From aa8329933e53a4a699f6965196b81cd315124c1e Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Wed, 16 Sep 2020 15:36:58 -0600 Subject: [PATCH 01/36] Fix DA ingesting ep (ensemble perturbation) of hydrometeors in ep_format=2 (#1287) TYPE: bug fix KEYWORDS: WRFDA, alpha_hydrometeors, ep_format=2 SOURCE: Jamie Bresch (NCAR) DESCRIPTION OF CHANGES: Problem: Only rootproc reads in the data, but the broadcasting from rootproc was missing for qice, qsnow and qgraup. Non-root processors will have qrain values for qice, qsnow and qgraup. Solution: add call wrf_dm_bcast_real(temp3d, ijk) LIST OF MODIFIED FILES: M var/da/da_setup_structures/da_setup_flow_predictors_ep_format2.inc TESTS CONDUCTED: RELEASE NOTE: Big fix for WRFDA incorrect ensemble perturbation values for qice, qsnow and qgraup when alpha_hydrometeors=true and ep_format=2. --- .../da_setup_flow_predictors_ep_format2.inc | 3 +++ 1 file changed, 3 insertions(+) diff --git a/var/da/da_setup_structures/da_setup_flow_predictors_ep_format2.inc b/var/da/da_setup_structures/da_setup_flow_predictors_ep_format2.inc index f26c8b537e..7905516743 100644 --- a/var/da/da_setup_structures/da_setup_flow_predictors_ep_format2.inc +++ b/var/da/da_setup_structures/da_setup_flow_predictors_ep_format2.inc @@ -359,6 +359,7 @@ subroutine da_setup_flow_predictors_ep_format2( ix, jy, kz, ne, ep, its, ite, jt read(unit=ep_unit) temp3d_r4(1:ix,1:jy,1:kz) temp3d = temp3d_r4 end if + call wrf_dm_bcast_real(temp3d, ijk) te = ie + (it-1)*nens ep % ci(its:ite,jts:jte,kts:kte,te) = ens_scaling_inv * & temp3d(its:ite,jts:jte,kts:kte) @@ -393,6 +394,7 @@ subroutine da_setup_flow_predictors_ep_format2( ix, jy, kz, ne, ep, its, ite, jt read(unit=ep_unit) temp3d_r4(1:ix,1:jy,1:kz) temp3d = temp3d_r4 end if + call wrf_dm_bcast_real(temp3d, ijk) te = ie + (it-1)*nens ep % sn(its:ite,jts:jte,kts:kte,te) = ens_scaling_inv * & temp3d(its:ite,jts:jte,kts:kte) @@ -427,6 +429,7 @@ subroutine da_setup_flow_predictors_ep_format2( ix, jy, kz, ne, ep, its, ite, jt read(unit=ep_unit) temp3d_r4(1:ix,1:jy,1:kz) temp3d = temp3d_r4 end if + call wrf_dm_bcast_real(temp3d, ijk) te = ie + (it-1)*nens ep % gr(its:ite,jts:jte,kts:kte,te) = ens_scaling_inv * & temp3d(its:ite,jts:jte,kts:kte) From 9bbb00a0fe66cc36c225fa1549e4696302b17183 Mon Sep 17 00:00:00 2001 From: Jamie Bresch Date: Fri, 18 Sep 2020 08:55:20 -0600 Subject: [PATCH 02/36] Fix DA use_obs_errfac for multiple outerloops (#1288) TYPE: bug fix KEYWORDS: WRFDA, use_obs_errfac, max_ext_its > 1 SOURCE: Jamie Bresch (NCAR) DESCRIPTION OF CHANGES: Problem: CWB reported seeing obs errors keep decreasing with each outerloop. Solution: Add a check for outerloop number, so that when use_obs_errfac=true and errfac.dat exists in the working directory, observation error factors are applied only at the first outerloop. LIST OF MODIFIED FILES: M var/da/da_minimisation/da_get_innov_vector.inc TESTS CONDUCTED: RELEASE NOTE: Bug fix for WRFDA's incorrectly applying errfac.dat at each outerloop when use_obs_errfac=true and max_ext_its > 1. --- var/da/da_minimisation/da_get_innov_vector.inc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/var/da/da_minimisation/da_get_innov_vector.inc b/var/da/da_minimisation/da_get_innov_vector.inc index 792c3856dd..d3e60d2ca5 100644 --- a/var/da/da_minimisation/da_get_innov_vector.inc +++ b/var/da/da_minimisation/da_get_innov_vector.inc @@ -285,7 +285,7 @@ subroutine da_get_innov_vector (it, num_qcstat_conv, ob, iv, grid, config_flags) ! [3] Optionally rescale observation errors: !------------------------------------------------------------------------ - if (use_obs_errfac) call da_use_obs_errfac( iv) + if (use_obs_errfac .and. it == 1) call da_use_obs_errfac(iv) !------------------------------------------------------------------------ ! [4] Optionally add Gaussian noise to O, O-B: From 75e865a77bb47d41cd8516ef985b2ad4b59e6cc2 Mon Sep 17 00:00:00 2001 From: lpilz Date: Wed, 7 Oct 2020 17:31:10 +0200 Subject: [PATCH 03/36] Chem: Prevent seg fault due to numgas==0 (#1294) TYPE: bug fix KEYWORDS: chem, drydep, wesely SOURCE: Lukas Pilz (Heidelberg University) DESCRIPTION OF CHANGES: Problem: A namelist option incompatibility between chem_opt (16) and gas_drydep_opt (1) leads to trying to access a variable that is not available in memory. This leads to unpredictable behaviors. When choosing a tracer-only chem_opt, numgas is 0. If gas_drydep_opt is 1 (the default), in the Wesely scheme initialization (dep_init), the field `dvj` is initialized with size numgas (here 0). Accessing the variable `dvj` is an error. Solution: A fatal error was added for when the Wesely scheme initialization is called with numgas = 0. This fix is in `chem/chemics_init.F` and not `share/module_check_a_mundo.F` because checking the namelist options would require some tricky-to-maintain hardcoding. LIST OF MODIFIED FILES: chem/chemics_init.F TESTS CONDUCTED: 1. Run with chem_opt = 16 and gas_drydep_opt = 1 fails appropriately 2. Run with chem_opt = 16 and gas_drydep_opt = 0 runs as it should 3. The jenkins testing is OK. RELEASE NOTE: For WRF-Chem, a namelist option incompatibility between chem_opt (16) and gas_drydep_opt (1) leads to trying to access a variable that is not available in memory. This leads to unpredictable behaviors. A fatal error was added for when the Wesely scheme initialization is called with numgas = 0. --- chem/chemics_init.F | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/chem/chemics_init.F b/chem/chemics_init.F index ea27ae3c58..66bc2f5024 100755 --- a/chem/chemics_init.F +++ b/chem/chemics_init.F @@ -1944,7 +1944,11 @@ subroutine chem_init (id,chem,emis_ant,scalar,dt,bioemdt,photdt,chemdt,stepbioe, ! drydep_select: SELECT CASE(config_flags%gas_drydep_opt) CASE (WESELY) - CALL wrf_debug(15,'initializing dry dep (wesely)') + IF (numgas .eq. 0) THEN + CALL wrf_error_fatal("ERROR: numgas = 0, SELECTED CHEM OPT IS & + &NOT COMPATIBLE WITH WESELY DRY DEPOSITION") + ENDIF + CALL wrf_debug(15,'initializing dry dep (wesely)') call dep_init( id, config_flags, numgas, mminlu_loc, & its, ite, jts, jte, ide, jde ) From 3337022ee16268aeb65b6a13d224af168933bbc6 Mon Sep 17 00:00:00 2001 From: pedro-jm Date: Wed, 7 Oct 2020 15:36:11 -0600 Subject: [PATCH 04/36] Bug fixes in deng shallow cumulus parameterization (#1277) TYPE: bug fix KEYWORDS: Deng shcu, resolved hydrometeors, non-active updrafts, precipitation units, variable initialization, limit NT SOURCE: Pedro A. Jimenez and Tim Juliano (NCAR/RAL), Eric Grimit and Mattew Wiley (Vaisala), and Xin-Zhong Liang (University of Maryland) DESCRIPTION OF CHANGES: Problem: The resolved hydrometeors are added to the unresolved hydrometeors inside Deng's parameterization. The radiation driver adds the resolved hydrometeors to the unresolved ones causing to double counting the effects of the resolved hydrometeors. The unresolved clouds are not properly removed when the updraft is not active Incorrect precipitation units Incorrect initialization of variable radiusc. The variable is initialized inside an #if construct for the 1D model If dt < 18 s NT is larger than 100 causing the code to look for values outside of array bounds for ainckfsa variable Solution: Do not add the resolved hydrometeors to the unresolved ones inside Deng's parameterization Set cloud fraction and the mixing ratio of the unresolved hydrometeors to 0 if the updraft is not active. Remove the conversion factor that was leading to the incorrect units. Initialize radiusc outside of the #if construct so radiusc is always initialized. Limit the maximum value of DT to 100 The following figure illustrates the impact of corrections 1 and 2. The time series of the mixing ratio now properly goes to 0 if the updraft is not active. image LIST OF MODIFIED FILES: M phys/module_shcu_deng.F TESTS CONDUCTED: We have run simulations with and without the fixes. The figure above illustrates that the clouds are now adequately removed if there are not active updrafts. Jenkins tests are all passing RELEASE NOTE: Several fixes introduced to the Deng's shallow cumulus parameterization: 1) Do not add the resolved hydrometeors to the unresolved ones to avoid double counting, 2) remove clouds if the updraft is not active, 3) correct conversion factor for precipitation, 4) correct initialization of radiusc variable, and 5) limit variable NT to avoid array out of bounds. --- phys/module_shcu_deng.F | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/phys/module_shcu_deng.F b/phys/module_shcu_deng.F index 408135ebd2..e9146ca580 100644 --- a/phys/module_shcu_deng.F +++ b/phys/module_shcu_deng.F @@ -255,8 +255,7 @@ SUBROUTINE deng_shcu_driver( & CA_RAD(I,K,J)=(1.0-CLDAREAA(I,K,J))*CS+CLDAREAA(I,K,J) CLDFRA_SH(I,K,J)= CA_RAD(I,K,J) -! CW_RAD(I,K,J)=CLDLIQA(I,K,J)+QC(I,K,J) - CW_RAD(I,K,J)=CLDLIQA(I,K,J)*CLDAREAA(I,K,J) + QC(I,K,J) + CW_RAD(I,K,J)=CLDLIQA(I,K,J)*CLDAREAA(I,K,J) ENDDO ENDDO ENDDO @@ -414,12 +413,9 @@ SUBROUTINE deng_shcu_driver( & ENDIF IF(CLDDPTHB(I,J) .LE. 0.0) THEN ! No active updraft - IF( CLDAREAB(I,K,J) .LE. 1.0e-3 .OR. CLDLIQB(I,K,J) .LE. 1.0e-17 ) THEN - ! QC(I,K,J)=QC(I,K,J)+CLDAREAB(I,K,J)*CLDLIQB(I,K,J) RQCSHTEN(I,K,J)=RQCSHTEN(I,K,J)+CLDAREAB(I,K,J)*CLDLIQB(I,K,J)/DT CLDAREAB(I,K,J) = 0.0 CLDLIQB(I,K,J) = 0.0 - ENDIF ENDIF ENDDO ENDDO @@ -679,8 +675,8 @@ SUBROUTINE deng_shcu(I,J, & ! in DCLDTOP(I,J)=0.0 DCLDBASE(I,J)=0.0 CLDBMFLX(I,J)=0.0 - RADIUSC(I,J)=0.0 #endif + RADIUSC(I,J)=0.0 ! !...INPUT A VERTICAL SOUNDING ... NOTE THAT MODEL LAYERS ARE NUMBERED FROM THE !...BOTTOM-UP IN THE SHALLOW CONVECTION SCHEME... @@ -2099,6 +2095,7 @@ SUBROUTINE deng_shcu(I,J, & ! in ! IF(CAPEI(I,J) .LT. 100.0) THEN ! averaging KF number of clouds NT = NINT(15.0*60.0/(0.5*DT))-1 ! for 15 min. + NT = MIN(NT, 100) ELSE NT = 0 ENDIF @@ -2799,7 +2796,7 @@ SUBROUTINE deng_shcu(I,J, & ! in ! ! CALCULATE THE CONVECTIVE RAINFALL ! - RAINSHV(I,J)=.1*.5*DT2*PPTFLX/DXSQ + RAINSHV(I,J)=.5*DT2*PPTFLX/DXSQ IF ( wrf_dm_on_monitor()) THEN CALL get_wrf_debug_level( dbg_level ) From e3456dafbb6f5bd79463e2a721c23b3685f0d8d0 Mon Sep 17 00:00:00 2001 From: Tim Raupach <51448110+traupach@users.noreply.github.com> Date: Sat, 10 Oct 2020 03:10:53 +1100 Subject: [PATCH 05/36] Fix vertical indices of c1h and c2h in ideal case init of ph_1 (#1280) TYPE: bug fix KEYWORDS: ideal case, initialization SOURCE: Tim Raupach (UNSW CCRC) DESCRIPTION OF CHANGES: Problem: In ideal case initialization routines, incorrect indices were used in the calculation of ph_1 after a perturbation bubble was added. Impact: The calculation of perturbation geopotential ph_1 (perturbation geopotential) and Z_BASE (idealized base state height) were affected. 1. If hybrid coordinate option was selected, (hybrid_opt = 2), the entire ph_1 initialization is incorrect due to the offset in the indexing of c1h and c2h (half levels vs full levels). 2. If hybrid_opt = 0, since the 1d variables are initialized kms:kme, there is no impact. Solution: The vertical indices were corrected in the calculations of ph_1 in the idealized initialization routine. ISSUE: LIST OF MODIFIED FILES: M dyn_em/module_initialize_ideal.F TESTS CONDUCTED: 1. The jenkins testing is all pass. RELEASE NOTE: In the ideal case initialization routines, incorrect indices were used in the calculation of ph_1 after a perturbation bubble was added. For the idealized cases that do not use the hybrid vertical coordinate by default, there is no impact at all. The ideal cases with a hill had the correct hybrid formulation. --- dyn_em/module_initialize_ideal.F | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/dyn_em/module_initialize_ideal.F b/dyn_em/module_initialize_ideal.F index 22817bd550..058b299233 100644 --- a/dyn_em/module_initialize_ideal.F +++ b/dyn_em/module_initialize_ideal.F @@ -1120,10 +1120,10 @@ SUBROUTINE init_domain_rk ( grid & ! rebalance hydrostatically - DO k = 2,kte + DO k = 2,kte grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (grid%dnw(k-1))*( & - ((grid%c1h(k)*grid%mub(i,j)+grid%c2h(k))+(grid%c1h(k)*grid%mu_1(i,j)))*grid%al(i,k-1,j)+ & - (grid%c1h(k)*grid%mu_1(i,j))*grid%alb(i,k-1,j) ) + ((grid%c1h(k-1)*grid%mub(i,j)+grid%c2h(k-1))+(grid%c1h(k-1)*grid%mu_1(i,j)))*grid%al(i,k-1,j)+ & + (grid%c1h(k-1)*grid%mu_1(i,j))*grid%alb(i,k-1,j) ) grid%ph_2(i,k,j) = grid%ph_1(i,k,j) grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j) @@ -1165,10 +1165,10 @@ SUBROUTINE init_domain_rk ( grid & ! rebalance hydrostatically - DO k = 2,kte + DO k = 2,kte grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (grid%dnw(k-1))*( & - ((grid%c1h(k)*grid%mub(i,j)+grid%c2h(k))+(grid%c1h(k)*grid%mu_1(i,j)))*grid%al(i,k-1,j)+ & - (grid%c1h(k)*grid%mu_1(i,j))*grid%alb(i,k-1,j) ) + ((grid%c1h(k-1)*grid%mub(i,j)+grid%c2h(k-1))+(grid%c1h(k-1)*grid%mu_1(i,j)))*grid%al(i,k-1,j)+ & + (grid%c1h(k-1)*grid%mu_1(i,j))*grid%alb(i,k-1,j) ) grid%ph_2(i,k,j) = grid%ph_1(i,k,j) grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j) @@ -1212,8 +1212,8 @@ SUBROUTINE init_domain_rk ( grid & DO k = 2,kte grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (grid%dnw(k-1))*( & - ((grid%c1h(k)*grid%mub(i,j)+grid%c2h(k))+(grid%c1h(k)*grid%mu_1(i,j)))*grid%al(i,k-1,j)+ & - (grid%c1h(k)*grid%mu_1(i,j))*grid%alb(i,k-1,j) ) + ((grid%c1h(k-1)*grid%mub(i,j)+grid%c2h(k-1))+(grid%c1h(k-1)*grid%mu_1(i,j)))*grid%al(i,k-1,j)+ & + (grid%c1h(k-1)*grid%mu_1(i,j))*grid%alb(i,k-1,j) ) grid%ph_2(i,k,j) = grid%ph_1(i,k,j) grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j) @@ -1245,8 +1245,8 @@ SUBROUTINE init_domain_rk ( grid & DO k = 2,kte grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (grid%dnw(k-1))*( & - ((grid%c1h(k)*grid%mub(i,j)+grid%c2h(k))+(grid%c1h(k)*grid%mu_1(i,j)))*grid%al(i,k-1,j)+ & - (grid%c1h(k)*grid%mu_1(i,j))*grid%alb(i,k-1,j) ) + ((grid%c1h(k-1)*grid%mub(i,j)+grid%c2h(k-1))+(grid%c1h(k-1)*grid%mu_1(i,j)))*grid%al(i,k-1,j)+ & + (grid%c1h(k-1)*grid%mu_1(i,j))*grid%alb(i,k-1,j) ) grid%ph_2(i,k,j) = grid%ph_1(i,k,j) grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j) ENDDO @@ -1306,8 +1306,8 @@ SUBROUTINE init_domain_rk ( grid & DO k = 2,kte grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (grid%dnw(k-1))*( & - ((grid%c1h(k)*grid%mub(i,j)+grid%c2h(k))+(grid%c1h(k)*grid%mu_1(i,j)))*grid%al(i,k-1,j)+ & - (grid%c1h(k)*grid%mu_1(i,j))*grid%alb(i,k-1,j) ) + ((grid%c1h(k-1)*grid%mub(i,j)+grid%c2h(k-1))+(grid%c1h(k-1)*grid%mu_1(i,j)))*grid%al(i,k-1,j)+ & + (grid%c1h(k-1)*grid%mu_1(i,j))*grid%alb(i,k-1,j) ) grid%ph_2(i,k,j) = grid%ph_1(i,k,j) grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j) @@ -1355,8 +1355,8 @@ SUBROUTINE init_domain_rk ( grid & DO k = 2,kte grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (grid%dnw(k-1))*( & - ((grid%c1h(k)*grid%mub(i,j)+grid%c2h(k))+(grid%c1h(k)*grid%mu_1(i,j)))*grid%al(i,k-1,j)+ & - (grid%c1h(k)*grid%mu_1(i,j))*grid%alb(i,k-1,j) ) + ((grid%c1h(k-1)*grid%mub(i,j)+grid%c2h(k-1))+(grid%c1h(k-1)*grid%mu_1(i,j)))*grid%al(i,k-1,j)+ & + (grid%c1h(k-1)*grid%mu_1(i,j))*grid%alb(i,k-1,j) ) grid%ph_2(i,k,j) = grid%ph_1(i,k,j) grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j) From 5296b788f058870e4b1f6114f65f40684524d80f Mon Sep 17 00:00:00 2001 From: arjanna <47889545+arjanna@users.noreply.github.com> Date: Wed, 14 Oct 2020 18:49:58 +0200 Subject: [PATCH 06/36] fixes irrigation module (#1283) Co-authored-by: Arianna Valmassoi --- phys/module_surface_driver.F | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/phys/module_surface_driver.F b/phys/module_surface_driver.F index d082f547ad..fcdb7c015a 100644 --- a/phys/module_surface_driver.F +++ b/phys/module_surface_driver.F @@ -1392,8 +1392,8 @@ SUBROUTINE surface_driver( & REAL, PARAMETER :: PI_GRECO=3.14159 INTEGER :: end_hour, irr_start,xt24,irr_day REAL :: constants_irrigation - REAL,DIMENSION( ims:ime, jms:jme ) :: IRRIGATION_CHANNEL - REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN),OPTIONAL:: IRRIGATION + REAL, DIMENSION( ims:ime, jms:jme ) :: IRRIGATION_CHANNEL + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) , OPTIONAL:: IRRIGATION REAL, INTENT(IN),OPTIONAL:: irr_daily_amount INTEGER :: phase INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT),OPTIONAL :: irr_rand_field @@ -1499,6 +1499,7 @@ SUBROUTINE surface_driver( & IF ( PRESENT( rainshv ))RAINBL(i,j) = RAINBL(i,j) + RAINSHV(i,j) RAINBL(i,j) = MAX (RAINBL(i,j), 0.0) #if (EM_CORE==1) + IRRIGATION_CHANNEL(i,j) = 0. sf_surf_irr: SELECT CASE(sf_surf_irr_scheme) CASE(DRIP) CALL drip_irrigation( & @@ -2740,7 +2741,7 @@ SUBROUTINE surface_driver( & dl_u_bep,sf_bep,vl_bep & !O multi-layer urban ,sfcheadrt,INFXSRT, soldrain & !hydro ,SDA_HFX, SDA_QFX, HFX_BOTH, QFX_BOTH, QNORM, fasdas & ! fasdas - ,RS,XLAIDYN) + ,RS,XLAIDYN,IRRIGATION_CHANNEL) ELSE CALL wrf_error_fatal('Lack arguments to call lsm_mosaic') ENDIF @@ -2860,7 +2861,7 @@ SUBROUTINE surface_driver( & ! ! END FASDAS ! - ,RS,XLAIDYN) + ,RS,XLAIDYN,IRRIGATION_CHANNEL) ENDIF call seaice_noah( SEAICE_ALBEDO_OPT, SEAICE_ALBEDO_DEFAULT, SEAICE_THICKNESS_OPT, & From 306616cdd675c63291f68288e7c839e3c83458a0 Mon Sep 17 00:00:00 2001 From: Ju-Hye Kim <42191918+juhyejuhye@users.noreply.github.com> Date: Tue, 20 Oct 2020 15:15:47 -0600 Subject: [PATCH 07/36] Background effective radius consistency fix (#1295) FARMS correctly detects unresolved clouds TYPE: bug fix KEYWORDS: FARMS, effective radius of unresolved hydrometeors, cloud fraction SOURCE: Ju-Hye Kim and Pedro A. Jimenez (NCAR/RAL), and Jimy Dudhia (NCAR/MMM) DESCRIPTION OF CHANGES: Problem: The previous version of FARMS did not correctly account for the radiative effects of unresolved clouds, because the FARMS calculates the surface irradiances using both cloud water contents and cloud effective radii. In previous version, cloud water contents came from both resolved and unresolved clouds, on the other hand, effective radii came only from resolved clouds. Solution: The climatological effective radii are assigned to unresolved clouds of liquid, ice and snow species, and are specified as the effective radii of clouds in microphysics schemes (e.g. mp=2) that do not provide any effective radii. The fix is also valid for Thompson MPs, WSMMPs, and WDMMPs by adjusting the background effective radii of these schemes. In addition to this, we improved calculations of surface irradiance by adding cloud fraction to the FARMS scheme. ISSUE: N/A LIST OF MODIFIED FILES: M phys/module_mp_thompson.F M phys/module_mp_wdm5.F M phys/module_mp_wdm6.F M phys/module_mp_wdm7.F M phys/module_mp_wsm3.F M phys/module_mp_wsm5.F M phys/module_mp_wsm6.F M phys/module_mp_wsm7.F M phys/module_physics_init.F M phys/module_ra_farms.F M phys/module_radiation_driver.F TESTS CONDUCTED: Do mods fix problem? How can that be demonstrated, and was that test conducted? Yes. The downward short wave flux (GHI) will increase in the cloud region with unresolved clouds by reduced scatterings due to increased cloud size. This was tested in the WRF-Solar model. Are the Jenkins tests all passing? We did't do the Jenkins tests. RELEASE NOTE: Bug fix to account for the effective radius of the unresolved hydrometeors by FARMS. --- phys/module_mp_thompson.F | 23 +++++----- phys/module_mp_wdm5.F | 13 +++--- phys/module_mp_wdm6.F | 13 +++--- phys/module_mp_wdm7.F | 13 +++--- phys/module_mp_wsm3.F | 13 +++--- phys/module_mp_wsm5.F | 13 +++--- phys/module_mp_wsm6.F | 13 +++--- phys/module_mp_wsm7.F | 13 +++--- phys/module_physics_init.F | 27 +++++++----- phys/module_ra_farms.F | 76 +++++++++++++++++++++++++++------- phys/module_radiation_driver.F | 5 ++- share/module_model_constants.F | 4 ++ 12 files changed, 145 insertions(+), 81 deletions(-) diff --git a/phys/module_mp_thompson.F b/phys/module_mp_thompson.F index fbc32a7420..9e5dbddc52 100644 --- a/phys/module_mp_thompson.F +++ b/phys/module_mp_thompson.F @@ -49,6 +49,7 @@ MODULE module_mp_thompson #if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) ) USE module_dm, ONLY : wrf_dm_max_real #endif + USE module_model_constants, only : RE_QC_BG, RE_QI_BG, RE_QS_BG IMPLICIT NONE @@ -1304,16 +1305,16 @@ 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) = RE_QC_BG + re_qi1d(k) = RE_QI_BG + re_qs1d(k) = RE_QS_BG enddo 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(RE_QC_BG, MIN(re_qc1d(k), 50.E-6)) + re_ice(i,k,j) = MAX(RE_QI_BG, MIN(re_qi1d(k), 125.E-6)) + re_snow(i,k,j) = MAX(RE_QS_BG, MIN(re_qs1d(k), 999.E-6)) enddo ENDIF @@ -5065,7 +5066,7 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & if (has_qc) then do k = kts, kte - re_qc1d(k) = 2.49E-6 + re_qc1d(k) = RE_QC_BG if (rc(k).le.R1 .or. nc(k).le.R2) CYCLE if (nc(k).lt.100) then inu_c = 15 @@ -5081,16 +5082,16 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & if (has_qi) then do k = kts, kte - re_qi1d(k) = 2.49E-6 + re_qi1d(k) = RE_QI_BG 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(2.51E-6, MIN(SNGL(0.5D0 * DBLE(3.+mu_i)/lami), 125.E-6)) + re_qi1d(k) = MAX(5.01E-6, MIN(SNGL(0.5D0 * DBLE(3.+mu_i)/lami), 125.E-6)) enddo endif if (has_qs) then do k = kts, kte - re_qs1d(k) = 4.99E-6 + re_qs1d(k) = RE_QS_BG if (rs(k).le.R1) CYCLE tc0 = MIN(-0.1, t1d(k)-273.15) smob = rs(k)*oams @@ -5125,7 +5126,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(5.01E-6, MIN(0.5*(smoc/smob), 999.E-6)) + re_qs1d(k) = MAX(10.01E-6, MIN(0.5*(smoc/smob), 999.E-6)) enddo endif diff --git a/phys/module_mp_wdm5.F b/phys/module_mp_wdm5.F index caafdfd77d..6e69b082e2 100644 --- a/phys/module_mp_wdm5.F +++ b/phys/module_mp_wdm5.F @@ -10,6 +10,7 @@ MODULE module_mp_wdm5 ! USE module_mp_radar + USE module_model_constants, only : RE_QC_BG, RE_QI_BG, RE_QS_BG ! REAL, PARAMETER, PRIVATE :: dtcldcr = 120. ! maximum time step for minor loops REAL, PARAMETER, PRIVATE :: n0r = 8.e6 ! intercept parameter rain @@ -289,9 +290,9 @@ SUBROUTINE wdm5(th, q, qc, qr, qi, qs & if (has_reqc.ne.0 .and. has_reqi.ne.0 .and. has_reqs.ne.0) then do i = its, ite do k = kts, kte - re_qc(k) = 2.51E-6 - re_qi(k) = 10.01E-6 - re_qs(k) = 25.E-6 + re_qc(k) = RE_QC_BG + re_qi(k) = RE_QI_BG + re_qs(k) = RE_QS_BG t1d(k) = th(i,k,j)*pii(i,k,j) den1d(k)= den(i,k,j) @@ -304,9 +305,9 @@ SUBROUTINE wdm5(th, q, qc, qr, qi, qs & qmin, t0c, re_qc, re_qi, re_qs, & kts, kte, i, j) do k = kts, kte - re_cloud(i,k,j) = MAX(2.51E-6, MIN(re_qc(k), 50.E-6)) - re_ice(i,k,j) = MAX(10.01E-6, MIN(re_qi(k), 125.E-6)) - re_snow(i,k,j) = MAX(25.E-6, MIN(re_qs(k), 999.E-6)) + re_cloud(i,k,j) = MAX(RE_QC_BG, MIN(re_qc(k), 50.E-6)) + re_ice(i,k,j) = MAX(RE_QI_BG, MIN(re_qi(k), 125.E-6)) + re_snow(i,k,j) = MAX(RE_QS_BG, MIN(re_qs(k), 999.E-6)) enddo ! k loop enddo ! i loop endif ! has_reqc, etc... diff --git a/phys/module_mp_wdm6.F b/phys/module_mp_wdm6.F index 039ebfa64d..4ff157910c 100644 --- a/phys/module_mp_wdm6.F +++ b/phys/module_mp_wdm6.F @@ -10,6 +10,7 @@ module module_mp_wdm6 !------------------------------------------------------------------------------- ! use module_mp_radar + use module_model_constants, only : RE_QC_BG, RE_QI_BG, RE_QS_BG ! ! !------------------------------------------------------------------------------- @@ -301,9 +302,9 @@ subroutine wdm6(th, q, qc, qr, qi, qs, qg, & if (has_reqc.ne.0 .and. has_reqi.ne.0 .and. has_reqs.ne.0) then do i = its,ite do k = kts,kte - re_qc(k) = 2.51e-6 - re_qi(k) = 10.01e-6 - re_qs(k) = 25.e-6 + re_qc(k) = RE_QC_BG + re_qi(k) = RE_QI_BG + re_qs(k) = RE_QS_BG ! t1d(k) = th(i,k,j)*pii(i,k,j) den1d(k)= den(i,k,j) @@ -318,9 +319,9 @@ subroutine wdm6(th, q, qc, qr, qi, qs, qg, & kts, kte, i, j) ! do k = kts,kte - re_cloud(i,k,j) = max(2.51e-6, min(re_qc(k), 50.e-6)) - re_ice(i,k,j) = max(10.01e-6, min(re_qi(k), 125.e-6)) - re_snow(i,k,j) = max(25.e-6, min(re_qs(k), 999.e-6)) + re_cloud(i,k,j) = max(RE_QC_BG, min(re_qc(k), 50.e-6)) + re_ice(i,k,j) = max(RE_QI_BG, min(re_qi(k), 125.e-6)) + re_snow(i,k,j) = max(RE_QS_BG, min(re_qs(k), 999.e-6)) enddo enddo endif diff --git a/phys/module_mp_wdm7.F b/phys/module_mp_wdm7.F index edb97b5e3d..e063038d78 100644 --- a/phys/module_mp_wdm7.F +++ b/phys/module_mp_wdm7.F @@ -9,6 +9,7 @@ MODULE module_mp_wdm7 ! ! USE module_mp_radar + USE module_model_constants, only : RE_QC_BG, RE_QI_BG, RE_QS_BG ! REAL, PARAMETER, PRIVATE :: dtcldcr = 120. ! maximum time step for minor loops REAL, PARAMETER, PRIVATE :: n0r = 8.e6 ! intercept parameter rain @@ -334,9 +335,9 @@ SUBROUTINE wdm7(th, q, qc, qr, qi, qs, qg, qh, & IF (has_reqc.ne.0 .and. has_reqi.ne.0 .and. has_reqs.ne.0) THEN DO i=its,ite DO k=kts,kte - re_qc(k) = 2.51E-6 - re_qi(k) = 10.01E-6 - re_qs(k) = 25.E-6 + re_qc(k) = RE_QC_BG + re_qi(k) = RE_QI_BG + re_qs(k) = RE_QS_BG t1d(k) = th(i,k,j)*pii(i,k,j) den1d(k)= den(i,k,j) @@ -349,9 +350,9 @@ SUBROUTINE wdm7(th, q, qc, qr, qi, qs, qg, qh, & qmin, t0c, re_qc, re_qi, re_qs, & kts, kte, i, j) DO k=kts,kte - re_cloud(i,k,j) = max(2.51E-6, min(re_qc(k), 50.E-6)) - re_ice(i,k,j) = max(10.01E-6, min(re_qi(k), 125.E-6)) - re_snow(i,k,j) = max(25.E-6, min(re_qs(k), 999.E-6)) + re_cloud(i,k,j) = max(RE_QC_BG, min(re_qc(k), 50.E-6)) + re_ice(i,k,j) = max(RE_QI_BG, min(re_qi(k), 125.E-6)) + re_snow(i,k,j) = max(RE_QS_BG, min(re_qs(k), 999.E-6)) ENDDO ENDDO ENDIF diff --git a/phys/module_mp_wsm3.F b/phys/module_mp_wsm3.F index 1d38089bb6..a71d3cbfa6 100644 --- a/phys/module_mp_wsm3.F +++ b/phys/module_mp_wsm3.F @@ -11,6 +11,7 @@ MODULE module_mp_wsm3 ! + USE module_model_constants, only : RE_QC_BG, RE_QI_BG, RE_QS_BG ! REAL, PARAMETER, PRIVATE :: dtcldcr = 120. ! maximum time step for minor loops REAL, PARAMETER, PRIVATE :: n0r = 8.e6 ! intercept parameter rain @@ -162,9 +163,9 @@ SUBROUTINE wsm3(th, q, qci, qrs & if (has_reqc.ne.0 .and. has_reqi.ne.0 .and. has_reqs.ne.0) then do i=its,ite do k=kts,kte - re_qc(k) = 2.51E-6 - re_qi(k) = 10.01E-6 - re_qs(k) = 25.E-6 + re_qc(k) = RE_QC_BG + re_qi(k) = RE_QI_BG + re_qs(k) = RE_QS_BG t1d(k) = th(i,k,j)*pii(i,k,j) den1d(k)= den(i,k,j) @@ -182,9 +183,9 @@ SUBROUTINE wsm3(th, q, qci, qrs & qmin, t0c, re_qc, re_qi, re_qs, & kts, kte, i, j) do k=kts,kte - re_cloud(i,k,j) = MAX(2.51E-6, MIN(re_qc(k), 50.E-6)) - re_ice(i,k,j) = MAX(10.01E-6, MIN(re_qi(k), 125.E-6)) - re_snow(i,k,j) = MAX(25.E-6, MIN(re_qs(k), 999.E-6)) + re_cloud(i,k,j) = MAX(RE_QC_BG, MIN(re_qc(k), 50.E-6)) + re_ice(i,k,j) = MAX(RE_QI_BG, MIN(re_qi(k), 125.E-6)) + re_snow(i,k,j) = MAX(RE_QS_BG, MIN(re_qs(k), 999.E-6)) enddo enddo endif ! has_reqc, etc... diff --git a/phys/module_mp_wsm5.F b/phys/module_mp_wsm5.F index faf3982b26..e081a7b6e4 100644 --- a/phys/module_mp_wsm5.F +++ b/phys/module_mp_wsm5.F @@ -13,6 +13,7 @@ MODULE module_mp_wsm5 ! USE module_mp_radar + USE module_model_constants, only : RE_QC_BG, RE_QI_BG, RE_QS_BG ! REAL, PARAMETER, PRIVATE :: dtcldcr = 120. ! maximum time step for minor loops REAL, PARAMETER, PRIVATE :: n0r = 8.e6 ! intercept parameter rain @@ -218,9 +219,9 @@ SUBROUTINE wsm5(th, q, qc, qr, qi, qs & if (has_reqc.ne.0 .and. has_reqi.ne.0 .and. has_reqs.ne.0) then do i=its,ite do k=kts,kte - re_qc(k) = 2.51E-6 - re_qi(k) = 10.01E-6 - re_qs(k) = 25.E-6 + re_qc(k) = RE_QC_BG + re_qi(k) = RE_QI_BG + re_qs(k) = RE_QS_BG t1d(k) = th(i,k,j)*pii(i,k,j) den1d(k)= den(i,k,j) @@ -232,9 +233,9 @@ SUBROUTINE wsm5(th, q, qc, qr, qi, qs & qmin, t0c, re_qc, re_qi, re_qs, & kts, kte, i, j) do k=kts,kte - re_cloud(i,k,j) = MAX(2.51E-6, MIN(re_qc(k), 50.E-6)) - re_ice(i,k,j) = MAX(10.01E-6, MIN(re_qi(k), 125.E-6)) - re_snow(i,k,j) = MAX(25.E-6, MIN(re_qs(k), 999.E-6)) + re_cloud(i,k,j) = MAX(RE_QC_BG, MIN(re_qc(k), 50.E-6)) + re_ice(i,k,j) = MAX(RE_QI_BG, MIN(re_qi(k), 125.E-6)) + re_snow(i,k,j) = MAX(RE_QS_BG, MIN(re_qs(k), 999.E-6)) enddo enddo endif ! has_reqc, etc... diff --git a/phys/module_mp_wsm6.F b/phys/module_mp_wsm6.F index 5c52d40f28..69a2d49592 100644 --- a/phys/module_mp_wsm6.F +++ b/phys/module_mp_wsm6.F @@ -9,6 +9,7 @@ MODULE module_mp_wsm6 ! USE module_mp_radar + USE module_model_constants, only : RE_QC_BG, RE_QI_BG, RE_QS_BG ! REAL, PARAMETER, PRIVATE :: dtcldcr = 120. ! maximum time step for minor loops REAL, PARAMETER, PRIVATE :: n0r = 8.e6 ! intercept parameter rain @@ -237,9 +238,9 @@ SUBROUTINE wsm6(th, q, qc, qr, qi, qs, qg & if (has_reqc.ne.0 .and. has_reqi.ne.0 .and. has_reqs.ne.0) then do i=its,ite do k=kts,kte - re_qc(k) = 2.51E-6 - re_qi(k) = 10.01E-6 - re_qs(k) = 25.E-6 + re_qc(k) = RE_QC_BG + re_qi(k) = RE_QI_BG + re_qs(k) = RE_QS_BG t1d(k) = th(i,k,j)*pii(i,k,j) den1d(k)= den(i,k,j) @@ -251,9 +252,9 @@ SUBROUTINE wsm6(th, q, qc, qr, qi, qs, qg & qmin, t0c, re_qc, re_qi, re_qs, & kts, kte, i, j) do k=kts,kte - re_cloud(i,k,j) = MAX(2.51E-6, MIN(re_qc(k), 50.E-6)) - re_ice(i,k,j) = MAX(10.01E-6, MIN(re_qi(k), 125.E-6)) - re_snow(i,k,j) = MAX(25.E-6, MIN(re_qs(k), 999.E-6)) + re_cloud(i,k,j) = MAX(RE_QC_BG, MIN(re_qc(k), 50.E-6)) + re_ice(i,k,j) = MAX(RE_QI_BG, MIN(re_qi(k), 125.E-6)) + re_snow(i,k,j) = MAX(RE_QS_BG, MIN(re_qs(k), 999.E-6)) enddo enddo endif ! has_reqc, etc... diff --git a/phys/module_mp_wsm7.F b/phys/module_mp_wsm7.F index 31e5636559..8f757f08c5 100644 --- a/phys/module_mp_wsm7.F +++ b/phys/module_mp_wsm7.F @@ -9,6 +9,7 @@ MODULE module_mp_wsm7 ! USE module_mp_radar + USE module_model_constants, only : RE_QC_BG, RE_QI_BG, RE_QS_BG ! REAL, PARAMETER, PRIVATE :: dtcldcr = 120. ! maximum time step for minor loops REAL, PARAMETER, PRIVATE :: n0r = 8.e6 ! intercept parameter rain @@ -245,9 +246,9 @@ SUBROUTINE wsm7(th, q, qc, qr, qi, qs, qg, qh & if (has_reqc.ne.0 .and. has_reqi.ne.0 .and. has_reqs.ne.0) then do i=its,ite do k=kts,kte - re_qc(k) = 2.51E-6 - re_qi(k) = 10.01E-6 - re_qs(k) = 25.E-6 + re_qc(k) = RE_QC_BG + re_qi(k) = RE_QI_BG + re_qs(k) = RE_QS_BG ! t1d(k) = th(i,k,j)*pii(i,k,j) den1d(k)= den(i,k,j) @@ -261,9 +262,9 @@ SUBROUTINE wsm7(th, q, qc, qr, qi, qs, qg, qh & kts, kte, i, j) ! do k=kts,kte - re_cloud(i,k,j) = MAX(2.51E-6, MIN(re_qc(k), 50.E-6)) - re_ice(i,k,j) = MAX(10.01E-6, MIN(re_qi(k), 125.E-6)) - re_snow(i,k,j) = MAX(25.E-6, MIN(re_qs(k), 999.E-6)) + re_cloud(i,k,j) = MAX(RE_QC_BG, MIN(re_qc(k), 50.E-6)) + re_ice(i,k,j) = MAX(RE_QI_BG, MIN(re_qi(k), 125.E-6)) + re_snow(i,k,j) = MAX(RE_QS_BG, MIN(re_qs(k), 999.E-6)) enddo enddo endif ! if has_reqc ne 0 end diff --git a/phys/module_physics_init.F b/phys/module_physics_init.F index d9edbf6c53..f5bf1b4c68 100644 --- a/phys/module_physics_init.F +++ b/phys/module_physics_init.F @@ -942,15 +942,22 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & ! for cloud, ice, and snow. IF ( config_flags%swint_opt .eq. 2 ) THEN - IF ( ( has_reqc .EQ. 1 ) .AND. & - ( has_reqi .EQ. 1 ) .AND. & - ( has_reqs .EQ. 1 ) .AND. & + IF (( config_flags%mp_physics == THOMPSON .OR. & + config_flags%mp_physics == THOMPSONAERO .OR. & + config_flags%mp_physics == WSM3SCHEME .OR. & + config_flags%mp_physics == WSM5SCHEME .OR. & + config_flags%mp_physics == WSM6SCHEME .OR. & + config_flags%mp_physics == WSM7SCHEME .OR. & + config_flags%mp_physics == WDM5SCHEME .OR. & + config_flags%mp_physics == WDM6SCHEME .OR. & + config_flags%mp_physics == WDM7SCHEME ).OR. & + (( has_reqc .EQ. 0 .AND. has_reqi .EQ. 0 .and. has_reqs .EQ. 0 ) .AND. & ( f_qc ) .AND. & ( f_qi ) .AND. & - ( f_qs ) ) THEN + ( f_qs ))) THEN ! everything is A-OK for FARMS ELSE - CALL wrf_error_fatal ('--- ERROR: FARMS (swint_opt==2) requires a different MP scheme') + CALL wrf_error_fatal ('--- ERROR: FARMS (swint_opt==2) requires a different MP scheme (Please see the module_physics_init') END IF END IF @@ -1163,13 +1170,13 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & end do !..Fill initial starting values of radiative effective radii for -!.. cloud water (2.51 microns), cloud ice (5.01 microns), and -!.. snow (10.01 microns). +!.. cloud water (2.49 microns), cloud ice (4.99 microns), and +!.. snow (9.99 microns). if (has_reqc.ne.0) then do j=jts,jtf do k=kts,ktf do i=its,itf - re_cloud(i,k,j) = 2.51E-6 + re_cloud(i,k,j) = RE_QC_BG end do end do end do @@ -1178,7 +1185,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & do j=jts,jtf do k=kts,ktf do i=its,itf - re_ice(i,k,j) = 5.01E-6 + re_ice(i,k,j) = RE_QI_BG end do end do end do @@ -1187,7 +1194,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf, & do j=jts,jtf do k=kts,ktf do i=its,itf - re_snow(i,k,j) = 10.01E-6 + re_snow(i,k,j) = RE_QS_BG end do end do end do diff --git a/phys/module_ra_farms.F b/phys/module_ra_farms.F index d63926c19a..0db1e92319 100644 --- a/phys/module_ra_farms.F +++ b/phys/module_ra_farms.F @@ -27,26 +27,29 @@ module module_ra_farms real, parameter :: DE_CLOUD_MIN = 5.0, DE_CLOUD_MAX = 120.0 real, parameter :: TAU_MIN = 0.0001, TAU_MAX = 300.0 real, parameter :: AOD550_VAL = 0.12, ANGEXP_VAL = 1.3, AERSSA_VAL = 0.85, AERASY_VAL = 0.9 + real, parameter :: RE_CLOUD_CLIM = 8.E-6, RE_ICE_CLIM = 24.E-6, RE_SNOW_CLIM = 24.E-6 contains subroutine Farms_driver (ims, ime, jms, jme, its, ite, jts, jte, kms, kme, kts, kte, & p8w, rho, dz8w, albedo, aer_opt, aerssa2d, aerasy2d, aod5502d, angexp2d, & coszen_loc, qv, qi, qs, qc, re_cloud, re_ice, re_snow, & - julian, swdown2, swddir2, swddni2, swddif2, swdownc2, swddnic2) + julian, swdown2, swddir2, swddni2, swddif2, swdownc2, swddnic2, & + has_reqc, has_reqi, has_reqs, cldfra) implicit None integer, intent(in) :: ims, ime, jms, jme, its, ite, jts, jte, kms, kme, & kts, kte - integer, intent(in) :: aer_opt + integer, intent(in) :: aer_opt, has_reqc, has_reqi, has_reqs real, intent(in) :: julian real, dimension(ims:ime, jms:jme), intent(in) :: albedo, coszen_loc real, dimension(ims:ime, kms:kme, jms:jme ), intent(in) :: qv, qi, qs, qc, & - p8w, rho, dz8w, re_cloud, re_ice, re_snow + p8w, rho, dz8w, cldfra + real, dimension(ims:ime, kms:kme, jms:jme ), intent(in) :: re_cloud, re_ice, re_snow real, dimension(ims:ime, jms:jme), intent(inout) :: aerssa2d, aerasy2d, aod5502d, angexp2d real, dimension(ims:ime,jms:jme), intent(inout) :: swddir2, swdown2, & @@ -54,10 +57,10 @@ subroutine Farms_driver (ims, ime, jms, jme, its, ite, jts, jte, kms, kme, kts, swdownc2, swddnic2 ! Local - integer :: i, j + integer :: i, j, k real :: tau_qv, tau_qi, tau_qs, pmw, swp, iwp, lwp, beta - real :: re_cloud_path, re_ice_path, re_snow_path, q_aux - real, dimension(kms:kme) :: rhodz + real :: re_cloud_path, re_ice_path, re_snow_path, q_aux, cldfra_h + real, dimension(kms:kme) :: rhodz, re_cloud_k, re_ice_k, re_snow_k j_loop: do j = jts, jte @@ -71,6 +74,34 @@ subroutine Farms_driver (ims, ime, jms, jme, its, ite, jts, jte, kms, kme, kts, swddnic2(i, j) = 0.0 else rhodz(:) = rho(i, :, j) * dz8w(i, :, j) / (1. + qv(i, :, j)) + re_cloud_k(:) = re_cloud(i, :, j) + re_ice_k(:) = re_ice(i, :, j) + re_snow_k(:) = re_snow(i, :, j) + + if (has_reqc == 1) then + do k = kts, kte + if (CLDFRA (i, k, j) > 0.0 .and. re_cloud_k(k) < 2.5E-6) re_cloud_k(k) = RE_CLOUD_CLIM + end do + else + re_cloud_k(:) = RE_CLOUD_CLIM + end if + + if (has_reqi == 1) then + do k = kts, kte + if (cldfra(i, k, j) > 0.0 .and. re_ice_k(k) < 5.0E-6) re_ice_k(k) = RE_ICE_CLIM + end do + else + re_ice_k(:) = RE_ICE_CLIM + end if + + if (has_reqs == 1) then + do k = kts, kte + if (cldfra(i, k, j) > 0.0 .and. re_snow_k(k) < 10.0E-6) re_snow_k(k) = RE_SNOW_CLIM + end do + else + re_snow_k(:) = RE_SNOW_CLIM + end if + ! PMW pmw = integrate_1var (rhodz, qv(i, :, j), kms, kme, kts, kte) @@ -80,7 +111,7 @@ subroutine Farms_driver (ims, ime, jms, jme, its, ite, jts, jte, kms, kme, kts, if (q_aux > 0.0) then re_cloud_path = integrate_2var (rhodz, qc(i, :, j), & - re_cloud(i, :, j), kms, kme, kts, kte) + re_cloud_k, kms, kme, kts, kte) re_cloud_path = re_cloud_path / q_aux else re_cloud_path = 0.0 @@ -92,7 +123,7 @@ subroutine Farms_driver (ims, ime, jms, jme, its, ite, jts, jte, kms, kme, kts, if (q_aux > 0.0) then re_ice_path = integrate_2var (rhodz, qi(i, :, j), & - re_ice(i, :, j), kms, kme, kts, kte) + re_ice_k, kms, kme, kts, kte) re_ice_path = re_ice_path / q_aux else re_ice_path = 0.0 @@ -104,12 +135,22 @@ subroutine Farms_driver (ims, ime, jms, jme, its, ite, jts, jte, kms, kme, kts, if (q_aux > 0.0) then re_snow_path = integrate_2var (rhodz, qs(i, :, j), & - re_snow(i, :, j), kms, kme, kts, kte) + re_snow_k, kms, kme, kts, kte) re_snow_path = re_snow_path / q_aux else re_snow_path = 0.0 end if + ! Calculate horizontal cloud fraction + q_aux = integrate_1var (rhodz, qc(i, :, j) + qi(i, :, j) + qs(i, :, j), kms, kme, kts, kte) + if (q_aux > 0.0) then + cldfra_h = integrate_2var (rhodz, qc(i, :, j) + qi(i, :, j) + qs(i, :, j), & + cldfra(i, :, j), kms, kme, kts, kte) + cldfra_h = cldfra_h / q_aux + else + cldfra_h = 0.0 + end if + ! optical thickness water if (re_cloud_path > 0.0) then tau_qv = THREE_OVER_TWO * lwp / re_cloud_path / 1000.0 @@ -154,11 +195,11 @@ subroutine Farms_driver (ims, ime, jms, jme, its, ite, jts, jte, kms, kme, kts, end if beta = aod5502d(i, j) * (1000.0/ 550.0) ** (- angexp2d(i, j)) - - Call Farms (p8w(i, 1, j), albedo(i, j), aerssa2d(i, j), & - aerasy2d(i, j), coszen_loc(i, j), beta, & - angexp2d(i, j), pmw, tau_qv, tau_qi, tau_qs, & - re_cloud_path, re_ice_path, re_snow_path, int(julian), & + + Call Farms (p8w(i, 1, j), albedo(i, j), aerssa2d(i, j), & + aerasy2d(i, j), coszen_loc(i, j), beta, & + angexp2d(i, j), pmw, tau_qv, tau_qi, tau_qs, cldfra_h, & + re_cloud_path, re_ice_path, re_snow_path, int(julian), & swdown2(i, j), swddni2(i, j), swddif2(i, j), swddir2(i, j), & swdownc2(i, j), swddnic2(i, j)) @@ -210,7 +251,7 @@ end function Integrate_2var subroutine FARMS (p_pa, albdo, ssa, g, solarangle, beta, alpha, w_mm, & - tau_qv, tau_qi, tau_qs, re_cloud_path_m, re_ice_path_m, re_snow_path_m, & + tau_qv, tau_qi, tau_qs, cldfra_h, re_cloud_path_m, re_ice_path_m, re_snow_path_m, & juday, ghi, dni, dif, dir, ghi_clear, dni_clear) !!!!!! This Fast All-sky Radiation Model for Solar applications (FARMS) was developed by @@ -248,7 +289,7 @@ subroutine FARMS (p_pa, albdo, ssa, g, solarangle, beta, alpha, w_mm, & implicit none real, intent(in) :: p_pa, albdo, ssa, g, solarangle, beta, alpha, w_mm, & - tau_qv, tau_qi, tau_qs, re_cloud_path_m, re_ice_path_m, re_snow_path_m + tau_qv, tau_qi, tau_qs, re_cloud_path_m, re_ice_path_m, re_snow_path_m, cldfra_h integer, intent(in) :: juday real, intent(out) :: ghi, dni, dir, dif, ghi_clear, dni_clear @@ -355,6 +396,9 @@ subroutine FARMS (p_pa, albdo, ssa, g, solarangle, beta, alpha, w_mm, & ghi = Ftotal ghi_clear = solarangle * F0 * ((Tddclr + Tduclr) / (1.0 - albdo * Ruuclr)) + ghi = cldfra_h * ghi + (1.0 - cldfra_h) * ghi_clear + dni = cldfra_h * dni + (1.0 - cldfra_h) * dni_clear + dif = ghi - dir end subroutine farms diff --git a/phys/module_radiation_driver.F b/phys/module_radiation_driver.F index b8a6b06820..3a57db4c85 100644 --- a/phys/module_radiation_driver.F +++ b/phys/module_radiation_driver.F @@ -2797,8 +2797,9 @@ SUBROUTINE radiation_driver ( & jte = j_end(ij) call farms_driver (ims, ime, jms, jme, its, ite, jts, jte, kms, kme, kts, kte, & p8w, rho, dz8w, albedo, aer_opt, aerssa2d, aerasy2d, aod5502d, angexp2d, & - coszen_loc, qv, qi, qs, qc, re_cloud, re_ice, re_snow, & - julian, swdown2, swddir2, swddni2, swddif2, swdownc2, swddnic2) + coszen_loc, qv, qi, qs, qc, re_cloud, re_ice, re_snow, & + julian, swdown2, swddir2, swddni2, swddif2, swdownc2, swddnic2, & + has_reqc, has_reqi, has_reqs, CLDFRA) enddo !$OMP END PARALLEL DO end if diff --git a/share/module_model_constants.F b/share/module_model_constants.F index d9a31823c7..e4a7b9eb77 100644 --- a/share/module_model_constants.F +++ b/share/module_model_constants.F @@ -63,6 +63,10 @@ MODULE module_model_constants REAL , PARAMETER :: rhowater = 1000. ! density of liquid water at 0^oC (kg m^-3) REAL , PARAMETER :: rhosnow = 100. ! density of snow (kg m^-3) REAL , PARAMETER :: rhoair0 = 1.28 ! density of dry air at 0^oC and 1000mb pressure (kg m^-3) + + REAL , PARAMETER :: RE_QC_BG = 2.49E-6 ! effective radius of cloud for background (m) + REAL , PARAMETER :: RE_QI_BG = 4.99E-6 ! effective radius of ice for background (m) + REAL , PARAMETER :: RE_QS_BG = 9.99E-6 ! effective radius of snow for background (m) ! ! Now namelist-specified parameter: ccn_conc - RAS ! REAL , PARAMETER :: n_ccn0 = 1.0E8 From ac76162f34869ca50b2812cc3646575d89c00f9e Mon Sep 17 00:00:00 2001 From: Marc Honnorat Date: Fri, 23 Oct 2020 19:31:03 +0200 Subject: [PATCH 08/36] Fix MPI synchronization in real namelist processing (#1299) TYPE: bug fix KEYWORDS: mpi, real, bug SOURCE: Marc Honnorat (EXWEXs) DESCRIPTION OF CHANGES: Problem: When running real.exe on multiple processes with MPI, one or more process occasionally crashes in setup_physics_suite (in share/module_check_a_mundo.F). This has been linked to wrf_dm_initialize non-blocking MPI. The real.exe occasionally crashes in setup_physics_suite (in share/module_check_a_mundo.F#L2640) because the latter uses model_config_rec % physics_suite, which on some machines is not initialized. The behavior is as if the broadcast of model_config_rec performed just before in main/real_em.F#L124 had not been received by all processes. I had never seen this bug before, it has only happened on one machine (an Intel-based cluster using Intel-MPI and ifort). The current fix makes sure that all processes are well synced before proceeding with setup_physics_suite. It solves the issue on my machine. Since this is immediately after reading in the namelist, no performance issues are expected as this read and broadcast of the namelist occurs only once per real / WRF / ndown run. Solution: An MPI barrier is added at the end of wrf_dm_initialize to force all of the processes to be synchronized before checking the namelist consistency. This is a simplification of PR #1268, which had extra white space. ISSUE: Fixes #1267 LIST OF MODIFIED FILES: M external/RSL_LITE/module_dm.F TESTS CONDUCTED: 1. On the only machine were I have seen the bug occur, this change fixes the problem. No other test was conducted since I couldn't reproduce the bug on another setup. 2. Jenkins testing is all PASS. RELEASE NOTES: When running real.exe on multiple processes with MPI, one or more processes occasionally crash in setup_physics_suite (in share/module_check_a_mundo.F). This has been traced to the fact that wrf_dm_initialize is non-blocking from an MPI point of view. The problem is intermittent and has only happened on one machine (an Intel-based cluster using Intel-MPI and ifort). An MPI barrier has been added at the end of wrf_dm_initialize to force all processes to be synchronized before checking namelist consistency. --- external/RSL_LITE/module_dm.F | 3 +++ 1 file changed, 3 insertions(+) diff --git a/external/RSL_LITE/module_dm.F b/external/RSL_LITE/module_dm.F index eb8bacb4b9..9527805e97 100644 --- a/external/RSL_LITE/module_dm.F +++ b/external/RSL_LITE/module_dm.F @@ -228,6 +228,9 @@ SUBROUTINE wrf_dm_initialize CALL nl_set_nproc_y ( 1, ntasks_y ) WRITE( wrf_err_message , * )'Ntasks in X ',ntasks_x,', ntasks in Y ',ntasks_y CALL wrf_message( wrf_err_message ) +#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) ) + CALL MPI_BARRIER( local_communicator, ierr ) +#endif RETURN END SUBROUTINE wrf_dm_initialize From be098d96a9f2d6e48d6ca473485ea3425f5c8a5e Mon Sep 17 00:00:00 2001 From: Ted Mansell <37668594+MicroTed@users.noreply.github.com> Date: Fri, 23 Oct 2020 12:32:39 -0500 Subject: [PATCH 09/36] Fix horizontal advection flag usage when "mom" != "sca" (#1302) TYPE: bug fix KEYWORDS: HALO, h_mom_adv_order SOURCE: Ted Mansell (NOAA/NSSL) DESCRIPTION OF CHANGES: Problem: The halo exchange (used during distributed memory communication) had inconsistent use of `h_mom_adv_order`. There are locations when the namelist option to check should have `h_sca_adv_order`, and even a couple cases where the code should have tested both. Consequently, the MPI results did not match for different number of patches or processor counts if `h_mom_adv_order=3` and `h_sca_adv_order=5`. This problem only occurs when the advection order differs between the momentum and scalar variables. Solution: These changes (using the correct variable to test, or using both `h_mom_adv_order` and `h_sca_adv_order`) fix the problem of non-reproducibility on different core counts (where non-reproducibility means "wrong answers"). Also, a few of the halo exchanges in solve_em need to check both the momentum and scalar flags, since both types are communicated in the subroutine call. LIST OF MODIFIED FILES: dyn_em/module_first_rk_step_part1.F dyn_em/module_first_rk_step_part2.F dyn_em/solve_em.F TESTS CONDUCTED: 1. Jenkins testing is all PASS Tested ideal case (em_quarter_ss) on 4 vs 1 processes, with the following advection orders: - h_mom_adv_order=3 - h_sca_adv_order=5 2. Without changes, diffwrf found differences. 3. After changes the wrfout files match exactly. (Also tested for h_mom_adv_order=5, h_sca_adv_order=3) RELEASE NOTES: The halo exchange (used during distributed memory communication) had inconsistent use of h_mom_adv_order. There are locations in the ARW dynamics solver when the namelist option to check should have been h_sca_adv_order, and even a couple cases where the IF tests should have tested both options (both h_mom_adv_order and h_sca_adv_order). Consequently, the model results did not match bit-for-bit for differing numbers processors (when the advection order differed between the momentum and scalar variables). These IF-test changes (using the correct namelist option to compare, or possibly using both the h_mom_adv_order and h_sca_adv_order options) fix the problem of non-reproducibility due to the advection order. This problem only occurs when the advection order differs between the momentum and scalar variables. --- dyn_em/module_first_rk_step_part1.F | 10 ++--- dyn_em/module_first_rk_step_part2.F | 6 +-- dyn_em/solve_em.F | 67 +++++++++++++++-------------- 3 files changed, 43 insertions(+), 40 deletions(-) diff --git a/dyn_em/module_first_rk_step_part1.F b/dyn_em/module_first_rk_step_part1.F index bcd346f49b..ae0a7f1388 100644 --- a/dyn_em/module_first_rk_step_part1.F +++ b/dyn_em/module_first_rk_step_part1.F @@ -1097,8 +1097,8 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags & ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN # include "HALO_EM_CHEM_E_5.inc" ELSE - WRITE(message,*)'solve_em: invalid h_mom_adv_order = ',& - & config_flags%h_mom_adv_order + WRITE(message,*)'solve_em: invalid h_sca_adv_order = ',& + & config_flags%h_sca_adv_order ENDIF ENDIF #endif @@ -1421,12 +1421,12 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags & #ifdef DM_PARALLEL IF( config_flags%shcu_physics == CAMUWSHCUSCHEME ) THEN CALL wrf_debug ( 200 , ' call HALO CHEM AFTER SHALLOW CUMULUS' ) - IF ( config_flags%h_mom_adv_order <= 4 ) THEN + IF ( config_flags%h_sca_adv_order <= 4 ) THEN # include "HALO_EM_CHEM_E_3.inc" - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN + ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN # include "HALO_EM_CHEM_E_5.inc" ELSE - WRITE(message,*)'module_first_rk_step_part1: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + WRITE(message,*)'module_first_rk_step_part1: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order CALL wrf_error_fatal(TRIM(message)) ENDIF ENDIF diff --git a/dyn_em/module_first_rk_step_part2.F b/dyn_em/module_first_rk_step_part2.F index 009b09fca6..518592858f 100644 --- a/dyn_em/module_first_rk_step_part2.F +++ b/dyn_em/module_first_rk_step_part2.F @@ -689,12 +689,12 @@ SUBROUTINE first_rk_step_part2 ( grid , config_flags & # include "HALO_EM_PHYS_DIFFUSION.inc" ENDIF - IF ( config_flags%h_mom_adv_order <= 4 ) THEN + IF ( config_flags%h_sca_adv_order <= 4 ) THEN # include "HALO_EM_TKE_3.inc" - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN + ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN # include "HALO_EM_TKE_5.inc" ELSE - WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order CALL wrf_error_fatal(TRIM(wrf_err_message)) ENDIF #endif diff --git a/dyn_em/solve_em.F b/dyn_em/solve_em.F index 0fe7edebdd..6b2aca6064 100644 --- a/dyn_em/solve_em.F +++ b/dyn_em/solve_em.F @@ -320,7 +320,7 @@ SUBROUTINE solve_em ( grid , config_flags & ! see matching halo calls below for stencils !-------------------------------------------------------------- CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' ) - IF ( config_flags%h_mom_adv_order <= 4 ) THEN + IF ( config_flags%h_sca_adv_order <= 4 ) THEN # include "HALO_EM_CHEM_E_3.inc" IF( config_flags%progn > 0 ) THEN # include "HALO_EM_SCALAR_E_3.inc" @@ -328,7 +328,7 @@ SUBROUTINE solve_em ( grid , config_flags & IF( config_flags%cu_physics == CAMZMSCHEME ) THEN # include "HALO_EM_SCALAR_E_3.inc" ENDIF - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN + ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN # include "HALO_EM_CHEM_E_5.inc" IF( config_flags%cu_physics == CAMZMSCHEME ) THEN # include "HALO_EM_SCALAR_E_5.inc" @@ -337,7 +337,7 @@ SUBROUTINE solve_em ( grid , config_flags & # include "HALO_EM_SCALAR_E_5.inc" ENDIF ELSE - WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order CALL wrf_error_fatal(TRIM(wrf_err_message)) ENDIF ENDIF @@ -346,12 +346,12 @@ SUBROUTINE solve_em ( grid , config_flags & ! see matching halo calls below for stencils !-------------------------------------------------------------- CALL wrf_debug ( 200 , ' call HALO_RK_tracer' ) - IF ( config_flags%h_mom_adv_order <= 4 ) THEN + IF ( config_flags%h_sca_adv_order <= 4 ) THEN # include "HALO_EM_TRACER_E_3.inc" - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN + ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN # include "HALO_EM_TRACER_E_5.inc" ELSE - WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order CALL wrf_error_fatal(TRIM(wrf_err_message)) ENDIF ENDIF @@ -2288,12 +2288,12 @@ SUBROUTINE solve_em ( grid , config_flags & BENCH_START(tke_adv_tim) TKE_advance: IF (config_flags%km_opt .eq. 2.or.config_flags%km_opt.eq.5) then ! XZ #ifdef DM_PARALLEL - IF ( config_flags%h_mom_adv_order <= 4 ) THEN + IF ( config_flags%h_sca_adv_order <= 4 ) THEN # include "HALO_EM_TKE_ADVECT_3.inc" - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN + ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN # include "HALO_EM_TKE_ADVECT_5.inc" ELSE - WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order CALL wrf_error_fatal(TRIM(wrf_err_message)) ENDIF #endif @@ -3116,12 +3116,13 @@ SUBROUTINE solve_em ( grid , config_flags & ! scalar x #ifdef DM_PARALLEL - IF ( config_flags%h_mom_adv_order <= 4 ) THEN + IF ( config_flags%h_mom_adv_order <= 4 .and. config_flags%h_sca_adv_order <= 4 ) THEN # include "HALO_EM_D2_3.inc" - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN + ELSE IF ( config_flags%h_mom_adv_order <= 6 .and. config_flags%h_sca_adv_order <= 6 ) THEN # include "HALO_EM_D2_5.inc" ELSE - WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order or h_sca_adv_order = ', & + config_flags%h_mom_adv_order, config_flags%h_sca_adv_order CALL wrf_error_fatal(TRIM(wrf_err_message)) ENDIF # include "PERIOD_BDY_EM_D.inc" @@ -3252,13 +3253,13 @@ SUBROUTINE solve_em ( grid , config_flags & ! moist, chem, scalar, tke x - IF ( config_flags%h_mom_adv_order <= 4 ) THEN + IF ( config_flags%h_sca_adv_order <= 4 ) THEN IF ( (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN # include "HALO_EM_TKE_5.inc" ELSE # include "HALO_EM_TKE_3.inc" ENDIF - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN + ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN IF ( (config_flags%tke_adv_opt /= ORIGINAL .and. config_flags%tke_adv_opt /= WENO_SCALAR) .and. (rk_step == rk_order-1) ) THEN # include "HALO_EM_TKE_7.inc" ELSE @@ -4264,12 +4265,13 @@ SUBROUTINE solve_em ( grid , config_flags & #ifdef DM_PARALLEL - IF ( config_flags%h_mom_adv_order <= 4 ) THEN + IF ( config_flags%h_mom_adv_order <= 4 .and. config_flags%h_sca_adv_order <= 4 ) THEN # include "HALO_EM_D3_3.inc" - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN + ELSE IF ( config_flags%h_mom_adv_order <= 6 .and. config_flags%h_sca_adv_order <= 6 ) THEN # include "HALO_EM_D3_5.inc" ELSE - WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order or h_sca_adv_order = ', & + config_flags%h_mom_adv_order, config_flags%h_sca_adv_order CALL wrf_error_fatal(TRIM(wrf_err_message)) ENDIF # include "PERIOD_BDY_EM_D3.inc" @@ -4609,12 +4611,13 @@ SUBROUTINE solve_em ( grid , config_flags & ! see above !-------------------------------------------------------------- CALL wrf_debug ( 200 , ' call HALO_RK_E' ) - IF ( config_flags%h_mom_adv_order <= 4 ) THEN + IF ( config_flags%h_mom_adv_order <= 4 .and. config_flags%h_sca_adv_order <= 4 ) THEN # include "HALO_EM_E_3.inc" - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN + ELSE IF ( config_flags%h_mom_adv_order <= 6 .and. config_flags%h_sca_adv_order <= 6 ) THEN # include "HALO_EM_E_5.inc" ELSE - WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order or h_sca_adv_order = ', & + config_flags%h_mom_adv_order, config_flags%h_sca_adv_order CALL wrf_error_fatal(TRIM(wrf_err_message)) ENDIF #endif @@ -4625,12 +4628,12 @@ SUBROUTINE solve_em ( grid , config_flags & ! see above !-------------------------------------------------------------- CALL wrf_debug ( 200 , ' call HALO_RK_MOIST' ) - IF ( config_flags%h_mom_adv_order <= 4 ) THEN + IF ( config_flags%h_sca_adv_order <= 4 ) THEN # include "HALO_EM_MOIST_E_3.inc" - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN + ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN # include "HALO_EM_MOIST_E_5.inc" ELSE - WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order CALL wrf_error_fatal(TRIM(wrf_err_message)) ENDIF ENDIF @@ -4639,12 +4642,12 @@ SUBROUTINE solve_em ( grid , config_flags & ! see above !-------------------------------------------------------------- CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' ) - IF ( config_flags%h_mom_adv_order <= 4 ) THEN + IF ( config_flags%h_sca_adv_order <= 4 ) THEN # include "HALO_EM_CHEM_E_3.inc" - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN + ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN # include "HALO_EM_CHEM_E_5.inc" ELSE - WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order CALL wrf_error_fatal(TRIM(wrf_err_message)) ENDIF ENDIF @@ -4653,12 +4656,12 @@ SUBROUTINE solve_em ( grid , config_flags & ! see above !-------------------------------------------------------------- CALL wrf_debug ( 200 , ' call HALO_RK_TRACER' ) - IF ( config_flags%h_mom_adv_order <= 4 ) THEN + IF ( config_flags%h_sca_adv_order <= 4 ) THEN # include "HALO_EM_TRACER_E_3.inc" - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN + ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN # include "HALO_EM_TRACER_E_5.inc" ELSE - WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order CALL wrf_error_fatal(TRIM(wrf_err_message)) ENDIF ENDIF @@ -4667,12 +4670,12 @@ SUBROUTINE solve_em ( grid , config_flags & ! see above !-------------------------------------------------------------- CALL wrf_debug ( 200 , ' call HALO_RK_SCALAR' ) - IF ( config_flags%h_mom_adv_order <= 4 ) THEN + IF ( config_flags%h_sca_adv_order <= 4 ) THEN # include "HALO_EM_SCALAR_E_3.inc" - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN + ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN # include "HALO_EM_SCALAR_E_5.inc" ELSE - WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order CALL wrf_error_fatal(TRIM(wrf_err_message)) ENDIF ENDIF From 28c18eee39cf323acaf2705543a4e1090b7b9abb Mon Sep 17 00:00:00 2001 From: Srikanth Yalavarthi Date: Fri, 23 Oct 2020 23:05:43 +0530 Subject: [PATCH 10/36] Temporary fix for gfortran/10 compiler argument mismatches (#1251) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit TYPE: bug fix KEYWORDS: gfortran/10 SOURCE: Srikanth Yalavarthi (Marvell Semiconductor) DESCRIPTION OF CHANGES: Problem: Due to argument inconsistencies, the WRF code will not compile with gfortran/10. Here are some examples of incorrect Fortran argument usages: ``` Error: Rank mismatch between actual argument at (1) and actual argument at (2) (rank-1 and scalar) wrf_io.f:7605:71: 7605 | ,i1,i2,j1,j2,k1,k2 ) | 1 ``` ``` Error: Type mismatch in argument ‘field’ at (1); passed INTEGER(4) to REAL(8) wrf_io.f:7744:49: 2538 | stat = NF_GET_ATT_INT (DH%NCID,NF_GLOBAL,Element,Buffer) | 2 ...... 7744 | stat = NF_GET_ATT_INT(NCID,VarID,'FieldType',FType) | 1 ``` ``` Error: Rank mismatch between actual argument at (1) and actual argument at (2) (scalar and rank-3) field_routines.f:158:52: 110 | stat = NF_GET_VARA_INT(NCID,VarID,VStart,VCount,Data) | 2 ...... 158 | stat = NF_GET_VARA_INT(NCID,VarID,VStart,VCount,Buffer) | 1 ``` ``` Error: Rank mismatch in argument ‘fileindex’ at (1) (scalar and rank-1) io_grib1.f90:685:27: 685 | CALL gr1_fill_eta_levels(fileinfo(DataHandle)%fileindex(:), FileFd(DataHandle), & | 1 ``` ``` Error: Type mismatch between actual argument at (1) and actual argument at (2) (INTEGER(4)/REAL(4)). module_internal_header_util.f:1592:39: 1592 | DataHandle, Data, Count, code ) | 1 ...... 1654 | DataHandle, Data, Count, code ) | 2 ``` ``` Error: Rank mismatch between actual argument at (1) and actual argument at (2) (rank-1 and scalar) module_io_int_read.f:129:39: 129 | call mpi_file_read_at(ifd, offset, tmp, 1, & | 1 ...... 573 | call mpi_file_read_at(ifd, offset, tmp, num, & | 2 ``` ``` Error: Type mismatch between actual argument at (1) and actual argument at (2) (REAL(8)/COMPLEX(8)). zmfm1b.f90:74:38: 72 | call zmf3kb ( lot, ido, l1, na, c, jump, inc, ch, 1, lot, wa(iw) ) | 2 73 | else if ( nbr == 4 ) then 74 | call zmf3kb ( lot, ido, l1, na, ch, 1, lot, c, jump, inc, wa(iw) ) | 1 ``` The errors in the WRF infrastructure code can be eventually updated. However, the code from the FFTPACK library will be left AS-IS. We are going to initially address all of the problems in a temporary fashion. Temporary solution: A compiler flag was added for the gfortran compiler to allow mismatched arguments, which enables the WRF system to build. The new flag is only for versions of gfortran 10 and later. This change was introduced in the configure script, which modifies all gfortran stanzas. Permanent fix: A complete fix requires changes in the Fortran sources for BOZ declarations and to fix mismatches in subroutine arguments. ISSUE: Fixes #1250 LIST OF MODIFIED FILES: M Makefile M arch/configure.defaults M configure TESTS CONDUCTED: 1. Successfully built the master branch with GCC-10 on RPi4 Ubuntu-20.04 machine 2. Logic tested, where only GNU 10 and above are impacted. 3. Other compilers are not affected. 4. Jenkins testing is OK. 5. The DA variants have been tested also: I could build WRF / WRFPLUS / 3DVAR / 4DVAR ``` [00:01] [syalavarthi@sparrow WRF]$./configure wrfda && ./compile all_wrfvar && ls var/build/*.exe var/build/da_advance_time.exe var/build/da_tune_obs_hollingsworth1.exe var/build/gen_be_addmean.exe var/build/gen_be_diags.exe var/build/gen_be_hist.exe var/build/gen_be_stage2_1dvar.exe var/build/gen_mbe_stage2.exe var/build/da_bias_airmass.exe var/build/da_tune_obs_hollingsworth2.exe var/build/gen_be_cov2d.exe var/build/gen_be_diags_read.exe var/build/gen_be_stage0_gsi.exe var/build/gen_be_stage2_gsi.exe var/build/da_bias_scan.exe var/build/da_update_bc.exe var/build/gen_be_cov2d3d_contrib.exe var/build/gen_be_ensmean.exe var/build/gen_be_stage0_wrf.exe var/build/gen_be_stage2a.exe var/build/da_bias_sele.exe var/build/da_update_bc_ad.exe var/build/gen_be_cov3d.exe var/build/gen_be_ensrf.exe var/build/gen_be_stage1.exe var/build/gen_be_stage3.exe var/build/da_bias_verif.exe var/build/da_verif_grid.exe var/build/gen_be_cov3d2d_contrib.exe var/build/gen_be_ep1.exe var/build/gen_be_stage1_1dvar.exe var/build/gen_be_stage4_global.exe var/build/da_rad_diags.exe var/build/da_verif_obs.exe var/build/gen_be_cov3d3d_bin3d_contrib.exe var/build/gen_be_ep2.exe var/build/gen_be_stage1_gsi.exe var/build/gen_be_stage4_regional.exe var/build/da_tune_obs_desroziers.exe var/build/da_wrfvar.exe var/build/gen_be_cov3d3d_contrib.exe var/build/gen_be_etkf.exe var/build/gen_be_stage2.exe var/build/gen_be_vertloc.exe [00:10] [syalavarthi@sparrow WRF]$ [06:40] [syalavarthi@sparrow WRFPLUS]$./configure wrfplus && ./compile wrfplus && ls main/*.exe main/wrfplus.exe [07:16] [syalavarthi@sparrow WRF]$./configure 4dvar && ./compile all_wrfvar && ls var/build/*.exe var/build/da_advance_time.exe var/build/da_tune_obs_hollingsworth1.exe var/build/gen_be_addmean.exe var/build/gen_be_diags.exe var/build/gen_be_hist.exe var/build/gen_be_stage2_1dvar.exe var/build/gen_mbe_stage2.exe var/build/da_bias_airmass.exe var/build/da_tune_obs_hollingsworth2.exe var/build/gen_be_cov2d.exe var/build/gen_be_diags_read.exe var/build/gen_be_stage0_gsi.exe var/build/gen_be_stage2_gsi.exe var/build/da_bias_scan.exe var/build/da_update_bc.exe var/build/gen_be_cov2d3d_contrib.exe var/build/gen_be_ensmean.exe var/build/gen_be_stage0_wrf.exe var/build/gen_be_stage2a.exe var/build/da_bias_sele.exe var/build/da_update_bc_ad.exe var/build/gen_be_cov3d.exe var/build/gen_be_ensrf.exe var/build/gen_be_stage1.exe var/build/gen_be_stage3.exe var/build/da_bias_verif.exe var/build/da_verif_grid.exe var/build/gen_be_cov3d2d_contrib.exe var/build/gen_be_ep1.exe var/build/gen_be_stage1_1dvar.exe var/build/gen_be_stage4_global.exe var/build/da_rad_diags.exe var/build/da_verif_obs.exe var/build/gen_be_cov3d3d_bin3d_contrib.exe var/build/gen_be_ep2.exe var/build/gen_be_stage1_gsi.exe var/build/gen_be_stage4_regional.exe var/build/da_tune_obs_desroziers.exe var/build/da_wrfvar.exe var/build/gen_be_cov3d3d_contrib.exe var/build/gen_be_etkf.exe var/build/gen_be_stage2.exe var/build/gen_be_vertloc.exe ``` RELEASE NOTE: Due to subroutine and function argument inconsistencies, the WRF code will not compile with gfortran/10. The fix introduces a new compiler flag for all gfortran stanzas (`-fallow-argument-mismatch -fallow-invalid-boz`). --- Makefile | 2 +- arch/configure.defaults | 18 ++++++++++++------ configure | 19 +++++++++++++++++++ 3 files changed, 32 insertions(+), 7 deletions(-) diff --git a/Makefile b/Makefile index 9b6600acf7..8e2da2a1fa 100644 --- a/Makefile +++ b/Makefile @@ -151,7 +151,7 @@ all_wrfvar : fi if [ $(BUFR) ] ; then \ (cd var/external/bufr; \ - $(MAKE) $(J) FC="$(SFC)" CC="$(SCC)" CPP="$(CPP)" CPPFLAGS="$(CPPFLAGS)" CFLAGS="$(CFLAGS)" FFLAGS="$(FCOPTIM) $(FORMAT_FIXED)" RANLIB="$(RANLIB)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" ) ; \ + $(MAKE) $(J) FC="$(SFC)" CC="$(SCC)" CPP="$(CPP)" CPPFLAGS="$(CPPFLAGS)" CFLAGS="$(CFLAGS)" FFLAGS="$(FCOPTIM) $(FORMAT_FIXED) $(FCCOMPAT)" RANLIB="$(RANLIB)" AR="$(AR)" ARFLAGS="$(ARFLAGS)" ) ; \ fi ### Use 'make' to avoid '-i -r' above: if [ $(WAVELET) ] ; then \ diff --git a/arch/configure.defaults b/arch/configure.defaults index 90983753e8..140ebf7b1c 100644 --- a/arch/configure.defaults +++ b/arch/configure.defaults @@ -73,8 +73,9 @@ FCDEBUG = # -g $(FCNOOPT) # -fbacktrace -ggdb -fcheck=bounds,do,m FORMAT_FIXED = -ffixed-form FORMAT_FREE = -ffree-form -ffree-line-length-none FCSUFFIX = +FCCOMPAT = BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 -FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) +FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(FCCOMPAT) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = TRADFLAG = CONFIGURE_TRADFLAG @@ -785,8 +786,9 @@ FCDEBUG = # -g $(FCNOOPT) # -ggdb -fbacktrace -fcheck=bounds,do,me FORMAT_FIXED = -ffixed-form FORMAT_FREE = -ffree-form -ffree-line-length-none FCSUFFIX = +FCCOMPAT = BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 -FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) +FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(FCCOMPAT) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = TRADFLAG = CONFIGURE_TRADFLAG @@ -1006,8 +1008,9 @@ FCDEBUG = # -g $(FCNOOPT) # -fbacktrace -ggdb -fcheck=bounds,do,me FORMAT_FIXED = -ffixed-form FORMAT_FREE = -ffree-form -ffree-line-length-none FCSUFFIX = +FCCOMPAT = BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 -FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) +FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(FCCOMPAT) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = TRADFLAG = CONFIGURE_TRADFLAG @@ -1049,8 +1052,9 @@ FCDEBUG = # -g $(FCNOOPT) # -fbacktrace -ggdb -fcheck=bounds,do,me FORMAT_FIXED = -ffixed-form FORMAT_FREE = -ffree-form -ffree-line-length-none FCSUFFIX = +FCCOMPAT = BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 -FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) +FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(FCCOMPAT) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = TRADFLAG = CONFIGURE_TRADFLAG @@ -1772,8 +1776,9 @@ FCDEBUG = # -g $(FCNOOPT) # -fbacktrace -ggdb -fcheck=bounds,do,me FORMAT_FIXED = -ffixed-form FORMAT_FREE = -ffree-form -ffree-line-length-none FCSUFFIX = +FCCOMPAT = BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 -FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) +FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(FCCOMPAT) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = TRADFLAG = CONFIGURE_TRADFLAG @@ -1946,8 +1951,9 @@ FCDEBUG = # -g $(FCNOOPT) # -ggdb -fbacktrace FORMAT_FIXED = -ffixed-form FORMAT_FREE = -ffree-form -ffree-line-length-none FCSUFFIX = +FCCOMPAT = BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 -FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) +FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(FCCOMPAT) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = TRADFLAG = -traditional diff --git a/configure b/configure index c4fc28b0ab..ed9f10c2f4 100755 --- a/configure +++ b/configure @@ -685,6 +685,25 @@ if [ $os = "Linux" -o $os = "Darwin" ]; then foo=foo_$$ + grep '^SFC' configure.wrf | grep -i 'gfortran' > /dev/null + if [ $? ] + then + + cat > ${foo}.F << EOF + PROGRAM GFORTRAN_VERSION_CHECK + IF (__GNUC__ .GT. 9) CALL EXIT(1) + END PROGRAM +EOF + + gfortran -o ${foo} ${foo}.F > /dev/null 2>&1 && ./${foo} + if [ $? -eq 1 ] + then + sed '/^FCCOMPAT/ s/$/ -fallow-argument-mismatch -fallow-invalid-boz/' configure.wrf > configure.wrf.edit + mv configure.wrf.edit configure.wrf + fi + rm ${foo} ${foo}.F 2> /dev/null + fi + cat > ${foo}.c < Date: Fri, 23 Oct 2020 11:59:16 -0600 Subject: [PATCH 11/36] Fixes occasional inestabilities in surface layer option 1 (#1286) TYPE: bug fix KEYWORDS: occasional instabilities, sfclayrev, look up tables SOURCE: Pedro A. Jimenez (NCAR/RAL) DESCRIPTION OF CHANGES: Problem: For some occasions the model turns unstable, and this was found to be originating due to the surface layer option 1, with the upper boundary values of the look up tables. Solution: Avoiding using the look up tables of the integrated similarity functions for the last tabulated value. LIST OF MODIFIED FILES: M phys/module_sf_sfclayrev.F TESTS CONDUCTED: After introducing the fix the model no longer turns unstable in the specific instances noted. The jenkins tests are all PASS. RELEASE NOTE: A minor fix (excluding use of the upper bounding value of the look-up table) was introduced to avoid occasional instabilities in the surface layer option 1. --- phys/module_sf_sfclayrev.F | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/phys/module_sf_sfclayrev.F b/phys/module_sf_sfclayrev.F index 76574cc115..6f9c30f9c5 100644 --- a/phys/module_sf_sfclayrev.F +++ b/phys/module_sf_sfclayrev.F @@ -1202,7 +1202,7 @@ function psim_stable(zolf) real :: rzol 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 psim_stable = psim_stable_full(zolf) @@ -1215,7 +1215,7 @@ function psih_stable(zolf) real :: rzol 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 psih_stable = psih_stable_full(zolf) @@ -1228,7 +1228,7 @@ function psim_unstable(zolf) real :: rzol 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 psim_unstable = psim_unstable_full(zolf) @@ -1241,7 +1241,7 @@ function psih_unstable(zolf) real :: rzol 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 psih_unstable = psih_unstable_full(zolf) From ad348f51bade3e98b6ef565b5ad36198f796af2e Mon Sep 17 00:00:00 2001 From: ZheZhang Date: Fri, 23 Oct 2020 12:01:33 -0600 Subject: [PATCH 12/36] Enhancement for crop-specific parameters in Noah-MP-Crop (#1256) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit TYPE: Enhancement KEYWORDS: Noah-MP-Crop, specific-crop, parameters, photosynthesis, stomata SOURCE: Zhe Zhang (University of Saskatchewan) DESCRIPTION OF CHANGES: The current release WRF-Crop option 1, (Liu Xing's model), uses generic-crop parameters in stomata subroutine, to calculate photosynthesis and stomata resistance, regardless of crop type. Also some parameters in the crop parameters in MPTABLE.TBL, the first and second columns for corn and soybean are not consistent with the values used in Xing's paper. This pull request fixes the parameter values for these two columns in the crop parameter section in MPTABLE.TBL, as well as adds specific-crop photosynthesis-stomata parameters in this section. LIST OF MODIFIED FILES: phys/module_sf_noahmplsm.F phys/module_sf_noahmpdrv.F run/MPTABLE.TBL TESTS CONDUCTED: Coupled WRF-Crop simulation is conducted on Cheyenne. The results seem reasonable in terms of crop LAI and biomass. Presented these results with the Noah-MP LSM group meeting with Dr. Fei Chen. Jenkins testing is all PASS. RELEASE NOTE: Incorporate specific-crop parameters for photosynthesis and stomata subroutine in Noah-MP-Crop. The current release WRF-Crop option 1, (Liu Xing's model), uses generic-crop parameters in stomata subroutine, to calculate photosynthesis and stomata resistance, regardless of crop type. Also some parameters in the crop parameters in MPTABLE.TBL, the first and second columns for corn and soybean are not consistent with the values used in Xing's paper. This update fixes the parameter values for these two columns in the crop parameter section in MPTABLE.TBL, as well as adds specific-crop photosynthesis-stomata parameters in this section. Zhang, Z., Barlage, M., Chen, F., Li, Y., Helgason, W., Xu, X., et al. (2020). Joint modeling of crop and irrigation in the Central United States using the Noah‐MP land surface model. Journal of Advances in Modeling Earth Systems. https://doi.org/10.1029/2020MS002159 --- phys/module_sf_noahmpdrv.F | 18 +++++- phys/module_sf_noahmplsm.F | 118 +++++++++++++++++++++++++++++++++---- run/MPTABLE.TBL | 106 ++++++++++++++++++++++----------- 3 files changed, 195 insertions(+), 47 deletions(-) diff --git a/phys/module_sf_noahmpdrv.F b/phys/module_sf_noahmpdrv.F index f77b959845..594ce4c49e 100644 --- a/phys/module_sf_noahmpdrv.F +++ b/phys/module_sf_noahmpdrv.F @@ -1161,6 +1161,17 @@ SUBROUTINE TRANSFER_MP_PARAMETERS(VEGTYPE,SOILTYPE,SLOPETYPE,SOILCOLOR,CROPTYPE, 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%C3PSN = C3PSNI_TABLE(CROPTYPE) ! parameters from stomata ! Zhe Zhang 2020-07-13 + parameters%KC25 = KC25I_TABLE(CROPTYPE) + parameters%AKC = AKCI_TABLE(CROPTYPE) + parameters%KO25 = KO25I_TABLE(CROPTYPE) + parameters%AKO = AKOI_TABLE(CROPTYPE) + parameters%AVCMX = AVCMXI_TABLE(CROPTYPE) + parameters%VCMX25 = VCMX25I_TABLE(CROPTYPE) + parameters%BP = BPI_TABLE(CROPTYPE) + parameters%MP = MPI_TABLE(CROPTYPE) + parameters%FOLNMX = FOLNMXI_TABLE(CROPTYPE) + parameters%QE25 = QE25I_TABLE(CROPTYPE) ! ends here 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) (caused by non-modeling part,e.g.pest,weeds) @@ -1187,6 +1198,9 @@ SUBROUTINE TRANSFER_MP_PARAMETERS(VEGTYPE,SOILTYPE,SLOPETYPE,SOILCOLOR,CROPTYPE, 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%LFCT = LFCT_TABLE(CROPTYPE,:) ! fraction of translocation to grain ! Zhe Zhang 2020-07-13 + parameters%STCT = STCT_TABLE(CROPTYPE,:) ! fraction of translocation to grain + parameters%RTCT = RTCT_TABLE(CROPTYPE,:) ! fraction of translocation to grain parameters%BIO2LAI = BIO2LAI_TABLE(CROPTYPE) ! leaf are per living leaf biomass [m^2/kg] END IF @@ -1728,7 +1742,7 @@ SUBROUTINE NOAHMP_INIT ( MMINLU, SNOW , SNOWH , CANWAT , ISLTYP , IVGTYP, XLAT croptype(i,1,j) > croptype(i,4,j) ) then ! choose corn cropcat (i,j) = 1 - lfmassxy(i,j) = lai(i,j)/0.035 + lfmassxy(i,j) = lai(i,j)/0.015 ! Initialize lfmass Zhe Zhang 2020-07-13 stmassxy(i,j) = xsaixy(i,j)/0.003 elseif(croptype(i,2,j) > croptype(i,1,j) .and. & @@ -1736,7 +1750,7 @@ SUBROUTINE NOAHMP_INIT ( MMINLU, SNOW , SNOWH , CANWAT , ISLTYP , IVGTYP, XLAT croptype(i,2,j) > croptype(i,4,j) ) then ! choose soybean cropcat (i,j) = 2 - lfmassxy(i,j) = lai(i,j)/0.015 + lfmassxy(i,j) = lai(i,j)/0.030 ! Initialize lfmass Zhe Zhang 2020-07-13 stmassxy(i,j) = xsaixy(i,j)/0.003 else diff --git a/phys/module_sf_noahmplsm.F b/phys/module_sf_noahmplsm.F index 9686a403c6..d0d557b55e 100644 --- a/phys/module_sf_noahmplsm.F +++ b/phys/module_sf_noahmplsm.F @@ -346,6 +346,9 @@ MODULE MODULE_SF_NOAHMPLSM REAL :: LFPT(NSTAGE) ! fraction of carbohydrate flux to leaf REAL :: STPT(NSTAGE) ! fraction of carbohydrate flux to stem REAL :: RTPT(NSTAGE) ! fraction of carbohydrate flux to root + REAL :: LFCT(NSTAGE) ! fraction of carbohydrate flux transallocate from leaf to grain ! Zhe Zhang 2020-07-13 + REAL :: STCT(NSTAGE) ! fraction of carbohydrate flux transallocate from stem to grain + REAL :: RTCT(NSTAGE) ! fraction of carbohydrate flux transallocate from root to grain REAL :: GRAINPT(NSTAGE) ! fraction of carbohydrate flux to grain REAL :: BIO2LAI ! leaf are per living leaf biomass [m^2/kg] @@ -8589,6 +8592,7 @@ SUBROUTINE CO2FLUX_CROP (parameters, REAL :: STMSMN REAL :: SAPM !stem area per unit mass (m2/g) REAL :: DIEST + REAL :: LFCONVERT !leaf to grain conversion ! Zhe Zhang 2020-07-13 REAL :: STCONVERT !stem to grain conversion [g/m2/s] REAL :: RTCONVERT !root to grain conversion [g/m2/s] ! -------------------------- constants ------------------------------- @@ -8691,15 +8695,23 @@ SUBROUTINE CO2FLUX_CROP (parameters, GPP = CBHYDRAFX* 0.4 !!g/m2/s C 0.4=12/30, CH20 to C + LFCONVERT = 0.0 ! Zhe Zhang 2020-07-13 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 + LFCONVERT = LFMASS*(parameters%LFCT(PGS)*DT/3600.0) + STCONVERT = STMASS*(parameters%STCT(PGS)*DT/3600.0) + RTCONVERT = RTMASS*(parameters%RTCT(PGS)*DT/3600.0) + LFMASS = LFMASS - LFCONVERT + STMASS = STMASS - STCONVERT + RTMASS = RTMASS - RTCONVERT + GRAIN = GRAIN + STCONVERT + RTCONVERT + LFCONVERT + !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 @@ -9300,6 +9312,18 @@ MODULE NOAHMP_TABLES REAL :: GDDS4_TABLE(NCROP) ! GDD from seeding to intial reproductive REAL :: GDDS5_TABLE(NCROP) ! GDD from seeding to pysical maturity + REAL :: C3PSNI_TABLE(NCROP) !photosynthetic pathway: 0. = c4, 1. = c3 ! Zhe Zhang 2020-07-03 + REAL :: KC25I_TABLE(NCROP) !co2 michaelis-menten constant at 25c (pa) + REAL :: AKCI_TABLE(NCROP) !q10 for kc25 + REAL :: KO25I_TABLE(NCROP) !o2 michaelis-menten constant at 25c (pa) + REAL :: AKOI_TABLE(NCROP) !q10 for ko25 + REAL :: VCMX25I_TABLE(NCROP) !maximum rate of carboxylation at 25c (umol co2/m**2/s) + REAL :: AVCMXI_TABLE(NCROP) !q10 for vcmx25 + REAL :: BPI_TABLE(NCROP) !minimum leaf conductance (umol/m**2/s) + REAL :: MPI_TABLE(NCROP) !slope of conductance-to-photosynthesis relationship + REAL :: QE25I_TABLE(NCROP) !quantum efficiency at 25c (umol co2 / umol photon) + REAL :: FOLNMXI_TABLE(NCROP) !foliage nitrogen concentration when + INTEGER :: C3C4_TABLE(NCROP) ! photosynthetic pathway: 1. = c3 2. = c4 REAL :: AREF_TABLE(NCROP) ! reference maximum CO2 assimulation rate REAL :: PSNRF_TABLE(NCROP) ! CO2 assimulation reduction factor(0-1) (caused by non-modeling part,e.g.pest,weeds) @@ -9330,6 +9354,9 @@ MODULE NOAHMP_TABLES REAL :: STPT_TABLE(NCROP,NSTAGE) ! fraction of carbohydrate flux to stem REAL :: RTPT_TABLE(NCROP,NSTAGE) ! fraction of carbohydrate flux to root REAL :: GRAINPT_TABLE(NCROP,NSTAGE) ! fraction of carbohydrate flux to grain + REAL :: LFCT_TABLE(NCROP,NSTAGE) ! fraction of carbohydrate translocation from leaf to grain ! Zhe Zhang 2020-07-13 + REAL :: STCT_TABLE(NCROP,NSTAGE) ! stem to grain + REAL :: RTCT_TABLE(NCROP,NSTAGE) ! root to grain REAL :: BIO2LAI_TABLE(NCROP) ! leaf are per living leaf biomass [m^2/kg] ! MPTABLE.TBL optional parameters @@ -9868,6 +9895,17 @@ subroutine read_mp_crop_parameters() REAL, DIMENSION(NCROP) :: GDDS3 REAL, DIMENSION(NCROP) :: GDDS4 REAL, DIMENSION(NCROP) :: GDDS5 + REAL, DIMENSION(NCROP) :: C3PSN ! this session copied from stomata parameters Zhe Zhang 2020-07-13 + REAL, DIMENSION(NCROP) :: KC25 + REAL, DIMENSION(NCROP) :: AKC + REAL, DIMENSION(NCROP) :: KO25 + REAL, DIMENSION(NCROP) :: AKO + REAL, DIMENSION(NCROP) :: AVCMX + REAL, DIMENSION(NCROP) :: VCMX25 + REAL, DIMENSION(NCROP) :: BP + REAL, DIMENSION(NCROP) :: MP + REAL, DIMENSION(NCROP) :: FOLNMX + REAL, DIMENSION(NCROP) :: QE25 ! until here INTEGER, DIMENSION(NCROP) :: C3C4 REAL, DIMENSION(NCROP) :: AREF REAL, DIMENSION(NCROP) :: PSNRF @@ -9894,12 +9932,20 @@ subroutine read_mp_crop_parameters() REAL, DIMENSION(NCROP) :: STPT_S1,STPT_S2,STPT_S3,STPT_S4,STPT_S5,STPT_S6,STPT_S7,STPT_S8 REAL, DIMENSION(NCROP) :: RTPT_S1,RTPT_S2,RTPT_S3,RTPT_S4,RTPT_S5,RTPT_S6,RTPT_S7,RTPT_S8 REAL, DIMENSION(NCROP) :: GRAINPT_S1,GRAINPT_S2,GRAINPT_S3,GRAINPT_S4,GRAINPT_S5,GRAINPT_S6,GRAINPT_S7,GRAINPT_S8 + REAL, DIMENSION(NCROP) :: LFCT_S1,LFCT_S2,LFCT_S3,LFCT_S4,LFCT_S5,LFCT_S6,LFCT_S7,LFCT_S8 + REAL, DIMENSION(NCROP) :: STCT_S1,STCT_S2,STCT_S3,STCT_S4,STCT_S5,STCT_S6,STCT_S7,STCT_S8 + REAL, DIMENSION(NCROP) :: RTCT_S1,RTCT_S2,RTCT_S3,RTCT_S4,RTCT_S5,RTCT_S6,RTCT_S7,RTCT_S8 REAL, DIMENSION(NCROP) :: BIO2LAI - NAMELIST / noahmp_crop_parameters /DEFAULT_CROP, PLTDAY, HSDAY, PLANTPOP, IRRI, GDDTBASE, GDDTCUT, GDDS1, GDDS2, & - GDDS3, GDDS4, GDDS5, C3C4, AREF, PSNRF, I2PAR, TASSIM0, & - TASSIM1, TASSIM2, K, EPSI, Q10MR, FOLN_MX, LEFREEZ, & +! NAMELIST / noahmp_crop_parameters /DEFAULT_CROP, PLTDAY, HSDAY, PLANTPOP, IRRI, GDDTBASE, GDDTCUT, GDDS1, GDDS2, & +! GDDS3, GDDS4, GDDS5, C3C4, AREF, PSNRF, I2PAR, TASSIM0, & +! TASSIM1, TASSIM2, K, EPSI, Q10MR, FOLN_MX, LEFREEZ, & +! Zhe Zhang 2020-07-13 + NAMELIST / noahmp_crop_parameters /DEFAULT_CROP, PLTDAY, HSDAY, PLANTPOP, IRRI, GDDTBASE, GDDTCUT, GDDS1, GDDS2, GDDS3, GDDS4, GDDS5, & ! + C3PSN, KC25, AKC, KO25, AKO, AVCMX, VCMX25, BP, MP, FOLNMX, QE25, & ! parameters added from stomata + C3C4, AREF, PSNRF, I2PAR, TASSIM0, & + TASSIM1, TASSIM2, K, EPSI, Q10MR, FOLN_MX, LEFREEZ, & DILE_FC_S1,DILE_FC_S2,DILE_FC_S3,DILE_FC_S4,DILE_FC_S5,DILE_FC_S6,DILE_FC_S7,DILE_FC_S8, & DILE_FW_S1,DILE_FW_S2,DILE_FW_S3,DILE_FW_S4,DILE_FW_S5,DILE_FW_S6,DILE_FW_S7,DILE_FW_S8, & FRA_GR, & @@ -9911,6 +9957,9 @@ subroutine read_mp_crop_parameters() STPT_S1, STPT_S2, STPT_S3, STPT_S4, STPT_S5, STPT_S6, STPT_S7, STPT_S8, & RTPT_S1, RTPT_S2, RTPT_S3, RTPT_S4, RTPT_S5, RTPT_S6, RTPT_S7, RTPT_S8, & GRAINPT_S1,GRAINPT_S2,GRAINPT_S3,GRAINPT_S4,GRAINPT_S5,GRAINPT_S6,GRAINPT_S7,GRAINPT_S8, & + LFCT_S1,LFCT_S2,LFCT_S3,LFCT_S4,LFCT_S5,LFCT_S6,LFCT_S7,LFCT_S8, & + STCT_S1,STCT_S2,STCT_S3,STCT_S4,STCT_S5,STCT_S6,STCT_S7,STCT_S8, & + RTCT_S1,RTCT_S2,RTCT_S3,RTCT_S4,RTCT_S5,RTCT_S6,RTCT_S7,RTCT_S8, & BIO2LAI @@ -9927,6 +9976,17 @@ subroutine read_mp_crop_parameters() GDDS3_TABLE = -1.E36 GDDS4_TABLE = -1.E36 GDDS5_TABLE = -1.E36 + C3PSNI_TABLE = -1.E36 ! parameter from PSN copied from stomata ! Zhe Zhang 2020-07-13 + KC25I_TABLE = -1.E36 + AKCI_TABLE = -1.E36 + KO25I_TABLE = -1.E36 + AKOI_TABLE = -1.E36 + AVCMXI_TABLE = -1.E36 + VCMX25I_TABLE = -1.E36 + BPI_TABLE = -1.E36 + MPI_TABLE = -1.E36 + FOLNMXI_TABLE = -1.E36 + QE25I_TABLE = -1.E36 ! ends here C3C4_TABLE = -99999 AREF_TABLE = -1.E36 PSNRF_TABLE = -1.E36 @@ -9953,6 +10013,9 @@ subroutine read_mp_crop_parameters() STPT_TABLE = -1.E36 RTPT_TABLE = -1.E36 GRAINPT_TABLE = -1.E36 + LFCT_TABLE = -1.E36 ! convert start + STCT_TABLE = -1.E36 + RTCT_TABLE = -1.E36 ! convert end BIO2LAI_TABLE = -1.E36 @@ -9983,6 +10046,17 @@ subroutine read_mp_crop_parameters() GDDS3_TABLE = GDDS3 GDDS4_TABLE = GDDS4 GDDS5_TABLE = GDDS5 + C3PSNI_TABLE(1:5) = C3PSN(1:5) ! parameters from stomata ! Zhe Zhang 2020-07-13 + KC25I_TABLE(1:5) = KC25(1:5) + AKCI_TABLE(1:5) = AKC(1:5) + KO25I_TABLE(1:5) = KO25(1:5) + AKOI_TABLE(1:5) = AKO(1:5) + AVCMXI_TABLE(1:5) = AVCMX(1:5) + VCMX25I_TABLE(1:5) = VCMX25(1:5) + BPI_TABLE(1:5) = BP(1:5) + MPI_TABLE(1:5) = MP(1:5) + FOLNMXI_TABLE(1:5) = FOLNMX(1:5) + QE25I_TABLE(1:5) = QE25(1:5) ! ends here C3C4_TABLE = C3C4 AREF_TABLE = AREF PSNRF_TABLE = PSNRF @@ -10072,6 +10146,30 @@ subroutine read_mp_crop_parameters() GRAINPT_TABLE(:,6) = GRAINPT_S6 GRAINPT_TABLE(:,7) = GRAINPT_S7 GRAINPT_TABLE(:,8) = GRAINPT_S8 + LFCT_TABLE(:,1) = LFCT_S1 + LFCT_TABLE(:,2) = LFCT_S2 + LFCT_TABLE(:,3) = LFCT_S3 + LFCT_TABLE(:,4) = LFCT_S4 + LFCT_TABLE(:,5) = LFCT_S5 + LFCT_TABLE(:,6) = LFCT_S6 + LFCT_TABLE(:,7) = LFCT_S7 + LFCT_TABLE(:,8) = LFCT_S8 + STCT_TABLE(:,1) = STCT_S1 + STCT_TABLE(:,2) = STCT_S2 + STCT_TABLE(:,3) = STCT_S3 + STCT_TABLE(:,4) = STCT_S4 + STCT_TABLE(:,5) = STCT_S5 + STCT_TABLE(:,6) = STCT_S6 + STCT_TABLE(:,7) = STCT_S7 + STCT_TABLE(:,8) = STCT_S8 + RTCT_TABLE(:,1) = RTCT_S1 + RTCT_TABLE(:,2) = RTCT_S2 + RTCT_TABLE(:,3) = RTCT_S3 + RTCT_TABLE(:,4) = RTCT_S4 + RTCT_TABLE(:,5) = RTCT_S5 + RTCT_TABLE(:,6) = RTCT_S6 + RTCT_TABLE(:,7) = RTCT_S7 + RTCT_TABLE(:,8) = RTCT_S8 BIO2LAI_TABLE = BIO2LAI end subroutine read_mp_crop_parameters diff --git a/run/MPTABLE.TBL b/run/MPTABLE.TBL index be26e9b248..03afe68d7a 100644 --- a/run/MPTABLE.TBL +++ b/run/MPTABLE.TBL @@ -360,21 +360,31 @@ DEFAULT_CROP = 0 ! The default crop type(1- ! 1 2 3 4 5 !---------------------------------------------------------- -PLTDAY = 130, 111, 111, 111, 111, ! Planting date -HSDAY = 280, 300, 300, 300, 300, ! Harvest date +PLTDAY = 111, 131, 111, 111, 111, ! Planting date +HSDAY = 300, 280, 300, 300, 300, ! Harvest date PLANTPOP = 78.0, 78.0, 78.0, 78.0, 78.0, ! Plant density [per ha] - used? IRRI = 0.0, 0.0, 0.0, 0.0, 0.0, ! Irrigation strategy 0= non-irrigation 1=irrigation (no water-stress) GDDTBASE = 10.0, 10.0, 10.0, 10.0, 10.0, ! Base temperature for GDD accumulation [C] GDDTCUT = 30.0, 30.0, 30.0, 30.0, 30.0, ! Upper temperature for GDD accumulation [C] -GDDS1 = 60.0, 50.0, 50.0, 50.0, 50.0, ! GDD from seeding to emergence -GDDS2 = 675.0, 718.0, 718.0, 718.0, 718.0, ! GDD from seeding to initial vegetative -GDDS3 = 1183.0, 933.0, 933.0, 933.0, 933.0, ! GDD from seeding to post vegetative -GDDS4 = 1253.0, 1103.0, 1103.0, 1103.0, 1103.0, ! GDD from seeding to intial reproductive -GDDS5 = 1605.0, 1555.0, 1555.0, 1555.0, 1555.0, ! GDD from seeding to pysical maturity - +GDDS1 = 50.0, 60.0, 50.0, 50.0, 50.0, ! GDD from seeding to emergence +GDDS2 = 625.0, 675.0, 718.0, 718.0, 718.0, ! GDD from seeding to initial vegetative +GDDS3 = 933.0, 1183.0, 933.0, 933.0, 933.0, ! GDD from seeding to post vegetative +GDDS4 = 1103.0, 1253.0, 1103.0, 1103.0, 1103.0, ! GDD from seeding to intial reproductive +GDDS5 = 1555.0, 1605.0, 1555.0, 1555.0, 1555.0, ! GDD from seeding to pysical maturity +C3PSN = 0.0, 1.0, 1.0, 1.0, 1.0, ! transfer crop-specific photosynthetic parameters +KC25 = 30.0, 30.0, 30.0, 30.0, 30.0, ! Zhe Zhang +AKC = 2.1, 2.1, 2.1, 2.1, 2.1, ! 2020-02-05 +KO25 = 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, ! +AKO = 1.2, 1.2, 1.2, 1.2, 1.2, ! +AVCMX = 2.4, 2.4, 2.4, 2.4, 2.4, ! +VCMX25 = 60.0, 80.0, 60.0, 60.0, 55.0, ! +BP = 4.E4, 1.E4, 2.E3, 2.E3, 2.E3, ! +MP = 4., 9., 6., 9., 9., ! +FOLNMX = 1.5, 1.5, 1.5, 1.5, 1.5, ! +QE25 = 0.05, 0.06, 0.06, 0.06, 0.06, ! C3C4 = 2, 1, 2, 2, 2, ! photosynthetic pathway: 1. = c3 2. = c4 -Aref = 7.0, 7.0, 7.0, 7.0, 7.0, ! reference maximum CO2 assimulation rate +Aref = 7.0, 7.0, 7.0, 7.0, 7.0, ! reference maximum CO2 assimulation rate PSNRF = 0.85, 0.85, 0.85, 0.85, 0.85, ! CO2 assimulation reduction factor(0-1) (caused by non-modeling part,e.g.pest,weeds) I2PAR = 0.5, 0.5, 0.5, 0.5, 0.5, ! Fraction of incoming solar radiation to photosynthetically active radiation TASSIM0 = 8.0, 8.0, 8.0, 8.0, 8.0, ! Minimum temperature for CO2 assimulation [C] @@ -390,7 +400,7 @@ LEFREEZ = 268, 268, 268, 268, 268, ! characteristic T for lea DILE_FC_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! coeficient for temperature leaf stress death [1/s] DILE_FC_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! One row for each of 8 stages DILE_FC_S3 = 0.0, 0.0, 0.0, 0.0, 0.0, -DILE_FC_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, +DILE_FC_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, DILE_FC_S5 = 0.5, 0.5, 0.5, 0.5, 0.5, DILE_FC_S6 = 0.5, 0.5, 0.5, 0.5, 0.5, DILE_FC_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, @@ -411,8 +421,8 @@ LF_OVRC_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of leaf turnove LF_OVRC_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! One row for each of 8 stages LF_OVRC_S3 = 0.0, 0.0, 0.0, 0.0, 0.0, LF_OVRC_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, -LF_OVRC_S5 = 0.2, 0.48, 0.48, 0.48, 0.48, -LF_OVRC_S6 = 0.3, 0.48, 0.48, 0.48, 0.48, +LF_OVRC_S5 = 0.2, 0.2, 0.48, 0.48, 0.48, +LF_OVRC_S6 = 0.3, 0.3, 0.48, 0.48, 0.48, LF_OVRC_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, LF_OVRC_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, @@ -420,8 +430,8 @@ ST_OVRC_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of stem turnove ST_OVRC_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! One row for each of 8 stages ST_OVRC_S3 = 0.0, 0.0, 0.0, 0.0, 0.0, ST_OVRC_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, -ST_OVRC_S5 = 0.12, 0.12, 0.12, 0.12, 0.12, -ST_OVRC_S6 = 0.06, 0.06, 0.06, 0.06, 0.06, +ST_OVRC_S5 = 0.2, 0.12, 0.12, 0.12, 0.12, +ST_OVRC_S6 = 0.3, 0.06, 0.06, 0.06, 0.06, ST_OVRC_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, ST_OVRC_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, @@ -429,21 +439,20 @@ RT_OVRC_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of root tunrove RT_OVRC_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! One row for each of 8 stages RT_OVRC_S3 = 0.0, 0.0, 0.0, 0.0, 0.0, RT_OVRC_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, -RT_OVRC_S5 = 0.12, 0.12, 0.12, 0.12, 0.12, -RT_OVRC_S6 = 0.06, 0.06, 0.06, 0.06, 0.06, +RT_OVRC_S5 = 0.12, 0.12, 0.12, 0.12, 0.12, +RT_OVRC_S6 = 0.06, 0.06, 0.06, 0.06, 0.06, RT_OVRC_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, RT_OVRC_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, - -LFMR25 = 1.0, 1.0, 1.0, 1.0, 1.0, ! leaf maintenance respiration at 25C [umol CO2/m**2 /s] -STMR25 = 0.05, 0.1, 0.1, 0.1, 0.1, ! stem maintenance respiration at 25C [umol CO2/kg bio/s] -RTMR25 = 0.05, 0.0, 0.0, 0.0, 0.0, ! root maintenance respiration at 25C [umol CO2/kg bio/s] -GRAINMR25 = 0.0, 0.1, 0.1, 0.1, 0.1, ! grain maintenance respiration at 25C [umol CO2/kg bio/s] +LFMR25 = 0.8, 1.0, 1.0, 1.0, 1.0, ! leaf maintenance respiration at 25C [umol CO2/m**2 /s] +STMR25 = 0.05, 0.05, 0.1, 0.1, 0.1, ! stem maintenance respiration at 25C [umol CO2/kg bio/s] +RTMR25 = 0.05, 0.05, 0.0, 0.0, 0.0, ! root maintenance respiration at 25C [umol CO2/kg bio/s] +GRAINMR25 = 0.0, 0.0, 0.1, 0.1, 0.1, ! grain maintenance respiration at 25C [umol CO2/kg bio/s] LFPT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to leaf LFPT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! One row for each of 8 stages -LFPT_S3 = 0.4, 0.4, 0.4, 0.4, 0.4, -LFPT_S4 = 0.2, 0.2, 0.2, 0.2, 0.2, +LFPT_S3 = 0.36, 0.4, 0.4, 0.4, 0.4, +LFPT_S4 = 0.1, 0.2, 0.2, 0.2, 0.2, LFPT_S5 = 0.0, 0.0, 0.0, 0.0, 0.0, LFPT_S6 = 0.0, 0.0, 0.0, 0.0, 0.0, LFPT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, @@ -451,33 +460,60 @@ LFPT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, STPT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to stem STPT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! One row for each of 8 stages -STPT_S3 = 0.2, 0.2, 0.2, 0.2, 0.2, -STPT_S4 = 0.5, 0.5, 0.5, 0.5, 0.5, -STPT_S5 = 0.0, 0.15, 0.15, 0.15, 0.15, -STPT_S6 = 0.0, 0.05, 0.05, 0.05, 0.05, +STPT_S3 = 0.24, 0.2, 0.2, 0.2, 0.2, +STPT_S4 = 0.6, 0.5, 0.5, 0.5, 0.5, +STPT_S5 = 0.0, 0.0, 0.15, 0.15, 0.15, +STPT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, STPT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, -STPT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, +STPT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, RTPT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to root RTPT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! One row for each of 8 stages -RTPT_S3 = 0.34, 0.4, 0.4, 0.4, 0.4, +RTPT_S3 = 0.4, 0.4, 0.4, 0.4, 0.4, RTPT_S4 = 0.3, 0.3, 0.3, 0.3, 0.3, -RTPT_S5 = 0.05, 0.05, 0.05, 0.05, 0.05, -RTPT_S6 = 0.0, 0.05, 0.05, 0.05, 0.05, +RTPT_S5 = 0.05, 0.05, 0.05, 0.05, 0.05, +RTPT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, RTPT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, RTPT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, - + GRAINPT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to grain GRAINPT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! One row for each of 8 stages GRAINPT_S3 = 0.0, 0.0, 0.0, 0.0, 0.0, GRAINPT_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, -GRAINPT_S5 = 0.95, 0.8, 0.8, 0.8, 0.8, -GRAINPT_S6 = 1.0, 0.9, 0.9, 0.9, 0.9, +GRAINPT_S5 = 0.95, 0.95, 0.8, 0.8, 0.8, +GRAINPT_S6 = 1.0, 1.0, 0.9, 0.9, 0.9, GRAINPT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, GRAINPT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, +LFCT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! carbohydrate translocation +LFCT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, +LFCT_S3 = 0.0, 0., 0.4, 0.4, 0.4, +LFCT_S4 = 0.0, 0., 0.3, 0.3, 0.3, +LFCT_S5 = 0.0, 0.0, 0.05, 0.05, 0.05, +LFCT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, +LFCT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, +LFCT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, + +STCT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! carbohydrate translocation +STCT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, +STCT_S3 = 0.0, 0., 0.4, 0.4, 0.4, +STCT_S4 = 0.0, 0., 0.3, 0.3, 0.3, +STCT_S5 = 0.0, 0., 0.05, 0.05, 0.05, +STCT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, +STCT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, +STCT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, + +RTCT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! carbohydrate translocation +RTCT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, +RTCT_S3 = 0.0, 0., 0.4, 0.4, 0.4, +RTCT_S4 = 0.0, 0., 0.3, 0.3, 0.3, +RTCT_S5 = 0.0, 0., 0.05, 0.05, 0.05, +RTCT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, +RTCT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, +RTCT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, + +BIO2LAI = 0.015, 0.030, 0.015, 0.015, 0.015, ! leaf are per living leaf biomass [m^2/kg] -BIO2LAI = 0.035, 0.015, 0.015, 0.015, 0.015, ! leaf are per living leaf biomass [m^2/kg] / From 76943c1a5595a6c03956d6b73a8d3e5d469af7d6 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Tue, 27 Oct 2020 08:12:55 -0600 Subject: [PATCH 13/36] Inconsistent arg types (integer kind) across subroutine call (#1300) TYPE: bug fix KEYWORDS: integer kind SOURCE: internal DESCRIPTION OF CHANGES: Problem: The nine calls to io_int_loc had inconsistent kinds of integer for the actual and dummy arguments. On every machine and compiler previously, the integer kinds for MPI_offset and c_int64_t were identical. On the raspberry pi (using the default apt-get openmpi and gnu fortran), these are not identical. Solution: As the integers are being shared through a C interface, that integer kind was selected. LIST OF MODIFIED FILES: modified: external/io_int/module_io_int_read.F90 TESTS CONDUCTED: 1. Without the mods, the WRF model did not build on a raspberry pi. With the mods, the code builds and runs. Here testing on a raspberry pi includes the distributed memory, so the MPI_offset variable would be in use. ``` pi@raspberrypi:/media/pi/gill/WRF/test/em_quarter_ss $ mpirun -np 1 ./wrf.exe ; tail rsl.out.0000 starting wrf task 0 of 1 Timing for main: time 0001-01-01_00:00:24 on domain 1: 0.79946 elapsed seconds Timing for main: time 0001-01-01_00:00:36 on domain 1: 0.79981 elapsed seconds Timing for main: time 0001-01-01_00:00:48 on domain 1: 0.80066 elapsed seconds Timing for main: time 0001-01-01_00:01:00 on domain 1: 0.79946 elapsed seconds Timing for main: time 0001-01-01_00:01:12 on domain 1: 0.80392 elapsed seconds Timing for main: time 0001-01-01_00:01:24 on domain 1: 0.80236 elapsed seconds Timing for main: time 0001-01-01_00:01:36 on domain 1: 0.80006 elapsed seconds Timing for main: time 0001-01-01_00:01:48 on domain 1: 0.79996 elapsed seconds Timing for main: time 0001-01-01_00:02:00 on domain 1: 0.80133 elapsed seconds d01 0001-01-01_00:02:00 wrf: SUCCESS COMPLETE WRF ``` ``` pi@raspberrypi:/media/pi/gill/WRF/test/em_quarter_ss $ mpirun -np 2 ./wrf.exe ; tail rsl.out.0000 starting wrf task 1 of 2 starting wrf task 0 of 2 Timing for main: time 0001-01-01_00:00:24 on domain 1: 0.53475 elapsed seconds Timing for main: time 0001-01-01_00:00:36 on domain 1: 0.53516 elapsed seconds Timing for main: time 0001-01-01_00:00:48 on domain 1: 0.53412 elapsed seconds Timing for main: time 0001-01-01_00:01:00 on domain 1: 0.53324 elapsed seconds Timing for main: time 0001-01-01_00:01:12 on domain 1: 0.53357 elapsed seconds Timing for main: time 0001-01-01_00:01:24 on domain 1: 0.53547 elapsed seconds Timing for main: time 0001-01-01_00:01:36 on domain 1: 0.53507 elapsed seconds Timing for main: time 0001-01-01_00:01:48 on domain 1: 0.53406 elapsed seconds Timing for main: time 0001-01-01_00:02:00 on domain 1: 0.53477 elapsed seconds d01 0001-01-01_00:02:00 wrf: SUCCESS COMPLETE WRF ``` ``` pi@raspberrypi:/media/pi/gill/WRF/test/em_quarter_ss $ mpirun -np 3 ./wrf.exe ; tail rsl.out.0000 starting wrf task 0 of 3 starting wrf task 1 of 3 starting wrf task 2 of 3 Timing for main: time 0001-01-01_00:00:24 on domain 1: 0.48709 elapsed seconds Timing for main: time 0001-01-01_00:00:36 on domain 1: 0.48533 elapsed seconds Timing for main: time 0001-01-01_00:00:48 on domain 1: 0.48523 elapsed seconds Timing for main: time 0001-01-01_00:01:00 on domain 1: 0.48553 elapsed seconds Timing for main: time 0001-01-01_00:01:12 on domain 1: 0.48532 elapsed seconds Timing for main: time 0001-01-01_00:01:24 on domain 1: 0.48635 elapsed seconds Timing for main: time 0001-01-01_00:01:36 on domain 1: 0.48445 elapsed seconds Timing for main: time 0001-01-01_00:01:48 on domain 1: 0.48409 elapsed seconds Timing for main: time 0001-01-01_00:02:00 on domain 1: 0.48494 elapsed seconds d01 0001-01-01_00:02:00 wrf: SUCCESS COMPLETE WRF ``` ``` pi@raspberrypi:/media/pi/gill/WRF/test/em_quarter_ss $ mpirun -np 4 ./wrf.exe ; tail rsl.out.0000 starting wrf task 3 of 4 starting wrf task 0 of 4 starting wrf task 1 of 4 starting wrf task 2 of 4 Timing for main: time 0001-01-01_00:00:24 on domain 1: 0.65011 elapsed seconds Timing for main: time 0001-01-01_00:00:36 on domain 1: 0.64889 elapsed seconds Timing for main: time 0001-01-01_00:00:48 on domain 1: 0.64934 elapsed seconds Timing for main: time 0001-01-01_00:01:00 on domain 1: 0.64886 elapsed seconds Timing for main: time 0001-01-01_00:01:12 on domain 1: 0.65009 elapsed seconds Timing for main: time 0001-01-01_00:01:24 on domain 1: 0.64658 elapsed seconds Timing for main: time 0001-01-01_00:01:36 on domain 1: 0.64700 elapsed seconds Timing for main: time 0001-01-01_00:01:48 on domain 1: 0.64807 elapsed seconds Timing for main: time 0001-01-01_00:02:00 on domain 1: 0.64591 elapsed seconds d01 0001-01-01_00:02:00 wrf: SUCCESS COMPLETE WRF ``` 2. Jenkins testing is all PASS. RELEASE NOTES: An inconsistency in the declaration of integer kinds was discovered in the seldom-used routine that processes binary formatted data. In one routine the values were declared as an MPI type (and integer kind mpi_offset_type). That argument was passed to a routine that declared the integers as c_int64_t (which is part of the standard technique now to be used when working with C). These two integer kinds must have been the same 8-byte size for all of the x86_64 Linux machines that we have used. These integer kinds are however different for at least some gfortran / openmpi combinations on ARM processors (specifically found on a raspberry pi). There is no impact to existing users. If the code previously worked (built), this changes nothing. --- external/io_int/module_io_int_read.F90 | 40 +++++++++++++------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/external/io_int/module_io_int_read.F90 b/external/io_int/module_io_int_read.F90 index 5e2a8f6e68..8bd9d7d1e1 100644 --- a/external/io_int/module_io_int_read.F90 +++ b/external/io_int/module_io_int_read.F90 @@ -87,7 +87,7 @@ end module module_io_int_read module module_io_int_read use module_io_int_idx, only: io_int_loc, r_info - use, intrinsic :: iso_c_binding, only: c_int32_t + use, intrinsic :: iso_c_binding, only: c_int32_t, c_int64_t implicit none @@ -127,9 +127,9 @@ subroutine read_i0(ifd, records, varname, dst, ierr) integer, intent(out) :: dst integer, intent(out) :: ierr - integer(kind=mpi_offset_kind) :: offset - integer :: count - integer :: tmp + integer(c_int64_t) :: offset + integer(c_int32_t) :: count + integer :: tmp call io_int_loc(varname, records, offset, count, ierr) if (ierr .ne. 0) then @@ -161,8 +161,8 @@ subroutine read_i1(ifd, records, varname, dst, ierr) integer, intent(inout) :: dst(:) integer, intent(out) :: ierr - integer(kind=mpi_offset_kind) :: offset - integer :: count + integer(c_int64_t) :: offset + integer(c_int32_t) :: count integer :: num integer :: i integer :: its, ite @@ -219,8 +219,8 @@ subroutine read_i2(ifd, records, varname, dst, ierr) integer, intent(inout) :: dst(:,:) integer, intent(out) :: ierr - integer(kind=mpi_offset_kind) :: offset - integer :: count + integer(c_int64_t) :: offset + integer(c_int32_t) :: count integer :: num integer :: i, j integer :: its, ite, jts, jte @@ -279,8 +279,8 @@ subroutine read_i3(ifd, records, varname, dst, ierr) integer, intent(inout) :: dst(:,:,:) integer, intent(out) :: ierr - integer(kind=mpi_offset_kind) :: offset - integer :: count + integer(c_int64_t) :: offset + integer(c_int32_t) :: count integer :: num integer :: i, j, k integer :: its, ite, jts, jte, kts, kte @@ -343,8 +343,8 @@ subroutine read_r0(ifd, records, varname, dst, ierr) real, intent(out) :: dst integer, intent(out) :: ierr - integer(kind=mpi_offset_kind) :: offset - integer :: count + integer(c_int64_t) :: offset + integer(c_int32_t) :: count integer :: tmp call io_int_loc(varname, records, offset, count, ierr) @@ -377,8 +377,8 @@ subroutine read_r1(ifd, records, varname, dst, ierr) real, intent(inout) :: dst(:) integer, intent(out) :: ierr - integer(kind=mpi_offset_kind) :: offset - integer :: count + integer(c_int64_t) :: offset + integer(c_int32_t) :: count integer :: num integer :: i integer :: its, ite @@ -435,8 +435,8 @@ subroutine read_r2(ifd, records, varname, dst, ierr) real, intent(inout) :: dst(:,:) integer, intent(out) :: ierr - integer(kind=mpi_offset_kind) :: offset - integer :: count + integer(c_int64_t) :: offset + integer(c_int32_t) :: count integer :: num integer :: i, j integer :: its, ite, jts, jte @@ -495,8 +495,8 @@ subroutine read_r3(ifd, records, varname, dst, ierr) real, intent(inout) :: dst(:,:,:) integer, intent(out) :: ierr - integer(kind=mpi_offset_kind) :: offset - integer :: count + integer(c_int64_t) :: offset + integer(c_int32_t) :: count integer :: num integer :: i, j, k integer :: its, ite, jts, jte, kts, kte @@ -559,8 +559,8 @@ subroutine read_c1(ifd, records, varname, dst, ierr) character(len=*), intent(inout) :: dst integer, intent(out) :: ierr - integer(kind=mpi_offset_kind) :: offset - integer :: count + integer(c_int64_t) :: offset + integer(c_int32_t) :: count integer :: num integer :: i integer, allocatable, dimension(:) :: tmp From 3e5d62471137625037d68b28e3ca594f2869ff03 Mon Sep 17 00:00:00 2001 From: Neeldip <35301060+Neeldip@users.noreply.github.com> Date: Tue, 10 Nov 2020 21:40:28 +0530 Subject: [PATCH 14/36] TYPE: bug fix (#1321) Fix for high sulfate concentrations with biomass_burn_opt = 2 TYPE: bug fix KEYWORDS: chem,biomassburn,plumerise,sulfate SOURCE: Neeldip Barman (IIT Guwahati) DESCRIPTION OF CHANGES: Problem: Namelist option biomass_burn_opt = 2 when used with chem_opt=202 produces very high so4 concentration and so4 plumes reaching near the model top. This further leads to very large optical depths. Namelist option biomass_burn_opt = 2 does not take sulfate emissions as inputs in registry, but sulfate emission inputs have been defined in module_mosaic_addemiss.F Solution: Setting IF ( p_ebu_sulf .gt. 1) aem_so4 = bburn_mosaic_f(n)*ebu(i,k,j,p_ebu_sulf) inplace of aem_so4 = bburn_mosaic_f(n)*ebu(i,k,j,p_ebu_sulf) LIST OF MODIFIED FILES: module_mosaic_addemiss.F TESTS CONDUCTED: 1. chem_opt = 202 with the code modification RELEASE NOTE: sulf emissions are not defined for biomass_burn_opt = 2 (MOZART option) in the registry, but sulf emission inputs have been defined in module_mosaic_addemiss.F, which is used for any MOZART option coupled to MOSAIC --- chem/module_mosaic_addemiss.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/chem/module_mosaic_addemiss.F b/chem/module_mosaic_addemiss.F index 874bdcde5a..723224c97d 100644 --- a/chem/module_mosaic_addemiss.F +++ b/chem/module_mosaic_addemiss.F @@ -601,7 +601,7 @@ subroutine mosaic_addemiss( id, dtstep, u10, v10, alt, dz8w, xland, & do i = its, ite ! compute mass biomass burning emissions [(ug/m3)*m/s] for each species ! using the apportioning fractions - aem_so4 = bburn_mosaic_f(n)*ebu(i,k,j,p_ebu_sulf) + IF ( p_ebu_sulf .gt. 1) aem_so4 = bburn_mosaic_f(n)*ebu(i,k,j,p_ebu_sulf) aem_oc = bburn_mosaic_f(n)*ebu(i,k,j,p_ebu_oc) aem_bc = bburn_mosaic_f(n)*ebu(i,k,j,p_ebu_bc) ! Option to calculate OIN fraction of total PM for fire emissions From 774acb5ac9507c686a8375b712289fd9a8b35243 Mon Sep 17 00:00:00 2001 From: Ju-Hye Kim <42191918+juhyejuhye@users.noreply.github.com> Date: Tue, 29 Dec 2020 11:53:46 -0700 Subject: [PATCH 15/36] Update check_a_mundo to make FARMS work correctly (#1332) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit TYPE: bug fix KEYWORDS: FARMS, Microphysics, module_check_a_mundo.F SOURCE: Ju Hye Kim and Pedro Jimenez (NCAR/RAL) DESCRIPTION OF CHANGES: Problem: FARMS can work correctly with microphysics schemes that do not provide effective radii of clouds. But, current WRF model displays an ERROR message and stops when the 'swint_opt is 2' and 'use_mp_re is not 1'. Solution: We remove this constraint from ‘module_check_a_mundo.F’. LIST OF MODIFIED FILES: M share/module_check_a_mundo.F TESTS CONDUCTED: 1. When FARMS and a microphysics scheme that do not provide effective radii of clouds (ex: mp=2) are used together, the model does not stop anymore. 2. All jenkins tests are passing. RELEASE NOTE: Fixed an incorrect stop in the model when FARMS radiation is used with microphysics that do not provide effective cloud radii. --- share/module_check_a_mundo.F | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/share/module_check_a_mundo.F b/share/module_check_a_mundo.F index db28b315a3..69cca36211 100644 --- a/share/module_check_a_mundo.F +++ b/share/module_check_a_mundo.F @@ -576,24 +576,6 @@ END FUNCTION bep_bem_nbui_max END IF ENDDO -!----------------------------------------------------------------------- -! The FARMS radiation option (swint_opt==2) requires both effective radii -! and mass for cloud, ice, and snow. A run-time option is available to -! disable the use of effective radii in the MP schemes. These two options -! may not be used together. -!----------------------------------------------------------------------- - oops = 0 - IF ( ( model_config_rec%swint_opt .EQ. 2 ) .AND. & - ( model_config_rec%use_mp_re .NE. 1 ) ) THEN - oops = oops + 1 - END IF - - IF ( oops .GT. 0 ) THEN - wrf_err_message = '--- ERROR: FARMS (swint_opt=2) requires effective radii (use_mp_re=1)' - CALL wrf_message ( wrf_err_message ) - count_fatal_error = count_fatal_error + 1 - END IF - #endif !----------------------------------------------------------------------- From 8752b393a640f5ec88411ebd820a6c35c40f1352 Mon Sep 17 00:00:00 2001 From: hmorrison100 <38229011+hmorrison100@users.noreply.github.com> Date: Tue, 29 Dec 2020 11:57:59 -0700 Subject: [PATCH 16/36] Fix saturation vapor pressure at low temperatures (#1328) TYPE: bug fix KEYWORDS: saturation vapor pressure, Morrison double-moment scheme SOURCE: Hugh Morrison (NCAR) DESCRIPTION OF CHANGES: Problem: Current code gave unrealistically high saturation vapor pressures at T < -80 C. Solution: "function polysvp" in module_mp_morr_two_moment_aero.F and module_mp_morr_two_moment.F are modified to correct the problem. LIST OF MODIFIED FILES: M phys/module_mp_morr_two_moment_aero.F M phys/module_mp_morr_two_moment.F TESTS CONDUCTED: Idealized tests conduced by Morrison, the mods fix the problem. Jenkins tests have passed. RELEASE NOTE: Fix a problem with function polyqvp which gave unrealistically high saturation vapor pressures at T < -80 C. --- phys/module_mp_morr_two_moment.F | 36 ++++++++++++++++++++------ phys/module_mp_morr_two_moment_aero.F | 37 +++++++++++++++++++++------ 2 files changed, 57 insertions(+), 16 deletions(-) diff --git a/phys/module_mp_morr_two_moment.F b/phys/module_mp_morr_two_moment.F index 0c1b077557..94ec70e9fc 100644 --- a/phys/module_mp_morr_two_moment.F +++ b/phys/module_mp_morr_two_moment.F @@ -76,6 +76,8 @@ ! 1) changes and cleanup of code comments ! 2) correction to universal gas constant (very small change) +! CHANGES FOR WRFV4.3 +! 1) fix to saturation vapor pressure polysvp to work at T < -80 C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! THIS SCHEME IS A BULK DOUBLE-MOMENT SCHEME THAT PREDICTS MIXING @@ -1287,6 +1289,7 @@ SUBROUTINE MORR_TWO_MOMENT_MICRO(QC3DTEN,QI3DTEN,QNI3DTEN,QR3DTEN, & ! SATURATION VAPOR PRESSURE AND MIXING RATIO ! hm, add fix for low pressure, 5/12/10 + EVS(K) = min(0.99*pres(k),POLYSVP(T3D(K),0)) ! PA EIS(K) = min(0.99*pres(k),POLYSVP(T3D(K),1)) ! PA @@ -4080,11 +4083,18 @@ REAL FUNCTION POLYSVP (T,TYPE) ! POLYSVP = 10.**(-9.09718*(273.16/T-1.)-3.56654* & ! LOG10(273.16/T)+0.876793*(1.-T/273.16)+ & ! LOG10(6.1071))*100. +! hm 11/16/20, use Goff-Gratch for T < 195.8 K and Flatau et al. equal or above 195.8 K + if (t.ge.195.8) then + dt=t-273.15 + polysvp = a0i + dt*(a1i+dt*(a2i+dt*(a3i+dt*(a4i+dt*(a5i+dt*(a6i+dt*(a7i+a8i*dt))))))) + polysvp = polysvp*100. + else + polysvp = 10.**(-9.09718*(273.16/t-1.)-3.56654* & + alog10(273.16/t)+0.876793*(1.-t/273.16)+ & + alog10(6.1071))*100. - dt = max(-80.,t-273.16) - polysvp = a0i + dt*(a1i+dt*(a2i+dt*(a3i+dt*(a4i+dt*(a5i+dt*(a6i+dt*(a7i+a8i*dt))))))) - polysvp = polysvp*100. + end if END IF @@ -4092,17 +4102,27 @@ REAL FUNCTION POLYSVP (T,TYPE) IF (TYPE.EQ.0) THEN - dt = max(-80.,t-273.16) - polysvp = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) - polysvp = polysvp*100. - ! POLYSVP = 10.**(-7.90298*(373.16/T-1.)+ & ! 5.02808*LOG10(373.16/T)- & ! 1.3816E-7*(10**(11.344*(1.-T/373.16))-1.)+ & ! 8.1328E-3*(10**(-3.49149*(373.16/T-1.))-1.)+ & ! LOG10(1013.246))*100. +! hm 11/16/20, use Goff-Gratch for T < 202.0 K and Flatau et al. equal or above 202.0 K + if (t.ge.202.0) then + dt = t-273.15 + polysvp = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) + polysvp = polysvp*100. + else + +! note: uncertain below -70 C, but produces physical values (non-negative) unlike flatau + polysvp = 10.**(-7.90298*(373.16/t-1.)+ & + 5.02808*alog10(373.16/t)- & + 1.3816e-7*(10**(11.344*(1.-t/373.16))-1.)+ & + 8.1328e-3*(10**(-3.49149*(373.16/t-1.))-1.)+ & + alog10(1013.246))*100. + end if - END IF + END IF END FUNCTION POLYSVP diff --git a/phys/module_mp_morr_two_moment_aero.F b/phys/module_mp_morr_two_moment_aero.F index 0a27d2e2d8..71cc3f8009 100644 --- a/phys/module_mp_morr_two_moment_aero.F +++ b/phys/module_mp_morr_two_moment_aero.F @@ -76,6 +76,10 @@ ! 1) changes and cleanup of code comments ! 2) correction to universal gas constant (very small change) +! CHANGES FOR WRFV4.3 +! 1) fix to saturation vapor pressure polysvp to work at T < -80 C +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! TWG 2017 ! TWG = Timothy Glotfelty, EPA ! Adapted from WRFV3.8.1 Morrison Double Moment Scheme @@ -5031,11 +5035,18 @@ REAL FUNCTION POLYSVP (T,TYPE) ! POLYSVP = 10.**(-9.09718*(273.16/T-1.)-3.56654* & ! LOG10(273.16/T)+0.876793*(1.-T/273.16)+ & ! LOG10(6.1071))*100. +! hm 11/16/20, use Goff-Gratch for T < 195.8 K and Flatau et al. equal or above 195.8 K + if (t.ge.195.8) then + dt=t-273.15 + polysvp = a0i + dt*(a1i+dt*(a2i+dt*(a3i+dt*(a4i+dt*(a5i+dt*(a6i+dt*(a7i+a8i*dt))))))) + polysvp = polysvp*100. + else + polysvp = 10.**(-9.09718*(273.16/t-1.)-3.56654* & + alog10(273.16/t)+0.876793*(1.-t/273.16)+ & + alog10(6.1071))*100. - dt = max(-80.,t-273.16) - polysvp = a0i + dt*(a1i+dt*(a2i+dt*(a3i+dt*(a4i+dt*(a5i+dt*(a6i+dt*(a7i+a8i*dt))))))) - polysvp = polysvp*100. + end if END IF @@ -5043,17 +5054,27 @@ REAL FUNCTION POLYSVP (T,TYPE) IF (TYPE.EQ.0) THEN - dt = max(-80.,t-273.16) - polysvp = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) - polysvp = polysvp*100. - ! POLYSVP = 10.**(-7.90298*(373.16/T-1.)+ & ! 5.02808*LOG10(373.16/T)- & ! 1.3816E-7*(10**(11.344*(1.-T/373.16))-1.)+ & ! 8.1328E-3*(10**(-3.49149*(373.16/T-1.))-1.)+ & ! LOG10(1013.246))*100. +! hm 11/16/20, use Goff-Gratch for T < 202.0 K and Flatau et al. equal or above 202.0 K + if (t.ge.202.0) then + dt = t-273.15 + polysvp = a0 + dt*(a1+dt*(a2+dt*(a3+dt*(a4+dt*(a5+dt*(a6+dt*(a7+a8*dt))))))) + polysvp = polysvp*100. + else + +! note: uncertain below -70 C, but produces physical values (non-negative) unlike flatau + polysvp = 10.**(-7.90298*(373.16/t-1.)+ & + 5.02808*alog10(373.16/t)- & + 1.3816e-7*(10**(11.344*(1.-t/373.16))-1.)+ & + 8.1328e-3*(10**(-3.49149*(373.16/t-1.))-1.)+ & + alog10(1013.246))*100. + end if - END IF + END IF END FUNCTION POLYSVP From 6a98943c34dc48c99e2957ff40ea36e50caeb441 Mon Sep 17 00:00:00 2001 From: arjanna <47889545+arjanna@users.noreply.github.com> Date: Tue, 29 Dec 2020 20:01:24 +0100 Subject: [PATCH 17/36] fix on time constraints (#1315) TYPE: bug fix KEYWORDS: irrigation, time selection, day selection, bug fix SOURCE: Arianna Valmassoi (Uni-Bonn) DESCRIPTION OF CHANGES: Problem: The irrigation schemes weren't working when the date selection was across two different years: i.e. irr_end_julianday < irr_start_julianday. Same problem was found for active hours across the local 00 time: i.e. irr_start_hour+irr_num_hours>23 Solution: Fixed by adding/modifying the if statements LIST OF MODIFIED FILES: M phys/module_irrigation.F TESTS CONDUCTED: Do mods fix problem? yes Are the Jenkins tests all passing? Passed. RELEASE NOTE: Bug fixes for temporal selection that spans across different years and different local days. --- phys/module_irrigation.F | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/phys/module_irrigation.F b/phys/module_irrigation.F index aae8d014af..660ec1b634 100644 --- a/phys/module_irrigation.F +++ b/phys/module_irrigation.F @@ -35,7 +35,8 @@ SUBROUTINE drip_irrigation( julian_in & INTEGER, INTENT(INOUT) :: irr_rand_field_val IRRIGATION_CHANNEL=0. IF(RAINBL.LE.0.01 .AND. IRRIGATION.GE.0.001) THEN - end_hour=irr_start_hour+irr_num_hours + end_hour=irr_start_hour+irr_num_hours + if(end_hour.gt.23) end_hour=end_hour-24 constants_irrigation=irr_freq*irr_daily_amount*0.000277778*0.01/irr_num_hours ! hours in second:1/3600=0.000277778 phase=0. timing=modulo((int(julian_in)-irr_start_julianday),irr_freq) @@ -44,7 +45,9 @@ SUBROUTINE drip_irrigation( julian_in & xt24=mod(xtime,1440.) tloc=floor(gmt+xt24/60.) if(tloc.lt.0) tloc=tloc+24 - IF ((tloc.GE.irr_start_hour .AND. tloc.LT.end_hour) .AND. (julian_in.GE.irr_start_julianday .AND. julian_in.LT.irr_end_julianday) .AND. timing.EQ.0. ) THEN + IF (((tloc.GE.irr_start_hour .AND. tloc.LT.24) .OR. ( tloc.GE.0 .AND. tloc.LT.end_hour) ) & + .AND. ((julian_in.GE.irr_start_julianday .AND. julian_in.LT.367) .OR. & + ( julian_in.GE.0 .AND. julian_in.LT.irr_end_julianday)) .AND. timing.EQ.0. ) THEN IF(irr_ph.EQ.0) THEN RAINBL =RAINBL +dt*IRRIGATION*constants_irrigation IRRIGATION_CHANNEL=0. @@ -81,6 +84,7 @@ SUBROUTINE channel_irrigation( julian_in & !ARI IRRIGATION_CHANNEL=0. IF(RAINBL.LE.0.01 .AND. IRRIGATION.GE.0.001) THEN end_hour=irr_start_hour+irr_num_hours + if(end_hour.gt.23) end_hour=end_hour-24 constants_irrigation=irr_freq*irr_daily_amount*0.000277778*0.01/irr_num_hours ! hours in second:1/3600=0.000277778 phase=0. timing=modulo((int(julian_in)-irr_start_julianday),irr_freq) @@ -89,7 +93,9 @@ SUBROUTINE channel_irrigation( julian_in & !ARI xt24=mod(xtime,1440.) tloc=floor(gmt+xt24/60.) if(tloc.lt.0) tloc=tloc+24 - IF ((tloc.GE.irr_start_hour .AND. tloc.LT.end_hour) .AND. (julian_in.GE.irr_start_julianday .AND. julian_in.LT.irr_end_julianday) .AND. timing.EQ.0. ) THEN + IF (((tloc.GE.irr_start_hour .AND. tloc.LT.24) .OR. ( tloc.GE.0 .AND. tloc.LT.end_hour) ) & + .AND. ((julian_in.GE.irr_start_julianday .AND. julian_in.LT.367) .OR. & + ( julian_in.GE.0 .AND. julian_in.LT.irr_end_julianday)) .AND. timing.EQ.0. ) THEN IF(irr_ph.EQ.0) THEN IRRIGATION_CHANNEL=dt*IRRIGATION*constants_irrigation ELSE @@ -137,7 +143,7 @@ SUBROUTINE sprinkler_irrigation( julian_in qr_curr REAL, INTENT(IN ) :: dt end_hour=irr_start_hour+irr_num_hours - + if(end_hour.gt.23) end_hour=end_hour-24 xt24=mod(xtime,1440.) tloc=floor(gmt+xt24/60.) if(tloc.lt.0) tloc=tloc+24 @@ -147,9 +153,9 @@ SUBROUTINE sprinkler_irrigation( julian_in DO b=jts,jte constants_irrigation=irr_freq*irr_daily_amount/(irr_num_hours*3600*rho(a,kms,b)*dz8w(a,kms,b)*100) - IF ( (tloc.GE.irr_start_hour .AND. tloc.LT.end_hour) .AND. & + IF ( ((tloc.GE.irr_start_hour .AND. tloc.LT.24) .OR. ( tloc.GE.0 .AND. tloc.LT.end_hour) ) .AND. & (irrigation(a,b).GE.0.1) .AND. & - (julian_in.GE.irr_start_julianday .AND. julian_in.LT.irr_end_julianday ) ) THEN + ((julian_in.GE.irr_start_julianday .AND. julian_in.LT.367) .OR. ( julian_in.GE.0 .AND. julian_in.LT.irr_end_julianday)) ) THEN CALL irr_calc_phase(irr_ph,phase,irr_rand_field_val(a,b),a,b,irrigation(a,b),irr_freq) IF(irr_ph.EQ.0) THEN qr_curr(a,kms,b)=qr_curr(a,kms,b)+irrigation(a,b)*constants_irrigation*dt From b21c918993134cbc3dc17752d1f2c42ff033d6a2 Mon Sep 17 00:00:00 2001 From: dudhia Date: Tue, 29 Dec 2020 12:11:59 -0700 Subject: [PATCH 18/36] Fix for QSFC when fractional sea-ice is used with MYJSFC and QNSESFC (#1313) TYPE: bug fix KEYWORDS: sea-ice fraction option, QSFC calculation, MYJSFC, QNSESFC SOURCE: Xin-Zhong Liang DESCRIPTION OF CHANGES: Problem: Incorrect parentheses in weighted average Solution: Fixed parentheses Effect: Test by Kevin Manning indicates small effect. ISSUE: For use when this PR closes an issue. Fixes #1297 (part) LIST OF MODIFIED FILES: M phys/module_surface_driver.F TESTS CONDUCTED: Test by Kevin Manning shows small impact. Jenkins test (TBD) RELEASE NOTE: Fix incorrect parentheses in weighted average for QSFC when sea-ice fraction is used with MYJSFC and QNSESFC surface layer physics. --- phys/module_surface_driver.F | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/phys/module_surface_driver.F b/phys/module_surface_driver.F index fcdb7c015a..5bb4ba964c 100644 --- a/phys/module_surface_driver.F +++ b/phys/module_surface_driver.F @@ -4370,7 +4370,7 @@ subroutine myjsfc_seaice_wrapper(ITIMESTEP,HT,DZ, & ! QSFC_SEA calculation as done in myjsfc for open water points PSFC = PINT(I,LOWLYR(I,J),J) QSFC_SEA(i,j) = PQ0SEA/PSFC*EXP(A2S*(TSK(i,j)-A3S)/(TSK(i,j)-A4S)) - QSFC(i,j) = QSFC(i,j) - (1.0-XICE(i,j)) * QSFC_SEA(i,j) / XICE(i,j) + QSFC(i,j) = (QSFC(i,j) - (1.0-XICE(i,j)) * QSFC_SEA(i,j)) / XICE(i,j) ! HFX_SEA(i,j) = HFX(i,j) QFX_SEA(i,j) = QFX(i,j) @@ -4737,7 +4737,7 @@ subroutine qnsesfc_seaice_wrapper(ITIMESTEP,HT,DZ, & ! QSFC_SEA calculation as done in qnsesfc for open water points PSFC = PINT(I,LOWLYR(I,J),J) QSFC_SEA(i,j) = PQ0SEA/PSFC*EXP(A2S*(TSK(i,j)-A3S)/(TSK(i,j)-A4S)) - QSFC(i,j) = QSFC(i,j) - (1.0-XICE(i,j)) * QSFC_SEA(i,j) / XICE(i,j) + QSFC(i,j) = (QSFC(i,j) - (1.0-XICE(i,j)) * QSFC_SEA(i,j)) / XICE(i,j) ! HFX_SEA(i,j) = HFX(i,j) QFX_SEA(i,j) = QFX(i,j) From 61029b1416dfb16574fbf08d9c763e3d8705290d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Matthias=20G=C3=B6bel?= Date: Tue, 29 Dec 2020 21:45:10 +0100 Subject: [PATCH 19/36] Add factor when converting surface heat fluxes from dry to moist theta (#1259) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit TYPE: bug fix KEYWORDS: surface heat flux, use_theta_m, moist theta, non-local flux, 3D TKE SOURCE: Matthias Göbel (University of Innsbruck) DESCRIPTION OF CHANGES: The conversion of surface heat fluxes from dry to moist theta in WRF is inconsistent. This leads to an unclosed dry theta budget at the lowest grid point. The surface sensible heat flux in the routines `vertical_diffusion_2` and `vertical_diffusion_implicit` should be multiplied with as is derived below. Using Reynold's decomposition and averaging we can show for the perturbation moist theta: with water vapor mixing ratio q and This yields for the converted surface heat flux: The triple correlation in the equation above cannot be easily estimated in WRF, but judging from my tests it probably has a negligible impact. Instead of the given equation, WRF uses: We therefore multiplied the surface heat flux with , when `use_theta_m=1`. For `km_opt=5`, also the contribution from the non-local heat flux is multiplied with a correction factor. LIST OF MODIFIED FILES: dyn_em/module_diffusion_em.F TESTS CONDUCTED: checked the dry theta budget of a simulation with use_theta_m=1: simple idealized LES once with model-computed surface heat flux and once with prescribed heat fluxes, RRTMG radiation, no microphysics, zero eddy diffusivities. Changed the code to output advection, SGS diffusion and radiation tendencies for dry theta (regardless of use_theta_m and without changing the tendencies used by the model). These forcing tendencies are averaged online over 30 minutes. The sum of the forcing terms is plotted against the actual tendency of dry theta (change of instantaneous dry theta between the half-hourly time stamps divided by 30 minutes) for all gridpoints and time stamps. All tendency terms are divided by the dry air mass to obtain more familiar units. The modified code fixes the issue of an unclosed dry theta budget at the lowest gridpoint (see attached figures). The simulations were repeated for km_opt=5. RELEASE NOTE: To close the dry theta budget at the lowest grid point when use_theta_m is enabled, the surface heat fluxes, and in the case of km_opt=5 also the non-local heat flux, are multiplied with 1+Rv/Rd*qv. ![test_fluxes_flat_thd_3rd+5th](https://user-images.githubusercontent.com/17001470/88155314-389f7380-cc08-11ea-9dac-f7ec6cceeaed.png) ![test_fluxes_flat_thdm_3rd+5th](https://user-images.githubusercontent.com/17001470/88155312-3806dd00-cc08-11ea-8226-4ed46c5c556e.png) ![test_fluxes_flat_fixed-sfc-fluxes_thdm_3rd+5th](https://user-images.githubusercontent.com/17001470/88155315-39380a00-cc08-11ea-8cbd-6b9fd6217c1c.png) --- dyn_em/module_diffusion_em.F | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/dyn_em/module_diffusion_em.F b/dyn_em/module_diffusion_em.F index 57fd621e7a..4217fa2ada 100644 --- a/dyn_em/module_diffusion_em.F +++ b/dyn_em/module_diffusion_em.F @@ -4282,11 +4282,13 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & DO i = i_start, i_end cpm = cp * (1. + 0.8 * moist(i,kts,j,P_QV)) hfx(i,j)=heat_flux*cpm*rho(i,kts,j) ! provided for output only - rt_tendf(i,kts,j)=rt_tendf(i,kts,j) & - -g*heat_flux*rho(i,kts,j)/dnw(kts) if(config_flags%use_theta_m == 1)THEN rt_tendf(i,kts,j)=rt_tendf(i,kts,j) & + -g*heat_flux*(1.+rvovrd*moist(i,kts,j,P_QV))*rho(i,kts,j)/dnw(kts) & -g*1.61*theta(i,kts,j)*qfx(i,j)/dnw(kts) + ELSE + rt_tendf(i,kts,j)=rt_tendf(i,kts,j) & + -g*heat_flux*rho(i,kts,j)/dnw(kts) ENDIF ENDDO ENDDO @@ -4297,11 +4299,13 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & cpm = cp * (1. + 0.8 * moist(i,kts,j,P_QV)) heat_flux = hfx(i,j)/cpm - rt_tendf(i,kts,j)=rt_tendf(i,kts,j) & - -g*heat_flux/dnw(kts) if(config_flags%use_theta_m == 1)THEN rt_tendf(i,kts,j)=rt_tendf(i,kts,j) & + -g*heat_flux*(1.+rvovrd*moist(i,kts,j,P_QV))/dnw(kts) & -g*1.61*theta(i,kts,j)*qfx(i,j)/dnw(kts) + ELSE + rt_tendf(i,kts,j)=rt_tendf(i,kts,j) & + -g*heat_flux/dnw(kts) ENDIF ENDDO @@ -7717,7 +7721,7 @@ SUBROUTINE vertical_diffusion_implicit(ru_tendf, rv_tendf, rw_tendf, rt_tendf,& INTEGER :: i_start, i_end, j_start, j_end REAL :: V0_u,V0_v,ustar,beta - REAL :: heat_flux, moist_flux + REAL :: heat_flux, moist_flux, qfac REAL :: cpm,rdz_w,rhoavg_u,rhoavg_v,rdz_z ! End declarations. !----------------------------------------------------------------------- @@ -8094,17 +8098,23 @@ SUBROUTINE vertical_diffusion_implicit(ru_tendf, rv_tendf, rw_tendf, rt_tendf,& - dt*rdz_w*nlflux_rho(i,k+1,j) & + dt*rdz_w*hfx(i,j)/cpm ELSE + qfac = 1.+rvovrd*moist(i,kts,j,P_QV) d(k) = var_mix(i,kts,j) & - - dt*rdz_w*nlflux_rho(i,k+1,j) & - + dt*rdz_w*(hfx(i,j)/cpm+1.61*theta(i,kts,j)*qfx(i,j)) + - dt*rdz_w*nlflux_rho(i,k+1,j)*qfac & + + dt*rdz_w*(qfac*hfx(i,j)/cpm+1.61*theta(i,kts,j)*qfx(i,j)) ENDIF DO k = kts+1, ktf-1 rdz_w = -g/dnw(k)/(c1h(k)*mu(i,j) + c2h(k)) + IF(config_flags%use_theta_m == 1)THEN + qfac = 1.+rvovrd*moist(i,k,j,P_QV) + ELSE + qfac = 1. + ENDIF a(k) = -rdz_w*rdz(i,k,j)*xkxavg(i,k,j)*dt b(k) = 1.+rdz_w*(rdz(i,k+1,j)*xkxavg(i,k+1,j)+rdz(i,k,j)*xkxavg(i,k,j))*dt c(k) = -rdz_w*rdz(i,k+1,j)*xkxavg(i,k+1,j)*dt - d(k) = -rdz_w*(nlflux_rho(i,k+1,j)-nlflux_rho(i,k,j))*dt + var_mix(i,k,j) + d(k) = -rdz_w*(nlflux_rho(i,k+1,j)-nlflux_rho(i,k,j))*qfac*dt + var_mix(i,k,j) ENDDO a(ktf) = 0. From 93ccd183d4e94c8a7066e3de8873b102119efbb1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Matthias=20G=C3=B6bel?= Date: Tue, 29 Dec 2020 22:20:49 +0100 Subject: [PATCH 20/36] Prevent divide by zero in km_opt=5 (#1304) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit TYPE: bug fix KEYWORDS: 3D TKE, km_opt, divide by zero SOURCE: Matthias Göbel (University of Innsbruck) DESCRIPTION OF CHANGES: Problem: When compiling WRF with the -D option, several divide-by-zero errors happen in the km_opt=5 scheme. This PR fixes the problems, and the changes are approved by the developer. LIST OF MODIFIED FILES: dyn_em/module_diffusion_em.F TESTS CONDUCTED: Jenkins testing is all PASS. RELEASE NOTE: Fixed divide by zero in the 3D-TKE option km_opt=5. --- dyn_em/module_diffusion_em.F | 124 ++++++++++++++++++++--------------- 1 file changed, 72 insertions(+), 52 deletions(-) diff --git a/dyn_em/module_diffusion_em.F b/dyn_em/module_diffusion_em.F index 4217fa2ada..cc1e00eaac 100644 --- a/dyn_em/module_diffusion_em.F +++ b/dyn_em/module_diffusion_em.F @@ -5137,7 +5137,7 @@ SUBROUTINE nonlocal_flux (config_flags,nlflux,gamu,gamv,hpbl,kpbl, & DO i = i_start, i_end delxy = sqrt(dx/msftx(i,j)*dy/msfty(i,j)) pu1=pu(delxy,hpbl(i,j)) - IF(sfcflg(i,j).and.sflux(i,j).GT.0.0)THEN + IF((sfcflg(i,j).and.sflux(i,j).GT.0.0) .and. (hpbl(i,j) .GT. 0)) THEN !nonlocal momentum flux based on Brown and Grant (1997) brint = -sm*ust(i,j)*ust(i,j)*wstar3(i,j)/(hpbl(i,j)*wscale(i,j)**4) gamu(i,j) = pu1 * brint*u_phy(i,1,j)/wspd(i,j) @@ -5169,8 +5169,12 @@ SUBROUTINE nonlocal_flux (config_flags,nlflux,gamu,gamv,hpbl,kpbl, & deltaoh(i,j) = max(ezfac*deltaoh(i,j),hpbl(i,j)-za(i,kpbl(i,j)-1,j)-1.) deltaoh(i,j) = min(deltaoh(i,j), hpbl(i,j)) - rigs(i,j) = govrth(i,j)*dthv(i,j)*deltaoh(i,j)/(du**2.+dv**2.) - rigs(i,j) = max(min(rigs(i,j), rigsmax),rimin) + if ((du .ne. 0) .or. (dv .ne. 0)) then + rigs(i,j) = govrth(i,j)*dthv(i,j)*deltaoh(i,j)/(du**2.+dv**2.) + rigs(i,j) = max(min(rigs(i,j), rigsmax),rimin) + else + rigs(i,j) = rigsmax + endif enlfrac2(i,j) = max(min(wm3/wstar3(i,j)/(1.+cpent/rigs(i,j)),entfmax),entfmin) enlfrac2(i,j) = enlfrac2(i,j)*enlfrac ENDIF @@ -5186,44 +5190,41 @@ SUBROUTINE nonlocal_flux (config_flags,nlflux,gamu,gamv,hpbl,kpbl, & ENDDO ENDDO ENDDO - - DO j = j_start, j_end - DO i = i_start, i_end - deltaoh(i,j) = deltaoh(i,j)/hpbl(i,j) - ENDDO - ENDDO DO j = j_start, j_end DO i = i_start, i_end - delxy = sqrt(dx/msftx(i,j)*dy/msfty(i,j)) - mlfrac = mltop-deltaoh(i,j) - ezfrac = mltop+deltaoh(i,j) - zfacmf(i,1,j) = min(max((zq(i,2,j)/hpbl(i,j)),zfmin),1.) - sfcfracn = max(sfcfracn1,zfacmf(i,1,j)) -! - sflux0 = (a11+a12*sfcfracn)*sflux(i,j) - snlflux0 = nlfrac*sflux0 - amf1 = snlflux0/sfcfracn - amf2 = -snlflux0/(mlfrac-sfcfracn) - bmf2 = -mlfrac*amf2 - amf3 = snlflux0*enlfrac2(i,j)/deltaoh(i,j) - bmf3 = -amf3*mlfrac - hfxpbl(i,j) = amf3+bmf3 - pth1 = pthnl(delxy,hpbl(i,j)) - hfxpbl(i,j) = hfxpbl(i,j)*pth1 + IF (pblflg(i,j)) THEN + deltaoh(i,j) = deltaoh(i,j)/hpbl(i,j) + delxy = sqrt(dx/msftx(i,j)*dy/msfty(i,j)) + mlfrac = mltop-deltaoh(i,j) + ezfrac = mltop+deltaoh(i,j) + zfacmf(i,1,j) = min(max((zq(i,2,j)/hpbl(i,j)),zfmin),1.) + sfcfracn = max(sfcfracn1,zfacmf(i,1,j)) + ! + sflux0 = (a11+a12*sfcfracn)*sflux(i,j) + snlflux0 = nlfrac*sflux0 + amf1 = snlflux0/sfcfracn + amf2 = -snlflux0/(mlfrac-sfcfracn) + bmf2 = -mlfrac*amf2 + amf3 = snlflux0*enlfrac2(i,j)/deltaoh(i,j) + bmf3 = -amf3*mlfrac + hfxpbl(i,j) = amf3+bmf3 + pth1 = pthnl(delxy,hpbl(i,j)) + hfxpbl(i,j) = hfxpbl(i,j)*pth1 - DO k = kts, ktf - zfacmf(i,k,j) = max((zq(i,k+1,j)/hpbl(i,j)),zfmin) - IF(pblflg(i,j).and.k.LT.kpbl(i,j)) THEN - IF(zfacmf(i,k,j).LE.sfcfracn) THEN - nlflux(i,k,j) = amf1*zfacmf(i,k,j) - ELSE IF (zfacmf(i,k,j).LE.mlfrac) THEN - nlflux(i,k,j) = amf2*zfacmf(i,k,j)+bmf2 - ENDIF - nlflux(i,k,j) = nlflux(i,k,j) + hfxpbl(i,j)*exp(-entfacmf(i,k,j)) - nlflux(i,k,j) = nlflux(i,k,j)*pth1 - ENDIF - ENDDO + DO k = kts, ktf + zfacmf(i,k,j) = max((zq(i,k+1,j)/hpbl(i,j)),zfmin) + IF(k.LT.kpbl(i,j)) THEN + IF(zfacmf(i,k,j).LE.sfcfracn) THEN + nlflux(i,k,j) = amf1*zfacmf(i,k,j) + ELSE IF (zfacmf(i,k,j).LE.mlfrac) THEN + nlflux(i,k,j) = amf2*zfacmf(i,k,j)+bmf2 + ENDIF + nlflux(i,k,j) = nlflux(i,k,j) + hfxpbl(i,j)*exp(-entfacmf(i,k,j)) + nlflux(i,k,j) = nlflux(i,k,j)*pth1 + ENDIF + ENDDO + ENDIF ENDDO ENDDO END SUBROUTINE nonlocal_flux @@ -5241,10 +5242,15 @@ FUNCTION pthnl(d,h) REAL,PARAMETER :: b1 = 2.0, b2 = 0.875 real :: d,h,doh,num,den - doh = d/h - num = a1*(doh)**b1 + a2*(doh)**b2+a3 - den = a4*(doh)**b1 + a5*(doh)**b2+a6 - pthnl = a7*num/den + (1. - a7) + if (h .ne. 0) then + doh = d/h + num = a1*(doh)**b1 + a2*(doh)**b2+a3 + den = a4*(doh)**b1 + a5*(doh)**b2+a6 + pthnl = a7*num/den + (1. - a7) + else + pthnl = 1. + endif + pthnl = max(pthnl,pmin) pthnl = min(pthnl,pmax) @@ -5265,10 +5271,14 @@ FUNCTION pthl(d,h) REAL,PARAMETER :: b1 = 2.0, b2 = 0.5 REAL :: d,h,doh,num,den - doh = d/h - num = a1*(doh)**b1 + a2*(doh)**b2+a3 - den = a4*(doh)**b1 + a5*(doh)**b2+a6 - pthl = a7*num/den+(1. - a7) + if (h .ne. 0) then + doh = d/h + num = a1*(doh)**b1 + a2*(doh)**b2+a3 + den = a4*(doh)**b1 + a5*(doh)**b2+a6 + pthl = a7*num/den+(1. - a7) + else + pthl = 1. + endif pthl = max(pthl,pmin) pthl = min(pthl,pmax) @@ -5288,10 +5298,14 @@ FUNCTION pu(d,h) REAL,PARAMETER :: b1 = 2.0, b2 = 0.6666667 REAL :: d,h,doh,num,den - doh = d/h - num = a1*(doh)**b1 + a2*(doh)**b2 - den = a3*(doh)**b1 + a4*(doh)**b2+a5 - pu = num/den + if (h .ne. 0) then + doh = d/h + num = a1*(doh)**b1 + a2*(doh)**b2 + den = a3*(doh)**b1 + a4*(doh)**b2+a5 + pu = num/den + else + pu = 1. + endif pu = max(pu,pmin) pu = min(pu,pmax) @@ -8156,15 +8170,21 @@ SUBROUTINE vertical_diffusion_implicit(ru_tendf, rv_tendf, rw_tendf, rt_tendf,& DO i = i_start, i_end DO k = kts, ktf-1 rdz_w = - g/dnw(k)/(c1h(k)*mu(i,j)+c2h(k)) - beta = 1.5*sqrt(tke(i,k,j))/l_diss(i,k,j) + IF (l_diss(i,k,j) .ne. 0) THEN + beta = 1.5*sqrt(tke(i,k,j))/l_diss(i,k,j) + ELSE + beta = 0. + ENDIF a(k) = - 2.0*xkxavg(i,k,j)*dt*rdz_w*rdz(i,k,j) b(k) = 1.0 + 2.0*dt*rdz_w*(rdz(i,k,j)*xkxavg(i,k,j) & + rdz(i,k+1,j)*xkxavg(i,k+1,j)) & + dt*beta c(k) = - 2.0*xkxavg(i,k+1,j)*dt*rdz(i,k+1,j)*rdz_w - d(k) = tke(i,k,j) & - + 0.5*dt*tke(i,k,j)**1.5/l_diss(i,k,j) + d(k) = tke(i,k,j) + IF (l_diss(i,k,j) .ne. 0) THEN + d(k) = d(k) + 0.5*dt*tke(i,k,j)**1.5/l_diss(i,k,j) + ENDIF ENDDO a(ktf) = 0. !-1 From f3bec85082119f51bd67fd7874584242affc1d9d Mon Sep 17 00:00:00 2001 From: dudhia Date: Tue, 29 Dec 2020 16:27:21 -0700 Subject: [PATCH 21/36] Bug fixes for RRTMG-K option (#1317) TYPE: bug fix KEYWORDS: RRTMG-K option (sw and lw option 14) SOURCE: Soonyoung Roh and Hwan-Jin Song (National Institute of Meteorological Science, Korea) DESCRIPTION OF CHANGES: The bugs include wrong surface downward diagnostic output for long- and short-wave fluxes (clear sky fluxes misplaced in cloudy sky flux arrays), a wrong data statement value for wavenum2 and a wrong value used for bound check for effective size of snow. Affects radiation driver call arguments for lw and sw scheme and internal numerical values in two places of the shortwave scheme (rrtmg_swk). This has been confirmed as a correct fix by the developers. ISSUE: Fixes #1312 LIST OF MODIFIED FILES: M phys/module_ra_rrtmg_swk.F M phys/module_radiation_driver.F TESTS CONDUCTED: Test reported by source (documented in Issue #1312) Jenkins testing all pass RELEASE NOTE: Fixed a bug in surface downward diagnostic output of long- and short-wave fluxes and two other bugs involving wrong numerical values used in the code (Thanks to Roh and Song of NIMS, Korea). --- phys/module_ra_rrtmg_swk.F | 4 ++-- phys/module_radiation_driver.F | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/phys/module_ra_rrtmg_swk.F b/phys/module_ra_rrtmg_swk.F index 46e5fbc694..a18146b9dc 100644 --- a/phys/module_ra_rrtmg_swk.F +++ b/phys/module_ra_rrtmg_swk.F @@ -1732,7 +1732,7 @@ subroutine cldprmc_sw(nlayers, inflag, iceflag, liqflag, cldfmc, & 'ERROR: SNOW GENERALIZED EFFECTIVE SIZE OUT OF BOUNDS' factor = (radsno - 2._rb)/3._rb index = int(factor) - if(index.eq.167) index = 166 + if(index.eq.46) index = 45 fint = factor-real(index) ib = ngb(ig) extcosno(ig) = extice3(index,ib)+fint* & @@ -4308,7 +4308,7 @@ subroutine swdatinit(cpdair) 7700._rb, 8050._rb,12850._rb,16000._rb,22650._rb,29000._rb, & 38000._rb, 820._rb/) wavenum2(:) = (/3250._rb, 4000._rb, 4650._rb, 5150._rb, 6150._rb, 7700._rb, & - 8050._rb, 2850._rb,16000._rb,22650._rb,29000._rb,38000._rb, & + 8050._rb,12850._rb,16000._rb,22650._rb,29000._rb,38000._rb, & 50000._rb, 2600._rb/) delwave(:) = (/ 650._rb, 750._rb, 650._rb, 500._rb, 1000._rb, 1550._rb, & 350._rb, 4800._rb, 3150._rb, 6650._rb, 6350._rb, 9000._rb, & diff --git a/phys/module_radiation_driver.F b/phys/module_radiation_driver.F index 3a57db4c85..1c47e82ff0 100644 --- a/phys/module_radiation_driver.F +++ b/phys/module_radiation_driver.F @@ -1984,10 +1984,10 @@ SUBROUTINE radiation_driver ( & lwupflx, lwupflxc, lwdnflx, lwdnflxc, & swupflx, swupflxc, swdnflx, swdnflxc, & lwupt, lwuptc, lwdnt, lwdntc, & - lwupb, lwupbc, lwdnb, lwdnb, & + lwupb, lwupbc, lwdnb, lwdnbc, & glw, olr, lwcf, & swupt, swuptc, swdnt, swdntc, & - swupb, swupbc, swdnb, swdnb, & + swupb, swupbc, swdnb, swdnbc, & gsw, swcf, & coszen, solcon, albedo, emiss, & t,t8w, tsk, rho, p, p8w, cldfra, & From e5755c1e8411c34b953c42c163720866c29c2106 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Matthias=20G=C3=B6bel?= Date: Wed, 30 Dec 2020 00:29:55 +0100 Subject: [PATCH 22/36] use tke_seed_value only when necessary for km_opt = 2, 5 (#1307) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit TYPE: bug fix KEYWORDS: tke, isfflx, tke_heat_flux, tke_drag_coefficient, tke_seed SOURCE: Matthias Göbel (University of Innsbruck) DESCRIPTION OF CHANGES: Problem: The tke seed value is used in the absence of surface drag or a surface heat flux, since there is no way to generate tke without pre-existing tke. So far the usage of the seed value is only tied to the namelist variables tke_drag_coefficient and tke_heat_flux being greater than 0. However, these namelist variables are only applied if no PBL scheme is used, diff_opt=2, and isfflx=0. If a PBL scheme is used or diff_opt=1, then isfflx=0 is a sufficient condition to get zero fluxes (see also technical notes). Solution: Fixed the if statements to enforce a correct setting of the tke seed value that fits to the purpose of the seed. LIST OF MODIFIED FILES: dyn_em/module_diffusion_em.F wrftladj/module_diffusion_em_ad.F wrftladj/module_diffusion_em_tl.F TESTS CONDUCTED: Jenkins testing is all pass. RELEASE NOTE: Corrected the tke seed value for km_opt 2 and 5 to be non-zero if and only if the surface heat and momentum fluxes are zero depending on isfflx, diff_opt, and bl_pbl_physics (Thanks to Matthias Göbel of University of Innsbruck). --- dyn_em/module_diffusion_em.F | 15 ++++++++++++--- wrftladj/module_diffusion_em_ad.F | 15 ++++++++++++--- wrftladj/module_diffusion_em_tl.F | 17 +++++++++++++---- 3 files changed, 37 insertions(+), 10 deletions(-) diff --git a/dyn_em/module_diffusion_em.F b/dyn_em/module_diffusion_em.F index cc1e00eaac..00c0d456fd 100644 --- a/dyn_em/module_diffusion_em.F +++ b/dyn_em/module_diffusion_em.F @@ -2160,9 +2160,18 @@ SUBROUTINE tke_km( config_flags, xkmh, xkmv, xkhh, xkhv, & ! tke_seed if the drag and flux are off. c_k = config_flags%c_k - tke_seed = tke_seed_value - if( (config_flags%tke_drag_coefficient .gt. epsilon) .or. & - (config_flags%tke_heat_flux .gt. epsilon) ) tke_seed = 0. + tke_seed = 0. + IF (config_flags%isfflx .eq. 0) THEN + IF ((config_flags%diff_opt .eq. 2) .and. (config_flags%bl_pbl_physics .eq. 0)) THEN + IF( (config_flags%tke_drag_coefficient .lt. epsilon) .and. & + (config_flags%tke_heat_flux .lt. epsilon) ) THEN + tke_seed = tke_seed_value + ENDIF + ELSE + !tke_drag_coefficient and tke_heat_flux are irrelevant here + tke_seed = tke_seed_value + ENDIF + ENDIF DO j = j_start, j_end DO k = kts+1, ktf-1 diff --git a/wrftladj/module_diffusion_em_ad.F b/wrftladj/module_diffusion_em_ad.F index 10f3dbc3c1..3e9d9e404d 100644 --- a/wrftladj/module_diffusion_em_ad.F +++ b/wrftladj/module_diffusion_em_ad.F @@ -6711,11 +6711,20 @@ SUBROUTINE a_tke_km(config_flags,xkmh,a_xkmh,xkmv,a_xkmv,xkhh,a_xkhh,xkhv, & !LPB[12] c_k = config_flags%c_k - tke_seed = tke_seed_value + tke_seed = 0. !LPB[13] - if( (config_flags%tke_drag_coefficient .gt. epsilon) .or. & - (config_flags%tke_heat_flux .gt. epsilon) ) tke_seed = 0. + IF (config_flags%isfflx .eq. 0) THEN + IF ((config_flags%diff_opt .eq. 2) .and. (config_flags%bl_pbl_physics .eq. 0)) THEN + IF( (config_flags%tke_drag_coefficient .lt. epsilon) .and. & + (config_flags%tke_heat_flux .lt. epsilon) ) THEN + tke_seed = tke_seed_value + ENDIF + ELSE + !tke_drag_coefficient and tke_heat_flux are irrelevant here + tke_seed = tke_seed_value + ENDIF + ENDIF !LPB[14] DO j = j_start, j_end diff --git a/wrftladj/module_diffusion_em_tl.F b/wrftladj/module_diffusion_em_tl.F index b07a832579..ff4014ffa2 100644 --- a/wrftladj/module_diffusion_em_tl.F +++ b/wrftladj/module_diffusion_em_tl.F @@ -2645,10 +2645,19 @@ SUBROUTINE g_tke_km(config_flags,xkmh,g_xkmh,xkmv,g_xkmv,xkhh,g_xkhh, & g_c_k =0.0 c_k =config_flags%c_k - tke_seed =tke_seed_value - - if( (config_flags%tke_drag_coefficient .gt. epsilon) .or. & - (config_flags%tke_heat_flux .gt. epsilon) ) tke_seed =0. + tke_seed = 0. + + IF (config_flags%isfflx .eq. 0) THEN + IF ((config_flags%diff_opt .eq. 2) .and. (config_flags%bl_pbl_physics .eq. 0)) THEN + IF( (config_flags%tke_drag_coefficient .lt. epsilon) .and. & + (config_flags%tke_heat_flux .lt. epsilon) ) THEN + tke_seed = tke_seed_value + ENDIF + ELSE + !tke_drag_coefficient and tke_heat_flux are irrelevant here + tke_seed = tke_seed_value + ENDIF + ENDIF DO j =j_start,j_end DO k =kts+1,ktf-1 From d1fce1f3749cd21db385c1088cfa384266b8bf6c Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Tue, 29 Dec 2020 18:30:40 -0700 Subject: [PATCH 23/36] 1st gfortran stanza target for raspberry pi (add aarch64 and armv7l) (#1301) TYPE: new feature KEYWORDS: raspberry pi SOURCE: Daniel Zurawski and internal DESCRIPTION OF CHANGES: Additional strings, `armv7l` and `aarch64`, have been added to the first gfortran configuration stanza so that these may be keywords for search from Raspberry Pi's `uname -a` output. No new stanza was added for the gfortran target, so no re-numbering is required for existing scripts that are reliant on such things as "32 = Gfortran for Linux with a serial build". Associated with this PR, #1300 (Inconsistent arg types (integer kind) across subroutine call) is also required to get the Raspberry Pi to build successfully. LIST OF MODIFIED FILES: modified: arch/configure.defaults TESTS CONDUCTED: 1. Previously, a Raspberry Pi build returned this: ``` ********************************************************* *** ERROR ERROR ERROR ERROR *** *** *** *** Configuration not found in configure.defaults *** ********************************************************* ``` 2. After this PR, the configure command is able to find a target (raspian buster): ``` ----------------------------------------------------------------------- Please select from among the following Linux armv7l options: 1. (serial) 2. (smpar) 3. (dmpar) 4. (dm+sm) GNU (gfortran/gcc) ``` 3. After this PR, the configure command is able to find a target (ubuntu mate): ``` ------------------------------------------------------------------------ Please select from among the following Linux aarch64 options: 1. (serial) 2. (smpar) 3. (dmpar) 4. (dm+sm) GNU (gfortran/gcc) ``` 4. Jenkins testing is all pass. RELEASE NOTES: Modifications to the WRF code now permit the model to be built on a Raspberry Pi with the GNU/8 compiler. --- arch/configure.defaults | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/arch/configure.defaults b/arch/configure.defaults index 140ebf7b1c..026d6f4ce5 100644 --- a/arch/configure.defaults +++ b/arch/configure.defaults @@ -44,7 +44,7 @@ RLFLAGS = CC_TOOLS = cc ########################################################### -#ARCH Linux i486 i586 i686, gfortran compiler with gcc #serial smpar dmpar dm+sm +#ARCH Linux i486 i586 i686 armv7l aarch64, gfortran compiler with gcc #serial smpar dmpar dm+sm # DESCRIPTION = GNU ($SFC/$SCC) DMPARALLEL = # 1 From fe7d9d6eca32e55b17fd1a93e5dfe1881960aa30 Mon Sep 17 00:00:00 2001 From: jordanschnell Date: Wed, 30 Dec 2020 08:54:03 -0700 Subject: [PATCH 24/36] bug fix: improper indexing in add aircraft emissions (#1327) KEYWORDS: chemistry, emissions, aircraft, indexing SOURCE: Stacy Walters (formerly NCAR) DESCRIPTION OF CHANGES: Problem: An improper loop indexing that can cause addressing or floating point errors when aircraft emissions are used. Solution: Fix indexing (i - dimension) for the conversion term, from i to its:ite LIST OF MODIFIED FILES: M chem/module_emissions_anthropogenics.F TESTS CONDUCTED: 1. Jenkins test PASSED RELEASE NOTE: Improper indexing in a conversion factor when using aircraft emissions for WRF Chem previously caused addressing (seg fault) or floating point errors. This has been corrected by matching the indexing on the LHS with the RHS. --- chem/module_emissions_anthropogenics.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/chem/module_emissions_anthropogenics.F b/chem/module_emissions_anthropogenics.F index 6f168e67c9..52358038a2 100755 --- a/chem/module_emissions_anthropogenics.F +++ b/chem/module_emissions_anthropogenics.F @@ -241,7 +241,7 @@ subroutine add_anthropogenics(id,dtstep,dz8w,config_flags,rho_phy,alt, & if (config_flags%aircraft_emiss_opt == 1 ) then do j=jts,jte do k=kts,min(config_flags%kemit_aircraft,kte) - conv_rho(its:ite)=4.828e-4/rho_phy(i,k,j)*dtstep/(dz8w(i,k,j)*60.) + conv_rho(its:ite)=4.828e-4/rho_phy(its:ite,k,j)*dtstep/(dz8w(its:ite,k,j)*60.) if( p_no >= param_first_scalar ) then chem(its:ite,k,j,p_no) = chem(its:ite,k,j,p_no) + emis_aircraft(its:ite,k,j,p_eac_no) *conv_rho(its:ite) endif From f7ed7855f24a9f9e5e2f3a0fa394f0db4be284a0 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Sun, 3 Jan 2021 22:41:55 -0700 Subject: [PATCH 25/36] Update vertical interpolation stand-alone, fix vert_interp call (#1337) TYPE: bug fix KEYWORDS: vertical, interpolation SOURCE: internal DESCRIPTION: The stand-alone vertical interpolation program that is part of the module_initialize_real.F file allows detailed testing of the existing vertical interpolation process used for ARW in the real program. It is understood that practically no one except for me ever exercises this utility. 1. The call to the main vertical interpolation routine, vert_interp, was out of date (missing the grid id for some diagnostic error prints). 2. A suggestion for a build command is now provided. 3. Locations to use pressure-level or eta-level data are provided. LIST OF MODIFIED FILES: M module_initialize_real.F TESTS CONDUCTED: 1. The stand-alone code builds and runs properly. ``` ------------------------------------ UNIT TEST FOR VERTICAL INTERPOLATION ------------------------------------ ------------------------------------ Lagrange Order = 1 ------------------------------------ Level Pressure Field (Pa) (generic) ------------------------------------ 1 102000.000 102000.00 2 100000.000 100000.00 3 94722.219 94722.219 4 89444.445 89444.445 5 84166.664 84166.664 6 78888.891 78888.891 7 73611.109 73611.109 8 68333.336 68333.336 9 63055.555 63055.555 10 57777.777 57777.777 11 52500.000 52500.000 12 47222.223 47222.223 13 41944.445 41944.445 14 36666.668 36666.668 15 31388.889 31388.889 16 26111.111 26111.111 17 20833.334 20833.334 18 15555.556 15555.556 19 10277.777 10277.777 20 5000.000 5000.0000 Multi-Order Interpolator ------------------------------------ Level Pressure Field Field Field (Pa) Calc Interp Diff ------------------------------------ 1 100327.586 100327.6 100327.6 0.7812500E-02 2 96982.758 96982.76 96982.76 0.000000 3 93637.930 93637.93 93637.93 0.000000 4 90293.102 90293.10 90293.10 0.000000 5 86948.273 86948.27 86948.27 0.000000 6 83603.445 83603.45 83603.45 -0.7812500E-02 7 80258.617 80258.62 80258.62 0.000000 8 76913.797 76913.80 76913.80 0.000000 9 73568.969 73568.97 73568.97 0.000000 10 70224.141 70224.14 70224.14 0.000000 11 66879.312 66879.31 66879.31 0.000000 12 63534.484 63534.48 63534.48 0.000000 13 60189.656 60189.66 60189.66 0.000000 14 56844.828 56844.83 56844.83 0.000000 15 53500.000 53500.00 53500.00 0.000000 16 50155.172 50155.17 50155.17 0.000000 17 46810.344 46810.34 46810.35 -0.3906250E-02 18 43465.516 43465.52 43465.52 0.000000 19 40120.688 40120.69 40120.69 0.000000 20 36775.863 36775.86 36775.87 -0.3906250E-02 21 33431.035 33431.04 33431.04 0.000000 22 30086.207 30086.21 30086.21 0.000000 23 26741.379 26741.38 26741.38 0.000000 24 23396.551 23396.55 23396.55 0.000000 25 20051.725 20051.72 20051.73 -0.1953125E-02 26 16706.896 16706.90 16706.90 0.000000 27 13362.068 13362.07 13362.07 0.000000 28 10017.241 10017.24 10017.24 0.9765625E-03 29 6672.414 6672.414 6672.413 0.4882812E-03 ``` 2. Due to cpp ifdefs, the modifications have no impact on the traditionally used compilable code. --- dyn_em/module_initialize_real.F | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/dyn_em/module_initialize_real.F b/dyn_em/module_initialize_real.F index f2d6906f07..be68cc3756 100644 --- a/dyn_em/module_initialize_real.F +++ b/dyn_em/module_initialize_real.F @@ -4930,6 +4930,8 @@ END SUBROUTINE find_my_parent2 #ifdef VERT_UNIT +!gfortran -DVERT_UNIT -ffree-form -ffree-line-length-none module_initialize_real.F -o vert.exe + !This is a main program for a small unit test for the vertical interpolation. program vint @@ -4961,6 +4963,7 @@ program vint logical, parameter :: use_surface = .TRUE. ! .FALSE. ! .TRUE. real , parameter :: zap_close_levels = 500. ! 100. integer, parameter :: force_sfc_in_vinterp = 6 ! 0 ! 6 + integer, parameter :: id = 1 integer :: k @@ -4975,7 +4978,7 @@ program vint print *,'UNIT TEST FOR VERTICAL INTERPOLATION' print *,'------------------------------------' print *,' ' - do lagrange_order = 1 , 9 , 8 + do lagrange_order = 1 , 1 print *,' ' print *,'------------------------------------' print *,'Lagrange Order = ',lagrange_order @@ -5006,7 +5009,7 @@ program vint generic , 'T' , & interp_type , lagrange_order , extrap_type , & lowest_lev_from_sfc , use_levels_below_ground , use_surface , & - zap_close_levels , force_sfc_in_vinterp , & + zap_close_levels , force_sfc_in_vinterp , id , & ids , ide , jds , jde , kds , kde , & ims , ime , jms , jme , kms , kme , & its , ite , jts , jte , kts , kte ) @@ -5052,8 +5055,6 @@ subroutine fillitup ( fo , po , fn , pn , & integer :: i , j , k - real , parameter :: piov2 = 3.14159265358 / 2. - k = 1 do j = jts , jte do i = its , ite @@ -5065,6 +5066,7 @@ subroutine fillitup ( fo , po , fn , pn , & do j = jts , jte do i = its , ite po(i,k,j) = ( 5000. * ( 1 - (k-1) ) + 100000. * ( (k-1) - (generic-1) ) ) / (1. - real(generic-1) ) +! po(i,k,j) = FILL IN YOUR INPUT PRESSURE LEVELS end do end do end do @@ -5074,7 +5076,7 @@ subroutine fillitup ( fo , po , fn , pn , & do j = jts , jte do i = its , ite fo(i,k,j) = po(i,k,j) -! fo(i,k,j) = sin(po(i,k,j) * piov2 / 102000. ) +! fo(i,k,j) = FILL IN YOUR COLUMN OF PRESS_LEVEL FIELD end do end do end do @@ -5083,7 +5085,6 @@ subroutine fillitup ( fo , po , fn , pn , & do j = jts , jte do i = its , ite fo(i,k,j) = (((po(i,k,j)-5000.)/102000.)*((102000.-po(i,k,j))/102000.))*102000. -! fo(i,k,j) = sin(po(i,k,j) * piov2 / 102000. ) end do end do end do @@ -5095,6 +5096,7 @@ subroutine fillitup ( fo , po , fn , pn , & do j = jts , jte do i = its , ite pn(i,k,j) = ( 5000. * ( 0 - (k-1) ) + 102000. * ( (k-1) - (kte-1) ) ) / (-1. * real(kte-1) ) +! pn(i,k,j) = FILL IN A COLUMN OF KNOWN FULL-LEVEL PRESSURES ON ETA SURFACES end do end do end do @@ -5113,7 +5115,7 @@ subroutine fillitup ( fo , po , fn , pn , & do j = jts , jte do i = its , ite fn(i,k,j) = pn(i,k,j) -! fn(i,k,j) = sin(pn(i,k,j) * piov2 / 102000. ) +! fn(i,k,j) = FILL IN COLUMN OF HALF LEVEL FIELD end do end do end do @@ -5137,6 +5139,12 @@ function skip_middle_points_t ( ids , ide , jds , jde , i , j , em_width , hold_ skip_middle_points_t = .false. end function skip_middle_points_t +subroutine wrf_message(level,message) + character(len=*), intent(in) :: message + integer, intent(in) :: level + print *,trim(message) +end subroutine wrf_message + #endif !--------------------------------------------------------------------- From d609495d0fdb7f25c0f5c21b6c95c4072d3b9b34 Mon Sep 17 00:00:00 2001 From: dudhia Date: Mon, 4 Jan 2021 09:04:18 -0700 Subject: [PATCH 26/36] km_opt=5 heat flux fix should just use lowest level qv (#1352) TYPE: bug fix KEYWORDS: km_opt=5, 3d tke scheme, use_theta_m=1 SOURCE: internal DESCRIPTION OF CHANGES: Problem: A previous surface flux fix (61029b1) applied a theta_m correction to all levels. However, this should only be used for qv at the surface. Solution: Switch k to kts in one place where this is applied, and pull the invariant assignment out of the k-index DO loop. LIST OF MODIFIED FILES: M dyn_em/module_diffusion.F TESTS CONDUCTED: Jenkins testing is all pass. RELEASE NOTE: Addendum to heat-flux theta_m fix (61029b1)* correct pwat function to use dry rho for integration --- dyn_em/module_diffusion_em.F | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/dyn_em/module_diffusion_em.F b/dyn_em/module_diffusion_em.F index 00c0d456fd..0c98282352 100644 --- a/dyn_em/module_diffusion_em.F +++ b/dyn_em/module_diffusion_em.F @@ -8127,13 +8127,13 @@ SUBROUTINE vertical_diffusion_implicit(ru_tendf, rv_tendf, rw_tendf, rt_tendf,& + dt*rdz_w*(qfac*hfx(i,j)/cpm+1.61*theta(i,kts,j)*qfx(i,j)) ENDIF + IF(config_flags%use_theta_m == 1)THEN + qfac = 1.+rvovrd*moist(i,kts,j,P_QV) + ELSE + qfac = 1. + ENDIF DO k = kts+1, ktf-1 rdz_w = -g/dnw(k)/(c1h(k)*mu(i,j) + c2h(k)) - IF(config_flags%use_theta_m == 1)THEN - qfac = 1.+rvovrd*moist(i,k,j,P_QV) - ELSE - qfac = 1. - ENDIF a(k) = -rdz_w*rdz(i,k,j)*xkxavg(i,k,j)*dt b(k) = 1.+rdz_w*(rdz(i,k+1,j)*xkxavg(i,k+1,j)+rdz(i,k,j)*xkxavg(i,k,j))*dt c(k) = -rdz_w*rdz(i,k+1,j)*xkxavg(i,k+1,j)*dt From ce5b0cb8bd716e4ef36eb14ea8f7c9fee621076d Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Wed, 6 Jan 2021 21:39:47 -0700 Subject: [PATCH 27/36] Return type on wrf_dm_max_int should be an integer (#1339) TYPE: bug fix KEYWORDS, real, int, integer, wrf_dm_max_int SOURCE: internal DESCRIPTION OF CHANGES: While looking to see if WRF had a function to return the maximum integer from among the max values of integers on each of the MPI ranks, it was noticed that the return value for the existing function was REAL. It should be an INTEGER. There is only a single use of this function in the entire model, in the file `share/module_trajectory.F`. ``` glb_traj_proc(trj) = wrf_dm_max_int( traj_proc(trj) ) ``` In that file, the input to the function, `traj_proc`, and the return value, `glb_traj_proc`, are both declared as integers. Therefore, there is no reason for a function to be given a list of integers, and when finding the max value to actually return that value as a real. ``` integer :: traj_proc(traj_max), glb_traj_proc(traj_max) ``` LIST OF MODIFIED FILES: M external/RSL_LITE/module_dm.F TESTS CONDUCTED: 1. Jenkins tests OK. 2. A small set of trajectories works as expected. ![Screen Shot 2021-01-06 at 6 01 44 PM](https://user-images.githubusercontent.com/12666234/103838081-5f802380-5049-11eb-87ed-648860b7d203.png) --- external/RSL_LITE/module_dm.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/RSL_LITE/module_dm.F b/external/RSL_LITE/module_dm.F index 9527805e97..bf4ded6bb9 100644 --- a/external/RSL_LITE/module_dm.F +++ b/external/RSL_LITE/module_dm.F @@ -1298,7 +1298,7 @@ INTEGER function getrealmpitype() RETURN END FUNCTION getrealmpitype - REAL FUNCTION wrf_dm_max_int ( inval ) + INTEGER FUNCTION wrf_dm_max_int ( inval ) IMPLICIT NONE #ifndef STUBMPI INTEGER, intent(in) :: inval From 432f33db6587452024fefe34893a9084268f8dc6 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Thu, 7 Jan 2021 14:15:06 -0700 Subject: [PATCH 28/36] Fix examples.namelist info RE: trajectories (#1340) TYPE: text only KEYWORDS: namelist, readme SOURCE: internal DESCRIPTION OF CHANGES: The trajectory examples.namelist was no longer providing sufficient info to run trajectories. 1. One of the helpful suggestions had a misspelled namelist record. It should have been `domains`, but it was referred to as `domain`. 2. There was no info on the additional options required: `dm_has_traj`. 3. There was no mention of the now mandatory additional text file `wrfinput_traj_d01` that has two namelist records. LIST OF MODIFIED FILES: M test/em_real/examples.namelist TESTS CONDUCTED: 1. This readme is not part of the build process, or part of compilable code. It will have no impact of results. Users likely also just skip past the incorrect namelist record identifier and grab the intended variable (num_traj). All in all, pretty small potatoes. 2. The jenksins tests pass, but no surprise - since we did not change anything that is part of the build. --- test/em_real/examples.namelist | 41 +++++++++++++++++++++++++++++++--- 1 file changed, 38 insertions(+), 3 deletions(-) diff --git a/test/em_real/examples.namelist b/test/em_real/examples.namelist index db55bd6e8c..c32f6043ed 100755 --- a/test/em_real/examples.namelist +++ b/test/em_real/examples.namelist @@ -492,13 +492,48 @@ Price, J. F., T. B. Sanford, and G. Z. Forristal, 1994: Forced stage response to -** Using U. Miami Forward Lagrangian trajectory calculation - (add it in namelist record &physics): -&domain +** Using the ACOM Forward Lagrangian trajectory calculation: + +&domains num_traj = 25, &physics traj_opt = 1, + dm_has_traj = .true., ..true., .true. + + +For domain #1, the file must "wrfinput_traj_d01" exist in the working directory. Similarly for domain 2, 3, etc. Each domain +has a separate file for a namelist. + +&traj_default + traj_def%start_time = '2000-01-24_12:00:00', + traj_def%stop_time = '2000-01-25_12:00:00', + traj_def%dyn_name(1:6) = 'p', 'T', 'z', 'u', 'v', 'w', + traj_def%hyd_name(1) = 'QVAPOR', +/ + +&traj_spec + traj_type%start_time = '2000-01-24_12:00:00', '2000-01-24_12:00:00', + '2000-01-24_12:00:00', '2000-01-24_12:00:00', + '2000-01-24_12:00:00', '2000-01-24_12:00:00', + '2000-01-24_12:00:00', '2000-01-24_12:00:00', + '2000-01-24_12:00:00', '2000-01-24_12:00:00', + '2000-01-24_12:00:00', + traj_type%stop_time = '2000-01-25_12:00:00', '2000-01-25_12:00:00', + '2000-01-25_12:00:00', '2000-01-25_12:00:00', + '2000-01-25_12:00:00', '2000-01-25_12:00:00', + '2000-01-25_12:00:00', '2000-01-25_12:00:00', + '2000-01-25_12:00:00', '2000-01-25_12:00:00', + '2000-01-25_12:00:00', + traj_type%lev = 60., 60., 60., 60., 60., 60., 60., 60., 60., 60., 60., + traj_type%lon = -79.88470, -79.74551, -79.60422, -79.46072, + -79.31503, -79.16708, -79.01682, -78.86417, + -78.70911, -78.55151, -78.39142, + traj_type%lat = 29.18063, 29.70515, 30.23069, 30.75718, + 31.28461, 31.81292, 32.34208, 32.87204, + 33.40276, 33.93421, 34.46631, +/ + ** Vertical nesting From 0a9c2eb2dc8d81246dd6a4f2d739396c84043fef Mon Sep 17 00:00:00 2001 From: Ryan Cabell Date: Thu, 7 Jan 2021 17:41:52 -0700 Subject: [PATCH 29/36] Add missing compiler name for two Intel config stanzas (#1326) TYPE: bug fix KEYWORDS: build, hydro, intel, stanza SOURCE: Ryan Cabell (NCAR) DESCRIPTION OF CHANGES: Problem: Building coupled WRF/WRF Hydro models fails when choosing configuration INTEL (ifort/icc): HSW/BDW. Solution: Add missing `ifort compiler with icc` text to ARCH line for the HSW/BDW configuration. For completeness, the KNL MIC configure stanza was also missing the same information, and has been updated. Neither of these stanzas are involved in the traditional WRF code build, so there is no impact on users of the default WRF atmosphere model. ISSUE: For use when this PR closes an issue. Fixes #1325 LIST OF MODIFIED FILES: M arch/configure.defaults TESTS CONDUCTED: 1. Modification causes WRF-Hydro build to complete successfully with the `INTEL (ifort/icc): HSW/BDW` configuration 2. Jenkins testing all positive --- arch/configure.defaults | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/arch/configure.defaults b/arch/configure.defaults index 026d6f4ce5..692fbfe9c3 100644 --- a/arch/configure.defaults +++ b/arch/configure.defaults @@ -1834,7 +1834,7 @@ RLFLAGS = CC_TOOLS = $(SCC) ########################################################### -#ARCH Linux x86_64 ppc64le i486 i586 i686 #serial smpar dmpar dm+sm +#ARCH Linux x86_64 ppc64le i486 i586 i686, ifort compiler with icc #serial smpar dmpar dm+sm # DESCRIPTION = INTEL ($SFC/$SCC): HSW/BDW DMPARALLEL = # 1 @@ -1878,7 +1878,7 @@ RLFLAGS = CC_TOOLS = $(SCC) ########################################################### -#ARCH Linux KNL x86_64 ppc64le i486 i586 i686 #serial smpar dmpar dm+sm +#ARCH Linux KNL x86_64 ppc64le i486 i586 i686, ifort compiler with icc #serial smpar dmpar dm+sm # DESCRIPTION = INTEL ($SFC/$SCC): KNL MIC DMPARALLEL = # 1 From 062b45114f226a0f32dbf2e37b6882af29bd31e4 Mon Sep 17 00:00:00 2001 From: Milan Curcic Date: Tue, 12 Jan 2021 16:18:38 -0500 Subject: [PATCH 30/36] Remove obsolescent and non-standard features in physics modules (#1273) TYPE: Bug fix KEYWORDS: Fix, obsolescent, non-standard, features SOURCE: Milan Curcic (University of Miami) DESCRIPTION OF CHANGES: Problem: This PR removes or fixes some obsolescent and non-standard features in several physics modules which were preventing WRF to be built with IBM XL v16.1.1 on Power9, as reported in #1270. Solution: 1. Replace amax1() occurrences with max() 2. Explicitly cast literal constants that are passed to min() and max() intrinsics so that they are type and kind compatible with other arguments 3. Replace calls to the non-standard flush() subroutine with the standard flush() statement. ISSUE: Fixes #1270 LIST OF MODIFIED FILES: M phys/module_cu_mskf.F M phys/module_cu_scalesas.F M phys/module_dust_emis.F M phys/module_mp_fast_sbm.F M phys/module_mp_milbrandt2mom.F M phys/module_mp_p3.F M phys/module_mp_thompson.F M phys/module_ra_goddard.F M phys/module_shcu_deng.F TESTS CONDUCTED: These fixes were necessary to allow WRF to be built and run on IBM Power9 with the XL v16.1.1 compiler. The executables build in both single (./configure) and double (./configure -r8) precision modes. Jenkins testing is all pass. RELEASE NOTE: Several physics modules were updated to be more Fortran standard-conforming. This PR removes or fixes some obsolescent and non-standard features in these physics modules which were preventing WRF to be built with IBM XL v16.1.1 on Power9. --- phys/module_cu_mskf.F | 28 +++++++++---------- phys/module_cu_scalesas.F | 2 +- phys/module_dust_emis.F | 6 ++-- phys/module_mp_fast_sbm.F | 2 +- phys/module_mp_milbrandt2mom.F | 6 ++-- phys/module_mp_p3.F | 4 +-- phys/module_mp_thompson.F | 2 +- phys/module_ra_goddard.F | 50 +++++++++++++++++----------------- phys/module_shcu_deng.F | 4 +-- 9 files changed, 52 insertions(+), 52 deletions(-) diff --git a/phys/module_cu_mskf.F b/phys/module_cu_mskf.F index 1f107a9ebe..0292f99713 100644 --- a/phys/module_cu_mskf.F +++ b/phys/module_cu_mskf.F @@ -1762,8 +1762,8 @@ subroutine mskf_mphy(su, qu, mu, du, cmel, cmei, zf, pm, te, qe, ep mtime=deltat/900._r8 mtimec=deltat/900._r8 - mtime = AMAX1(1.0,mtime) !TWG remove time scale limitation from CAM5 - mtimec = AMAX1(1.0,mtimec) + mtime = max(1.0_r8,mtime) !TWG remove time scale limitation from CAM5 + mtimec = max(1.0_r8,mtimec) ! conservation of qc @@ -5160,19 +5160,19 @@ SUBROUTINE MSKF_eta_PARA (I, J, & JK = KX-KQ+1 ! print *,'kf qliq=', QLIQ(KQ) - QLIQ(KQ) = amax1(0.0,zmqliq(1,JK)) - QICE(KQ) = amax1(0.0,zmqice(1,JK)) + QLIQ(KQ) = max(0._r8,zmqliq(1,JK)) + QICE(KQ) = max(0._r8,zmqice(1,JK)) !TWG 06/14/16 - QRAIN(KQ) = amax1(0.0,zmqrain(1,JK)) - QSNOW(KQ) = amax1(0.0,zmqsnow(1,JK)) - NLIQ(KQ) = amax1(0.0,ncmp(1,JK)) - NICE(KQ) = amax1(0.0,nimp(1,JK)) - NRAIN(KQ) = amax1(0.0,nrmp(1,JK)) - NSNOW(KQ) = amax1(0.0,nsmp(1,JK)) - CCN(KQ) = amax1(0.0,zmccn(1,JK)) - EFFCH(KQ) = MAX(2.49, MIN(effc(1,JK), 50.)) - EFFIH(KQ) = MAX(4.99, MIN(effi(1,JK), 125.)) - EFFSH(KQ) = MAX(9.99, MIN(effs(1,JK), 999.)) + QRAIN(KQ) = max(0._r8,zmqrain(1,JK)) + QSNOW(KQ) = max(0._r8,zmqsnow(1,JK)) + NLIQ(KQ) = max(0._r8,ncmp(1,JK)) + NICE(KQ) = max(0._r8,nimp(1,JK)) + NRAIN(KQ) = max(0._r8,nrmp(1,JK)) + NSNOW(KQ) = max(0._r8,nsmp(1,JK)) + CCN(KQ) = max(0._r8,zmccn(1,JK)) + EFFCH(KQ) = max(2.49_r8, min(effc(1,JK), 50._r8)) + EFFIH(KQ) = max(4.99_r8, min(effi(1,JK), 125._r8)) + EFFSH(KQ) = max(9.99_r8, min(effs(1,JK), 999._r8)) ! END TWG DETLQ(KQ)= QLIQ(KQ)*UDR(KQ) DETIC(KQ)= QICE(KQ)*UDR(KQ) diff --git a/phys/module_cu_scalesas.F b/phys/module_cu_scalesas.F index 937ed93172..ec11287d73 100755 --- a/phys/module_cu_scalesas.F +++ b/phys/module_cu_scalesas.F @@ -4222,7 +4222,7 @@ subroutine mfshalcnv(im,ix,km,delt,delp,prslp,psp,phil,ql, & if(cnvflg(i)) then if (gdx(i) < dxcrt) then scaldfunc(i) = (1.-sigmagfm(i)) * (1.-sigmagfm(i)) - scaldfunc(i) = max(min(scaldfunc(i), 1.0), 0._kind_phys) + scaldfunc(i) = max(min(scaldfunc(i), 1._kind_phys), 0._kind_phys) else scaldfunc(i) = 1.0 endif diff --git a/phys/module_dust_emis.F b/phys/module_dust_emis.F index f022eb5116..b171ff979f 100644 --- a/phys/module_dust_emis.F +++ b/phys/module_dust_emis.F @@ -142,7 +142,7 @@ subroutine bulk_dust_emis (ktau,dt,num_soil_layers,u_phy,v_phy, & ! increase erodability where the surface albedo is high to account better for real deserts if (erodin .gt. 1.E-8 .AND. albbck(i,j).gt.0.175 .and. vegfra(i,j).lt.12.5) then - erodin = MIN(0.5, erodin + 0.1*albbck(i,j)) + erodin = min(0.5d0, dble(erodin + 0.1*albbck(i,j))) endif ! volumetric soil moisture over porosity @@ -158,14 +158,14 @@ subroutine bulk_dust_emis (ktau,dt,num_soil_layers,u_phy,v_phy, & ! Case of surface dry enough to erode IF (gwet < 0.5) THEN ! Pete's modified value ! IF (gwet < 0.2) THEN - u_ts = MAX(0.0D+0,u_ts0*(1.2D+0+2.0D-1*LOG10(MAX(1.0D-3, gwet)))) + u_ts = max(0.0d0,dble(u_ts0*(1.2d0+2.0d-1*log10(max(1.0d-3, dble(gwet)))))) ELSE ! Case of wet surface, no erosion u_ts = 100.0 END IF srce = frac_s(n)*erodin*dxy ! (m2) ! srce = 1.1*erodin*dxy ! (m2) - dsrc = MAX(0.0, ch_dust(n,month)*srce*w10m*w10m *(w10m - u_ts)*dt) ! (kg) + dsrc = max(0.0d0, dble(ch_dust(n,month)*srce*w10m*w10m *(w10m - u_ts)*dt)) ! (kg) ! unit change from kg/timestep/cell to ug/m2/s ! totalemis=((dsrc)/dt)*converi/dxy diff --git a/phys/module_mp_fast_sbm.F b/phys/module_mp_fast_sbm.F index 6a612f4b45..ec02a2aaf4 100644 --- a/phys/module_mp_fast_sbm.F +++ b/phys/module_mp_fast_sbm.F @@ -1978,7 +1978,7 @@ SUBROUTINE JERSUPSAT_KS (DEL1,DEL2,DEL1N,DEL2N, & IRI = 1 IPI = 1 - IF(AMAX1(RW,PW,RI,PI)<=RW_PW_RI_PI_MIN) THEN + IF(max(RW,PW,RI,PI)<=RW_PW_RI_PI_MIN) THEN RW = 0.0 IRW = 0 diff --git a/phys/module_mp_milbrandt2mom.F b/phys/module_mp_milbrandt2mom.F index a1304348ad..e7b1a33838 100644 --- a/phys/module_mp_milbrandt2mom.F +++ b/phys/module_mp_milbrandt2mom.F @@ -190,7 +190,7 @@ real FUNCTION gamma(xx) gammadp= exp(gammadp) !!GEM: - gamma = sngl(gammadp) + gamma = gammadp END FUNCTION gamma !======================================================================! @@ -260,7 +260,7 @@ real FUNCTION gammln(xx) enddo !! GEM: - gammln= sngl( tmp+log(stp*ser/x) ) + gammln=tmp+log(stp*ser/x) END FUNCTION gammln !======================================================================! @@ -3051,7 +3051,7 @@ SUBROUTINE mp_milbrandt2mom_main(WZ,T,Q,QC,QR,QI,QN,QG,QH,NC,NR,NY,NN,NG,NH,PS, LAMr = 1./iLAMr !note: The following coding of 'No_r=...' prevents overflow: !No_r = NR(i,k)*LAMr**(1.+alpha_r))*iGR31 - No_r = sngl(dble(NR(i,k))*dble(LAMr)**dble(1.+alpha_r))*iGR31 + No_r = dble(NR(i,k))*dble(LAMr)**dble(1.+alpha_r)*iGR31 !note: There is an error in MY05a_eq(8) for VENTx (corrected in code) VENTr = Avx*GR32*iLAMr**cexr5 + Bvx*ScTHRD*sqrt(gam*afr*iMUkin)*GR17*iLAMr**cexr6 ABw = CHLC**2/(Ka*RGASV*T(i,k)**2)+1./(DE(i,k)*(QSW(i,k))*Cdiff) diff --git a/phys/module_mp_p3.F b/phys/module_mp_p3.F index f0b7c6d6b4..b6968444c7 100644 --- a/phys/module_mp_p3.F +++ b/phys/module_mp_p3.F @@ -354,7 +354,7 @@ subroutine p3_init(lookup_file_dir,nCat,model,stat,abort_on_err) if (global_status == STATUS_ERROR) then if (err_abort) then print*,'Stopping in P3 init' - call flush(6) + flush(6) stop endif return @@ -430,7 +430,7 @@ subroutine p3_init(lookup_file_dir,nCat,model,stat,abort_on_err) if (global_status == STATUS_ERROR) then if (err_abort) then print*,'Stopping in P3 init' - call flush(6) + flush(6) stop endif return diff --git a/phys/module_mp_thompson.F b/phys/module_mp_thompson.F index 9e5dbddc52..4fb4e9ddeb 100644 --- a/phys/module_mp_thompson.F +++ b/phys/module_mp_thompson.F @@ -3009,7 +3009,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & ! -tpc_wev(idx_d, idx_c, idx_n)*orho*odt) prw_vcd(k) = MAX(DBLE(-rc(k)*0.99*orho*odt), prw_vcd(k)) pnc_wcd(k) = MAX(DBLE(-nc(k)*0.99*orho*odt), & - -tnc_wev(idx_d, idx_c, idx_n)*orho*odt) + DBLE(-tnc_wev(idx_d, idx_c, idx_n)*orho*odt)) endif else diff --git a/phys/module_ra_goddard.F b/phys/module_ra_goddard.F index f4ebeb3204..54d0d12d3e 100644 --- a/phys/module_ra_goddard.F +++ b/phys/module_ra_goddard.F @@ -5254,7 +5254,7 @@ subroutine swrad ( np,cosz, pl,ta,wa,oa, fcld,ict,icb, & !dir$ vector aligned DO ic=1,irestrict if(lmask(ic) .eqv. .true.) then - df_sub(ic,k) = max(df(ic,k) - df(ic,k-1), 0.) !df for each layer (remove negative df_sub) + df_sub(ic,k) = max(df(ic,k) - df(ic,k-1), 0._fp_kind) !df for each layer (remove negative df_sub) endif ENDDO enddo @@ -5275,7 +5275,7 @@ subroutine swrad ( np,cosz, pl,ta,wa,oa, fcld,ict,icb, & !dir$ vector aligned DO ic=1,irestrict if(lmask(ic) .eqv. .true.) then - flc(ic,k)=max(flc(ic,k)-df_clr(ic,k),0.) !this filter is for small cosine zenith angle. + flc(ic,k)=max(flc(ic,k)-df_clr(ic,k),0._fp_kind) !this filter is for small cosine zenith angle. endif ENDDO enddo @@ -5316,7 +5316,7 @@ subroutine swrad ( np,cosz, pl,ta,wa,oa, fcld,ict,icb, & i_tau = min(max(int(cld_alb*10.)+1,1),10) !1~10 ratio = ratio_lut(i_tau,i_cos) else !use computed clear and cloudy flux ratio (not fast_overcast) - ratio = max(0.01, min(1.,(flx(ic,k)/flc(ic,k)))) + ratio = max(0.01_fp_kind, min(1._fp_kind,(flx(ic,k)/flc(ic,k)))) endif df_sub(ic,k) = df_sub(ic,k)*ratio !compute cloudy-sky df_sub enddo !k @@ -5340,8 +5340,8 @@ subroutine swrad ( np,cosz, pl,ta,wa,oa, fcld,ict,icb, & !dir$ vector aligned DO ic=1,irestrict if(lmask(ic) .eqv. .true.) then - flx(ic,k) = max(flx(ic,k)-df_cld(ic,k) , 0.) !this max is for small cosz - flxd(ic,k) = max(flxd(ic,k)-df_cld(ic,k), 0.) !this max is for small cosz + flx(ic,k) = max(flx(ic,k)-df_cld(ic,k) , 0._fp_kind) !this max is for small cosz + flxd(ic,k) = max(flxd(ic,k)-df_cld(ic,k), 0._fp_kind) !this max is for small cosz flxu(ic,k) = flx(ic,k)-flxd(ic,k) endif ENDDO @@ -5361,7 +5361,7 @@ subroutine swrad ( np,cosz, pl,ta,wa,oa, fcld,ict,icb, & if ( (fdirir(ic)-df_cld(ic,np+1)) >= 0. ) then ! normal fdirir(ic)=fdirir(ic)-df_cld(ic,np+1) ! updated else ! if negative, it also reduces diffuse component. - fdifir(ic) = MAX(0., fdifir(ic) + (fdirir(ic)-df_cld(ic,np+1)) ) + fdifir(ic) = max(0._fp_kind, fdifir(ic) + (fdirir(ic)-df_cld(ic,np+1)) ) fdirir(ic)=0. endif ! @@ -5717,7 +5717,7 @@ subroutine sw_uvpar (np,wh,oh,dp, & !-----for direct incident radiation ! the effective layer optical properties. eqs. (6.2)-(6.4) !modify max & min - tautob(ic)=tausto(ic) + max(tauclb(ic,k,ib),0.e0) + tautob(ic)=tausto(ic) + max(tauclb(ic,k,ib),0._fp_kind) ssatob(ic)=min(max((ssatau(ic)+ssacl(ic,k,ib)*tauclb(ic,k,ib))/tautob(ic) , ssa_min), ssa_max) !SSA of cloud is unity asytob(ic)=min(max((asysto(ic)+asycl(ic,k,ib)*ssacl(ic,k,ib)*tauclb(ic,k,ib)) & /( max(ssatob(ic)*tautob(ic),const_tiny) ),asy_min), asy_max) @@ -6176,7 +6176,7 @@ subroutine sw_ir (np,wh,dp, & !-----compute reflectance and transmittance of the cloudy portion of a layer !-----for direct incident radiation. eqs.(6.2)-(6.4) - tautob(ic,k)=tausto(ic,k)+max(tauclb(ic,k),0.e0) + tautob(ic,k)=tausto(ic,k)+max(tauclb(ic,k),0._fp_kind) ssatob(ic,k)=min(max((ssatau(ic,k)+ssacl(ic,k,iv)*tauclb(ic,k))/tautob(ic,k),ssa_min),ssa_max) asytob(ic,k)=min(max((asysto(ic,k)+asycl(ic,k,iv)*ssacl(ic,k,iv)*tauclb(ic,k)) & /( max(ssatob(ic,k)*tautob(ic,k),const_tiny) ),ssa_min),ssa_max) @@ -6187,7 +6187,7 @@ subroutine sw_ir (np,wh,dp, & ssatof(ic,k)=ssatob(ic,k) asytof(ic,k)=asytob(ic,k) else - tautof(ic,k)=tausto(ic,k)+max(tauclf(ic,k),0.e0) + tautof(ic,k)=tausto(ic,k)+max(tauclf(ic,k),0._fp_kind) ssatof(ic,k)=min(max((ssatau(ic,k)+ssacl(ic,k,iv)*tauclf(ic,k))/tautof(ic,k),ssa_min),ssa_max) asytof(ic,k)=min(max((asysto(ic,k)+asycl(ic,k,iv)*ssacl(ic,k,iv)*tauclf(ic,k)) & /( max(ssatof(ic,k)*tautof(ic,k),const_tiny) ),asy_min),asy_max) @@ -6529,7 +6529,7 @@ subroutine cloud_scale (np,cosz,fcld,taucld,ict,icb, & !-----normalize cloud cover following eq. (7.8) fa=fcld(ic,k)/cc(ic,kk) !-----table look-up - taux=min(taux,32.) + taux=min(taux,32._fp_kind) fm=cosz(ic)/dm ft=(log10(taux)-t1)/dt fa=fa/da @@ -6555,8 +6555,8 @@ subroutine cloud_scale (np,cosz,fcld,taucld,ict,icb, & xai=xai+(-caib(im,it,ia-1)*(1.-fa)+ & caib(im,it,ia+1)*(1.+fa))*fa*.5+caib(im,it,ia)*(1.-fa*fa) xai= xai-2.*caib(im,it,ia) - xai=max(xai,0.0) - xai=min(xai,1.0) + xai=max(xai,0._fp_kind) + xai=min(xai,1._fp_kind) tauclb(ic,k) = taux*xai !-----scale cloud optical thickness for diffuse radiation following eq. (7.4) ! the scaling factor, xai, is a function of the cloud optical @@ -6566,8 +6566,8 @@ subroutine cloud_scale (np,cosz,fcld,taucld,ict,icb, & xai=xai+(-caif(it,ia-1)*(1.-fa)+ & caif(it,ia+1)*(1.+fa))*fa*.5+caif(it,ia)*(1.-fa*fa) xai= xai-caif(it,ia) - xai=max(xai,0.0) - xai=min(xai,1.0) + xai=max(xai,0._fp_kind) + xai=min(xai,1._fp_kind) tauclf(ic,k) = taux*xai endif endif @@ -10427,11 +10427,11 @@ subroutine lwrad ( np, emiss, tb, ts, ict, icb,& !new dp (ic,k) = pl(ic,k+1)-pl(ic,k) dh2o (ic,k) = 1.02*wa(ic,k)*dp(ic,k) - dh2o (ic,k) = max(dh2o (ic,k),1.e-30) + dh2o (ic,k) = max(dh2o (ic,k),1.e-30_fp_kind) do3 (ic,k) = 476.*oa(ic,k)*dp(ic,k) - do3 (ic,k) = max(do3 (ic,k),1.e-30) + do3 (ic,k) = max(do3 (ic,k),1.e-30_fp_kind) dco2 (ic,k) = 789.*co2*dp(ic,k) - dco2 (ic,k) = max(dco2 (ic,k),1.e-30) + dco2 (ic,k) = max(dco2 (ic,k),1.e-30_fp_kind) dch4 (ic,k) = 789.*ch4*dp(ic,k) dn2o (ic,k) = 789.*n2o*dp(ic,k) df11 (ic,k) = 789.*cfc11*dp(ic,k) @@ -10576,7 +10576,7 @@ subroutine lwrad ( np, emiss, tb, ts, ict, icb,& taux=taux*(1.-ww*ff) !-----compute cloud diffuse transmittance. it is approximated by using ! a diffusivity factor of 1.66. - tauxa=max(0.,1.66*taux) + tauxa=max(0._fp_kind,1.66*taux) tcldlyr(ic,k)=0. if(tauxa.lt.80.) tcldlyr(ic,k)=exp(-tauxa) endif @@ -10885,8 +10885,8 @@ subroutine lwrad ( np, emiss, tb, ts, ict, icb,& if (k2 .eq. k1+1) then !dir$ vector aligned DO ic=1,irestrict - yy=min(0.999,trant(ic)) - yy=max(0.001,yy) + yy=min(0.999_fp_kind,trant(ic)) + yy=max(0.001_fp_kind,yy) !-hmhj use log instead of alog for default intrinsic function xx=(blevel(ic,k1)-blevel(ic,k2))/ log(yy) bu=(blevel(ic,k1)-blevel(ic,k2)*yy)/(1.0-yy)+xx @@ -11652,9 +11652,9 @@ subroutine tablup(k1,k2,np,nx,nh,sabs,spre,stem,w1,p1, & !-----normalize we and pe pe=(log10(x2)-p1)/dpe !-----restrict the magnitudes of the normalized we and pe. - we=min(we,REAL(nh-1)) - pe=max(pe,0.0) - pe=min(pe,REAL(nx-1)) + we=min(we,real(nh-1,kind=fp_kind)) + pe=max(pe,0._fp_kind) + pe=min(pe,real(nx-1,kind=fp_kind)) !-----assign iw and ip and compute the distance of we and pe ! from iw and ip. iw=int(we+1.0) @@ -11684,8 +11684,8 @@ subroutine tablup(k1,k2,np,nx,nh,sabs,spre,stem,w1,p1, & t2 = ca*(1.-fw) + cb*fw !-----update the total transmittance between levels k1 and k2 tran(ic)= (ax + (t1+t2*x3) * x3)*tran(ic) - tran(ic)=min(tran(ic),0.9999999) - tran(ic)=max(tran(ic),0.0000001) + tran(ic)=min(tran(ic),0.9999999_fp_kind) + tran(ic)=max(tran(ic),0.0000001_fp_kind) else tran(ic)=0.9999999 endif diff --git a/phys/module_shcu_deng.F b/phys/module_shcu_deng.F index e9146ca580..edba0e5ce6 100644 --- a/phys/module_shcu_deng.F +++ b/phys/module_shcu_deng.F @@ -4475,7 +4475,7 @@ SUBROUTINE TPMIX2(p,thes,tu,qu,qliq,qice,qnewlq,qnewic,XLV1,XLV0,ktau,i,j,nk,tra IF(IPTB.GE.220 .OR. IPTB.LE.1 .OR. ITHTB.GE.250 .OR. ITHTB.LE.1)THEN write(98,'(a,6i5,2f9.2,i3)')'*** OUT OF BOUNDS ***', ktau,i,j,nk,IPTB, ITHTB, & p/100.0, thes, tracker - call flush(98) + flush(98) ENDIF ! t00=ttab(ithtb ,iptb ) @@ -4793,7 +4793,7 @@ SUBROUTINE TPMIX2DD(p,thes,ts,qs,ktau,i,j,nk) ithtb=int(tth)+1 IF(IPTB.GE.220 .OR. IPTB.LE.1 .OR. ITHTB.GE.250 .OR. ITHTB.LE.1)THEN write(97,'(a,6i5,2f9.2)')'*** OUT OF BOUNDS ***', ktau,i,j,nk,IPTB, ITHTB, p/100., thes - call flush(97) + flush(97) ENDIF ! t00=ttab(ithtb ,iptb ) From 650be0c7d76f8e4969a36a7d311713a20aeab47a Mon Sep 17 00:00:00 2001 From: Timothy Juliano <46979614+twjuliano@users.noreply.github.com> Date: Tue, 12 Jan 2021 15:38:18 -0700 Subject: [PATCH 31/36] Bug fixes related to solar diag package: COS(zenith angle), non-existent hydrometeors, shortwave irradiances in time series (#1284) TYPE: bug fix, enhancement KEYWORDS: solar diagnostic, shortwave irradiance, solar zenith, hydrometeor, cloud SOURCE: Timothy W. Juliano, Ju-Hye Kim, Pedro A. Jimenez, Jared Lee, Thomas Brummet (NCAR/RAL) DESCRIPTION OF CHANGES: Bug fixes Problem: 1. Value of cosine solar zenith angle (coszen) can be slightly <-1 or slightly >1, which results in a nonphysical value for diagnosis of the solar zenith angle 2. Calculating cloud parameters in solar diagnostic package when hydrometeor type is not present Solution: 1. Bound the values of coszen to be [-1, 1] 2. Add conditional check in solar diagnostic module for presence of hydrometeor type before calculating cloud parameters. Also add check for summation of water path variables to ensure >=0.0 kg/m2. Enhancement We have added the Global Horizontal Irradiance (SWDOWN), Direct Normal Irradiance (SWDDNI), and Diffuse Horizontal Irradiance (SWDDIF), as well as the clear-sky Global Horizontal Irradiance (SWDOWNC) and clear-sky Direct Normal Irradiance (SWDDNIC) variables to the tslist when the solar diagnostic package is activated. Furthermore, we add these five variables as calculated by FARMS: SWDOWN2, SWDDNI2, SWDDIF2, SWDOWNC2, and SWDDNIC2. All 10 variables are output regardless of model physics configuration. Variables SWDOWN, SWDDNI, and SWDDIF are calculated when any shortwave radiation scheme is active. If the RRTMG (ra_sw_physics=4) or RRTMG FAST (ra_sw_physics=24) shortwave radiation scheme or FARMS (swint_opt=2) is activated, then variables SWDOWNC and SWDDNIC are calculated [otherwise, set to MISSING (=-999.0)]. If FARMS (swint_opt=2) is activated, then variables SWDOWN2, SWDDNI2, SWDDIF2, SWDOWNC2, and SWDDNIC2 are calculated [otherwise, set to MISSING (=-999.0)]. LIST OF MODIFIED FILES: M Registry/Registry.EM_COMMON M Registry/registry.solar_fields M phys/module_diag_solar.F M phys/module_diagnostics_driver.F M phys/module_radiation_driver.F M run/README.tslist M share/wrf_timeseries.F TESTS CONDUCTED: 1. We have run simulations with and without the fixes. Problem 1: When coszen is within the range [-1, 1], the model results are bit for bit identical before and after the change. Problem 2: The model output confirms that the cloud parameters are not calculated when the hydrometeor type is not present and also that the water path variables are positive. Enhancement: The tslist output is written as expected. 2. Jenkins testing is all PASS. RELEASE NOTE: Several fixes are introduced for the solar diagnostic package: 1) Correct solar zenith angle calculation (this will have a small effect on radiation for all schemes); and 2) check presence of hydrometeor type before calculating cloud parameters. An enhancement to the package is also introduced: Adding shortwave irradiance variables to the tslist when activating the RRTMG or RRTMG FAST shortwave radiation scheme or FARMS. --- Registry/Registry.EM_COMMON | 2 +- Registry/registry.solar_fields | 10 ++ phys/module_diag_solar.F | 188 +++++++++++++++++++------------ phys/module_diagnostics_driver.F | 4 +- phys/module_radiation_driver.F | 1 + run/README.tslist | 10 ++ share/wrf_timeseries.F | 86 +++++++++++++- 7 files changed, 227 insertions(+), 74 deletions(-) diff --git a/Registry/Registry.EM_COMMON b/Registry/Registry.EM_COMMON index 869dff658c..9e7202afed 100644 --- a/Registry/Registry.EM_COMMON +++ b/Registry/Registry.EM_COMMON @@ -3063,7 +3063,7 @@ package icedepth_one seaice_thickness_opt==1 - state:icedept #Time series options for text output package notseries process_time_series==0 - - package tseries process_time_series==1 - state:ts_hour,ts_u,ts_v,ts_q,ts_t,ts_psfc,ts_glw,ts_gsw,ts_hfx,ts_lh,ts_tsk,ts_tslb,ts_clw,ts_rainc,ts_rainnc,ts_u_profile,ts_v_profile,ts_gph_profile,ts_th_profile,ts_p_profile,ts_w_profile -package tseries_add_solar process_time_series==2 - state:ts_hour,ts_u,ts_v,ts_q,ts_t,ts_psfc,ts_glw,ts_gsw,ts_hfx,ts_lh,ts_tsk,ts_tslb,ts_clw,ts_rainc,ts_rainnc,ts_u_profile,ts_v_profile,ts_gph_profile,ts_th_profile,ts_cldfrac2d,ts_wvp,ts_lwp,ts_iwp,ts_swp,ts_lwp_tot,ts_iwp_tot,ts_swp_tot,ts_re_qc,ts_re_qi,ts_re_qs,ts_re_qc_tot,ts_re_qi_tot,ts_re_qs_tot,ts_tau_qc,ts_tau_qi,ts_tau_qs,ts_tau_qc_tot,ts_tau_qi_tot,ts_tau_qs_tot,ts_cbaseht,ts_ctopht,ts_cbaseht_tot,ts_ctopht_tot,ts_clrnidx,ts_p_profile,ts_w_profile +package tseries_add_solar process_time_series==2 - state:ts_hour,ts_u,ts_v,ts_q,ts_t,ts_psfc,ts_glw,ts_gsw,ts_hfx,ts_lh,ts_tsk,ts_tslb,ts_clw,ts_rainc,ts_rainnc,ts_u_profile,ts_v_profile,ts_gph_profile,ts_th_profile,ts_cldfrac2d,ts_wvp,ts_lwp,ts_iwp,ts_swp,ts_lwp_tot,ts_iwp_tot,ts_swp_tot,ts_re_qc,ts_re_qi,ts_re_qs,ts_re_qc_tot,ts_re_qi_tot,ts_re_qs_tot,ts_tau_qc,ts_tau_qi,ts_tau_qs,ts_tau_qc_tot,ts_tau_qi_tot,ts_tau_qs_tot,ts_cbaseht,ts_ctopht,ts_cbaseht_tot,ts_ctopht_tot,ts_clrnidx,ts_p_profile,ts_w_profile,ts_swdown,ts_swddni,ts_swddif,ts_swdownc,ts_swddnic,ts_swdown2,ts_swddni2,ts_swddif2,ts_swdownc2,ts_swddnic2 # WRF-HAILCAST state real HAILCAST_DHAIL1 ij misc 1 - r "HAILCAST_DHAIL1" "WRF-HAILCAST Hail Diameter, 1st rank order" "mm" diff --git a/Registry/registry.solar_fields b/Registry/registry.solar_fields index 6cd55e6ba6..2855d4642b 100644 --- a/Registry/registry.solar_fields +++ b/Registry/registry.solar_fields @@ -61,6 +61,16 @@ state real ts_cbaseht_tot ?! misc - - - "TS_C state real ts_ctopht_tot ?! misc - - - "TS_CTOPHT_TOT" "CLOUD TOP HEIGHT RES + UNRES" state real ts_clrnidx ?! misc - - - "TS_CLRNIDX" "CLEARNESS INDEX" state real ts_sza ?! misc - - - "TS_SZA" "SOLAR ZENITH ANGLE" +state real ts_swdown ?! misc - - - "TS_SWDOWN" "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE" +state real ts_swddni ?! misc - - - "TS_SWDDNI" "SHORTWAVE SURFACE DOWNWARD DIRECT NORMAL IRRADIANCE" +state real ts_swddif ?! misc - - - "TS_SWDDIF" "SHORTWAVE SURFACE DOWNWARD DIFFUSE IRRADIANCE" +state real ts_swdownc ?! misc - - - "TS_SWDOWNC" "DOWNWARD CLEAR-SKY SHORTWAVE FLUX AT GROUND SURFACE" +state real ts_swddnic ?! misc - - - "TS_SWDDNIC" "CLEAR-SKY SHORTWAVE SURFACE DOWNWARD DIRECT NORMAL IRRADIANCE" +state real ts_swdown2 ?! misc - - - "TS_SWDOWN2" "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE FROM FARMS" +state real ts_swddni2 ?! misc - - - "TS_SWDDNI2" "SHORTWAVE SURFACE DOWNWARD DIRECT NORMAL IRRADIANCE FROM FARMS" +state real ts_swddif2 ?! misc - - - "TS_SWDDIF2" "SHORTWAVE SURFACE DOWNWARD DIFFUSE IRRADIANCE FROM FARMS" +state real ts_swdownc2 ?! misc - - - "TS_SWDOWNC2" "DOWNWARD CLEAR-SKY SHORTWAVE FLUX AT GROUND SURFACE FROM FARMS" +state real ts_swddnic2 ?! misc - - - "TS_SWDDNIC2" "CLEAR-SKY SHORTWAVE SURFACE DOWNWARD DIRECT NORMAL IRRADIANCE FROM FARMS" # Package declarations diff --git a/phys/module_diag_solar.F b/phys/module_diag_solar.F index 919e5bab14..4461aefa54 100644 --- a/phys/module_diag_solar.F +++ b/phys/module_diag_solar.F @@ -28,7 +28,8 @@ MODULE module_diag_solar ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - SUBROUTINE solar_diag (rho, dz8w, ph, phb, cldfrac3d, coszen, swdnb, swdnt, qv, qc, qi, qs, & + SUBROUTINE solar_diag (rho, dz8w, ph, phb, cldfrac3d, coszen, swdnb, swdnt, & + param_first_scalar, p_qc, p_qi, p_qs, qv, qc, qi, qs, & qc_tot, qi_tot, has_reqc, has_reqi, has_reqs, f_qv, f_qc, f_qi, f_qs, & re_cloud, re_ice, re_snow, clrnidx, sza, cldfrac2d, wvp2d, lwp2d, iwp2d, swp2d, & wp2d_sum, lwp2d_tot, iwp2d_tot, wp2d_tot_sum, re_cloud_path, re_ice_path, re_snow_path, & @@ -45,7 +46,7 @@ SUBROUTINE solar_diag (rho, dz8w, ph, phb, cldfrac3d, coszen, swdnb, swdnt, qv, REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: coszen, swdnb, swdnt REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: ph, phb, cldfrac3d, qv, qc, qi, qs, qc_tot, qi_tot, & re_cloud, re_ice, re_snow, rho, dz8w - INTEGER, INTENT(IN) :: has_reqc, has_reqi, has_reqs + INTEGER, INTENT(IN) :: param_first_scalar, p_qc, p_qi, p_qs, has_reqc, has_reqi, has_reqs LOGICAL, INTENT(IN) :: f_qv, f_qc, f_qi, f_qs REAL, DIMENSION(ims:ime, jms:jme), INTENT(OUT) :: clrnidx, sza, cldfrac2d, wvp2d, lwp2d, iwp2d, swp2d, wp2d_sum, & lwp2d_tot, iwp2d_tot, wp2d_tot_sum, re_cloud_path, re_ice_path, re_snow_path, re_cloud_path_tot, re_ice_path_tot, & @@ -101,9 +102,9 @@ SUBROUTINE solar_diag (rho, dz8w, ph, phb, cldfrac3d, coszen, swdnb, swdnt, qv, end if !!! LIQUID WATER - if (f_qc) then + if (f_qc .and. p_qc > param_first_scalar) then !!! RESOLVED !!! - ! Calc liquid water pth + ! Calc liquid water path q_aux = integrate_1var (rhodz, qc(i, :, j), kms, kme, kts, kte) lwp = q_aux lwp2d(i, j) = SIGN( MAX( lwp, 0.0 ), 1.0 ) @@ -124,9 +125,6 @@ SUBROUTINE solar_diag (rho, dz8w, ph, phb, cldfrac3d, coszen, swdnb, swdnt, qv, else tau_qc(i, j) = 0.0 end if - else - re_cloud_path(i, j) = MISSING - tau_qc(i, j) = MISSING end if !!! TOTAL (RESOLVED + UNRESOLVED) !!! @@ -151,14 +149,18 @@ SUBROUTINE solar_diag (rho, dz8w, ph, phb, cldfrac3d, coszen, swdnb, swdnt, qv, else tau_qc_tot(i, j) = 0.0 end if - else - re_cloud_path_tot(i, j) = MISSING - tau_qc_tot(i, j) = MISSING end if + else + lwp2d(i, j) = MISSING + re_cloud_path(i, j) = MISSING + tau_qc(i, j) = MISSING + lwp2d_tot(i, j) = MISSING + re_cloud_path_tot(i, j) = MISSING + tau_qc_tot(i, j) = MISSING end if !!! ICE - if (f_qi) then + if (f_qi .and. p_qi > param_first_scalar) then !!! RESOLVED !!! ! Calc ice water path q_aux = integrate_1var (rhodz, qi(i, :, j), kms, kme, kts, kte) @@ -186,9 +188,6 @@ SUBROUTINE solar_diag (rho, dz8w, ph, phb, cldfrac3d, coszen, swdnb, swdnt, qv, else tau_qi(i, j) = 0.0 end if - else - re_ice_path(i, j) = MISSING - tau_qi(i, j) = MISSING end if !!! TOTAL (RESOLVED + UNRESOLVED) !!! @@ -218,14 +217,18 @@ SUBROUTINE solar_diag (rho, dz8w, ph, phb, cldfrac3d, coszen, swdnb, swdnt, qv, else tau_qi_tot(i, j) = 0.0 end if - else - re_ice_path_tot(i, j) = MISSING - tau_qi_tot(i, j) = MISSING end if + else + iwp2d(i, j) = MISSING + re_ice_path(i, j) = MISSING + tau_qi(i, j) = MISSING + iwp2d_tot(i, j) = MISSING + re_ice_path_tot(i, j) = MISSING + tau_qi_tot(i, j) = MISSING end if !!! SNOW - if (f_qs) then + if (f_qs .and. p_qs > param_first_scalar) then !!! RESOLVED !!! ! Calc effective radius snow q_aux = integrate_1var (rhodz, qs(i, :, j), kms, kme, kts, kte) @@ -252,78 +255,123 @@ SUBROUTINE solar_diag (rho, dz8w, ph, phb, cldfrac3d, coszen, swdnb, swdnt, qv, else tau_qs(i, j) = 0.0 end if - else - re_snow_path(i, j) = MISSING - tau_qs(i, j) = MISSING end if + else + swp2d(i, j) = MISSING + re_snow_path(i, j) = MISSING + tau_qs(i, j) = MISSING end if - if (f_qc .or. f_qi .or. f_qs) then + if ( (f_qc .or. f_qi .or. f_qs) .and. & + (p_qc > param_first_scalar .or. & + p_qi > param_first_scalar .or. & + p_qs > param_first_scalar) ) then !!! RESOLVED !!! ! Sum water paths (cloud liquid + ice + snow) - wp2d_sum(i, j) = lwp2d(i, j) + iwp2d(i, j) + swp2d(i, j) + wp2d_sum(i, j) = MAX( lwp2d(i, j), 0.0 ) + MAX( iwp2d(i, j), 0.0 ) + MAX( swp2d(i, j), 0.0 ) !!! CLOUD BASE & TOP HEIGHTS ! Cloud base first - k = kts - wc = qc(i, k, j) + qi(i, k, j) + qs(i, k, j) - do while ( (wc < WC_MIN) .and. (k < kte) ) - k = k + 1 - wc = qc(i, k, j) + qi(i, k, j) + qs(i, k, j) - end do - - if (k == kte) then - cbase(i, j) = MISSING - else - cbase(i, j) = ( (ph(i, k, j) + phb(i, k, j)) + (ph(i, k + 1, j) + phb(i, k + 1, j)) ) / (2.0 * G) - end if - - ! Cloud top second - k = kte - wc = qc(i, k, j) + qi(i, k, j) + qs(i, k, j) - do while ( (wc < WC_MIN) .and. (k > kts) ) - k = k - 1 - wc = qc(i, k, j) + qi(i, k, j) + qs(i, k, j) - end do + if (wp2d_sum(i, j) > Q_MIN) then + k = kts + wc = 0.0 + if (f_qc .and. p_qc > param_first_scalar) wc = wc + qc(i, k, j) + if (f_qi .and. p_qi > param_first_scalar) wc = wc + qi(i, k, j) + if (f_qs .and. p_qs > param_first_scalar) wc = wc + qs(i, k, j) + do while ( (wc < WC_MIN) .and. (k < kte) ) + k = k + 1 + wc = 0.0 + if (f_qc .and. p_qc > param_first_scalar) wc = wc + qc(i, k, j) + if (f_qi .and. p_qi > param_first_scalar) wc = wc + qi(i, k, j) + if (f_qs .and. p_qs > param_first_scalar) wc = wc + qs(i, k, j) + end do + + if (k == kte) then + cbase(i, j) = MISSING + else + cbase(i, j) = ( (ph(i, k, j) + phb(i, k, j)) + (ph(i, k + 1, j) + phb(i, k + 1, j)) ) / (2.0 * G) + end if - if (k == kts) then - ctop(i, j) = MISSING + ! Cloud top second + k = kte + wc = 0.0 + if (f_qc .and. p_qc > param_first_scalar) wc = wc + qc(i, k, j) + if (f_qi .and. p_qi > param_first_scalar) wc = wc + qi(i, k, j) + if (f_qs .and. p_qs > param_first_scalar) wc = wc + qs(i, k, j) + do while ( (wc < WC_MIN) .and. (k > kts) ) + k = k - 1 + wc = 0.0 + if (f_qc .and. p_qc > param_first_scalar) wc = wc + qc(i, k, j) + if (f_qi .and. p_qi > param_first_scalar) wc = wc + qi(i, k, j) + if (f_qs .and. p_qs > param_first_scalar) wc = wc + qs(i, k, j) + end do + + if (k == kts) then + ctop(i, j) = MISSING + else + ctop(i, j) = ( (ph(i, k, j) + phb(i, k, j)) + (ph(i, k + 1, j) + phb(i, k + 1, j)) ) / (2.0 * G) + end if else - ctop(i, j) = ( (ph(i, k, j) + phb(i, k, j)) + (ph(i, k + 1, j) + phb(i, k + 1, j)) ) / (2.0 * G) + cbase(i, j) = MISSING + ctop(i, j) = MISSING end if !!! TOTAL (RESOLVED + UNRESOLVED) !!! ! Sum water paths (cloud liquid + ice + snow) ! Note that snow is from resolved only - wp2d_tot_sum(i, j) = lwp2d_tot(i, j) + iwp2d_tot(i, j) + swp2d(i, j) + wp2d_tot_sum(i, j) = MAX( lwp2d_tot(i, j), 0.0 ) + MAX( iwp2d_tot(i, j), 0.0 ) + MAX( swp2d(i, j), 0.0 ) ! Cloud base first - k = kts - wc = qc_tot(i, k, j) + qi_tot(i, k, j) + qs(i, k, j) - do while ( (wc < WC_MIN) .and. (k < kte) ) - k = k + 1 - wc = qc_tot(i, k, j) + qi_tot(i, k, j) + qs(i, k, j) - end do - - if (k == kte) then - cbase_tot(i, j) = MISSING - else - cbase_tot(i, j) = ( (ph(i, k, j) + phb(i, k, j)) + (ph(i, k + 1, j) + phb(i, k + 1, j)) ) / (2.0 * G) - end if - - ! Cloud top second - k = kte - wc = qc_tot(i, k, j) + qi_tot(i, k, j) + qs(i, k, j) - do while ( (wc < WC_MIN) .and. (k > kts) ) - k = k - 1 - wc = qc_tot(i, k, j) + qi_tot(i, k, j) + qs(i, k, j) - end do + if (wp2d_tot_sum(i, j) > Q_MIN) then + k = kts + wc = 0.0 + if (f_qc .and. p_qc > param_first_scalar) wc = wc + qc_tot(i, k, j) + if (f_qi .and. p_qi > param_first_scalar) wc = wc + qi_tot(i, k, j) + if (f_qs .and. p_qs > param_first_scalar) wc = wc + qs(i, k, j) + do while ( (wc < WC_MIN) .and. (k < kte) ) + k = k + 1 + wc = 0.0 + if (f_qc .and. p_qc > param_first_scalar) wc = wc + qc_tot(i, k, j) + if (f_qi .and. p_qi > param_first_scalar) wc = wc + qi_tot(i, k, j) + if (f_qs .and. p_qs > param_first_scalar) wc = wc + qs(i, k, j) + end do + + if (k == kte) then + cbase_tot(i, j) = MISSING + else + cbase_tot(i, j) = ( (ph(i, k, j) + phb(i, k, j)) + (ph(i, k + 1, j) + phb(i, k + 1, j)) ) / (2.0 * G) + end if - if (k == kts) then - ctop_tot(i, j) = MISSING + ! Cloud top second + k = kte + wc = 0.0 + if (f_qc .and. p_qc > param_first_scalar) wc = wc + qc_tot(i, k, j) + if (f_qi .and. p_qi > param_first_scalar) wc = wc + qi_tot(i, k, j) + if (f_qs .and. p_qs > param_first_scalar) wc = wc + qs(i, k, j) + do while ( (wc < WC_MIN) .and. (k > kts) ) + k = k - 1 + wc = 0.0 + if (f_qc .and. p_qc > param_first_scalar) wc = wc + qc_tot(i, k, j) + if (f_qi .and. p_qi > param_first_scalar) wc = wc + qi_tot(i, k, j) + if (f_qs .and. p_qs > param_first_scalar) wc = wc + qs(i, k, j) + end do + + if (k == kts) then + ctop_tot(i, j) = MISSING + else + ctop_tot(i, j) = ( (ph(i, k, j) + phb(i, k, j)) + (ph(i, k + 1, j) + phb(i, k + 1, j)) ) / (2.0 * G) + end if else - ctop_tot(i, j) = ( (ph(i, k, j) + phb(i, k, j)) + (ph(i, k + 1, j) + phb(i, k + 1, j)) ) / (2.0 * G) + cbase_tot(i, j) = MISSING + ctop_tot(i, j) = MISSING end if + else + wp2d_sum(i, j) = MISSING + cbase(i, j) = MISSING + ctop(i, j) = MISSING + wp2d_tot_sum(i, j) = MISSING + cbase_tot(i, j) = MISSING + ctop_tot(i, j) = MISSING end if ENDDO diff --git a/phys/module_diagnostics_driver.F b/phys/module_diagnostics_driver.F index 5b10eac981..9b45e20d70 100644 --- a/phys/module_diagnostics_driver.F +++ b/phys/module_diagnostics_driver.F @@ -39,6 +39,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags, & SKIP_PRESS_DIAGS, SKIP_Z_DIAGS, & DO_TRAD_FIELDS, & DO_SOLAR_OUTPUT, & + PARAM_FIRST_SCALAR, & P_QG, P_QH, P_QV, P_QC, P_QI, P_QS, & P_QNG, P_QH, P_QNH, P_QR, P_QNR, & F_QV, F_QC, F_QI, F_QS, & @@ -1084,7 +1085,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags, & CALL solar_diag ( & rho=grid%rho, dz8w=dz8w, ph=grid%ph_2, phb=grid%phb, & cldfrac3d=grid%cldfra, coszen=grid%coszen, swdnb=grid%swdnb, & - swdnt=grid%swdnt, qv=moist(ims,kms,jms,P_QV), & + swdnt=grid%swdnt, param_first_scalar=param_first_scalar, & + p_qc=p_qc, p_qi=p_qi, p_qs=p_qs, qv=moist(ims,kms,jms,P_QV), & qc=moist(ims,kms,jms,P_QC), qi=moist(ims,kms,jms,P_QI), & qs=moist(ims,kms,jms,P_QS), qc_tot=grid%qc_tot, & qi_tot=grid%qi_tot, & diff --git a/phys/module_radiation_driver.F b/phys/module_radiation_driver.F index 1c47e82ff0..5df9182e9f 100644 --- a/phys/module_radiation_driver.F +++ b/phys/module_radiation_driver.F @@ -3248,6 +3248,7 @@ SUBROUTINE calc_coszen(ims,ime,jms,jme,its,ite,jts,jte, & xxlat=xlat(i,j)*degrad coszen(i,j)=sin(xxlat)*sin(declin) & +cos(xxlat)*cos(declin) *cos(hrang(i,j)) + coszen(i, j) = min (max (coszen(i, j), -1.0), 1.0) enddo enddo END SUBROUTINE calc_coszen diff --git a/run/README.tslist b/run/README.tslist index e65e46ad7c..1e912e6f5c 100644 --- a/run/README.tslist +++ b/run/README.tslist @@ -125,6 +125,16 @@ cbaseht_tot: CLOUD BASE HEIGHT RES + UNRES (m) ctopht_tot: CLOUD TOP HEIGHT RES + UNRES (m) clrnidx: CLEARNESS INDEX () sza: SOLAR ZENITH ANGLE (deg) +swdown: DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE (W m-2) +swddni: SHORTWAVE SURFACE DOWNWARD DIRECT NORMAL IRRADIANCE (W m-2) +swddif: SHORTWAVE SURFACE DOWNWARD DIFFUSE IRRADIANCE (W m-2) +swdownc: DOWNWARD CLEAR-SKY SHORTWAVE FLUX AT GROUND SURFACE (W m-2) +swddnic: CLEAR-SKY SHORTWAVE SURFACE DOWNWARD DIRECT NORMAL IRRADIANCE (W m-2) +swdown2: DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE FROM FARMS (W m-2) +swddni2: SHORTWAVE SURFACE DOWNWARD DIRECT NORMAL IRRADIANCE FROM FARMS (W m-2) +swddif2: SHORTWAVE SURFACE DOWNWARD DIFFUSE IRRADIANCE FROM FARMS (W m-2) +swdownc2: DOWNWARD CLEAR-SKY SHORTWAVE FLUX AT GROUND SURFACE FROM FARMS (W m-2) +swddnic2: CLEAR-SKY SHORTWAVE SURFACE DOWNWARD DIRECT NORMAL IRRADIANCE FROM FARMS (W m-2) Format of the files of vertical profile: diff --git a/share/wrf_timeseries.F b/share/wrf_timeseries.F index c40e38a7f6..226a070284 100644 --- a/share/wrf_timeseries.F +++ b/share/wrf_timeseries.F @@ -351,6 +351,7 @@ SUBROUTINE calc_ts( grid ) INTEGER :: i, k, mm, n, ix, iy, rc REAL :: earth_u, earth_v, & output_t, output_q, clw, xtime_minutes + REAL, PARAMETER :: MISSING = -999.0 REAL, ALLOCATABLE, DIMENSION(:) :: p8w REAL, ALLOCATABLE, DIMENSION(:) :: earth_u_profile, earth_v_profile TYPE (grid_config_rec_type) :: config_flags @@ -516,6 +517,37 @@ SUBROUTINE calc_ts( grid ) grid%ts_ctopht_tot(n,i) = grid%ctopht_tot(ix,iy) grid%ts_clrnidx(n,i) = grid%clrnidx(ix,iy) grid%ts_sza(n,i) = grid%sza(ix,iy) + grid%ts_swdown(n,i) = grid%swdown(ix,iy) + grid%ts_swddni(n,i) = grid%swddni(ix,iy) + grid%ts_swddif(n,i) = grid%swddif(ix,iy) + ! Calc extra solar variables if FARMS or RRTMG/RRTMG FAST + if ( config_flags%swint_opt == 2 .or. & + config_flags%ra_sw_physics == RRTMG_SWSCHEME .or. & + config_flags%ra_sw_physics == RRTMG_SWSCHEME_FAST ) then + grid%ts_swdownc(n,i) = grid%swdownc(ix,iy) + grid%ts_swddnic(n,i) = grid%swddnic(ix,iy) + if ( config_flags%swint_opt == 2 ) then ! FARMS + grid%ts_swdown2(n,i) = grid%swdown2(ix,iy) + grid%ts_swddni2(n,i) = grid%swddni2(ix,iy) + grid%ts_swddif2(n,i) = grid%swddif2(ix,iy) + grid%ts_swdownc2(n,i) = grid%swdownc2(ix,iy) + grid%ts_swddnic2(n,i) = grid%swddnic2(ix,iy) + else + grid%ts_swdown2(n,i) = MISSING + grid%ts_swddni2(n,i) = MISSING + grid%ts_swddif2(n,i) = MISSING + grid%ts_swdownc2(n,i) = MISSING + grid%ts_swddnic2(n,i) = MISSING + end if + else + grid%ts_swdownc(n,i) = MISSING + grid%ts_swddnic(n,i) = MISSING + grid%ts_swdown2(n,i) = MISSING + grid%ts_swddni2(n,i) = MISSING + grid%ts_swddif2(n,i) = MISSING + grid%ts_swdownc2(n,i) = MISSING + grid%ts_swddnic2(n,i) = MISSING + end if END IF #else grid%ts_tsk(n,i) = grid%nmm_tsk(ix,iy) @@ -580,6 +612,16 @@ SUBROUTINE calc_ts( grid ) grid%ts_ctopht_tot(n,i) = 1.E30 grid%ts_clrnidx(n,i) = 1.E30 grid%ts_sza(n,i) = 1.E30 + grid%ts_swdown(n,i) = 1.E30 + grid%ts_swddni(n,i) = 1.E30 + grid%ts_swddif(n,i) = 1.E30 + grid%ts_swdownc(n,i) = 1.E30 + grid%ts_swddnic(n,i) = 1.E30 + grid%ts_swdown2(n,i) = 1.E30 + grid%ts_swddni2(n,i) = 1.E30 + grid%ts_swddif2(n,i) = 1.E30 + grid%ts_swdownc2(n,i) = 1.E30 + grid%ts_swddnic2(n,i) = 1.E30 END IF #endif grid%ts_tsk(n,i) = 1.E30 @@ -787,6 +829,36 @@ SUBROUTINE write_ts( grid ) ts_buf(:,:) = grid%ts_sza(:,:) CALL wrf_dm_min_reals(ts_buf(:,:),grid%ts_sza(:,:),grid%ts_buf_size*grid%max_ts_locs) + + ts_buf(:,:) = grid%ts_swdown(:,:) + CALL wrf_dm_min_reals(ts_buf(:,:),grid%ts_swdown(:,:),grid%ts_buf_size*grid%max_ts_locs) + + ts_buf(:,:) = grid%ts_swddni(:,:) + CALL wrf_dm_min_reals(ts_buf(:,:),grid%ts_swddni(:,:),grid%ts_buf_size*grid%max_ts_locs) + + ts_buf(:,:) = grid%ts_swddif(:,:) + CALL wrf_dm_min_reals(ts_buf(:,:),grid%ts_swddif(:,:),grid%ts_buf_size*grid%max_ts_locs) + + ts_buf(:,:) = grid%ts_swdownc(:,:) + CALL wrf_dm_min_reals(ts_buf(:,:),grid%ts_swdownc(:,:),grid%ts_buf_size*grid%max_ts_locs) + + ts_buf(:,:) = grid%ts_swddnic(:,:) + CALL wrf_dm_min_reals(ts_buf(:,:),grid%ts_swddnic(:,:),grid%ts_buf_size*grid%max_ts_locs) + + ts_buf(:,:) = grid%ts_swdown2(:,:) + CALL wrf_dm_min_reals(ts_buf(:,:),grid%ts_swdown2(:,:),grid%ts_buf_size*grid%max_ts_locs) + + ts_buf(:,:) = grid%ts_swddni2(:,:) + CALL wrf_dm_min_reals(ts_buf(:,:),grid%ts_swddni2(:,:),grid%ts_buf_size*grid%max_ts_locs) + + ts_buf(:,:) = grid%ts_swddif2(:,:) + CALL wrf_dm_min_reals(ts_buf(:,:),grid%ts_swddif2(:,:),grid%ts_buf_size*grid%max_ts_locs) + + ts_buf(:,:) = grid%ts_swdownc2(:,:) + CALL wrf_dm_min_reals(ts_buf(:,:),grid%ts_swdownc2(:,:),grid%ts_buf_size*grid%max_ts_locs) + + ts_buf(:,:) = grid%ts_swddnic2(:,:) + CALL wrf_dm_min_reals(ts_buf(:,:),grid%ts_swddnic2(:,:),grid%ts_buf_size*grid%max_ts_locs) END IF #endif @@ -836,7 +908,7 @@ SUBROUTINE write_ts( grid ) grid%ts_clw(n,i) ELSE !!! WRF-Solar diagnostics - WRITE(UNIT=iunit,FMT='(i2,f13.6,i5,i5,i5,1x,39(f13.5,1x))') & + WRITE(UNIT=iunit,FMT='(i2,f13.6,i5,i5,i5,1x,49(f13.5,1x))') & grid%id, grid%ts_hour(n,i), & grid%id_tsloc(i), ix, iy, & grid%ts_t(n,i), & @@ -877,7 +949,17 @@ SUBROUTINE write_ts( grid ) grid%ts_cbaseht_tot(n,i), & grid%ts_ctopht_tot(n,i), & grid%ts_clrnidx(n,i), & - grid%ts_sza(n,i) + grid%ts_sza(n,i), & + grid%ts_swdown(n,i), & + grid%ts_swddni(n,i), & + grid%ts_swddif(n,i), & + grid%ts_swdownc(n,i), & + grid%ts_swddnic(n,i), & + grid%ts_swdown2(n,i), & + grid%ts_swddni2(n,i), & + grid%ts_swddif2(n,i), & + grid%ts_swdownc2(n,i), & + grid%ts_swddnic2(n,i) END IF #else WRITE(UNIT=iunit,FMT='(i2,f13.6,i5,i5,i5,1x,7(f13.5,1x))') & From 9ef0fd712b2cd3084f388c2478e030ba6cc0ca37 Mon Sep 17 00:00:00 2001 From: brigaudet <48535869+brigaudet@users.noreply.github.com> Date: Tue, 12 Jan 2021 15:01:25 -0800 Subject: [PATCH 32/36] Corrected bug in mixactivate for diagnostic CCN in sectional schemes (#1359) TYPE: bug fix KEYWORDS: chemistry, sectional, CCN, mixactivate SOURCE: Calvin Howes (UCLA), Richard Easter (PNNL), internal DESCRIPTION OF CHANGES: Problem: The sectional scheme diagnostic CCN1, CCN2, ... CCN6 output as computed in mixactivate did not allow for particle growth in the computation of volume-mean diameters. This bug was initially found by Calvin Howes, with the current fix proposed by Richard Easter 09/25/2020. The CCN output fields being diagnostic do not impact actual aerosol activation, so cloud properties are not impacted by the bug. Solution: Subroutine mixactivate in module_mixactivate.F was modified to use actual time-dependent sizes rather than the default values in computing critical supersaturations and hence CCN. LIST OF MODIFIED FILES: M phys/module_mixactivate.F TESTS CONDUCTED: 1. The first set of attached figures shows CCN6 (CCN at > 1% SS) in the WRF restart files for the lowest model level in a simulation of the Amazon using chem_opt = 11 (RADM2SORG_AQ). The number of CCN is reduced in areas of cloud formation, suggesting wet removal. But this preferentially impacts the larger / activated Aitken mode particles, reducing the particle size from the default size. Thus with the bug fix the diagnosed CCN is reduced relative to the standard code, while the cloud condensate mixing ratio (QCLOUD) is unchanged (second set of slides). [CCN_bug_fix_test_4.2.2.pptx](https://github.com/wrf-model/WRF/files/5784455/CCN_bug_fix_test_4.2.2.pptx) 2. Jenkins testing is all pass. RELEASE NOTE: Corrected bug in mixactivate for diagnostic CCN in sectional schemes. Impacts Morrison and Lin et al. microphysics schemes. --- phys/module_mixactivate.F | 56 ++++++++++++++++++++++++++++++--------- 1 file changed, 43 insertions(+), 13 deletions(-) diff --git a/phys/module_mixactivate.F b/phys/module_mixactivate.F index 8bdc8bbc87..a44c0cc279 100644 --- a/phys/module_mixactivate.F +++ b/phys/module_mixactivate.F @@ -413,7 +413,7 @@ subroutine mixactivate( msectional, & (/0.02,0.05,0.1,0.2,0.5,1.0/) real super(psat) ! supersaturation real, parameter :: surften = 0.076 ! surface tension of water w/respect to air (N/m) - real :: ccnfact(psat,maxd_asize, maxd_atype) + real :: ccnfact real :: amcube(maxd_asize, maxd_atype) ! cube of dry mode radius (m) real :: argfactor(maxd_asize, maxd_atype) real aten ! surface tension parameter @@ -432,6 +432,8 @@ subroutine mixactivate( msectional, & real :: colmass_worst( 0:maxd_acomp, maxd_asize, maxd_atype ) real :: colmass_maxworst_r real :: rhodz( kts:kte ), rhodzsum + real :: tmp_amcube, tmp_dpvolmean, tmp_npv, tmp_num_mr + real :: tmp_vol_mr( kts:kte ) !!$#if (defined AIX) !!$#define ERF erf @@ -1163,36 +1165,64 @@ subroutine mixactivate( msectional, & chem(i,kts:kte,j,lnumcw)= raercol(kts:kte,lnumcw,nnew)*scale chem(i,kts:kte,j,lnum)= raercol(kts:kte,lnum,nnew)*scale endif + tmp_vol_mr(kts:kte) = 0.0 do l=1,ncomp(n) lmass=massptr_aer(l,m,n,ai_phase) lmasscw=massptr_aer(l,m,n,cw_phase) -! scale = mwdry/mw_aer(l,n) scale = 1.e9 chem(i,kts:kte,j,lmasscw)=raercol(kts:kte,lmasscw,nnew)*scale ! ug/kg chem(i,kts:kte,j,lmass)=raercol(kts:kte,lmass,nnew)*scale ! ug/kg + tmp_vol_mr(kts:kte) = tmp_vol_mr(kts:kte) + & + (raercol(kts:kte,lmass,nnew) + raercol(kts:kte,lmasscw,nnew))/(1.0e-3*dens_aer(l,n)) + ! (kg_dmap/kg_air)/(kg_dmap/cm3_dvap) = (cm3_dvap/kg_air) + ! note: dmap (or dvap) means dry mass (or volume) of aerosol particles enddo lwater=waterptr_aer(m,n) if(lwater>0)chem(i,kts:kte,j,lwater)=raercol(kts:kte,lwater,nnew) ! don't convert units + + exp45logsig=exp(4.5*alogsig(m,n)*alogsig(m,n)) do k=kts,kte - sm=2.*aten*sqrt(aten/(27.*hygro(i,k,j,m,n)*amcube(m,n))) + if (lnum > 0) then + tmp_num_mr = raercol(k,lnum,nnew) + raercol(k,lnumcw,nnew) ! (num_ap/kg_air) + if (tmp_num_mr .lt. 1.0e-14) then ! this is about 1e-20 num_ap/cm3_air + sm=2.*aten*sqrt(aten/(27.*hygro(i,k,j,m,n)*amcube(m,n))) + else + ! rce 2020/09/24 - calculate sm using the actual dgnum (that varies in + ! space & time) rather than the default value in dgnum_aer(m,n) + tmp_dpvolmean = (1.90985*tmp_vol_mr(k)/tmp_num_mr)**0.3333333 ! (cm) + tmp_dpvolmean = max( dlo_sect(m,n), min( dhi_sect(m,n), tmp_dpvolmean ) ) + tmp_npv = 6./(pi*((0.01*tmp_dpvolmean)**3)) ! (num_ap/m3_dvap) + tmp_amcube = 3./(4.*pi*exp45logsig*tmp_npv) ! tmp_amcube = (0.5*dgnum)**3 in m3 + sm=2.*aten*sqrt(aten/(27.*hygro(i,k,j,m,n)*tmp_amcube)) + ! sm = critical supersaturation for diameter = dgnum + endif + else + tmp_num_mr = (tmp_vol_mr(k)*1.0e-6)*npv(m,n) ! (num_ap/kg_air) + sm=2.*aten*sqrt(aten/(27.*hygro(i,k,j,m,n)*amcube(m,n))) + end if + +! calculate ccn concentrations (num_ap/cm3_air) as diagnostics +! assume same hygroscopicity and ccnfact for cloud-phase and aerosol phase particles do l=1,psat arg=argfactor(m,n)*log(sm/super(l)) + ! since scrit is proportional to dry_diam**(-3/2) + ! arg = (log(dp_for_super_l) - log(dgnum))/(sqrt(2)*alogsig) + ! where dp_for_super_l is diameter at which scrit = super(l) if(arg<2)then if(arg<-2)then - ccnfact(l,m,n)=1.e-6 ! convert from #/m3 to #/cm3 + ccnfact =1.0 else - ccnfact(l,m,n)=1.e-6*0.5*ERFC_NUM_RECIPES(arg) + ccnfact = 0.5*ERFC_NUM_RECIPES(arg) ! fraction of particles in bin/mode with scrit < super(l) ! fraction of particles in bin/mode with scrit < super(l) endif else - ccnfact(l,m,n) = 0. + ccnfact = 0.0 endif -! ccn concentration as diagnostic -! assume same hygroscopicity and ccnfact for cloud-phase and aerosol phase particles - ccn(k,l)=ccn(k,l)+(raercol(k,lnum,nnew)+raercol(k,lnumcw,nnew))*cs(k)*ccnfact(l,m,n) - enddo - enddo - enddo - enddo + ccn(k,l) = ccn(k,l) + (tmp_num_mr*ccnfact)*cs(k)*1.0e-6 + enddo ! l + enddo ! k + + enddo ! m + enddo ! n do l=1,psat !wig, 22-Nov-2006: added vertical bounds to prevent out-of-bounds at top if(l.eq.1)ccn1(i,kts:kte,j)=ccn(:,l) From eb9082381fa124545272b5e16fee7c04309ac7ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Matthias=20G=C3=B6bel?= Date: Wed, 13 Jan 2021 21:13:14 +0100 Subject: [PATCH 33/36] Fixed boundary issues in rhs_ph with advection orders < 5 (#1336) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit TYPE: bug fix KEYWORDS: geopotential, index, horizontal advection, open, specified SOURCE: Matthias Göbel (University of Innsbruck) DESCRIPTION OF CHANGES: When using advection order < 5 (h_sca_adv_order) and open or specified boundary conditions, the upper limits in the horizontal advection loops of geopotential are one too small. Let's look at the y-advection with advection order = 2, for instance and assume jte=jde. For open and specified BC the lower limit is increased by 1 from jds to jds+1, but the upper limit is decreased by 2 from jde-1 to jtf=jde-1-2=jde-3. It should be jtf=jde-2, however. Starting at line 2092 the jde-1 point is set, but the jde-2 point is not handled anywhere. The issue is analogous for x-advection and advection order = 4 (jtf=jde-4 instead of jtf=jde-3). For advection order >= 5, the limits are set correctly, because a different notation is used: jtf = min(jtf,jde-4) LIST OF MODIFIED FILES: dyn_em/module_big_step_utilities_em.F TESTING CONDUCTED: An LES case is used to test this change, with periodic y-boundaries and open x-boundaries, mean x-wind of 10 m/s, h_sca_adv_order=3, and north-south oriented cosine ridge in the center of the domain. Here is the perturbation geopotential after 1 minute integration at k=2: ![ph](https://user-images.githubusercontent.com/17001470/102336394-67d8c780-3f91-11eb-899d-3b05d28c05ab.png) and here the difference plot: ![ph_diff](https://user-images.githubusercontent.com/17001470/102336506-876ff000-3f91-11eb-9ccf-7615df8adaff.png) One can clearly see the higher geopotential in the new formulation at i=ide-3. This is the point where the horizontal advection is not carried out by the current algorithm. After 10 minutes it looks like this: ![ph_600](https://user-images.githubusercontent.com/17001470/102336745-dd449800-3f91-11eb-9b06-94776b70d9c8.png) ![ph_diff_600](https://user-images.githubusercontent.com/17001470/102336749-df0e5b80-3f91-11eb-83ac-1d15a499aae9.png) It passes all Jenkins tests too. RELEASE NOTES: When using advection order < 5 (namelist h_sca_adv_order), and either open or specified boundary conditions, the upper limit of the indexing in the horizontal advection loops of geopotential was previously incorrect. For horizontal advection order >= 5 (which is the default), the index limits are correct. --- dyn_em/module_big_step_utilities_em.F | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/dyn_em/module_big_step_utilities_em.F b/dyn_em/module_big_step_utilities_em.F index eceac268da..187d0de1f8 100644 --- a/dyn_em/module_big_step_utilities_em.F +++ b/dyn_em/module_big_step_utilities_em.F @@ -1506,7 +1506,7 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & jtf=MIN(jte,jde-1) IF ( (config_flags%open_ys .or. specified) .and. jts == jds ) j_start = jts+1 - IF ( (config_flags%open_ye .or. specified) .and. jte == jde ) jtf = jtf-2 + IF ( (config_flags%open_ye .or. specified) .and. jte == jde ) jtf = jte-2 DO j = j_start, jtf @@ -1539,7 +1539,7 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & jtf=MIN(jte,jde-1) IF ( (config_flags%open_xs .or. specified) .and. its == ids ) i_start = its+1 - IF ( (config_flags%open_xe .or. specified) .and. ite == ide ) itf = itf-2 + IF ( (config_flags%open_xe .or. specified) .and. ite == ide ) itf = ite-2 DO j = j_start, jtf @@ -1574,7 +1574,7 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & jtf=MIN(jte,jde-1) IF ( (config_flags%open_ys .or. specified) .and. jts == jds ) j_start = jts+2 - IF ( (config_flags%open_ye .or. specified) .and. jte == jde ) jtf = jtf-3 + IF ( (config_flags%open_ye .or. specified) .and. jte == jde ) jtf = jte-3 DO j = j_start, jtf @@ -1664,7 +1664,7 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & jtf=MIN(jte,jde-1) IF ( (config_flags%open_xs) .and. its == ids ) i_start = its+2 - IF ( (config_flags%open_xe) .and. ite == ide ) itf = itf-3 + IF ( (config_flags%open_xe) .and. ite == ide ) itf = ite-3 DO j = j_start, jtf From b3177504dfb23dd0438106cc0f797d65fd882136 Mon Sep 17 00:00:00 2001 From: weiwangncar Date: Wed, 13 Jan 2021 14:08:12 -0700 Subject: [PATCH 34/36] Fix for lh_urb2d diagnostics in NoahMP (#1363) TYPE: bug fix KEYWORDS: lh_urb2d, diagnostics, noahmp SOURCE: internal (reported by Xin-Zhong Liang) DESCRIPTION OF CHANGES: Problem: lh_urb2d was inconsistent with other urban budget arrays sh_urb2d, g_urb2d, and rn_urb2d by being the only one multiplied by the urban fraction making it a grid cell average instead of urban area average. This is only a diagnostic for output with using of an urban option together with NoahMP. Solution: Divide lh_urb2d by frc_urb2d. Won't affect model run results apart from this diagnostic. These arrays are not in default history output. LIST OF MODIFIED FILES: phys/module_sf_noahmpdrv.F TESTS CONDUCTED: Only Jenkins tests were performed. The Jenkins tests are all passing. RELEASE NOTE: Fix lh_urb2d diagnostic to be urban area average instead of grid cell average consistent with other urb2d diagnostics associated with NoahMP. No effect on run results. --- phys/module_sf_noahmpdrv.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/phys/module_sf_noahmpdrv.F b/phys/module_sf_noahmpdrv.F index 594ce4c49e..f2d0f67467 100644 --- a/phys/module_sf_noahmpdrv.F +++ b/phys/module_sf_noahmpdrv.F @@ -3207,7 +3207,7 @@ SUBROUTINE noahmp_urban(sf_urban_physics, NSOIL, IVGTYP, ITIMESTEP, lh(i,j) = qfx(i,j)*xlv hfx(i,j) = hfx_urb(i,j) + (1-frc_urb2d(i,j))*hfx_rural(i,j) ![W/m/m] sh_urb2d(i,j) = hfx_urb(i,j)/frc_urb2d(i,j) - lh_urb2d(i,j) = qfx_urb(i,j)*xlv + lh_urb2d(i,j) = qfx_urb(i,j)*xlv/frc_urb2d(i,j) g_urb2d(i,j) = grdflx_urb(i,j) rn_urb2d(i,j) = rs_abs_urb(i,j)+emiss_urb(i,j)*glw(i,j)-rl_up_urb(i,j) ust(i,j) = (umom**2.+vmom**2.)**.25 From 5d02c18f74e51098307117e2e3e94bdce093dcc9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Matthias=20G=C3=B6bel?= Date: Thu, 14 Jan 2021 23:03:29 +0100 Subject: [PATCH 35/36] Fix for symmetric boundary conditions applied to 3D variables (#1314) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit TYPE: bug fix KEYWORDS: boundary conditions, symmetric, corners SOURCE: Matthias Göbel (University of Innsbruck) DESCRIPTION OF CHANGES: Problem: In idealized simulations, the routine `set_physical_bc3d` sets the boundary zone points for periodic, symmetric, and open boundary conditions. At first, the routine does not set the corner points (e.g., (ids-1,jds-1)): For the y-boundaries, it iterates i only from `MAX(ids,its-1)` to `MIN(ite+1,ide+istag)` and analogously for the x-boundaries (note that for open BC it actually also tries to set the corner points (see line 896), but not effectively, because the RHS values in lines 903-905 are still 0 there, as the y-BC has not been applied yet). For doubly-periodic BC, the corner points are set correctly afterward, starting at line 1100. In any other case, however, it seems that the corner points are not assigned and appear as zeros. These corner points are later used, e.g. in the SGS UV-flux (titau_21_12) in the diffusion module: https://github.com/wrf-model/WRF/blob/f311cd5e136631ebf3ebaa02b4b7be3816ed171f/dyn_em/module_diffusion_em.F#L5511-L5517 Thus, because `rho(i_start-1,k,j_start-1)=0` and `xkx(i_start-1,k,j_start-1)=0`, we have `xkxavg(i_start, k, j_start)` much smaller than at the other locations. This is usually not a problem, since the deformation defor12 and thus also the flux titau_21_12 should be 0 at these corner points when using symmetric boundary conditions on at least one of these boundaries. I write "should" because that's a theoretical argument. In practice, only the deformation at the ids or jds boundaries is zero. Due to an inconsistency in the symmetric BC for the deformation, the deformation at the ide or jde boundaries is not 0. This problem is described in the following. The deformation (variable = 'd') is treated like an unstaggered variable: https://github.com/wrf-model/WRF/blob/f311cd5e136631ebf3ebaa02b4b7be3816ed171f/share/module_bc.F#L1003-L1011 Thus, the deformation which was initially zero at the boundary is set to a non-zero value by `dat(i,k,jde) = dat(i,k,jde-1)`. All staggered variables except the normal velocity (so also the deformation) should be treated equally in the symmetric boundaries since the location of the symmetric boundary is on the staggered grid. Therefore I adjusted the relevant if statement in the second commit. If open boundary conditions are used on any of the boundaries, only the fluxes on the interior are calculated, so the corner points also don't matter. However, to avoid any current or future side effects due to the missing corner points, corner points are set anyway as it is done in `set_physical_bc2d`. Solution: 1. commit: The solution to set the corner points is the same as is already applied in the 2d routine `set_physical_bc2d`. 2. commit: To treat all variables staggered in a certain direction equally, the variables `jstag` and `istag` are used in the if statement instead of checking the value of `variable`. This was done only for the symmetric BC. For the open BC, it might be necessary, too. 3. commit: The corner point assignment for doubly-periodic BC is now redundant and was removed. ISSUE: Fixes #1311 LIST OF MODIFIED FILES: share/module_bc.F TESTS CONDUCTED: With the first commit, I tested, whether the corner points for doubly-periodic BC are set in the same way as in the original code. This test allowed removing this redundant part of the code in commit 3. To compare the different model versions, I ran an idealized simulation with km_opt=2, diff_opt=2, tke_heat_flux=0.2, U = 5 m/s, periodic in x, symmetric in y. The following figure shows the titau_21_12 flux at k=kds after 20 minutes for three model versions: left: original, middle: fixed corners (commit 1), right: fixed corners and fixed symmetric BC for the deformation (commit 1 and 2) ![fuy_sgs](https://user-images.githubusercontent.com/17001470/98154601-505be880-1ed5-11eb-9f0a-6eef1175e730.png) All versions have titau_21_12=0 at j=jds. In the left and middle panel, the fluxes at jde and jde-1 are almost identical. However, the original version has fluxes with lower magnitudes at the upper left and right corners (as the corners of xkmh and rho are not set as explained above). In the right panel, the flux at j=jde is now also zero as it should be. The following figure shows a time series of U at the upper left corner: ![u_timeseries](https://user-images.githubusercontent.com/17001470/98154606-52be4280-1ed5-11eb-93d3-563062274e5c.png) We can see that fixing the symmetric BC to have zero fluxes at j=jde does have a significant effect. Fixing the corners (commit 1) only has a minor effect, which is maximized at the corner points (j=jde, i=ids, and ide) as can be seen here: ![u_diff](https://user-images.githubusercontent.com/17001470/98154624-55b93300-1ed5-11eb-906d-b8aaef7f1596.png) RELEASE NOTE: Missing corner points are set when setting boundary conditions of 3D variables and all staggered variables are treated equally in symmetric BC. Thereby the periodic BC become cleaner and more consistent with set_physical_bc2d and the symmetric BC are fixed as horizontal deformation is treated now as a staggered variable which leads to correct BC for SGS momentum fluxes at the northern boundaries. --- share/module_bc.F | 95 ++++++++++++++++------------------------------- 1 file changed, 31 insertions(+), 64 deletions(-) diff --git a/share/module_bc.F b/share/module_bc.F index ea2c5b2382..c0b071893a 100644 --- a/share/module_bc.F +++ b/share/module_bc.F @@ -680,7 +680,8 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: dat TYPE( grid_config_rec_type ) config_flags - INTEGER :: i, j, k, istag, jstag, itime, k_end + INTEGER :: i, j, k, istag, jstag, itime, k_end, & + i_start, i_end LOGICAL :: debug, open_bc_copy @@ -779,7 +780,7 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & symmetry_xs: IF( ( config_flags%symmetric_xs ) .and. & ( its == ids ) ) THEN - IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN + IF ( istag == -1 ) THEN DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag) DO k = kts, k_end @@ -823,7 +824,7 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & symmetry_xe: IF( ( config_flags%symmetric_xe ) .and. & ( ite == ide ) ) THEN - IF ( (variable /= 'u') .and. (variable /= 'x') ) THEN + IF ( istag == -1 ) THEN DO j = MAX(jds,jts-1), MIN(jte+1,jde+jstag) DO k = kts, k_end @@ -927,13 +928,27 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & ! same procedure in y +! Set the starting and ending loop indexes in the 'i' direction, so that +! halo cells on the edge of the domain are also updated. Begin with a default +! start and end index for inner tiles, and then modify if the tile is on the +! edge of the domain. + + i_start = MAX(ids, its-1) + i_end = MIN(ite+1, ide+istag) + IF ( its .eq. ids) THEN + i_start = ims + END IF + IF ( ite .eq. ide) THEN + i_end = ime + END IF + periodicity_y: IF( ( config_flags%periodic_y ) ) THEN IF ( ( jds == jps ) .and. ( jde == jpe ) ) THEN ! test if both north and south on processor IF( jts == jds ) then DO j = 0, -(bdyzone-1), -1 DO k = kts, k_end - DO i = MAX(ids,its-1), MIN(ite+1,ide+istag) + DO i = i_start, i_end dat(i,k,jds+j-1) = dat(i,k,jde+j-1) ENDDO ENDDO @@ -945,7 +960,7 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & DO j = -jstag, bdyzone DO k = kts, k_end - DO i = MAX(ids,its-1), MIN(ite+1,ide+istag) + DO i = i_start, i_end dat(i,k,jde+j+jstag) = dat(i,k,jds+j+jstag) ENDDO ENDDO @@ -960,11 +975,11 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & symmetry_ys: IF( ( config_flags%symmetric_ys ) .and. & ( jts == jds) ) THEN - IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN + IF ( jstag == -1 ) THEN DO j = 1, bdyzone DO k = kts, k_end - DO i = MAX(ids,its-1), MIN(ite+1,ide+istag) + DO i = i_start, i_end dat(i,k,jds-j) = dat(i,k,jds+j-1) ENDDO ENDDO @@ -976,7 +991,7 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & DO j = 1, bdyzone DO k = kts, k_end - DO i = MAX(ids,its-1), MIN(ite+1,ide+istag) + DO i = i_start, i_end dat(i,k,jds-j) = - dat(i,k,jds+j) ENDDO ENDDO @@ -986,7 +1001,7 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & DO j = 1, bdyzone DO k = kts, k_end - DO i = MAX(ids,its-1), MIN(ite+1,ide+istag) + DO i = i_start, i_end dat(i,k,jds-j) = dat(i,k,jds+j) ENDDO ENDDO @@ -1003,11 +1018,11 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & symmetry_ye: IF( ( config_flags%symmetric_ye ) .and. & ( jte == jde ) ) THEN - IF ( (variable /= 'v') .and. (variable /= 'y') ) THEN + IF ( jstag == -1 ) THEN DO j = 1, bdyzone DO k = kts, k_end - DO i = MAX(ids,its-1), MIN(ite+1,ide+istag) + DO i = i_start, i_end dat(i,k,jde+j-1) = dat(i,k,jde-j) ENDDO ENDDO @@ -1019,7 +1034,7 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & DO j = 1, bdyzone DO k = kts, k_end - DO i = MAX(ids,its-1), MIN(ite+1,ide+istag) + DO i = i_start, i_end dat(i,k,jde+j) = - dat(i,k,jde-j) ENDDO ENDDO @@ -1029,7 +1044,7 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & DO j = 1, bdyzone DO k = kts, k_end - DO i = MAX(ids,its-1), MIN(ite+1,ide+istag) + DO i = i_start, i_end dat(i,k,jde+j) = dat(i,k,jde-j) ENDDO ENDDO @@ -1050,7 +1065,7 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & ( jts == jds) .and. open_bc_copy ) THEN DO k = kts, k_end - DO i = MAX(ids,its-1), MIN(ite+1,ide+istag) + DO i = i_start, i_end dat(i,k,jds-1) = dat(i,k,jds) dat(i,k,jds-2) = dat(i,k,jds) dat(i,k,jds-3) = dat(i,k,jds) @@ -1070,7 +1085,7 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & IF (variable /= 'v' .and. variable /= 'y' ) THEN DO k = kts, k_end - DO i = MAX(ids,its-1), MIN(ite+1,ide+istag) + DO i = i_start, i_end dat(i,k,jde ) = dat(i,k,jde-1) dat(i,k,jde+1) = dat(i,k,jde-1) dat(i,k,jde+2) = dat(i,k,jde-1) @@ -1080,7 +1095,7 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & ELSE DO k = kts, k_end - DO i = MAX(ids,its-1), MIN(ite+1,ide+istag) + DO i = i_start, i_end dat(i,k,jde+1) = dat(i,k,jde) dat(i,k,jde+2) = dat(i,k,jde) dat(i,k,jde+3) = dat(i,k,jde) @@ -1095,54 +1110,6 @@ SUBROUTINE set_physical_bc3d( dat, variable_in, & END IF periodicity_y -! fix corners for doubly periodic domains - - IF ( config_flags%periodic_x .and. config_flags%periodic_y & - .and. (ids == ips) .and. (ide == ipe) & - .and. (jds == jps) .and. (jde == jpe) ) THEN - - IF ( (its == ids) .and. (jts == jds) ) THEN ! lower left corner fill - DO j = 0, -(bdyzone-1), -1 - DO k = kts, k_end - DO i = 0, -(bdyzone-1), -1 - dat(ids+i-1,k,jds+j-1) = dat(ide+i-1,k,jde+j-1) - ENDDO - ENDDO - ENDDO - END IF - - IF ( (ite == ide) .and. (jts == jds) ) THEN ! lower right corner fill - DO j = 0, -(bdyzone-1), -1 - DO k = kts, k_end - DO i = 1, bdyzone - dat(ide+i+istag,k,jds+j-1) = dat(ids+i+istag,k,jde+j-1) - ENDDO - ENDDO - ENDDO - END IF - - IF ( (ite == ide) .and. (jte == jde) ) THEN ! upper right corner fill - DO j = 1, bdyzone - DO k = kts, k_end - DO i = 1, bdyzone - dat(ide+i+istag,k,jde+j+jstag) = dat(ids+i+istag,k,jds+j+jstag) - ENDDO - ENDDO - ENDDO - END IF - - IF ( (its == ids) .and. (jte == jde) ) THEN ! upper left corner fill - DO j = 1, bdyzone - DO k = kts, k_end - DO i = 0, -(bdyzone-1), -1 - dat(ids+i-1,k,jde+j+jstag) = dat(ide+i-1,k,jds+j+jstag) - ENDDO - ENDDO - ENDDO - END IF - - END IF - END SUBROUTINE set_physical_bc3d SUBROUTINE init_module_bc From 1e93b7e3957c85fe019c0b9fc064500defcc00c5 Mon Sep 17 00:00:00 2001 From: smileMchen Date: Thu, 14 Jan 2021 20:46:12 -0700 Subject: [PATCH 36/36] Prepare for the release of WRFv4.2.2 (#1365) Type: Text only Keywords: prepare for release of WRFV4.2.2 Source: internal Description of Changes: modify README and inc/version_decl List of modified files: M README M inc/version_decl Test conducted: not necessary --- README | 2 +- inc/version_decl | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/README b/README index d5b942d812..6e98338938 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -WRF Model Version 4.2.1 +WRF Model Version 4.2.2 http://www2.mmm.ucar.edu/wrf/users/ diff --git a/inc/version_decl b/inc/version_decl index fc13f34730..0a849d69f4 100644 --- a/inc/version_decl +++ b/inc/version_decl @@ -1 +1 @@ - CHARACTER (LEN=*), PARAMETER :: release_version = 'V4.2.1' + CHARACTER (LEN=*), PARAMETER :: release_version = 'V4.2.2'