diff --git a/Externals_CAM.cfg b/Externals_CAM.cfg index 90fe4700d5..cd7c03e349 100644 --- a/Externals_CAM.cfg +++ b/Externals_CAM.cfg @@ -21,16 +21,16 @@ required = True [clubb] local_path = src/physics/clubb -protocol = git -repo_url = https://github.com/ESCOMP/CLUBB_CESM -tag = clubb_release_b76a124_20200220_c20200320 +protocol = svn +repo_url = https://github.com/larson-group/clubb_release/tags/ +tag = clubb_4ncar_20220311_f51de38/src/CLUBB_core required = True [silhs] local_path = src/physics/silhs -protocol = git -repo_url = https://github.com/ESCOMP/SILHS_CESM -tag = silhs_clubb_release_b76a124_20200220_c20200320 +protocol = svn +repo_url = https://github.com/larson-group/clubb_release/tags/ +tag = clubb_4ncar_20220311_f51de38/src/SILHS required = True [pumas] diff --git a/bld/build-namelist b/bld/build-namelist index 6d260e601d..5023742114 100755 --- a/bld/build-namelist +++ b/bld/build-namelist @@ -3080,55 +3080,112 @@ if ($clubb_sgs =~ /$TRUE/io) { } add_default($nl, 'clubb_do_icesuper'); - - add_default($nl, 'clubb_expldiff'); - add_default($nl, 'clubb_rainevap_turb'); + add_default($nl, 'clubb_do_energyfix'); add_default($nl, 'clubb_cloudtop_cooling'); - add_default($nl, 'clubb_timestep'); + add_default($nl, 'clubb_rainevap_turb'); add_default($nl, 'clubb_rnevap_effic'); - add_default($nl, 'clubb_beta'); - add_default($nl, 'clubb_c1'); - add_default($nl, 'clubb_c1b'); - add_default($nl, 'clubb_c11'); - add_default($nl, 'clubb_c11b'); - add_default($nl, 'clubb_c14'); - add_default($nl, 'clubb_C2rt'); - add_default($nl, 'clubb_C2thl'); - add_default($nl, 'clubb_C2rtthl'); - add_default($nl, 'clubb_C4'); - add_default($nl, 'clubb_c6rt'); - add_default($nl, 'clubb_c6rtb'); - add_default($nl, 'clubb_c6rtc'); - add_default($nl, 'clubb_c6thl'); - add_default($nl, 'clubb_c6thlb'); - add_default($nl, 'clubb_c6thlc'); + add_default($nl, 'clubb_timestep'); + add_default($nl, 'clubb_l_diag_Lscale_from_tau'); + + my $clubb_Lscale_from_tau = $nl->get_value('clubb_l_diag_Lscale_from_tau'); + + if($clubb_Lscale_from_tau =~ "true") { + add_default($nl, 'clubb_c1', 'val'=>1.0); + add_default($nl, 'clubb_c1b', 'val'=>1.0); + add_default($nl, 'clubb_C2rt', 'val'=>1.0); + add_default($nl, 'clubb_C2thl', 'val'=>1.0); + add_default($nl, 'clubb_C2rtthl', 'val'=>1.0); + add_default($nl, 'clubb_C4', 'val'=>5.2); + add_default($nl, 'clubb_C_uu_shr', 'val'=>0.1076484659222455); + add_default($nl, 'clubb_C_uu_buoy', 'val'=>0.3); + add_default($nl, 'clubb_c6rt', 'val'=>2.0); + add_default($nl, 'clubb_c6rtb', 'val'=>2.0); + add_default($nl, 'clubb_c6rtc', 'val'=>1.0); + add_default($nl, 'clubb_c6thl', 'val'=>2.0); + add_default($nl, 'clubb_c6thlb', 'val'=>2.0); + add_default($nl, 'clubb_c6thlc', 'val'=>1.0); + add_default($nl, 'clubb_C8', 'val'=>3.440377776099962); + add_default($nl, 'clubb_C8b', 'val'=>0.0); + add_default($nl, 'clubb_c11', 'val'=>0.31057411754034614); + add_default($nl, 'clubb_c11b', 'val'=>0.3250718127387944); + add_default($nl, 'clubb_c14', 'val'=>1.0); + add_default($nl, 'clubb_C_invrs_tau_bkgnd', 'val'=>3.727123755772682); + add_default($nl, 'clubb_C_invrs_tau_sfc', 'val'=>0.12743072568015346); + add_default($nl, 'clubb_C_invrs_tau_shear', 'val'=>0.12502726304767026); + add_default($nl, 'clubb_C_invrs_tau_N2', 'val'=>0.08122667220596895); + add_default($nl, 'clubb_C_invrs_tau_N2_wp2', 'val'=>0.1); + add_default($nl, 'clubb_C_invrs_tau_N2_xp2', 'val'=>0.05); + add_default($nl, 'clubb_C_invrs_tau_N2_wpxp', 'val'=>0.0); + add_default($nl, 'clubb_C_invrs_tau_N2_clear_wp3', 'val'=>1.0); + add_default($nl, 'clubb_gamma_coef', 'val'=>0.5492223674353673); + add_default($nl, 'clubb_gamma_coefb', 'val'=>0.2531868210746816); + add_default($nl, 'clubb_beta', 'val'=>2.27756371212011); + } else { + add_default($nl, 'clubb_c1'); + add_default($nl, 'clubb_c1b'); + add_default($nl, 'clubb_C2rt'); + add_default($nl, 'clubb_C2thl'); + add_default($nl, 'clubb_C2rtthl'); + add_default($nl, 'clubb_C4'); + add_default($nl, 'clubb_C_uu_shr'); + add_default($nl, 'clubb_C_uu_buoy'); + add_default($nl, 'clubb_c6rt'); + add_default($nl, 'clubb_c6rtb'); + add_default($nl, 'clubb_c6rtc'); + add_default($nl, 'clubb_c6thl'); + add_default($nl, 'clubb_c6thlb'); + add_default($nl, 'clubb_c6thlc'); + add_default($nl, 'clubb_C8'); + add_default($nl, 'clubb_C8b'); + add_default($nl, 'clubb_c11'); + add_default($nl, 'clubb_c11b'); + add_default($nl, 'clubb_c14'); + add_default($nl, 'clubb_C_invrs_tau_bkgnd'); + add_default($nl, 'clubb_C_invrs_tau_sfc'); + add_default($nl, 'clubb_C_invrs_tau_shear'); + add_default($nl, 'clubb_C_invrs_tau_N2'); + add_default($nl, 'clubb_C_invrs_tau_N2_wp2'); + add_default($nl, 'clubb_C_invrs_tau_N2_xp2'); + add_default($nl, 'clubb_C_invrs_tau_N2_wpxp'); + add_default($nl, 'clubb_C_invrs_tau_N2_clear_wp3'); + add_default($nl, 'clubb_gamma_coef'); + add_default($nl, 'clubb_gamma_coefb'); + add_default($nl, 'clubb_beta'); + } + add_default($nl, 'clubb_C7'); add_default($nl, 'clubb_C7b'); - add_default($nl, 'clubb_C8'); - add_default($nl, 'clubb_C8b'); + + add_default($nl, 'clubb_C_wp3_pr_turb'); + add_default($nl, 'clubb_c_K1'); + add_default($nl, 'clubb_c_K2'); + add_default($nl, 'clubb_nu2'); + add_default($nl, 'clubb_c_K8'); add_default($nl, 'clubb_c_K9'); add_default($nl, 'clubb_nu9'); add_default($nl, 'clubb_c_K10'); add_default($nl, 'clubb_c_K10h'); add_default($nl, 'clubb_do_liqsupersat'); - add_default($nl, 'clubb_gamma_coef'); - add_default($nl, 'clubb_gamma_coefb'); + add_default($nl, 'clubb_wpxp_L_thresh'); + add_default($nl, 'clubb_lambda0_stability_coef'); add_default($nl, 'clubb_lmin_coef'); add_default($nl, 'clubb_mult_coef'); add_default($nl, 'clubb_Skw_denom_coef'); add_default($nl, 'clubb_skw_max_mag'); - add_default($nl, 'clubb_up2_vp2_factor'); + add_default($nl, 'clubb_up2_sfc_coef'); add_default($nl, 'clubb_C_wp2_splat'); - add_default($nl, 'clubb_wpxp_L_thresh'); add_default($nl, 'clubb_detliq_rad'); add_default($nl, 'clubb_detice_rad'); add_default($nl, 'clubb_detphase_lowtemp'); + add_default($nl, 'clubb_ipdf_call_placement'); add_default($nl, 'clubb_l_brunt_vaisala_freq_moist'); add_default($nl, 'clubb_l_call_pdf_closure_twice'); add_default($nl, 'clubb_l_damp_wp3_Skw_squared'); + add_default($nl, 'clubb_l_lmm_stepping'); + add_default($nl, 'clubb_l_e3sm_config'); add_default($nl, 'clubb_l_lscale_plume_centered'); add_default($nl, 'clubb_l_min_wp2_from_corr_wx'); add_default($nl, 'clubb_l_min_xp2_from_corr_wx'); @@ -3141,11 +3198,18 @@ if ($clubb_sgs =~ /$TRUE/io) { add_default($nl, 'clubb_l_use_C7_Richardson'); add_default($nl, 'clubb_l_use_C11_Richardson'); add_default($nl, 'clubb_l_use_cloud_cover'); - add_default($nl, 'clubb_l_use_ice_latent'); add_default($nl, 'clubb_l_use_thvm_in_bv_freq'); add_default($nl, 'clubb_l_vert_avg_closure'); - add_default($nl, 'clubb_l_diag_Lscale_from_tau'); add_default($nl, 'clubb_l_damp_wp2_using_em'); + add_default($nl, 'clubb_l_godunov_upwind_wpxp_ta'); + add_default($nl, 'clubb_l_godunov_upwind_xpyp_ta'); + add_default($nl, 'clubb_l_use_shear_Richardson'); + add_default($nl, 'clubb_l_use_tke_in_wp3_pr_turb_term'); + add_default($nl, 'clubb_l_use_tke_in_wp2_wp3_K_dfsn'); + add_default($nl, 'clubb_l_smooth_Heaviside_tau_wpxp'); + add_default($nl, 'clubb_l_do_expldiff_rtm_thlm'); + + #CLUBB+MF options add_default($nl, 'do_clubb_mf'); add_default($nl, 'do_clubb_mf_diag'); add_default($nl, 'clubb_mf_L0'); diff --git a/bld/namelist_files/namelist_defaults_cam.xml b/bld/namelist_files/namelist_defaults_cam.xml index 8366f2d9b7..b5ce306c32 100644 --- a/bld/namelist_files/namelist_defaults_cam.xml +++ b/bld/namelist_files/namelist_defaults_cam.xml @@ -1823,9 +1823,6 @@ .false. .false. - .false. - .true. - .false. .false. 1.0D0 @@ -1836,12 +1833,17 @@ 150.0D0 75.0D0 + + .false. + 1.0 1.0 1.0 1.0 1.3 5.2 + 0.3 + 0.3 4.0 6.0 1.0 @@ -1856,52 +1858,73 @@ 0.35D0 2.2D0 1.6D0 + 0.4 + 0.75 + 0.125 + 5.0 + 1.25 0.25 20.0 0.5 0.3 .false. 60.0 - 0.308 - 0.280 - 0.270 - 0.32 - 2.4 - 0.04 - 0.1 - 1.0D0 - 0.0 - 4.5 - 2.0 - 0.0 - 8.0D-6 - 25.0D-6 - 238.15D0 - + 1.0 + 0.1 + 0.02 + 0.1 + 0.2 + 0.2 + 0.0 + 0.0 + 0.308 + 0.280 + 0.270 + 0.32 + 2.4 + 0.04 + 0.1 + 1.0D0 + 0.0 + 4.5 + 2.0 + 0.0 + 8.0D-6 + 25.0D-6 + 238.15D0 + 1 + + .true. .false. .true. .false. .false. - .false. - .false. + .true. + .true. .false. .false. .true. .false. .false. + .false. + .false. .true. .false. .false. + .false. .true. - .false. .false. .true. - .false. .false. + .false. + .false. + .false. + .false. + .false. + .false. .true. - 0.2 0.2 0.2 @@ -1911,7 +1934,7 @@ 0.02 0.5 0.5 - 1.0 + 0.5 0.25 20.0 2.0 @@ -1924,7 +1947,7 @@ 1.5 4.0 10.0 - 4.0 + 4.0 0.0 .true. @@ -1943,7 +1966,7 @@ .true. .false. .false. - .true. + .false. .false. @@ -2250,6 +2273,17 @@ 0.0 0.0 + .true. + .false. + .false. + .true. + .true. + .false. + .true. + .true. + .true. + .false. + .true. NONE diff --git a/bld/namelist_files/namelist_definition.xml b/bld/namelist_files/namelist_definition.xml index 8a89f7a76f..72ef68e5d5 100644 --- a/bld/namelist_files/namelist_definition.xml +++ b/bld/namelist_files/namelist_definition.xml @@ -3273,6 +3273,61 @@ Intercept of linear equation that calculates precribed in-cloud ice mixing ratio Intercept of linear equation that calculates precribed in-cloud ice concentration ratio [N_i'^2] / [N_i]^2 [-] + +Enables importance sampling for SILHS subcolumns + + + +Enables calculation of Lscale_vert_avg, used to generate SILHS samples. + + + +Enables straight Monte Carlo sampling, this overrides l_lh_importance_sampling. + + + +Enables the "new" SILHS importance sampling scheme with prescribed probabilities. Requires l_lh_importance_sampling. + + + +Determine starting SILHS first sampling level (k_lh_start) based on maximum within-cloud rcm. If false, and if l_random_k_lh_start is also false, then the SILHS first sampling level is the column maximum of liquid cloud water. + + + +Determine starting SILHS first sampling level (k_lh_start) based on random choice. Overrides l_rcm_in_cloud_k_lh_start if true. + + + +Assumption of maximum vertical overlap when grid-box rcm exceeds cloud threshold. + + + +Produces "instantaneous" variance-covariance microphysical source terms, ignoring discretization effects. + + + +Limit SILHS sample point weights for stability. + + + +Prescribe variance fractions. + + + +Scale sample point weights to sum to num_samples (the "ratio estimate"). + + - -Explicit diffusion on temperature and moisture when CLUBB is on -Default: .false. - + +Option for the placement of the call to CLUBB's PDF closure. The options include: ipdf_pre_advance_fields (1) calls the PDF closure before advancing prognostic fields. ipdf_post_advance_fields (2) calls after advancing prognostic fields, and ipdf_pre_post_advance_fields (3) calls both before and after advancing prognostic fields. +Default: 1 + + Limiting value of C1 when skewness of w (vertical velocity) is small in @@ -3583,6 +3639,16 @@ C4 coefficient in the wp2 return-to-isotropy term. A higher value of C4 tends wp2 more towards the value of subgrid TKE. + +Coefficient in the wp2 (variance of vertical velocity) pressure terms opposing shear production. + + + +Coefficient in the wp2 (variance of vertical velocity) pressure terms opposing buoyancy production. + + Low Skewness in C7 Skw. Function @@ -3605,11 +3671,45 @@ the damping of CLUBB's wp3 when skewness of w (vertical velocity) is large in magnitude. + +Coefficient in the pressure-turbulence term of CLUBB's wp3 predictive equation. + + + +Coefficient of Kh_zm (diffusivity on momentum grid levels) in the wp2 (variance +of vertical velocity) predictive equation. +Default: 0.75 + + + +Coefficient of Kh_zm (diffusivity on momentum grid levels) in the scalar +variance predictive equations (e.g. rtp2, variance of total water). +Default: 0.125 + + + +Constant in the diffusivity term in the scalar variance predictive equations +(e.g. rtp2, variance of total water). +Default: 5.0 + + + +Coefficient of Kh_zt (diffusivity on thermodynamic grid levels) in the wp3 +(third-order moment of vertical velocity) predictive equation. +Default: 1.25 + + Coefficient of Kh_zm (diffusivity on momentum grid levels) in the up2 (variance of the west-east wind component) and vp2 (variance of the south-north wind component) predictive equations. +Default: 0.25 CLUBB tunable parameter - Lscale threshold: damp C6 and C7 (units: m) +Default: 60.0 + +Coefficient of inverse tau term contributed by background constant value (units: none) +Default: 1.0 + + + +Coefficient of inverse tau term contributed by surface log law (units: none) +Default: 0.1 + + + +Coefficient of inverse tau term contributed by vertical wind shear (units: none) +Default: 0.02 + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency (units: none) +Default: 0.1 + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency but for wp3_wp2 (units: none) +Default: 0.2 + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency but for xp2_wpxp (units: none) +Default: 0.2 + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency but for xm_wpxp (units: none) +Default: 0.0 + + + +Coefficient of inverse tau term contributed by Brunt Vaisala frequency but for wp3 (units: none) +Default: 0.0 + + -Low Skw.: gamma coef. Skw. Fnct. +Low Skewness in gamma coefficient Skewness Function (units: none) +Default: Changes depending on grid and physics options - Factor used in calculating the surface values of up2 (variance of the u wind component) and vp2 (variance of the v wind component). Increasing -clubb_up2_vp2_factor increases the values of up2 and vp2 at the surface. +clubb_up2_sfc_coef increases the values of up2 and vp2 at the surface. +Default: 2.0 Coefficient for gustiness near ground. +Default: 0.0 + +Flag to use shear in the calculation of Richardson number. +Default: .false. + + Flag to allow cloud fraction and mean cloud water at adjacent vertical grid levels influence the amount of cloudiness and amount of cloud water in a grid box. - - - -Include the effects of ice latent heating in turbulence terms -Default: .false. +Default: .true. Flag to use mean theta-v in the calculation of Brunt-Vaisala frequency. +Default: .false. Flag that, when it is enabled, automatically enables CLUBB's l_trapezoidal_rule_zt, l_trapezoidal_rule_zm, and l_call_pdf_closure_twice. +Default: .true. + + + +Flag to apply Linear Multistep Method (LMM) stepping in CLUBB. +Default: .false. + + + +Flag to run CLUBB with E3SM settings. +Default: .true. + +Flag to use Total Kenetic Energy (TKE) in eddy diffusion for wp2 and wp3. +Default: .false. + + + +Flag to use Total Kenetic Energy (TKE) formulation for wp3 pr_turb (turbulent +production) term. +Default: .false. + + + +Flag to use smooth Heaviside 'Peskin' in computation of invrs_tau. +Default: .false. + + + +This flag determines whether we want to use an upwind differencing approximation +rather than a centered differencing for turbulent advection terms. It affects +wpxp only. +Default: .false. + + + +This flag determines whether we want to use an upwind differencing approximation +rather than a centered differencing for turbulent advection terms. It affects +xpyp only. +Default: .false. + + Flag to use a dissipation formula of -(2/3)*em/tau_zm, as in Bougeault (1981), in the wp2 (variance of vertical velocity) predictive equation. +Default: .false. + + + +Explicit diffusion on temperature and moisture by CLUBB, in addition to CLUBB's +normal prognostic equations for rtm and thlm. +Default: .false. + +SCAM to calculate or read tendencies from a global ana/dycore +Default: FALSE + + + +Use 1st order upwind for ana tendencies (instead of 2nd order space centered) +Default: FALSE + + + +Use scam state as center column in stencil for ana adv tendencies +Default: FALSE + + + +Use scam state as center column in stencil for ana adv tendencies +Default: FALSE + + + +Use scam state as center column in stencil for ana adv tendencies +Default: FALSE + + + +Use scam state as center column in stencil for ana adv tendencies +Default: FALSE + + + +Force scam to use tendencies directly from dycore or ana (not recalculated) +Default: FALSE + + + +Force scam to use omega directly from dycore or ana (not recalculated) +Default: FALSE + + + +Interpolate ana fields to constant pressure surfaces +Default: FALSE + + + + +template for analysis forcing dataset. +Default: set by build-namelist. + + + +templatefull path for analysis forcing dataset. +Default: set by build-namelist. + + + +Force scam to compute large-scale forcing from renalysis or 3D model output +Default: FALSE + + 0): + freqw=freqc*h0frq + + freqs = str( freqw ) + freqs = freqs.strip()+'S' + print('write interval='+freqs) + + fl = sorted( glob.glob( dir +'/*cam.h0*') ) + nf = len( fl ) + + #fl=fl[0:10] + ird=0 + for f in fl: + print(f) + try: + a=xr.open_dataset( f ) + print("Successfully opened"+f) + nx=a.lon.size + ny=a.lat.size + nl=a.lev.size + nli=a.ilev.size + nt=a.time.size + + aa=a[fld] #.isel(time=0) + print(aa.dims) + + if ('lon' in aa.dims) and ('lat' in aa.dims) and ('lev' not in aa.dims) and ('ilev' not in aa.dims): + print(fld+' is a surface var ' ) + varType = 'surface' + if ('lon' in aa.dims) and ('lat' in aa.dims) and ('lev' in aa.dims): + print(fld+' is a profile var ' ) + varType = 'profile' + if ('lon' in aa.dims) and ('lat' in aa.dims) and ('ilev' in aa.dims): + print(fld+' is an Iprofile var ' ) + varType = 'iprofile' + + if (ird == 0): + #Cook up time array + timeData=a.time.data + #interval=a.time[1]-a.time[0] + #intersec= ( interval.data.astype(int) / 10**9 ) # this is in NANOseconds + bigTime = xr.cftime_range( timeData[0] , periods=nt*nf, freq=freqs , calendar="noleap" ) + if varType == 'surface': + dummy=np.zeros( nt*nf ) + dummy=dummy.reshape( nt*nf ,1,1) + cu=xr.DataArray( dummy , coords=[bigTime,a.lat,a.lon], dims=['time','lat','lon'] , name=fld ) + if varType == 'profile': + dummy=np.zeros( nt*nf*nl ) + dummy=dummy.reshape( nt*nf,nl ,1,1) + cu=xr.DataArray( dummy , coords=[bigTime,a.lev,a.lat,a.lon], dims=['time','lev','lat','lon'], name=fld ) + if varType == 'iprofile': + dummy=np.zeros( nt*nf*nli ) + dummy=dummy.reshape( nt*nf,nli ,1,1) + cu=xr.DataArray( dummy , coords=[bigTime,a.ilev,a.lat,a.lon], dims=['time','ilev','lat','lon'], name=fld ) + + print('Prepped XARRAY for data with time') + + if varType == 'surface': + #cu.values[ ird*nt :(ird+1)*nt-1, 0, 0] = aa[:,0,0] # why the heck is this wrong?????!!!!! + cu.values[ ird*nt :(ird+1)*nt , 0, 0] = aa[:,0,0] + if varType == 'profile' or varType == 'iprofile': + cu.values[ ird*nt :(ird+1)*nt , : , 0, 0] = aa[:,:,0,0] + + ird=ird+1 + + except ValueError: + print('******** VALUE ERROR *************') + print('File \n'+f+'\n probably no good') + if (ird == 0): + exit('First dataset not valid') + else: + ird=ird+1 + + cu.to_netcdf('/project/amp/juliob/scam/'+xp+'_'+fld+'.nc') + + return cu + + + def ncmerge(self): + import numpy as np + import xarray as xr + import glob + import txtutil as tx + + + + xp=self.case + dir=self.archdir + + fl = sorted( glob.glob( dir +'/*cam.h0*') ) + nf = len( fl ) + + flt = fl[0:10] + + #ds=xr.open_mfdataset( flt , concat_dim='time') + #print("merged nc files") + #ds.to_netcdf(path = dir +'/merged_h0.nc') + #exit() + + ird=0 + for f in flt: + print(f) + try: + a=xr.open_dataset( f ) + print("Successfully opened"+f) + + if (ird == 0): + b=a + elif (ird>0): + b.merge(a,join='inner' ) + b.to_netcdf( 'testmerge.nc' ) + + ird=ird+1 + + except ValueError: + print('******** VALUE ERROR *************') + print('File \n'+f+'\n probably no good') + if (ird == 0): + exit('First dataset not valid') + else: + ird=ird+1 + + return diff --git a/myPythonTools/scam_case.py b/myPythonTools/scam_case.py new file mode 100644 index 0000000000..af5eb97ac6 --- /dev/null +++ b/myPythonTools/scam_case.py @@ -0,0 +1,342 @@ +class scam_case: + #import sys + #import getopt as go + #import os + + def __init__(self): + import os + + self.scmlat=36.6 + self.scmlon=270. + self.nlev=58 + self.name="base_case" + self.tag="case_tag" + self.startdate=[2010,4,1] + self.atm_ncpl=192 + self.mfilt=1 + self.nsteps=31*self.atm_ncpl + self.coupler="nuopc" + self.compiler="intel" + self.basecase="base_case" + self.isbasecase=True + self.NameByBuild=False + self.cime_output_root="dir" + self.ensemble_root="none" + self.project="P93300642" # Needed for Cheyenne + + host=os.environ['HOST'] + + if ('izumi' in host): + self.machine="izumi" + elif ('cheyenne' in host): + self.machine="cheyenne" + + def base_case(self): + import subprocess as sp + import os + import pickle + + user=os.environ['USER'] + + y = self.startdate[0] + m = self.startdate[1] + d = self.startdate[2] + lat = self.scmlat + lon = self.scmlon + lev = self.nlev + tag = self.tag + + + case_day = str(d).zfill(2) + case_mon = str(m).zfill(2) + case_yr = str(y).zfill(4) + + case_date = case_yr+case_mon+case_day + case_sdate = case_yr+"-"+case_mon+"-"+case_day + + case_lat = str(abs(lat)).zfill(4) + if lat < 0: + case_lat = case_lat+'S' + elif lat > 0: + case_lat = case_lat+'N' + if lon < 0: + lon = lon+360. + + case_lon = str(abs(lon)).zfill(5)+'E' + case_lev = 'L'+str(abs(lev)) + + lonstr = str(lon) + latstr = str(lat) + levstr = str(lev) + + NstepStr = str( self.nsteps ) + NcplStr = str( self.atm_ncpl ) + CplStr = str( self.coupler ) + CompilerStr = str( self.compiler ) + MachStr = str( self.machine ) + ProjStr = str( self.project ) + + if (self.NameByBuild == True): + case_tag = tag+'_'+MachStr+'_'+CompilerStr+'_'+CplStr + else: + case_tag = tag+'_'+case_lev+'_'+case_lon+'_'+case_lat+'_'+case_yr+'-'+case_mon+'-'+case_day + + if ( self.coupler=="nuopc"): + COMPSET="FSCAM" + elif ( self.coupler=="mct"): + COMPSET="2000_CAM60%SCAM_CLM50%SP_CICE5%PRES_DOCN%DOM_SROF_SGLC_SWAV" + + + #This is the actual case name for the 'base' case + print(case_tag) + self.name=case_tag + self.basecase=case_tag + self.isbasecase=True + + #----------------------------------------------------- + # This script assumes that you will create new cases in + # in a directory '../../cases' from + # ${CESMROOT}/cime/scripts + #----------------------------------------------------- + cmd1="mkdir -p ../../cases/"+case_tag + + if (MachStr == 'cheyenne'): + cmd2="./create_newcase --case ../../cases/"+case_tag+ " --compset "+ COMPSET + " --res T42_T42 --driver " + CplStr + " --user-mods-dir ../../cime_config/usermods_dirs/scam_STUB --walltime 01:00:00 --mach " + MachStr + " --pecount 1 --compiler "+ CompilerStr + " --project "+ ProjStr + " --run-unsupported" + else: + cmd2="./create_newcase --case ../../cases/"+case_tag+ " --compset "+ COMPSET + " --res T42_T42 --driver " + CplStr + " --user-mods-dir ../../cime_config/usermods_dirs/scam_STUB --walltime 01:00:00 --mach " + MachStr + " --pecount 1 --compiler "+ CompilerStr + " --run-unsupported" + + cd0 = 'cd ../../cases/'+case_tag +';' + + #sp.run('date') + sp.run(cmd2,shell=True) + + cmd = ( "./case.setup" ) + sp.run(cd0 + cmd , shell=True ) + + #cmd = ( "cp ../../cime_config/usermods_dirs/scam_STUB/scripts/STUB_iop.nc ./") + #sp.run(cd0 + cmd , shell=True ) + + cmd = ( "cp ../../myPythonTools/STUB_iop.nc ./") + sp.run(cd0 + cmd , shell=True ) + cmd = ( "cp ../../myPythonTools/user_nl_cice ./") + sp.run(cd0 + cmd , shell=True ) + + if (self.nlev==58) and (self.machine=='cheyenne'): + cmd = ( "cp ../../myPythonTools/user_nl_cam_L58_cheyenne ./user_nl_cam") + elif (self.nlev==93) and (self.machine=='cheyenne'): + cmd = ( "cp ../../myPythonTools/user_nl_cam_L93_cheyenne ./user_nl_cam") + else: + cmd = ( "cp ../../myPythonTools/user_nl_cam ./") + + sp.run(cd0 + cmd , shell=True ) + + cmd = ( "./xmlchange DOUT_S_ROOT='/project/amp/"+user+"/scam/archive/"+case_tag+"'" + ";" + + "./xmlchange CAM_CONFIG_OPTS='-dyn eul -scam -phys cam_dev -nlev "+levstr+"'"+ ";" + + "./xmlchange ATM_NCPL="+NcplStr+";"+ + "./xmlchange STOP_N="+NstepStr+";"+ + "./xmlchange START_TOD=00000"+";"+ + "./xmlchange STOP_OPTION=nsteps"+";"+ + "./xmlchange PTS_LAT="+latstr+";"+ + "./xmlchange PTS_LON="+lonstr+";"+ + "./xmlchange RUN_STARTDATE="+case_sdate+";" + ) + sp.run(cd0 + cmd , shell=True ) + + + cmd = ( + "ncap2 --overwrite -s bdate="+case_date+" STUB_iop.nc STUB_iop.nc"+";"+ + "ncap2 --overwrite -s lat[lat]="+latstr+" STUB_iop.nc STUB_iop.nc"+";"+ + "ncap2 --overwrite -s lon[lon]="+lonstr+" STUB_iop.nc STUB_iop.nc"+";" + ) + sp.run(cd0 + cmd , shell=True ) + + + print("Machine = "+self.machine) + print("Compiler = "+self.compiler) + print("created and setup case=") + print(" ../../cases/"+case_tag ) + print("Should be ready to build and submit") + fname = '../../cases/'+case_tag+'/'+'env_build.xml' + + # find CIME_OUTPUT_ROOT + fob=open(fname,"r") + linin = fob.readlines() + for line in linin: + if (line.find('entry id="CIME_OUTPUT_ROOT"') !=-1): + linspl1 = line.split('value=') + linspl2 = linspl1[1].split('"') + self.cime_output_root = linspl2[1] + fob.close() + + # write 'self' to pickle file in casedir + fname = '../../cases/'+case_tag+'/'+'BaseCaseSelf.pkL' + with open( fname, 'wb') as fob: + pickle.dump( self, fob ) + fob.close() + + + def spawn_case(self,basecase): + #--------------------------------------- + # This function is still under development + #--------------------------------------- + import subprocess as sp + import os + import pickle + import txtutil as tx + + user=os.environ['USER'] + + fname = '../../cases/'+basecase+'/'+'BaseCaseSelf.pkL' + with open( fname, 'rb') as fob: + base=pickle.load( fob ) + fob.close() + + #--------------------------------- + # These sould be inherited from + # base case or hardwried here + #--------------------------------- + self.basecase = base.name + self.isbasecase = False + self.nlev = base.nlev + self.coupler = base.coupler + self.compiler = base.compiler + self.atm_ncpl = base.atm_ncpl + self.cime_output_root = base.cime_output_root + lev = base.nlev + + #----------------------------------- + # These are specified in scam_drv.py + # or scam_ens.py + #----------------------------------- + y = self.startdate[0] + m = self.startdate[1] + d = self.startdate[2] + lat = self.scmlat + lon = self.scmlon + tag = self.tag + + + case_day = str(d).zfill(2) + case_mon = str(m).zfill(2) + case_yr = str(y).zfill(4) + + case_date = case_yr+case_mon+case_day + case_sdate = case_yr+"-"+case_mon+"-"+case_day + + case_lat = str(abs(lat)).zfill(4) + if lat < 0: + case_lat = case_lat+'S' + elif lat > 0: + case_lat = case_lat+'N' + if lon < 0: + lon = lon+360. + + case_lon = str(abs(lon)).zfill(5)+'E' + case_lev = 'L'+str(abs(lev)) + + lonstr = str(lon) + latstr = str(lat) + levstr = str(lev) + + case_tag = tag+'_'+case_lev+'_'+case_lon+'_'+case_lat+'_'+case_yr+'-'+case_mon+'-'+case_day + self.name = case_tag + + ensemble_root = self.cime_output_root + '/' + self.basecase +'_ENS' + self.ensemble_root = ensemble_root + + + # -------------- + # Clean before making new directory + #---------------- + cmd = ("rm -rf "+ ensemble_root + "/"+case_tag) + sp.run( cmd , shell=True ) + + cmd = ("mkdir -p "+ ensemble_root + "/"+case_tag+"/bld") + sp.run( cmd , shell=True ) + + cmd = ("cp -r "+ self.cime_output_root + "/" + base.name +"/run" + " " + + ensemble_root + "/"+case_tag+"/run") + sp.run( cmd , shell=True ) + + cmd = ("cp "+ self.cime_output_root + "/" + base.name +"/bld/cesm.exe" + " " + + ensemble_root + "/"+case_tag+"/bld/") + sp.run( cmd , shell=True ) + + cmd = ( "cp ../../myPythonTools/STUB_iop.nc" + " " + + ensemble_root + "/"+case_tag+"/run/") + sp.run(cmd , shell=True ) + cmd = ( "cp ../../myPythonTools/ens_run.sh" + " " + + ensemble_root + "/"+case_tag+"/run/") + sp.run(cmd , shell=True ) + + cd0 ="cd "+ ensemble_root + "/" + case_tag +"/run ;" + + cmd = ( + "ncap2 --overwrite -s bdate="+case_date+" STUB_iop.nc STUB_iop.nc"+";"+ + "ncap2 --overwrite -s lat[lat]="+latstr+" STUB_iop.nc STUB_iop.nc"+";"+ + "ncap2 --overwrite -s lon[lon]="+lonstr+" STUB_iop.nc STUB_iop.nc"+";" + ) + sp.run(cd0 + cmd , shell=True ) + + fili= ensemble_root + "/" + case_tag +"/run/atm_in" + tx.nmled(fili,'iopfile','"STUB_iop.nc"') + # Set history to make one file per day + tx.nmled(fili,'mfilt',str(self.mfilt) ) + + if (base.coupler=='nuopc'): + fili= ensemble_root + "/" + case_tag +"/run/nuopc.runconfig" + tx.nmled(fili,'case_name',case_tag) + tx.nmled(fili,'start_ymd',case_date) + tx.nmled(fili,'scol_lat',latstr) + tx.nmled(fili,'scol_lon',lonstr) + + if (base.coupler=='mct'): + fili= ensemble_root + "/" + case_tag +"/run/drv_in" + tx.nmled(fili,'case_name',case_tag) + tx.nmled(fili,'start_ymd',case_date) + tx.nmled(fili,'scmlat',latstr) + tx.nmled(fili,'scmlon',lonstr) + + def ensemble_member_run(self): + import subprocess as sp + import os + + cd0 ="cd "+ self.ensemble_root + "/" + self.name +"/run ;" + cmd ="/usr/local/torque/bin/qsub ens_run.sh" + + sp.run(cd0 + cmd , shell=True ) + + def unpickle_base(self,basecase): + #--------------------------------------- + # This function is still under development + #--------------------------------------- + import pickle + + fname = '../../cases/'+basecase+'/'+'BaseCaseSelf.pkL' + with open( fname, 'rb') as fob: + base=pickle.load( fob ) + fob.close() + + return base + + def changeTag(self,newtag): + #--------------------------------------- + # This function is still under development + #--------------------------------------- + + self.tag = newtag + + def changeLon(self,newlon): + #--------------------------------------- + # This function is still under development + #--------------------------------------- + + self.scmlon = newlon + + def changeLat(self,newlat): + #--------------------------------------- + # This function is still under development + #--------------------------------------- + + self.scmlat = newlat + diff --git a/myPythonTools/scam_drv.py b/myPythonTools/scam_drv.py new file mode 100755 index 0000000000..904a9fd3d4 --- /dev/null +++ b/myPythonTools/scam_drv.py @@ -0,0 +1,69 @@ +#!/usr/bin/env python + +import getopt as go +import scam_case as scm +import sys +import os + +argv=sys.argv + +case=scm.scam_case() +user=os.environ['USER'] +spawncase=False + +print(case.scmlon) + +try: + opts, args = go.getopt( argv[1:], "i:j:y:m:d:t:l:x:n:q:c:S:M:N", + ["lon=","lat=","year=","month=","day=","tag=","nlev=","coupler=","nsteps=" + ,"atm-ncpl=","compiler=","spawn=","machine=","NameByBuild="] ) +except: + print( "something is wrong") + exit() + +date=case.startdate +print(date) + +for opt, arg in opts: + if opt in ("-i","--lon"): + case.scmlon = float(arg) + elif opt in ("-j","--lat"): + case.scmlat = float(arg) + elif opt in ("-y","--year"): + case.startdate[0] = int(arg) + elif opt in ("-m","--month"): + case.startdate[1] = int(arg) + elif opt in ("-d","--day"): + case.startdate[2] = int(arg) + elif opt in ("-l","--nlev"): + case.nlev = int(arg) + elif opt in ("-t","--tag"): + case.tag = arg + elif opt in ("-x","--coupler"): + case.coupler = arg + elif opt in ("-n","--nsteps"): + case.nsteps = int(arg) + elif opt in ("-q","--atm-ncpl"): + case.atm_ncpl = int(arg) + elif opt in ("-c","--compiler"): + case.compiler = arg + elif opt in ("-M","--machine"): + case.machine = arg + elif opt in ("-S","--spawn"): + basecase = arg + spawncase = True + elif opt in ("-N","--NameByBuild"): + case.NameByBuild=True + + +date=case.startdate +print(date) + +if (spawncase == False): + case.base_case() +else: + case.spawn_case(basecase) + +#fname = '../../cases/'+case_tag+'/'+'CaseInst.pysave' +#with open( fname, 'wb') as fob: +# pickle.dump( case, fob ) diff --git a/myPythonTools/scam_ens.py b/myPythonTools/scam_ens.py new file mode 100755 index 0000000000..be5502a8f1 --- /dev/null +++ b/myPythonTools/scam_ens.py @@ -0,0 +1,49 @@ +#!/usr/bin/env python + +import scam_case as scm +import numpy as np + +#basecase = 'nCTOPb3_L58_080.0E_30.0N_2010-07-01' +basecase = 'NCPL96_izumi_intel_nuopc' +base=scm.scam_case() +base=base.unpickle_base(basecase) + +print(base.__dict__) + +#exit() + +starting_ens=21 +lats = 32.+ np.arange(2) +lons = 85.+ np.arange(10) + +Lons,Lats = np.meshgrid(lons,lats) + + +dims=Lons.shape + + +x=[] +n=0 +for j in range( dims[1] ): + for i in range( dims[0]): + x.append( scm.scam_case() ) + n=n+1 + +Lons=Lons.reshape( dims[0]*dims[1] ) +Lats=Lats.reshape( dims[0]*dims[1] ) + +N=n +for n in range(N): + nens=n+starting_ens + ee = 'x_E'+str(nens).zfill(2) + x[n].changeTag( ee ) + x[n].changeLon( Lons[n] ) + x[n].changeLat( Lats[n] ) + x[n].startdate = [2010,6,1] #base.startdate + +for n in range(N): + x[n].spawn_case(basecase) + +for n in range(N): + x[n].ensemble_member_run() + diff --git a/myPythonTools/testh0.py b/myPythonTools/testh0.py new file mode 100644 index 0000000000..67394bf105 --- /dev/null +++ b/myPythonTools/testh0.py @@ -0,0 +1,20 @@ +import h0scam as h0 + +#---------------------------------- +# Run from python prompt like this: +# exec(open("./testh0.py").read()) + +#dir='/scratch/cluster/juliob/nCTOPb3_L58_080.0E_30.0N_2010-07-01_ENS/x_E03_L58_081.0E_33.0N_2010-07-01/run/' +#xp='x_E03_L58_081.0E_33.0N_2010-07-01' + +dir='/scratch/cluster/juliob/NCPL96_izumi_intel_nuopc_ENS/x_E01_L58_085.0E_32.0N_2010-04-01/run/' +xp='x_E01_L58_085.0E_32.0N_2010-04-01' + +#dir='/scratch/cluster/juliob/nCTOPb2_L58_080.0E_30.0N_2010-07-01/run/' +#xp='nCTOPb2_L58_080.0E_30.0N_2010-07-01' + +x = h0.h0scam(xp=xp,dir=dir) + +#x.ncmerge() + +cu=x.curtain('rtm_mfl') diff --git a/myPythonTools/txtutil.py b/myPythonTools/txtutil.py new file mode 100644 index 0000000000..415ade01cd --- /dev/null +++ b/myPythonTools/txtutil.py @@ -0,0 +1,43 @@ +import subprocess as sp + +# which namelist parameter to change + +def nmled(fili,parm,valu): + #which file + #fili = "atm_in" + filo = fili+"_edit" + + + fin = open( fili ,"r") + fex = open( filo ,"w") + linin = fin.readlines() + for line in linin: + spl = line.split("=") + #if (line.find("zmconv_ke") !=-1): + if (spl[0].strip() == parm): + print(spl) + spl[1] = " "+ valu +" \n" + print(spl) + line="=".join(spl) + + fex.write(line) + + fin.close() + fex.close() + + cmd = "mv "+filo+" "+fili + sp.run( cmd, shell=True) + +def nmlread(fili,parm): + + valu=-99999 + fin = open( fili ,"r") + linin = fin.readlines() + for line in linin: + spl = line.split("=") + if (spl[0].strip() == parm): + valu=spl[1] + + fin.close() + + return valu diff --git a/myPythonTools/user_nl_cam b/myPythonTools/user_nl_cam new file mode 100644 index 0000000000..eac76629f5 --- /dev/null +++ b/myPythonTools/user_nl_cam @@ -0,0 +1,93 @@ +!scmlon=$PTS_LON +!scmlat=$PTS_LAT +iopfile="$CASEROOT/STUB_iop.nc" +ncdata="/project/amp/juliob/scam/inputdata/SCAM_IC_288x192_L58_48_BL10.nc" + + +bnd_topo="/fs/cgd/csm/inputdata/atm/cam/topo/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_c170103.nc" + +mfilt=5760 + +nhtfrq=1 +scm_use_obs_uv = .false. +scm_relaxation = .false. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. + +use_scm_ana_frc = .true. +scm_ana_frc_path = '/project/amp/juliob/ERAI/f09_omega/L58/' +scm_ana_frc_file_template = '%y/ERAI_fv09_L58.cam2.i.%y-%m-%d-%s.nc' + +scm_ana_x_plevels = .true. +scm_ana_direct_omega = .true. +scm_ana_direct_ttend = .false. +scm_ana_t_react = .true. +scm_ana_q_react = .true. +scm_ana_u_react = .true. +scm_ana_v_react = .true. +scm_ana_upwind = .false. + +fincl1 = 'Target_U','Target_V','Target_T','Target_Q', + 'Nudge_U','Nudge_V','Nudge_T','Nudge_Q', + 'OMEGA_ANA','ETAD_ANA','T_ANA','Q_ANA','U_ANA','V_ANA', + 'UTEND_PHYSTOT', 'VTEND_PHYSTOT', 'TTEN_PHYS', + 'UTEND_DCONV','UTEND_SHCONV','UTEND_MACROP','UTEND_VDIFF','UTEND_RAYLEIGH', + 'UTEND_GWDTOT','UTEND_QBORLX','UTEND_LUNART','UTEND_IONDRG','UTEND_NDG', + 'VTEND_DCONV','VTEND_SHCONV','VTEND_MACROP','VTEND_VDIFF','VTEND_RAYLEIGH', + 'VTEND_GWDTOT','VTEND_QBORLX','VTEND_LUNART','VTEND_IONDRG','VTEND_NDG', + 'KVH_CLUBB','TAUARDGBETAX','TAUARDGBETAY','TAU1RDGBETAX','TAU1RDGBETAY', + 'UBT1RDGBETA','TAU1RDGBETAM','RVMTEND_CLUBB' + + +gw_drag_file = '/fs/cgd/inputdata/inputdata/atm/waccm/gw/newmfspectra40_dc25.nc' +use_gw_convect_dp = .false. +use_gw_convect_sh = .false. +use_gw_front = .false. +scm_use_ana_iop = .true. +cld_macmic_num_steps=3 +do_clubb_mf = .false. +do_clubb_mf_diag = .false. + +&nudging_nl +Nudge_Model = .true. +Nudge_Path = '/project/amp/juliob/ERAI/f09_omega/L58/' +Nudge_File_Template = '%y/ERAI_fv09_L58.cam2.i.%y-%m-%d-%s.nc' +Nudge_Force_Opt = 0 +Nudge_TimeScale_Opt = 0 +Nudge_Times_Per_Day = 4 +Model_Times_Per_Day = 192 +Nudge_Uprof = 2 +Nudge_Ucoef = 1.0 +Nudge_Vprof = 2 +Nudge_Vcoef = 1.0 +Nudge_Tprof = 2 +Nudge_Tcoef = 1.0 +Nudge_Qprof = 2 +Nudge_Qcoef = 0.0 +Nudge_PSprof = 0 +Nudge_PScoef = 0 +Nudge_Beg_Year = 2009 +Nudge_Beg_Month = 1 +Nudge_Beg_Day = 1 +Nudge_End_Year = 2018 +Nudge_End_Month = 4 +Nudge_End_Day = 5 +Nudge_Hwin_lat0 = 0.0 +Nudge_Hwin_lon0 = 180. +Nudge_Hwin_latWidth = 9999.0 +Nudge_Hwin_lonWidth = 9999.0 +Nudge_Hwin_latDelta = 1.0 +Nudge_Hwin_lonDelta = 1.0 +Nudge_Hwin_Invert = .false. +Nudge_Vwin_Hindex = 0. +Nudge_Vwin_Lindex = 0. +Nudge_Vwin_Hdelta = 0.001 +Nudge_Vwin_Ldelta = 0.001 +Nudge_Vwin_Invert = .true. +/ diff --git a/myPythonTools/user_nl_cam_L58_cheyenne b/myPythonTools/user_nl_cam_L58_cheyenne new file mode 100644 index 0000000000..195097a88a --- /dev/null +++ b/myPythonTools/user_nl_cam_L58_cheyenne @@ -0,0 +1,92 @@ +!scmlon=$PTS_LON +!scmlat=$PTS_LAT +iopfile="$CASEROOT/STUB_iop.nc" +ncdata="/glade/p/cgd/amp/juliob/scam/inputdata/SCAM_IC_288x192_L58_48_BL10.nc" + +bnd_topo='/glade/p/cesmdata/cseg/inputdata/atm/cam/topo/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_c170103.nc' + +mfilt=5760 + +nhtfrq=1 +scm_use_obs_uv = .false. +scm_relaxation = .false. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. + +use_scm_ana_frc = .true. +scm_ana_frc_path = '/glade/p/cgd/amp/juliob/ERAI/f09_omega/L58/' +scm_ana_frc_file_template = '%y/ERAI_fv09_L58.cam2.i.%y-%m-%d-%s.nc' + +scm_ana_x_plevels = .true. +scm_ana_direct_omega = .true. +scm_ana_direct_ttend = .false. +scm_ana_t_react = .true. +scm_ana_q_react = .true. +scm_ana_u_react = .true. +scm_ana_v_react = .true. +scm_ana_upwind = .false. + +fincl1 = 'Target_U','Target_V','Target_T','Target_Q', + 'Nudge_U','Nudge_V','Nudge_T','Nudge_Q', + 'OMEGA_ANA','ETAD_ANA','T_ANA','Q_ANA','U_ANA','V_ANA', + 'UTEND_PHYSTOT', 'VTEND_PHYSTOT', 'TTEN_PHYS', + 'UTEND_DCONV','UTEND_SHCONV','UTEND_MACROP','UTEND_VDIFF','UTEND_RAYLEIGH', + 'UTEND_GWDTOT','UTEND_QBORLX','UTEND_LUNART','UTEND_IONDRG','UTEND_NDG', + 'VTEND_DCONV','VTEND_SHCONV','VTEND_MACROP','VTEND_VDIFF','VTEND_RAYLEIGH', + 'VTEND_GWDTOT','VTEND_QBORLX','VTEND_LUNART','VTEND_IONDRG','VTEND_NDG', + 'KVH_CLUBB','TAUARDGBETAX','TAUARDGBETAY','TAU1RDGBETAX','TAU1RDGBETAY', + 'UBT1RDGBETA','TAU1RDGBETAM','RVMTEND_CLUBB' + + +gw_drag_file = '/glade/p/cesmdata/cseg/inputdata/atm/waccm/gw/newmfspectra40_dc25.nc' +use_gw_convect_dp = .true. +use_gw_convect_sh = .false. +use_gw_front = .false. +scm_use_ana_iop = .true. +cld_macmic_num_steps=3 +do_clubb_mf = .false. +do_clubb_mf_diag = .false. + +&nudging_nl +Nudge_Model = .true. +Nudge_Path = '/glade/p/cgd/amp/juliob/ERAI/f09_omega/L58/' +Nudge_File_Template = '%y/ERAI_fv09_L58.cam2.i.%y-%m-%d-%s.nc' +Nudge_Force_Opt = 0 +Nudge_TimeScale_Opt = 0 +Nudge_Times_Per_Day = 4 +Model_Times_Per_Day = 192 +Nudge_Uprof = 2 +Nudge_Ucoef = 1.0 +Nudge_Vprof = 2 +Nudge_Vcoef = 1.0 +Nudge_Tprof = 2 +Nudge_Tcoef = 1.0 +Nudge_Qprof = 2 +Nudge_Qcoef = 0.0 +Nudge_PSprof = 0 +Nudge_PScoef = 0 +Nudge_Beg_Year = 2009 +Nudge_Beg_Month = 1 +Nudge_Beg_Day = 1 +Nudge_End_Year = 2018 +Nudge_End_Month = 4 +Nudge_End_Day = 5 +Nudge_Hwin_lat0 = 0.0 +Nudge_Hwin_lon0 = 180. +Nudge_Hwin_latWidth = 9999.0 +Nudge_Hwin_lonWidth = 9999.0 +Nudge_Hwin_latDelta = 1.0 +Nudge_Hwin_lonDelta = 1.0 +Nudge_Hwin_Invert = .false. +Nudge_Vwin_Hindex = 0. +Nudge_Vwin_Lindex = 0. +Nudge_Vwin_Hdelta = 0.001 +Nudge_Vwin_Ldelta = 0.001 +Nudge_Vwin_Invert = .true. +/ diff --git a/myPythonTools/user_nl_cam_L93_cheyenne b/myPythonTools/user_nl_cam_L93_cheyenne new file mode 100644 index 0000000000..4b94b10b8c --- /dev/null +++ b/myPythonTools/user_nl_cam_L93_cheyenne @@ -0,0 +1,92 @@ +!scmlon=$PTS_LON +!scmlat=$PTS_LAT +iopfile="$CASEROOT/STUB_iop.nc" +ncdata="/glade/p/cgd/amp/juliob/scam/inputdata/SCAM_IC_288x192_L93.nc" + +bnd_topo='/glade/p/cesmdata/cseg/inputdata/atm/cam/topo/fv_0.9x1.25_nc3000_Nsw042_Nrs008_Co060_Fi001_ZR_sgh30_24km_GRNL_c170103.nc' + +mfilt=5760 + +nhtfrq=1 +scm_use_obs_uv = .false. +scm_relaxation = .false. +scm_relax_fincl = 'T', 'bc_a1', 'bc_a4', 'dst_a1', 'dst_a2', 'dst_a3', 'ncl_a1', 'ncl_a2', + 'ncl_a3', 'num_a1', 'num_a2', 'num_a3', + 'num_a4', 'pom_a1', 'pom_a4', 'so4_a1', 'so4_a2', 'so4_a3', 'soa_a1', 'soa_a2' +scm_relax_bot_p = 105000. +scm_relax_top_p = 200. +scm_relax_linear = .true. +scm_relax_tau_bot_sec = 864000. +scm_relax_tau_top_sec = 172800. + +use_scm_ana_frc = .true. +scm_ana_frc_path = '/glade/p/cgd/amp/juliob/ERAI/f09_omega/L93/' +scm_ana_frc_file_template = '%y/ERAI_fv09_L93.cam2.i.%y-%m-%d-%s.nc' + +scm_ana_x_plevels = .true. +scm_ana_direct_omega = .true. +scm_ana_direct_ttend = .false. +scm_ana_t_react = .true. +scm_ana_q_react = .true. +scm_ana_u_react = .true. +scm_ana_v_react = .true. +scm_ana_upwind = .false. + +fincl1 = 'Target_U','Target_V','Target_T','Target_Q', + 'Nudge_U','Nudge_V','Nudge_T','Nudge_Q', + 'OMEGA_ANA','ETAD_ANA','T_ANA','Q_ANA','U_ANA','V_ANA', + 'UTEND_PHYSTOT', 'VTEND_PHYSTOT', 'TTEN_PHYS', + 'UTEND_DCONV','UTEND_SHCONV','UTEND_MACROP','UTEND_VDIFF','UTEND_RAYLEIGH', + 'UTEND_GWDTOT','UTEND_QBORLX','UTEND_LUNART','UTEND_IONDRG','UTEND_NDG', + 'VTEND_DCONV','VTEND_SHCONV','VTEND_MACROP','VTEND_VDIFF','VTEND_RAYLEIGH', + 'VTEND_GWDTOT','VTEND_QBORLX','VTEND_LUNART','VTEND_IONDRG','VTEND_NDG', + 'KVH_CLUBB','TAUARDGBETAX','TAUARDGBETAY','TAU1RDGBETAX','TAU1RDGBETAY', + 'UBT1RDGBETA','TAU1RDGBETAM','RVMTEND_CLUBB' + + +gw_drag_file = '/glade/p/cesmdata/cseg/inputdata/atm/waccm/gw/newmfspectra40_dc25.nc' +use_gw_convect_dp = .true. +use_gw_convect_sh = .false. +use_gw_front = .false. +scm_use_ana_iop = .true. +cld_macmic_num_steps=3 +do_clubb_mf = .false. +do_clubb_mf_diag = .false. + +&nudging_nl +Nudge_Model = .true. +Nudge_Path = '/glade/p/cgd/amp/juliob/ERAI/f09_omega/L93/' +Nudge_File_Template = '%y/ERAI_fv09_L93.cam2.i.%y-%m-%d-%s.nc' +Nudge_Force_Opt = 0 +Nudge_TimeScale_Opt = 0 +Nudge_Times_Per_Day = 4 +Model_Times_Per_Day = 192 +Nudge_Uprof = 2 +Nudge_Ucoef = 1.0 +Nudge_Vprof = 2 +Nudge_Vcoef = 1.0 +Nudge_Tprof = 2 +Nudge_Tcoef = 1.0 +Nudge_Qprof = 2 +Nudge_Qcoef = 0.0 +Nudge_PSprof = 0 +Nudge_PScoef = 0 +Nudge_Beg_Year = 2009 +Nudge_Beg_Month = 1 +Nudge_Beg_Day = 1 +Nudge_End_Year = 2018 +Nudge_End_Month = 4 +Nudge_End_Day = 5 +Nudge_Hwin_lat0 = 0.0 +Nudge_Hwin_lon0 = 180. +Nudge_Hwin_latWidth = 9999.0 +Nudge_Hwin_lonWidth = 9999.0 +Nudge_Hwin_latDelta = 1.0 +Nudge_Hwin_lonDelta = 1.0 +Nudge_Hwin_Invert = .false. +Nudge_Vwin_Hindex = 0. +Nudge_Vwin_Lindex = 0. +Nudge_Vwin_Hdelta = 0.001 +Nudge_Vwin_Ldelta = 0.001 +Nudge_Vwin_Invert = .true. +/ diff --git a/myPythonTools/user_nl_cice b/myPythonTools/user_nl_cice new file mode 100644 index 0000000000..ce8b72f238 --- /dev/null +++ b/myPythonTools/user_nl_cice @@ -0,0 +1,8 @@ +!---------------------------------------------------------------------------------- +! Users should add all user specific namelist changes below in the form of +! namelist_var = new_namelist_value +! Note - that it does not matter what namelist group the namelist_var belongs to +!---------------------------------------------------------------------------------- + + dumpfreq_n = 0 + histfreq_n = 0, 0, 0, 0, 0 diff --git a/src/chemistry/mozart/chemistry.F90 b/src/chemistry/mozart/chemistry.F90 index 920d96a5e3..28127c5ce5 100644 --- a/src/chemistry/mozart/chemistry.F90 +++ b/src/chemistry/mozart/chemistry.F90 @@ -707,6 +707,7 @@ subroutine chem_init(phys_state, pbuf2d) use fire_emissions, only : fire_emissions_init use short_lived_species, only : short_lived_species_initic use ocean_emis, only : ocean_emis_init + use scamMod, only : single_column type(physics_buffer_desc), pointer :: pbuf2d(:,:) type(physics_state), intent(in):: phys_state(begchunk:endchunk) @@ -809,7 +810,11 @@ subroutine chem_init(phys_state, pbuf2d) if ( 1.e-2_r8 >= ptop_ref .and. ptop_ref > 1.e-5_r8 ) then ! around waccm top, below top of waccmx cnst_fixed_ubc(1) = .true. else if ( 1.e1_r8 > ptop_ref .and. ptop_ref > 1.e-2_r8 ) then ! well above top of cam and below top of waccm - call endrun('chem_init: do not know how to set water vapor upper boundary when model top is near mesopause') + if(.not.(single_column)) then + call endrun('chem_init: do not know how to set water vapor upper boundary when model top is near mesopause') + else + cnst_fixed_ubc(1) = .true. + endif endif if ( masterproc ) write(iulog,*) 'chem_init: addfld done' diff --git a/src/chemistry/mozart/upper_bc.F90 b/src/chemistry/mozart/upper_bc.F90 index 71a4a65b0c..8b076623e7 100644 --- a/src/chemistry/mozart/upper_bc.F90 +++ b/src/chemistry/mozart/upper_bc.F90 @@ -157,11 +157,16 @@ subroutine ubc_init() use mo_snoe, only: snoe_inti use mo_msis_ubc, only: msis_ubc_inti use constituents,only: cnst_get_ind + use scamMod,only: single_column !---------------------------Local workspace----------------------------- logical :: zonal_avg !----------------------------------------------------------------------- - apply_upper_bc = ptop_ref<1._r8 ! Pa + if (single_column) then + apply_upper_bc = .FALSE. + else + apply_upper_bc = ptop_ref<1._r8 ! Pa + endif if (.not.apply_upper_bc) return diff --git a/src/control/history_scam.F90 b/src/control/history_scam.F90 index 2c81ce1a78..3288bfc7ca 100644 --- a/src/control/history_scam.F90 +++ b/src/control/history_scam.F90 @@ -45,7 +45,10 @@ subroutine scm_intht() call addfld ('UDIFF', (/ 'lev' /), 'A', 'K','difference from observed u wind', gridname='gauss_grid') call addfld ('VDIFF', (/ 'lev' /), 'A', 'K','difference from observed v wind', gridname='gauss_grid') - call addfld ('TOBS', (/ 'lev' /), 'A', 'K','observed temp') + call addfld ('TOBS', (/ 'lev' /), 'A', 'K','observed temp', gridname='gauss_grid') + call addfld ('UOBS', (/ 'lev' /), 'A', 'm/s','observed zonal wind', gridname='gauss_grid') + call addfld ('VOBS', (/ 'lev' /), 'A', 'm/s','observed meridional wind', gridname='gauss_grid') + call addfld ('QDIFF', (/ 'lev' /), 'A', 'kg/kg','difference from observed water', gridname='gauss_grid') call addfld ('QOBS', (/ 'lev' /), 'A', 'kg/kg','observed water', gridname='physgrid') @@ -100,6 +103,59 @@ subroutine scm_intht() call addfld ('NLTEN_PHYS', (/ 'lev' /), 'I','#/kg/s', 'NL vertical advective forcing', gridname='gauss_grid' ) call addfld ('NITEN_PHYS', (/ 'lev' /), 'I','#/kg/s', 'NI vertical advective forcing', gridname='gauss_grid' ) +!++jtb + call addfld ('U_IOP', (/ 'lev' /), 'I', 'm/s', 'Zonal Wind from IOP ', gridname='gauss_grid' ) + call addfld ('V_IOP', (/ 'lev' /), 'I', 'm/s', 'Mer. Wind from IOP ', gridname='gauss_grid' ) + call addfld ('OMEGA_IOP', (/ 'lev' /), 'I', 'Pa/s', 'Vertical velocity (from IOP) ', gridname='gauss_grid' ) + call addfld ('OMEGA_ANA', (/ 'lev' /), 'I', 'Pa/s', 'Vertical velocity (analysis) ', gridname='gauss_grid' ) + call addfld ('ETAD_ANA', (/ 'lev' /), 'I', 'Pa/s', 'Eta_dot (analysis) ', gridname='gauss_grid' ) + call addfld ('ZETA_ANA', (/ 'lev' /), 'I', '1/s', 'Rel. Vorticity (analysis) ', gridname='gauss_grid' ) + call addfld ('T_ANA', (/ 'lev' /), 'I', 'K', 'Temperature (analysis) ', gridname='gauss_grid' ) + call addfld ('Q_ANA', (/ 'lev' /), 'I', 'g/g', 'Spec. humidity (analysis) ', gridname='gauss_grid' ) + call addfld ('U_ANA', (/ 'lev' /), 'I', 'm/s', 'Zonal wind (analysis) ', gridname='gauss_grid' ) + call addfld ('V_ANA', (/ 'lev' /), 'I', 'm/s', 'Mer. Wind (analysis) ', gridname='gauss_grid' ) + call addfld ('TV_ANA', (/ 'lev' /), 'I', 'K', 'Temperature (analysis) ', gridname='gauss_grid' ) + call addfld ('TTEN_TOTDYN_ANA', (/ 'lev' /), 'I', 'K/s', 'Temperature tendency (analysis)', gridname='gauss_grid' ) + call addfld ('UTEN_TOTDYN_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Zonal wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('VTEN_TOTDYN_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Meridional wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('QTEN_TOTDYN_ANA', (/ 'lev' /), 'I', 'kg/kg/s', 'tracer tendency (analysis)', gridname='gauss_grid' ) + + call addfld ('UTEN_TOTDYN_ANAR', (/ 'lev' /), 'I', 'm/s/s', 'Zonal wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('VTEN_TOTDYN_ANAR', (/ 'lev' /), 'I', 'm/s/s', 'Meridional wind tendency (analysis)', gridname='gauss_grid' ) + + call addfld ('UTEN_DYCORE_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Zonal wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('VTEN_DYCORE_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Meridional wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('TTEN_DYCORE_ANA', (/ 'lev' /), 'I', 'K/s', 'Temperature tendency (analysis)', gridname='gauss_grid' ) + call addfld ('OMEGA_DYCORE_ANA', (/ 'lev' /), 'I', 'Pa/s','Pressure tendency/velocity (analysis)', gridname='gauss_grid' ) + call addfld ('OMEGA_RECALC_ANA', (/ 'lev' /), 'I', 'Pa/s','Pressure tendency/velocity (analysis)', gridname='gauss_grid' ) + + call addfld ('UTEN_PRG_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Zonal wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('UTEN_PHIG_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Zonal wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('UTEN_KEG_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Zonal wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('UTEN_VORT_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Zonal wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('UTEN_PFRC_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Zonal wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('UTEN_VADV_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Zonal wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('UTEN_HADV_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Zonal wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('UTEN_CORIOL', (/ 'lev' /), 'I', 'm/s/s', 'Zonal wind tendency (analysis)', gridname='gauss_grid' ) + + + call addfld ('VTEN_VORT_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Meridional wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('VTEN_PFRC_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Meridional wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('VTEN_VADV_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Meridional wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('VTEN_HADV_ANA', (/ 'lev' /), 'I', 'm/s/s', 'Meridional wind tendency (analysis)', gridname='gauss_grid' ) + call addfld ('VTEN_CORIOL', (/ 'lev' /), 'I', 'm/s/s', 'Meridional wind tendency (analysis)', gridname='gauss_grid' ) + + call addfld ('TTEN_VADV_ANA', (/ 'lev' /), 'I', 'K/s', 'Temperature tendency (analysis)', gridname='gauss_grid' ) + call addfld ('TTEN_HADV_ANA', (/ 'lev' /), 'I', 'K/s', 'Temperature tendency (analysis)', gridname='gauss_grid' ) + call addfld ('TTEN_COMP_ANA', (/ 'lev' /), 'I', 'K/s', 'Temperature tendency (analysis)', gridname='gauss_grid' ) + call addfld ('TTEN_COMP_IOP', (/ 'lev' /), 'I', 'K/s', 'Temperature tendency (analysis)', gridname='gauss_grid' ) + + call addfld ('QTEN_VADV_ANA', (/ 'lev' /), 'I', '1/s', 'Temperature tendency (analysis)', gridname='gauss_grid' ) + call addfld ('QTEN_HADV_ANA', (/ 'lev' /), 'I', '1/s', 'Temperature tendency (analysis)', gridname='gauss_grid' ) + +!--jtb + + end subroutine scm_intht !####################################################################### diff --git a/src/control/scamMod.F90 b/src/control/scamMod.F90 index b18169b340..b5506184cb 100644 --- a/src/control/scamMod.F90 +++ b/src/control/scamMod.F90 @@ -76,6 +76,24 @@ module scamMod character*(max_path_len), public :: lsmsurffile character*(max_path_len), public :: lsminifile +!++jtb +logical, public :: use_scm_ana_frc = .false. +character*(max_path_len), public :: scm_ana_frc_file_template +character*(max_path_len), public :: scm_ana_frc_path + +logical, public :: scm_ana_x_plevels = .true. +logical, public :: scm_ana_direct_omega = .false. +logical, public :: scm_ana_direct_ttend = .false. +logical, public :: scm_ana_t_react = .false. +logical, public :: scm_ana_q_react = .false. +logical, public :: scm_ana_u_react = .false. +logical, public :: scm_ana_v_react = .false. +logical, public :: scm_ana_upwind = .false. +!+++ARH +logical, public :: scm_use_ana_iop = .false. +!---ARH +!--jtb + ! note that scm_zadv_q is set to slt to be consistent with CAM BFB testing @@ -250,7 +268,13 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) scm_cambfb_mode,scm_crm_mode,scm_zadv_uv,scm_zadv_T,scm_zadv_q,& scm_use_obs_T, scm_use_obs_uv, scm_use_obs_qv, & scm_relax_linear, scm_relax_tau_top_sec, & - scm_relax_tau_bot_sec, scm_force_latlon, scm_relax_fincl, scm_backfill_iop_w_init + scm_relax_tau_bot_sec, scm_force_latlon, scm_relax_fincl, scm_backfill_iop_w_init, & +!+jtb + use_scm_ana_frc, scm_ana_frc_path, scm_ana_frc_file_template, & + scm_ana_x_plevels, scm_ana_direct_omega, & + scm_ana_t_react, scm_ana_q_react, scm_ana_u_react, scm_ana_v_react, & + scm_ana_upwind, scm_ana_direct_ttend, scm_use_ana_iop +!--jtb single_column=single_column_in @@ -306,6 +330,9 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) use_camiop = .false. endif +write(*,*) "!!!!!!!!!! ScamMod !!!!!!!! " +write(*,*) scm_force_latlon , scmlon, scmlat + ! If we are not forcing the lat and lon from the namelist use the closest lat and lon that is found in the IOP file. if (.not.scm_force_latlon) then call shr_scam_GetCloseLatLon( ncid, scmlat, scmlon, ioplat, ioplon, latidx, lonidx ) @@ -316,7 +343,9 @@ subroutine scam_readnl(nlfile,single_column_in,scmlat_in,scmlon_in) scmlat = ioplat scmlon = ioplon end if - +write(*,*) " after " , scmlon, scmlat + + if (masterproc) then write (iulog,*) 'Single Column Model Options: ' write (iulog,*) '=============================' diff --git a/src/dynamics/eul/dyn_comp.F90 b/src/dynamics/eul/dyn_comp.F90 index 442c9f3228..0ba8285207 100644 --- a/src/dynamics/eul/dyn_comp.F90 +++ b/src/dynamics/eul/dyn_comp.F90 @@ -842,8 +842,10 @@ subroutine process_inidat(fieldname, m_cnst, fh) ret = pio_inq_varid(fh, cnst_name(m_cnst), varid) ret = pio_get_att(fh, varid, 'units', trunits) if (trunits(1:5) .ne. 'KG/KG' .and. trunits(1:5) .ne. 'kg/kg') then - call endrun(sub//': ERROR: Units for tracer ' & - //trim(cnst_name(m_cnst))//' must be in KG/KG') +!+++ARH +! call endrun(sub//': ERROR: Units for tracer ' & +! //trim(cnst_name(m_cnst))//' must be in KG/KG') +!---ARH end if else if (.not. analytic_ic_active()) then diff --git a/src/dynamics/eul/get_ana_dynfrc_4scam.F90 b/src/dynamics/eul/get_ana_dynfrc_4scam.F90 new file mode 100644 index 0000000000..1fdd1c58e0 --- /dev/null +++ b/src/dynamics/eul/get_ana_dynfrc_4scam.F90 @@ -0,0 +1,1650 @@ +module get_ana_dynfrc_4scam + + use spmd_utils, only: masterproc + use cam_logfile, only: iulog + use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8, & + cs=>SHR_KIND_CS,cl=>SHR_KIND_CL + use shr_const_mod, only: rearth => shr_const_rearth , & ! =6.37122e6_R8 meters + pi => shr_const_pi , & + OOmega => shr_const_omega , & + rdair => shr_const_rdair , & + cpair => shr_const_cpdair + + use scamMod, only: use_scm_ana_frc, & + scm_ana_frc_path, & + scm_ana_frc_file_template, & + scm_ana_x_plevels, & + scm_ana_direct_omega, & + scm_ana_t_react, & + scm_ana_q_react, & + scm_ana_u_react, & + scm_ana_v_react, & + scm_ana_upwind, & + scm_ana_direct_ttend + + + + ! shr_const_mod is in ${CESMROOT}/cime/src/share/util/ + + implicit none + private + save + + public get_ana_dynfrc_fv +! +! Private module data +! + + real(r8) , save , allocatable :: T_1(:,:,:) , U_1(:,:,:), V_1(:,:,:), Q_1(:,:,:),PS_1(:,:),PHIS_1(:,:) + real(r8) , save , allocatable :: T_2(:,:,:) , U_2(:,:,:), V_2(:,:,:), Q_2(:,:,:),PS_2(:,:),PHIS_2(:,:) + real(r8) , save , allocatable :: UTCORE_1(:,:,:) , UTCORE_2(:,:,:) + real(r8) , save , allocatable :: VTCORE_1(:,:,:) , VTCORE_2(:,:,:) + real(r8) , save , allocatable :: TTCORE_1(:,:,:) , TTCORE_2(:,:,:) + real(r8) , save , allocatable :: OGCORE_1(:,:,:) , OGCORE_2(:,:,:) + real(r8) , save , allocatable :: lat_ana(:),lon_ana(:),lev_ana(:) + integer , save :: nlev_ana, nlon_ana, nlat_ana + + real(r8) , save , allocatable :: To_1(:,:,:) , Uo_1(:,:,:), Vo_1(:,:,:), Qo_1(:,:,:),PSo_1(:,:),PHISo_1(:,:) + real(r8) , save , allocatable :: To_2(:,:,:) , Uo_2(:,:,:), Vo_2(:,:,:), Qo_2(:,:,:),PSo_2(:,:),PHISo_2(:,:) + real(r8) , save , allocatable :: UTCOREo_1(:,:,:) , UTCOREo_2(:,:,:), UTCOREo_X(:,:,:) + real(r8) , save , allocatable :: VTCOREo_1(:,:,:) , VTCOREo_2(:,:,:), VTCOREo_X(:,:,:) + real(r8) , save , allocatable :: TTCOREo_1(:,:,:) , TTCOREo_2(:,:,:), TTCOREo_X(:,:,:) + real(r8) , save , allocatable :: OGCOREo_1(:,:,:) , OGCOREo_2(:,:,:), OGCOREo_X(:,:,:) + + + + real(r8) , save , allocatable :: ETAD_X(:,:,:) , OMG_X(:,:,:) + real(r8) , save , allocatable :: ZETA_X(:) + real(r8) , save , allocatable :: KEh_X(:,:,:) + real(r8) , save , allocatable :: Tv_X(:,:,:) + + real(r8) , save , allocatable :: pke_X(:,:,:),pko_X(:,:,:),phik_X(:,:,:),Thv_X(:,:,:) + real(r8) , save , allocatable :: ple_X(:,:,:) , plo_X(:,:,:), phi_X(:,:,:) + + real(r8) , save , allocatable :: To_X(:,:,:) , Uo_X(:,:,:), Vo_X(:,:,:), Qo_X(:,:,:),PSo_X(:,:),PHISo_X(:,:) + + +!======================================================================= +contains +!======================================================================= + +subroutine get_ana_dynfrc_fv ( scmlon, scmlat , & + omega_ana, etad_ana, zeta_ana, & + t_ana , tv_ana , & + q_ana , & + u_ana , & + v_ana , & + ps_ana , & + uten_hadv_ana , & + vten_hadv_ana , & + uten_pfrc_ana , & + vten_pfrc_ana , & + uten_vort_ana , & + vten_vort_ana , & + qten_hadv_ana , & + tten_hadv_ana , & + uten_vadv_ana , & + vten_vadv_ana , & + tten_vadv_ana , & + qten_vadv_ana , & + tten_comp_ana , & + uten_keg_ana , & + uten_phig_ana , & + uten_prg_ana , & + uten_dycore_ana , & + vten_dycore_ana , & + tten_dycore_ana , & + omega_dycore_ana , & + omega_recalc_ana , & + u_scm, v_scm, t_scm, q_scm, & + u_ana_diag, v_ana_diag, t_ana_diag, q_ana_diag ) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! US and VS are input (D-grid velocities) +!-------------------------------------------- +! ub(i,j,L)= 0.5*(us(i-1,j,L) + us(i,j,L)) +! vb(i,j,L)= 0.5*(vs(i,j,L) + vs(i,j+1,L)) +! +! uc(i,j,L)= 0.5*(ub(i,j,L) + ub(i,j-1,L)) +! vc(i,j,L)= 0.5*(vb(i,j-1,L) + vb(i+1,j-1,L)) +!--------------------------------------------- +! Grid arrangement in FV latlon h,i-files +!--------------------------------------------- +! J=NY +! ... +! +! ub,vb(I,J) us(I,J),vc(I,J+1) +! +! +! vs(I,J),uc(I,J) ua,va,T,p(I,J) vs(I+1,J),uc(I+1,J) +! +! +! vc(I,J) +! +! +! ua,va,T,p(I,J-1) +! +! ... +! J=1 ... +!---------------------------------------------- + + use pmgrid, only : plev, plat, plevp, plon + use hycoef, only: hyai, hybi, ps0, hyam, hybm + use filenames, only: interpret_filename_spec + use time_manager, only: timemgr_time_ge,timemgr_time_inc,get_curr_date,get_step_size,is_first_step + use netcdf + use cam_abortutils, only: endrun + use ref_pres, only: pref_mid ! In Pascal + + real(r8), intent(in) :: scmlon, scmlat + real(r8), intent(out) :: omega_ana( plev ) + real(r8), intent(out) :: etad_ana(plev) + real(r8), intent(out) :: t_ana(plev) , tv_ana(plev) + real(r8), intent(out) :: zeta_ana(plev) + real(r8), intent(out) :: u_ana(plev) + real(r8), intent(out) :: v_ana(plev) + real(r8), intent(out) :: q_ana(plev) + real(r8), intent(out) :: ps_ana + real(r8), intent(out) :: uten_hadv_ana( plev ) + real(r8), intent(out) :: vten_hadv_ana( plev ) + real(r8), intent(out) :: uten_pfrc_ana( plev ) + real(r8), intent(out) :: vten_pfrc_ana( plev ) + real(r8), intent(out) :: qten_hadv_ana( plev ) + real(r8), intent(out) :: tten_hadv_ana( plev ) + real(r8), intent(out) :: qten_vadv_ana( plev ) + real(r8), intent(out) :: tten_vadv_ana( plev ) + real(r8), intent(out) :: uten_vadv_ana( plev ) + real(r8), intent(out) :: vten_vadv_ana( plev ) + + real(r8), intent(out) :: tten_comp_ana( plev ) + + real(r8), intent(out) :: uten_keg_ana( plev ) + real(r8), intent(out) :: uten_prg_ana( plev ) + real(r8), intent(out) :: uten_phig_ana( plev ) + real(r8), intent(out) :: uten_vort_ana( plev ) + real(r8), intent(out) :: vten_vort_ana( plev ) + real(r8), intent(out) :: uten_dycore_ana( plev ) + real(r8), intent(out) :: vten_dycore_ana( plev ) + real(r8), intent(out) :: tten_dycore_ana( plev ) + real(r8), intent(out) :: omega_recalc_ana( plev ) + real(r8), intent(out) :: omega_dycore_ana( plev ) + + real(r8), intent(in) :: u_scm(plev) + real(r8), intent(in) :: v_scm(plev) + real(r8), intent(in) :: t_scm(plev) + real(r8), intent(in) :: q_scm(plev) + + real(r8), intent(out) :: u_ana_diag(plev) + real(r8), intent(out) :: v_ana_diag(plev) + real(r8), intent(out) :: t_ana_diag(plev) + real(r8), intent(out) :: q_ana_diag(plev) + + integer, save :: iax, jax + integer, save :: Read_year2, Read_month2, Read_day2, Read_sec2, Read_YMD2 + integer, save :: nlev_alc, nlon_alc, nlat_alc + + !!logical , parameter :: l_vectinv = .FALSE. + !!real(r8) :: tv_ana(plev) + real(r8) :: rho_ana( plev ), plo_ana(plev) + + + + real(r8) :: scmlonx + + real(r8) :: ana_wgt1 , ana_wgt2 , dx0, dy, darea + + integer :: nx, ny,i,j,k,L,LM, iav(1),jav(1),iac,jac + + real(r8) , allocatable :: rlats(:),rlons(:) + real(r8) :: zeta(plev),absvo(plev) + ! Horz. gradient profiles (1=X, 2=Y) + real(r8) :: kehg_ana(plev,2),kehg_X(plev,2) + real(r8) :: phig_ana(plev,2),phig_X(plev,2) + real(r8) :: plog_ana(plev,2),plog_X(plev,2) + real(r8) :: teg_ana(plev,2), teg_X(plev,2) + real(r8) :: qg_ana(plev,2), qg_X(plev,2) + real(r8) :: ug_ana(plev,2), ug_X(plev,2) + real(r8) :: vg_ana(plev,2), vg_X(plev,2) + real(r8) :: lin_pfc_ana(plev,2) , lin_pfc_X(plev,2) + + real(r8) :: omega_ana_x(plev) + real(r8) :: alpha_react(plev) + + real(r8) :: lat_alc(3) , lon_alc(3) + real(r8) :: aalc(3,3,plev) + + + character(len=CL):: Ana_File_Template,Ana_file1,Ana_file2,Ana_Path + + + integer :: dyn_year,dyn_month,dyn_day,dyn_sec,year,month,day,sec + integer :: dyn_step,ymd1,ymd2,curr_sec,next_sec,curr_year,curr_month,curr_day,curr_ymd + + integer :: analysis_step + integer :: ana_year1, ana_month1, ana_day1, ana_sec1 + integer :: ana_year2, ana_month2, ana_day2, ana_sec2 + + logical :: l_Read_next_Ana, Alarm_Read_ana, Alarm_Bump_ana, initialize + + write(iulog,*) " version 07 of get_ana_dynfrc_4scam ... " + + + Alarm_Read_Ana = .FALSE. + Alarm_Bump_Ana = .FALSE. + + if ( scmlon < 0 ) then + scmlonx = scmlon + 360._r8 + else + scmlonx = scmlon + end if + + ! Default to 6 hour steps between ana + analysis_step = 6 * 3600 + + + Ana_path = trim(scm_ana_frc_path) + Ana_File_Template = trim(Ana_path)//trim(scm_ana_frc_file_template) + + + call get_curr_date(Year,Month,Day,Sec) + + curr_ymd = (Year*10000) + (Month*100) + Day + curr_sec = Sec + + ana_sec1 = ( Sec / analysis_step ) * analysis_step + ana_day1 = Day + ana_month1 = Month + ana_year1 = Year + + YMD1=(Ana_Year1*10000) + (Ana_Month1*100) + Ana_Day1 + + + call timemgr_time_inc(YMD1,Ana_Sec1, & + YMD2,Ana_Sec2,Analysis_Step,0,0) + + Ana_Year2 = YMD2 / 10000 + Ana_Month2 = (YMD2 - Ana_Year2*10000)/100 + Ana_Day2 = YMD2 - Ana_Year2*10000 - Ana_Month2*100 + + Ana_File1 = interpret_filename_spec(Ana_File_Template , & + yr_spec=Ana_Year1 , & + mon_spec=Ana_Month1, & + day_spec=Ana_Day1 , & + sec_spec=Ana_Sec1 ) + + Ana_File2 = interpret_filename_spec(Ana_File_Template , & + yr_spec=Ana_Year2 , & + mon_spec=Ana_Month2, & + day_spec=Ana_Day2 , & + sec_spec=Ana_Sec2 ) + + + l_Read_next_Ana = .FALSE. + ! On first time step, read in 2 analysis files + if (is_first_step().and.masterproc) then + write(iulog,*) " It's now (First time step):" , curr_YMD, curr_sec + write(iulog,*) "Read Initial ana files " + write(iulog,*) Ana_file1 + write(iulog,*) Ana_file2 + Alarm_Read_Ana = .TRUE. + Alarm_Bump_Ana = .FALSE. + else + ! On subsequent steps test to see if "Curr" date is later or same as "Read". + ! If it is, then l_read_next_ana=.TRUE. + call timemgr_time_ge(Read_ymd2, Read_Sec2, curr_YMD, curr_Sec, l_Read_next_ana ) + endif + + if (l_Read_next_Ana) then + Alarm_Read_Ana = .TRUE. + Alarm_Bump_Ana = .TRUE. + endif + + ! Aloocate space for analysis fields. + ! Read in both Initial Analysis files. Nothing to bump yet + if ( (Alarm_Read_Ana ) .AND. .NOT.(Alarm_Bump_Ana) ) then + initialize=.TRUE. + call read_netcdf_ana_fv_ini ( Ana_File1, nlon_ana, nlat_ana, nlev_ana ,iax, jax ) + + if ( plev /= nlev_ana) then + call endrun ("SCAM plev NE nlev_ana") + end if + + ! Full global fields + allocate( lat_ana(nlat_ana) , lon_ana(nlon_ana), lev_ana(nlev_ana) ) + allocate( U_1(nlon_ana, nlat_ana, nlev_ana), V_1(nlon_ana, nlat_ana, nlev_ana), T_1(nlon_ana, nlat_ana, nlev_ana), & + Q_1(nlon_ana, nlat_ana, nlev_ana), PS_1 (nlon_ana, nlat_ana ), PHIS_1 (nlon_ana, nlat_ana ) ) + allocate( U_2(nlon_ana, nlat_ana, nlev_ana), V_2(nlon_ana, nlat_ana, nlev_ana), T_2(nlon_ana, nlat_ana, nlev_ana), & + Q_2(nlon_ana, nlat_ana, nlev_ana), PS_2 (nlon_ana, nlat_ana ), PHIS_2 (nlon_ana, nlat_ana ) ) + + allocate( UTCORE_1(nlon_ana, nlat_ana, nlev_ana), UTCORE_2(nlon_ana, nlat_ana, nlev_ana) ) + allocate( VTCORE_1(nlon_ana, nlat_ana, nlev_ana), VTCORE_2(nlon_ana, nlat_ana, nlev_ana) ) + allocate( TTCORE_1(nlon_ana, nlat_ana, nlev_ana), TTCORE_2(nlon_ana, nlat_ana, nlev_ana) ) + allocate( OGCORE_1(nlon_ana, nlat_ana, nlev_ana), OGCORE_2(nlon_ana, nlat_ana, nlev_ana) ) + + ! SCM "patches" + nlon_alc=3 + nlat_alc=3 + nlev_alc=nlev_ana + + + + ! Patches of full global fields + allocate( Uo_1(nlon_alc, nlat_alc, nlev_alc), Vo_1(nlon_alc, nlat_alc, nlev_alc), To_1(nlon_alc, nlat_alc, nlev_alc), & + Qo_1(nlon_alc, nlat_alc, nlev_alc), PSo_1 (nlon_alc, nlat_alc ), PHISo_1 (nlon_alc, nlat_alc ) ) + allocate( Uo_2(nlon_alc, nlat_alc, nlev_alc), Vo_2(nlon_alc, nlat_alc, nlev_alc), To_2(nlon_alc, nlat_alc, nlev_alc), & + Qo_2(nlon_alc, nlat_alc, nlev_alc), PSo_2 (nlon_alc, nlat_alc ), PHISo_2 (nlon_alc, nlat_alc ) ) + + allocate( UTCOREo_1(nlon_alc, nlat_alc, nlev_alc), UTCOREo_2(nlon_alc, nlat_alc, nlev_alc), UTCOREo_X(nlon_alc, nlat_alc, nlev_alc) ) + allocate( VTCOREo_1(nlon_alc, nlat_alc, nlev_alc), VTCOREo_2(nlon_alc, nlat_alc, nlev_alc), VTCOREo_X(nlon_alc, nlat_alc, nlev_alc) ) + allocate( TTCOREo_1(nlon_alc, nlat_alc, nlev_alc), TTCOREo_2(nlon_alc, nlat_alc, nlev_alc), TTCOREo_X(nlon_alc, nlat_alc, nlev_alc) ) + allocate( OGCOREo_1(nlon_alc, nlat_alc, nlev_alc), OGCOREo_2(nlon_alc, nlat_alc, nlev_alc), OGCOREo_X(nlon_alc, nlat_alc, nlev_alc) ) + + allocate( Uo_X(nlon_alc, nlat_alc, nlev_alc), Vo_X(nlon_alc, nlat_alc, nlev_alc), To_X(nlon_alc, nlat_alc, nlev_alc), & + Qo_X(nlon_alc, nlat_alc, nlev_alc), PSo_X (nlon_alc, nlat_alc ), PHISo_X (nlon_alc, nlat_alc ) ) + allocate( ETAD_X(nlon_alc,nlat_alc,nlev_alc) ) + allocate( OMG_X(nlon_alc,nlat_alc,nlev_alc) ) + allocate( ple_X(nlon_alc, nlat_alc, nlev_alc+1), plo_X(nlon_alc, nlat_alc, nlev_alc), phi_X(nlon_alc, nlat_alc, nlev_alc+1) ) + allocate( pke_X(nlon_alc, nlat_alc, nlev_alc+1), pko_X(nlon_alc, nlat_alc, nlev_alc), phik_X(nlon_alc, nlat_alc, nlev_alc+1) ) + allocate( THv_X(nlon_alc, nlat_alc, nlev_alc ) ) + allocate( zeta_X(nlev_alc) ) + allocate( KEh_X(nlon_alc, nlat_alc, nlev_alc ) ) + allocate( Tv_X(nlon_alc, nlat_alc, nlev_alc ) ) + + call read_netcdf_ana_fv ( Ana_File1, nlon_ana, nlat_ana, nlev_ana, & + U_1, V_1, & + T_1, Q_1, PS_1, PHIS_1, & + lon_ana, lat_ana, lev_ana & + , utcore_1, vtcore_1, ttcore_1, ogcore_1 & + ) + write(*,*) " checks ... " + write(*,*) iax, jax + + call read_netcdf_ana_fv ( Ana_File2, nlon_ana, nlat_ana, nlev_ana, & + U_2, V_2, & + T_2, Q_2, PS_2, PHIS_2, & + lon_ana, lat_ana, lev_ana & + , utcore_2, vtcore_2, ttcore_2, ogcore_2 & + ) + + ! Make patches + Uo_1 = U_1(iax-1:iax+1,jax-1:jax+1,:) + Vo_1 = V_1(iax-1:iax+1,jax-1:jax+1,:) + To_1 = T_1(iax-1:iax+1,jax-1:jax+1,:) + Qo_1 = Q_1(iax-1:iax+1,jax-1:jax+1,:) + PSo_1 = PS_1(iax-1:iax+1,jax-1:jax+1 ) + PHISo_1 = PHIS_1(iax-1:iax+1,jax-1:jax+1 ) + UTCOREo_1 = UTCORE_1(iax-1:iax+1,jax-1:jax+1,:) + VTCOREo_1 = VTCORE_1(iax-1:iax+1,jax-1:jax+1,:) + TTCOREo_1 = TTCORE_1(iax-1:iax+1,jax-1:jax+1,:) + OGCOREo_1 = OGCORE_1(iax-1:iax+1,jax-1:jax+1,:) + + Uo_2 = U_2(iax-1:iax+1,jax-1:jax+1,:) + Vo_2 = V_2(iax-1:iax+1,jax-1:jax+1,:) + To_2 = T_2(iax-1:iax+1,jax-1:jax+1,:) + Qo_2 = Q_2(iax-1:iax+1,jax-1:jax+1,:) + PSo_2 = PS_2(iax-1:iax+1,jax-1:jax+1 ) + PHISo_2 = PHIS_2(iax-1:iax+1,jax-1:jax+1 ) + UTCOREo_2 = UTCORE_2(iax-1:iax+1,jax-1:jax+1,:) + VTCOREo_2 = VTCORE_2(iax-1:iax+1,jax-1:jax+1,:) + TTCOREo_2 = TTCORE_2(iax-1:iax+1,jax-1:jax+1,:) + OGCOREo_2 = OGCORE_2(iax-1:iax+1,jax-1:jax+1,:) + + + ! Mark Ana date as read + Read_year2 = Ana_year2 + Read_month2 = Ana_month2 + Read_day2 = Ana_day2 + Read_sec2 = Ana_sec2 + Read_YMD2 =(Ana_Year2*10000) + (Ana_Month2*100) + Ana_Day2 + + end if + + ! Bump second analysis to first postion, and read in next analysis + if ( (Alarm_Read_Ana ) .AND. (Alarm_Bump_Ana) ) then + + Uo_1 = Uo_2 + Vo_1 = Vo_2 + To_1 = To_2 + Qo_1 = Qo_2 + PSo_1 = PSo_2 + PHISo_1 = PHISo_2 + UTCOREo_1 = UTCOREo_2 + VTCOREo_1 = VTCOREo_2 + TTCOREo_1 = TTCOREo_2 + + call read_netcdf_ana_fv ( Ana_File2, nlon_ana, nlat_ana, nlev_ana, & + U_2, V_2, & + T_2, Q_2, PS_2, PHIS_2, & + lon_ana, lat_ana, lev_ana & + , utcore_2, vtcore_2, ttcore_2, ogcore_2 & + ) + + + ! Make patches + Uo_2 = U_2(iax-1:iax+1,jax-1:jax+1,:) + Vo_2 = V_2(iax-1:iax+1,jax-1:jax+1,:) + To_2 = T_2(iax-1:iax+1,jax-1:jax+1,:) + Qo_2 = Q_2(iax-1:iax+1,jax-1:jax+1,:) + PSo_2 = PS_2(iax-1:iax+1,jax-1:jax+1 ) + PHISo_2 = PHIS_2(iax-1:iax+1,jax-1:jax+1 ) + UTCOREo_2 = UTCORE_2(iax-1:iax+1,jax-1:jax+1,:) + VTCOREo_2 = VTCORE_2(iax-1:iax+1,jax-1:jax+1,:) + TTCOREo_2 = TTCORE_2(iax-1:iax+1,jax-1:jax+1,:) + OGCOREo_2 = OGCORE_2(iax-1:iax+1,jax-1:jax+1,:) + + + ! Mark Ana date as read + Read_year2 = Ana_year2 + Read_month2 = Ana_month2 + Read_day2 = Ana_day2 + Read_sec2 = Ana_sec2 + Read_YMD2=(Ana_Year2*10000) + (Ana_Month2*100) + Ana_Day2 + end if + + Alarm_Read_Ana = .FALSE. + Alarm_Bump_Ana = .FALSE. + + + + +#if 0 + call dynfrc_timewgts( & + (/ Ana_Year1, Ana_Month1, Ana_day1, Ana_sec1 /) , & + (/ Ana_Year2, Ana_Month2, Ana_day2, Ana_sec2 /) , & + ana_wgt1 , ana_wgt2 ) +#else + ana_wgt1 = 0._r8 ! 0=all weight on t+1 + ana_wgt2 = 1._r8 - ana_wgt1 +#endif + if (masterproc) write(iulog,*) " Ana forcing time wgts ",ana_wgt1,ana_wgt2 + + iac=2 + jac=2 + + + + Uo_X = ana_wgt1 * Uo_1 + ana_wgt2 * Uo_2 + Vo_X = ana_wgt1 * Vo_1 + ana_wgt2 * Vo_2 + To_X = ana_wgt1 * To_1 + ana_wgt2 * To_2 + Qo_X = ana_wgt1 * Qo_1 + ana_wgt2 * Qo_2 + PSo_X = ana_wgt1 * PSo_1 + ana_wgt2 * PSo_2 + PHISo_X = ana_wgt1 * PHISo_1 + ana_wgt2 * PHISo_2 + + UTCOREo_X = ana_wgt1 * UTCOREo_1 + ana_wgt2 * UTCOREo_2 + VTCOREo_X = ana_wgt1 * VTCOREo_1 + ana_wgt2 * VTCOREo_2 + TTCOREo_X = ana_wgt1 * TTCOREo_1 + ana_wgt2 * TTCOREo_2 + OGCOREo_X = ana_wgt1 * OGCOREo_1 + ana_wgt2 * OGCOREo_2 + + lon_alc = lon_ana(iax-1:iax+1) + lat_alc = lat_ana(jax-1:jax+1) + + if(masterproc) write(iulog,*) " SCM lon lat: ",scmlonx,scmlat + if(masterproc) write(iulog,*) " Closest Ana lon lat: ",lon_ana( iax ) , lat_ana( jax ) + + + ! Save off analysis fields for diagnostics and + ! other purposes + T_ana_diag(:) = To_X( iac, jac, :) + Q_ana_diag(:) = Qo_X( iac, jac, :) + U_ana_diag(:) = Uo_X( iac, jac, :) + V_ana_diag(:) = Vo_X( iac, jac, :) + + !================================================ + ! Patch in SCM profiles here if wanted. + ! This acts as "dynamical nudging", since + ! horizontal advective tendencies will become + ! stronger if SCM state drifts away from re-ana. + ! Note, this will only be effective w/ upwind + ! scheme, since 2nd order cntrd skips over central + ! point in stencil. + !---- + ! For stability it turns out may be good to scale + ! with pressure so that high-velocity strato winds + ! don't lead to CFL violations. So, as a bad, dirty, + ! dirty short term solution, weight "reaction" by + ! pref_mid. Clearly, better soln would be to + ! sub-step this part of the dynamics as is done + ! for the other "dycores". + !================================================= + ! Calculate "reaction coefficient" + !--------------------------------- + alpha_react(:)=1.0_r8 !1._r8 + + ! Adjust central profiles in stencils + !------------------------------------ + if (scm_ana_t_react) then + To_X( iac, jac, :) = alpha_react(:) * T_scm(:) & + + ( 1._r8-alpha_react(:) ) * To_X( iac, jac, :) + if(masterproc) write(iulog,*) " REACTING to SCM T-state ..... " + else + if(masterproc) write(iulog,*) " No reaction to SCM T-state ..... " + endif + if (scm_ana_q_react) then + Qo_X( iac, jac, :) = alpha_react(:) * Q_scm(:) & + + ( 1._r8-alpha_react(:) ) * Qo_X( iac, jac, :) + if(masterproc) write(iulog,*) " REACTING to SCM Q-state ..... " + else + if(masterproc) write(iulog,*) " No reaction to SCM Q-state ..... " + endif + if (scm_ana_u_react) then + Uo_X( iac, jac, :) = alpha_react(:) * U_scm(:) & + + ( 1._r8-alpha_react(:) ) * Uo_X( iac, jac, :) + if(masterproc) write(iulog,*) " REACTING to SCM U-state ..... " + else + if(masterproc) write(iulog,*) " No reaction to SCM U-state ..... " + endif + if (scm_ana_v_react) then + Vo_X( iac, jac, :) = alpha_react(:) * V_scm(:) & + + ( 1._r8-alpha_react(:) ) * Vo_X( iac, jac, :) + if(masterproc) write(iulog,*) " REACTING to SCM V-state ..... " + else + if(masterproc) write(iulog,*) " No reaction to SCM V-state ..... " + endif + + + + !========================================= + + call virtual_t( nlon_alc,nlat_alc,nlev_alc, & + To_X , Qo_X , Tv_X ) + + call makepr_fv( nlon_alc,nlat_alc,nlev_alc, & + tv_X , pso_X , phiso_X , & + plo_X, ple_X, phi_X ) + call etadot_fv ( nlon_alc , nlat_alc , nlev_alc , lon_alc , lat_alc , & + uo_X , & + vo_X , & + plo_X, ple_X , etad_X , omg_X ) + call zeta_fv( nlon_alc,nlat_alc,nlev_alc, & + lon_alc ,lat_alc , & + uo_X , vo_X , zeta_X ) + + call makepk_fv( nlon_alc,nlat_alc,nlev_alc, & + To_X , Qo_X , & + pso_X , phiso_X , & + pko_X, pke_X, phik_X, thv_X ) + + KEh_X = 0.5 * ( Uo_X**2 + Vo_X**2 ) + + + if (scm_ana_x_plevels) then + call patch_eta_x_plv ( nlon_alc , nlat_alc , nlev_alc, & + iac, jac, uo_X , plo_X ) + call patch_eta_x_plv ( nlon_alc , nlat_alc , nlev_alc, & + iac, jac, vo_X , plo_X ) + call patch_eta_x_plv ( nlon_alc , nlat_alc , nlev_alc, & + iac, jac, to_X , plo_X ) + call patch_eta_x_plv ( nlon_alc , nlat_alc , nlev_alc, & + iac, jac, qo_X , plo_X ) + call patch_eta_x_plv ( nlon_alc , nlat_alc , nlev_alc, & + iac, jac, tv_X , plo_X ) + !Retain p-frc calculation on eta??? + !call patch_eta_x_plv ( nlon_alc , nlat_alc , nlev_alc+1, & + ! iac, jac, phi_X , ple_X ) + if(masterproc) write(iulog,*) " calcs on PRESSURE levels " + else + if(masterproc) write(iulog,*) " calcs on ETA levels " + end if + + + zeta_ana = zeta_X + omega_recalc_ana = omg_X( iac,jac,:) + etad_ana = etad_X( iac,jac,:) + plo_ana = plo_X( iac,jac,:) + t_ana = To_X( iac,jac,:) + tv_ana = Tv_X( iac,jac,:) + q_ana = Qo_X( iac,jac,:) + ps_ana = PSo_X( iac,jac ) + + u_ana = Uo_X( iac,jac,:) + v_ana = Vo_X( iac,jac,:) + + rho_ana = plo_ana / ( Rdair * tv_ana ) + + uten_dycore_ana = UTCOREo_X( iac,jac,:) + vten_dycore_ana = VTCOREo_X( iac,jac,:) + tten_dycore_ana = TTCOREo_X( iac,jac,:) + omega_dycore_ana = OGCOREo_X( iac,jac,:) + + + ! Horz. gradient calcs + + kehg_X = grad_fv( nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, KEh_X ) + + ! T_x, T_y should be straight T (not virtual) + !!teg_X = grad_fv( nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, To_X ) + teg_X = grad_fv( nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, Tv_X ) !test 05-31-21 + + qg_X = grad_fv( nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, Qo_X ) + + ug_X = grad_fv( nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, Uo_X ) + + vg_X = grad_fv( nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, Vo_X ) + + aalc = 0.5*( PHI_X( :, :, 2:nlev_alc+1) + PHI_X(: , : ,1:nlev_alc) ) + !!aalc = PHI_X( :, :, 2:nlev_alc+1) + !!aalc = PHI_X(: , : ,1:nlev_alc) + phig_X = grad_fv( nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, aalc ) + + !Retain p-frc calculation on eta??? + !if (scm_ana_x_plevels) then ! No horz. p-gradient in p-coords + ! plog_X(:,1:2) = 0._r8 + !else + plog_X = grad_fv( nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, plo_X(:,:,1:nlev_alc) ) + !plog_X = grad_fv( nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, ple_X(:,:,1:nlev_alc) ) + !end if + + + +#if 1 + lin_pfc_X = lin_pfc_fv( nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, ple_X, phi_X ) +#else + lin_pfc_X = lin_pfc_fv( nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, pke_X, phik_X ) +#endif + + kehg_ana = kehg_X + plog_ana = plog_X + phig_ana = phig_X + teg_ana = teg_X + qg_ana = qg_X + ug_ana = ug_X + vg_ana = vg_X + lin_pfc_ana = lin_pfc_X + + !put together pieces for u*grad(u) form of U and V adv tendencies + + if ( scm_ana_upwind .OR. scm_ana_u_react ) then + uten_hadv_ana = upwind_hadv(nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, u_ana, v_ana, Uo_X ) + else + uten_hadv_ana = -u_ana * ug_ana(:,1) - v_ana * ug_ana(:,2) + end if + if ( scm_ana_upwind .OR. scm_ana_v_react ) then + vten_hadv_ana = upwind_hadv(nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, u_ana, v_ana, Vo_X ) + else + vten_hadv_ana = -u_ana * vg_ana(:,1) - v_ana * vg_ana(:,2) + end if + + ! Coriolis terms + !====================================== + absvo = 2._r8 * OOmega * sin( lat_ana(jax) * PI/180._r8 ) + !Allow Coriolis to react to SCM winds + uten_vort_ana = absvo * v_ana + vten_vort_ana = -absvo * u_ana + ! Force Coriolis to ALWAYS be calc w/ analysis winds + !!uten_vort_ana = absvo * v_ana_diag + !!vten_vort_ana = -absvo * u_ana_diag + ! ----- Diags for VI form (0-out) + uten_keg_ana = 0._r8 ! fill with 0 + + !!if (scm_ana_x_plevels) then ! No horz. p-gradient in p-coords + if (.FALSE.) then ! No horz. p-gradient in p-coords + uten_pfrc_ana = - phig_ana(:,1) + vten_pfrc_ana = - phig_ana(:,2) + else +#if 1 + !put together pieces for Pressure and Phi gradient tencency terms + uten_pfrc_ana = -(1._r8/rho_ana) * plog_ana(:,1) - phig_ana(:,1) + vten_pfrc_ana = -(1._r8/rho_ana) * plog_ana(:,2) - phig_ana(:,2) +#else + !Lin(1997) QJRMS pfrc tendency terms + uten_pfrc_ana = lin_pfc_ana(:,1) + vten_pfrc_ana = lin_pfc_ana(:,2) +#endif + end if + + + if ( scm_ana_upwind .OR. scm_ana_t_react ) then + tten_hadv_ana = upwind_hadv(nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, u_ana, v_ana, Tv_X ) + else + tten_hadv_ana = -u_ana * teg_ana(:,1) - v_ana * teg_ana(:,2) ! should be straight T (not virtual) + end if + if ( scm_ana_upwind .OR. scm_ana_q_react ) then + qten_hadv_ana = upwind_hadv(nlon_alc,nlat_alc,nlev_alc,iac,jac,lon_alc,lat_alc, u_ana, v_ana, Qo_X ) + else + qten_hadv_ana = -u_ana * qg_ana(:,1) - v_ana * qg_ana(:,2) + end if + + if (.not.(scm_ana_direct_omega)) then + omega_ana = omega_recalc_ana ! use reconstructed omega + if(masterproc) write(iulog,*) " Omega recalc from ana U,V etc." + else + omega_ana = omega_dycore_ana ! use direct omega from dycore/ana + if(masterproc) write(iulog,*) " Omega direct from ana" + end if + + + if (.not.(scm_ana_x_plevels)) then + !Tendencies due to vertical advection (etadot * D_eta ... ) + uten_vadv_ana = vadv_fv( nlev_alc, etad_ana, u_ana ) + vten_vadv_ana = vadv_fv( nlev_alc, etad_ana, v_ana ) + tten_vadv_ana = vadv_fv( nlev_alc, etad_ana, tv_ana ) ! should be straight T (not virtual) + qten_vadv_ana = vadv_fv( nlev_alc, etad_ana, q_ana ) + else + !Tendencies due to vertical advection (Omega * D_p ... ) + uten_vadv_ana = vadv_fv_press( nlev_alc, omega_ana, plo_ana, u_ana ) + vten_vadv_ana = vadv_fv_press( nlev_alc, omega_ana, plo_ana, v_ana ) + tten_vadv_ana = vadv_fv_press( nlev_alc, omega_ana, plo_ana, t_ana ) ! should be straight T (not virtual) + qten_vadv_ana = vadv_fv_press( nlev_alc, omega_ana, plo_ana, q_ana ) + end if + + tten_comp_ana = (1./cpair)*( omega_ana / rho_ana ) + + !DIags for pressure/geop grad forces + uten_phig_ana = - phig_ana(:,1) + uten_prg_ana = - (1._r8/rho_ana) * plog_ana(:,1) + + end subroutine get_ana_dynfrc_fv + +!----------------------------------------------------- +! Stuff ... useful ojala +!----------------------------------------------------- + !------------------------- + function vadv_fv( nlev, etad, aa ) result( tend ) + use hycoef, only: hyai, hybi, ps0, hyam, hybm + integer, intent(in) :: nlev + real(r8), intent(in) :: etad(nlev) , aa(nlev) + real(r8) :: tend(nlev) + real(r8) :: eta(nlev) + integer :: L + + eta = hybm+hyam + + do L=2,nlev-1 + tend(L) = etad(L)* ( aa(L+1) - aa(L-1) ) / ( eta(L+1) - eta(L-1) ) + end do + L=1 + tend(L) = etad(L)* ( aa(L+1) - aa(L) ) / ( eta(L+1) - eta(L) ) + L=nlev + tend(L) = etad(L)* ( aa(L) - aa(L-1) ) / ( eta(L) - eta(L-1) ) + + tend = -1.*tend ! for RHS consistency + + end function vadv_fv +!--------------------------- + !------------------------- + function vadv_fv_press( nlev, omega, plo, aa ) result( tend ) + integer, intent(in) :: nlev + real(r8), intent(in) :: omega(nlev) , aa(nlev),plo(nlev) + real(r8) :: tend(nlev) + integer :: L + + do L=2,nlev-1 + tend(L) = omega(L)* ( aa(L+1) - aa(L-1) ) / ( plo(L+1) - plo(L-1) ) + end do + L=1 + tend(L) = omega(L)* ( aa(L+1) - aa(L) ) / ( plo(L+1) - plo(L) ) + L=nlev + tend(L) = omega(L)* ( aa(L) - aa(L-1) ) / ( plo(L) - plo(L-1) ) + + tend = -1.*tend ! for RHS consistency + + end function vadv_fv_press +!--------------------------- + function lin_pfc_fv( nlon,nlat,nlev,iax,jax,lons,lats, pre, phi ) result( pfc ) + !use shr_kind_mod, only: r8 => shr_kind_r8 + !use shr_const_mod, only: rearth => shr_const_rearth , & ! =6.37122e6_R8 meters + ! pi => shr_const_pi , & + ! omega => shr_const_omega + + integer, intent(in) :: nlon,nlat,nlev,iax,jax + real(r8), intent(in) :: pre(nlon,nlat,nlev+1),phi(nlon,nlat,nlev+1) + real(r8), intent(in) :: lats(nlat),lons(nlon) + real(r8) :: pfc(nlev,2) + real(r8) :: pfxW(nlev) , pfxE(nlev) + real(r8) :: pfyS(nlev) , pfyN(nlev) + real(r8) :: rlats(nlat),rlons(nlon),dx,dy,ds + real(r8) :: pr1,pr2,pr3,pr4, ph1,ph2,ph3,ph4 + integer :: L , igg + + ! Begin + rlons(:) = lons(:) * PI/180._r8 + rlats(:) = lats(:) * PI/180._r8 + + dx=( rlons(2)-rlons(1) ) * Rearth + dy=( rlats(2)-rlats(1) ) * Rearth + + ds = MAX( dx*cos(rlats(jax)) , .1 ) + igg = iax + do L=1,nlev + pr1 = pre(igg-1,jax,L+1) + pr2 = pre(igg ,jax,L+1) + pr3 = pre(igg ,jax,L ) + pr4 = pre(igg-1,jax,L ) + ph1 = phi(igg-1,jax,L+1) + ph2 = phi(igg ,jax,L+1) + ph3 = phi(igg ,jax,L ) + ph4 = phi(igg-1,jax,L ) + pfxW(L) = ( (pr2-pr4)*(ph1-ph3) + (pr1-pr3)*(ph4-ph2) ) /( ds * ( (pr2-pr4) + (pr1-pr3) ) ) + end do + igg = iax +1 + do L=1,nlev + pr1 = pre(igg-1,jax,L+1) + pr2 = pre(igg ,jax,L+1) + pr3 = pre(igg ,jax,L ) + pr4 = pre(igg-1,jax,L ) + ph1 = phi(igg-1,jax,L+1) + ph2 = phi(igg ,jax,L+1) + ph3 = phi(igg ,jax,L ) + ph4 = phi(igg-1,jax,L ) + pfxE(L) = ( (pr2-pr4)*(ph1-ph3) + (pr1-pr3)*(ph4-ph2) ) /( ds * ( (pr2-pr4) + (pr1-pr3) ) ) + end do + ds = dy + igg = jax + do L=1,nlev + pr1 = pre(iax,igg-1,L+1) + pr2 = pre(iax,igg ,L+1) + pr3 = pre(iax,igg ,L ) + pr4 = pre(iax,igg-1,L ) + ph1 = phi(iax,igg-1,L+1) + ph2 = phi(iax,igg ,L+1) + ph3 = phi(iax,igg ,L ) + ph4 = phi(iax,igg-1,L ) + pfyS(L) = ( (pr2-pr4)*(ph1-ph3) + (pr1-pr3)*(ph4-ph2) ) /( ds * ( (pr2-pr4) + (pr1-pr3) ) ) + end do + igg = jax +1 + do L=1,nlev + pr1 = pre(iax,igg-1,L+1) + pr2 = pre(iax,igg ,L+1) + pr3 = pre(iax,igg ,L ) + pr4 = pre(iax,igg-1,L ) + ph1 = phi(iax,igg-1,L+1) + ph2 = phi(iax,igg ,L+1) + ph3 = phi(iax,igg ,L ) + ph4 = phi(iax,igg-1,L ) + pfyN(L) = ( (pr2-pr4)*(ph1-ph3) + (pr1-pr3)*(ph4-ph2) ) /( ds * ( (pr2-pr4) + (pr1-pr3) ) ) + end do + + + do L=1,nlev + pfc(L,1) = 0.5*( pfxW(L) + pfxE(L) ) + pfc(L,2) = 0.5*( pfyS(L) + pfyN(L) ) + end do + + + + end function lin_pfc_fv + !------------------------- + function grad_fv( nlon,nlat,nlev,iax,jax,lons,lats, aa ) result( ga ) + !use shr_kind_mod, only: r8 => shr_kind_r8 + !use shr_const_mod, only: rearth => shr_const_rearth , & ! =6.37122e6_R8 meters + ! pi => shr_const_pi , & + ! omega => shr_const_omega + + integer, intent(in) :: nlon,nlat,nlev,iax,jax + real(r8), intent(in) :: aa(nlon,nlat,nlev) + real(r8), intent(in) :: lats(nlat),lons(nlon) + real(r8) :: ga(nlev,2) + real(r8) :: rlats(nlat),rlons(nlon),dx,dy + integer :: L + + ! Begin + rlons(:) = lons(:) * PI/180._r8 + rlats(:) = lats(:) * PI/180._r8 + + dx=( rlons(2)-rlons(1) ) * Rearth + dy=( rlats(2)-rlats(1) ) * Rearth + + do L=1,nlev + ga(L,1) = (aa(iax+1,jax,L) - aa(iax-1,jax,L))/( 2.*dx*cos(rlats(jax)) + 0.1 ) + ga(L,2) = (aa(iax,jax+1,L) - aa(iax,jax-1,L))/( 2.*dy ) + end do + + + + end function grad_fv + !------------------------- + function upwind_hadv( nlon,nlat,nlev,iax,jax,lons,lats,u,v, aa ) result( hadv_tend ) + !use shr_kind_mod, only: r8 => shr_kind_r8 + !use shr_const_mod, only: rearth => shr_const_rearth , & ! =6.37122e6_R8 meters + ! pi => shr_const_pi , & + ! omega => shr_const_omega + + integer, intent(in) :: nlon,nlat,nlev,iax,jax + real(r8), intent(in) :: aa(nlon,nlat,nlev) + real(r8), intent(in) :: lats(nlat),lons(nlon),u(nlev),v(nlev) + real(r8) :: hadv_tend(nlev) + real(r8) :: rlats(nlat),rlons(nlon),dx,dy,xten(nlev),yten(nlev) + integer :: L + + ! Begin + rlons(:) = lons(:) * PI/180._r8 + rlats(:) = lats(:) * PI/180._r8 + + dx=( rlons(2)-rlons(1) ) * Rearth + dy=( rlats(2)-rlats(1) ) * Rearth + + do L=1,nlev + if ( u(L) >= 0._r8 ) then + xten(L) = u(L) * ( aa(iax,jax,L) - aa(iax-1,jax,L))/( dx*cos(rlats(jax)) + 0.1 ) + else + xten(L) = u(L) * ( aa(iax+1,jax,L) - aa(iax,jax,L))/( dx*cos(rlats(jax)) + 0.1 ) + end if + end do + do L=1,nlev + if ( v(L) >= 0._r8 ) then + yten(L) = v(L) * ( aa(iax,jax,L) - aa(iax,jax-1,L))/( dy ) + else + yten(L) = v(L) * ( aa(iax,jax+1,L) - aa(iax,jax,L))/( dy ) + end if + end do + + hadv_tend(:) = -1._r8 * ( xten(:) + yten(:) ) + + + end function upwind_hadv +!========================================= + subroutine makepk_fv( nlon,nlat,nlev, t, q, ps, phis, pko, pke, phi, th ) + use hycoef, only: hyai, hybi, ps0, hyam, hybm + !!use shr_const_mod, only: rdair => shr_const_rdair, cpair => shr_const_cpdair, + integer, intent(in) :: nlon,nlat,nlev + real(r8), intent(in) :: t(nlon,nlat,nlev),q(nlon,nlat,nlev),ps(nlon,nlat),phis(nlon,nlat) + real(r8), intent(out) :: pko(nlon,nlat,nlev),th(nlon,nlat,nlev),pke(nlon,nlat,nlev+1), phi(nlon,nlat,nlev+1) + real(r8) :: ple(nlon,nlat,nlev+1),plo(nlon,nlat,nlev),rv(nlon,nlat,nlev) + real(r8) :: kappa, p00 + integer :: L + + do L=1,nlev+1 + ple(:,:,L) = hyai(L)*ps0 + hybi(L)*ps(:,:) + end do + do L=1,nlev + plo(:,:,L) = hyam(L)*ps0 + hybm(L)*ps(:,:) + end do + + kappa=rdair/cpair + + pko = plo**kappa + pke = ple**kappa + + p00 = 100000._r8 + th = ( ( p00 / plo)**kappa ) * t + + rv = 1._r8/(1._r8 - q) - 1._r8 + th = th*(1._r8 + 0.61_r8 * rv ) + + phi(:,:,nlev+1) = phis(:,:) + do L=nlev,1,-1 + phi(:,:,L) = phi(:,:,L+1) - ( CpAir * Th(:,:,L) ) * ( pke(:,:,L) - pke(:,:,L+1) ) / (p00**kappa ) + end do + + + end subroutine makepk_fv + +!============================================================================= + subroutine makepr_fv( nlon,nlat,nlev, t, ps, phis, plo, ple, phi ) + use hycoef, only: hyai, hybi, ps0, hyam, hybm + use shr_const_mod, only: rdair => shr_const_rdair + integer, intent(in) :: nlon,nlat,nlev + real(r8), intent(in) :: t(nlon,nlat,nlev),ps(nlon,nlat),phis(nlon,nlat) + real(r8), intent(out) :: plo(nlon,nlat,nlev), ple(nlon,nlat,nlev+1), phi(nlon,nlat,nlev+1) + real(r8) :: lnple(nlon,nlat,nlev+1) + integer :: L + + do L=1,nlev+1 + ple(:,:,L) = hyai(L)*ps0 + hybi(L)*ps(:,:) + end do + do L=1,nlev + plo(:,:,L) = hyam(L)*ps0 + hybm(L)*ps(:,:) + end do + + lnple = log( ple ) + phi(:,:,nlev+1) = phis(:,:) + do L=nlev,1,-1 + phi(:,:,L) = phi(:,:,L+1) - (RdAir * T(:,:,L) ) * ( lnple(:,:,L) - lnple(:,:,L+1) ) + !phi(:,:,L) = phi(:,:,L+1) - (RdAir * T(:,:,L) / plo(:,:,L) ) * ( ple(:,:,L) - ple(:,:,L+1) ) + end do + + end subroutine makepr_fv + +!============================================================================= + subroutine virtual_t( nlon,nlat,nlev, t, q, tv ) + use hycoef, only: hyai, hybi, ps0, hyam, hybm + use shr_const_mod, only: rdair => shr_const_rdair + integer, intent(in) :: nlon,nlat,nlev + real(r8), intent(in) :: t(nlon,nlat,nlev),q(nlon,nlat,nlev) + real(r8), intent(out) :: tv(nlon,nlat,nlev) + real(r8) :: rv(nlon,nlat,nlev) + integer :: L + + + rv = 1._r8/(1._r8 - q) - 1._r8 + tv = t*(1._r8 + 0.61_r8 * rv ) + + + end subroutine virtual_t + + !------------------------- + subroutine zeta_fv( nlon,nlat,nlev,lons,lats, u,v, zeta ) + !use shr_kind_mod, only: r8 => shr_kind_r8 + !use shr_const_mod, only: rearth => shr_const_rearth , & ! =6.37122e6_R8 meters + ! pi => shr_const_pi , & + ! omega => shr_const_omega + + integer, intent(in) :: nlon,nlat,nlev + real(r8), intent(in) :: u(nlon,nlat,nlev),v(nlon,nlat,nlev) + real(r8), intent(out) :: zeta(nlev) + !real(r8), intent(in) :: u(iax-1:iax+1,jax-1:jax+1,nlev) + !real(r8), intent(in) :: v(iax-1:iax+1,jax-1:jax+1,nlev) + real(r8), intent(in) :: lats(nlat),lons(nlon) + real(r8) :: rlats(nlat),rlons(nlon) + real(r8) :: dy,dx0,dx,darea,voo,voo2 + + integer :: iap,jap,iam,jam,i,j,L,iax,jax + + iax=2 + jax=2 + write(*,*) " we're in subr. zeta_fv Lon Lat: " + write(*,*) lons(iax),lats(jax) + + rlons(:) = lons(:) * PI/180._r8 + rlats(:) = lats(:) * PI/180._r8 + + dx0 = rearth* ( rlons(2)-rlons(1) ) + dy = rearth* ( rlats(2)-rlats(1) ) + + darea = dy*dx0*cos( rlats(jax) ) + + write(*,*) dx0,dy,cos( rlats(jax) ) + + do L =1,nlev + zeta(L) = & + ( V(iax+1,jax, L) - V(iax-1,jax,L) ) / ( 2*dx0*cos( rlats(jax) ) ) & + - ( U(iax,jax+1, L) - U(iax,jax-1,L) ) / ( 2*dy ) + end do + + write(*,*) " vorticity est. ",zeta(nlev) + + end subroutine zeta_fv +!================================================================ + subroutine etadot_fv ( nlon, nlat, nlev, lons, lats, u, v, plo, ple, etadot , omega ) + use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 + use shr_const_mod, only: rearth => shr_const_rearth , & ! =6.37122e6_R8 meters + pi => shr_const_pi + use hycoef, only: hyai, hybi, ps0, hyam, hybm + + integer, intent(in) :: nlon,nlat,nlev + real(r8), intent(in) :: lons(nlon),lats(nlat) + real(r8), intent(in) :: u(nlon,nlat,nlev) , v(nlon,nlat,nlev) , plo( nlon,nlat,nlev) , ple( nlon,nlat,nlev+1) + real(r8), intent(out) :: etadot( nlon,nlat,nlev) ,omega(nlon,nlat,nlev) + !real(r8), intent(in) :: uc(:,:,:) , vc(:,:,:) , ple(:,:,:) + + ! Local variables + real(r8),allocatable :: div(:,:,:) + real(r8),allocatable :: mass(:,:,:), fuc(:,:,:),fvc(:,:,:) + real(r8) :: rlats(nlat), rlons(nlon), rcos1, eta(nlev+1) , dx,dy! radians + real(r8), allocatable :: etadot_t1(:,:), etadot_t2(:,:,:) + integer :: i,j,L,im1,jm1,ip1,jp1 + real :: uc_ijL , vc_ijL + + allocate ( div(nlon,nlat,nlev) ) + allocate ( mass(nlon,nlat,nlev), fuc(nlon,nlat,nlev),fvc(nlon,nlat+1,nlev) ) + allocate ( etadot_t1(nlon,nlat), etadot_t2(nlon,nlat,nlev) ) + + div = 0._r8 + fuc = 0._r8 + fvc = 0._r8 + mass = 0._r8 + etadot = 0._r8 + etadot_t1 = 0._r8 + etadot_t2 = 0._r8 + + rlons(:) = lons(:) * PI/180._r8 + rlats(:) = lats(:) * PI/180._r8 + + do L=1,nlev+1 + eta(L) = hyai(L) + hybi(L) ! 1._r8*L/(nlev+1) + end do + do L=1,nlev + mass(:,:,L) = ( ple(:,:,L+1)-ple(:,:,L) )/( eta(L+1)-eta(L) ) + end do + + ! calculate mass fluxes at gridbox edges, using upwind algorithm + do L=1,nlev + do j=1,nlat + do i=2,nlon + im1=i-1 + !if ( i == 1) im1=nlon + uc_ijL = 0.5*( u(im1,j,L) + u(i,j,L) ) + if ( uc_ijL < 0. ) fuc(i,j,L)= uc_ijL * mass(i,j,L) + if ( uc_ijL >= 0. ) fuc(i,j,L)= uc_ijL * mass(im1,j,L) + end do + end do + end do + ! Note: cos(lat) term incorporated into fluxes + do L=1,nlev + do j=2,nlat + do i=1,nlon + jm1=j-1 + vc_ijL = 0.5 * ( v(i,jm1,L)+v(i,j,L) ) + if ( vc_ijL < 0. ) fvc(i,j,L)= vc_ijL * mass(i,j,L) *cos( rlats(j) ) + if ( vc_ijL >= 0. ) fvc(i,j,L)= vc_ijL * mass(i,jm1,L) *cos( rlats(jm1) ) + end do + end do + end do + + + ! now calculate HORZ divergence of (FUC,FVC). Note coslat term already + ! incorporated in FVC. + do L=1,nlev + do j=1,nlat-1 + do i=1,nlon-1 + ip1=i+1 + jp1=j+1 + rcos1 = 1. /( Rearth*cos( rlats(j) ) ) + div(i,j,L) = rcos1 * ( FUC(ip1,j,L)-FUC(i,j,L) ) / (rlons(ip1)-rlons(i) ) & + + rcos1 * ( FVC(i,jp1,L)-FVC(i,j,L) ) / (rlats(jp1)-rlats(j) ) + end do + end do + end do + + + etadot_t1(:,:)=0._r8 + etadot_t2(:,:,:)=0._r8 + do L=1,nlev + etadot_t1(:,:) = etadot_t1(:,:) + div(:,:,L)*(eta(L+1)-eta(L)) + end do + do L=2,nlev + etadot_t2(:,:,L) = etadot_t2(:,:,L-1) + div(:,:,L)*(eta(L+1)-eta(L)) + end do + do L=1,nlev + etadot(:,:,L) = ( hybm(L)*etadot_t1(:,:) - etadot_t2(:,:,L) ) / mass(:,:,L) + end do + + dx=( rlons(2)-rlons(1) ) * Rearth + dy=( rlats(2)-rlats(1) ) * Rearth + omega = 0._r8 + +#if 1 + do L=1,nlev + do j=2,nlat-1 + do i=2,nlon-1 + omega(i,j,L) = u(i,j,L) * (plo(i+1,j,L)-plo(i-1,j,L))/( 2.*dx*cos(rlats(j)) + 0.1 ) & + + v(i,j,L) * (plo(i,j+1,L)-plo(i,j-1,L))/( 2.*dy ) & + - etadot_t2(i,j,L) + end do + end do + end do +#else + do L=1,nlev + do j=2,nlat-1 + do i=2,nlon-1 + omega(i,j,L) = etadot(i,j,L)*mass(i,j,L) + end do + end do + end do +#endif + + +end subroutine etadot_fv + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!! Reading netcdf files +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!================================================================ + subroutine read_netcdf_ana_fv_ini( anal_file , nlon, nlat, nlev,lonidx,latidx ) + ! + ! READ_NETCDF_ANAL_INI: + ! Open the given analyses data file. Query dimesnisons. + ! Close. + !=============================================================== + use cam_abortutils, only : endrun + use netcdf + use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 + use hycoef, only: hyai, hybi, ps0, hyam, hybm + use shr_const_mod, only: rdair => shr_const_rdair + use scammod, only: scmlon,scmlat + use shr_scam_mod, only: shr_scam_getCloseLatLon ! Standardized system subroutines + + !------------- + character(len=*),intent(in):: anal_file + + integer, intent(out) :: nlon,nlat,nlev,latidx,lonidx + + ! Local values + !------------- + integer :: ncid,varid,istat + integer :: ilat,ilon,ilev + integer :: i,j,L + + real(r8) :: closelon,closelat + + logical :: l_have_us , l_have_vs + + l_have_us = .FALSE. + l_have_vs = .FALSE. + + ! masterporc does all of the work here + !----------------------------------------- + if(masterproc) then + + ! Open the given file + !----------------------- + istat=nf90_open(trim(anal_file),NF90_NOWRITE,ncid) + if(istat.ne.NF90_NOERR) then + write(iulog,*)'NF90_OPEN: failed for file ',trim(anal_file) + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + + ! Read in Dimensions + !-------------------- + istat=nf90_inq_dimid(ncid,'lon',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + istat=nf90_inquire_dimension(ncid,varid,len=nlon) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + + istat=nf90_inq_dimid(ncid,'lat',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + istat=nf90_inquire_dimension(ncid,varid,len=nlat) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + + istat=nf90_inq_dimid(ncid,'lev',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + istat=nf90_inquire_dimension(ncid,varid,len=nlev) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + + call shr_scam_getCloseLatLon(ncid ,scmlat,scmlon,closelat,closelon,latidx,lonidx) + + ! Close the analyses file and exit + !----------------------- + istat=nf90_close(ncid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_EUL') + endif + + endif ! (masterproc) then + + + end subroutine read_netcdf_ana_fv_ini + +!================================================================ + subroutine read_netcdf_ana_fv( anal_file , nlon, nlat, nlev, & + u, v, & + t, q, ps, phis, & + lons, lats, levs & + , utcore, vtcore, ttcore, ogcore & + ) + ! + ! READ_NETCDF_ANAL : + ! Open the given analyses data file, read in + ! U,V,T,Q, and PS values as well as Lons, Lats. + !=============================================================== + use cam_abortutils, only : endrun + use netcdf + use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 + use hycoef, only: hyai, hybi, ps0, hyam, hybm + use shr_const_mod, only: rdair => shr_const_rdair + ! Arguments + !------------- + character(len=*),intent(in):: anal_file + + integer, intent(in ) :: nlon,nlat,nlev + real(r8), intent(out) :: U(nlon,nlat,nlev), V(nlon,nlat,nlev) + real(r8), intent(out) :: T(nlon,nlat,nlev), Q(nlon,nlat,nlev) + real(r8), intent(out) :: PS(nlon,nlat), PHIS(nlon,nlat) + !real(r8), intent(out) :: PHI(nlon,nlat,nlev+1),PLE(nlon,nlat,nlev+1),PLO(nlon,nlat,nlev) + real(r8), intent(out) :: Lats(nlat),Lons(nlon),Levs(nlev) + + real(r8), intent(out) :: UTCORE(nlon,nlat,nlev), VTCORE(nlon,nlat,nlev), TTCORE(nlon,nlat,nlev) + real(r8), intent(out) :: OGCORE(nlon,nlat,nlev) + + ! Local values + !------------- + integer :: ncid,varid,istat + integer :: ilat,ilon,ilev + integer :: i,j,L + + logical :: l_have_us , l_have_vs + + l_have_us = .FALSE. + l_have_vs = .FALSE. + + ! masterporc does all of the work here + !----------------------------------------- + if(masterproc) then + + ! Open the given file + !----------------------- + istat=nf90_open(trim(anal_file),NF90_NOWRITE,ncid) + if(istat.ne.NF90_NOERR) then + write(iulog,*)'NF90_OPEN: failed for file ',trim(anal_file) + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + end if + end if + + + + if(masterproc) then + + istat=nf90_inq_varid(ncid,'lon',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + istat=nf90_get_var(ncid,varid,Lons) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + + istat=nf90_inq_varid(ncid,'lat',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + istat=nf90_get_var(ncid,varid,Lats) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + + istat=nf90_inq_varid(ncid,'lev',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + istat=nf90_get_var(ncid,varid,Levs) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + endif ! (masterproc) then + + + if(masterproc) then + ! Read in, transpose lat/lev indices, + ! and scatter data arrays + !---------------------------------- + ! First block reads U + !---------------------------------- + istat=nf90_inq_varid(ncid,'U',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + istat=nf90_get_var(ncid,varid, U ) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + endif ! (masterproc) then + + if(masterproc) then + istat=nf90_inq_varid(ncid,'V',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + istat=nf90_get_var(ncid,varid, V ) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + endif ! (masterproc) then + + + + +!!!!!!!!!!!!!! + if(masterproc) then + istat=nf90_inq_varid(ncid,'T',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + istat=nf90_get_var(ncid,varid, T ) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + endif ! (masterproc) then + + if(masterproc) then + istat=nf90_inq_varid(ncid,'Q',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + istat=nf90_get_var(ncid,varid, Q ) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + endif ! (masterproc) then + + if(masterproc) then + istat=nf90_inq_varid(ncid,'PS',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + istat=nf90_get_var(ncid,varid,PS ) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + endif ! (masterproc) then + + if(masterproc) then + istat=nf90_inq_varid(ncid,'PHIS',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_SE') + endif + istat=nf90_get_var(ncid,varid,PHIS ) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + endif + endif ! (masterproc) then + + if(masterproc) then + istat=nf90_inq_varid(ncid,'UTEND_CORE',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) "No UTEND_CORE on file: " + write(iulog,*) trim(anal_file) + utcore(:,:,:)=-9999._r8 + else + istat=nf90_get_var(ncid,varid,utcore ) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + end if + end if + end if ! (masterproc) then + + if(masterproc) then + istat=nf90_inq_varid(ncid,'VTEND_CORE',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) "No VTEND_CORE on file: " + write(iulog,*) trim(anal_file) + vtcore(:,:,:)=-9999._r8 + else + istat=nf90_get_var(ncid,varid,vtcore ) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + end if + end if + end if ! (masterproc) then + + if(masterproc) then + istat=nf90_inq_varid(ncid,'DTCORE',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) "No TTEND_CORE on file: " + write(iulog,*) trim(anal_file) + ttcore(:,:,:)=-9999._r8 + else + istat=nf90_get_var(ncid,varid,ttcore ) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + end if + end if + end if ! (masterproc) then + + if(masterproc) then + istat=nf90_inq_varid(ncid,'OMEGA',varid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) "No OMEGA (core) on file: " + write(iulog,*) trim(anal_file) + ogcore(:,:,:)=-9999._r8 + else + istat=nf90_get_var(ncid,varid,ogcore ) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_FV') + end if + end if + end if ! (masterproc) then + + + if(masterproc) then + ! Close the analysis file + !----------------------- + istat=nf90_close(ncid) + if(istat.ne.NF90_NOERR) then + write(iulog,*) nf90_strerror(istat) + call endrun ('UPDATE_ANALYSES_EUL') + endif + end if + !------------ +#if 0 +! Block winds at 45 m/s for increased stability. Kluge if Jets nt important + where(U > 45._r8) + U = 45._r8 + end where + where(V > 45._r8) + V = 45._r8 + end where + where(U < -45._r8) + U = -45._r8 + end where + where(V < -45._r8) + V = -45._r8 + end where +#endif + + + write(*,*) "In read_netcdf_anal " + write(*,*) "Reading: ",anal_file + write(*,*) "Lons ..." + write(*,*) "Shape: ",shape(Lons) + write(*,*) "MinMax: ",minval(Lons),maxval(Lons) + write(*,*) "US and VS are presnt on file: ",l_have_us, l_have_vs + + + return + end subroutine read_netcdf_ana_fv +!================================================================ +!================================================================ + subroutine dynfrc_timewgts ( & + ana_prev_date, ana_next_date, & + wgt1 , wgt2 ) + + + use shr_kind_mod, only: r8 => shr_kind_r8, i8 => shr_kind_i8 + use ESMF + use time_manager, only:timemgr_time_ge,timemgr_time_inc,get_curr_date,get_step_size + + integer, intent(in) :: ana_prev_date(4), ana_next_date(4) + real(r8) , intent(out) :: wgt1,wgt2 + + type(ESMF_Time) :: Date1,Date2,Date0 + type(ESMF_TimeInterval) :: DateDiff2,DateDiff0,DateDiff, AnaDiff + integer :: DeltaT0, DeltaT2 , YMD, Year,Month,Day,Sec, Ana_interval, rc + + call get_curr_date(Year,Month,Day,Sec) + YMD=(Year*10000) + (Month*100) + Day + + call ESMF_TimeSet(Date0,YY=Ana_prev_date(1), MM=Ana_prev_date(2) , & + DD= Ana_prev_date(3) , S= Ana_prev_date(4) ) + call ESMF_TimeSet(Date1,YY=Year,MM=Month,DD=Day,S=Sec) + + call ESMF_TimeSet(Date2,YY=Ana_next_date(1), MM=Ana_next_date(2) , & + DD= Ana_next_date(3) , S= Ana_next_date(4) ) + AnaDiff =Date2-Date0 + call ESMF_TimeIntervalGet(AnaDiff,S=Ana_interval ,rc=rc) + + DateDiff2 =Date2-Date1 + call ESMF_TimeIntervalGet(DateDiff2,S=DeltaT2,rc=rc) + DateDiff0 =Date1-Date0 + call ESMF_TimeIntervalGet(DateDiff0,S=DeltaT0,rc=rc) + + wgt1 = 1._r8 - ( 1._r8 * DeltaT0 ) / Ana_interval + wgt2 = 1._r8 - ( 1._r8 * DeltaT2 ) / Ana_interval + +end subroutine dynfrc_timewgts + + +!!!!!!!!!!!!!!!!!!!!!!!!!! + subroutine patch_eta_x_plv ( nx , ny, nL,ix, jx, aa, plo ) + integer, intent(in) :: nx,ny,nl,ix,jx + real(r8), intent(in) :: plo(nx,ny,nL) + real(r8), intent(inout) :: aa(nx,ny,nL) + + real(r8) :: plx(nL),plq(nL),aax(nL),aaq(nL),aat(nx,ny,nL) + real(r8) :: dp,dpk,dpk1,wtk,wtk1 + integer :: i,j,L,k + + + plx(:) = plo(ix,jx,:) ! target pressures + + do j=1,ny + do i=1,nx + plq(:) = plo(i,j,:) + aaq(:) = aa(i,j,:) + !if (plq(1) <= MINVAL(plx) ) aax(1) = aaq(1) + !if (plq(nl) > MAXVAL(plx) ) aax(nl) = aaq(nl) + do L=1,nl + do k=2,nl + if ( ( plx(L) <= plq(k) ).AND.(plx(L) > plq(k-1) ) ) then + dp = plq(k)-plq(k-1) + dpk1 = plx(L)-plq(k-1) + dpk = plq(k)-plx(L) + wtk1 = 1._r8 - dpk1 / dp + wtk = 1._r8 - dpk / dp + aax(L) = wtk * aaq(k) + wtk1 * aaq(k-1) + end if + end do + if ( plx(L) <= plq(1) ) aax(L)=aaq(1) + if ( plx(L) > plq(NL) ) aax(L)=aaq(NL) + end do + + aat(i,j,:)=aax(:) + end do + end do + + aa=aat + +!write(*,*) " mod " +!write(411) nx,ny,nL +!write(411) plo,aa,aat +!PAUSE + + + end subroutine patch_eta_x_plv + + +end module get_ana_dynfrc_4scam diff --git a/src/dynamics/eul/scmforecast.F90 b/src/dynamics/eul/scmforecast.F90 index f9c0cbc6a8..b52a3bd92c 100644 --- a/src/dynamics/eul/scmforecast.F90 +++ b/src/dynamics/eul/scmforecast.F90 @@ -1,3 +1,4 @@ +#define SCAMNUDGERUN module scmforecast ! --------------------------------------------------------------------------- ! ! ! @@ -9,7 +10,11 @@ module scmforecast use spmd_utils, only: masterproc use cam_logfile, only: iulog use cam_control_mod, only: adiabatic - +!++jtb +#ifdef SCAMNUDGERUN + use get_ana_dynfrc_4scam, only: get_ana_dynfrc_fv +#endif +!--jtb implicit none private save @@ -59,10 +64,20 @@ subroutine forecast( lat , nlon , ztodt , & scm_relax_tau_sec,scm_relax_tau_top_sec,scm_relax_top_p, & scm_relaxation,scm_use_obs_qv,scm_use_obs_t,scm_use_obs_uv,scm_zadv_q,scm_zadv_t, & scm_zadv_uv,tdiff,tobs,uobs,use_3dfrc,use_camiop,vertdivq, & - vertdivt,vertdivu,vertdivv,vobs,wfld,qinitobs,scm_relax_fincl + vertdivt,vertdivu,vertdivv,vobs,wfld,qinitobs,scm_relax_fincl, & +!++jtb + scmlon,scmlat, & + scm_ana_direct_ttend, & + scm_use_ana_iop +!--jtb use time_manager, only : get_curr_calday, get_nstep, get_step_size, is_first_step use cam_abortutils, only : endrun use string_utils, only: to_upper +!++jtb + use shr_const_mod, only: rearth => shr_const_rearth , & ! =6.37122e6_R8 meters + pi => shr_const_pi , & + OOmega => shr_const_omega +!--jtb implicit none @@ -71,6 +86,7 @@ subroutine forecast( lat , nlon , ztodt , & ! ---------------------- ! character(len=*), parameter :: subname = "forecast" + real(r8),parameter :: hugebad=9.99e12_r8 ! --------------------------------------------------- ! ! x = t, u, v, q ! @@ -83,16 +99,16 @@ subroutine forecast( lat , nlon , ztodt , & integer, intent(in) :: nlon real(r8), intent(in) :: ztodt ! Twice time step unless nstep = 0 [ s ] - real(r8), intent(in) :: ps(plon) ! Surface pressure [ Pa ] - real(r8), intent(in) :: psm1(plon) ! Surface pressure [ Pa ] - real(r8), intent(in) :: psm2(plon) ! Surface pressure [ Pa ] + real(r8), intent(inout) :: ps(plon) ! Surface pressure [ Pa ] + real(r8), intent(inout) :: psm1(plon) ! Surface pressure [ Pa ] + real(r8), intent(inout) :: psm2(plon) ! Surface pressure [ Pa ] real(r8), intent(in) :: t3m1(plev) ! Temperature [ K ] - real(r8), intent(in) :: t3m2(plev) ! Temperature [ K ] + real(r8), intent(inout) :: t3m2(plev) ! Temperature [ K ] real(r8), intent(in) :: u3m1(plev) ! Zonal wind [ m/s ] - real(r8), intent(in) :: u3m2(plev) ! Zonal wind [ m/s ] + real(r8), intent(inout) :: u3m2(plev) ! Zonal wind [ m/s ] real(r8), intent(in) :: v3m1(plev) ! Meridional wind [ m/s ] - real(r8), intent(in) :: v3m2(plev) ! Meridional wind [ m/s ] + real(r8), intent(inout) :: v3m2(plev) ! Meridional wind [ m/s ] real(r8), intent(inout) :: q3m1(plev,pcnst) ! Tracers [ kg/kg, #/kg ] real(r8), intent(inout) :: q3m2(plev,pcnst) ! Tracers [ kg/kg, #/kg ] @@ -156,6 +172,7 @@ subroutine forecast( lat , nlon , ztodt , & real(r8) vten_zadv(plev) ! Vertical advective forcing of v [ m/s/s ] real(r8) qten_zadv(plev,pcnst) ! Vertical advective forcing of tracers [ #/kg/s, kg/kg/s ] + ! --------------------------- ! ! For 'scm_relaxation' switch ! ! --------------------------- ! @@ -169,6 +186,88 @@ subroutine forecast( lat , nlon , ztodt , & real(r8) rslope ! [optional] slope for linear relaxation profile real(r8) rycept ! [optional] y-intercept for linear relaxtion profile + +!++jtb +! ------------------------------------ ! +! Quantities derived from Analyses ! +! ------------------------------------ ! +!======================================! + real(r8) dynfrcp(plev) ! Scaling factor for ana-derived tends + logical l_vectinv + real(r8) omega_ana(plev) ! Vertical pressure velocity [ Pa/s ] + real(r8) etad_ana(plev) ! "Eta dot" velocity [ Pa/s ] + real(r8) T_ana(plev), Q_ana(plev) , Tv_ana(plev) ! + real(r8) u_ana(plev), v_ana(plev) ! + real(r8) zeta_ana(plev) ! + real(r8) ps_ana + real(r8) T_ana_diag(plev), Q_ana_diag(plev) ! + real(r8) u_ana_diag(plev), v_ana_diag(plev) ! + ! ----------------------------------- ! + ! vertical advective tendencies ! + ! ----------------------------------- ! + real(r8) tten_vadv_ana(plev) ! Vertical advective forcing of t [ K/s ] + real(r8) uten_vadv_ana(plev) ! Vertical advective forcing of u [ m/s/s ] + real(r8) vten_vadv_ana(plev) ! Vertical advective forcing of v [ m/s/s ] + real(r8) qten_vadv_ana(plev) ! Vertical advective forcing of tracers [ #/kg/s, kg/kg/s ] + ! ------------------------------------- ! + ! Horizontal advective/other tendencies ! + ! ------------------------------------- ! + real(r8) uten_hadv_ana(plev) ! of u [ m/s/s ] + real(r8) vten_hadv_ana(plev) ! of v [ m/s/s ] + real(r8) uten_pfrc_ana(plev) ! of u [ m/s/s ] + real(r8) vten_pfrc_ana(plev) ! of v [ m/s/s ] + real(r8) uten_vort_ana(plev) ! of u [ m/s/s ] + real(r8) vten_vort_ana(plev) ! of v [ m/s/s ] + real(r8) tten_hadv_ana(plev) ! of t [ K/s ] + real(r8) qten_hadv_ana(plev) ! of tracers [ #/kg/s, kg/kg/s ] + + !---------------------------------! + ! Adiabatic compression tendency ! + !---------------------------------! + real(r8) tten_comp_ana(plev) ! of t [ K/s ] + + + real(r8) uten_keg_ana(plev) ! of u [ m/s/s ] + real(r8) uten_prg_ana(plev) ! of u [ m/s/s ] + real(r8) uten_phig_ana(plev) ! of u [ m/s/s ] + ! ------------------------------------------ ! + ! Direct dycore or ana tendencies or quants ! + ! Not recalculated. ! + ! (not usually available, ! + ! set=-9999 if missing ) ! + ! ------------------------------------------ ! + real(r8) tten_dycore_ana(plev) ! Total direct Ana forcing of t [ K/s ] + real(r8) vten_dycore_ana(plev) ! Total direct Ana forcing of v [ m/s/s ] + real(r8) uten_dycore_ana(plev) ! Total direct Ana forcing of u [ m/s/s ] + real(r8) omega_dycore_ana(plev) ! Omega direct from Ana/dycore (not recalc) [ Pa/s ] + ! ----------------------------------- ! + ! total recalc. "dycore" tendencies ! + ! ----------------------------------- ! + real(r8) omega_recalc_ana(plev) ! Omega from Ana/dycore (recalculated) [ Pa/s ] + real(r8) tten_totdyn_ana(plev) ! Total Ana forcing of t [ K/s ] + real(r8) uten_totdyn_ana(plev) ! Total Ana forcing of u [ m/s/s ] + real(r8) vten_totdyn_ana(plev) ! Total Ana forcing of v [ m/s/s ] + real(r8) qten_totdyn_ana(plev) ! Total Ana forcing of tracers [ #/kg/s, kg/kg/s ] + real(r8) fcoriol,uten_coriol(plev),vten_coriol(plev) + real(r8) ufcstm2(plev),vfcstm2(plev) + real(r8) ufcor_0(plev),vfcor_0(plev) + real(r8) uten_totdyn_anax(plev) ! Total Ana forcing of u [ m/s/s ] + real(r8) vten_totdyn_anax(plev) ! Total Ana forcing of v [ m/s/s ] + real(r8) tfw0, tfw1, tfw2, tftotw,ztodtn,AA + integer nsubdyn,nt,nstep_curr + +!+++ARH + !logical use_ana_iop +!---ARH + logical l_use_reconst_ttend ! use reconstructed T-tendency based on analysis + logical l_use_direct_ttend ! use T-tendency direct from dycore + + + l_use_reconst_ttend = .NOT.( scm_ana_direct_ttend ) + l_use_direct_ttend = .NOT.( l_use_reconst_ttend ) + +!--jtb + !+++ BPM check what we have: if (masterproc .and. is_first_step()) write(iulog,*) 'SCAM FORECAST REPORT: ' , & 'have_divq ', have_divq , & @@ -253,8 +352,122 @@ subroutine forecast( lat , nlon , ztodt , & ! = .false. : Use User-generated SCAM IOP file ! ! ------------------------------------------------------- ! - - if( use_camiop ) then +#ifdef SCAMNUDGERUN + !!! use_ana_iop needs to get into namelist!! !!!! +!+++ARH + !use_ana_iop=.TRUE. + !!use_ana_iop=.FALSE. +!---ARH + l_vectinv =.FALSE. + +!+++ARH + !if (use_ana_iop) then + if (scm_use_ana_iop) then +!---ARH + call get_ana_dynfrc_fv ( scmlon, scmlat , & + omega_ana, etad_ana, zeta_ana, & + t_ana , tv_ana , & + q_ana , & + u_ana , & + v_ana , & + ps_ana , & + uten_hadv_ana , & + vten_hadv_ana , & + uten_pfrc_ana , & + vten_pfrc_ana , & + uten_vort_ana , & + vten_vort_ana , & + qten_hadv_ana , & + tten_hadv_ana , & + uten_vadv_ana , & + vten_vadv_ana , & + tten_vadv_ana , & + qten_vadv_ana , & + tten_comp_ana , & + uten_keg_ana , & + uten_phig_ana , & + uten_prg_ana , & + uten_dycore_ana , & + vten_dycore_ana , & + tten_dycore_ana , & + omega_dycore_ana , & + omega_recalc_ana , & + u3m2, v3m2, t3m2, q3m2(:,1), & + u_ana_diag, v_ana_diag, t_ana_diag, q_ana_diag ) + else + ! set these to a "bad" value + omega_ana = HugeBad + etad_ana = HugeBad + zeta_ana = HugeBad + t_ana = HugeBad + tv_ana = HugeBad + q_ana = HugeBad + u_ana = HugeBad + v_ana = HugeBad + t_ana_diag = HugeBad + q_ana_diag = HugeBad + u_ana_diag = HugeBad + v_ana_diag = HugeBad + ps_ana = HugeBad + uten_hadv_ana = HugeBad + vten_hadv_ana = HugeBad + uten_pfrc_ana = HugeBad + vten_pfrc_ana = HugeBad + uten_vort_ana = HugeBad + vten_vort_ana = HugeBad + qten_hadv_ana = HugeBad + tten_hadv_ana = HugeBad + uten_vadv_ana = HugeBad + vten_vadv_ana = HugeBad + tten_vadv_ana = HugeBad + qten_vadv_ana = HugeBad + tten_comp_ana = HugeBad + uten_keg_ana = HugeBad + uten_phig_ana = HugeBad + uten_prg_ana = HugeBad + uten_dycore_ana = HugeBad + vten_dycore_ana = HugeBad + tten_dycore_ana = HugeBad + omega_dycore_ana = HugeBad + omega_recalc_ana = HugeBad + endif + + ! -------------------------------------------------------------- ! + ! Re-Calculate midpoint pressure levels if PS_ANA is reasonable ! + ! -------------------------------------------------------------- ! + if (ps_ana < 500000._r8 ) then + psm1=ps_ana + call plevs0( nlon, plon, plev, psm1, pintm1, pmidm1, pdelm1 ) + end if + if(l_vectinv) then + uten_totdyn_ana = uten_hadv_ana + uten_pfrc_ana + uten_vadv_ana + vten_totdyn_ana = vten_hadv_ana + vten_pfrc_ana + vten_vadv_ana + uten_totdyn_anax = uten_hadv_ana + uten_pfrc_ana + uten_vadv_ana + vten_totdyn_anax = vten_hadv_ana + vten_pfrc_ana + vten_vadv_ana + else + uten_totdyn_ana = uten_hadv_ana + uten_vort_ana + uten_pfrc_ana + uten_vadv_ana + vten_totdyn_ana = vten_hadv_ana + vten_vort_ana + vten_pfrc_ana + vten_vadv_ana + uten_totdyn_anax = uten_hadv_ana + uten_vort_ana + uten_pfrc_ana + uten_vadv_ana + vten_totdyn_anax = vten_hadv_ana + vten_vort_ana + vten_pfrc_ana + vten_vadv_ana + endif + + tten_totdyn_ana = tten_hadv_ana + tten_vadv_ana + tten_comp_ana + qten_totdyn_ana = qten_hadv_ana + qten_vadv_ana +#else +!+++ARH + !use_ana_iop=.FALSE. +!---ARH +#endif + +!++jtb + ! Need 3rd option 'use_ana_iop' + ! - suboption: use {u,v,t,q}ten_vadv_ana OR recalculate with etad_ana + ! - what about other species in q? + ! - we might want to calculate fu,fv using evolving (local) u's and v's + ! to allow geostrophic adjustment. +!--jtb + +if( use_camiop ) then do k = 1, plev tfcst(k) = t3m2(k) + ztodt * tten_phys(k) + ztodt * divt3d(k) ufcst(k) = u3m2(k) + ztodt * uten_phys(k) + ztodt * divu3d(k) @@ -269,8 +482,11 @@ subroutine forecast( lat , nlon , ztodt , & enddo enddo - else - +else ! when use_camiop =.FALSE. +!+++ARH + !if( .NOT.(use_ana_iop) ) then + if( .NOT.(scm_use_ana_iop) ) then +!---ARH ! ---------------------------------------------------------------------------- ! ! Compute 'omega'( wfldint ) at the interface from the value at the mid-point. ! ! SCAM-IOP file must provide omega at the mid-point not at the interface. ! @@ -403,19 +619,197 @@ subroutine forecast( lat , nlon , ztodt , & call endrun( subname//':: divq not on the dataset. Unable to forecast Humidity. Stopping') end if - do k = 1, plev - tfcst(k) = t3m2(k) + ztodt * ( tten_phys(k) + divt(k) + tten_zadv(k) ) - ufcst(k) = u3m2(k) + ztodt * ( uten_phys(k) + divu(k) + uten_zadv(k) ) - vfcst(k) = v3m2(k) + ztodt * ( vten_phys(k) + divv(k) + vten_zadv(k) ) - do m = 1, pcnst - qfcst(1,k,m) = q3m2(k,m) + ztodt * ( qten_phys(k,m) + divq(k,m) + qten_zadv(k,m) ) + + nstep_curr = get_nstep() + + do k = 1, plev + tfcst(k) = t3m2(k) + ztodt * ( tten_phys(k) + divt(k) + tten_zadv(k) ) + ufcst(k) = u3m2(k) + ztodt * ( uten_phys(k) + divu(k) + uten_zadv(k) ) + vfcst(k) = v3m2(k) + ztodt * ( vten_phys(k) + divv(k) + vten_zadv(k) ) + do m = 1, pcnst + qfcst(1,k,m) = q3m2(k,m) + ztodt * ( qten_phys(k,m) + divq(k,m) + qten_zadv(k,m) ) + enddo enddo - enddo + else + !------------------------------------- + ! This is the use_ana_iop=.TRUE. block + !------------------------------------- + + nstep_curr = get_nstep() + + if (is_first_step()) then + u3m2 = u_ana + v3m2 = v_ana + t3m2 = t_ana + q3m2(:,1) = q_ana + psm2 = ps_ana + endif + + + ! ----------------------------------------------------- + ! Applied tendencies are in two + ! categories: 1) physics (includes nudging); + ! and 2) dynamics. Dynamics tendencies are + ! grouped and then scaled by dynfrcp. This is + ! to allow removal of unreliable analysis driven + ! dynamics tendencies above some pressure, + ! typically <~ 10Pa. + !------------------------------------------------------ + dynfrcp(:) = 1._r8 + where( pmidm1 < 10._r8) ! changed from 10. Test. + dynfrcp = 0._r8 + end where + !------------------------------------------------------ + fcoriol = 2._r8 * OOmega * sin( scmlat * PI/180._r8 ) + uten_coriol = fcoriol * v3m2 + vten_coriol = -fcoriol * u3m2 + nsubdyn = 1 + vfcst = v3m2 + ufcst = u3m2 + ztodtn = ztodt/nsubdyn + do nt= 1, nsubdyn + do k = 1, plev + ufcst(k) = ufcst(k) + ztodtn * ( uten_phys(k) & + + dynfrcp(k) * & + ( uten_hadv_ana(k) + uten_vadv_ana(k) & + + uten_vort_ana(k) & + !! + fcoriol * vfcstm2(k) & + + uten_pfrc_ana(k) ) ) + vfcst(k) = vfcst(k) + ztodtn * ( vten_phys(k) & + + dynfrcp(k) * & + ( vten_hadv_ana(k) + vten_vadv_ana(k) & + + vten_vort_ana(k) & + !! - fcoriol * ufcstm2(k) & + + vten_pfrc_ana(k) ) ) + end do + ufcstm2 = ufcst + vfcstm2 = vfcst + end do + + + ufcor_0 = ufcst + vfcor_0 = vfcst + +#if 0 + ! Implicit formulation of Coriolis terms + nsubdyn = 1 + ztodtn = ztodt/nsubdyn + AA = 1._r8/(1._r8 + (ztodtn*fcoriol)**2 ) + do nt= 1, nsubdyn + do k = 1, plev + ufcst(k) = dynfrcp(k) * AA * ( ufcstm2(k) + ztodtn*fcoriol*vfcstm2(k) ) & + + (1._r8 - dynfrcp(k) )*ufcst(k) + vfcst(k) = dynfrcp(k) * AA * ( vfcstm2(k) - ztodtn*fcoriol*ufcstm2(k) ) & + + (1._r8 - dynfrcp(k) )*vfcst(k) + end do + ufcstm2 = ufcst + vfcstm2 = vfcst + end do + + uten_vort_ana = (ufcst - ufcor_0 )/ztodt + vten_vort_ana = (vfcst - vfcor_0 )/ztodt +#endif + + uten_totdyn_ana = uten_hadv_ana + uten_vort_ana + uten_pfrc_ana + uten_vadv_ana + vten_totdyn_ana = vten_hadv_ana + vten_vort_ana + vten_pfrc_ana + vten_vadv_ana + +#if 1 + !---------------------------- + ! Calculate "usual" T-tendencies from complete IOP-file anyway + !---------------------------- + ! ---------------------------------------------------------------------------- ! + ! Compute 'omega'( wfldint ) at the interface from the value at the mid-point. ! + ! SCAM-IOP file must provide omega at the mid-point not at the interface. ! + ! ---------------------------------------------------------------------------- ! + wfldint(1) = 0._r8 + do k = 2, plev + weight = ( pintm1(k) - pmidm1(k-1) ) / ( pmidm1(k) - pmidm1(k-1) ) + wfldint(k) = ( 1._r8 - weight ) * wfld(k-1) + weight * wfld(k) + enddo + wfldint(plevp) = 0._r8 + ! ------------------------------------------------------------ ! + ! Compute Eulerian compression heating due to vertical motion. ! + ! ------------------------------------------------------------ ! + do k = 1, plev + tten_comp_EUL(k) = wfld(k) * t3m1(k) * rair / ( cpair * pmidm1(k) ) + enddo + ! ---------------------------------------------------------------------------- ! + ! Compute Centered Eulerian vertical advective tendencies for all 't, u, v, q' ! + ! ---------------------------------------------------------------------------- ! + do k = 2, plev - 1 + fac = 1._r8 / ( 2.0_r8 * pdelm1(k) ) + tten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( t3m1(k+1) - t3m1(k) ) + wfldint(k) * ( t3m1(k) - t3m1(k-1) ) ) + end do + k = 1 + fac = 1._r8 / ( 2.0_r8 * pdelm1(k) ) + tten_zadv_EULc(k) = -fac * ( wfldint(k+1) * ( t3m1(k+1) - t3m1(k) ) ) + k = plev + fac = 1._r8 / ( 2.0_r8 * pdelm1(k) ) + tten_zadv_EULc(k) = -fac * ( wfldint(k) * ( t3m1(k) - t3m1(k-1) ) ) + !---------------------------------------- + ! Replace ERA-derived T-tendencies with + ! IOP-file derived T-tendencies + !---------------------------------------- + !!tten_vadv_ana(:) = tten_zadv_EULc(:) + !!tten_comp_ana(:) = tten_comp_EUL(:) + !!tten_hadv_ana(:) = divt(:) + !------------------- + ! For output + !-------------------- + tten_zadv(:) = tten_zadv_EULc(:) + !---------------------------- + ! End of Calculate "usual" T-tendencies from complete IOP-file anyway + !---------------------------- +#endif + + + + if (l_use_reconst_ttend) then + do k=1,plev + tfcst(k) = t3m2(k) + ztodt * ( tten_phys(k) & + + dynfrcp(k) * & + ( tten_hadv_ana(k) + tten_vadv_ana(k) & + + tten_comp_ana(k) ) ) + end do + end if + + if (l_use_direct_ttend) then + do k=1,plev + tfcst(k) = t3m2(k) + ztodt * ( tten_phys(k) & + + dynfrcp(k) * & + ( tten_dycore_ana(k) ) ) + end do + end if + + do k=1,plev + do m = 1, 1 + qfcst(1,k,m) = q3m2(k,m) + ztodt * ( qten_phys(k,m) & + + dynfrcp(k) * & + ( qten_hadv_ana(k) + qten_vadv_ana(k) ) ) + enddo + enddo + + ps = ps_ana + + write(*,*) " Nstep " ,nstep_curr + if (mod( nstep_curr,10)==0) then + !ufcst = 0.5*(ufcst+u3m1) + !vfcst = 0.5*(vfcst+v3m1) + endif + + ! Zero-out NON ana_iop diagnostics + ! ???? + + end if ! END use_ana_iop IF block + + ! This code is executed regardless of use_ana_iop value ! ------------------ ! ! Diagnostic Outputs ! ! ------------------ ! - + call outfld( 'TOBS' , tobs, plon, dummy_dyndecomp ) + call outfld( 'UOBS' , uobs, plon, dummy_dyndecomp ) + call outfld( 'VOBS' , vobs, plon, dummy_dyndecomp ) call outfld( 'TTEN_XYADV' , divt, plon, dummy_dyndecomp ) call outfld( 'UTEN_XYADV' , divu, plon, dummy_dyndecomp ) call outfld( 'VTEN_XYADV' , divv, plon, dummy_dyndecomp ) @@ -438,29 +832,35 @@ subroutine forecast( lat , nlon , ztodt , & call outfld( 'UTEN_ZADV' , uten_zadv, plon, dummy_dyndecomp ) call outfld( 'VTEN_ZADV' , vten_zadv, plon, dummy_dyndecomp ) call outfld( 'QVTEN_ZADV' , qten_zadv(:,1), plon, dummy_dyndecomp ) - call outfld( 'TTEN_ZADV' , vertdivt, plon, dummy_dyndecomp ) - call outfld( 'QVTEN_ZADV' , vertdivq(:,1), plon, dummy_dyndecomp ) + !call outfld( 'TTEN_ZADV' , vertdivt, plon, dummy_dyndecomp ) + !call outfld( 'QVTEN_ZADV' , vertdivq(:,1), plon, dummy_dyndecomp ) - call outfld( 'TTEN_PHYS' , tten_phys, plon, dummy ) - call outfld( 'UTEN_PHYS' , uten_phys, plon, dummy ) - call outfld( 'VTEN_PHYS' , vten_phys, plon, dummy ) - call outfld( 'QVTEN_PHYS' , qten_phys(:,1), plon, dummy ) + call outfld( 'TTEN_COMP_IOP', tten_comp_eul, plon, dummy_dyndecomp ) - endif + call outfld( 'TTEN_PHYS' , tten_phys, plon, dummy_dyndecomp ) + call outfld( 'UTEN_PHYS' , uten_phys, plon, dummy_dyndecomp ) + call outfld( 'VTEN_PHYS' , vten_phys, plon, dummy_dyndecomp ) + call outfld( 'QVTEN_PHYS' , qten_phys(:,1), plon, dummy_dyndecomp ) + + end if ! END of use_camiop IF BLOCK +!!!!#if 0 +!+++ARH + !if( .NOT.(use_ana_iop) ) then + if( .NOT.(scm_use_ana_iop) ) then +!---ARH ! ---------------------------------------------------------------- ! ! Used the SCAM-IOP-specified state instead of forecasted state ! ! at each time step if specified by the switch. ! ! If SCAM-IOP has 't,u,v,q' profile at a single initial time step. ! - ! ---------------------------------------------------------------- ! - + ! ---------------------------------------------------------------- ! if( scm_use_obs_T .and. have_t ) then do k = 1, plev tfcst(k) = tobs(k) enddo endif - if( scm_use_obs_uv .and. have_u .and. have_v ) then + if( scm_use_obs_uv .and. have_u .and. have_v ) then do k = 1, plev ufcst(k) = uobs(k) vfcst(k) = vobs(k) @@ -540,7 +940,9 @@ subroutine forecast( lat , nlon , ztodt , & call outfld( 'TRELAX' , relax_T , plon, dummy ) call outfld( 'QRELAX' , relax_q(1:plev,1) , plon, dummy ) call outfld( 'TAURELAX' , rtau , plon, dummy ) - +!!!#endif + end if ! END of 2nd use_ana_iop BLOCK (exec for use_ana_iop=.F.) + ! --------------------------------------------------------- ! ! Assign the final forecasted state to the output variables ! ! --------------------------------------------------------- ! @@ -548,15 +950,79 @@ subroutine forecast( lat , nlon , ztodt , & t3(1:plev) = tfcst(1:plev) u3(1:plev) = ufcst(1:plev) v3(1:plev) = vfcst(1:plev) - q3(1:plev,1:pcnst) = qfcst(1,1:plev,1:pcnst) - + +!+++ARH + !if (use_ana_iop) then + if (scm_use_ana_iop) then +!---ARH + q3(1:plev,1:1) = qfcst(1,1:plev,1:1) + else + q3(1:plev,1:pcnst) = qfcst(1,1:plev,1:pcnst) + endif + tdiff(1:plev) = t3(1:plev) - tobs(1:plev) qdiff(1:plev) = q3(1:plev,1) - qobs(1:plev) + call outfld( 'QDIFF' , qdiff, plon, dummy_dyndecomp ) call outfld( 'TDIFF' , tdiff, plon, dummy_dyndecomp ) + +#ifdef SCAMNUDGERUN + call outfld( 'OMEGA_IOP' , wfld, plon, dummy_dyndecomp ) + call outfld( 'OMEGA_ANA' , omega_ana, plon, dummy_dyndecomp ) + call outfld( 'ETAD_ANA' , etad_ana, plon, dummy_dyndecomp ) + call outfld( 'ZETA_ANA' , zeta_ana, plon, dummy_dyndecomp ) + call outfld( 'T_ANA' , T_ana_diag, plon, dummy_dyndecomp ) + call outfld( 'Q_ANA' , Q_ana_diag, plon, dummy_dyndecomp ) + call outfld( 'TV_ANA' , Tv_ana, plon, dummy_dyndecomp ) + call outfld( 'U_ANA' , U_ana_diag, plon, dummy_dyndecomp ) + call outfld( 'V_ANA' , V_ana_diag, plon, dummy_dyndecomp ) + + call outfld( 'UTEN_CORIOL' , uten_coriol, plon, dummy_dyndecomp ) + call outfld( 'VTEN_CORIOL' , vten_coriol, plon, dummy_dyndecomp ) + + call outfld( 'UTEN_TOTDYN_ANA' , uten_totdyn_ana, plon, dummy_dyndecomp ) + call outfld( 'VTEN_TOTDYN_ANA' , vten_totdyn_ana, plon, dummy_dyndecomp ) + call outfld( 'TTEN_TOTDYN_ANA' , tten_totdyn_ana, plon, dummy_dyndecomp ) + call outfld( 'QTEN_TOTDYN_ANA' , qten_totdyn_ana, plon, dummy_dyndecomp ) + + call outfld( 'UTEN_TOTDYN_ANAR' , uten_totdyn_anax, plon, dummy_dyndecomp ) + call outfld( 'VTEN_TOTDYN_ANAR' , vten_totdyn_anax, plon, dummy_dyndecomp ) + + call outfld( 'UTEN_DYCORE_ANA' , uten_dycore_ana, plon, dummy_dyndecomp ) + call outfld( 'VTEN_DYCORE_ANA' , vten_dycore_ana, plon, dummy_dyndecomp ) + call outfld( 'TTEN_DYCORE_ANA' , tten_dycore_ana, plon, dummy_dyndecomp ) + call outfld( 'OMEGA_DYCORE_ANA', omega_dycore_ana, plon, dummy_dyndecomp ) + call outfld( 'OMEGA_RECALC_ANA', omega_recalc_ana, plon, dummy_dyndecomp ) + + call outfld( 'UTEN_HADV_ANA' , uten_hadv_ana, plon, dummy_dyndecomp ) + call outfld( 'UTEN_VADV_ANA' , uten_vadv_ana, plon, dummy_dyndecomp ) + call outfld( 'UTEN_VORT_ANA' , uten_vort_ana, plon, dummy_dyndecomp ) + call outfld( 'UTEN_KEG_ANA' , uten_keg_ana, plon, dummy_dyndecomp ) + call outfld( 'UTEN_PFRC_ANA' , uten_pfrc_ana, plon, dummy_dyndecomp ) + call outfld( 'UTEN_PRG_ANA' , uten_prg_ana, plon, dummy_dyndecomp ) + call outfld( 'UTEN_PHIG_ANA' , uten_phig_ana, plon, dummy_dyndecomp ) + + call outfld( 'VTEN_HADV_ANA' , vten_hadv_ana, plon, dummy_dyndecomp ) + call outfld( 'VTEN_VADV_ANA' , vten_vadv_ana, plon, dummy_dyndecomp ) + call outfld( 'VTEN_VORT_ANA' , vten_vort_ana, plon, dummy_dyndecomp ) + call outfld( 'VTEN_PFRC_ANA' , vten_pfrc_ana, plon, dummy_dyndecomp ) + + call outfld( 'TTEN_HADV_ANA' , tten_hadv_ana, plon, dummy_dyndecomp ) + call outfld( 'TTEN_VADV_ANA' , tten_vadv_ana, plon, dummy_dyndecomp ) + call outfld( 'TTEN_COMP_ANA' , tten_comp_ana, plon, dummy_dyndecomp ) + + call outfld( 'QTEN_HADV_ANA' , qten_hadv_ana, plon, dummy_dyndecomp ) + call outfld( 'QTEN_VADV_ANA' , qten_vadv_ana, plon, dummy_dyndecomp ) + + if (have_u) call outfld( 'U_IOP' , uobs, plon, dummy_dyndecomp ) + if (have_u) call outfld( 'V_IOP' , vobs, plon, dummy_dyndecomp ) + +#endif return end subroutine forecast - end module scmforecast + + +end module scmforecast diff --git a/src/physics/cam/check_energy.F90 b/src/physics/cam/check_energy.F90 index 3d0232b356..b9290e7319 100644 --- a/src/physics/cam/check_energy.F90 +++ b/src/physics/cam/check_energy.F90 @@ -66,6 +66,9 @@ module check_energy integer :: teout_idx = 0 ! teout index in physics buffer integer :: dtcore_idx = 0 ! dtcore index in physics buffer +!+++ARH + integer :: dqcore_idx = 0 +!---ARH integer :: ducore_idx = 0 ! ducore index in physics buffer integer :: dvcore_idx = 0 ! dvcore index in physics buffer @@ -139,6 +142,9 @@ subroutine check_energy_register() call pbuf_add_field('TEOUT', 'global',dtype_r8 , (/pcols,dyn_time_lvls/), teout_idx) call pbuf_add_field('DTCORE','global',dtype_r8, (/pcols,pver,dyn_time_lvls/),dtcore_idx) +!+++ARH + call pbuf_add_field('DQCORE','global',dtype_r8, (/pcols,pver,dyn_time_lvls/),dqcore_idx) +!---ARH call pbuf_add_field('DUCORE','global',dtype_r8, (/pcols,pver,dyn_time_lvls/),ducore_idx) call pbuf_add_field('DVCORE','global',dtype_r8, (/pcols,pver,dyn_time_lvls/),dvcore_idx) if(is_subcol_on()) then @@ -199,12 +205,18 @@ subroutine check_energy_init() call addfld('TEFIX', horiz_only, 'A', 'J/m2', 'Total energy after fixer') call addfld('EFIX', horiz_only, 'A', 'W/m2', 'Effective sensible heat flux due to energy fixer') call addfld('DTCORE', (/ 'lev' /), 'A', 'K/s' , 'T tendency due to dynamical core') +!+++ARH + call addfld('DQCORE', (/ 'lev' /), 'A', 'kg/kg/s' , 'Q tendency due to dynamical core') +!---ARH if ( history_budget ) then call add_default ('DTCORE', history_budget_histfile_num, ' ') end if if ( history_waccm ) then call add_default ('DTCORE', 1, ' ') +!+++ARH + call add_default ('DQCORE', history_budget_histfile_num, ' ') +!---ARH end if end subroutine check_energy_init diff --git a/src/physics/cam/clubb_intr.F90 b/src/physics/cam/clubb_intr.F90 index fe263a70c7..6a9d9d5d1b 100644 --- a/src/physics/cam/clubb_intr.F90 +++ b/src/physics/cam/clubb_intr.F90 @@ -1,3 +1,4 @@ +#undef CLUBBTOP_OFF module clubb_intr !----------------------------------------------------------------------------------------------------- ! @@ -29,12 +30,32 @@ module clubb_intr use zm_conv_intr, only: zmconv_microp #ifdef CLUBB_SGS use clubb_api_module, only: pdf_parameter, implicit_coefs_terms - use clubb_api_module, only: clubb_config_flags_type + use clubb_api_module, only: clubb_config_flags_type, grid, stats, nu_vertical_res_dep + use clubb_api_module, only: nparams use clubb_mf, only: do_clubb_mf, do_clubb_mf_diag use cloud_fraction, only: dp1, dp2 #endif implicit none +#ifdef CLUBB_SGS + ! Variables that contains all the statistics + + type (stats), target, save :: stats_zt(pcols), & ! stats_zt grid + stats_zm(pcols), & ! stats_zm grid + stats_rad_zt(pcols), & ! stats_rad_zt grid + stats_rad_zm(pcols), & ! stats_rad_zm grid + stats_sfc(pcols) ! stats_sfc + +!$omp threadprivate(stats_zt, stats_zm, stats_rad_zt, stats_rad_zm, stats_sfc) + + type(grid), target :: dummy_gr + type(nu_vertical_res_dep), private, save :: dummy_nu_vert_res_dep ! Vertical resolution dependent nu values + real(r8), private, save :: dummy_lmin + +!$omp threadprivate(dummy_gr) + +#endif + private save @@ -46,9 +67,10 @@ module clubb_intr #ifdef CLUBB_SGS ! This utilizes CLUBB specific variables in its interface stats_init_clubb, & - init_clubb_config_flags, & -#endif + stats_zt, stats_zm, stats_sfc, & + stats_rad_zt, stats_rad_zm, & stats_end_timestep_clubb, & +#endif clubb_readnl, & clubb_init_cnst, & clubb_implements_cnst @@ -63,6 +85,7 @@ module clubb_intr #ifdef CLUBB_SGS type(clubb_config_flags_type), public :: clubb_config_flags + real(r8), dimension(nparams), public :: clubb_params ! Adjustable CLUBB parameters (C1, C2 ...) #endif ! ------------ ! @@ -73,7 +96,9 @@ module clubb_intr grid_type = 3, & ! The 2 option specifies stretched thermodynamic levels hydromet_dim = 0 ! The hydromet array in SAM-CLUBB is currently 0 elements - real(r8), parameter, dimension(0) :: & + ! Even though sclr_dim is set to 0, the dimension here is set to 1 to prevent compiler errors + ! See github ticket larson-group/cam#133 for details + real(r8), parameter, dimension(1) :: & sclr_tol = 1.e-8_r8 ! Total water in kg/kg character(len=6) :: saturation_equation @@ -99,6 +124,7 @@ module clubb_intr rtpthlp_const = 0.01_r8 ! Constant to add to rtpthlp when moments are advected real(r8), parameter :: unset_r8 = huge(1.0_r8) + integer, parameter :: unset_i = huge(1) ! Commonly used temperature for the melting temp of ice crystals [K] real(r8), parameter :: meltpt_temp = 268.15_r8 @@ -125,10 +151,25 @@ module clubb_intr real(r8) :: clubb_c11 = unset_r8 real(r8) :: clubb_c11b = unset_r8 real(r8) :: clubb_c14 = unset_r8 + real(r8) :: clubb_C_wp3_pr_turb = unset_r8 + real(r8) :: clubb_c_K1 = unset_r8 + real(r8) :: clubb_c_K2 = unset_r8 + real(r8) :: clubb_nu2 = unset_r8 + real(r8) :: clubb_c_K8 = unset_r8 real(r8) :: clubb_c_K9 = unset_r8 real(r8) :: clubb_nu9 = unset_r8 real(r8) :: clubb_c_K10 = unset_r8 real(r8) :: clubb_c_K10h = unset_r8 + real(r8) :: clubb_C_invrs_tau_bkgnd = unset_r8 + real(r8) :: clubb_C_invrs_tau_sfc = unset_r8 + real(r8) :: clubb_C_invrs_tau_shear = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2 = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2_wp2 = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2_xp2 = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2_wpxp = unset_r8 + real(r8) :: clubb_C_invrs_tau_N2_clear_wp3 = unset_r8 + real(r8) :: clubb_C_uu_shr = unset_r8 + real(r8) :: clubb_C_uu_buoy = unset_r8 real(r8) :: clubb_gamma_coef = unset_r8 real(r8) :: clubb_gamma_coefb = unset_r8 real(r8) :: clubb_beta = unset_r8 @@ -137,31 +178,129 @@ module clubb_intr real(r8) :: clubb_mult_coef = unset_r8 real(r8) :: clubb_Skw_denom_coef = unset_r8 real(r8) :: clubb_skw_max_mag = unset_r8 - real(r8) :: clubb_up2_vp2_factor = unset_r8 + real(r8) :: clubb_up2_sfc_coef = unset_r8 real(r8) :: clubb_C_wp2_splat = unset_r8 real(r8) :: clubb_wpxp_L_thresh = unset_r8 real(r8) :: clubb_detliq_rad = unset_r8 real(r8) :: clubb_detice_rad = unset_r8 real(r8) :: clubb_detphase_lowtemp = unset_r8 - logical :: clubb_l_brunt_vaisala_freq_moist = .false. - logical :: clubb_l_call_pdf_closure_twice = .false. - logical :: clubb_l_damp_wp3_Skw_squared = .false. - logical :: clubb_l_min_wp2_from_corr_wx = .false. - logical :: clubb_l_min_xp2_from_corr_wx = .false. - logical :: clubb_l_predict_upwp_vpwp = .false. - logical :: clubb_l_rcm_supersat_adj = .false. - logical :: clubb_l_stability_correct_tau_zm = .false. - logical :: clubb_l_trapezoidal_rule_zt = .false. - logical :: clubb_l_trapezoidal_rule_zm = .false. - logical :: clubb_l_upwind_xpyp_ta = .false. - logical :: clubb_l_use_C7_Richardson = .false. - logical :: clubb_l_use_C11_Richardson = .false. - logical :: clubb_l_use_cloud_cover = .false. - logical :: clubb_l_use_thvm_in_bv_freq = .false. - logical :: clubb_l_vert_avg_closure = .false. - logical :: clubb_l_diag_Lscale_from_tau = .false. - logical :: clubb_l_damp_wp2_using_em = .false. + + integer :: & + clubb_iiPDF_type, & ! Selected option for the two-component normal + ! (double Gaussian) PDF type to use for the w, rt, + ! and theta-l (or w, chi, and eta) portion of + ! CLUBB's multivariate, two-component PDF. + clubb_ipdf_call_placement = unset_i ! Selected option for the placement of the call to + ! CLUBB's PDF. + + logical :: & + clubb_l_use_precip_frac, & ! Flag to use precipitation fraction in KK microphysics. The + ! precipitation fraction is automatically set to 1 when this + ! flag is turned off. + clubb_l_predict_upwp_vpwp, & ! Flag to predict and along with and + ! alongside the advancement of , , , + ! , , and in subroutine + ! advance_xm_wpxp. Otherwise, and are still + ! approximated by eddy diffusivity when and are + ! advanced in subroutine advance_windm_edsclrm. + clubb_l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping + ! the overall correlation of w and x (w and rt, as well as w + ! and theta-l) within the limits of -max_mag_correlation_flux + ! to max_mag_correlation_flux. + clubb_l_min_xp2_from_corr_wx, & ! Flag to base the threshold minimum value of xp2 (rtp2 and + ! thlp2) on keeping the overall correlation of w and x within + ! the limits of -max_mag_correlation_flux to + ! max_mag_correlation_flux. + clubb_l_C2_cloud_frac, & ! Flag to use cloud fraction to adjust the value of the + ! turbulent dissipation coefficient, C2. + clubb_l_diffuse_rtm_and_thlm, & ! Diffuses rtm and thlm + clubb_l_stability_correct_Kh_N2_zm, & ! Divides Kh_N2_zm by a stability factor + clubb_l_calc_thlp2_rad, & ! Include the contribution of radiation to thlp2 + clubb_l_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent or mean advection terms. It + ! affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, & + ! sclrpthlp. + clubb_l_upwind_xm_ma, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent or mean advection terms. It + ! affects rtm, thlm, sclrm, um and vm. + clubb_l_uv_nudge, & ! For wind speed nudging. + clubb_l_rtm_nudge, & ! For rtm nudging + clubb_l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. + ! TKE = 1/2 (u'^2 + v'^2 + w'^2) + clubb_l_vert_avg_closure, & ! Use 2 calls to pdf_closure and the trapezoidal rule to + ! compute the varibles that are output from high order + ! closure + clubb_l_trapezoidal_rule_zt, & ! If true, the trapezoidal rule is called for the + ! thermodynamic-level variables output from pdf_closure. + clubb_l_trapezoidal_rule_zm, & ! If true, the trapezoidal rule is called for three + ! momentum-level variables - wpthvp, thlpthvp, and rtpthvp - + ! output from pdf_closure. + clubb_l_call_pdf_closure_twice, & ! This logical flag determines whether or not to call + ! subroutine pdf_closure twice. If true, pdf_closure is + ! called first on thermodynamic levels and then on momentum + ! levels so that each variable is computed on its native + ! level. If false, pdf_closure is only called on + ! thermodynamic levels, and variables which belong on + ! momentum levels are interpolated. + clubb_l_standard_term_ta, & ! Use the standard discretization for the turbulent advection + ! terms. Setting to .false. means that a_1 and a_3 are + ! pulled outside of the derivative in + ! advance_wp2_wp3_module.F90 and in + ! advance_xp2_xpyp_module.F90. + clubb_l_partial_upwind_wp3, & ! Flag to use an "upwind" discretization rather + ! than a centered discretization for the portion + ! of the wp3 turbulent advection term for ADG1 + ! that is linearized in terms of wp3. + ! (Requires ADG1 PDF and clubb_l_standard_term_ta). + clubb_l_godunov_upwind_wpxp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent advection terms. + ! It affects wpxp only. + clubb_l_godunov_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind + ! differencing approximation rather than a centered + ! differencing for turbulent advection terms. It affects + ! xpyp only. + clubb_l_use_cloud_cover, & ! Use cloud_cover and rcm_in_layer to help boost cloud_frac + ! and rcm to help increase cloudiness at coarser grid + ! resolutions. + clubb_l_diagnose_correlations, & ! Diagnose correlations instead of using fixed ones + clubb_l_calc_w_corr, & ! Calculate the correlations between w and the hydrometeors + clubb_l_const_Nc_in_cloud, & ! Use a constant cloud droplet conc. within cloud (K&K) + clubb_l_fix_w_chi_eta_correlations, & ! Use a fixed correlation for s and t Mellor(chi/eta) + clubb_l_stability_correct_tau_zm, & ! Use tau_N2_zm instead of tau_zm in wpxp_pr1 stability + ! correction + clubb_l_damp_wp2_using_em, & ! In wp2 equation, use a dissipation formula of + ! -(2/3)*em/tau_zm, as in Bougeault (1981) + clubb_l_do_expldiff_rtm_thlm, & ! Diffuse rtm and thlm explicitly + clubb_l_Lscale_plume_centered, & ! Alternate that uses the PDF to compute the perturbed values + clubb_l_diag_Lscale_from_tau, & ! First diagnose dissipation time tau, and then diagnose the + ! mixing length scale as Lscale = tau * tke + clubb_l_use_C7_Richardson, & ! Parameterize C7 based on Richardson number + clubb_l_use_C11_Richardson, & ! Parameterize C11 and C16 based on Richardson number + clubb_l_use_shear_Richardson, & ! Use shear in the calculation of Richardson number + clubb_l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in + ! saturated atmospheres (from Durran and Klemp, 1982) + clubb_l_use_thvm_in_bv_freq, & ! Use thvm in the calculation of Brunt-Vaisala frequency + clubb_l_rcm_supersat_adj, & ! Add excess supersaturated vapor to cloud water + clubb_l_lmm_stepping, & ! Apply Linear Multistep Method (LMM) Stepping + clubb_l_e3sm_config, & ! Run model with E3SM settings + clubb_l_vary_convect_depth, & ! Flag used to calculate convective velocity using + ! a variable estimate of layer depth based on the depth + ! over which wpthlp is positive near the ground when true + ! More information can be found by + ! Looking at issue #905 on the clubb repo + clubb_l_use_tke_in_wp3_pr_turb_term,& ! Use TKE formulation for wp3 pr_turb term + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Use TKE in eddy diffusion for wp2 and wp3 + clubb_l_smooth_Heaviside_tau_wpxp, & ! Use smooth Heaviside 'Peskin' in computation of invrs_tau + clubb_l_single_C2_Skw, & ! Use a single Skewness dependent C2 for rtp2, thlp2, and + ! rtpthlp + clubb_l_damp_wp3_Skw_squared, & ! Set damping on wp3 to use Skw^2 rather than Skw^4 + clubb_l_prescribed_avg_deltaz, & ! used in adj_low_res_nu. If .true., avg_deltaz = deltaz + clubb_l_update_pressure ! Flag for having CLUBB update pressure and exner + ! Constant parameters logical, parameter, private :: & l_implemented = .true., & ! Implemented in a host model (always true) @@ -173,15 +312,10 @@ module clubb_intr logical :: lq(pcnst) logical :: prog_modal_aero logical :: do_rainturb - logical :: do_expldiff logical :: clubb_do_adv logical :: clubb_do_liqsupersat = .false. logical :: clubb_do_energyfix = .true. logical :: history_budget - - logical :: clubb_l_lscale_plume_centered - logical :: clubb_l_use_ice_latent - integer :: history_budget_histfile_num integer :: edsclr_dim ! Number of scalars to transport in CLUBB integer :: offset @@ -212,6 +346,16 @@ module clubb_intr rtpthvp_idx, & ! moisture buoyancy correlation thlpthvp_idx, & ! temperature buoyancy correlation sclrpthvp_idx, & ! passive scalar buoyancy correlation + wp2rtp_idx, & ! w'^2 rt' + wp2thlp_idx, & ! w'^2 thl' + uprcp_idx, & ! < u' r_c' > + vprcp_idx, & ! < v' r_c' > + rc_coef_idx, & ! Coefficient of X'r_c' in Eq. (34) + wp4_idx, & ! w'^4 + wpup2_idx, & ! w'u'^2 + wpvp2_idx, & ! w'v'^2 + wp2up2_idx, & ! w'^2 u'^2 + wp2vp2_idx, & ! w'^2 v'^2 cloud_frac_idx, & ! CLUBB's cloud fraction cld_idx, & ! Cloud fraction concld_idx, & ! Convective cloud fraction @@ -249,6 +393,13 @@ module clubb_intr wpthlp_mc_zt_idx, & rtpthlp_mc_zt_idx + integer :: & ! added pbuf fields for clubb to have restart bfb when ipdf_call_placement=2 + pdf_zm_w_1_idx, & + pdf_zm_w_2_idx, & + pdf_zm_varnce_w_1_idx, & + pdf_zm_varnce_w_2_idx, & + pdf_zm_mixt_frac_idx + integer, public :: & ixthlp2 = 0, & ixwpthlp = 0, & @@ -281,8 +432,10 @@ module clubb_intr #ifdef CLUBB_SGS type(pdf_parameter), target, allocatable, public, protected :: & - pdf_params_chnk(:,:) ! PDF parameters (thermo. levs.) [units vary] - type(pdf_parameter), target, allocatable :: pdf_params_zm_chnk(:,:) ! PDF parameters on momentum levs. [units vary] + pdf_params_chnk(:) ! PDF parameters (thermo. levs.) [units vary] + + type(pdf_parameter), target, allocatable :: pdf_params_zm_chnk(:) ! PDF parameters on momentum levs. [units vary] + type(implicit_coefs_terms), target, allocatable :: pdf_implicit_coefs_terms_chnk(:,:) ! PDF impl. coefs. & expl. terms [units vary] #endif @@ -384,9 +537,19 @@ subroutine clubb_register_cam( ) call pbuf_add_field('RTPTHVP', 'physpkg', dtype_r8, (/pcols,pverp/), rtpthvp_idx) call pbuf_add_field('THLPTHVP', 'physpkg', dtype_r8, (/pcols,pverp/), thlpthvp_idx) call pbuf_add_field('CLOUD_FRAC', 'physpkg', dtype_r8, (/pcols,pverp/), cloud_frac_idx) - call pbuf_add_field('ISS_FRAC', 'physpkg', dtype_r8, (/pcols,pverp/), ice_supersat_idx) + call pbuf_add_field('ISS_FRAC', 'physpkg', dtype_r8, (/pcols,pverp/), ice_supersat_idx) call pbuf_add_field('RCM', 'physpkg', dtype_r8, (/pcols,pverp/), rcm_idx) call pbuf_add_field('ZTODT', 'physpkg', dtype_r8, (/pcols/), ztodt_idx) + call pbuf_add_field('WP2RTP', 'global', dtype_r8, (/pcols,pverp/), wp2rtp_idx) + call pbuf_add_field('WP2THLP', 'global', dtype_r8, (/pcols,pverp/), wp2thlp_idx) + call pbuf_add_field('UPRCP', 'global', dtype_r8, (/pcols,pverp/), uprcp_idx) + call pbuf_add_field('VPRCP', 'global', dtype_r8, (/pcols,pverp/), vprcp_idx) + call pbuf_add_field('RC_COEF', 'global', dtype_r8, (/pcols,pverp/), rc_coef_idx) + call pbuf_add_field('WP4', 'global', dtype_r8, (/pcols,pverp/), wp4_idx) + call pbuf_add_field('WPUP2', 'global', dtype_r8, (/pcols,pverp/), wpup2_idx) + call pbuf_add_field('WPVP2', 'global', dtype_r8, (/pcols,pverp/), wpvp2_idx) + call pbuf_add_field('WP2UP2', 'global', dtype_r8, (/pcols,pverp/), wp2up2_idx) + call pbuf_add_field('WP2VP2', 'global', dtype_r8, (/pcols,pverp/), wp2vp2_idx) ! For SILHS microphysical covariance contributions call pbuf_add_field('rtp2_mc_zt', 'global', dtype_r8, (/pcols,pverp/), rtp2_mc_zt_idx) @@ -395,6 +558,12 @@ subroutine clubb_register_cam( ) call pbuf_add_field('wpthlp_mc_zt','global',dtype_r8, (/pcols,pverp/), wpthlp_mc_zt_idx) call pbuf_add_field('rtpthlp_mc_zt','global',dtype_r8,(/pcols,pverp/), rtpthlp_mc_zt_idx) + call pbuf_add_field('pdf_zm_w_1', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_1_idx) + call pbuf_add_field('pdf_zm_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_w_2_idx) + call pbuf_add_field('pdf_zm_var_w_1', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_varnce_w_1_idx) + call pbuf_add_field('pdf_zm_var_w_2', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_varnce_w_2_idx) + call pbuf_add_field('pdf_zm_mixt_frac', 'global', dtype_r8, (/pcols,pverp,dyn_time_lvls/), pdf_zm_mixt_frac_idx) + #endif end subroutine clubb_register_cam @@ -510,9 +679,14 @@ subroutine clubb_readnl(nlfile) use namelist_utils, only: find_group_name use units, only: getunit, freeunit use cam_abortutils, only: endrun - use clubb_api_module, only: l_stats, l_output_rad_files - use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical, mpi_real8 + use spmd_utils, only: mpicom, mstrid=>masterprocid, mpi_logical, mpi_real8, & + mpi_integer use clubb_mf, only: clubb_mf_readnl + + use clubb_api_module, only: & + set_default_clubb_config_flags_api, & ! Procedure(s) + initialize_clubb_config_flags_type_api, & + l_stats, l_output_rad_files #endif character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -521,33 +695,44 @@ subroutine clubb_readnl(nlfile) character(len=*), parameter :: sub = 'clubb_readnl' - logical :: clubb_history, clubb_rad_history, clubb_cloudtop_cooling, clubb_rainevap_turb, & - clubb_expldiff ! Stats enabled (T/F) + logical :: clubb_history = .false., clubb_rad_history = .false. ! Stats enabled (T/F) + logical :: clubb_cloudtop_cooling = .false., clubb_rainevap_turb = .false. integer :: iunit, read_status, ierr - namelist /clubb_his_nl/ clubb_history, clubb_rad_history - namelist /clubbpbl_diff_nl/ clubb_cloudtop_cooling, clubb_rainevap_turb, clubb_expldiff, & - clubb_do_adv, clubb_timestep, & - clubb_rnevap_effic,clubb_do_icesuper - namelist /clubb_params_nl/ clubb_c1, clubb_c1b, clubb_c11, clubb_c11b, clubb_c14, clubb_mult_coef, clubb_gamma_coef, & + namelist /clubbpbl_diff_nl/ clubb_cloudtop_cooling, clubb_rainevap_turb, clubb_do_adv, clubb_timestep, & + clubb_rnevap_effic, clubb_do_icesuper + namelist /clubb_params_nl/ clubb_c1, clubb_c1b, clubb_c11, clubb_c11b, clubb_c14, & + clubb_C_wp3_pr_turb, clubb_mult_coef, clubb_gamma_coef, & clubb_c_K10, clubb_c_K10h, clubb_beta, clubb_C2rt, clubb_C2thl, & - clubb_C2rtthl, clubb_C8, clubb_C8b, clubb_C7, clubb_C7b, clubb_Skw_denom_coef, & + clubb_C2rtthl, clubb_C8, clubb_C8b, clubb_C7, clubb_C7b, clubb_Skw_denom_coef, & clubb_c6rt, clubb_c6rtb, clubb_c6rtc, clubb_c6thl, clubb_c6thlb, clubb_c6thlc, & - clubb_C4, clubb_c_K9, clubb_nu9, clubb_C_wp2_splat, clubb_wpxp_L_thresh, & + clubb_C4, clubb_C_uu_shr, clubb_C_uu_buoy, & + clubb_c_K1, clubb_c_K2, clubb_nu2, clubb_c_K8, & + clubb_c_K9, clubb_nu9, clubb_C_wp2_splat, clubb_wpxp_L_thresh, & clubb_lambda0_stability_coef, clubb_l_lscale_plume_centered, & - clubb_l_use_ice_latent, clubb_do_liqsupersat, clubb_do_energyfix,& + clubb_do_liqsupersat, clubb_do_energyfix,& clubb_lmin_coef,clubb_skw_max_mag, clubb_l_stability_correct_tau_zm, & - clubb_gamma_coefb, clubb_up2_vp2_factor, clubb_detliq_rad, clubb_detice_rad, & - clubb_detphase_lowtemp, & - clubb_l_use_C7_Richardson, clubb_l_use_C11_Richardson, & + clubb_gamma_coefb, clubb_up2_sfc_coef, clubb_detliq_rad, clubb_detice_rad, & + clubb_detphase_lowtemp, clubb_l_do_expldiff_rtm_thlm, & + clubb_C_invrs_tau_bkgnd, clubb_C_invrs_tau_sfc, clubb_C_invrs_tau_shear, & + clubb_C_invrs_tau_N2, clubb_C_invrs_tau_N2_wp2, clubb_C_invrs_tau_N2_xp2, & + clubb_C_invrs_tau_N2_wpxp, clubb_C_invrs_tau_N2_clear_wp3, & + clubb_ipdf_call_placement, clubb_l_predict_upwp_vpwp, & + clubb_l_min_wp2_from_corr_wx, clubb_l_min_xp2_from_corr_wx, & + clubb_l_upwind_xpyp_ta, clubb_l_vert_avg_closure, & + clubb_l_trapezoidal_rule_zt, clubb_l_trapezoidal_rule_zm, & + clubb_l_call_pdf_closure_twice, clubb_l_godunov_upwind_wpxp_ta, & + clubb_l_godunov_upwind_xpyp_ta, clubb_l_use_cloud_cover, & + clubb_l_damp_wp2_using_em, & + clubb_l_diag_Lscale_from_tau, clubb_l_use_C7_Richardson, & + clubb_l_use_C11_Richardson, clubb_l_use_shear_Richardson, & clubb_l_brunt_vaisala_freq_moist, clubb_l_use_thvm_in_bv_freq, & clubb_l_rcm_supersat_adj, clubb_l_damp_wp3_Skw_squared, & - clubb_l_predict_upwp_vpwp, clubb_l_min_wp2_from_corr_wx, & - clubb_l_min_xp2_from_corr_wx, clubb_l_upwind_xpyp_ta, clubb_l_vert_avg_closure, & - clubb_l_trapezoidal_rule_zt, clubb_l_trapezoidal_rule_zm, & - clubb_l_call_pdf_closure_twice, clubb_l_use_cloud_cover, & - clubb_l_diag_Lscale_from_tau, clubb_l_damp_wp2_using_em + clubb_l_lmm_stepping, & + clubb_l_e3sm_config, & + clubb_l_use_tke_in_wp3_pr_turb_term, clubb_l_use_tke_in_wp2_wp3_K_dfsn, & + clubb_l_smooth_Heaviside_tau_wpxp !----- Begin Code ----- @@ -557,10 +742,55 @@ subroutine clubb_readnl(nlfile) l_output_rad_files = .false. ! Initialize to false do_cldcool = .false. ! Initialize to false do_rainturb = .false. ! Initialize to false - do_expldiff = .false. ! Initialize to false - - clubb_l_lscale_plume_centered = .false. ! Initialize to false! - clubb_l_use_ice_latent = .false. ! Initialize to false! + + ! Initialize namelist variables to clubb defaults + call set_default_clubb_config_flags_api( clubb_iiPDF_type, & ! Out + clubb_ipdf_call_placement, & ! Out + clubb_l_use_precip_frac, & ! Out + clubb_l_predict_upwp_vpwp, & ! Out + clubb_l_min_wp2_from_corr_wx, & ! Out + clubb_l_min_xp2_from_corr_wx, & ! Out + clubb_l_C2_cloud_frac, & ! Out + clubb_l_diffuse_rtm_and_thlm, & ! Out + clubb_l_stability_correct_Kh_N2_zm, & ! Out + clubb_l_calc_thlp2_rad, & ! Out + clubb_l_upwind_xpyp_ta, & ! Out + clubb_l_upwind_xm_ma, & ! Out + clubb_l_uv_nudge, & ! Out + clubb_l_rtm_nudge, & ! Out + clubb_l_tke_aniso, & ! Out + clubb_l_vert_avg_closure, & ! Out + clubb_l_trapezoidal_rule_zt, & ! Out + clubb_l_trapezoidal_rule_zm, & ! Out + clubb_l_call_pdf_closure_twice, & ! Out + clubb_l_standard_term_ta, & ! Out + clubb_l_partial_upwind_wp3, & ! Out + clubb_l_godunov_upwind_wpxp_ta, & ! Out + clubb_l_godunov_upwind_xpyp_ta, & ! Out + clubb_l_use_cloud_cover, & ! Out + clubb_l_diagnose_correlations, & ! Out + clubb_l_calc_w_corr, & ! Out + clubb_l_const_Nc_in_cloud, & ! Out + clubb_l_fix_w_chi_eta_correlations, & ! Out + clubb_l_stability_correct_tau_zm, & ! Out + clubb_l_damp_wp2_using_em, & ! Out + clubb_l_do_expldiff_rtm_thlm, & ! Out + clubb_l_Lscale_plume_centered, & ! Out + clubb_l_diag_Lscale_from_tau, & ! Out + clubb_l_use_C7_Richardson, & ! Out + clubb_l_use_C11_Richardson, & ! Out + clubb_l_use_shear_Richardson, & ! Out + clubb_l_brunt_vaisala_freq_moist, & ! Out + clubb_l_use_thvm_in_bv_freq, & ! Out + clubb_l_rcm_supersat_adj, & ! Out + clubb_l_damp_wp3_Skw_squared, & ! Out + clubb_l_prescribed_avg_deltaz, & ! Out + clubb_l_lmm_stepping, & ! Out + clubb_l_e3sm_config, & ! Out + clubb_l_vary_convect_depth, & ! Out + clubb_l_use_tke_in_wp3_pr_turb_term, & ! Out + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! Out + clubb_l_smooth_Heaviside_tau_wpxp ) ! Out ! Call CLUBB+MF namelist call clubb_mf_readnl(nlfile) @@ -611,8 +841,6 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_cloudtop_cooling") call mpi_bcast(clubb_rainevap_turb, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_rainevap_turb") - call mpi_bcast(clubb_expldiff, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_expldiff") call mpi_bcast(clubb_do_adv, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_adv") call mpi_bcast(clubb_timestep, 1, mpi_real8, mstrid, mpicom, ierr) @@ -630,6 +858,8 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c11b") call mpi_bcast(clubb_c14, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c14") + call mpi_bcast(clubb_C_wp3_pr_turb, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_wp3_pr_turb") call mpi_bcast(clubb_c6rt, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c6rt") call mpi_bcast(clubb_c6rtb, 1, mpi_real8, mstrid, mpicom, ierr) @@ -670,8 +900,20 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C7b") call mpi_bcast(clubb_Skw_denom_coef, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_Skw_denom_coef") - call mpi_bcast(clubb_C4, 1, mpi_real8, mstrid, mpicom, ierr) + call mpi_bcast(clubb_C4, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C4") + call mpi_bcast(clubb_C_uu_shr, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_uu_shr") + call mpi_bcast(clubb_C_uu_buoy, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_uu_buoy") + call mpi_bcast(clubb_c_K1, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K1") + call mpi_bcast(clubb_c_K2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K2") + call mpi_bcast(clubb_nu2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_nu2") + call mpi_bcast(clubb_c_K8, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K8") call mpi_bcast(clubb_c_K9, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_c_K9") call mpi_bcast(clubb_nu9, 1, mpi_real8, mstrid, mpicom, ierr) @@ -682,13 +924,26 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_lambda0_stability_coef") call mpi_bcast(clubb_l_lscale_plume_centered,1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_lscale_plume_centered") - call mpi_bcast(clubb_l_use_ice_latent, 1, mpi_logical, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_ice_latent") call mpi_bcast(clubb_do_liqsupersat, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_liqsupersat") call mpi_bcast(clubb_do_energyfix, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_do_energyfix") - + call mpi_bcast(clubb_C_invrs_tau_bkgnd, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_bkgnd") + call mpi_bcast(clubb_C_invrs_tau_sfc, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_sfc") + call mpi_bcast(clubb_C_invrs_tau_shear, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_shear") + call mpi_bcast(clubb_C_invrs_tau_N2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2") + call mpi_bcast(clubb_C_invrs_tau_N2_wp2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_wp2") + call mpi_bcast(clubb_C_invrs_tau_N2_xp2, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_xp2") + call mpi_bcast(clubb_C_invrs_tau_N2_wpxp, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_wpxp") + call mpi_bcast(clubb_C_invrs_tau_N2_clear_wp3, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_C_invrs_tau_N2_clear_wp3") call mpi_bcast(clubb_lmin_coef, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_lmin_coef") call mpi_bcast(clubb_skw_max_mag, 1, mpi_real8, mstrid, mpicom, ierr) @@ -697,8 +952,8 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_stability_correct_tau_zm") call mpi_bcast(clubb_gamma_coefb, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_gamma_coefb") - call mpi_bcast(clubb_up2_vp2_factor, 1, mpi_real8, mstrid, mpicom, ierr) - if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_up2_vp2_factor") + call mpi_bcast(clubb_up2_sfc_coef, 1, mpi_real8, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_up2_sfc_coef") call mpi_bcast(clubb_detliq_rad, 1, mpi_real8, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_detliq_rad") call mpi_bcast(clubb_detice_rad, 1, mpi_real8, mstrid, mpicom, ierr) @@ -710,6 +965,8 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_C7_Richardson") call mpi_bcast(clubb_l_use_C11_Richardson, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_C11_Richardson") + call mpi_bcast(clubb_l_use_shear_Richardson, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_shear_Richardson") call mpi_bcast(clubb_l_brunt_vaisala_freq_moist, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_brunt_vaisala_freq_moist") call mpi_bcast(clubb_l_use_thvm_in_bv_freq, 1, mpi_logical, mstrid, mpicom, ierr) @@ -726,6 +983,10 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_min_xp2_from_corr_wx") call mpi_bcast(clubb_l_upwind_xpyp_ta, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_upwind_xpyp_ta") + call mpi_bcast(clubb_l_godunov_upwind_wpxp_ta, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_godunov_upwind_wpxp_ta") + call mpi_bcast(clubb_l_godunov_upwind_xpyp_ta, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_godunov_upwind_xpyp_ta") call mpi_bcast(clubb_l_vert_avg_closure, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_vert_avg_closure") call mpi_bcast(clubb_l_trapezoidal_rule_zt, 1, mpi_logical, mstrid, mpicom, ierr) @@ -740,57 +1001,135 @@ subroutine clubb_readnl(nlfile) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_diag_Lscale_from_tau") call mpi_bcast(clubb_l_damp_wp2_using_em, 1, mpi_logical, mstrid, mpicom, ierr) if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_damp_wp2_using_em") + call mpi_bcast(clubb_l_do_expldiff_rtm_thlm, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_do_expldiff_rtm_thlm") + call mpi_bcast(clubb_l_lmm_stepping, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_lmm_stepping") + call mpi_bcast(clubb_l_e3sm_config, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_e3sm_config") + call mpi_bcast(clubb_l_use_tke_in_wp3_pr_turb_term, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_tke_in_wp3_pr_turb_term") + call mpi_bcast(clubb_l_use_tke_in_wp2_wp3_K_dfsn, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_use_tke_in_wp2_wp3_K_dfsn") + call mpi_bcast(clubb_l_smooth_Heaviside_tau_wpxp, 1, mpi_logical, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_l_smooth_Heaviside_tau_wpxp") + call mpi_bcast(clubb_ipdf_call_placement, 1, mpi_integer, mstrid, mpicom, ierr) + if (ierr /= 0) call endrun(sub//": FATAL: mpi_bcast: clubb_ipdf_call_placement") ! Overwrite defaults if they are true if (clubb_history) l_stats = .true. if (clubb_rad_history) l_output_rad_files = .true. if (clubb_cloudtop_cooling) do_cldcool = .true. if (clubb_rainevap_turb) do_rainturb = .true. - if (clubb_expldiff) do_expldiff = .true. -! Check that all namelists have been set - if(clubb_timestep == unset_r8) call endrun(sub//": FATAL: clubb_timestep is not set") - if(clubb_rnevap_effic == unset_r8) call endrun(sub//": FATAL:clubb_rnevap_effic is not set") - - if(clubb_c1 == unset_r8) call endrun(sub//": FATAL: clubb_c1 is not set") - if(clubb_c1b == unset_r8) call endrun(sub//": FATAL: clubb_c1b is not set") - if(clubb_C2rt == unset_r8) call endrun(sub//": FATAL: clubb_C2rt is not set") - if(clubb_C2thl == unset_r8) call endrun(sub//": FATAL: clubb_C2thl is not set") - if(clubb_C2rtthl == unset_r8) call endrun(sub//": FATAL: clubb_C2rtthl is not set") - if(clubb_C4 == unset_r8) call endrun(sub//": FATAL: clubb_C4 is not set") - if(clubb_c6rt == unset_r8) call endrun(sub//": FATAL: clubb_c6rt is not set") - if(clubb_c6rtb == unset_r8) call endrun(sub//": FATAL: clubb_c6rtb is not set") - if(clubb_c6rtc == unset_r8) call endrun(sub//": FATAL: clubb_c6rtc is not set") - if(clubb_c6thl == unset_r8) call endrun(sub//": FATAL: clubb_c6thl is not set") - if(clubb_c6thlb == unset_r8) call endrun(sub//": FATAL: clubb_c6thlb is not set") - if(clubb_c6thlc == unset_r8) call endrun(sub//": FATAL: clubb_c6thlc is not set") - if(clubb_wpxp_L_thresh == unset_r8) call endrun(sub//": FATAL: clubb_wpxp_L_thresh is not set") - if(clubb_C8 == unset_r8) call endrun(sub//": FATAL: clubb_C8 is not set") - if(clubb_C8b == unset_r8) call endrun(sub//": FATAL: clubb_C8b is not set") - if(clubb_C7 == unset_r8) call endrun(sub//": FATAL: clubb_C7 is not set") - if(clubb_C7b == unset_r8) call endrun(sub//": FATAL: clubb_C7b is not set") - if(clubb_c11 == unset_r8) call endrun(sub//": FATAL: clubb_c11 is not set") - if(clubb_c11b == unset_r8) call endrun(sub//": FATAL: clubb_c11b is not set") - if(clubb_c14 == unset_r8) call endrun(sub//": FATAL: clubb_c14 is not set") - if(clubb_c_K9 == unset_r8) call endrun(sub//": FATAL: clubb_c_K9 is not set") - if(clubb_nu9 == unset_r8) call endrun(sub//": FATAL: clubb_nu9 is not set") - if(clubb_c_K10 == unset_r8) call endrun(sub//": FATAL: clubb_c_K10 is not set") - if(clubb_c_K10h == unset_r8) call endrun(sub//": FATAL: clubb_c_K10h is not set") - if(clubb_gamma_coef == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coef is not set") - if(clubb_gamma_coefb == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coefb is not set") - if(clubb_beta == unset_r8) call endrun(sub//": FATAL: clubb_beta is not set") - if(clubb_lambda0_stability_coef == unset_r8) call endrun(sub//": FATAL: clubb_lambda0_stability_coef is not set") - if(clubb_lmin_coef == unset_r8) call endrun(sub//": FATAL: clubb_lmin_coef is not set") - if(clubb_mult_coef == unset_r8) call endrun(sub//": FATAL: clubb_mult_coef is not set") - if(clubb_Skw_denom_coef == unset_r8) call endrun(sub//": FATAL: clubb_Skw_denom_coef is not set") - if(clubb_skw_max_mag == unset_r8) call endrun(sub//": FATAL: clubb_skw_max_mag is not set") - if(clubb_up2_vp2_factor == unset_r8) call endrun(sub//": FATAL: clubb_up2_vp2_factor is not set") - if(clubb_C_wp2_splat == unset_r8) call endrun(sub//": FATAL: clubb_C_wp2_splatis not set") - if(clubb_detliq_rad == unset_r8) call endrun(sub//": FATAL: clubb_detliq_rad not set") - if(clubb_detice_rad == unset_r8) call endrun(sub//": FATAL: clubb_detice_rad not set") - if(clubb_detphase_lowtemp == unset_r8) call endrun(sub//": FATAL: clubb_detphase_lowtemp not set") - if(clubb_detphase_lowtemp >= meltpt_temp) & - call endrun(sub//": ERROR: clubb_detphase_lowtemp must be less than 268.15 K") + ! Check that all namelists have been set + if(clubb_timestep == unset_r8) call endrun(sub//": FATAL: clubb_timestep is not set") + if(clubb_rnevap_effic == unset_r8) call endrun(sub//": FATAL:clubb_rnevap_effic is not set") + + if(clubb_c1 == unset_r8) call endrun(sub//": FATAL: clubb_c1 is not set") + if(clubb_c1b == unset_r8) call endrun(sub//": FATAL: clubb_c1b is not set") + if(clubb_C2rt == unset_r8) call endrun(sub//": FATAL: clubb_C2rt is not set") + if(clubb_C2thl == unset_r8) call endrun(sub//": FATAL: clubb_C2thl is not set") + if(clubb_C2rtthl == unset_r8) call endrun(sub//": FATAL: clubb_C2rtthl is not set") + if(clubb_C4 == unset_r8) call endrun(sub//": FATAL: clubb_C4 is not set") + if(clubb_C_uu_shr == unset_r8) call endrun(sub//": FATAL: clubb_C_uu_shr is not set") + if(clubb_C_uu_buoy == unset_r8) call endrun(sub//": FATAL: clubb_C_uu_buoy is not set") + if(clubb_c6rt == unset_r8) call endrun(sub//": FATAL: clubb_c6rt is not set") + if(clubb_c6rtb == unset_r8) call endrun(sub//": FATAL: clubb_c6rtb is not set") + if(clubb_c6rtc == unset_r8) call endrun(sub//": FATAL: clubb_c6rtc is not set") + if(clubb_c6thl == unset_r8) call endrun(sub//": FATAL: clubb_c6thl is not set") + if(clubb_c6thlb == unset_r8) call endrun(sub//": FATAL: clubb_c6thlb is not set") + if(clubb_c6thlc == unset_r8) call endrun(sub//": FATAL: clubb_c6thlc is not set") + if(clubb_wpxp_L_thresh == unset_r8) call endrun(sub//": FATAL: clubb_wpxp_L_thresh is not set") + if(clubb_C8 == unset_r8) call endrun(sub//": FATAL: clubb_C8 is not set") + if(clubb_C8b == unset_r8) call endrun(sub//": FATAL: clubb_C8b is not set") + if(clubb_C7 == unset_r8) call endrun(sub//": FATAL: clubb_C7 is not set") + if(clubb_C7b == unset_r8) call endrun(sub//": FATAL: clubb_C7b is not set") + if(clubb_c11 == unset_r8) call endrun(sub//": FATAL: clubb_c11 is not set") + if(clubb_c11b == unset_r8) call endrun(sub//": FATAL: clubb_c11b is not set") + if(clubb_c14 == unset_r8) call endrun(sub//": FATAL: clubb_c14 is not set") + if(clubb_C_wp3_pr_turb == unset_r8) call endrun(sub//": FATAL: clubb_C_wp3_pr_turb is not set") + if(clubb_c_K1 == unset_r8) call endrun(sub//": FATAL: clubb_c_K1 is not set") + if(clubb_c_K2 == unset_r8) call endrun(sub//": FATAL: clubb_c_K2 is not set") + if(clubb_nu2 == unset_r8) call endrun(sub//": FATAL: clubb_nu2 is not set") + if(clubb_c_K8 == unset_r8) call endrun(sub//": FATAL: clubb_c_K8 is not set") + if(clubb_c_K9 == unset_r8) call endrun(sub//": FATAL: clubb_c_K9 is not set") + if(clubb_nu9 == unset_r8) call endrun(sub//": FATAL: clubb_nu9 is not set") + if(clubb_c_K10 == unset_r8) call endrun(sub//": FATAL: clubb_c_K10 is not set") + if(clubb_c_K10h == unset_r8) call endrun(sub//": FATAL: clubb_c_K10h is not set") + if(clubb_C_invrs_tau_bkgnd == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_bkgnd is not set") + if(clubb_C_invrs_tau_sfc == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_sfc is not set") + if(clubb_C_invrs_tau_shear == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_shear is not set") + if(clubb_C_invrs_tau_N2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2 is not set") + if(clubb_C_invrs_tau_N2_wp2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_wp2 is not set") + if(clubb_C_invrs_tau_N2_xp2 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_xp2 is not set") + if(clubb_C_invrs_tau_N2_wpxp == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_wpxp is not set") + if(clubb_C_invrs_tau_N2_clear_wp3 == unset_r8) call endrun(sub//": FATAL: clubb_C_invrs_tau_N2_clear_wp3 is not set") + if(clubb_gamma_coef == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coef is not set") + if(clubb_gamma_coefb == unset_r8) call endrun(sub//": FATAL: clubb_gamma_coefb is not set") + if(clubb_beta == unset_r8) call endrun(sub//": FATAL: clubb_beta is not set") + if(clubb_lambda0_stability_coef == unset_r8) call endrun(sub//": FATAL: clubb_lambda0_stability_coef is not set") + if(clubb_lmin_coef == unset_r8) call endrun(sub//": FATAL: clubb_lmin_coef is not set") + if(clubb_mult_coef == unset_r8) call endrun(sub//": FATAL: clubb_mult_coef is not set") + if(clubb_Skw_denom_coef == unset_r8) call endrun(sub//": FATAL: clubb_Skw_denom_coef is not set") + if(clubb_skw_max_mag == unset_r8) call endrun(sub//": FATAL: clubb_skw_max_mag is not set") + if(clubb_up2_sfc_coef == unset_r8) call endrun(sub//": FATAL: clubb_up2_sfc_coef is not set") + if(clubb_C_wp2_splat == unset_r8) call endrun(sub//": FATAL: clubb_C_wp2_splatis not set") + if(clubb_detliq_rad == unset_r8) call endrun(sub//": FATAL: clubb_detliq_rad not set") + if(clubb_detice_rad == unset_r8) call endrun(sub//": FATAL: clubb_detice_rad not set") + if(clubb_ipdf_call_placement == unset_i) call endrun(sub//": FATAL: clubb_ipdf_call_placement not set") + if(clubb_detphase_lowtemp == unset_r8) call endrun(sub//": FATAL: clubb_detphase_lowtemp not set") + if(clubb_detphase_lowtemp >= meltpt_temp) & + call endrun(sub//": ERROR: clubb_detphase_lowtemp must be less than 268.15 K") + + call initialize_clubb_config_flags_type_api( clubb_iiPDF_type, & ! In + clubb_ipdf_call_placement, & ! In + clubb_l_use_precip_frac, & ! In + clubb_l_predict_upwp_vpwp, & ! In + clubb_l_min_wp2_from_corr_wx, & ! In + clubb_l_min_xp2_from_corr_wx, & ! In + clubb_l_C2_cloud_frac, & ! In + clubb_l_diffuse_rtm_and_thlm, & ! In + clubb_l_stability_correct_Kh_N2_zm, & ! In + clubb_l_calc_thlp2_rad, & ! In + clubb_l_upwind_xpyp_ta, & ! In + clubb_l_upwind_xm_ma, & ! In + clubb_l_uv_nudge, & ! In + clubb_l_rtm_nudge, & ! In + clubb_l_tke_aniso, & ! In + clubb_l_vert_avg_closure, & ! In + clubb_l_trapezoidal_rule_zt, & ! In + clubb_l_trapezoidal_rule_zm, & ! In + clubb_l_call_pdf_closure_twice, & ! In + clubb_l_standard_term_ta, & ! In + clubb_l_partial_upwind_wp3, & ! In + clubb_l_godunov_upwind_wpxp_ta, & ! In + clubb_l_godunov_upwind_xpyp_ta, & ! In + clubb_l_use_cloud_cover, & ! In + clubb_l_diagnose_correlations, & ! In + clubb_l_calc_w_corr, & ! In + clubb_l_const_Nc_in_cloud, & ! In + clubb_l_fix_w_chi_eta_correlations, & ! In + clubb_l_stability_correct_tau_zm, & ! In + clubb_l_damp_wp2_using_em, & ! In + clubb_l_do_expldiff_rtm_thlm, & ! In + clubb_l_Lscale_plume_centered, & ! In + clubb_l_diag_Lscale_from_tau, & ! In + clubb_l_use_C7_Richardson, & ! In + clubb_l_use_C11_Richardson, & ! In + clubb_l_use_shear_Richardson, & ! In + clubb_l_brunt_vaisala_freq_moist, & ! In + clubb_l_use_thvm_in_bv_freq, & ! In + clubb_l_rcm_supersat_adj, & ! In + clubb_l_damp_wp3_Skw_squared, & ! In + clubb_l_prescribed_avg_deltaz, & ! In + clubb_l_lmm_stepping, & ! In + clubb_l_e3sm_config, & ! In + clubb_l_vary_convect_depth, & ! In + clubb_l_use_tke_in_wp3_pr_turb_term, & ! In + clubb_l_use_tke_in_wp2_wp3_K_dfsn, & ! In + clubb_l_smooth_Heaviside_tau_wpxp, & ! In + clubb_config_flags ) ! Out #endif end subroutine clubb_readnl @@ -824,10 +1163,14 @@ subroutine clubb_ini_cam(pbuf2d) ! These are needed to set parameters use clubb_api_module, only: & - ilambda0_stability_coef, ic_K10, ic_K10h, iC7, iC7b, iC8, iC8b, iC11, iC11b, iC4, & - iC1, iC1b, iC6rt, iC6rtb, iC6rtc, iC6thl, iC6thlb, iC6thlc, iup2_vp2_factor, iwpxp_L_thresh, & - iC14, igamma_coef, igamma_coefb, imult_coef, ilmin_coef, iSkw_denom_coef, ibeta, iskw_max_mag, & - iC2rt, iC2thl, iC2rtthl, ic_K9, inu9, iC_wp2_splat, params_list + core_rknd, em_min, & + ilambda0_stability_coef, ic_K10, ic_K10h, iC7, iC7b, iC8, iC8b, iC11, iC11b, iC4, iC_uu_shr, iC_uu_buoy, & + iC1, iC1b, iC6rt, iC6rtb, iC6rtc, iC6thl, iC6thlb, iC6thlc, iup2_sfc_coef, iwpxp_L_thresh, & + iC14, iC_wp3_pr_turb, igamma_coef, igamma_coefb, imult_coef, ilmin_coef, & + iSkw_denom_coef, ibeta, iskw_max_mag, & + iC_invrs_tau_bkgnd,iC_invrs_tau_sfc,iC_invrs_tau_shear,iC_invrs_tau_N2,iC_invrs_tau_N2_wp2, & + iC_invrs_tau_N2_xp2,iC_invrs_tau_N2_wpxp,iC_invrs_tau_N2_clear_wp3,iC_uu_shr,iC_uu_buoy, & + iC2rt, iC2thl, iC2rtthl, ic_K1, ic_K2, inu2, ic_K8, ic_K9, inu9, iC_wp2_splat, params_list use clubb_api_module, only: & print_clubb_config_flags_api, & @@ -839,15 +1182,11 @@ subroutine clubb_ini_cam(pbuf2d) set_clubb_debug_level_api, & clubb_fatal_error, & ! Error code value to indicate a fatal error nparams, & + set_default_parameters_api, & read_parameters_api, & l_stats, & l_stats_samp, & l_grads, & - stats_zt, & - stats_zm, & - stats_sfc, & - stats_rad_zt, & - stats_rad_zm, & w_tol_sqd, & rt_tol, & thl_tol @@ -878,13 +1217,11 @@ subroutine clubb_ini_cam(pbuf2d) real(kind=time_precision) :: dum1, dum2, dum3 - real(r8), dimension(nparams) :: clubb_params ! These adjustable CLUBB parameters (C1, C2 ...) - ! The similar name to clubb_history is unfortunate... logical :: history_amwg, history_clubb integer :: err_code ! Code for when CLUBB fails - integer :: j, k, l ! Indices + integer :: i, j, k, l ! Indices integer :: ntop_eddy ! Top interface level to which eddy vertical diffusion is applied ( = 1 ) integer :: nbot_eddy ! Bottom interface level to which eddy vertical diffusion is applied ( = pver ) integer :: nmodes, nspec, m @@ -900,7 +1237,30 @@ subroutine clubb_ini_cam(pbuf2d) ! CAM defines zi at the surface to be zero. real(r8), parameter :: sfc_elevation = 0._r8 - integer :: nlev + integer :: nlev, ierr + + real(r8) :: & + C1, C1b, C1c, C2rt, C2thl, C2rtthl, & + C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, C6thl, C6thlb, C6thlc, & + C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, & + C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & + c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, & + slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, & + coef_spread_DG_means_rt, coef_spread_DG_means_thl, & + gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, & + omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, & + lambda0_stability_coef, mult_coef, taumin, taumax, Lscale_mu_coef, & + Lscale_pert_coef, alpha_corr, Skw_denom_coef, c_K10, c_K10h, & + thlp2_rad_coef, thlp2_rad_cloud_frac_thresh, up2_sfc_coef, & + Skw_max_mag, xp3_coef_base, xp3_coef_slope, altitude_threshold, & + rtp2_clip_coef, C_invrs_tau_bkgnd, C_invrs_tau_sfc, & + C_invrs_tau_shear, C_invrs_tau_N2, C_invrs_tau_N2_wp2, & + C_invrs_tau_N2_xp2, C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & + C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & + Cx_min, Cx_max, Richardson_num_min, Richardson_num_max !----- Begin Code ----- @@ -912,19 +1272,16 @@ subroutine clubb_ini_cam(pbuf2d) ! Allocate PDF parameters across columns and chunks allocate( & - pdf_params_chnk(pcols,begchunk:endchunk), & - pdf_params_zm_chnk(pcols,begchunk:endchunk), & + pdf_params_chnk(begchunk:endchunk), & + pdf_params_zm_chnk(begchunk:endchunk), & pdf_implicit_coefs_terms_chnk(pcols,begchunk:endchunk) ) - - ! Allocate (in the vertical) and zero PDF parameters - do l = begchunk, endchunk, 1 - do j = 1, pcols, 1 - call init_pdf_params_api( pverp+1-top_lev, pdf_params_chnk(j,l) ) - call init_pdf_params_api( pverp+1-top_lev, pdf_params_zm_chnk(j,l) ) + + do j = 1, pcols, 1 + do l = begchunk, endchunk, 1 call init_pdf_implicit_coefs_terms_api( pverp+1-top_lev, sclr_dim, & pdf_implicit_coefs_terms_chnk(j,l) ) - enddo ! j = 1, pcols, 1 - enddo ! l = begchunk, endchunk, 1 + enddo ! l = begchunk, endchunk, 1 + enddo ! j = 1, pcols, 1 ! ----------------------------------------------------------------- ! ! Determine how many constituents CLUBB will transport. Note that @@ -971,7 +1328,7 @@ subroutine clubb_ini_cam(pbuf2d) ! tendencies to avoid double counted. Else, we apply tendencies. lq(ixnumliq) = .false. edsclr_dim = edsclr_dim-1 - endif + end if ! ----------------------------------------------------------------- ! ! Set the debug level. Level 2 has additional computational expense since @@ -1031,17 +1388,66 @@ subroutine clubb_ini_cam(pbuf2d) ! Define number of tracers for CLUBB to diffuse ! ----------------------------------------------------------------- ! - if (do_expldiff) then + if (clubb_l_do_expldiff_rtm_thlm) then offset = 2 ! diffuse temperature and moisture explicitly edsclr_dim = edsclr_dim + offset - endif + end if ! ----------------------------------------------------------------- ! ! Setup CLUBB core ! ----------------------------------------------------------------- ! - ! Read in parameters for CLUBB. Just read in default values - call read_parameters_api( -99, "", clubb_params ) + ! Read in parameters for CLUBB. Just read in default values + call set_default_parameters_api( & + C1, C1b, C1c, C2rt, C2thl, C2rtthl, & + C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, & + C6thl, C6thlb, C6thlc, C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, & + C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & + c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, & + slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, & + coef_spread_DG_means_rt, coef_spread_DG_means_thl, & + gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, & + omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, & + lambda0_stability_coef, mult_coef, taumin, taumax, & + Lscale_mu_coef, Lscale_pert_coef, alpha_corr, & + Skw_denom_coef, c_K10, c_K10h, thlp2_rad_coef, & + thlp2_rad_cloud_frac_thresh, up2_sfc_coef, & + Skw_max_mag, xp3_coef_base, xp3_coef_slope, & + altitude_threshold, rtp2_clip_coef, C_invrs_tau_bkgnd, & + C_invrs_tau_sfc, C_invrs_tau_shear, C_invrs_tau_N2, & + C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, & + C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & + C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & + Cx_min, Cx_max, Richardson_num_min, Richardson_num_max ) + + call read_parameters_api( -99, "", & + C1, C1b, C1c, C2rt, C2thl, C2rtthl, & + C4, C_uu_shr, C_uu_buoy, C6rt, C6rtb, C6rtc, & + C6thl, C6thlb, C6thlc, C7, C7b, C7c, C8, C8b, C10, & + C11, C11b, C11c, C12, C13, C14, C_wp2_pr_dfsn, C_wp3_pr_tp, & + C_wp3_pr_turb, C_wp3_pr_dfsn, C_wp2_splat, & + C6rt_Lscale0, C6thl_Lscale0, C7_Lscale0, wpxp_L_thresh, & + c_K, c_K1, nu1, c_K2, nu2, c_K6, nu6, c_K8, nu8, & + c_K9, nu9, nu10, c_K_hm, c_K_hmb, K_hm_min_coef, nu_hm, & + slope_coef_spread_DG_means_w, pdf_component_stdev_factor_w, & + coef_spread_DG_means_rt, coef_spread_DG_means_thl, & + gamma_coef, gamma_coefb, gamma_coefc, mu, beta, lmin_coef, & + omicron, zeta_vrnce_rat, upsilon_precip_frac_rat, & + lambda0_stability_coef, mult_coef, taumin, taumax, & + Lscale_mu_coef, Lscale_pert_coef, alpha_corr, & + Skw_denom_coef, c_K10, c_K10h, thlp2_rad_coef, & + thlp2_rad_cloud_frac_thresh, up2_sfc_coef, & + Skw_max_mag, xp3_coef_base, xp3_coef_slope, & + altitude_threshold, rtp2_clip_coef, C_invrs_tau_bkgnd, & + C_invrs_tau_sfc, C_invrs_tau_shear, C_invrs_tau_N2, & + C_invrs_tau_N2_wp2, C_invrs_tau_N2_xp2, & + C_invrs_tau_N2_wpxp, C_invrs_tau_N2_clear_wp3, & + C_invrs_tau_wpxp_Ri, C_invrs_tau_wpxp_N2_thresh, & + Cx_min, Cx_max, Richardson_num_min, Richardson_num_max, & + clubb_params ) ! Fill in dummy arrays for height. Note that these are overwrote ! at every CLUBB step to physical values. @@ -1055,6 +1461,7 @@ subroutine clubb_ini_cam(pbuf2d) clubb_params(iC11) = clubb_c11 clubb_params(iC11b) = clubb_c11b clubb_params(iC14) = clubb_c14 + clubb_params(iC_wp3_pr_turb) = clubb_C_wp3_pr_turb clubb_params(ic_K10) = clubb_c_K10 clubb_params(imult_coef) = clubb_mult_coef clubb_params(iSkw_denom_coef) = clubb_Skw_denom_coef @@ -1079,36 +1486,25 @@ subroutine clubb_ini_cam(pbuf2d) clubb_params(iC1) = clubb_C1 clubb_params(iC1b) = clubb_C1b clubb_params(igamma_coefb) = clubb_gamma_coefb - clubb_params(iup2_vp2_factor) = clubb_up2_vp2_factor + clubb_params(iup2_sfc_coef) = clubb_up2_sfc_coef clubb_params(iC4) = clubb_C4 + clubb_params(iC_uu_shr) = clubb_C_uu_shr + clubb_params(iC_uu_buoy) = clubb_C_uu_buoy + clubb_params(ic_K1) = clubb_c_K1 + clubb_params(ic_K2) = clubb_c_K2 + clubb_params(inu2) = clubb_nu2 + clubb_params(ic_K8) = clubb_c_K8 clubb_params(ic_K9) = clubb_c_K9 clubb_params(inu9) = clubb_nu9 clubb_params(iC_wp2_splat) = clubb_C_wp2_splat - - call init_clubb_config_flags( clubb_config_flags ) ! In/Out - clubb_config_flags%l_use_C7_Richardson = clubb_l_use_C7_Richardson - clubb_config_flags%l_use_C11_Richardson = clubb_l_use_C11_Richardson - clubb_config_flags%l_brunt_vaisala_freq_moist = clubb_l_brunt_vaisala_freq_moist - clubb_config_flags%l_use_thvm_in_bv_freq = clubb_l_use_thvm_in_bv_freq - clubb_config_flags%l_rcm_supersat_adj = clubb_l_rcm_supersat_adj - clubb_config_flags%l_damp_wp3_Skw_squared = clubb_l_damp_wp3_Skw_squared - clubb_config_flags%l_predict_upwp_vpwp = clubb_l_predict_upwp_vpwp - clubb_config_flags%l_min_wp2_from_corr_wx = clubb_l_min_wp2_from_corr_wx - clubb_config_flags%l_min_xp2_from_corr_wx = clubb_l_min_xp2_from_corr_wx - clubb_config_flags%l_upwind_xpyp_ta = clubb_l_upwind_xpyp_ta - clubb_config_flags%l_vert_avg_closure = clubb_l_vert_avg_closure - clubb_config_flags%l_trapezoidal_rule_zt = clubb_l_trapezoidal_rule_zt - clubb_config_flags%l_trapezoidal_rule_zm = clubb_l_trapezoidal_rule_zm - clubb_config_flags%l_call_pdf_closure_twice = clubb_l_call_pdf_closure_twice - clubb_config_flags%l_use_cloud_cover = clubb_l_use_cloud_cover - clubb_config_flags%l_stability_correct_tau_zm = clubb_l_stability_correct_tau_zm - clubb_config_flags%l_do_expldiff_rtm_thlm = do_expldiff - clubb_config_flags%l_Lscale_plume_centered = clubb_l_lscale_plume_centered - clubb_config_flags%l_use_ice_latent = clubb_l_use_ice_latent - clubb_config_flags%l_diag_Lscale_from_tau = clubb_l_diag_Lscale_from_tau - clubb_config_flags%l_damp_wp2_using_em = clubb_l_damp_wp2_using_em - clubb_config_flags%l_update_pressure = l_update_pressure - + clubb_params(iC_invrs_tau_bkgnd) = clubb_C_invrs_tau_bkgnd + clubb_params(iC_invrs_tau_sfc) = clubb_C_invrs_tau_sfc + clubb_params(iC_invrs_tau_shear) = clubb_C_invrs_tau_shear + clubb_params(iC_invrs_tau_N2) = clubb_C_invrs_tau_N2 + clubb_params(iC_invrs_tau_N2_wp2) = clubb_C_invrs_tau_N2_wp2 + clubb_params(iC_invrs_tau_N2_xp2) = clubb_C_invrs_tau_N2_xp2 + clubb_params(iC_invrs_tau_N2_wpxp) = clubb_C_invrs_tau_N2_wpxp + clubb_params(iC_invrs_tau_N2_clear_wp3) = clubb_C_invrs_tau_N2_clear_wp3 ! Set up CLUBB core. Note that some of these inputs are overwritten ! when clubb_tend_cam is called. The reason is that heights can change @@ -1121,15 +1517,17 @@ subroutine clubb_ini_cam(pbuf2d) sclr_tol, edsclr_dim, clubb_params, & ! In l_host_applies_sfc_fluxes, & ! In saturation_equation, & ! In - l_input_fields, & + l_input_fields, & ! In l_implemented, grid_type, zi_g(2), zi_g(1), zi_g(nlev+1),& ! In zi_g(1:nlev+1), zt_g(1:nlev+1), sfc_elevation, & ! In + clubb_config_flags%iiPDF_type, & ! In + clubb_config_flags%ipdf_call_placement, & ! In clubb_config_flags%l_predict_upwp_vpwp, & ! In - clubb_config_flags%l_use_ice_latent, & ! In + clubb_config_flags%l_min_xp2_from_corr_wx, & ! In clubb_config_flags%l_prescribed_avg_deltaz, & ! In clubb_config_flags%l_damp_wp2_using_em, & ! In clubb_config_flags%l_stability_correct_tau_zm, & ! In - err_code ) + dummy_gr, dummy_lmin, dummy_nu_vert_res_dep, err_code ) ! Out if ( err_code == clubb_fatal_error ) then call endrun('clubb_ini_cam: FATAL ERROR CALLING SETUP_CLUBB_CORE') @@ -1141,10 +1539,11 @@ subroutine clubb_ini_cam(pbuf2d) do j = 1, nparams, 1 write(iulog,*) params_list(j), " = ", clubb_params(j) enddo - endif + end if ! Print configurable CLUBB flags if ( masterproc ) then + write(iulog,'(a,i0,a)') " CLUBB configurable flags " call print_clubb_config_flags_api( iulog, clubb_config_flags ) ! Intent(in) end if @@ -1262,17 +1661,21 @@ subroutine clubb_ini_cam(pbuf2d) if (l_stats) then - call stats_init_clubb( .true., dum1, dum2, & - nlev+1, nlev+1, nlev+1, dum3 ) + do i=1, pcols + call stats_init_clubb( .true., dum1, dum2, & + nlev+1, nlev+1, nlev+1, dum3, & + stats_zt(i), stats_zm(i), stats_sfc(i), & + stats_rad_zt(i), stats_rad_zm(i)) + end do - allocate(out_zt(pcols,pverp,stats_zt%num_output_fields)) - allocate(out_zm(pcols,pverp,stats_zm%num_output_fields)) - allocate(out_sfc(pcols,1,stats_sfc%num_output_fields)) + allocate(out_zt(pcols,pverp,stats_zt(1)%num_output_fields)) + allocate(out_zm(pcols,pverp,stats_zm(1)%num_output_fields)) + allocate(out_sfc(pcols,1,stats_sfc(1)%num_output_fields)) - allocate(out_radzt(pcols,pverp,stats_rad_zt%num_output_fields)) - allocate(out_radzm(pcols,pverp,stats_rad_zm%num_output_fields)) + allocate(out_radzt(pcols,pverp,stats_rad_zt(1)%num_output_fields)) + allocate(out_radzm(pcols,pverp,stats_rad_zm(1)%num_output_fields)) - endif + end if ! ----------------------------------------------------------------- ! ! Make all of this output default, this is not CLUBB history @@ -1389,7 +1792,7 @@ subroutine clubb_ini_cam(pbuf2d) call add_default('RVMTEND_CLUBB', history_budget_histfile_num, ' ') call add_default('UTEND_CLUBB', history_budget_histfile_num, ' ') call add_default('VTEND_CLUBB', history_budget_histfile_num, ' ') - endif + end if ! --------------- ! @@ -1426,6 +1829,17 @@ subroutine clubb_ini_cam(pbuf2d) call pbuf_set_field(pbuf2d, tke_idx, 0.0_r8) call pbuf_set_field(pbuf2d, kvh_idx, 0.0_r8) call pbuf_set_field(pbuf2d, radf_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp2rtp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp2thlp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, uprcp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, vprcp_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, rc_coef_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp4_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wpup2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wpvp2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp2up2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, wp2vp2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, ice_supersat_idx, 0.0_r8) ! Initialize SILHS covariance contributions call pbuf_set_field(pbuf2d, rtp2_mc_zt_idx, 0.0_r8) @@ -1433,7 +1847,14 @@ subroutine clubb_ini_cam(pbuf2d) call pbuf_set_field(pbuf2d, wprtp_mc_zt_idx, 0.0_r8) call pbuf_set_field(pbuf2d, wpthlp_mc_zt_idx, 0.0_r8) call pbuf_set_field(pbuf2d, rtpthlp_mc_zt_idx, 0.0_r8) - endif + + call pbuf_set_field(pbuf2d, pdf_zm_w_1_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, pdf_zm_w_2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, pdf_zm_varnce_w_1_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, pdf_zm_varnce_w_2_idx, 0.0_r8) + call pbuf_set_field(pbuf2d, pdf_zm_mixt_frac_idx, 0.0_r8) + + end if ! The following is physpkg, so it needs to be initialized every time call pbuf_set_field(pbuf2d, fice_idx, 0.0_r8) @@ -1479,14 +1900,13 @@ subroutine clubb_tend_cam( & use cam_abortutils, only: endrun use cam_logfile, only: iulog use tropopause, only: tropopause_findChemTrop - use time_manager, only: get_nstep + use time_manager, only: get_nstep, is_first_restart_step #ifdef CLUBB_SGS use hb_diff, only: pblintd use scamMOD, only: single_column,scm_clubb_iop_name use clubb_api_module, only: & nparams, & - read_parameters_api, & setup_parameters_api, & time_precision, & advance_clubb_core_api, & @@ -1499,16 +1919,17 @@ subroutine clubb_tend_cam( & l_stats, & stats_tsamp, & stats_tout, & - stats_zt, & - stats_sfc, & - stats_zm, & - stats_rad_zt, & - stats_rad_zm, & l_output_rad_files, & stats_begin_timestep_api, & - hydromet_dim, calculate_thlp2_rad_api, mu, update_xp2_mc_api, & + hydromet_dim, calculate_thlp2_rad_api, update_xp2_mc_api, & sat_mixrat_liq_api, & - fstderr + fstderr, & + ipdf_post_advance_fields, & + copy_single_pdf_params_to_multi, & + copy_multi_pdf_params_to_single, & + pdf_parameter, & + init_pdf_params_api, & + setup_grid_api use clubb_api_module, only: & clubb_fatal_error ! Error code value to indicate a fatal error @@ -1518,6 +1939,8 @@ subroutine clubb_tend_cam( & use macrop_driver, only: liquid_macro_tend use clubb_mf, only: integrate_mf + + use perf_mod #endif @@ -1566,123 +1989,142 @@ subroutine clubb_tend_cam( & integer :: itim_old integer :: ncol, lchnk ! # of columns, and chunk identifier integer :: err_code ! Diagnostic, for if some calculation goes amiss. - integer :: icnt, clubbtop + integer :: icnt logical :: lq2(pcnst) - integer :: iter + integer :: iter, ierr + + integer :: clubbtop(pcols) real(r8) :: frac_limit, ic_limit real(r8) :: dtime ! CLUBB time step [s] - real(r8) :: edsclr_in(pverp+1-top_lev,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] - real(r8) :: wp2_in(pverp+1-top_lev) ! vertical velocity variance (CLUBB) [m^2/s^2] - real(r8) :: wp3_in(pverp+1-top_lev) ! third moment vertical velocity [m^3/s^3] - real(r8) :: wpthlp_in(pverp+1-top_lev) ! turbulent flux of thetal [K m/s] - real(r8) :: wprtp_in(pverp+1-top_lev) ! turbulent flux of total water [kg/kg m/s] - real(r8) :: rtpthlp_in(pverp+1-top_lev) ! covariance of thetal and qt [kg/kg K] - real(r8) :: rtp2_in(pverp+1-top_lev) ! total water variance [kg^2/kg^2] - real(r8) :: thlp2_in(pverp+1-top_lev) ! thetal variance [K^2] - real(r8) :: rtp3_in(pverp+1-top_lev) ! total water 3rd order [kg^3/kg^3] - real(r8) :: thlp3_in(pverp+1-top_lev) ! thetal 3rd order [K^3] - real(r8) :: up2_in(pverp+1-top_lev) ! meridional wind variance [m^2/s^2] - real(r8) :: vp2_in(pverp+1-top_lev) ! zonal wind variance [m^2/s^2] - real(r8) :: up3_in(pverp+1-top_lev) ! meridional wind third-order [m^3/s^3] - real(r8) :: vp3_in(pverp+1-top_lev) ! zonal wind third-order [m^3/s^3] - real(r8) :: upwp_in(pverp+1-top_lev) ! meridional wind flux [m^2/s^2] - real(r8) :: vpwp_in(pverp+1-top_lev) ! zonal wind flux [m^2/s^2] - real(r8) :: wpthvp_in(pverp+1-top_lev) ! w'th_v' (momentum levels) [m/s K] - real(r8) :: wp2thvp_in(pverp+1-top_lev) ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] - real(r8) :: rtpthvp_in(pverp+1-top_lev) ! r_t'th_v' (momentum levels) [kg/kg K] - real(r8) :: thlpthvp_in(pverp+1-top_lev) ! th_l'th_v' (momentum levels) [K^2] - real(r8) :: thlm_in(pverp+1-top_lev) ! liquid water potential temperature (thetal) [K] - real(r8) :: rtm_in(pverp+1-top_lev) ! total water mixing ratio [kg/kg] - real(r8) :: rvm_in(pverp+1-top_lev) ! water vapor mixing ratio [kg/kg] - real(r8) :: um_in(pverp+1-top_lev) ! meridional wind [m/s] - real(r8) :: vm_in(pverp+1-top_lev) ! zonal wind [m/s] - real(r8) :: rho_in(pverp+1-top_lev) ! mid-point density [kg/m^3] - real(r8) :: pre_in(pverp+1-top_lev) ! input for precip evaporation - real(r8) :: rtp2_mc_out(pverp+1-top_lev) ! total water tendency from rain evap - real(r8) :: thlp2_mc_out(pverp+1-top_lev) ! thetal tendency from rain evap - real(r8) :: wprtp_mc_out(pverp+1-top_lev) - real(r8) :: wpthlp_mc_out(pverp+1-top_lev) - real(r8) :: rtpthlp_mc_out(pverp+1-top_lev) - real(r8) :: rcm_inout(pverp+1-top_lev) ! CLUBB output of liquid water mixing ratio [kg/kg] - real(r8) :: rcm_out_zm(pverp+1-top_lev) - real(r8) :: wprcp_out(pverp+1-top_lev) ! CLUBB output of flux of liquid water [kg/kg m/s] - real(r8) :: cloud_frac_inout(pverp+1-top_lev) ! CLUBB output of cloud fraction [fraction] - real(r8) :: rcm_in_layer_out(pverp+1-top_lev) ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] - real(r8) :: cloud_cover_out(pverp+1-top_lev) ! CLUBB output of in-cloud cloud fraction [fraction] - real(r8) :: thlprcp_out(pverp+1-top_lev) - real(r8) :: rho_ds_zm(pverp+1-top_lev) ! Dry, static density on momentum levels [kg/m^3] - real(r8) :: rho_ds_zt(pverp+1-top_lev) ! Dry, static density on thermodynamic levels [kg/m^3] - real(r8) :: invrs_rho_ds_zm(pverp+1-top_lev) ! Inv. dry, static density on momentum levels [m^3/kg] - real(r8) :: invrs_rho_ds_zt(pverp+1-top_lev) ! Inv. dry, static density on thermo. levels [m^3/kg] - real(r8) :: thv_ds_zm(pverp+1-top_lev) ! Dry, base-state theta_v on momentum levels [K] - real(r8) :: thv_ds_zt(pverp+1-top_lev) ! Dry, base-state theta_v on thermo. levels [K] - real(r8) :: rfrzm(pverp+1-top_lev) - real(r8) :: radf(pverp+1-top_lev) - real(r8) :: wprtp_forcing(pverp+1-top_lev) - real(r8) :: wpthlp_forcing(pverp+1-top_lev) - real(r8) :: rtp2_forcing(pverp+1-top_lev) - real(r8) :: thlp2_forcing(pverp+1-top_lev) - real(r8) :: rtpthlp_forcing(pverp+1-top_lev) - real(r8) :: ice_supersat_frac_out(pverp+1-top_lev) - real(r8) :: zt_g(pverp+1-top_lev) ! Thermodynamic grid of CLUBB [m] - real(r8) :: zi_g(pverp+1-top_lev) ! Momentum grid of CLUBB [m] + real(r8) :: edsclr_in(pcols,pverp+1-top_lev,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] + real(r8) :: wp2_in(pcols,pverp+1-top_lev) ! vertical velocity variance (CLUBB) [m^2/s^2] + real(r8) :: wp3_in(pcols,pverp+1-top_lev) ! third moment vertical velocity [m^3/s^3] + real(r8) :: wpthlp_in(pcols,pverp+1-top_lev) ! turbulent flux of thetal [K m/s] + real(r8) :: wprtp_in(pcols,pverp+1-top_lev) ! turbulent flux of total water [kg/kg m/s] + real(r8) :: rtpthlp_in(pcols,pverp+1-top_lev) ! covariance of thetal and qt [kg/kg K] + real(r8) :: rtp2_in(pcols,pverp+1-top_lev) ! total water variance [kg^2/kg^2] + real(r8) :: thlp2_in(pcols,pverp+1-top_lev) ! thetal variance [K^2] + real(r8) :: rtp3_in(pcols,pverp+1-top_lev) ! total water 3rd order [kg^3/kg^3] + real(r8) :: thlp3_in(pcols,pverp+1-top_lev) ! thetal 3rd order [K^3] + real(r8) :: up2_in(pcols,pverp+1-top_lev) ! meridional wind variance [m^2/s^2] + real(r8) :: vp2_in(pcols,pverp+1-top_lev) ! zonal wind variance [m^2/s^2] + real(r8) :: up3_in(pcols,pverp+1-top_lev) ! meridional wind third-order [m^3/s^3] + real(r8) :: vp3_in(pcols,pverp+1-top_lev) ! zonal wind third-order [m^3/s^3] + real(r8) :: upwp_in(pcols,pverp+1-top_lev) ! meridional wind flux [m^2/s^2] + real(r8) :: vpwp_in(pcols,pverp+1-top_lev) ! zonal wind flux [m^2/s^2] + real(r8) :: wpthvp_in(pcols,pverp+1-top_lev) ! w'th_v' (momentum levels) [m/s K] + real(r8) :: wp2thvp_in(pcols,pverp+1-top_lev) ! w'^2 th_v' (thermodynamic levels) [m^2/s^2 K] + real(r8) :: rtpthvp_in(pcols,pverp+1-top_lev) ! r_t'th_v' (momentum levels) [kg/kg K] + real(r8) :: thlpthvp_in(pcols,pverp+1-top_lev) ! th_l'th_v' (momentum levels) [K^2] + real(r8) :: thlm_in(pcols,pverp+1-top_lev) ! liquid water potential temperature (thetal) [K] + real(r8) :: rtm_in(pcols,pverp+1-top_lev) ! total water mixing ratio [kg/kg] + real(r8) :: rvm_in(pcols,pverp+1-top_lev) ! water vapor mixing ratio [kg/kg] + real(r8) :: um_in(pcols,pverp+1-top_lev) ! meridional wind [m/s] + real(r8) :: vm_in(pcols,pverp+1-top_lev) ! zonal wind [m/s] + real(r8) :: rho_in(pcols,pverp+1-top_lev) ! mid-point density [kg/m^3] + real(r8) :: pre_in(pcols,pverp+1-top_lev) ! input for precip evaporation + real(r8) :: rtp2_mc_out(pcols,pverp+1-top_lev) ! total water tendency from rain evap + real(r8) :: thlp2_mc_out(pcols,pverp+1-top_lev) ! thetal tendency from rain evap + real(r8) :: wprtp_mc_out(pcols,pverp+1-top_lev) + real(r8) :: wpthlp_mc_out(pcols,pverp+1-top_lev) + real(r8) :: rtpthlp_mc_out(pcols,pverp+1-top_lev) + real(r8) :: rcm_inout(pcols,pverp+1-top_lev) ! CLUBB output of liquid water mixing ratio [kg/kg] + real(r8) :: rcm_out_zm(pcols,pverp+1-top_lev) + real(r8) :: wprcp_out(pcols,pverp+1-top_lev) ! CLUBB output of flux of liquid water [kg/kg m/s] + real(r8) :: cloud_frac_inout(pcols,pverp+1-top_lev) ! CLUBB output of cloud fraction [fraction] + real(r8) :: rcm_in_layer_out(pcols,pverp+1-top_lev) ! CLUBB output of in-cloud liq. wat. mix. ratio [kg/kg] + real(r8) :: cloud_cover_out(pcols,pverp+1-top_lev) ! CLUBB output of in-cloud cloud fraction [fraction] + real(r8) :: invrs_tau_zm_out(pcols,pverp+1-top_lev) ! CLUBB output of 1 divided by time-scale [1/s] + real(r8) :: thlprcp_out(pcols,pverp+1-top_lev) + real(r8) :: rho_ds_zm(pcols,pverp+1-top_lev) ! Dry, static density on momentum levels [kg/m^3] + real(r8) :: rho_ds_zt(pcols,pverp+1-top_lev) ! Dry, static density on thermodynamic levels [kg/m^3] + real(r8) :: invrs_rho_ds_zm(pcols,pverp+1-top_lev) ! Inv. dry, static density on momentum levels [m^3/kg] + real(r8) :: invrs_rho_ds_zt(pcols,pverp+1-top_lev) ! Inv. dry, static density on thermo. levels [m^3/kg] + real(r8) :: thv_ds_zm(pcols,pverp+1-top_lev) ! Dry, base-state theta_v on momentum levels [K] + real(r8) :: thv_ds_zt(pcols,pverp+1-top_lev) ! Dry, base-state theta_v on thermo. levels [K] + real(r8) :: rfrzm(pcols,pverp+1-top_lev) + real(r8) :: radf(pcols,pverp+1-top_lev) + real(r8) :: wprtp_forcing(pcols,pverp+1-top_lev) + real(r8) :: wpthlp_forcing(pcols,pverp+1-top_lev) + real(r8) :: rtp2_forcing(pcols,pverp+1-top_lev) + real(r8) :: thlp2_forcing(pcols,pverp+1-top_lev) + real(r8) :: rtpthlp_forcing(pcols,pverp+1-top_lev) + real(r8) :: ice_supersat_frac_inout(pcols,pverp+1-top_lev) + real(r8) :: w_up_in_cloud_out(pcols,pverp+1-top_lev) + real(r8) :: zt_g(pcols,pverp+1-top_lev) ! Thermodynamic grid of CLUBB [m] + real(r8) :: zi_g(pcols,pverp+1-top_lev) ! Momentum grid of CLUBB [m] real(r8) :: zt_out(pcols,pverp) ! output for the thermo CLUBB grid [m] real(r8) :: zi_out(pcols,pverp) ! output for momentum CLUBB grid [m] - real(r8) :: fcor ! Coriolis forcing [s^-1] - real(r8) :: sfc_elevation ! Elevation of ground [m AMSL] [m] + real(r8) :: fcor(pcols) ! Coriolis forcing [s^-1] + real(r8) :: sfc_elevation(pcols) ! Elevation of ground [m AMSL] [m] real(r8) :: ubar ! surface wind [m/s] real(r8) :: ustar ! surface stress [m/s] real(r8) :: z0 ! roughness height [m] - real(r8) :: thlm_forcing(pverp+1-top_lev) ! theta_l forcing (thermodynamic levels) [K/s] - real(r8) :: rtm_forcing(pverp+1-top_lev) ! r_t forcing (thermodynamic levels) [(kg/kg)/s] - real(r8) :: um_forcing(pverp+1-top_lev) ! u wind forcing (thermodynamic levels) [m/s/s] - real(r8) :: vm_forcing(pverp+1-top_lev) ! v wind forcing (thermodynamic levels) [m/s/s] - real(r8) :: wm_zm(pverp+1-top_lev) ! w mean wind component on momentum levels [m/s] - real(r8) :: wm_zt(pverp+1-top_lev) ! w mean wind component on thermo. levels [m/s] - real(r8) :: p_in_Pa(pverp+1-top_lev) ! Air pressure (thermodynamic levels) [Pa] - real(r8) :: rho_zt(pverp+1-top_lev) ! Air density on thermo levels [kt/m^3] - real(r8) :: rho_zm(pverp+1-top_lev) ! Air density on momentum levels [kg/m^3] - real(r8) :: exner(pverp+1-top_lev) ! Exner function (thermodynamic levels) [-] - real(r8) :: wpthlp_sfc ! w' theta_l' at surface [(m K)/s] - real(r8) :: wprtp_sfc ! w' r_t' at surface [(kg m)/( kg s)] - real(r8) :: upwp_sfc ! u'w' at surface [m^2/s^2] - real(r8) :: vpwp_sfc ! v'w' at surface [m^2/s^2] - real(r8) :: sclrm_forcing(pverp+1-top_lev,sclr_dim) ! Passive scalar forcing [{units vary}/s] - real(r8) :: wpsclrp_sfc(sclr_dim) ! Scalar flux at surface [{units vary} m/s] - real(r8) :: edsclrm_forcing(pverp+1-top_lev,edsclr_dim)! Eddy passive scalar forcing [{units vary}/s] - real(r8) :: wpedsclrp_sfc(edsclr_dim) ! Eddy-scalar flux at surface [{units vary} m/s] - real(r8) :: sclrm(pverp+1-top_lev,sclr_dim) ! Passive scalar mean (thermo. levels) [units vary] - real(r8) :: wpsclrp(pverp+1-top_lev,sclr_dim)! w'sclr' (momentum levels) [{units vary} m/s] - real(r8) :: sclrp2(pverp+1-top_lev,sclr_dim) ! sclr'^2 (momentum levels) [{units vary}^2] - real(r8) :: sclrp3(pverp+1-top_lev,sclr_dim) ! sclr'^3 (thermo. levels) [{units vary}^3] - real(r8) :: sclrprtp(pverp+1-top_lev,sclr_dim) ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] - real(r8) :: sclrpthlp(pverp+1-top_lev,sclr_dim) ! sclr'thlp' (momentum levels) [{units vary} (K)] - real(r8) :: sclrpthvp_inout(pverp,sclr_dim) ! sclr'th_v' (momentum levels) [{units vary} (K)] - real(r8) :: hydromet(pverp+1-top_lev,hydromet_dim) - real(r8) :: wphydrometp(pverp+1-top_lev,hydromet_dim) - real(r8) :: wp2hmp(pverp+1-top_lev,hydromet_dim) - real(r8) :: rtphmp_zt(pverp+1-top_lev,hydromet_dim) - real(r8) :: thlphmp_zt (pverp+1-top_lev,hydromet_dim) - real(r8) :: bflx22 ! Variable for buoyancy flux for pbl [K m/s] - real(r8) :: khzm_out(pverp+1-top_lev) ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] - real(r8) :: khzt_out(pverp+1-top_lev) ! eddy diffusivity on thermo grids [m^2/s] - real(r8) :: qclvar_out(pverp+1-top_lev) ! cloud water variance [kg^2/kg^2] + real(r8) :: thlm_forcing(pcols,pverp+1-top_lev) ! theta_l forcing (thermodynamic levels) [K/s] + real(r8) :: rtm_forcing(pcols,pverp+1-top_lev) ! r_t forcing (thermodynamic levels) [(kg/kg)/s] + real(r8) :: um_forcing(pcols,pverp+1-top_lev) ! u wind forcing (thermodynamic levels) [m/s/s] + real(r8) :: vm_forcing(pcols,pverp+1-top_lev) ! v wind forcing (thermodynamic levels) [m/s/s] + real(r8) :: rtm_ref(pcols,pverp+1-top_lev) ! Initial profile of rtm [kg/kg] + real(r8) :: thlm_ref(pcols,pverp+1-top_lev) ! Initial profile of thlm [K] + real(r8) :: um_ref(pcols,pverp+1-top_lev) ! Initial profile of um [m/s] + real(r8) :: vm_ref(pcols,pverp+1-top_lev) ! Initial profile of vm [m/s] + real(r8) :: ug(pcols,pverp+1-top_lev) ! U geostrophic wind [m/s] + real(r8) :: vg(pcols,pverp+1-top_lev) ! V geostrophic wind [m/s] + real(r8) :: wm_zm(pcols,pverp+1-top_lev) ! w mean wind component on momentum levels [m/s] + real(r8) :: wm_zt(pcols,pverp+1-top_lev) ! w mean wind component on thermo. levels [m/s] + real(r8) :: p_in_Pa(pcols,pverp+1-top_lev) ! Air pressure (thermodynamic levels) [Pa] + real(r8) :: rho_zt(pcols,pverp+1-top_lev) ! Air density on thermo levels [kt/m^3] + real(r8) :: rho_zm(pcols,pverp+1-top_lev) ! Air density on momentum levels [kg/m^3] + real(r8) :: exner(pcols,pverp+1-top_lev) ! Exner function (thermodynamic levels) [-] + real(r8) :: wpthlp_sfc(pcols) ! w' theta_l' at surface [(m K)/s] + real(r8) :: wprtp_sfc(pcols) ! w' r_t' at surface [(kg m)/( kg s)] + real(r8) :: upwp_sfc(pcols) ! u'w' at surface [m^2/s^2] + real(r8) :: vpwp_sfc(pcols) ! v'w' at surface [m^2/s^2] + real(r8) :: sclrm_forcing(pcols,pverp+1-top_lev,sclr_dim) ! Passive scalar forcing [{units vary}/s] + real(r8) :: wpsclrp_sfc(pcols,sclr_dim) ! Scalar flux at surface [{units vary} m/s] + real(r8) :: edsclrm_forcing(pcols,pverp+1-top_lev,edsclr_dim)! Eddy passive scalar forcing [{units vary}/s] + real(r8) :: wpedsclrp_sfc(pcols,edsclr_dim) ! Eddy-scalar flux at surface [{units vary} m/s] + real(r8) :: sclrm(pcols,pverp+1-top_lev,sclr_dim) ! Passive scalar mean (thermo. levels) [units vary] + real(r8) :: wpsclrp(pcols,pverp+1-top_lev,sclr_dim)! w'sclr' (momentum levels) [{units vary} m/s] + real(r8) :: sclrp2(pcols,pverp+1-top_lev,sclr_dim) ! sclr'^2 (momentum levels) [{units vary}^2] + real(r8) :: sclrp3(pcols,pverp+1-top_lev,sclr_dim) ! sclr'^3 (thermo. levels) [{units vary}^3] + real(r8) :: sclrprtp(pcols,pverp+1-top_lev,sclr_dim) ! sclr'rt' (momentum levels) [{units vary} (kg/kg)] + real(r8) :: sclrpthlp(pcols,pverp+1-top_lev,sclr_dim) ! sclr'thlp' (momentum levels) [{units vary} (K)] + real(r8) :: sclrpthvp_inout(pcols,pverp,sclr_dim) ! sclr'th_v' (momentum levels) [{units vary} (K)] + real(r8) :: wp2rtp_inout(pcols,pverp+1-top_lev) ! w'^2 rt' (thermodynamic levels) + real(r8) :: wp2thlp_inout(pcols,pverp+1-top_lev) ! w'^2 thl' (thermodynamic levels) + real(r8) :: uprcp_inout(pcols,pverp+1-top_lev) ! < u' r_c' > (momentum levels) + real(r8) :: vprcp_inout(pcols,pverp+1-top_lev) ! < v' r_c' > (momentum levels) + real(r8) :: rc_coef_inout(pcols,pverp+1-top_lev) ! Coef. of X'r_c' in Eq. (34) (t-levs.) + real(r8) :: wp4_inout(pcols,pverp+1-top_lev) ! w'^4 (momentum levels + real(r8) :: wpup2_inout(pcols,pverp+1-top_lev) ! w'u'^2 (thermodynamic levels) + real(r8) :: wpvp2_inout(pcols,pverp+1-top_lev) ! w'v'^2 (thermodynamic levels) + real(r8) :: wp2up2_inout(pcols,pverp+1-top_lev) ! w'^2 u'^2 (momentum levels) + real(r8) :: wp2vp2_inout(pcols,pverp+1-top_lev) ! w'^2 v'^2 (momentum levels) + real(r8) :: hydromet(pcols,pverp+1-top_lev,hydromet_dim) + real(r8) :: wphydrometp(pcols,pverp+1-top_lev,hydromet_dim) + real(r8) :: wp2hmp(pcols,pverp+1-top_lev,hydromet_dim) + real(r8) :: rtphmp_zt(pcols,pverp+1-top_lev,hydromet_dim) + real(r8) :: thlphmp_zt (pcols,pverp+1-top_lev,hydromet_dim) + real(r8) :: bflx22(pcols) ! Variable for buoyancy flux for pbl [K m/s] + real(r8) :: khzm_out(pcols,pverp+1-top_lev) ! Eddy diffusivity of heat/moisture on momentum (i.e. interface) levels [m^2/s] + real(r8) :: khzt_out(pcols,pverp+1-top_lev) ! eddy diffusivity on thermo grids [m^2/s] + real(r8) :: qclvar_out(pcols,pverp+1-top_lev) ! cloud water variance [kg^2/kg^2] real(r8) :: qclvar(pcols,pverp) ! cloud water variance [kg^2/kg^2] - real(r8) :: zo ! roughness height [m] - real(r8) :: dz_g(pver) ! thickness of layer [m] + real(r8) :: zo(pcols) ! roughness height [m] + real(r8) :: dz_g(pcols,pver) ! thickness of layer [m] real(r8) :: relvarmax - real(r8) :: se_upper_a, se_upper_b, se_upper_diss - real(r8) :: tw_upper_a, tw_upper_b, tw_upper_diss + real(r8) :: se_upper_a(pcols), se_upper_b(pcols), se_upper_diss(pcols) + real(r8) :: tw_upper_a(pcols), tw_upper_b(pcols), tw_upper_diss(pcols) real(r8) :: grid_dx(pcols), grid_dy(pcols) ! CAM grid [m] - real(r8) :: host_dx, host_dy ! CAM grid [m] ! Variables below are needed to compute energy integrals for conservation real(r8) :: ke_a(pcols), ke_b(pcols), te_a(pcols), te_b(pcols) real(r8) :: wv_a(pcols), wv_b(pcols), wl_b(pcols), wl_a(pcols) - real(r8) :: se_dis, se_a(pcols), se_b(pcols), clubb_s(pver) + real(r8) :: se_dis(pcols), se_a(pcols), se_b(pcols), clubb_s(pcols,pver) real(r8) :: inv_exner_clubb(pcols,pverp) ! Inverse exner function consistent with CLUBB [-] real(r8) :: wpthlp_output(pcols,pverp) ! Heat flux output variable [W/m2] @@ -1695,18 +2137,18 @@ subroutine clubb_tend_cam( & real(r8) :: ustar2(pcols) ! Surface stress for PBL height [m2/s2] real(r8) :: rho(pcols,pverp) ! Midpoint density in CAM [kg/m^3] real(r8) :: thv(pcols,pver) ! virtual potential temperature [K] - real(r8) :: edsclr_out(pverp,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] + real(r8) :: edsclr_out(pcols,pverp,edsclr_dim) ! Scalars to be diffused through CLUBB [units vary] real(r8) :: rcm_in_layer(pcols,pverp) ! CLUBB in-cloud liquid water mixing ratio [kg/kg] real(r8) :: cloud_cover(pcols,pverp) ! CLUBB in-cloud cloud fraction [fraction] real(r8) :: wprcp(pcols,pverp) ! CLUBB liquid water flux [m/s kg/kg] real(r8) :: wpthvp_diag(pcols,pverp) ! CLUBB buoyancy flux [W/m^2] real(r8) :: rvm(pcols,pverp) real(r8) :: pdfp_rtp2(pcols, pverp) ! Calculated R-tot variance from pdf_params [kg^2/kg^2] - real(r8) :: rtp2_zt(pverp+1-top_lev) ! CLUBB R-tot variance on thermo levs + real(r8) :: rtp2_zt(pcols,pverp+1-top_lev) ! CLUBB R-tot variance on thermo levs real(r8) :: rtp2_zt_out(pcols, pverp) ! CLUBB R-tot variance on thermo levs [kg^2/kg^2] - real(r8) :: thl2_zt(pverp+1-top_lev) ! CLUBB Theta-l variance on thermo levs [K^2] + real(r8) :: thl2_zt(pcols,pverp+1-top_lev) ! CLUBB Theta-l variance on thermo levs [K^2] real(r8) :: thl2_zt_out(pcols, pverp) ! CLUBB Theta-l variance on thermo levs - real(r8) :: wp2_zt(pverp+1-top_lev) ! CLUBB W variance on theromo levs [m^2/s^2] + real(r8) :: wp2_zt(pcols,pverp+1-top_lev) ! CLUBB W variance on theromo levs [m^2/s^2] real(r8) :: wp2_zt_out(pcols, pverp) real(r8) :: dlf_liq_out(pcols, pverp) ! Detrained liquid water from ZM [kg/kg/s] real(r8) :: dlf_ice_out(pcols, pverp) ! Detrained ice water from ZM [kg/kg/s] @@ -1724,20 +2166,20 @@ subroutine clubb_tend_cam( & real(r8) :: rrho(pcols) ! Inverse of air density [1/kg/m^3] real(r8) :: kinwat(pcols) ! Kinematic water vapor flux [m/s] real(r8) :: latsub - real(r8) :: qrl_clubb(pverp+1-top_lev) - real(r8) :: qrl_zm(pverp+1-top_lev) - real(r8) :: thlp2_rad_out(pverp+1-top_lev) + real(r8) :: qrl_clubb(pcols,pverp+1-top_lev) + real(r8) :: qrl_zm(pcols,pverp+1-top_lev) + real(r8) :: thlp2_rad_out(pcols,pverp+1-top_lev) real(r8) :: apply_const, rtm_test real(r8) :: dl_rad, di_rad, dt_low - real(r8), dimension(nparams) :: clubb_params ! These adjustable CLUBB parameters (C1, C2 ...) - real(r8), dimension(sclr_dim) :: sclr_tol ! Tolerance on passive scalar [units vary] - character(len=200) :: temp1, sub ! Strings needed for CLUBB output real(kind=time_precision) :: time_elapsed ! time keep track of stats [s] integer :: stats_nsamp, stats_nout ! Stats sampling and output intervals for CLUBB [timestep] - real(r8) :: rtm_integral_1, rtm_integral_update, rtm_integral_forcing, rtm_integral_vtend, rtm_integral_ltend + real(r8) :: rtm_integral_vtend(pcols), & + rtm_integral_ltend(pcols) + + real(r8) :: rtm_integral_1, rtm_integral_update, rtm_integral_forcing ! --------------- ! ! Pointers ! @@ -1763,6 +2205,21 @@ subroutine clubb_tend_cam( & real(r8), pointer, dimension(:,:) :: rtpthvp ! r_t'th_v' (momentum levels) [kg/kg K] real(r8), pointer, dimension(:,:) :: thlpthvp ! th_l'th_v' (momentum levels) [K^2] real(r8), pointer, dimension(:,:) :: cloud_frac ! Cloud fraction (thermodynamic levels) [K^2] + real(r8), pointer, dimension(:,:) :: pdf_zm_w_1 !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_w_2 !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_1 !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_varnce_w_2 !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: pdf_zm_mixt_frac !work pointer for pdf_params_zm + real(r8), pointer, dimension(:,:) :: wp2rtp ! w'^2 rt' (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wp2thlp ! w'^2 thl' (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: uprcp ! < u' r_c' > (momentum levels) + real(r8), pointer, dimension(:,:) :: vprcp ! < v' r_c' > (momentum levels) + real(r8), pointer, dimension(:,:) :: rc_coef ! Coef. of X'r_c' in Eq. (34) (t-levs.) + real(r8), pointer, dimension(:,:) :: wp4 ! w'^4 (momentum levels + real(r8), pointer, dimension(:,:) :: wpup2 ! w'u'^2 (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wpvp2 ! w'v'^2 (thermodynamic levels) + real(r8), pointer, dimension(:,:) :: wp2up2 ! w'^2 u'^2 (momentum levels) + real(r8), pointer, dimension(:,:) :: wp2vp2 ! w'^2 v'^2 (momentum levels) real(r8), pointer, dimension(:,:) :: thlm ! mean temperature [K] real(r8), pointer, dimension(:,:) :: rtm ! mean moisture mixing ratio [kg/kg] real(r8), pointer, dimension(:,:) :: rcm ! CLUBB cloud water mixing ratio [kg/kg] @@ -1820,7 +2277,7 @@ subroutine clubb_tend_cam( & real(r8) :: rhmaxi(pcols) integer :: troplev(pcols) logical :: lqice(pcnst) - logical :: apply_to_surface + logical :: apply_to_surface(pcols) ! MF outputs to outfld real(r8), dimension(pcols,pverp) :: mf_dry_a_output, mf_moist_a_output, & @@ -1836,7 +2293,7 @@ subroutine clubb_tend_cam( & s_awu_output, s_awv_output, & mf_thlflx_output, mf_qtflx_output ! MF Plume - real(r8), dimension(pverp) :: mf_dry_a, mf_moist_a, & + real(r8), dimension(pcols,pverp) :: mf_dry_a, mf_moist_a, & mf_dry_w, mf_moist_w, & mf_dry_qt, mf_moist_qt, & mf_dry_thl, mf_moist_thl, & @@ -1849,7 +2306,7 @@ subroutine clubb_tend_cam( & s_awu, s_awv, & mf_thlflx, mf_qtflx ! MF local vars - real(r8), dimension(pverp) :: rtm_zm_in, thlm_zm_in, & ! momentum grid + real(r8), dimension(pcols,pverp) :: rtm_zm_in, thlm_zm_in, & ! momentum grid dzt, invrs_dzt, & ! thermodynamic grid invrs_exner_zt,& ! thermodynamic grid kappa_zt, qc_zt, & ! thermodynamic grid @@ -1858,12 +2315,19 @@ subroutine clubb_tend_cam( & real(r8) :: temp2d(pcols,pver), temp2dp(pcols,pverp) ! temporary array for holding scaled outputs - integer :: nlev intrinsic :: max character(len=*), parameter :: subr='clubb_tend_cam' + + type(pdf_parameter) :: pdf_params_single_col + + type(grid) :: gr(pcols) + integer :: begin_height, end_height + + type(nu_vertical_res_dep) :: nu_vert_res_dep(pcols) ! Vertical resolution dependent nu values + real(r8) :: lmin(pcols) #endif det_s(:) = 0.0_r8 @@ -1878,6 +2342,8 @@ subroutine clubb_tend_cam( & !-----------------------------------------------------------------------------------------------! !-----------------------------------------------------------------------------------------------! + call t_startf("clubb_tend_cam") + nlev = pver + 1 - top_lev rtp2_zt_out = 0._r8 @@ -1897,7 +2363,7 @@ subroutine clubb_tend_cam( & apply_const = 1._r8 ! Initialize to one, only if CLUBB's moments are advected else apply_const = 0._r8 ! Never want this if CLUBB's moments are not advected - endif + end if ! Get indicees for cloud and ice mass and cloud and ice number @@ -1922,7 +2388,7 @@ subroutine clubb_tend_cam( & if (clubb_do_liqsupersat) then call pbuf_get_field(pbuf, npccn_idx, npccn) - endif + end if ! Determine number of columns and which chunk computation is to be performed on @@ -1933,7 +2399,6 @@ subroutine clubb_tend_cam( & itim_old = pbuf_old_tim_idx() ! Establish associations between pointers and physics buffer fields - call pbuf_get_field(pbuf, wp2_idx, wp2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, wp3_idx, wp3, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, wpthlp_idx, wpthlp, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) @@ -1957,6 +2422,23 @@ subroutine clubb_tend_cam( & call pbuf_get_field(pbuf, thlpthvp_idx,thlpthvp) call pbuf_get_field(pbuf, rcm_idx, rcm) call pbuf_get_field(pbuf, cloud_frac_idx, cloud_frac) + + call pbuf_get_field(pbuf, pdf_zm_w_1_idx, pdf_zm_w_1, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, pdf_zm_w_2_idx, pdf_zm_w_2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, pdf_zm_varnce_w_1_idx, pdf_zm_varnce_w_1, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, pdf_zm_varnce_w_2_idx, pdf_zm_varnce_w_2, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + call pbuf_get_field(pbuf, pdf_zm_mixt_frac_idx, pdf_zm_mixt_frac, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) + + call pbuf_get_field(pbuf, wp2rtp_idx, wp2rtp) + call pbuf_get_field(pbuf, wp2thlp_idx, wp2thlp) + call pbuf_get_field(pbuf, uprcp_idx, uprcp) + call pbuf_get_field(pbuf, vprcp_idx, vprcp) + call pbuf_get_field(pbuf, rc_coef_idx, rc_coef) + call pbuf_get_field(pbuf, wp4_idx, wp4) + call pbuf_get_field(pbuf, wpup2_idx, wpup2) + call pbuf_get_field(pbuf, wpvp2_idx, wpvp2) + call pbuf_get_field(pbuf, wp2up2_idx, wp2up2) + call pbuf_get_field(pbuf, wp2vp2_idx, wp2vp2) call pbuf_get_field(pbuf, thlm_idx, thlm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, rtm_idx, rtm, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) call pbuf_get_field(pbuf, um_idx, um, start=(/1,1,itim_old/), kount=(/pcols,pverp,1/)) @@ -1995,12 +2477,21 @@ subroutine clubb_tend_cam( & call pbuf_get_field(pbuf, wprtp_mc_zt_idx, wprtp_mc_zt) call pbuf_get_field(pbuf, wpthlp_mc_zt_idx, wpthlp_mc_zt) call pbuf_get_field(pbuf, rtpthlp_mc_zt_idx, rtpthlp_mc_zt) + + ! Allocate arrays in the single column versions of pdf_params + call init_pdf_params_api( pverp+1-top_lev, 1, pdf_params_single_col ) + + ! Allocate pdf_params only if they aren't allocated already. + if ( .not. allocated(pdf_params_chnk(lchnk)%mixt_frac) ) then + call init_pdf_params_api( pverp+1-top_lev, ncol, pdf_params_chnk(lchnk) ) + call init_pdf_params_api( pverp+1-top_lev, ncol, pdf_params_zm_chnk(lchnk) ) + end if ! Initialize the apply_const variable (note special logic is due to eularian backstepping) if (clubb_do_adv .and. (is_first_step() .or. all(wpthlp(1:ncol,1:pver) == 0._r8))) then apply_const = 0._r8 ! On first time through do not remove constant ! from moments since it has not been added yet - endif + end if ! Set the ztodt timestep in pbuf for SILHS ztodtptr(:) = 1.0_r8*hdtime @@ -2064,7 +2555,7 @@ subroutine clubb_tend_cam( & call outfld( 'QITENDICE', qitend, pcols, lchnk ) call outfld( 'NITENDICE', initend, pcols, lchnk ) - endif + end if ! Determine CLUBB time step and make it sub-step friendly @@ -2083,7 +2574,7 @@ subroutine clubb_tend_cam( & if (dtime > hdtime) then dtime = hdtime - endif + end if ! Now check to see if CLUBB time step divides evenly into ! the host model time step. If not, force it to divide evenly. @@ -2096,14 +2587,14 @@ subroutine clubb_tend_cam( & do while (dtime > clubb_timestep) dtime = dtime/2._r8 end do - endif + end if ! If resulting host model time step and CLUBB time step do not divide evenly ! into each other, have model throw a fit. if (mod(hdtime,dtime) .ne. 0) then call endrun(subr//': CLUBB time step and HOST time step NOT compatible') - endif + end if ! determine number of timesteps CLUBB core should be advanced, ! host time step divided by CLUBB time step @@ -2111,9 +2602,9 @@ subroutine clubb_tend_cam( & ! Initialize forcings for transported scalars to zero - sclrm_forcing(:,:) = 0._r8 - edsclrm_forcing(:,:) = 0._r8 - sclrm(:,:) = 0._r8 + sclrm_forcing(:,:,:) = 0._r8 + edsclrm_forcing(:,:,:) = 0._r8 + sclrm(:,:,:) = 0._r8 ! Compute inverse exner function consistent with CLUBB's definition, which uses a constant ! surface pressure. CAM's exner (in state) does not. Therefore, for consistent @@ -2128,7 +2619,6 @@ subroutine clubb_tend_cam( & ! At each CLUBB call, initialize mean momentum and thermo CLUBB state ! from the CAM state - do k=1,pver ! loop over levels do i=1,ncol ! loop over columns @@ -2155,8 +2645,8 @@ subroutine clubb_tend_cam( & wp3(i,k) = state1%q(i,k,ixwp3) - (wp3_const*apply_const) up2(i,k) = state1%q(i,k,ixup2) vp2(i,k) = state1%q(i,k,ixvp2) - endif - endif + end if + end if enddo enddo @@ -2168,8 +2658,8 @@ subroutine clubb_tend_cam( & apply_const = 1._r8 else apply_const = 0._r8 - endif - endif + end if + end if rtm(1:ncol,pverp) = rtm(1:ncol,pver) um(1:ncol,pverp) = state1%u(1:ncol,pver) @@ -2186,7 +2676,7 @@ subroutine clubb_tend_cam( & wp3(1:ncol,pverp)=wp3(1:ncol,pver) up2(1:ncol,pverp)=up2(1:ncol,pver) vp2(1:ncol,pverp)=vp2(1:ncol,pver) - endif + end if ! Compute virtual potential temperature, which is needed for CLUBB do k=1,pver @@ -2224,792 +2714,1048 @@ subroutine clubb_tend_cam( & s_awv_output(:,:) = 0._r8 mf_thlflx_output(:,:) = 0._r8 mf_qtflx_output(:,:) = 0._r8 + + call t_startf("clubb_tend_cam_i_loop") + + ! Determine Coriolis force at given latitude. This is never used + ! when CLUBB is implemented in a host model, therefore just set + ! to zero. + fcor(:) = 0._r8 + + ! Define the CLUBB momentum grid (in height, units of m) + do k=1, nlev+1 + do i=1, ncol + zi_g(i,k) = state1%zi(i,pverp-k+1)-state1%zi(i,pver+1) + end do + end do - ! Loop over all columns in lchnk to advance CLUBB core - do i=1,ncol ! loop over columns - - ! Determine Coriolis force at given latitude. This is never used - ! when CLUBB is implemented in a host model, therefore just set - ! to zero. - fcor = 0._r8 + ! Define the CLUBB thermodynamic grid (in units of m) + do k=1, nlev + do i=1, ncol + zt_g(i,k+1) = state1%zm(i,pver-k+1)-state1%zi(i,pver+1) + end do + end do - ! Define the CLUBB momentum grid (in height, units of m) - do k=1,nlev+1 - zi_g(k) = state1%zi(i,pverp-k+1)-state1%zi(i,pver+1) - enddo + do k=1, pver + do i=1, ncol + dz_g(i,k) = state1%zi(i,k)-state1%zi(i,k+1) ! compute thickness + end do + end do + + ! Thermodynamic ghost point is below surface + do i=1, ncol + zt_g(i,1) = -1._r8*zt_g(i,2) + end do + + do i=1, ncol + ! Set the elevation of the surface + sfc_elevation(i) = state1%zi(i,pver+1) + end do - ! Define the CLUBB thermodynamic grid (in units of m) - do k=1,nlev - zt_g(k+1) = state1%zm(i,pver-k+1)-state1%zi(i,pver+1) + ! Compute thermodynamic stuff needed for CLUBB on thermo levels. + ! Inputs for the momentum levels are set below setup_clubb core + do k=1,nlev + do i=1, ncol + p_in_Pa(i,k+1) = state1%pmid(i,pver-k+1) ! Pressure profile + exner(i,k+1) = 1._r8/inv_exner_clubb(i,pver-k+1) + rho_ds_zt(i,k+1) = (1._r8/gravit)*(state1%pdel(i,pver-k+1)/dz_g(i,pver-k+1)) + invrs_rho_ds_zt(i,k+1) = 1._r8/(rho_ds_zt(i,k+1)) ! Inverse ds rho at thermo + rho_in(i,k+1) = rho_ds_zt(i,k+1) ! rho on thermo + thv_ds_zt(i,k+1) = thv(i,pver-k+1) ! thetav on thermo + rfrzm(i,k+1) = state1%q(i,pver-k+1,ixcldice) + radf(i,k+1) = radf_clubb(i,pver-k+1) + qrl_clubb(i,k+1) = qrl(i,pver-k+1)/(cpairv(i,k,lchnk)*state1%pdel(i,pver-k+1)) + end do + end do + + ! Compute mean w wind on thermo grid, convert from omega to w + do k=1,nlev + do i=1,ncol + wm_zt(i,k+1) = -1._r8*state1%omega(i,pver-k+1)/(rho_in(i,k+1)*gravit) end do + end do - do k=1,pver - dz_g(k) = state1%zi(i,k)-state1%zi(i,k+1) ! compute thickness - enddo - - ! Thermodynamic ghost point is below surface - zt_g(1) = -1._r8*zt_g(2) + ! Below computes the same stuff for the ghost point. May or may + ! not be needed, just to be safe to avoid NaN's + do i=1, ncol + rho_ds_zt(i,1) = rho_ds_zt(i,2) + invrs_rho_ds_zt(i,1) = invrs_rho_ds_zt(i,2) + rho_in(i,1) = rho_ds_zt(i,2) + thv_ds_zt(i,1) = thv_ds_zt(i,2) + rho_zt(i,:) = rho_in(i,:) + p_in_Pa(i,1) = p_in_Pa(i,2) + exner(i,1) = exner(i,2) + rfrzm(i,1) = rfrzm(i,2) + radf(i,1) = radf(i,2) + qrl_clubb(i,1) = qrl_clubb(i,2) + wm_zt(i,1) = 0._r8 + end do + + + ! ------------------------------------------------- ! + ! Begin case specific code for SCAM cases. ! + ! This section of code block is NOT called in ! + ! global simulations ! + ! ------------------------------------------------- ! + if (single_column) then + + ! Initialize zo if variable ustar is used + if (cam_in%landfrac(1) >= 0.5_r8) then + zo(1) = 0.035_r8 + else + zo(1) = 0.0001_r8 + end if - ! Set the elevation of the surface - sfc_elevation = state1%zi(i,pver+1) - - ! Set the grid size - host_dx = grid_dx(i) - host_dy = grid_dy(i) + ! Compute surface wind (ubar) + ubar = sqrt(um(1,pver)**2+vm(1,pver)**2) + if (ubar < 0.25_r8) ubar = 0.25_r8 + + ! Below denotes case specifics for surface momentum + ! and thermodynamic fluxes, depending on the case - ! Compute thermodynamic stuff needed for CLUBB on thermo levels. - ! Inputs for the momentum levels are set below setup_clubb core - do k=1,nlev - p_in_Pa(k+1) = state1%pmid(i,pver-k+1) ! Pressure profile - exner(k+1) = 1._r8/inv_exner_clubb(i,pver-k+1) - rho_ds_zt(k+1) = (1._r8/gravit)*(state1%pdel(i,pver-k+1)/dz_g(pver-k+1)) - invrs_rho_ds_zt(k+1) = 1._r8/(rho_ds_zt(k+1)) ! Inverse ds rho at thermo - rho_in(k+1) = rho_ds_zt(k+1) ! rho on thermo - thv_ds_zt(k+1) = thv(i,pver-k+1) ! thetav on thermo - rfrzm(k+1) = state1%q(i,pver-k+1,ixcldice) - radf(k+1) = radf_clubb(i,pver-k+1) - qrl_clubb(k+1) = qrl(i,pver-k+1)/(cpairv(i,k,lchnk)*state1%pdel(i,pver-k+1)) - enddo + ! Define ustar (based on case, if not variable) + ustar = 0.25_r8 ! Initialize ustar in case no case + + if(trim(scm_clubb_iop_name) == 'BOMEX_5day') then + ustar = 0.28_r8 + end if + + if(trim(scm_clubb_iop_name) == 'ATEX_48hr') then + ustar = 0.30_r8 + end if + + if(trim(scm_clubb_iop_name) == 'RICO_3day') then + ustar = 0.28_r8 + end if - ! Below computes the same stuff for the ghost point. May or may - ! not be needed, just to be safe to avoid NaN's - rho_ds_zt(1) = rho_ds_zt(2) - invrs_rho_ds_zt(1) = invrs_rho_ds_zt(2) - rho_in(1) = rho_ds_zt(2) - thv_ds_zt(1) = thv_ds_zt(2) - rho_zt(:) = rho_in(:) - p_in_Pa(1) = p_in_Pa(2) - exner(1) = exner(2) - rfrzm(1) = rfrzm(2) - radf(1) = radf(2) - qrl_clubb(1) = qrl_clubb(2) - - ! Compute mean w wind on thermo grid, convert from omega to w - wm_zt(1) = 0._r8 - do k=1,nlev - wm_zt(k+1) = -1._r8*state1%omega(i,pver-k+1)/(rho_in(k+1)*gravit) - enddo - - ! ------------------------------------------------- ! - ! Begin case specific code for SCAM cases. ! - ! This section of code block NOT called in ! - ! global simulations ! - ! ------------------------------------------------- ! + if(trim(scm_clubb_iop_name) == 'arm97' .or. trim(scm_clubb_iop_name) == 'gate' .or. & + trim(scm_clubb_iop_name) == 'toga' .or. trim(scm_clubb_iop_name) == 'mpace' .or. & + trim(scm_clubb_iop_name) == 'ARM_CC') then + + bflx22(1) = (gravit/theta0)*wpthlp_sfc(1) + ustar = diag_ustar(zt_g(1,2),bflx22(1),ubar,zo(1)) + end if + + ! Compute the surface momentum fluxes, if this is a SCAM simulation + upwp_sfc(1) = -um(1,pver)*ustar**2/ubar + vpwp_sfc(1) = -vm(1,pver)*ustar**2/ubar + + end if - if (single_column) then + ! Define surface sources for transported variables for diffusion, will + ! be zero as these tendencies are done in vertical_diffusion + do ixind=1,edsclr_dim + do i=1,ncol + wpedsclrp_sfc(i,ixind) = 0._r8 + end do + end do + + ! Set stats output and increment equal to CLUBB and host dt + stats_tsamp = dtime + stats_tout = hdtime + + stats_nsamp = nint(stats_tsamp/dtime) + stats_nout = nint(stats_tout/dtime) + + ! Heights need to be set at each timestep. Therefore, recall + ! setup_grid and setup_parameters for this. + + ! Set-up CLUBB core at each CLUBB call because heights can change + ! Important note: do not make any calls that use CLUBB grid-height + ! operators (such as zt2zm_api, etc.) until AFTER the + ! call to setup_grid_heights_api. + do i=1,ncol + call setup_grid_api( nlev+1, sfc_elevation(i), l_implemented, & ! intent(in) + grid_type, zi_g(i,2), zi_g(i,1), zi_g(i,nlev+1), & ! intent(in) + zi_g(i,:), zt_g(i,:), & ! intent(in) + gr(i), begin_height, end_height ) ! intent(out) + end do - ! Initialize zo if variable ustar is used + do i=1,ncol + call setup_parameters_api( zi_g(i,2), clubb_params, nlev+1, grid_type, & + zi_g(i,:), zt_g(i,:), & + clubb_config_flags%l_prescribed_avg_deltaz, & + lmin(i), nu_vert_res_dep(i), err_code ) + if ( err_code == clubb_fatal_error ) then + call endrun(subr//': Fatal error in CLUBB setup_parameters') + end if + end do - if (cam_in%landfrac(i) >= 0.5_r8) then - zo = 0.035_r8 - else - zo = 0.0001_r8 - endif + ! Define forcings from CAM to CLUBB as zero for momentum and thermo, + ! forcings already applied through CAM + thlm_forcing(:,:) = 0._r8 + rtm_forcing(:,:) = 0._r8 + um_forcing(:,:) = 0._r8 + vm_forcing(:,:) = 0._r8 - ! Compute surface wind (ubar) - ubar = sqrt(um(i,pver)**2+vm(i,pver)**2) - if (ubar < 0.25_r8) ubar = 0.25_r8 - - ! Below denotes case specifics for surface momentum - ! and thermodynamic fluxes, depending on the case - ! Define ustar (based on case, if not variable) - ustar = 0.25_r8 ! Initialize ustar in case no case - - if(trim(scm_clubb_iop_name) == 'BOMEX_5day') then - ustar = 0.28_r8 - endif + rtm_ref(:,:) = 0.0_r8 + thlm_ref(:,:) = 0.0_r8 + um_ref(:,:) = 0.0_r8 + vm_ref(:,:) = 0.0_r8 + ug(:,:) = 0.0_r8 + vg(:,:) = 0.0_r8 - if(trim(scm_clubb_iop_name) == 'ATEX_48hr') then - ustar = 0.30_r8 - endif + ! Add forcings for SILHS covariance contributions + rtp2_forcing(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, rtp2_mc_zt(1:ncol,:) ) + thlp2_forcing(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, thlp2_mc_zt(1:ncol,:) ) + wprtp_forcing(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, wprtp_mc_zt(1:ncol,:) ) + wpthlp_forcing(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, wpthlp_mc_zt(1:ncol,:) ) + rtpthlp_forcing(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, rtpthlp_mc_zt(1:ncol,:) ) + + ! Zero out SILHS covariance contribution terms + rtp2_mc_zt(:,:) = 0.0_r8 + thlp2_mc_zt(:,:) = 0.0_r8 + wprtp_mc_zt(:,:) = 0.0_r8 + wpthlp_mc_zt(:,:) = 0.0_r8 + rtpthlp_mc_zt(:,:) = 0.0_r8 - if(trim(scm_clubb_iop_name) == 'RICO_3day') then - ustar = 0.28_r8 - endif - if(trim(scm_clubb_iop_name) == 'arm97' .or. trim(scm_clubb_iop_name) == 'gate' .or. & - trim(scm_clubb_iop_name) == 'toga' .or. trim(scm_clubb_iop_name) == 'mpace' .or. & - trim(scm_clubb_iop_name) == 'ARM_CC') then - - bflx22 = (gravit/theta0)*wpthlp_sfc - ustar = diag_ustar(zt_g(2),bflx22,ubar,zo) - endif - - ! Compute the surface momentum fluxes, if this is a SCAM simulation - upwp_sfc = -um(i,pver)*ustar**2/ubar - vpwp_sfc = -vm(i,pver)*ustar**2/ubar + ! Compute some inputs from the thermodynamic grid + ! to the momentum grid + rho_ds_zm(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, rho_ds_zt(1:ncol,:)) + rho_zm(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, rho_zt(1:ncol,:)) + invrs_rho_ds_zm(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, invrs_rho_ds_zt(1:ncol,:)) + thv_ds_zm(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, thv_ds_zt(1:ncol,:)) + wm_zm(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, wm_zt(1:ncol,:)) + + ! Surface fluxes provided by host model + do i=1,ncol + wpthlp_sfc(i) = cam_in%shf(i)/(cpair*rho_ds_zm(i,1)) ! Sensible heat flux + wprtp_sfc(i) = cam_in%cflx(i,1)/rho_ds_zm(i,1) ! Moisture flux (check rho) + upwp_sfc(i) = cam_in%wsx(i)/rho_ds_zm(i,1) ! Surface meridional momentum flux + vpwp_sfc(i) = cam_in%wsy(i)/rho_ds_zm(i,1) ! Surface zonal momentum flux + end do - endif + ! Need to flip arrays around for CLUBB core + do k=1,nlev+1 + do i=1,ncol + um_in(i,k) = um(i,pverp-k+1) + vm_in(i,k) = vm(i,pverp-k+1) + upwp_in(i,k) = upwp(i,pverp-k+1) + vpwp_in(i,k) = vpwp(i,pverp-k+1) + wpthvp_in(i,k) = wpthvp(i,pverp-k+1) + wp2thvp_in(i,k) = wp2thvp(i,pverp-k+1) + rtpthvp_in(i,k) = rtpthvp(i,pverp-k+1) + thlpthvp_in(i,k)= thlpthvp(i,pverp-k+1) + up2_in(i,k) = up2(i,pverp-k+1) + vp2_in(i,k) = vp2(i,pverp-k+1) + up3_in(i,k) = up3(i,pverp-k+1) + vp3_in(i,k) = vp3(i,pverp-k+1) + wp2_in(i,k) = wp2(i,pverp-k+1) + wp3_in(i,k) = wp3(i,pverp-k+1) + rtp2_in(i,k) = rtp2(i,pverp-k+1) + thlp2_in(i,k) = thlp2(i,pverp-k+1) + rtp3_in(i,k) = rtp3(i,pverp-k+1) + thlp3_in(i,k) = thlp3(i,pverp-k+1) + thlm_in(i,k) = thlm(i,pverp-k+1) + rtm_in(i,k) = rtm(i,pverp-k+1) + rvm_in(i,k) = rvm(i,pverp-k+1) + wprtp_in(i,k) = wprtp(i,pverp-k+1) + wpthlp_in(i,k) = wpthlp(i,pverp-k+1) + rtpthlp_in(i,k) = rtpthlp(i,pverp-k+1) + rcm_inout(i,k) = rcm(i,pverp-k+1) + cloud_frac_inout(i,k) = cloud_frac(i,pverp-k+1) + + ! We only need to copy pdf_params from pbuf if this is a restart and + ! we're calling pdf_closure at the end of advance_clubb_core + if ( is_first_restart_step() & + .and. clubb_config_flags%ipdf_call_placement .eq. ipdf_post_advance_fields ) then + pdf_params_zm_chnk(lchnk)%w_1(i,k) = pdf_zm_w_1(i,pverp-k+1) + pdf_params_zm_chnk(lchnk)%w_2(i,k) = pdf_zm_w_2(i,pverp-k+1) + pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) = pdf_zm_varnce_w_1(i,pverp-k+1) + pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) = pdf_zm_varnce_w_2(i,pverp-k+1) + pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) = pdf_zm_mixt_frac(i,pverp-k+1) + end if + + sclrpthvp_inout(i,k,:) = 0._r8 + wp2rtp_inout(i,k) = wp2rtp(i,pverp-k+1) + wp2thlp_inout(i,k) = wp2thlp(i,pverp-k+1) + uprcp_inout(i,k) = uprcp(i,pverp-k+1) + vprcp_inout(i,k) = vprcp(i,pverp-k+1) + rc_coef_inout(i,k) = rc_coef(i,pverp-k+1) + wp4_inout(i,k) = wp4(i,pverp-k+1) + wpup2_inout(i,k) = wpup2(i,pverp-k+1) + wpvp2_inout(i,k) = wpvp2(i,pverp-k+1) + wp2up2_inout(i,k) = wp2up2(i,pverp-k+1) + wp2vp2_inout(i,k) = wp2vp2(i,pverp-k+1) + ice_supersat_frac_inout(i,k) = ice_supersat_frac(i,pverp-k+1) + end do + end do + + do k=2,nlev+1 + do i=1,ncol + pre_in(i,k) = prer_evap(i,pverp-k+1) + end do + end do + + do i=1,ncol + pre_in(i,1) = pre_in(i,2) + end do + + ! Initialize these to prevent crashing behavior + do k=1,nlev+1 + do i=1,ncol + wprcp_out(i,k) = 0._r8 + rcm_in_layer_out(i,k) = 0._r8 + cloud_cover_out(i,k) = 0._r8 + edsclr_in(i,k,:) = 0._r8 + khzm_out(i,k) = 0._r8 + khzt_out(i,k) = 0._r8 + end do + end do - ! Define surface sources for transported variables for diffusion, will - ! be zero as these tendencies are done in vertical_diffusion - do ixind=1,edsclr_dim - wpedsclrp_sfc(ixind) = 0._r8 - enddo + ! higher order scalar stuff, put to zero + do ixind=1, sclr_dim + do k=1, nlev+1 + do i=1, ncol + sclrm(i,k,ixind) = 0._r8 + wpsclrp(i,k,ixind) = 0._r8 + sclrp2(i,k,ixind) = 0._r8 + sclrp3(i,k,ixind) = 0._r8 + sclrprtp(i,k,ixind) = 0._r8 + sclrpthlp(i,k,ixind) = 0._r8 + wpsclrp_sfc(i,ixind) = 0._r8 + end do + end do + end do + + do ixind=1, hydromet_dim + do k=1, nlev+1 + do i=1, ncol + hydromet(i,k,ixind) = 0._r8 + wphydrometp(i,k,ixind) = 0._r8 + wp2hmp(i,k,ixind) = 0._r8 + rtphmp_zt(i,k,ixind) = 0._r8 + thlphmp_zt(i,k,ixind) = 0._r8 + end do + end do + end do - ! Set stats output and increment equal to CLUBB and host dt - stats_tsamp = dtime - stats_tout = hdtime - - ! Heights need to be set at each timestep. Therefore, recall - ! setup_grid and setup_parameters for this. - - ! Read in parameters for CLUBB. Just read in default values - call read_parameters_api( -99, "", clubb_params ) - - ! Set-up CLUBB core at each CLUBB call because heights can change - ! Important note: do not make any calls that use CLUBB grid-height - ! operators (such as zt2zm_api, etc.) until AFTER the - ! call to setup_grid_heights_api. - call setup_grid_heights_api(l_implemented, grid_type, zi_g(2), & - zi_g(1), zi_g, zt_g) - - call setup_parameters_api( zi_g(2), clubb_params, nlev+1, grid_type, & - zi_g, zt_g, & - clubb_config_flags%l_prescribed_avg_deltaz, & - err_code ) - - ! Define forcings from CAM to CLUBB as zero for momentum and thermo, - ! forcings already applied through CAM - thlm_forcing = 0._r8 - rtm_forcing = 0._r8 - um_forcing = 0._r8 - vm_forcing = 0._r8 - - wprtp_forcing = 0._r8 - wpthlp_forcing = 0._r8 - rtp2_forcing = 0._r8 - thlp2_forcing = 0._r8 - rtpthlp_forcing = 0._r8 - - ice_supersat_frac_out = 0._r8 - - ! Add forcings for SILHS covariance contributions - rtp2_forcing = rtp2_forcing + zt2zm_api( rtp2_mc_zt(i,:) ) - thlp2_forcing = thlp2_forcing + zt2zm_api( thlp2_mc_zt(i,:) ) - wprtp_forcing = wprtp_forcing + zt2zm_api( wprtp_mc_zt(i,:) ) - wpthlp_forcing = wpthlp_forcing + zt2zm_api( wpthlp_mc_zt(i,:) ) - rtpthlp_forcing = rtpthlp_forcing + zt2zm_api( rtpthlp_mc_zt(i,:) ) - - ! Zero out SILHS covariance contribution terms - rtp2_mc_zt(i,:) = 0.0_r8 - thlp2_mc_zt(i,:) = 0.0_r8 - wprtp_mc_zt(i,:) = 0.0_r8 - wpthlp_mc_zt(i,:) = 0.0_r8 - rtpthlp_mc_zt(i,:) = 0.0_r8 - - ! Compute some inputs from the thermodynamic grid - ! to the momentum grid - rho_ds_zm = zt2zm_api(rho_ds_zt) - rho_zm = zt2zm_api(rho_zt) - invrs_rho_ds_zm = zt2zm_api(invrs_rho_ds_zt) - thv_ds_zm = zt2zm_api(thv_ds_zt) - wm_zm = zt2zm_api(wm_zt) - - ! Surface fluxes provided by host model - wpthlp_sfc = cam_in%shf(i)/(cpair*rho_ds_zm(1)) ! Sensible heat flux - wprtp_sfc = cam_in%cflx(i,1)/rho_ds_zm(1) ! Moisture flux (check rho) - upwp_sfc = cam_in%wsx(i)/rho_ds_zm(1) ! Surface meridional momentum flux - vpwp_sfc = cam_in%wsy(i)/rho_ds_zm(1) ! Surface zonal momentum flux + ! pressure,exner on momentum grid needed for mass flux calc. + if (do_clubb_mf) then - ! Need to flip arrays around for CLUBB core - do k=1,nlev+1 - um_in(k) = um(i,pverp-k+1) - vm_in(k) = vm(i,pverp-k+1) - upwp_in(k) = upwp(i,pverp-k+1) - vpwp_in(k) = vpwp(i,pverp-k+1) - wpthvp_in(k) = wpthvp(i,pverp-k+1) - wp2thvp_in(k) = wp2thvp(i,pverp-k+1) - rtpthvp_in(k) = rtpthvp(i,pverp-k+1) - thlpthvp_in(k)= thlpthvp(i,pverp-k+1) - up2_in(k) = up2(i,pverp-k+1) - vp2_in(k) = vp2(i,pverp-k+1) - up3_in(k) = up3(i,pverp-k+1) - vp3_in(k) = vp3(i,pverp-k+1) - wp2_in(k) = wp2(i,pverp-k+1) - wp3_in(k) = wp3(i,pverp-k+1) - rtp2_in(k) = rtp2(i,pverp-k+1) - thlp2_in(k) = thlp2(i,pverp-k+1) - rtp3_in(k) = rtp3(i,pverp-k+1) - thlp3_in(k) = thlp3(i,pverp-k+1) - thlm_in(k) = thlm(i,pverp-k+1) - rtm_in(k) = rtm(i,pverp-k+1) - rvm_in(k) = rvm(i,pverp-k+1) - wprtp_in(k) = wprtp(i,pverp-k+1) - wpthlp_in(k) = wpthlp(i,pverp-k+1) - rtpthlp_in(k) = rtpthlp(i,pverp-k+1) - rcm_inout(k) = rcm(i,pverp-k+1) - cloud_frac_inout(k) = cloud_frac(i,pverp-k+1) - sclrpthvp_inout(k,:) = 0._r8 - - if (k .ne. 1) then - pre_in(k) = prer_evap(i,pverp-k+1) - endif - - ! Initialize these to prevent crashing behavior - wprcp_out(k) = 0._r8 - rcm_in_layer_out(k) = 0._r8 - cloud_cover_out(k) = 0._r8 - edsclr_in(k,:) = 0._r8 - khzm_out(k) = 0._r8 - khzt_out(k) = 0._r8 - - ! higher order scalar stuff, put to zero - sclrm(k,:) = 0._r8 - wpsclrp(k,:) = 0._r8 - sclrp2(k,:) = 0._r8 - sclrp3(k,:) = 0._r8 - sclrprtp(k,:) = 0._r8 - sclrpthlp(k,:) = 0._r8 - wpsclrp_sfc(:) = 0._r8 - hydromet(k,:) = 0._r8 - wphydrometp(k,:) = 0._r8 - wp2hmp(k,:) = 0._r8 - rtphmp_zt(k,:) = 0._r8 - thlphmp_zt(k,:) = 0._r8 - - enddo - pre_in(1) = pre_in(2) + do k=1,pver + do i=1,ncol + kappa_zt(i,k+1) = (rairv(i,pver-k+1,lchnk)/cpairv(i,pver-k+1,lchnk)) + qc_zt(i,k+1) = state1%q(i,pver-k+1,ixcldliq) + invrs_exner_zt(i,k+1) = inv_exner_clubb(i,pver-k+1) + end do + end do + + do i=1,ncol + kappa_zt(i,1) = kappa_zt(i,2) + qc_zt(i,1) = qc_zt(i,2) + invrs_exner_zt(i,1) = invrs_exner_zt(i,2) + end do - ! pressure,exner on momentum grid needed for mass flux calc. - if (do_clubb_mf) then - do k=1,pver - kappa_zt(k+1) = (rairv(i,pver-k+1,lchnk)/cpairv(i,pver-k+1,lchnk)) - qc_zt(k+1) = state1%q(i,pver-k+1,ixcldliq) - invrs_exner_zt(k+1) = inv_exner_clubb(i,pver-k+1) - enddo - kappa_zt(1) = kappa_zt(2) - qc_zt(1) = qc_zt(2) - invrs_exner_zt(1) = invrs_exner_zt(2) - - kappa_zm = zt2zm_api(kappa_zt) - do k=1,pverp - p_in_Pa_zm(k) = state1%pint(i,pverp-k+1) - invrs_exner_zm(k) = 1._r8/((p_in_Pa_zm(k)/p0_clubb)**(kappa_zm(k))) - enddo - end if - - if (clubb_do_adv) then - if (macmic_it == 1) then - wp2_in=zt2zm_api(wp2_in) - wpthlp_in=zt2zm_api(wpthlp_in) - wprtp_in=zt2zm_api(wprtp_in) - up2_in=zt2zm_api(up2_in) - vp2_in=zt2zm_api(vp2_in) - thlp2_in=zt2zm_api(thlp2_in) - rtp2_in=zt2zm_api(rtp2_in) - rtpthlp_in=zt2zm_api(rtpthlp_in) - - do k=1,nlev+1 - thlp2_in(k)=max(thl_tol**2,thlp2_in(k)) - rtp2_in(k)=max(rt_tol**2,rtp2_in(k)) - wp2_in(k)=max(w_tol_sqd,wp2_in(k)) - up2_in(k)=max(w_tol_sqd,up2_in(k)) - vp2_in(k)=max(w_tol_sqd,vp2_in(k)) - enddo - endif - endif - - ! Do the same for tracers - icnt=0 - do ixind=1,pcnst - if (lq(ixind)) then - icnt=icnt+1 - do k=1,nlev - edsclr_in(k+1,icnt) = state1%q(i,pver-k+1,ixind) - enddo - edsclr_in(1,icnt) = edsclr_in(2,icnt) - end if - enddo + kappa_zm(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, kappa_zt(1:ncol,:)) - if (do_expldiff) then - do k=1,nlev - edsclr_in(k+1,icnt+1) = thlm(i,pver-k+1) - edsclr_in(k+1,icnt+2) = rtm(i,pver-k+1) - enddo + do k=1,pverp + do i=1,ncol + p_in_Pa_zm(i,k) = state1%pint(i,pverp-k+1) + invrs_exner_zm(i,k) = 1._r8/((p_in_Pa_zm(i,k)/p0_clubb)**(kappa_zm(i,k))) + end do + end do + + end if + + + if (clubb_do_adv) then + if (macmic_it == 1) then - edsclr_in(1,icnt+1) = edsclr_in(2,icnt+1) - edsclr_in(1,icnt+2) = edsclr_in(2,icnt+2) - endif + wp2_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, wp2_in(1:ncol,:)) + wpthlp_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, wpthlp_in(1:ncol,:)) + wprtp_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, wprtp_in(1:ncol,:)) + up2_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, up2_in(1:ncol,:)) + vp2_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, vp2_in(1:ncol,:)) + thlp2_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, thlp2_in(1:ncol,:)) + rtp2_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, rtp2_in(1:ncol,:)) + rtpthlp_in(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, rtpthlp_in(1:ncol,:)) + + do k=1,nlev+1 + do i=1,ncol + thlp2_in(i,k) = max(thl_tol**2,thlp2_in(i,k)) + rtp2_in(i,k) = max(rt_tol**2,rtp2_in(i,k)) + wp2_in(i,k) = max(w_tol_sqd,wp2_in(i,k)) + up2_in(i,k) = max(w_tol_sqd,up2_in(i,k)) + vp2_in(i,k) = max(w_tol_sqd,vp2_in(i,k)) + end do + end do + + end if + end if - stats_nsamp = nint(stats_tsamp/dtime) - stats_nout = nint(stats_tout/dtime) + ! Do the same for tracers + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + + icnt = icnt+1 + + do k=1,nlev + do i=1,ncol + edsclr_in(i,k+1,icnt) = state1%q(i,pver-k+1,ixind) + end do + end do + + do i=1,ncol + edsclr_in(i,1,icnt) = edsclr_in(i,2,icnt) + end do + + end if + end do - do t=1,nadv ! do needed number of "sub" timesteps for each CAM step - ! Increment the statistics then being stats timestep - if (l_stats) then - call stats_begin_timestep_api(t, stats_nsamp, stats_nout) - endif - - !####################################################################### - !###################### CALL MF DIAGNOSTIC PLUMES ###################### - !####################################################################### - if (do_clubb_mf) then + if (clubb_l_do_expldiff_rtm_thlm) then + do k=1,nlev + do i=1, ncol + edsclr_in(i,k+1,icnt+1) = thlm(i,pver-k+1) + edsclr_in(i,k+1,icnt+2) = rtm(i,pver-k+1) + end do + end do + + do i=1, ncol + edsclr_in(i,1,icnt+1) = edsclr_in(i,2,icnt+1) + edsclr_in(i,1,icnt+2) = edsclr_in(i,2,icnt+2) + end do + + end if + + + do t=1,nadv ! do needed number of "sub" timesteps for each CAM step + + ! Increment the statistics then being stats timestep + if (l_stats) then + call stats_begin_timestep_api(t, stats_nsamp, stats_nout) + end if - do k=2,pverp - dzt(k) = zi_g(k) - zi_g(k-1) - enddo - dzt(1) = dzt(2) - invrs_dzt = 1._r8/dzt - - rtm_zm_in = zt2zm_api( rtm_in ) - thlm_zm_in = zt2zm_api( thlm_in ) - - call integrate_mf( pverp, dzt, zi_g, p_in_Pa_zm, invrs_exner_zm, & ! input - p_in_Pa, invrs_exner_zt, & ! input - um_in, vm_in, thlm_in, rtm_in, thv_ds_zt, & ! input - thlm_zm_in, rtm_zm_in, & ! input - wpthlp_sfc, wprtp_sfc, pblh(i), & ! input - mf_dry_a, mf_moist_a, & ! output - plume diagnostics - mf_dry_w, mf_moist_w, & ! output - plume diagnostics - mf_dry_qt, mf_moist_qt, & ! output - plume diagnostics - mf_dry_thl,mf_moist_thl, & ! output - plume diagnostics - mf_dry_u, mf_moist_u, & ! output - plume diagnostics - mf_dry_v, mf_moist_v, & ! output - plume diagnostics - mf_moist_qc, & ! output - plume diagnostics - s_ae, s_aw, & ! output - plume diagnostics - s_awthl, s_awqt, & ! output - plume diagnostics - s_awql, s_awqi, & ! output - plume diagnostics - s_awu, s_awv, & ! output - plume diagnostics - mf_thlflx, mf_qtflx ) ! output - variables needed for solver - - ! pass MF turbulent advection term as CLUBB explicit forcing term - rtm_forcing(1) = 0._r8 - thlm_forcing(1)= 0._r8 - do k=2,pverp - rtm_forcing(k) = rtm_forcing(k) - invrs_rho_ds_zt(k) * invrs_dzt(k) * & - ((rho_ds_zm(k) * mf_qtflx(k)) - (rho_ds_zm(k-1) * mf_qtflx(k-1))) + !####################################################################### + !###################### CALL MF DIAGNOSTIC PLUMES ###################### + !####################################################################### + if (do_clubb_mf) then + + do k=2,pverp + do i=1, ncol + dzt(i,k) = zi_g(i,k) - zi_g(i,k-1) + end do + end do + + do i=1, ncol + dzt(i,1) = dzt(i,2) + invrs_dzt(i,:) = 1._r8/dzt(i,:) + end do + + rtm_zm_in(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, rtm_in(1:ncol,:) ) + thlm_zm_in(1:ncol,:) = zt2zm_api( pverp+1-top_lev, ncol, gr, thlm_in(1:ncol,:) ) + + do i=1, ncol + call integrate_mf( pverp, dzt(i,:), zi_g(i,:), p_in_Pa_zm(i,:), invrs_exner_zm(i,:), & ! input + p_in_Pa(i,:), invrs_exner_zt(i,:), & ! input + um_in(i,:), vm_in(i,:), thlm_in(i,:), rtm_in(i,:), thv_ds_zt(i,:), & ! input + thlm_zm_in(i,:), rtm_zm_in(i,:), & ! input + wpthlp_sfc(i), wprtp_sfc(i), pblh(i), & ! input + mf_dry_a(i,:), mf_moist_a(i,:), & ! output - plume diagnostics + mf_dry_w(i,:), mf_moist_w(i,:), & ! output - plume diagnostics + mf_dry_qt(i,:), mf_moist_qt(i,:), & ! output - plume diagnostics + mf_dry_thl(i,:), mf_moist_thl(i,:), & ! output - plume diagnostics + mf_dry_u(i,:), mf_moist_u(i,:), & ! output - plume diagnostics + mf_dry_v(i,:), mf_moist_v(i,:), & ! output - plume diagnostics + mf_moist_qc(i,:), & ! output - plume diagnostics + s_ae(i,:), s_aw(i,:), & ! output - plume diagnostics + s_awthl(i,:), s_awqt(i,:), & ! output - plume diagnostics + s_awql(i,:), s_awqi(i,:), & ! output - plume diagnostics + s_awu(i,:), s_awv(i,:), & ! output - plume diagnostics + mf_thlflx(i,:), mf_qtflx(i,:) ) ! output - variables needed for solver + end do + + ! pass MF turbulent advection term as CLUBB explicit forcing term + do i=1, ncol + rtm_forcing(i,1) = 0._r8 + thlm_forcing(i,1)= 0._r8 + end do + + do k=2,pverp + do i=1, ncol + rtm_forcing(i,k) = rtm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & + ((rho_ds_zm(i,k) * mf_qtflx(i,k)) - (rho_ds_zm(i,k-1) * mf_qtflx(i,k-1))) - thlm_forcing(k) = thlm_forcing(k) - invrs_rho_ds_zt(k) * invrs_dzt(k) * & - ((rho_ds_zm(k) * mf_thlflx(k)) - (rho_ds_zm(k-1) * mf_thlflx(k-1))) - end do + thlm_forcing(i,k) = thlm_forcing(i,k) - invrs_rho_ds_zt(i,k) * invrs_dzt(i,k) * & + ((rho_ds_zm(i,k) * mf_thlflx(i,k)) - (rho_ds_zm(i,k-1) * mf_thlflx(i,k-1))) + end do + end do - end if + end if + + ! Arrays are allocated as if they have pcols grid columns, but there can be less. + ! Only pass clubb_core the number of columns (ncol) with valid data. + ! Advance CLUBB CORE one timestep in the future + call advance_clubb_core_api( gr(:ncol), pverp+1-top_lev, ncol, & + l_implemented, dtime, fcor(:ncol), sfc_elevation(:ncol), hydromet_dim, & + thlm_forcing(:ncol,:), rtm_forcing(:ncol,:), um_forcing(:ncol,:), vm_forcing(:ncol,:), & + sclrm_forcing(:ncol,:,:), edsclrm_forcing(:ncol,:,:), wprtp_forcing(:ncol,:), & + wpthlp_forcing(:ncol,:), rtp2_forcing(:ncol,:), thlp2_forcing(:ncol,:), & + rtpthlp_forcing(:ncol,:), wm_zm(:ncol,:), wm_zt(:ncol,:), & + wpthlp_sfc(:ncol), wprtp_sfc(:ncol), upwp_sfc(:ncol), vpwp_sfc(:ncol), & + wpsclrp_sfc(:ncol,:), wpedsclrp_sfc(:ncol,:), & + rtm_ref(:ncol,:), thlm_ref(:ncol,:), um_ref(:ncol,:), vm_ref(:ncol,:), ug(:ncol,:), vg(:ncol,:), & + p_in_Pa(:ncol,:), rho_zm(:ncol,:), rho_in(:ncol,:), exner(:ncol,:), & + rho_ds_zm(:ncol,:), rho_ds_zt(:ncol,:), invrs_rho_ds_zm(:ncol,:), & + invrs_rho_ds_zt(:ncol,:), thv_ds_zm(:ncol,:), thv_ds_zt(:ncol,:), hydromet(:ncol,:,:), & + rfrzm(:ncol,:), radf(:ncol,:), & + wphydrometp(:ncol,:,:), wp2hmp(:ncol,:,:), rtphmp_zt(:ncol,:,:), thlphmp_zt(:ncol,:,:), & + grid_dx(:ncol), grid_dy(:ncol), & + clubb_params, nu_vert_res_dep(:ncol), lmin(:ncol), & + clubb_config_flags, & + stats_zt(:ncol), stats_zm(:ncol), stats_sfc(:ncol), & + um_in(:ncol,:), vm_in(:ncol,:), upwp_in(:ncol,:), vpwp_in(:ncol,:), up2_in(:ncol,:), vp2_in(:ncol,:), up3_in(:ncol,:), vp3_in(:ncol,:), & + thlm_in(:ncol,:), rtm_in(:ncol,:), wprtp_in(:ncol,:), wpthlp_in(:ncol,:), & + wp2_in(:ncol,:), wp3_in(:ncol,:), rtp2_in(:ncol,:), rtp3_in(:ncol,:), thlp2_in(:ncol,:), thlp3_in(:ncol,:), rtpthlp_in(:ncol,:), & + sclrm(:ncol,:,:), & + sclrp2(:ncol,:,:), sclrp3(:ncol,:,:), sclrprtp(:ncol,:,:), sclrpthlp(:ncol,:,:), & + wpsclrp(:ncol,:,:), edsclr_in(:ncol,:,:), err_code, & + rcm_inout(:ncol,:), cloud_frac_inout(:ncol,:), & + wpthvp_in(:ncol,:), wp2thvp_in(:ncol,:), rtpthvp_in(:ncol,:), thlpthvp_in(:ncol,:), & + sclrpthvp_inout(:ncol,:,:), & + wp2rtp_inout(:ncol,:), wp2thlp_inout(:ncol,:), uprcp_inout(:ncol,:), & + vprcp_inout(:ncol,:), rc_coef_inout(:ncol,:), & + wp4_inout(:ncol,:), wpup2_inout(:ncol,:), wpvp2_inout(:ncol,:), & + wp2up2_inout(:ncol,:), wp2vp2_inout(:ncol,:), ice_supersat_frac_inout(:ncol,:), & + pdf_params_chnk(lchnk), pdf_params_zm_chnk(lchnk), & + pdf_implicit_coefs_terms_chnk(:ncol,lchnk), & + khzm_out(:ncol,:), khzt_out(:ncol,:), & + qclvar_out(:ncol,:), thlprcp_out(:ncol,:), & + wprcp_out(:ncol,:), w_up_in_cloud_out(:ncol,:), & + rcm_in_layer_out(:ncol,:), cloud_cover_out(:ncol,:), invrs_tau_zm_out(:ncol,:) ) + + + ! Note that CLUBB does not produce an error code specific to any column, and + ! one value only for the entire chunk + if ( err_code == clubb_fatal_error ) then + write(fstderr,*) "Fatal error in CLUBB: at timestep ", get_nstep() + write(fstderr,*) "LAT Range: ", state1%lat(1), " -- ", state1%lat(ncol) + write(fstderr,*) "LON: Range:", state1%lon(1), " -- ", state1%lon(ncol) + call endrun(subr//': Fatal error in CLUBB library') + end if + + if (do_rainturb) then + + do i=1, ncol + rvm_in(i,:) = rtm_in(i,:) - rcm_inout(i,:) + end do + + do i=1, ncol + + call copy_multi_pdf_params_to_single( pdf_params_chnk(lchnk), i, & + pdf_params_single_col) + + + call update_xp2_mc_api( gr(i), nlev+1, dtime, cloud_frac_inout(i,:), & + rcm_inout(i,:), rvm_in(i,:), thlm_in(i,:), wm_zt(i,:), exner(i,:), pre_in(i,:), pdf_params_single_col, & + rtp2_mc_out(i,:), thlp2_mc_out(i,:), & + wprtp_mc_out(i,:), wpthlp_mc_out(i,:), & + rtpthlp_mc_out(i,:)) + end do + + do i=1, ncol - ! Advance CLUBB CORE one timestep in the future - call advance_clubb_core_api & - ( l_implemented, dtime, fcor, sfc_elevation, hydromet_dim, & - thlm_forcing, rtm_forcing, um_forcing, vm_forcing, & - sclrm_forcing, edsclrm_forcing, wprtp_forcing, & - wpthlp_forcing, rtp2_forcing, thlp2_forcing, & - rtpthlp_forcing, wm_zm, wm_zt, & - wpthlp_sfc, wprtp_sfc, upwp_sfc, vpwp_sfc, & - wpsclrp_sfc, wpedsclrp_sfc, & - p_in_Pa, rho_zm, rho_in, exner, & - rho_ds_zm, rho_ds_zt, invrs_rho_ds_zm, & - invrs_rho_ds_zt, thv_ds_zm, thv_ds_zt, hydromet, & - rfrzm, radf, & - wphydrometp, wp2hmp, rtphmp_zt, thlphmp_zt, & - host_dx, host_dy, & - clubb_config_flags, & - um_in, vm_in, upwp_in, vpwp_in, up2_in, vp2_in, up3_in, vp3_in, & - thlm_in, rtm_in, wprtp_in, wpthlp_in, & - wp2_in, wp3_in, rtp2_in, rtp3_in, thlp2_in, thlp3_in, rtpthlp_in, & - sclrm, & - sclrp2, sclrp3, sclrprtp, sclrpthlp, & - wpsclrp, edsclr_in, err_code, & - rcm_inout, cloud_frac_inout, & - wpthvp_in, wp2thvp_in, rtpthvp_in, thlpthvp_in, & - sclrpthvp_inout, & - pdf_params_chnk(i,lchnk), pdf_params_zm_chnk(i,lchnk), & - pdf_implicit_coefs_terms_chnk(i,lchnk), & - khzm_out, khzt_out, & - qclvar_out, thlprcp_out, & - wprcp_out, ice_supersat_frac_out, & - rcm_in_layer_out, cloud_cover_out) - - if ( err_code == clubb_fatal_error ) then - write(fstderr,*) "Fatal error in CLUBB: at timestep ", get_nstep(), "LAT: ", state1%lat(i), " LON: ", state1%lon(i) - call endrun(subr//': Fatal error in CLUBB library') - end if + dum1 = (1._r8 - cam_in%landfrac(i)) + ! update turbulent moments based on rain evaporation + rtp2_in(i,:) = rtp2_in(i,:) + clubb_rnevap_effic * dum1 * rtp2_mc_out(i,:) * dtime + thlp2_in(i,:) = thlp2_in(i,:) + clubb_rnevap_effic * dum1 * thlp2_mc_out(i,:) * dtime + wprtp_in(i,:) = wprtp_in(i,:) + clubb_rnevap_effic * dum1 * wprtp_mc_out(i,:) * dtime + wpthlp_in(i,:) = wpthlp_in(i,:) + clubb_rnevap_effic * dum1 * wpthlp_mc_out(i,:) * dtime + + end do + + end if + - if (do_rainturb) then - rvm_in = rtm_in - rcm_inout - call update_xp2_mc_api(nlev+1, dtime, cloud_frac_inout, & - rcm_inout, rvm_in, thlm_in, wm_zt, exner, pre_in, pdf_params_chnk(i,lchnk), & - rtp2_mc_out, thlp2_mc_out, & - wprtp_mc_out, wpthlp_mc_out, & - rtpthlp_mc_out) - - dum1 = (1._r8 - cam_in%landfrac(i)) - - ! update turbulent moments based on rain evaporation - rtp2_in = rtp2_in + clubb_rnevap_effic * dum1 * rtp2_mc_out * dtime - thlp2_in = thlp2_in + clubb_rnevap_effic * dum1 * thlp2_mc_out * dtime - wprtp_in = wprtp_in + clubb_rnevap_effic * dum1 * wprtp_mc_out * dtime - wpthlp_in = wpthlp_in + clubb_rnevap_effic * dum1 * wpthlp_mc_out * dtime - endif - - if (do_cldcool) then - - rcm_out_zm = zt2zm_api(rcm_inout) - qrl_zm = zt2zm_api(qrl_clubb) - thlp2_rad_out(:) = 0._r8 - call calculate_thlp2_rad_api(nlev+1, rcm_out_zm, thlprcp_out, qrl_zm, thlp2_rad_out) - thlp2_in = thlp2_in + thlp2_rad_out * dtime - thlp2_in = max(thl_tol**2,thlp2_in) - endif - - ! Check to see if stats should be output, here stats are read into - ! output arrays to make them conformable to CAM output - if (l_stats) call stats_end_timestep_clubb(i,out_zt,out_zm,& - out_radzt,out_radzm,out_sfc) - - enddo ! end time loop - - if (clubb_do_adv) then - if (macmic_it == cld_macmic_num_steps) then - wp2_in=zm2zt_api(wp2_in) - wpthlp_in=zm2zt_api(wpthlp_in) - wprtp_in=zm2zt_api(wprtp_in) - up2_in=zm2zt_api(up2_in) - vp2_in=zm2zt_api(vp2_in) - thlp2_in=zm2zt_api(thlp2_in) - rtp2_in=zm2zt_api(rtp2_in) - rtpthlp_in=zm2zt_api(rtpthlp_in) - - do k=1,nlev+1 - thlp2_in(k)=max(thl_tol**2,thlp2_in(k)) - rtp2_in(k)=max(rt_tol**2,rtp2_in(k)) - wp2_in(k)=max(w_tol_sqd,wp2_in(k)) - up2_in(k)=max(w_tol_sqd,up2_in(k)) - vp2_in(k)=max(w_tol_sqd,vp2_in(k)) - enddo - endif - endif - - ! Convert RTP2 and THLP2 to thermo grid for output - rtp2_zt = zm2zt_api(rtp2_in) - thl2_zt = zm2zt_api(thlp2_in) - wp2_zt = zm2zt_api(wp2_in) + if (do_cldcool) then + + rcm_out_zm(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, rcm_inout(1:ncol,:)) + qrl_zm(1:ncol,:) = zt2zm_api(pverp+1-top_lev, ncol, gr, qrl_clubb(1:ncol,:)) + thlp2_rad_out(:,:) = 0._r8 + + do i=1, ncol + call calculate_thlp2_rad_api(nlev+1, rcm_out_zm(i,:), thlprcp_out(i,:), qrl_zm(i,:), clubb_params, & + thlp2_rad_out(i,:)) + end do + + do i=1, ncol + thlp2_in(i,:) = thlp2_in(i,:) + thlp2_rad_out(i,:) * dtime + thlp2_in(i,:) = max(thl_tol**2,thlp2_in(i,:)) + end do + + end if + + ! Check to see if stats should be output, here stats are read into + ! output arrays to make them conformable to CAM output + if (l_stats) then + do i=1, ncol + call stats_end_timestep_clubb(i, stats_zt(i), stats_zm(i), stats_rad_zt(i), stats_rad_zm(i), stats_sfc(i), & + out_zt, out_zm, out_radzt, out_radzm, out_sfc) + end do + end if - ! Arrays need to be "flipped" to CAM grid + enddo ! end time loop - do k=1,nlev+1 - - um(i,pverp-k+1) = um_in(k) - vm(i,pverp-k+1) = vm_in(k) - upwp(i,pverp-k+1) = upwp_in(k) - vpwp(i,pverp-k+1) = vpwp_in(k) - wpthvp(i,pverp-k+1) = wpthvp_in(k) - wp2thvp(i,pverp-k+1) = wp2thvp_in(k) - rtpthvp(i,pverp-k+1) = rtpthvp_in(k) - thlpthvp(i,pverp-k+1) = thlpthvp_in(k) - up2(i,pverp-k+1) = up2_in(k) - vp2(i,pverp-k+1) = vp2_in(k) - up3(i,pverp-k+1) = up3_in(k) - vp3(i,pverp-k+1) = vp3_in(k) - thlm(i,pverp-k+1) = thlm_in(k) - rtm(i,pverp-k+1) = rtm_in(k) - wprtp(i,pverp-k+1) = wprtp_in(k) - wpthlp(i,pverp-k+1) = wpthlp_in(k) - wp2(i,pverp-k+1) = wp2_in(k) - wp3(i,pverp-k+1) = wp3_in(k) - rtp2(i,pverp-k+1) = rtp2_in(k) - thlp2(i,pverp-k+1) = thlp2_in(k) - rtp3(i,pverp-k+1) = rtp3_in(k) - thlp3(i,pverp-k+1) = thlp3_in(k) - rtpthlp(i,pverp-k+1) = rtpthlp_in(k) - rcm(i,pverp-k+1) = rcm_inout(k) - ice_supersat_frac(i,pverp-k+1) = ice_supersat_frac_out(k) - wprcp(i,pverp-k+1) = wprcp_out(k) - cloud_frac(i,pverp-k+1) = min(cloud_frac_inout(k),1._r8) - rcm_in_layer(i,pverp-k+1) = rcm_in_layer_out(k) - cloud_cover(i,pverp-k+1) = min(cloud_cover_out(k),1._r8) - zt_out(i,pverp-k+1) = zt_g(k) - zi_out(i,pverp-k+1) = zi_g(k) - khzm(i,pverp-k+1) = khzm_out(k) - qclvar(i,pverp-k+1) = min(1._r8,qclvar_out(k)) - wm_zt_out(i,pverp-k+1) = wm_zt(k) - - rtp2_zt_out(i,pverp-k+1) = rtp2_zt(k) - thl2_zt_out(i,pverp-k+1) = thl2_zt(k) - wp2_zt_out(i,pverp-k+1) = wp2_zt(k) - - mean_rt & - = pdf_params_chnk(i,lchnk)%mixt_frac(k) & - * pdf_params_chnk(i,lchnk)%rt_1(k) & - + ( 1.0_r8 - pdf_params_chnk(i,lchnk)%mixt_frac(k) ) & - * pdf_params_chnk(i,lchnk)%rt_2(k) - - pdfp_rtp2(i,pverp-k+1) & - = pdf_params_chnk(i,lchnk)%mixt_frac(k) & - * ( ( pdf_params_chnk(i,lchnk)%rt_1(k) - mean_rt )**2 & - + pdf_params_chnk(i,lchnk)%varnce_rt_1(k) ) & - + ( 1.0_r8 - pdf_params_chnk(i,lchnk)%mixt_frac(k) ) & - * ( ( pdf_params_chnk(i,lchnk)%rt_2(k) - mean_rt )**2 & - + pdf_params_chnk(i,lchnk)%varnce_rt_2(k) ) - - do ixind=1,edsclr_dim - edsclr_out(pverp-k+1,ixind) = edsclr_in(k,ixind) - enddo + if (clubb_do_adv) then + if (macmic_it == cld_macmic_num_steps) then + + wp2_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, wp2_in(1:ncol,:)) + wpthlp_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, wpthlp_in(1:ncol,:)) + wprtp_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, wprtp_in(1:ncol,:)) + up2_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, up2_in(1:ncol,:)) + vp2_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, vp2_in(1:ncol,:)) + thlp2_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, thlp2_in(1:ncol,:)) + rtp2_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, rtp2_in(1:ncol,:)) + rtpthlp_in(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, rtpthlp_in(1:ncol,:)) + + do k=1,nlev+1 + do i=1, ncol + thlp2_in(i,k) = max(thl_tol**2, thlp2_in(i,k)) + rtp2_in(i,k) = max(rt_tol**2, rtp2_in(i,k)) + wp2_in(i,k) = max(w_tol_sqd, wp2_in(i,k)) + up2_in(i,k) = max(w_tol_sqd, up2_in(i,k)) + vp2_in(i,k) = max(w_tol_sqd, vp2_in(i,k)) + end do + end do + + end if + end if + + ! Convert RTP2 and THLP2 to thermo grid for output + rtp2_zt(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, rtp2_in(1:ncol,:)) + thl2_zt(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, thlp2_in(1:ncol,:)) + wp2_zt(1:ncol,:) = zm2zt_api(pverp+1-top_lev, ncol, gr, wp2_in(1:ncol,:)) + + ! Arrays need to be "flipped" to CAM grid + do k=1, nlev+1 + do i=1, ncol + um(i,pverp-k+1) = um_in(i,k) + vm(i,pverp-k+1) = vm_in(i,k) + upwp(i,pverp-k+1) = upwp_in(i,k) + vpwp(i,pverp-k+1) = vpwp_in(i,k) + wpthvp(i,pverp-k+1) = wpthvp_in(i,k) + wp2thvp(i,pverp-k+1) = wp2thvp_in(i,k) + rtpthvp(i,pverp-k+1) = rtpthvp_in(i,k) + thlpthvp(i,pverp-k+1) = thlpthvp_in(i,k) + up2(i,pverp-k+1) = up2_in(i,k) + vp2(i,pverp-k+1) = vp2_in(i,k) + up3(i,pverp-k+1) = up3_in(i,k) + vp3(i,pverp-k+1) = vp3_in(i,k) + thlm(i,pverp-k+1) = thlm_in(i,k) + rtm(i,pverp-k+1) = rtm_in(i,k) + wprtp(i,pverp-k+1) = wprtp_in(i,k) + wpthlp(i,pverp-k+1) = wpthlp_in(i,k) + wp2(i,pverp-k+1) = wp2_in(i,k) + wp3(i,pverp-k+1) = wp3_in(i,k) + rtp2(i,pverp-k+1) = rtp2_in(i,k) + thlp2(i,pverp-k+1) = thlp2_in(i,k) + rtp3(i,pverp-k+1) = rtp3_in(i,k) + thlp3(i,pverp-k+1) = thlp3_in(i,k) + rtpthlp(i,pverp-k+1) = rtpthlp_in(i,k) + rcm(i,pverp-k+1) = rcm_inout(i,k) + wprcp(i,pverp-k+1) = wprcp_out(i,k) + cloud_frac(i,pverp-k+1) = min(cloud_frac_inout(i,k),1._r8) + pdf_zm_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_1(i,k) + pdf_zm_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%w_2(i,k) + pdf_zm_varnce_w_1(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_1(i,k) + pdf_zm_varnce_w_2(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%varnce_w_2(i,k) + pdf_zm_mixt_frac(i,pverp-k+1) = pdf_params_zm_chnk(lchnk)%mixt_frac(i,k) + rcm_in_layer(i,pverp-k+1) = rcm_in_layer_out(i,k) + cloud_cover(i,pverp-k+1) = min(cloud_cover_out(i,k),1._r8) + zt_out(i,pverp-k+1) = zt_g(i,k) + zi_out(i,pverp-k+1) = zi_g(i,k) + khzm(i,pverp-k+1) = khzm_out(i,k) + qclvar(i,pverp-k+1) = min(1._r8,qclvar_out(i,k)) + wm_zt_out(i,pverp-k+1) = wm_zt(i,k) + wp2rtp(i,pverp-k+1) = wp2rtp_inout(i,k) + wp2thlp(i,pverp-k+1) = wp2thlp_inout(i,k) + uprcp(i,pverp-k+1) = uprcp_inout(i,k) + vprcp(i,pverp-k+1) = vprcp_inout(i,k) + rc_coef(i,pverp-k+1) = rc_coef_inout(i,k) + wp4(i,pverp-k+1) = wp4_inout(i,k) + wpup2(i,pverp-k+1) = wpup2_inout(i,k) + wpvp2(i,pverp-k+1) = wpvp2_inout(i,k) + wp2up2(i,pverp-k+1) = wp2up2_inout(i,k) + wp2vp2(i,pverp-k+1) = wp2vp2_inout(i,k) + ice_supersat_frac(i,pverp-k+1) = ice_supersat_frac_inout(i,k) + + rtp2_zt_out(i,pverp-k+1) = rtp2_zt(i,k) + thl2_zt_out(i,pverp-k+1) = thl2_zt(i,k) + wp2_zt_out(i,pverp-k+1) = wp2_zt(i,k) + + end do + end do - if (do_clubb_mf) then - mf_dry_a_output(i,pverp-k+1) = mf_dry_a(k) - mf_moist_a_output(i,pverp-k+1) = mf_moist_a(k) - mf_dry_w_output(i,pverp-k+1) = mf_dry_w(k) - mf_moist_w_output(i,pverp-k+1) = mf_moist_w(k) - mf_dry_qt_output(i,pverp-k+1) = mf_dry_qt(k) - mf_moist_qt_output(i,pverp-k+1) = mf_moist_qt(k) - mf_dry_thl_output(i,pverp-k+1) = mf_dry_thl(k) - mf_moist_thl_output(i,pverp-k+1) = mf_moist_thl(k) - mf_dry_u_output(i,pverp-k+1) = mf_dry_u(k) - mf_moist_u_output(i,pverp-k+1) = mf_moist_u(k) - mf_dry_v_output(i,pverp-k+1) = mf_dry_v(k) - mf_moist_v_output(i,pverp-k+1) = mf_moist_v(k) - mf_moist_qc_output(i,pverp-k+1) = mf_moist_qc(k) - mf_thlflx_output(i,pverp-k+1) = mf_thlflx(k) - mf_qtflx_output(i,pverp-k+1) = mf_qtflx(k) - s_ae_output(i,pverp-k+1) = s_ae(k) - s_aw_output(i,pverp-k+1) = s_aw(k) - s_awthl_output(i,pverp-k+1) = s_awthl(k) - s_awqt_output(i,pverp-k+1) = s_awqt(k) - s_awql_output(i,pverp-k+1) = s_awql(k) - s_awqi_output(i,pverp-k+1) = s_awqi(k) - s_awu_output(i,pverp-k+1) = s_awu(k) - s_awv_output(i,pverp-k+1) = s_awv(k) - mf_thlflx_output(i,pverp-k+1) = mf_thlflx(k) - mf_qtflx_output(i,pverp-k+1) = mf_qtflx(k) - end if + do k=1, nlev+1 + do i=1, ncol + + mean_rt = pdf_params_chnk(lchnk)%mixt_frac(i,k) & + * pdf_params_chnk(lchnk)%rt_1(i,k) & + + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & + * pdf_params_chnk(lchnk)%rt_2(i,k) + + pdfp_rtp2(i,pverp-k+1) = pdf_params_chnk(lchnk)%mixt_frac(i,k) & + * ( ( pdf_params_chnk(lchnk)%rt_1(i,k) - mean_rt )**2 & + + pdf_params_chnk(lchnk)%varnce_rt_1(i,k) ) & + + ( 1.0_r8 - pdf_params_chnk(lchnk)%mixt_frac(i,k) ) & + * ( ( pdf_params_chnk(lchnk)%rt_2(i,k) - mean_rt )**2 & + + pdf_params_chnk(lchnk)%varnce_rt_2(i,k) ) + end do + end do - enddo + do ixind=1,edsclr_dim + do k=1, nlev+1 + do i=1, ncol + edsclr_out(i,pverp-k+1,ixind) = edsclr_in(i,k,ixind) + end do + end do + end do + + if (do_clubb_mf) then + do k=1, nlev+1 + do i=1, ncol + mf_dry_a_output(i,pverp-k+1) = mf_dry_a(i,k) + mf_moist_a_output(i,pverp-k+1) = mf_moist_a(i,k) + mf_dry_w_output(i,pverp-k+1) = mf_dry_w(i,k) + mf_moist_w_output(i,pverp-k+1) = mf_moist_w(i,k) + mf_dry_qt_output(i,pverp-k+1) = mf_dry_qt(i,k) + mf_moist_qt_output(i,pverp-k+1) = mf_moist_qt(i,k) + mf_dry_thl_output(i,pverp-k+1) = mf_dry_thl(i,k) + mf_moist_thl_output(i,pverp-k+1) = mf_moist_thl(i,k) + mf_dry_u_output(i,pverp-k+1) = mf_dry_u(i,k) + mf_moist_u_output(i,pverp-k+1) = mf_moist_u(i,k) + mf_dry_v_output(i,pverp-k+1) = mf_dry_v(i,k) + mf_moist_v_output(i,pverp-k+1) = mf_moist_v(i,k) + mf_moist_qc_output(i,pverp-k+1) = mf_moist_qc(i,k) + mf_thlflx_output(i,pverp-k+1) = mf_thlflx(i,k) + mf_qtflx_output(i,pverp-k+1) = mf_qtflx(i,k) + s_ae_output(i,pverp-k+1) = s_ae(i,k) + s_aw_output(i,pverp-k+1) = s_aw(i,k) + s_awthl_output(i,pverp-k+1) = s_awthl(i,k) + s_awqt_output(i,pverp-k+1) = s_awqt(i,k) + s_awql_output(i,pverp-k+1) = s_awql(i,k) + s_awqi_output(i,pverp-k+1) = s_awqi(i,k) + s_awu_output(i,pverp-k+1) = s_awu(i,k) + s_awv_output(i,pverp-k+1) = s_awv(i,k) + mf_thlflx_output(i,pverp-k+1) = mf_thlflx(i,k) + mf_qtflx_output(i,pverp-k+1) = mf_qtflx(i,k) + end do + end do + end if ! Values to use above top_lev, for variables that have not already been ! set up there. These are mostly fill values that should not actually be ! used in the run, but may end up in diagnostic output. - upwp(i,:top_lev-1) = 0._r8 - vpwp(i,:top_lev-1) = 0._r8 - rcm(i,:top_lev-1) = 0._r8 - wprcp(i,:top_lev-1) = 0._r8 - cloud_frac(i,:top_lev-1) = 0._r8 - rcm_in_layer(i,:top_lev-1) = 0._r8 - zt_out(i,:top_lev-1) = 0._r8 - zi_out(i,:top_lev-1) = 0._r8 - khzm(i,:top_lev-1) = 0._r8 - qclvar(i,:top_lev-1) = 2._r8 - - - - ! enforce zero tracer tendencies above the top_lev level -- no change - icnt=0 - do ixind=1,pcnst - if (lq(ixind)) then - icnt=icnt+1 - edsclr_out(:top_lev-1,icnt) = state1%q(i,:top_lev-1,ixind) - end if - enddo + do k=1, top_lev-1 + do i=1, ncol + upwp(i,k) = 0._r8 + vpwp(i,k) = 0._r8 + rcm(i,k) = 0._r8 + wprcp(i,k) = 0._r8 + cloud_frac(i,k) = 0._r8 + rcm_in_layer(i,k) = 0._r8 + zt_out(i,k) = 0._r8 + zi_out(i,k) = 0._r8 + khzm(i,k) = 0._r8 + qclvar(i,k) = 2._r8 + end do + end do - ! Fill up arrays needed for McICA. Note we do not want the ghost point, - ! thus why the second loop is needed. - - zi_out(i,1) = 0._r8 - - ! Section below is concentrated on energy fixing for conservation. - ! There are two steps to this process. The first is to remove any tendencies - ! CLUBB may have produced above where it is active due to roundoff. - ! The second is to provider a fixer because CLUBB and CAM's thermodynamic - ! variables are different. - - ! Initialize clubbtop with the chemistry topopause top, to prevent CLUBB from - ! firing up in the stratosphere - clubbtop = troplev(i) - do while ((rtp2(i,clubbtop) <= 1.e-15_r8 .and. rcm(i,clubbtop) == 0._r8) .and. clubbtop < pver-1) - clubbtop = clubbtop + 1 - enddo - - ! Compute static energy using CLUBB's variables - do k=1,pver - clubb_s(k) = cpairv(i,k,lchnk) * thlm(i,k) / inv_exner_clubb(i,k) & - + latvap * rcm(i,k) & - + gravit * state1%zm(i,k) + state1%phis(i) - enddo + ! enforce zero tracer tendencies above the top_lev level -- no change + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + icnt=icnt+1 + + do i=1, ncol + edsclr_out(i,:top_lev-1,icnt) = state1%q(i,:top_lev-1,ixind) + end do + + end if + end do + + ! Fill up arrays needed for McICA. Note we do not want the ghost point, + ! thus why the second loop is needed. + zi_out(:,1) = 0._r8 + + ! Section below is concentrated on energy fixing for conservation. + ! There are two steps to this process. The first is to remove any tendencies + ! CLUBB may have produced above where it is active due to roundoff. + ! The second is to provider a fixer because CLUBB and CAM's thermodynamic + ! variables are different. + + ! Initialize clubbtop with the chemistry topopause top, to prevent CLUBB from + ! firing up in the stratosphere + do i=1, ncol + clubbtop(i) = troplev(i) + do while ((rtp2(i,clubbtop(i)) <= 1.e-15_r8 .and. rcm(i,clubbtop(i)) == 0._r8) .and. clubbtop(i) < pver-1) + clubbtop(i) = clubbtop(i) + 1 + end do + end do - ! Compute integrals above layer where CLUBB is active - se_upper_a = 0._r8 ! energy in layers above where CLUBB is active AFTER CLUBB is called - se_upper_b = 0._r8 ! energy in layers above where CLUBB is active BEFORE CLUBB is called - tw_upper_a = 0._r8 ! total water in layers above where CLUBB is active AFTER CLUBB is called - tw_upper_b = 0._r8 ! total water in layers above where CLUBB is active BEFORE CLUBB is called - do k=1,clubbtop - se_upper_a = se_upper_a + (clubb_s(k)+0.5_r8*(um(i,k)**2+vm(i,k)**2)+(latvap+latice)* & - (rtm(i,k)-rcm(i,k))+(latice)*rcm(i,k))*state1%pdel(i,k)/gravit - se_upper_b = se_upper_b + (state1%s(i,k)+0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)+(latvap+latice)* & - state1%q(i,k,ixq)+(latice)*state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit - tw_upper_a = tw_upper_a + rtm(i,k)*state1%pdel(i,k)/gravit - tw_upper_b = tw_upper_b + (state1%q(i,k,ixq)+state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit - enddo + ! Compute static energy using CLUBB's variables + do k=1,pver + do i=1, ncol + clubb_s(i,k) = cpairv(i,k,lchnk) * thlm(i,k) / inv_exner_clubb(i,k) & + + latvap * rcm(i,k) & + + gravit * state1%zm(i,k) + state1%phis(i) + end do + end do + +#ifndef CLUBBTOP_OFF + ! Compute integrals above layer where CLUBB is active + se_upper_a(:) = 0._r8 ! energy in layers above where CLUBB is active AFTER CLUBB is called + se_upper_b(:) = 0._r8 ! energy in layers above where CLUBB is active BEFORE CLUBB is called + tw_upper_a(:) = 0._r8 ! total water in layers above where CLUBB is active AFTER CLUBB is called + tw_upper_b(:) = 0._r8 ! total water in layers above where CLUBB is active BEFORE CLUBB is called + + do i=1, ncol + do k=1, clubbtop(i) + + se_upper_a(i) = se_upper_a(i) + (clubb_s(i,k)+0.5_r8*(um(i,k)**2+vm(i,k)**2) & + +(latvap+latice)*(rtm(i,k)-rcm(i,k)) & + +(latice)*rcm(i,k))*state1%pdel(i,k)/gravit + + se_upper_b(i) = se_upper_b(i) + (state1%s(i,k)+0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2) & + + (latvap+latice)*state1%q(i,k,ixq) & + + (latice)*state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit + + tw_upper_a(i) = tw_upper_a(i) + rtm(i,k)*state1%pdel(i,k)/gravit + + tw_upper_b(i) = tw_upper_b(i) + (state1%q(i,k,ixq) & + +state1%q(i,k,ixcldliq))*state1%pdel(i,k)/gravit + end do + end do - ! Compute the disbalance of total energy and water in upper levels, - ! divide by the thickness in the lower atmosphere where we will - ! evenly distribute this disbalance - se_upper_diss = (se_upper_a - se_upper_b)/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1)) - tw_upper_diss = (tw_upper_a - tw_upper_b)/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1)) + ! Compute the disbalance of total energy and water in upper levels, + ! divide by the thickness in the lower atmosphere where we will + ! evenly distribute this disbalance + do i=1, ncol + se_upper_diss(i) = (se_upper_a(i) - se_upper_b(i))/(state1%pint(i,pverp)-state1%pint(i,clubbtop(i)+1)) + tw_upper_diss(i) = (tw_upper_a(i) - tw_upper_b(i))/(state1%pint(i,pverp)-state1%pint(i,clubbtop(i)+1)) + end do - ! Perform a test to see if there will be any negative RTM errors - ! in the column. If so, apply the disbalance to the surface - apply_to_surface = .false. - if (tw_upper_diss < 0._r8) then - do k=clubbtop+1,pver - rtm_test = (rtm(i,k) + tw_upper_diss*gravit) - rcm(i,k) + ! Perform a test to see if there will be any negative RTM errors + ! in the column. If so, apply the disbalance to the surface + do i=1, ncol + apply_to_surface(i) = .false. + if (tw_upper_diss(i) < 0._r8) then + do k=clubbtop(i)+1,pver + rtm_test = (rtm(i,k) + tw_upper_diss(i)*gravit) - rcm(i,k) if (rtm_test < 0._r8) then - apply_to_surface = .true. - endif - enddo - endif + apply_to_surface(i) = .true. + end if + end do + end if + end do + + do i=1, ncol - if (apply_to_surface) then - tw_upper_diss = (tw_upper_a - tw_upper_b)/(state1%pint(i,pverp)-state1%pint(i,pver)) - se_upper_diss = (se_upper_a - se_upper_b)/(state1%pint(i,pverp)-state1%pint(i,pver)) - rtm(i,pver) = rtm(i,pver) + tw_upper_diss*gravit - if (apply_to_heat) clubb_s(pver) = clubb_s(pver) + se_upper_diss*gravit + if (apply_to_surface(i)) then + + tw_upper_diss(i) = (tw_upper_a(i) - tw_upper_b(i))/(state1%pint(i,pverp)-state1%pint(i,pver)) + se_upper_diss(i) = (se_upper_a(i) - se_upper_b(i))/(state1%pint(i,pverp)-state1%pint(i,pver)) + rtm(i,pver) = rtm(i,pver) + tw_upper_diss(i)*gravit + + if (apply_to_heat) then + clubb_s(i,pver) = clubb_s(i,pver) + se_upper_diss(i)*gravit + end if + else + ! Apply the disbalances above to layers where CLUBB is active - do k=clubbtop+1,pver - rtm(i,k) = rtm(i,k) + tw_upper_diss*gravit - if (apply_to_heat) clubb_s(k) = clubb_s(k) + se_upper_diss*gravit - enddo - endif + do k=clubbtop(i)+1, pver + rtm(i,k) = rtm(i,k) + tw_upper_diss(i)*gravit + + if (apply_to_heat) then + clubb_s(i,k) = clubb_s(i,k) + se_upper_diss(i)*gravit + end if + end do + + end if + + end do ! Essentially "zero" out tendencies in the layers above where CLUBB is active - do k=1,clubbtop - if (apply_to_heat) clubb_s(k) = state1%s(i,k) + do i=1, ncol + do k=1, clubbtop(i) + if (apply_to_heat) clubb_s(i,k) = state1%s(i,k) rcm(i,k) = state1%q(i,k,ixcldliq) rtm(i,k) = state1%q(i,k,ixq) + rcm(i,k) - enddo - - ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water - ! after CLUBB is called. This is for energy conservation purposes. - se_a = 0._r8 - ke_a = 0._r8 - wv_a = 0._r8 - wl_a = 0._r8 + end do + end do +#endif + + ! Compute integrals for static energy, kinetic energy, water vapor, and liquid water + ! after CLUBB is called. This is for energy conservation purposes. + se_a(:) = 0._r8 + ke_a(:) = 0._r8 + wv_a(:) = 0._r8 + wl_a(:) = 0._r8 + + do k=1,pver + do i=1, ncol + se_a(i) = se_a(i) + clubb_s(i,k)*state1%pdel(i,k)/gravit + ke_a(i) = ke_a(i) + 0.5_r8*(um(i,k)**2+vm(i,k)**2)*state1%pdel(i,k)/gravit + wv_a(i) = wv_a(i) + (rtm(i,k)-rcm(i,k))*state1%pdel(i,k)/gravit + wl_a(i) = wl_a(i) + (rcm(i,k))*state1%pdel(i,k)/gravit + end do + end do + + ! Do the same as above, but for before CLUBB was called. + se_b(:) = 0._r8 + ke_b(:) = 0._r8 + wv_b(:) = 0._r8 + wl_b(:) = 0._r8 + + do k=1, pver + do i=1, ncol + se_b(i) = se_b(i) + state1%s(i,k)*state1%pdel(i,k)/gravit + ke_b(i) = ke_b(i) + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)/gravit + wv_b(i) = wv_b(i) + state1%q(i,k,ixq)*state1%pdel(i,k)/gravit + wl_b(i) = wl_b(i) + state1%q(i,k,ixcldliq)*state1%pdel(i,k)/gravit + end do + end do - ! Do the same as above, but for before CLUBB was called. - se_b = 0._r8 - ke_b = 0._r8 - wv_b = 0._r8 - wl_b = 0._r8 - do k=1,pver - se_a(i) = se_a(i) + clubb_s(k)*state1%pdel(i,k)/gravit - ke_a(i) = ke_a(i) + 0.5_r8*(um(i,k)**2+vm(i,k)**2)*state1%pdel(i,k)/gravit - wv_a(i) = wv_a(i) + (rtm(i,k)-rcm(i,k))*state1%pdel(i,k)/gravit - wl_a(i) = wl_a(i) + (rcm(i,k))*state1%pdel(i,k)/gravit - - se_b(i) = se_b(i) + state1%s(i,k)*state1%pdel(i,k)/gravit - ke_b(i) = ke_b(i) + 0.5_r8*(state1%u(i,k)**2+state1%v(i,k)**2)*state1%pdel(i,k)/gravit - wv_b(i) = wv_b(i) + state1%q(i,k,ixq)*state1%pdel(i,k)/gravit - wl_b(i) = wl_b(i) + state1%q(i,k,ixcldliq)*state1%pdel(i,k)/gravit - enddo + do i=1, ncol ! Based on these integrals, compute the total energy before and after CLUBB call - te_a(i) = se_a(i) + ke_a(i) + (latvap+latice)*wv_a(i)+latice*wl_a(i) - te_b(i) = se_b(i) + ke_b(i) + (latvap+latice)*wv_b(i)+latice*wl_b(i) + te_a(i) = se_a(i) + ke_a(i) + (latvap+latice) * wv_a(i) + latice * wl_a(i) + te_b(i) = se_b(i) + ke_b(i) + (latvap+latice) * wv_b(i) + latice * wl_b(i) ! Take into account the surface fluxes of heat and moisture ! Use correct qflux from cam_in, not lhf/latvap as was done previously - te_b(i) = te_b(i)+(cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice))*hdtime + te_b(i) = te_b(i) + (cam_in%shf(i)+cam_in%cflx(i,1)*(latvap+latice)) * hdtime ! Compute the disbalance of total energy, over depth where CLUBB is active - se_dis = (te_a(i) - te_b(i))/(state1%pint(i,pverp)-state1%pint(i,clubbtop+1)) - - ! Fix the total energy coming out of CLUBB so it achieves enery conservation. - ! Apply this fixer throughout the column evenly, but only at layers where - ! CLUBB is active. - ! - ! NOTE: The energy fixer seems to cause the climate to change significantly - ! when using specified dynamics, so allow this to be turned off via a namelist - ! variable. - if (clubb_do_energyfix) then - do k=clubbtop+1,pver - clubb_s(k) = clubb_s(k) - se_dis*gravit - enddo - endif - - ! Now compute the tendencies of CLUBB to CAM, note that pverp is the ghost point - ! for all variables and therefore is never called in this loop - rtm_integral_vtend = 0._r8 - rtm_integral_ltend = 0._r8 - do k=1,pver - - ptend_loc%u(i,k) = (um(i,k)-state1%u(i,k))/hdtime ! east-west wind - ptend_loc%v(i,k) = (vm(i,k)-state1%v(i,k))/hdtime ! north-south wind - ptend_loc%q(i,k,ixq) = (rtm(i,k)-rcm(i,k)-state1%q(i,k,ixq))/hdtime ! water vapor - ptend_loc%q(i,k,ixcldliq) = (rcm(i,k)-state1%q(i,k,ixcldliq))/hdtime ! Tendency of liquid water - ptend_loc%s(i,k) = (clubb_s(k)-state1%s(i,k))/hdtime ! Tendency of static energy - - rtm_integral_ltend = rtm_integral_ltend + ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k)/gravit - rtm_integral_vtend = rtm_integral_vtend + ptend_loc%q(i,k,ixq)*state1%pdel(i,k)/gravit - - if (clubb_do_adv) then - if (macmic_it == cld_macmic_num_steps) then - - ! Here add a constant to moments which can be either positive or - ! negative. This is to prevent clipping when dynamics tries to - ! make all constituents positive - wp3(i,k) = wp3(i,k) + wp3_const - rtpthlp(i,k) = rtpthlp(i,k) + rtpthlp_const - wpthlp(i,k) = wpthlp(i,k) + wpthlp_const - wprtp(i,k) = wprtp(i,k) + wprtp_const - - ptend_loc%q(i,k,ixthlp2)=(thlp2(i,k)-state1%q(i,k,ixthlp2))/hdtime ! THLP Variance - ptend_loc%q(i,k,ixrtp2)=(rtp2(i,k)-state1%q(i,k,ixrtp2))/hdtime ! RTP Variance - ptend_loc%q(i,k,ixrtpthlp)=(rtpthlp(i,k)-state1%q(i,k,ixrtpthlp))/hdtime ! RTP THLP covariance - ptend_loc%q(i,k,ixwpthlp)=(wpthlp(i,k)-state1%q(i,k,ixwpthlp))/hdtime ! WPTHLP - ptend_loc%q(i,k,ixwprtp)=(wprtp(i,k)-state1%q(i,k,ixwprtp))/hdtime ! WPRTP - ptend_loc%q(i,k,ixwp2)=(wp2(i,k)-state1%q(i,k,ixwp2))/hdtime ! WP2 - ptend_loc%q(i,k,ixwp3)=(wp3(i,k)-state1%q(i,k,ixwp3))/hdtime ! WP3 - ptend_loc%q(i,k,ixup2)=(up2(i,k)-state1%q(i,k,ixup2))/hdtime ! UP2 - ptend_loc%q(i,k,ixvp2)=(vp2(i,k)-state1%q(i,k,ixvp2))/hdtime ! VP2 - else - ptend_loc%q(i,k,ixthlp2)=0._r8 - ptend_loc%q(i,k,ixrtp2)=0._r8 - ptend_loc%q(i,k,ixrtpthlp)=0._r8 - ptend_loc%q(i,k,ixwpthlp)=0._r8 - ptend_loc%q(i,k,ixwprtp)=0._r8 - ptend_loc%q(i,k,ixwp2)=0._r8 - ptend_loc%q(i,k,ixwp3)=0._r8 - ptend_loc%q(i,k,ixup2)=0._r8 - ptend_loc%q(i,k,ixvp2)=0._r8 - endif - - endif - - ! Apply tendencies to ice mixing ratio, liquid and ice number, and aerosol constituents. - ! Loading up this array doesn't mean the tendencies are applied. - ! edsclr_out is compressed with just the constituents being used, ptend and state are not compressed - - icnt=0 - do ixind=1,pcnst - if (lq(ixind)) then - icnt=icnt+1 - if ((ixind /= ixq) .and. (ixind /= ixcldliq) .and.& - (ixind /= ixthlp2) .and. (ixind /= ixrtp2) .and.& - (ixind /= ixrtpthlp) .and. (ixind /= ixwpthlp) .and.& - (ixind /= ixwprtp) .and. (ixind /= ixwp2) .and.& - (ixind /= ixwp3) .and. (ixind /= ixup2) .and. (ixind /= ixvp2) ) then - ptend_loc%q(i,k,ixind) = (edsclr_out(k,icnt)-state1%q(i,k,ixind))/hdtime ! transported constituents - end if - end if - enddo + se_dis(i) = (te_a(i) - te_b(i))/(state1%pint(i,pverp)-state1%pint(i,clubbtop(i)+1)) + end do - enddo + ! Fix the total energy coming out of CLUBB so it achieves energy conservation. + ! Apply this fixer throughout the column evenly, but only at layers where + ! CLUBB is active. + ! + ! NOTE: The energy fixer seems to cause the climate to change significantly + ! when using specified dynamics, so allow this to be turned off via a namelist + ! variable. + if (clubb_do_energyfix) then + do i=1, ncol + do k=clubbtop(i)+1,pver + clubb_s(i,k) = clubb_s(i,k) - se_dis(i)*gravit + end do + end do + end if + + ! Now compute the tendencies of CLUBB to CAM, note that pverp is the ghost point + ! for all variables and therefore is never called in this loop + rtm_integral_vtend(:) = 0._r8 + rtm_integral_ltend(:) = 0._r8 + + do k=1, pver + do i=1, ncol - enddo ! end column loop + ptend_loc%u(i,k) = (um(i,k) - state1%u(i,k)) / hdtime ! east-west wind + ptend_loc%v(i,k) = (vm(i,k) - state1%v(i,k)) / hdtime ! north-south wind + ptend_loc%q(i,k,ixq) = (rtm(i,k) - rcm(i,k)-state1%q(i,k,ixq)) / hdtime ! water vapor + ptend_loc%q(i,k,ixcldliq) = (rcm(i,k) - state1%q(i,k,ixcldliq)) / hdtime ! Tendency of liquid water + ptend_loc%s(i,k) = (clubb_s(i,k) - state1%s(i,k)) / hdtime ! Tendency of static energy - call outfld('KVH_CLUBB', khzm, pcols, lchnk) + rtm_integral_ltend(i) = rtm_integral_ltend(i) + ptend_loc%q(i,k,ixcldliq)*state1%pdel(i,k)/gravit + rtm_integral_vtend(i) = rtm_integral_vtend(i) + ptend_loc%q(i,k,ixq)*state1%pdel(i,k)/gravit - ! Add constant to ghost point so that output is not corrupted - if (clubb_do_adv) then + end do + end do + + + if (clubb_do_adv) then + if (macmic_it == cld_macmic_num_steps) then + + do k=1, pver + do i=1, ncol + + ! Here add a constant to moments which can be either positive or + ! negative. This is to prevent clipping when dynamics tries to + ! make all constituents positive + wp3(i,k) = wp3(i,k) + wp3_const + rtpthlp(i,k) = rtpthlp(i,k) + rtpthlp_const + wpthlp(i,k) = wpthlp(i,k) + wpthlp_const + wprtp(i,k) = wprtp(i,k) + wprtp_const + + ptend_loc%q(i,k,ixthlp2) = (thlp2(i,k) - state1%q(i,k,ixthlp2)) / hdtime ! THLP Variance + ptend_loc%q(i,k,ixrtp2) = (rtp2(i,k) - state1%q(i,k,ixrtp2)) / hdtime ! RTP Variance + ptend_loc%q(i,k,ixrtpthlp) = (rtpthlp(i,k) - state1%q(i,k,ixrtpthlp)) / hdtime ! RTP THLP covariance + ptend_loc%q(i,k,ixwpthlp) = (wpthlp(i,k) - state1%q(i,k,ixwpthlp)) / hdtime ! WPTHLP + ptend_loc%q(i,k,ixwprtp) = (wprtp(i,k) - state1%q(i,k,ixwprtp)) / hdtime ! WPRTP + ptend_loc%q(i,k,ixwp2) = (wp2(i,k) - state1%q(i,k,ixwp2)) / hdtime ! WP2 + ptend_loc%q(i,k,ixwp3) = (wp3(i,k) - state1%q(i,k,ixwp3)) / hdtime ! WP3 + ptend_loc%q(i,k,ixup2) = (up2(i,k) - state1%q(i,k,ixup2)) / hdtime ! UP2 + ptend_loc%q(i,k,ixvp2) = (vp2(i,k) - state1%q(i,k,ixvp2)) / hdtime ! VP2 + + end do + end do + + else + + do k=1, pver + do i=1, ncol + ptend_loc%q(i,k,ixthlp2) = 0._r8 + ptend_loc%q(i,k,ixrtp2) = 0._r8 + ptend_loc%q(i,k,ixrtpthlp) = 0._r8 + ptend_loc%q(i,k,ixwpthlp) = 0._r8 + ptend_loc%q(i,k,ixwprtp) = 0._r8 + ptend_loc%q(i,k,ixwp2) = 0._r8 + ptend_loc%q(i,k,ixwp3) = 0._r8 + ptend_loc%q(i,k,ixup2) = 0._r8 + ptend_loc%q(i,k,ixvp2) = 0._r8 + end do + end do + + end if + end if + + + ! Apply tendencies to ice mixing ratio, liquid and ice number, and aerosol constituents. + ! Loading up this array doesn't mean the tendencies are applied. + ! edsclr_out is compressed with just the constituents being used, ptend and state are not compressed + icnt=0 + do ixind=1,pcnst + if (lq(ixind)) then + icnt=icnt+1 + if ((ixind /= ixq) .and. (ixind /= ixcldliq) .and.& + (ixind /= ixthlp2) .and. (ixind /= ixrtp2) .and.& + (ixind /= ixrtpthlp) .and. (ixind /= ixwpthlp) .and.& + (ixind /= ixwprtp) .and. (ixind /= ixwp2) .and.& + (ixind /= ixwp3) .and. (ixind /= ixup2) .and. (ixind /= ixvp2) ) then + + do k=1, pver + do i=1, ncol + ptend_loc%q(i,k,ixind) = (edsclr_out(i,k,icnt)-state1%q(i,k,ixind))/hdtime ! transported constituents + end do + end do + + end if + end if + end do + + call t_stopf("clubb_tend_cam_i_loop") + + call outfld('KVH_CLUBB', khzm, pcols, lchnk) + + ! Add constant to ghost point so that output is not corrupted + if (clubb_do_adv) then if (macmic_it == cld_macmic_num_steps) then - wp3(:,pverp) = wp3(:,pverp) + wp3_const - rtpthlp(:,pverp) = rtpthlp(:,pverp) + rtpthlp_const - wpthlp(:,pverp) = wpthlp(:,pverp) + wpthlp_const - wprtp(:,pverp) = wprtp(:,pverp) + wprtp_const - endif - endif + wp3(:,pverp) = wp3(:,pverp) + wp3_const + rtpthlp(:,pverp) = rtpthlp(:,pverp) + rtpthlp_const + wpthlp(:,pverp) = wpthlp(:,pverp) + wpthlp_const + wprtp(:,pverp) = wprtp(:,pverp) + wprtp_const + end if + end if cmeliq(:,:) = ptend_loc%q(:,:,ixcldliq) @@ -3134,7 +3880,7 @@ subroutine clubb_tend_cam( & dum1 = 1.0_r8 else dum1 = ( meltpt_temp - state1%t(i,k) ) / ( meltpt_temp - dt_low ) - endif + end if if (zmconv_microp) then ptend_loc%q(i,k,ixcldliq) = dlfzm(i,k) + dlf2(i,k) * ( 1._r8 - dum1 ) @@ -3205,14 +3951,14 @@ subroutine clubb_tend_cam( & relvarmax = 2.0_r8 else relvarmax = 10.0_r8 - endif + end if relvar(:,:) = relvarmax ! default if (deep_scheme .ne. 'CLUBB_SGS') then where (rcm(:ncol,:pver) /= 0 .and. qclvar(:ncol,:pver) /= 0) & relvar(:ncol,:pver) = min(relvarmax,max(0.001_r8,rcm(:ncol,:pver)**2/qclvar(:ncol,:pver))) - endif + end if ! ------------------------------------------------- ! ! Optional Accretion enhancement factor ! @@ -3282,8 +4028,9 @@ subroutine clubb_tend_cam( & ! THIS PART COMPUTES CONVECTIVE AND DEEP CONVECTIVE CLOUD FRACTION ! ! --------------------------------------------------------------------------------- ! - deepcu(:,pver) = 0.0_r8 - shalcu(:,pver) = 0.0_r8 + ! Initialize cloud fraction + deepcu(:,:) = 0.0_r8 + shalcu(:,:) = 0.0_r8 do k=1,pver-1 do i=1,ncol @@ -3296,7 +4043,7 @@ subroutine clubb_tend_cam( & if (deepcu(i,k) <= frac_limit .or. dp_icwmr(i,k) < ic_limit) then deepcu(i,k) = 0._r8 - endif + end if ! using the deep convective cloud fraction, and CLUBB cloud fraction (variable ! "cloud_frac"), compute the convective cloud fraction. This follows the formulation @@ -3317,8 +4064,8 @@ subroutine clubb_tend_cam( & deepcu(:,:) = 0.0_r8 concld(:,:) = 0.0_r8 - endif - endif + end if + end if ! --------------------------------------------------------------------------------- ! ! COMPUTE THE ICE CLOUD FRACTION PORTION ! @@ -3353,7 +4100,7 @@ subroutine clubb_tend_cam( & call aist_vector(state1%q(:,k,ixq),state1%t(:,k),state1%pmid(:,k),state1%q(:,k,ixcldice), & state1%q(:,k,ixnumice), cam_in%landfrac(:),cam_in%snowhland(:),aist(:,k),ncol,& qsatfac_out=qsatfac(:,k), rhmini_in=rhmini, rhmaxi_in=rhmaxi) - endif + end if enddo ! --------------------------------------------------------------------------------- ! @@ -3398,7 +4145,7 @@ subroutine clubb_tend_cam( & enddo ! diagnose surface friction and obukhov length (inputs to diagnose PBL depth) - rrho(1:ncol) = (1._r8/gravit)*(state1%pdel(1:ncol,pver)/dz_g(pver)) + rrho(1:ncol) = (1._r8/gravit)*(state1%pdel(1:ncol,pver)/dz_g(1:ncol,pver)) call calc_ustar( ncol, state1%t(1:ncol,pver), state1%pmid(1:ncol,pver), cam_in%wsx(1:ncol), cam_in%wsy(1:ncol), & rrho(1:ncol), ustar2(1:ncol)) ! use correct qflux from coupler @@ -3517,39 +4264,41 @@ subroutine clubb_tend_cam( & ! Output CLUBB history here if (l_stats) then - do i=1,stats_zt%num_output_fields + do j=1,stats_zt(1)%num_output_fields - temp1 = trim(stats_zt%file%var(i)%name) + temp1 = trim(stats_zt(1)%file%grid_avg_var(j)%name) sub = temp1 if (len(temp1) > 16) sub = temp1(1:16) - call outfld(trim(sub), out_zt(:,:,i), pcols, lchnk ) + call outfld(trim(sub), out_zt(:,:,j), pcols, lchnk ) enddo - do i=1,stats_zm%num_output_fields + do j=1,stats_zm(1)%num_output_fields - temp1 = trim(stats_zm%file%var(i)%name) + temp1 = trim(stats_zm(1)%file%grid_avg_var(j)%name) sub = temp1 if (len(temp1) > 16) sub = temp1(1:16) - call outfld(trim(sub),out_zm(:,:,i), pcols, lchnk) + call outfld(trim(sub),out_zm(:,:,j), pcols, lchnk) enddo if (l_output_rad_files) then - do i=1,stats_rad_zt%num_output_fields - call outfld(trim(stats_rad_zt%file%var(i)%name), out_radzt(:,:,i), pcols, lchnk) + do j=1,stats_rad_zt(1)%num_output_fields + call outfld(trim(stats_rad_zt(1)%file%grid_avg_var(j)%name), out_radzt(:,:,j), pcols, lchnk) enddo - do i=1,stats_rad_zm%num_output_fields - call outfld(trim(stats_rad_zm%file%var(i)%name), out_radzm(:,:,i), pcols, lchnk) + do j=1,stats_rad_zm(1)%num_output_fields + call outfld(trim(stats_rad_zm(1)%file%grid_avg_var(j)%name), out_radzm(:,:,j), pcols, lchnk) enddo - endif + end if - do i=1,stats_sfc%num_output_fields - call outfld(trim(stats_sfc%file%var(i)%name), out_sfc(:,:,i), pcols, lchnk) + do j=1,stats_sfc(1)%num_output_fields + call outfld(trim(stats_sfc(1)%file%grid_avg_var(j)%name), out_sfc(:,:,j), pcols, lchnk) enddo - endif + end if + + call t_stopf("clubb_tend_cam") return #endif @@ -3676,7 +4425,7 @@ real(r8) function diag_ustar( z, bflx, wnd, z0 ) ustar = wnd*vonk/(lnz - psi1) end if - endif + end if end do end if @@ -3697,7 +4446,9 @@ end function diag_ustar #ifdef CLUBB_SGS subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & - nnzp, nnrad_zt,nnrad_zm, delt ) + nnzp, nnrad_zt,nnrad_zm, delt, & + stats_zt, stats_zm, stats_sfc, & + stats_rad_zt, stats_rad_zm) ! ! Description: Initializes the statistics saving functionality of ! the CLUBB model. This is for purpose of CAM-CLUBB interface. Here @@ -3708,7 +4459,6 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & use clubb_api_module, only: & - stats_zt, & ! Variables ztscr01, & ztscr02, & ztscr03, & @@ -3732,7 +4482,6 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ztscr21 use clubb_api_module, only: & - stats_zm, & zmscr01, & zmscr02, & zmscr03, & @@ -3750,9 +4499,6 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & zmscr15, & zmscr16, & zmscr17, & - stats_rad_zt, & - stats_rad_zm, & - stats_sfc, & l_stats, & l_output_rad_files, & stats_tsamp, & @@ -3790,6 +4536,13 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & integer, intent(in) :: nnrad_zm ! Grid points in the radiation grid [count] real(kind=time_precision), intent(in) :: delt ! Timestep (dtmain in CLUBB) [s] + + ! Output Variables + type (stats), intent(out) :: stats_zt, & ! stats_zt grid + stats_zm, & ! stats_zm grid + stats_rad_zt, & ! stats_rad_zt grid + stats_rad_zm, & ! stats_rad_zm grid + stats_sfc ! stats_sfc ! Local Variables @@ -3813,7 +4566,8 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ! Local Variables - logical :: l_error + logical :: l_error, & + first_call = .false. character(len=200) :: temp1, sub @@ -3885,7 +4639,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & 'model.in file.' write(fstderr,*) 'stats_tsamp = ', stats_tsamp write(fstderr,*) 'delt = ', delt - endif + end if ! Initialize zt (mass points) @@ -3903,7 +4657,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & "in the stats namelist, or change nvarmax_zt." write(fstderr,*) "nvarmax_zt = ", nvarmax_zt call endrun ("stats_init_clubb: number of zt statistical variables exceeds limit") - endif + end if stats_zt%num_output_fields = ntot stats_zt%kk = nnzp @@ -3913,35 +4667,37 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & allocate( stats_zt%accum_field_values( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) allocate( stats_zt%accum_num_samples( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) allocate( stats_zt%l_in_update( 1, 1, stats_zt%kk, stats_zt%num_output_fields ) ) + call stats_zero( stats_zt%kk, stats_zt%num_output_fields, stats_zt%accum_field_values, & stats_zt%accum_num_samples, stats_zt%l_in_update ) - allocate( stats_zt%file%var( stats_zt%num_output_fields ) ) + allocate( stats_zt%file%grid_avg_var( stats_zt%num_output_fields ) ) allocate( stats_zt%file%z( stats_zt%kk ) ) - ! Allocate scratch space + first_call = (.not. allocated(ztscr01)) - allocate( ztscr01(stats_zt%kk) ) - allocate( ztscr02(stats_zt%kk) ) - allocate( ztscr03(stats_zt%kk) ) - allocate( ztscr04(stats_zt%kk) ) - allocate( ztscr05(stats_zt%kk) ) - allocate( ztscr06(stats_zt%kk) ) - allocate( ztscr07(stats_zt%kk) ) - allocate( ztscr08(stats_zt%kk) ) - allocate( ztscr09(stats_zt%kk) ) - allocate( ztscr10(stats_zt%kk) ) - allocate( ztscr11(stats_zt%kk) ) - allocate( ztscr12(stats_zt%kk) ) - allocate( ztscr13(stats_zt%kk) ) - allocate( ztscr14(stats_zt%kk) ) - allocate( ztscr15(stats_zt%kk) ) - allocate( ztscr16(stats_zt%kk) ) - allocate( ztscr17(stats_zt%kk) ) - allocate( ztscr18(stats_zt%kk) ) - allocate( ztscr19(stats_zt%kk) ) - allocate( ztscr20(stats_zt%kk) ) - allocate( ztscr21(stats_zt%kk) ) + ! Allocate scratch space + if (first_call) allocate( ztscr01(stats_zt%kk) ) + if (first_call) allocate( ztscr02(stats_zt%kk) ) + if (first_call) allocate( ztscr03(stats_zt%kk) ) + if (first_call) allocate( ztscr04(stats_zt%kk) ) + if (first_call) allocate( ztscr05(stats_zt%kk) ) + if (first_call) allocate( ztscr06(stats_zt%kk) ) + if (first_call) allocate( ztscr07(stats_zt%kk) ) + if (first_call) allocate( ztscr08(stats_zt%kk) ) + if (first_call) allocate( ztscr09(stats_zt%kk) ) + if (first_call) allocate( ztscr10(stats_zt%kk) ) + if (first_call) allocate( ztscr11(stats_zt%kk) ) + if (first_call) allocate( ztscr12(stats_zt%kk) ) + if (first_call) allocate( ztscr13(stats_zt%kk) ) + if (first_call) allocate( ztscr14(stats_zt%kk) ) + if (first_call) allocate( ztscr15(stats_zt%kk) ) + if (first_call) allocate( ztscr16(stats_zt%kk) ) + if (first_call) allocate( ztscr17(stats_zt%kk) ) + if (first_call) allocate( ztscr18(stats_zt%kk) ) + if (first_call) allocate( ztscr19(stats_zt%kk) ) + if (first_call) allocate( ztscr20(stats_zt%kk) ) + if (first_call) allocate( ztscr21(stats_zt%kk) ) ztscr01 = 0.0_r8 ztscr02 = 0.0_r8 @@ -3966,8 +4722,10 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & ztscr21 = 0.0_r8 ! Default initialization for array indices for zt - - call stats_init_zt_api( clubb_vars_zt, l_error ) + if (first_call) then + call stats_init_zt_api( clubb_vars_zt, l_error, & + stats_zt ) + end if ! Initialize zm (momentum points) @@ -3985,7 +4743,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & "in the stats namelist, or change nvarmax_zm." write(fstderr,*) "nvarmax_zm = ", nvarmax_zm call endrun ("stats_init_clubb: number of zm statistical variables exceeds limit") - endif + end if stats_zm%num_output_fields = ntot stats_zm%kk = nnzp @@ -3995,31 +4753,32 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & allocate( stats_zm%accum_field_values( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) allocate( stats_zm%accum_num_samples( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) allocate( stats_zm%l_in_update( 1, 1, stats_zm%kk, stats_zm%num_output_fields ) ) + call stats_zero( stats_zm%kk, stats_zm%num_output_fields, stats_zm%accum_field_values, & stats_zm%accum_num_samples, stats_zm%l_in_update ) - allocate( stats_zm%file%var( stats_zm%num_output_fields ) ) + allocate( stats_zm%file%grid_avg_var( stats_zm%num_output_fields ) ) allocate( stats_zm%file%z( stats_zm%kk ) ) ! Allocate scratch space - allocate( zmscr01(stats_zm%kk) ) - allocate( zmscr02(stats_zm%kk) ) - allocate( zmscr03(stats_zm%kk) ) - allocate( zmscr04(stats_zm%kk) ) - allocate( zmscr05(stats_zm%kk) ) - allocate( zmscr06(stats_zm%kk) ) - allocate( zmscr07(stats_zm%kk) ) - allocate( zmscr08(stats_zm%kk) ) - allocate( zmscr09(stats_zm%kk) ) - allocate( zmscr10(stats_zm%kk) ) - allocate( zmscr11(stats_zm%kk) ) - allocate( zmscr12(stats_zm%kk) ) - allocate( zmscr13(stats_zm%kk) ) - allocate( zmscr14(stats_zm%kk) ) - allocate( zmscr15(stats_zm%kk) ) - allocate( zmscr16(stats_zm%kk) ) - allocate( zmscr17(stats_zm%kk) ) + if (first_call) allocate( zmscr01(stats_zm%kk) ) + if (first_call) allocate( zmscr02(stats_zm%kk) ) + if (first_call) allocate( zmscr03(stats_zm%kk) ) + if (first_call) allocate( zmscr04(stats_zm%kk) ) + if (first_call) allocate( zmscr05(stats_zm%kk) ) + if (first_call) allocate( zmscr06(stats_zm%kk) ) + if (first_call) allocate( zmscr07(stats_zm%kk) ) + if (first_call) allocate( zmscr08(stats_zm%kk) ) + if (first_call) allocate( zmscr09(stats_zm%kk) ) + if (first_call) allocate( zmscr10(stats_zm%kk) ) + if (first_call) allocate( zmscr11(stats_zm%kk) ) + if (first_call) allocate( zmscr12(stats_zm%kk) ) + if (first_call) allocate( zmscr13(stats_zm%kk) ) + if (first_call) allocate( zmscr14(stats_zm%kk) ) + if (first_call) allocate( zmscr15(stats_zm%kk) ) + if (first_call) allocate( zmscr16(stats_zm%kk) ) + if (first_call) allocate( zmscr17(stats_zm%kk) ) zmscr01 = 0.0_r8 zmscr02 = 0.0_r8 @@ -4039,7 +4798,10 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & zmscr16 = 0.0_r8 zmscr17 = 0.0_r8 - call stats_init_zm_api( clubb_vars_zm, l_error ) + if (first_call) then + call stats_init_zm_api( clubb_vars_zm, l_error, & + stats_zm ) + end if ! Initialize rad_zt (radiation points) @@ -4059,7 +4821,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & "in the stats namelist, or change nvarmax_rad_zt." write(fstderr,*) "nvarmax_rad_zt = ", nvarmax_rad_zt call endrun ("stats_init_clubb: number of rad_zt statistical variables exceeds limit") - endif + end if stats_rad_zt%num_output_fields = ntot stats_rad_zt%kk = nnrad_zt @@ -4073,10 +4835,11 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & call stats_zero( stats_rad_zt%kk, stats_rad_zt%num_output_fields, stats_rad_zt%accum_field_values, & stats_rad_zt%accum_num_samples, stats_rad_zt%l_in_update ) - allocate( stats_rad_zt%file%var( stats_rad_zt%num_output_fields ) ) + allocate( stats_rad_zt%file%grid_avg_var( stats_rad_zt%num_output_fields ) ) allocate( stats_rad_zt%file%z( stats_rad_zt%kk ) ) - call stats_init_rad_zt_api( clubb_vars_rad_zt, l_error ) + call stats_init_rad_zt_api( clubb_vars_rad_zt, l_error, & + stats_rad_zt ) ! Initialize rad_zm (radiation points) @@ -4094,7 +4857,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & "in the stats namelist, or change nvarmax_rad_zm." write(fstderr,*) "nvarmax_rad_zm = ", nvarmax_rad_zm call endrun ("stats_init_clubb: number of rad_zm statistical variables exceeds limit") - endif + end if stats_rad_zm%num_output_fields = ntot stats_rad_zm%kk = nnrad_zm @@ -4108,10 +4871,11 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & call stats_zero( stats_rad_zm%kk, stats_rad_zm%num_output_fields, stats_rad_zm%accum_field_values, & stats_rad_zm%accum_num_samples, stats_rad_zm%l_in_update ) - allocate( stats_rad_zm%file%var( stats_rad_zm%num_output_fields ) ) + allocate( stats_rad_zm%file%grid_avg_var( stats_rad_zm%num_output_fields ) ) allocate( stats_rad_zm%file%z( stats_rad_zm%kk ) ) - call stats_init_rad_zm_api( clubb_vars_rad_zm, l_error ) + call stats_init_rad_zm_api( clubb_vars_rad_zm, l_error, & + stats_rad_zm ) end if ! l_output_rad_files @@ -4131,7 +4895,7 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & "in the stats namelist, or change nvarmax_sfc." write(fstderr,*) "nvarmax_sfc = ", nvarmax_sfc call endrun ("stats_init_clubb: number of sfc statistical variables exceeds limit") - endif + end if stats_sfc%num_output_fields = ntot stats_sfc%kk = 1 @@ -4145,57 +4909,62 @@ subroutine stats_init_clubb( l_stats_in, stats_tsamp_in, stats_tout_in, & call stats_zero( stats_sfc%kk, stats_sfc%num_output_fields, stats_sfc%accum_field_values, & stats_sfc%accum_num_samples, stats_sfc%l_in_update ) - allocate( stats_sfc%file%var( stats_sfc%num_output_fields ) ) + allocate( stats_sfc%file%grid_avg_var( stats_sfc%num_output_fields ) ) allocate( stats_sfc%file%z( stats_sfc%kk ) ) - call stats_init_sfc_api( clubb_vars_sfc, l_error ) + if (first_call) then + call stats_init_sfc_api( clubb_vars_sfc, l_error, & + stats_sfc ) + end if ! Check for errors if ( l_error ) then call endrun ('stats_init: errors found') - endif + end if ! Now call add fields - do i = 1, stats_zt%num_output_fields - - temp1 = trim(stats_zt%file%var(i)%name) - sub = temp1 - if (len(temp1) > 16) sub = temp1(1:16) - -!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical - call addfld(trim(sub),(/ 'ilev' /),& - 'A',trim(stats_zt%file%var(i)%units),trim(stats_zt%file%var(i)%description)) - enddo - - do i = 1, stats_zm%num_output_fields - - temp1 = trim(stats_zm%file%var(i)%name) - sub = temp1 - if (len(temp1) > 16) sub = temp1(1:16) - -!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical - call addfld(trim(sub),(/ 'ilev' /),& - 'A',trim(stats_zm%file%var(i)%units),trim(stats_zm%file%var(i)%description)) - enddo + if (first_call) then + + do i = 1, stats_zt%num_output_fields + + temp1 = trim(stats_zt%file%grid_avg_var(i)%name) + sub = temp1 + if (len(temp1) > 16) sub = temp1(1:16) + + call addfld(trim(sub),(/ 'ilev' /),& + 'A',trim(stats_zt%file%grid_avg_var(i)%units),trim(stats_zt%file%grid_avg_var(i)%description)) + enddo + + do i = 1, stats_zm%num_output_fields + + temp1 = trim(stats_zm%file%grid_avg_var(i)%name) + sub = temp1 + if (len(temp1) > 16) sub = temp1(1:16) + + call addfld(trim(sub),(/ 'ilev' /),& + 'A',trim(stats_zm%file%grid_avg_var(i)%units),trim(stats_zm%file%grid_avg_var(i)%description)) + enddo - if (l_output_rad_files) then -!!XXgoldyXX: Probably need a hist coord for nnzp for the vertical - do i = 1, stats_rad_zt%num_output_fields - call addfld(trim(stats_rad_zt%file%var(i)%name),(/ 'ilev' /),& - 'A',trim(stats_rad_zt%file%var(i)%units),trim(stats_rad_zt%file%var(i)%description)) - enddo - - do i = 1, stats_rad_zm%num_output_fields - call addfld(trim(stats_rad_zm%file%var(i)%name),(/ 'ilev' /),& - 'A',trim(stats_rad_zm%file%var(i)%units),trim(stats_rad_zm%file%var(i)%description)) - enddo - endif - - do i = 1, stats_sfc%num_output_fields - call addfld(trim(stats_sfc%file%var(i)%name),horiz_only,& - 'A',trim(stats_sfc%file%var(i)%units),trim(stats_sfc%file%var(i)%description)) - enddo + if (l_output_rad_files) then + + do i = 1, stats_rad_zt%num_output_fields + call addfld(trim(stats_rad_zt%file%grid_avg_var(i)%name),(/ 'ilev' /),& + 'A',trim(stats_rad_zt%file%grid_avg_var(i)%units),trim(stats_rad_zt%file%grid_avg_var(i)%description)) + enddo + + do i = 1, stats_rad_zm%num_output_fields + call addfld(trim(stats_rad_zm%file%grid_avg_var(i)%name),(/ 'ilev' /),& + 'A',trim(stats_rad_zm%file%grid_avg_var(i)%units),trim(stats_rad_zm%file%grid_avg_var(i)%description)) + enddo + end if + + do i = 1, stats_sfc%num_output_fields + call addfld(trim(stats_sfc%file%grid_avg_var(i)%name),horiz_only,& + 'A',trim(stats_sfc%file%grid_avg_var(i)%units),trim(stats_sfc%file%grid_avg_var(i)%description)) + enddo + + end if return @@ -4207,26 +4976,21 @@ end subroutine stats_init_clubb ! ! ! =============================================================================== ! - +#ifdef CLUBB_SGS + subroutine stats_end_timestep_clubb(thecol, stats_zt, stats_zm, stats_rad_zt, stats_rad_zm, stats_sfc, & + out_zt, out_zm, out_radzt, out_radzm, out_sfc) !----------------------------------------------------------------------- - subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out_sfc) - ! Description: Called when the stats timestep has ended. This subroutine ! is responsible for calling statistics to be written to the output ! format. !----------------------------------------------------------------------- -#ifdef CLUBB_SGS + use shr_infnan_mod, only: is_nan => shr_infnan_isnan use clubb_api_module, only: & fstderr, & ! Constant(s) - stats_zt, & ! Variable(s) - stats_zm, & - stats_rad_zt, & - stats_rad_zm, & - stats_sfc, & l_stats_last, & stats_tsamp, & stats_tout, & @@ -4237,18 +5001,22 @@ subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out implicit none - -#endif - integer :: thecol + ! Input Variables + type (stats), intent(inout) :: stats_zt, & ! stats_zt grid + stats_zm, & ! stats_zm grid + stats_rad_zt, & ! stats_rad_zt grid + stats_rad_zm, & ! stats_rad_zm grid + stats_sfc ! stats_sfc + + ! Inout variables real(r8), intent(inout) :: out_zt(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields) real(r8), intent(inout) :: out_zm(:,:,:) ! (pcols,pverp,stats_zt%num_output_fields) real(r8), intent(inout) :: out_radzt(:,:,:) ! (pcols,pverp,stats_rad_zt%num_output_fields) real(r8), intent(inout) :: out_radzm(:,:,:) ! (pcols,pverp,rad_zm%num_output_fields) real(r8), intent(inout) :: out_sfc(:,:,:) ! (pcols,1,sfc%num_output_fields) -#ifdef CLUBB_SGS ! Local Variables integer :: i, k @@ -4310,7 +5078,7 @@ subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out out_radzt(thecol,:top_lev-1,:) = 0.0_r8 out_radzm(thecol,:top_lev-1,:) = 0.0_r8 - endif ! l_output_rad_files + end if ! l_output_rad_files do i = 1, stats_sfc%num_output_fields out_sfc(thecol,1,i) = stats_sfc%accum_field_values(1,1,1,i) @@ -4333,10 +5101,8 @@ subroutine stats_end_timestep_clubb(thecol,out_zt,out_zm,out_radzt,out_radzm,out return -#endif - end subroutine stats_end_timestep_clubb - +#endif ! =============================================================================== ! ! ! @@ -4459,208 +5225,5 @@ subroutine grid_size(state, grid_dx, grid_dy) end subroutine grid_size #endif - -#ifdef CLUBB_SGS - subroutine init_clubb_config_flags( clubb_config_flags_in ) -!------------------------------------------------------------------------------- -! Description: -! Initializes the public module variable 'clubb_config_flags' of type -! 'clubb_config_flags_type' on first call and only on first call. -! References: -! None -!------------------------------------------------------------------------------- - use clubb_api_module, only: & - clubb_config_flags_type, & ! Type - set_default_clubb_config_flags_api, & ! Procedure(s) - initialize_clubb_config_flags_type_api - - implicit none - - ! Input/Output Variables - type(clubb_config_flags_type), intent(inout) :: clubb_config_flags_in - - ! Local Variables - logical :: & - l_use_precip_frac, & ! Flag to use precipitation fraction in KK microphysics. The - ! precipitation fraction is automatically set to 1 when this - ! flag is turned off. - l_predict_upwp_vpwp, & ! Flag to predict and along with and - ! alongside the advancement of , , , - ! , , and in subroutine - ! advance_xm_wpxp. Otherwise, and are still - ! approximated by eddy diffusivity when and are - ! advanced in subroutine advance_windm_edsclrm. - l_min_wp2_from_corr_wx, & ! Flag to base the threshold minimum value of wp2 on keeping - ! the overall correlation of w and x (w and rt, as well as w - ! and theta-l) within the limits of -max_mag_correlation_flux - ! to max_mag_correlation_flux. - l_min_xp2_from_corr_wx, & ! Flag to base the threshold minimum value of xp2 (rtp2 and - ! thlp2) on keeping the overall correlation of w and x within - ! the limits of -max_mag_correlation_flux to - ! max_mag_correlation_flux. - l_C2_cloud_frac, & ! Flag to use cloud fraction to adjust the value of the - ! turbulent dissipation coefficient, C2. - l_diffuse_rtm_and_thlm, & ! Diffuses rtm and thlm - l_stability_correct_Kh_N2_zm, & ! Divides Kh_N2_zm by a stability factor - l_calc_thlp2_rad, & ! Include the contribution of radiation to thlp2 - l_upwind_wpxp_ta, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent or mean advection terms. It - ! affects wprtp, wpthlp, & wpsclrp. - l_upwind_xpyp_ta, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent or mean advection terms. It - ! affects rtp2, thlp2, up2, vp2, sclrp2, rtpthlp, sclrprtp, & - ! sclrpthlp. - l_upwind_xm_ma, & ! This flag determines whether we want to use an upwind - ! differencing approximation rather than a centered - ! differencing for turbulent or mean advection terms. It - ! affects rtm, thlm, sclrm, um and vm. - l_uv_nudge, & ! For wind speed nudging. - l_rtm_nudge, & ! For rtm nudging - l_tke_aniso, & ! For anisotropic turbulent kinetic energy, i.e. - ! TKE = 1/2 (u'^2 + v'^2 + w'^2) - l_vert_avg_closure, & ! Use 2 calls to pdf_closure and the trapezoidal rule to - ! compute the varibles that are output from high order - ! closure - l_trapezoidal_rule_zt, & ! If true, the trapezoidal rule is called for the - ! thermodynamic-level variables output from pdf_closure. - l_trapezoidal_rule_zm, & ! If true, the trapezoidal rule is called for three - ! momentum-level variables - wpthvp, thlpthvp, and rtpthvp - - ! output from pdf_closure. - l_call_pdf_closure_twice, & ! This logical flag determines whether or not to call - ! subroutine pdf_closure twice. If true, pdf_closure is - ! called first on thermodynamic levels and then on momentum - ! levels so that each variable is computed on its native - ! level. If false, pdf_closure is only called on - ! thermodynamic levels, and variables which belong on - ! momentum levels are interpolated. - l_standard_term_ta, & ! Use the standard discretization for the turbulent advection - ! terms. Setting to .false. means that a_1 and a_3 are - ! pulled outside of the derivative in - ! advance_wp2_wp3_module.F90 and in - ! advance_xp2_xpyp_module.F90. - l_use_cloud_cover, & ! Use cloud_cover and rcm_in_layer to help boost cloud_frac - ! and rcm to help increase cloudiness at coarser grid - ! resolutions. - l_diagnose_correlations, & ! Diagnose correlations instead of using fixed ones - l_calc_w_corr, & ! Calculate the correlations between w and the hydrometeors - l_const_Nc_in_cloud, & ! Use a constant cloud droplet conc. within cloud (K&K) - l_fix_w_chi_eta_correlations, & ! Use a fixed correlation for s and t Mellor(chi/eta) - l_stability_correct_tau_zm, & ! Use tau_N2_zm instead of tau_zm in wpxp_pr1 stability - ! correction - l_damp_wp2_using_em, & ! In wp2 equation, use a dissipation formula of - ! -(2/3)*em/tau_zm, as in Bougeault (1981) - l_do_expldiff_rtm_thlm, & ! Diffuse rtm and thlm explicitly - l_Lscale_plume_centered, & ! Alternate that uses the PDF to compute the perturbed values - l_diag_Lscale_from_tau, & ! First diagnose dissipation time tau, and then diagnose the - ! mixing length scale as Lscale = tau * tke - l_use_ice_latent, & ! Includes the effects of ice latent heating in turbulence - ! terms - l_use_C7_Richardson, & ! Parameterize C7 based on Richardson number - l_use_C11_Richardson, & ! Parameterize C11 and C16 based on Richardson number - l_brunt_vaisala_freq_moist, & ! Use a different formula for the Brunt-Vaisala frequency in - ! saturated atmospheres (from Durran and Klemp, 1982) - l_use_thvm_in_bv_freq, & ! Use thvm in the calculation of Brunt-Vaisala frequency - l_rcm_supersat_adj, & ! Add excess supersaturated vapor to cloud water - l_single_C2_Skw, & ! Use a single Skewness dependent C2 for rtp2, thlp2, and - ! rtpthlp - l_damp_wp3_Skw_squared, & ! Set damping on wp3 to use Skw^2 rather than Skw^4 - l_prescribed_avg_deltaz, & ! used in adj_low_res_nu. If .true., avg_deltaz = deltaz - l_update_pressure ! Flag for having CLUBB update pressure and exner - - logical, save :: first_call = .true. - - if (first_call) then - - call set_default_clubb_config_flags_api( l_use_precip_frac, & ! Out - l_predict_upwp_vpwp, & ! Out - l_min_wp2_from_corr_wx, & ! Out - l_min_xp2_from_corr_wx, & ! Out - l_C2_cloud_frac, & ! Out - l_diffuse_rtm_and_thlm, & ! Out - l_stability_correct_Kh_N2_zm, & ! Out - l_calc_thlp2_rad, & ! Out - l_upwind_wpxp_ta, & ! Out - l_upwind_xpyp_ta, & ! Out - l_upwind_xm_ma, & ! Out - l_uv_nudge, & ! Out - l_rtm_nudge, & ! Out - l_tke_aniso, & ! Out - l_vert_avg_closure, & ! Out - l_trapezoidal_rule_zt, & ! Out - l_trapezoidal_rule_zm, & ! Out - l_call_pdf_closure_twice, & ! Out - l_standard_term_ta, & ! Out - l_use_cloud_cover, & ! Out - l_diagnose_correlations, & ! Out - l_calc_w_corr, & ! Out - l_const_Nc_in_cloud, & ! Out - l_fix_w_chi_eta_correlations, & ! Out - l_stability_correct_tau_zm, & ! Out - l_damp_wp2_using_em, & ! Out - l_do_expldiff_rtm_thlm, & ! Out - l_Lscale_plume_centered, & ! Out - l_diag_Lscale_from_tau, & ! Out - l_use_ice_latent, & ! Out - l_use_C7_Richardson, & ! Out - l_use_C11_Richardson, & ! Out - l_brunt_vaisala_freq_moist, & ! Out - l_use_thvm_in_bv_freq, & ! Out - l_rcm_supersat_adj, & ! Out - l_single_C2_Skw, & ! Out - l_damp_wp3_Skw_squared, & ! Out - l_prescribed_avg_deltaz, & ! Out - l_update_pressure ) ! Out - - call initialize_clubb_config_flags_type_api( l_use_precip_frac, & ! In - l_predict_upwp_vpwp, & ! In - l_min_wp2_from_corr_wx, & ! In - l_min_xp2_from_corr_wx, & ! In - l_C2_cloud_frac, & ! In - l_diffuse_rtm_and_thlm, & ! In - l_stability_correct_Kh_N2_zm, & ! In - l_calc_thlp2_rad, & ! In - l_upwind_wpxp_ta, & ! In - l_upwind_xpyp_ta, & ! In - l_upwind_xm_ma, & ! In - l_uv_nudge, & ! In - l_rtm_nudge, & ! In - l_tke_aniso, & ! In - l_vert_avg_closure, & ! In - l_trapezoidal_rule_zt, & ! In - l_trapezoidal_rule_zm, & ! In - l_call_pdf_closure_twice, & ! In - l_standard_term_ta, & ! In - l_use_cloud_cover, & ! In - l_diagnose_correlations, & ! In - l_calc_w_corr, & ! In - l_const_Nc_in_cloud, & ! In - l_fix_w_chi_eta_correlations, & ! In - l_stability_correct_tau_zm, & ! In - l_damp_wp2_using_em, & ! In - l_do_expldiff_rtm_thlm, & ! In - l_Lscale_plume_centered, & ! In - l_diag_Lscale_from_tau, & ! In - l_use_ice_latent, & ! In - l_use_C7_Richardson, & ! In - l_use_C11_Richardson, & ! In - l_brunt_vaisala_freq_moist, & ! In - l_use_thvm_in_bv_freq, & ! In - l_rcm_supersat_adj, & ! In - l_single_C2_Skw, & ! In - l_damp_wp3_Skw_squared, & ! In - l_prescribed_avg_deltaz, & ! In - l_update_pressure, & ! In - clubb_config_flags_in ) ! Out - - first_call = .false. - - end if - - return - - end subroutine init_clubb_config_flags -#endif end module clubb_intr diff --git a/src/physics/cam/iop_forcing.F90 b/src/physics/cam/iop_forcing.F90 index 55259685b5..7f309caabc 100644 --- a/src/physics/cam/iop_forcing.F90 +++ b/src/physics/cam/iop_forcing.F90 @@ -29,6 +29,8 @@ subroutine scam_use_iop_srf( cam_in ) use physconst, only: stebol, latvap use scamMod use cam_abortutils, only: endrun + use cam_logfile, only: iulog + use spmd_utils, only: masterproc implicit none save @@ -37,6 +39,17 @@ subroutine scam_use_iop_srf( cam_in ) integer :: c ! Chunk index integer :: ncol ! Number of columns + + if (masterproc) write(iulog,*) " Parameters in iop_forcing :" + if (masterproc) write(iulog,*) " scm_iop_lhflxshflxTg =", scm_iop_lhflxshflxTg + if (masterproc) write(iulog,*) " scm_iop_Tg =", scm_iop_Tg + if (masterproc) write(iulog,*) " scm_crm_mode =", scm_crm_mode + if (masterproc) write(iulog,*) " have_lhflx =", have_lhflx + if (masterproc) write(iulog,*) " have_shflx =", have_shflx + if (masterproc) write(iulog,*) " have_Tg =", have_Tg + if (masterproc) write(iulog,*) " Tground =", tground + + if( scm_iop_lhflxshflxTg .and. scm_iop_Tg ) then call endrun( 'scam_use_iop_srf : scm_iop_lhflxshflxTg and scm_iop_Tg must not be specified at the same time.') end if diff --git a/src/physics/cam/ref_pres.F90 b/src/physics/cam/ref_pres.F90 index 742652db11..fa28869ac6 100644 --- a/src/physics/cam/ref_pres.F90 +++ b/src/physics/cam/ref_pres.F90 @@ -13,6 +13,7 @@ module ref_pres use shr_kind_mod, only: r8=>shr_kind_r8 use ppgrid, only: pver, pverp +use scamMod, only: single_column implicit none public @@ -131,7 +132,13 @@ subroutine ref_pres_init(pref_edge_in, pref_mid_in, num_pr_lev_in) top=.true.) ! Find level corresponding to the molecular diffusion bottom. - do_molec_diff = (ptop_ref < do_molec_press) +!+++ARH/jtb + if (single_column) then + do_molec_diff = .false. + else + do_molec_diff = (ptop_ref < do_molec_press) + end if +!---ARH/jtb if (do_molec_diff) then nbot_molec = press_lim_idx(molec_diff_bot_press, & top=.false.) diff --git a/src/physics/cam/subcol_SILHS.F90 b/src/physics/cam/subcol_SILHS.F90 index 5c335c932d..87f2561cc6 100644 --- a/src/physics/cam/subcol_SILHS.F90 +++ b/src/physics/cam/subcol_SILHS.F90 @@ -9,23 +9,31 @@ module subcol_SILHS use shr_kind_mod, only: r8=>shr_kind_r8, r4=>shr_kind_r4, i4=>shr_kind_i4 use physics_types, only: physics_state, physics_tend, physics_ptend - use ppgrid, only: pcols, psubcols, pver, pverp + use ppgrid, only: pcols, psubcols, pver, pverp, begchunk, endchunk use constituents, only: pcnst, cnst_get_ind use cam_abortutils, only: endrun use cam_logfile, only: iulog use cam_history, only: addfld, add_default, outfld, horiz_only + use ref_pres, only: top_lev => trop_cloud_top_lev #ifdef CLUBB_SGS #ifdef SILHS - use clubb_intr, only: pdf_params_chnk + use clubb_intr, only: & + clubb_config_flags, & + clubb_params, & + stats_zt, stats_zm, stats_sfc, & + pdf_params_chnk + use clubb_api_module, only: & hmp2_ip_on_hmm2_ip_slope_type, & - hmp2_ip_on_hmm2_ip_intrcpt_type + hmp2_ip_on_hmm2_ip_intrcpt_type, & + precipitation_fractions, & + stats use silhs_api_module, only: & silhs_config_flags_type #endif #endif - use physconst, only: cpair, gravit, latvap, latice, rair + use physconst, only: cpair, gravit, latvap, latice, rair, rga, cappa implicit none private @@ -39,14 +47,17 @@ module subcol_SILHS public :: subcol_SILHS_var_covar_driver public :: subcol_SILHS_fill_holes_conserv public :: subcol_SILHS_hydromet_conc_tend_lim + public :: init_state_subcol private :: fill_holes_sedimentation private :: fill_holes_same_phase_vert #ifdef SILHS - private :: Abs_Temp_profile - private :: StaticEng_profile ! Calc subcol mean ! Calc subcol variance private :: meansc private :: stdsc + + type (stats), target :: stats_lh_zt, & + stats_lh_sfc + !$omp threadprivate(stats_lh_zt, stats_lh_sfc) #endif !----- @@ -128,11 +139,13 @@ end subroutine subcol_register_SILHS subroutine subcol_readnl_SILHS(nlfile) #ifdef CLUBB_SGS #ifdef SILHS - use namelist_utils, only: find_group_name - use units, only: getunit, freeunit - use spmd_utils, only: masterproc, masterprocid, mpicom - use spmd_utils, only: mpi_integer, mpi_logical, mpi_character, mpir8 - use clubb_api_module,only: core_rknd + use namelist_utils, only: find_group_name + use spmd_utils, only: masterproc, masterprocid, mpicom + use spmd_utils, only: mpi_integer, mpi_logical, mpi_character, mpir8, iam + use clubb_api_module, only: core_rknd + use silhs_api_module, only: set_default_silhs_config_flags_api, & + initialize_silhs_config_flags_type_api, & + print_silhs_config_flags_api #endif #endif character(len=*), intent(in) :: nlfile ! filepath for file containing namelist input @@ -141,6 +154,23 @@ subroutine subcol_readnl_SILHS(nlfile) integer :: unitn, ierr #ifdef CLUBB_SGS #ifdef SILHS + + integer :: & + cluster_allocation_strategy + + logical :: & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights + namelist /subcol_SILHS_nl/ subcol_SILHS_weight, & subcol_SILHS_numsubcol, & subcol_SILHS_corr_file_path, & @@ -158,6 +188,18 @@ subroutine subcol_readnl_SILHS(nlfile) ! subcol_SILHS_c8, subcol_SILHS_c11, subcol_SILHS_c11b, & ! subcol_SILHS_gamma_coef, subcol_SILHS_mult_coef, subcol_SILHS_mu + namelist /silhs_config_flags_nl/ subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights + !----------------------------------------------------------------------------- ! Set defaults @@ -166,8 +208,7 @@ subroutine subcol_readnl_SILHS(nlfile) subcol_SILHS_hmp2_ip_on_hmm2_ip_intrcpt%Ni = 0.5_core_rknd if (masterproc) then - unitn = getunit() - open( unitn, file=trim(nlfile), status='old' ) + open( newunit=unitn, file=trim(nlfile), status='old' ) call find_group_name(unitn, 'subcol_SILHS_nl', status=ierr) if (ierr == 0) then read(unitn, subcol_SILHS_nl, iostat=ierr) @@ -176,9 +217,53 @@ subroutine subcol_readnl_SILHS(nlfile) end if end if close(unitn) - call freeunit(unitn) end if + ! Set default silhs_config_flags entires + call set_default_silhs_config_flags_api( cluster_allocation_strategy, & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights ) + + ! Get silhs_config_flags entries from namelist + if (masterproc) then + open( newunit=unitn, file=trim(nlfile), status='old' ) + call find_group_name(unitn, 'silhs_config_flags_nl', status=ierr) + if (ierr == 0) then + read(unitn, silhs_config_flags_nl, iostat=ierr) + if (ierr /= 0) then + call endrun('silhs_config_flags_nl: ERROR reading namelist') + end if + end if + close(unitn) + end if + + ! Save silhs_config_flags entries into module variable silhs_config_flags + call initialize_silhs_config_flags_type_api( cluster_allocation_strategy, & + subcol_silhs_l_lh_importance_sampling, & + subcol_silhs_l_Lscale_vert_avg, & + subcol_silhs_l_lh_straight_mc, & + subcol_silhs_l_lh_clustered_sampling, & + subcol_silhs_l_rcm_in_cloud_k_lh_start, & + subcol_silhs_l_random_k_lh_start, & + subcol_silhs_l_max_overlap_in_cloud, & + subcol_silhs_l_lh_instant_var_covar_src, & + subcol_silhs_l_lh_limit_weights, & + subcol_silhs_l_lh_var_frac, & + subcol_silhs_l_lh_normalize_weights, & + silhs_config_flags ) + + ! Print the SILHS configurable flags + call print_silhs_config_flags_api( iulog, silhs_config_flags ) ! Intent(in) + #ifdef SPMD ! Broadcast namelist variables call mpi_bcast(subcol_SILHS_weight, 1, mpi_logical, masterprocid, mpicom, ierr) @@ -214,6 +299,17 @@ subroutine subcol_readnl_SILHS(nlfile) ! call mpi_bcast(subcol_SILHS_gamma_coef, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_mult_coef, 1, mpir8, masterprocid, mpicom, ierr) ! call mpi_bcast(subcol_SILHS_mu, 1, mpir8, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_importance_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_Lscale_vert_avg, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_straight_mc, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_clustered_sampling, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_rcm_in_cloud_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_random_k_lh_start, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_max_overlap_in_cloud, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_instant_var_covar_src, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_limit_weights, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_var_frac, 1, mpi_logical, masterprocid, mpicom, ierr) + call mpi_bcast(silhs_config_flags%l_lh_normalize_weights, 1, mpi_logical, masterprocid, mpicom, ierr) ! SPMD #endif @@ -234,7 +330,6 @@ subroutine subcol_init_SILHS(pbuf2d) use physics_buffer, only: physics_buffer_desc, pbuf_get_field, & dtype_r8, pbuf_get_index - use units, only: getunit, freeunit #ifdef CLUBB_SGS #ifdef SILHS use clubb_api_module, only: core_rknd, & @@ -244,15 +339,6 @@ subroutine subcol_init_SILHS(pbuf2d) Ncnp2_on_Ncnm2, & set_clubb_debug_level_api - use silhs_api_module, only: set_default_silhs_config_flags_api, & - initialize_silhs_config_flags_type_api, & - print_silhs_config_flags_api - - use spmd_utils, only: iam - - use clubb_intr, only: init_clubb_config_flags, & - clubb_config_flags - #endif #endif @@ -280,22 +366,7 @@ subroutine subcol_init_SILHS(pbuf2d) iiNi, & ! Hydrometeor array index for ice concentration, Ni iiNg ! Hydrometeor array index for graupel concentration, Ng - integer :: & - cluster_allocation_strategy - - logical :: & - l_lh_importance_sampling, & - l_Lscale_vert_avg, & - l_lh_straight_mc, & - l_lh_clustered_sampling, & - l_rcm_in_cloud_k_lh_start, & - l_random_k_lh_start, & - l_max_overlap_in_cloud, & - l_lh_instant_var_covar_src, & - l_lh_limit_weights, & - l_lh_var_frac, & - l_lh_normalize_weights - + integer :: l ! Loop variable ! Set CLUBB's debug level ! This is called in module clubb_intr; no need to do it here. @@ -304,45 +375,13 @@ subroutine subcol_init_SILHS(pbuf2d) !------------------------------- ! CLUBB-SILHS Parameters (global module variables) !------------------------------- - call set_default_silhs_config_flags_api( cluster_allocation_strategy, & - l_lh_importance_sampling, & - l_Lscale_vert_avg, & - l_lh_straight_mc, & - l_lh_clustered_sampling, & - l_rcm_in_cloud_k_lh_start, & - l_random_k_lh_start, & - l_max_overlap_in_cloud, & - l_lh_instant_var_covar_src, & - l_lh_limit_weights, & - l_lh_var_frac, & - l_lh_normalize_weights ) - - call init_clubb_config_flags( clubb_config_flags ) ! In/Out clubb_config_flags%l_fix_w_chi_eta_correlations = .true. - l_lh_importance_sampling = .true. clubb_config_flags%l_diagnose_correlations = .false. clubb_config_flags%l_calc_w_corr = .false. ! l_prescribed_avg_deltaz = .false. clubb_config_flags%l_use_cloud_cover = .false. clubb_config_flags%l_const_Nc_in_cloud = .true. - call initialize_silhs_config_flags_type_api( cluster_allocation_strategy, & - l_lh_importance_sampling, & - l_Lscale_vert_avg, & - l_lh_straight_mc, & - l_lh_clustered_sampling, & - l_rcm_in_cloud_k_lh_start, & - l_random_k_lh_start, & - l_max_overlap_in_cloud, & - l_lh_instant_var_covar_src, & - l_lh_limit_weights, & - l_lh_var_frac, & - l_lh_normalize_weights, & - silhs_config_flags ) - - ! Print the SILHS configurable flags - call print_silhs_config_flags_api( iulog, silhs_config_flags ) ! Intent(in) - ! Values from the namelist docldfracscaling = subcol_SILHS_use_clear_col @@ -359,7 +398,6 @@ subroutine subcol_init_SILHS(pbuf2d) ! mu = subcol_SILHS_mu !call set_clubb_debug_level( 0 ) !#KTCtodo: Add a namelist variable to set debug level - ! Get constituent indices call cnst_get_ind('Q', ixq) @@ -435,17 +473,12 @@ subroutine subcol_init_SILHS(pbuf2d) corr_file_path_cloud = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//cloud_file_ext corr_file_path_below = trim( subcol_SILHS_corr_file_path )//trim( subcol_SILHS_corr_file_name )//below_file_ext - iunit = getunit() - - call setup_corr_varnce_array_api( corr_file_path_cloud, corr_file_path_below, & - iunit, & + getnewunit(iunit), & clubb_config_flags%l_fix_w_chi_eta_correlations ) - call freeunit(iunit) !------------------------------- ! Register output fields from SILHS - ! #KTCtodo: Remove these from the default output list !------------------------------- call addfld('SILHS_NCLD_SCOL', (/'psubcols', 'ilev '/), 'I', 'm^-3', & 'Subcolumn Cloud Number Concentration', flag_xyfill=.true., fill_value=1.e30_r8) @@ -526,7 +559,28 @@ subroutine subcol_init_SILHS(pbuf2d) #endif #endif end subroutine subcol_init_SILHS - +!==============================================================! + subroutine init_state_subcol(state, tend, state_sc, tend_sc) + + use ppgrid, only : pver, pverp, pcols + + use subcol_utils, only : subcol_set_subcols + + implicit none + + type(physics_state), intent(inout) :: state + type(physics_tend), intent(inout) :: tend + type(physics_state), intent(inout) :: state_sc ! sub-column state + type(physics_tend), intent(inout) :: tend_sc ! sub-column tend + + integer, dimension(pcols) :: numsubcol_arr ! To set up the state struct + + numsubcol_arr(:) = 0 ! Start over each chunk + numsubcol_arr(:state%ngrdcol) = subcol_SILHS_numsubcol ! Only set for valid grid columns + call subcol_set_subcols(state, tend, numsubcol_arr, state_sc, tend_sc) + + end subroutine init_state_subcol +!==================================================================! subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !------------------------------- ! This is where the subcolumns are created, and the call to @@ -537,10 +591,9 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) use physics_buffer, only : physics_buffer_desc, pbuf_get_index, & pbuf_get_field - use ppgrid, only : pver, pverp, pcols - use ref_pres, only : top_lev => trop_cloud_top_lev use time_manager, only : get_nstep use subcol_utils, only : subcol_set_subcols, subcol_set_weight + use subcol_pack_mod, only : subcol_pack use phys_control, only : phys_getopts use spmd_utils, only : masterproc use shr_const_mod, only : SHR_CONST_PI, SHR_CONST_RHOFW @@ -555,7 +608,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) hydromet_pdf_parameter, & - zm2zt_api, setup_grid_heights_api, gr, & + zm2zt_api, setup_grid_heights_api, & iirr, iiNr, iirs, iiri, & iirg, iiNs, & @@ -577,13 +630,16 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) genrand_intg, genrand_init_api, & nparams, ic_K, & - read_parameters_api + read_parameters_api, & + Cp, Lv, & + grid, setup_grid_api, & + init_precip_fracs_api use silhs_api_module, only : generate_silhs_sample_api, & ! Ncn_to_Nc, & clip_transform_silhs_output_api, & - est_kessler_microphys_api + est_kessler_microphys_api, & + vert_decorr_coef - use clubb_intr, only: clubb_config_flags #endif #endif @@ -610,14 +666,14 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) integer :: i, j, k, ngrdcol, ncol, lchnk, stncol integer :: begin_height, end_height ! Output from setup_grid call - real(r8) :: sfc_elevation ! Surface elevation - real(r8), dimension(pverp-top_lev+1) :: zt_g, zi_g ! Thermo & Momentum grids for clubb + real(r8) :: sfc_elevation(state%ngrdcol) ! Surface elevation + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: zt_g, zi_g ! Thermo & Momentum grids for clubb + real(r8), dimension(pverp) :: scfrac ! cloud fraction based on sc distributions real(r8) :: msc, std, maxcldfrac, maxsccldfrac real(r8) :: scale = 1.0_r8 - real(r8), dimension(nparams) :: clubb_params ! Adjustable CLUBB parameters - real(r8) :: c_K ! CLUBB parameter c_K (for eddy diffusivity) integer( kind = genrand_intg ) :: & @@ -627,19 +683,21 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- ! Required for set_up_pdf_params_incl_hydromet !---------------- - real(r8), dimension(pverp-top_lev+1) :: cld_frac_in ! Cloud fraction - type(hydromet_pdf_parameter), dimension(pverp-top_lev+1) :: & - hydromet_pdf_params ! Hydrometeor PDF parameters - real(r8), dimension(:,:,:), allocatable :: & ! Correlation matrix for pdf components - corr_array_1, corr_array_2 - real(r8), dimension(:,:), allocatable :: & - mu_x_1, mu_x_2, & ! Mean array for PDF components - sigma_x_1, sigma_x_2 ! Std dev arr for PDF components - real(r8), dimension(:,:,:), allocatable :: & ! Transposed corr cholesky mtx - corr_cholesky_mtx_1, corr_cholesky_mtx_2 - real(r8), dimension(pverp-top_lev+1) :: Nc_in_cloud - real(r8), dimension(pverp-top_lev+1) :: ice_supersat_frac_in - real(r8), dimension(pverp-top_lev+1,hydromet_dim) :: hydrometp2 + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: cld_frac_in ! Cloud fraction + + real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim, pdf_dim) :: & + corr_array_1, corr_array_2 ! Correlation matrix for pdf components + + real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim) :: & + mu_x_1, mu_x_2, & ! Mean array for PDF components + sigma_x_1, sigma_x_2 ! Std dev arr for PDF components + + real(r8), dimension(state%ngrdcol, pverp-top_lev+1, pdf_dim, pdf_dim) :: & + corr_cholesky_mtx_1, corr_cholesky_mtx_2 ! Transposed corr cholesky mtx + + real(r8), dimension(state%ngrdcol, pverp-top_lev+1) :: Nc_in_cloud + real(r8), dimension(state%ngrdcol, pverp-top_lev+1) :: ice_supersat_frac_in + real(r8), dimension(state%ngrdcol, pverp-top_lev+1, hydromet_dim) :: hydrometp2 !---------------- @@ -647,21 +705,21 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- integer :: iter ! CLUBB iteration integer :: num_subcols ! Number of subcolumns - integer, dimension(pcols) :: numsubcol_arr ! To set up the state struct integer, parameter :: sequence_length = 1 ! Number of timesteps btn subcol calls - real(r8), dimension(pverp-top_lev+1) :: rho_ds_zt ! Dry static density (kg/m^3) on thermo levs - real(r8), dimension(pver) :: dz_g ! thickness of layer - real(r8), dimension(pverp-top_lev+1) :: delta_zm ! Difference in u wind altitudes - real(r8), dimension(pverp-top_lev+1) :: invs_dzm ! 1/delta_zm - real(r8), dimension(pverp-top_lev+1) :: rcm_in ! Cld water mixing ratio on CLUBB levs - real(r8), dimension(pverp-top_lev+1,hydromet_dim) :: hydromet ! Hydrometeor species - real(r8), dimension(pverp-top_lev+1,hydromet_dim) :: wphydrometp ! Hydrometeor flux - real(r8), dimension(pverp-top_lev+1) :: Ncm ! Mean cloud droplet concentration, - - real(r8), dimension(pverp-top_lev+1) :: tke ! TKE - real(r8), dimension(pverp-top_lev+1) :: khzm ! Eddy diffusivity coef - real(r8), dimension(pverp-top_lev+1) :: Lscale_zm ! CLUBB's length scale on momentum (zm) levels - real(r8), dimension(pverp-top_lev+1) :: Lscale ! CLUBB's length scale + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: rho_ds_zt ! Dry static density (kg/m^3) on thermo levs + real(r8), dimension(state%ngrdcol,pver) :: dz_g ! thickness of layer + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: delta_zm ! Difference in u wind altitudes + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: rcm_in ! Cld water mixing ratio on CLUBB levs + real(r8), dimension(state%ngrdcol,pverp-top_lev+1,hydromet_dim) :: hydromet ! Hydrometeor species + real(r8), dimension(state%ngrdcol,pverp-top_lev+1,hydromet_dim) :: wphydrometp ! Hydrometeor flux + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Ncm ! Mean cloud droplet concentration, + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: tke ! TKE + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: khzm ! Eddy diffusivity coef + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Lscale_zm ! CLUBB's length scale on momentum (zm) levels + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: Lscale ! CLUBB's length scale logical, parameter :: & l_calc_weights_all_levs = .false. ! .false. if all time steps use the same @@ -670,29 +728,29 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) l_calc_weights_all_levs_itime, & ! .true. if we calculate sample weights separately at all ! grid levels at the current time step l_rad_itime ! .true. if we calculate radiation at the current time step - + !--------------- !Output from generate_silhs_sample !-------------- - real(r8), allocatable, dimension(:,:,:) :: X_nl_all_levs ! Sample transformed to normal-lognormal - real(r8), allocatable, dimension(:,:) :: lh_sample_point_weights ! Subcolumn weights - integer, allocatable, dimension(:,:) :: X_mixt_comp_all_levs ! Which Mixture Component - - real(r8), allocatable, dimension(:,:) :: rc_all_points ! Calculate RCM from LH output - real(r8), allocatable, dimension(:,:) :: rain_all_pts ! Calculate Rain from LH output - real(r8), allocatable, dimension(:,:) :: nrain_all_pts ! Calculate Rain Conc from LH - real(r8), allocatable, dimension(:,:) :: snow_all_pts ! Calculate Snow from LH output - real(r8), allocatable, dimension(:,:) :: nsnow_all_pts ! Calculate Snow Conc from LH - real(r8), allocatable, dimension(:,:) :: w_all_points ! Calculate W from LH output - ! real(r8), allocatable, dimension(:,:) :: RVM_lh_out ! Vapor mixing ratio sent away - real(r8), allocatable, dimension(:,:) :: ice_all_pts ! Calculate Cld Ice from LH output - real(r8), allocatable, dimension(:,:) :: nice_all_pts ! Calculate Num cld ice from LH - real(r8), allocatable, dimension(:,:) :: nclw_all_pts ! Calculate Num cld wat from LH + real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1,pdf_dim) :: X_nl_all_levs ! Sample transformed to normal-lognormal + real(r8), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: lh_sample_point_weights ! Subcolumn weights + integer, dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: X_mixt_comp_all_levs ! Which Mixture Component + + real(r8), dimension(state%ngrdcol,pverp-top_lev+1, subcol_SILHS_numsubcol) :: & + rc_all_points, & ! Calculate RCM from LH output + rain_all_pts, & ! Calculate Rain from LH output + nrain_all_pts, & ! Calculate Rain Conc from LH + snow_all_pts, & ! Calculate Snow from LH output + nsnow_all_pts, & ! Calculate Snow Conc from LH + w_all_points, & ! Calculate W from LH output + ice_all_pts, & ! Calculate Cld Ice from LH output + nice_all_pts, & ! Calculate Num cld ice from LH + nclw_all_pts ! Calculate Num cld wat from LH !---------------- ! Output from clip_transform_silhs_output_api !---------------- - real( kind = core_rknd ), dimension(:,:), allocatable :: & + real( kind = core_rknd ), dimension(state%ngrdcol,subcol_SILHS_numsubcol,pverp-top_lev+1) :: & lh_rt_clipped, & ! rt generated from silhs sample points lh_thl_clipped, & ! thl generated from silhs sample points lh_rc_clipped, & ! rc generated from silhs sample points @@ -748,13 +806,13 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) !---------------- ! Output from Est_Kessler_microphys !---------------- - real(r8), dimension(pverp-top_lev+1) :: lh_Akm ! Monte Carlo estimate of Kessler Autoconversion - real(r8), dimension(pverp-top_lev+1) :: AKm ! Exact Kessler autoconversion - real(r8), dimension(pverp-top_lev+1) :: AKstd ! Exact Stdev of gba Kessler - real(r8), dimension(pverp-top_lev+1) :: AKstd_cld ! Exact w/in cloud stdev of gba Kessler - real(r8), dimension(pverp-top_lev+1) :: AKm_rcm ! Exact local gba Kessler auto based on rcm - real(r8), dimension(pverp-top_lev+1) :: AKm_rcc ! Exact local gba Kessler based on w/in cloud rc - real(r8), dimension(pverp-top_lev+1) :: lh_rcm_avg ! LH estimate of grid box avg liquid water + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: lh_Akm ! Monte Carlo estimate of Kessler Autoconversion + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm ! Exact Kessler autoconversion + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKstd ! Exact Stdev of gba Kessler + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKstd_cld ! Exact w/in cloud stdev of gba Kessler + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm_rcm ! Exact local gba Kessler auto based on rcm + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: AKm_rcc ! Exact local gba Kessler based on w/in cloud rc + real(r8), dimension(state%ngrdcol,pverp-top_lev+1) :: lh_rcm_avg ! LH estimate of grid box avg liquid water real(r8), dimension(pcols,pverp) :: lh_AKm_out, AKm_out !---------------- @@ -766,7 +824,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) real(r8), dimension(pcols, pver) :: invs_exner ! inverse exner sent to conversion codw ! pcols for output to history real(r8) :: eff_rad_coef = 1.0_r8/(4.0_r8/3.0_r8*SHR_CONST_RHOFW*SHR_CONST_PI) - real(r8), dimension(pver) :: eff_rad_prof ! r^3 as calculated from grid mean MR & NC !---------------- ! Pointers @@ -785,10 +842,43 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) real(r8), pointer, dimension(:,:) :: tke_in ! TKE real(r8), pointer, dimension(:,:) :: khzm_in ! Eddy diffusivity coef + + logical, parameter :: l_est_kessler_microphys = .false. + logical, parameter :: l_outfld_subcol = .false. + + type(grid) :: gr(state%ngrdcol) + + type(precipitation_fractions) :: precip_fracs + + !------------------------------------------------ + ! Begin Code + !------------------------------------------------ + +#ifdef SILHS_OPENACC + if ( l_est_kessler_microphys ) then + call endrun('subcol_gen error: compilation with OpenACC requires l_est_kessler_microphys = .false.') + end if + + if ( subcol_SILHS_constrainmn ) then + call endrun('subcol_gen error: compilation with OpenACC requires subcol_SILHS_constrainmn = .false.') + end if + + if ( subcol_SILHS_weight ) then + call endrun('subcol_gen error: Importance sampling is not enabled for SILHS when using OpenACC. Set subcol_SILHS_weight to false.') + end if +#endif if (.not. allocated(state_sc%lat)) then call endrun('subcol_gen error: state_sc must be allocated before calling subcol_gen') end if + + if( rx_Nc ) then + call endrun('subcol_gen_SILHS: rx_Nc not enabled') + endif + + if (subcol_SILHS_meanice) then + call endrun('subcol_gen_SILHS: subcol_SILHS_meanice = T not currently available') + end if ! Determine num of columns and which chunk we're working on and what timestep ngrdcol = state%ngrdcol @@ -817,9 +907,6 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) call pbuf_get_field(pbuf, tke_idx, tke_in) call pbuf_get_field(pbuf, kvh_idx, khzm_in) - ! Read the clubb parameters in order to extract c_K. - call read_parameters_api( -99, "", clubb_params ) - ! Pull c_K from clubb parameters. c_K = clubb_params(ic_K) @@ -827,9 +914,7 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! Copy state and populate numbers and values of sub-columns !---------------- ztodt = ztodt_ptr(1) - numsubcol_arr(:) = 0 ! Start over each chunk - numsubcol_arr(:ngrdcol) = subcol_SILHS_numsubcol ! Only set for valid grid columns - call subcol_set_subcols(state, tend, numsubcol_arr, state_sc, tend_sc) + num_subcols = subcol_SILHS_numsubcol ! The number of vertical grid levels used in CLUBB is pverp, which is originally ! set in the call to setup_clubb_core_api from subroutine clubb_ini_cam. This @@ -838,572 +923,756 @@ subroutine subcol_gen_SILHS(state, tend, state_sc, tend_sc, pbuf) ! levels and also uses the gr%nz object. The value of gr%nz needs to be reset ! for SILHS here and then set again for CLUBB in subroutine clubb_tend_cam. gr%nz = pverp - top_lev + 1 + + ! Calculate sample weights separately at all grid levels when + ! radiation is not called + l_calc_weights_all_levs_itime = .false. ! subcol_utils cannot compute weighted avgs + ! when the weights vary with height. + ! Don't set to true until this is fixed!! - !---------------- - ! Loop over all the active grid columns in the chunk - !---------------- - do i = 1, ngrdcol + + ! Setup the CLUBB vertical grid object. This must be done for each + ! column as the z-distance between hybrid pressure levels can + ! change easily. + ! Define the CLUBB momentum grid (in height, units of m) + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + zi_g(i,k) = state%zi(i,pverp-k+1)-state%zi(i,pverp) + end do + end do + - ! JHDBG: Big suspicion about that code - ! V. Larson: I don't know what happens to arrays allocated with size - ! num_subcols if num_subcols varies with the grid column. - num_subcols = numsubcol_arr(i) - stncol = 0 ! Each grid column needs to know how many subcolumns have gone by - do k = 1, i-1 - ! stncol = stncol + numsubcol_arr(i-1) - ! Eric Raut replaced i-1 with k in line immediately above. - stncol = stncol + numsubcol_arr(k) - enddo - - ! Setup the CLUBB vertical grid object. This must be done for each - ! column as the z-distance between hybrid pressure levels can - ! change easily. - sfc_elevation = state%zi(i,pverp) - ! Define the CLUBB momentum grid (in height, units of m) - do k = 1, pverp-top_lev+1 - zi_g(k) = state%zi(i,pverp-k+1)-sfc_elevation - enddo - ! Define the CLUBB thermodynamic grid (in units of m) - do k = 1, pver-top_lev+1 - zt_g(k+1) = state%zm(i,pver-k+1)-state%zi(i,pverp) - enddo - ! Thermodynamic ghost point is below surface - zt_g(1) = -1._r8*zt_g(2) - ! Calculate the distance between grid levels on the host model grid, - ! using host model grid indices. - do k = top_lev, pver - dz_g(k) = state%zi(i,k)-state%zi(i,k+1) - enddo - ! allocate grid object - call setup_grid_heights_api( l_implemented, grid_type, & - zi_g(2), zi_g(1), zi_g(1:pverp-top_lev+1), & - zt_g(1:pverp-top_lev+1) ) - - ! Inverse delta_zm is required for the 3-level L-scale averaging - do k = 1, pver-top_lev+1 - delta_zm(k+1) = state%zi(i,pverp-k)-state%zi(i,pverp-k+1) - invs_dzm(k+1) = 1.0_r8/delta_zm(k+1) - enddo - ! Handle CLUBB sub-sfc ghost point as done in clubb grid_class.F90 - delta_zm(1) = delta_zm(2) - invs_dzm(1) = invs_dzm(2) - - ! Compute dry static density on CLUBB vertical grid - do k = 1, pver-top_lev+1 - rho_ds_zt(k+1) = (1._r8/gravit)*state%pdel(i,pver-k+1)/dz_g(pver-k+1) - enddo - ! CLUBB ghost point under the surface - rho_ds_zt(1) = rho_ds_zt(2) - - ! Set up hydromet array, flipped from CAM vert grid to CLUBB - do k = 1, pver-top_lev+1 - if ( iirr > 0 ) then - ! If ixrain and family are greater than zero, then MG2 is - ! being used, and rain and snow are part of state. Otherwise, - ! diagnostic rain and snow from MG1 are used in hydromet. - if (ixrain > 0) then - hydromet(k+1,iirr) = state%q(i,pver-k+1,ixrain) - else - hydromet(k+1,iirr) = qrain(i,pver-k+1) - endif - endif - if ( iiNr > 0 ) then - if (ixnumrain > 0) then - hydromet(k+1,iiNr) = state%q(i,pver-k+1,ixnumrain) - else - hydromet(k+1,iiNr) = nrain(i,pver-k+1) - endif - endif - if ( iirs > 0 ) then - if (ixsnow > 0) then - hydromet(k+1,iirs) = state%q(i,pver-k+1,ixsnow) - else - hydromet(k+1,iirs) = qsnow(i,pver-k+1) - endif - endif - if ( iiNs > 0 ) then - if (ixnumsnow > 0) then - hydromet(k+1,iiNs) = state%q(i,pver-k+1,ixnumsnow) - else - hydromet(k+1,iiNs) = nsnow(i,pver-k+1) - endif - endif - if ( iiri > 0 ) then - hydromet(k+1,iiri) = state%q(i,pver-k+1,ixcldice) - endif - if ( iiNi > 0 ) then - hydromet(k+1,iiNi) = state%q(i,pver-k+1,ixnumice) - endif - - Ncm(k+1) = state%q(i,pver-k+1,ixnumliq) - - enddo - - do k = 1, hydromet_dim ! ghost point below the surface - hydromet(1,k) = hydromet(2,k) - enddo - - Ncm(1) = Ncm(2) - - do k = top_lev, pver - ! Calculate effective radius cubed, CAM-grid oriented for use in subcolumns - eff_rad_prof(k) = eff_rad_coef*state%q(i,k,ixcldliq)/state%q(i,k,ixnumliq) - ! Test a fixed effective radius - ! eff_rad_prof(k) = 5.12e-16_r8 ! 8 microns - enddo - - ! Allocate arrays for set_up_pdf_params_incl_hydromet - allocate( corr_array_1(pdf_dim, pdf_dim, pverp-top_lev+1) ) - allocate( corr_array_2(pdf_dim, pdf_dim, pverp-top_lev+1) ) - allocate( mu_x_1(pdf_dim, pverp-top_lev+1) ) - allocate( mu_x_2(pdf_dim, pverp-top_lev+1) ) - allocate( sigma_x_1(pdf_dim, pverp-top_lev+1) ) - allocate( sigma_x_2(pdf_dim, pverp-top_lev+1) ) - allocate( corr_cholesky_mtx_1(pdf_dim, pdf_dim, pverp-top_lev+1) ) - allocate( corr_cholesky_mtx_2(pdf_dim, pdf_dim, pverp-top_lev+1) ) - ! Allocate arrays for SILHS output - allocate( lh_sample_point_weights(pverp-top_lev+1,num_subcols) ) - allocate( X_mixt_comp_all_levs(pverp-top_lev+1,num_subcols) ) - allocate( X_nl_all_levs(pverp-top_lev+1,num_subcols,pdf_dim) ) - allocate( lh_rt_clipped(pverp-top_lev+1,num_subcols) ) - allocate( lh_thl_clipped(pverp-top_lev+1,num_subcols) ) - allocate( lh_rc_clipped(pverp-top_lev+1,num_subcols) ) - allocate( lh_rv_clipped(pverp-top_lev+1,num_subcols) ) - allocate( lh_Nc_clipped(pverp-top_lev+1,num_subcols) ) - ! Allocate arrays for output to either history files or for updating state_sc - allocate( rc_all_points(pverp-top_lev+1, num_subcols) ) - allocate( rain_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( nrain_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( snow_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( nsnow_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( w_all_points(pverp-top_lev+1, num_subcols) ) - ! allocate( RVM_lh_out(num_subcols, pverp) ) ! This one used only to update state - allocate( ice_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( nice_all_pts(pverp-top_lev+1, num_subcols) ) - allocate( nclw_all_pts(pverp-top_lev+1, num_subcols) ) + ! Define the CLUBB thermodynamic grid (in units of m) + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + zt_g(i,k+1) = state%zm(i,pver-k+1)-state%zi(i,pverp) + + ! Thermodynamic ghost point is below surface + zt_g(i,1) = -1._r8*zt_g(i,2) + end do + end do + + do i=1, ncol + ! Set the elevation of the surface + sfc_elevation(i) = state%zi(i,pver+1) + end do + + ! Heights need to be set at each timestep. + do i=1, ncol + call setup_grid_api( pverp - top_lev, sfc_elevation(i), l_implemented, & ! intent(in) + grid_type, zi_g(i,2), zi_g(i,1), zi_g(i,pverp - top_lev+1), & ! intent(in) + zi_g(i,:), zt_g(i,:), & ! intent(in) + gr(i), begin_height, end_height ) ! intent(out) + end do - ! Convert from CAM vertical grid to CLUBB - do k = 1, pverp-top_lev+1 - rcm_in(k) = rcm(i,pverp-k+1) - ice_supersat_frac_in(k) = ice_supersat_frac(i,pverp-k+1) - enddo - do k = 1, pver-top_lev+1 - cld_frac_in(k+1) = alst(i,pver-k+1) - enddo - cld_frac_in(1) = cld_frac_in(2) ! Ghost pt below surface - ! Calculate a clubb-specific exner function - ! (This is grid mean, as pressure levels do not change in - ! the subcolumn state) - invs_exner(i,:) = ((state%pmid(i,:)/p0_clubb)**(rair/cpair)) - - ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS - ! Compute Num concentration of cloud nuclei - Nc_in_cloud = Ncm / max( cld_frac_in, cloud_frac_min ) - - ! The variable wphydrometp is only used when l_calc_w_corr is enabled. - ! The l_calc_w_corr flag is turned off by default, so wphydrometp will - ! simply be set to 0 to simplify matters. - wphydrometp = 0.0_r8 + ! Calculate the distance between grid levels on the host model grid, + ! using host model grid indices. + do k = top_lev, pver + do i = 1, ngrdcol + dz_g(i,k) = state%zi(i,k)-state%zi(i,k+1) + end do + end do + + ! Inverse delta_zm is required for the 3-level L-scale averaging + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + delta_zm(i,k+1) = state%zi(i,pverp-k)-state%zi(i,pverp-k+1) + + ! Handle CLUBB sub-sfc ghost point as done in clubb grid_class.F90 + delta_zm(i,1) = delta_zm(i,2) + end do + end do + + ! Compute dry static density on CLUBB vertical grid + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + rho_ds_zt(i,k+1) = (rga)*state%pdel(i,pverp-k)/dz_g(i,pverp-k) + + ! CLUBB ghost point under the surface + rho_ds_zt(i,1) = rho_ds_zt(i,2) + end do + end do + + ! Set up hydromet array, flipped from CAM vert grid to CLUBB + if ( iirr > 0 ) then + ! If ixrain and family are greater than zero, then MG2 is + ! being used, and rain and snow are part of state. Otherwise, + ! diagnostic rain and snow from MG1 are used in hydromet. + if (ixrain > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iirr) = state%q(i,pver-k+1,ixrain) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iirr) = qrain(i,pver-k+1) + end do + end do + endif + endif + + if ( iiNr > 0 ) then + if (ixnumrain > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNr) = state%q(i,pver-k+1,ixnumrain) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNr) = nrain(i,pver-k+1) + end do + end do + endif + endif + + if ( iirs > 0 ) then + if (ixsnow > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iirs) = state%q(i,pver-k+1,ixsnow) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iirs) = qsnow(i,pver-k+1) + end do + end do + endif + endif + + if ( iiNs > 0 ) then + if (ixnumsnow > 0) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNs) = state%q(i,pver-k+1,ixnumsnow) + end do + end do + else + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNs) = nsnow(i,pver-k+1) + end do + end do + endif + endif + + if ( iiri > 0 ) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiri) = state%q(i,pver-k+1,ixcldice) + end do + end do + endif + + if ( iiNi > 0 ) then + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + hydromet(i,k+1,iiNi) = state%q(i,pver-k+1,ixnumice) + end do + end do + endif + + do k = 1, hydromet_dim ! ghost point below the surface + do i = 1, ngrdcol + hydromet(i,1,k) = hydromet(i,2,k) + end do + end do + + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + Ncm(i,k+1) = state%q(i,pver-k+1,ixnumliq) + Ncm(i,1) = Ncm(i,2) + end do + end do + + ! Convert from CAM vertical grid to CLUBB + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + rcm_in(i,k) = rcm(i,pverp-k+1) + ice_supersat_frac_in(i,k) = ice_supersat_frac(i,pverp-k+1) + end do + end do + + + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + cld_frac_in(i,k+1) = alst(i,pver-k+1) + cld_frac_in(i,1) = cld_frac_in(i,2) ! Ghost pt below surface + end do + end do + + ! Calculate a clubb-specific exner function + ! (This is grid mean, as pressure levels do not change in + ! the subcolumn state) + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + invs_exner(i,k) = ((state%pmid(i,k)/p0_clubb)**(cappa)) + end do + end do - ! make the call - call setup_pdf_parameters_api( pverp-top_lev+1, pdf_dim, ztodt, & ! In - Nc_in_cloud, rcm_in, cld_frac_in, & ! In - ice_supersat_frac_in, hydromet, wphydrometp, & ! In - corr_array_n_cloud, corr_array_n_below, & ! In - pdf_params_chnk(i,lchnk), l_stats_samp, & ! In - clubb_config_flags%l_use_precip_frac, & ! In - clubb_config_flags%l_predict_upwp_vpwp, & ! In - clubb_config_flags%l_diagnose_correlations, & ! In - clubb_config_flags%l_calc_w_corr, & ! In - clubb_config_flags%l_const_Nc_in_cloud, & ! In - clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In - hydrometp2, & ! Out - mu_x_1, mu_x_2, & ! Out - sigma_x_1, sigma_x_2, & ! Out - corr_array_1, corr_array_2, & ! Out - corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! Out - hydromet_pdf_params ) ! Out - - ! Calculate radiation only once in a while - ! l_rad_itime = (mod( itime, floor(dt_rad/dt_main) ) == 0 .or. itime == 1) - - ! Calculate sample weights separately at all grid levels when - ! radiation is not called - ! l_calc_weights_all_levs_itime = l_calc_weights_all_levs .and. .not. - ! l_rad_itime - l_calc_weights_all_levs_itime = .false. ! subcol_utils cannot compute weighted avgs - ! when the weights vary with height. - ! Don't set to true until this is fixed!! - - ! In order for Lscale to be used properly, it needs to be passed out of - ! advance_clubb_core, saved to the pbuf, and then pulled out of the - ! pbuf for use here. The profile of Lscale is passed into subroutine - ! generate_silhs_sample_api for use in calculating the vertical - ! correlation coefficient. Rather than output Lscale directly, its - ! value can be calculated from other fields that are already output to - ! pbuf. The equation relating Lscale to eddy diffusivity is: - ! - ! Kh = c_K * Lscale * sqrt( TKE ). - ! - ! Both Kh and TKE are written to the pbuf, and c_K is easily extracted - ! from CLUBB's tunable parameters. The equation for Lscale is: - ! - ! Lscale = Kh / ( c_K * sqrt( TKE ) ). - ! - ! Since Kh and TKE are output on momentum (interface) grid levels, the - ! resulting calculation of Lscale is also found on momentum levels. It - ! needs to be interpolated back to thermodynamic (midpoint) grid levels - ! for further use. - do k = 1, pverp-top_lev+1 - khzm(k) = khzm_in(i,pverp-k+1) - tke(k) = tke_in(i,pverp-k+1) - enddo - Lscale_zm = khzm / ( c_K * sqrt( max( tke, em_min ) ) ) - - ! Interpolate Lscale_zm back to thermodynamic grid levels. - Lscale = max( zm2zt_api( Lscale_zm ), 0.01_r8 ) - - ! Set the seed to the random number generator based on a quantity that - ! will be reproducible for restarts. - lh_seed = int( 1.0e4_r8 * rtm(i,pver), kind = genrand_intg ) - call genrand_init_api( put=lh_seed ) - - ! Let's generate some subcolumns!!!!! - call generate_silhs_sample_api & - ( iter, pdf_dim, num_subcols, sequence_length, pverp-top_lev+1, & ! In - l_calc_weights_all_levs_itime, & ! In - pdf_params_chnk(i,lchnk), delta_zm, rcm_in, Lscale, & ! In - rho_ds_zt, mu_x_1, mu_x_2, sigma_x_1, sigma_x_2, & ! In - corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! In - hydromet_pdf_params, silhs_config_flags, & ! In - clubb_config_flags%l_uv_nudge, & ! In - clubb_config_flags%l_tke_aniso, & ! In - clubb_config_flags%l_standard_term_ta, & ! In - clubb_config_flags%l_single_C2_Skw, & ! In - X_nl_all_levs, X_mixt_comp_all_levs, & ! Out - lh_sample_point_weights) ! Out - - ! Extract clipped variables from subcolumns - call clip_transform_silhs_output_api( pverp-top_lev+1, num_subcols, & ! In - pdf_dim, hydromet_dim, & ! In - X_mixt_comp_all_levs, & ! In - X_nl_all_levs, & ! In - pdf_params_chnk(i,lchnk), & ! In - l_use_Ncn_to_Nc, & ! In - lh_rt_clipped, lh_thl_clipped, & ! Out - lh_rc_clipped, lh_rv_clipped, & ! Out - lh_Nc_clipped ) ! Out - - ! Test subcolumns by comparing to an estimate of kessler autoconversion - call est_kessler_microphys_api & - ( pverp-top_lev+1, num_subcols, pdf_dim, X_nl_all_levs, & - pdf_params_chnk(i,lchnk), & - rcm_in, cld_frac_in, X_mixt_comp_all_levs, lh_sample_point_weights, & - silhs_config_flags%l_lh_importance_sampling, & - lh_AKm, AKm, AKstd, AKstd_cld, AKm_rcm, AKm_rcc, lh_rcm_avg) - - ! Calc column liquid water for output (rcm) - rc_all_points = lh_rc_clipped(:,:) - - if ( iiPDF_rr > 0 ) then - ! Calc subcolumn precipitating liq water for output (rrm) - rain_all_pts = real( X_nl_all_levs(:,:,iiPDF_rr), kind=r8 ) - end if - - if ( iiPDF_Nr > 0 ) then - ! Calc subcolumn number rain conc for output (nrainm) - nrain_all_pts = real( X_nl_all_levs(:,:,iiPDF_Nr), kind=r8 ) - end if + ! Call setup_pdf_parameters to get the CLUBB PDF ready for SILHS + ! Compute Num concentration of cloud nuclei + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + Nc_in_cloud(i,k) = Ncm(i,k) / max( cld_frac_in(i,k), cloud_frac_min ) + end do + end do - if ( iiPDF_rs > 0 ) then - ! Calc subcolumn precipitating snow for output (rsm) - snow_all_pts = real( X_nl_all_levs(:,:,iiPDF_rs), kind=r8 ) - end if + ! The variable wphydrometp is only used when l_calc_w_corr is enabled. + ! The l_calc_w_corr flag is turned off by default, so wphydrometp will + ! simply be set to 0 to simplify matters. + wphydrometp = 0.0_r8 - if ( iiPDF_Ns > 0 ) then - ! Calc subcolumn precipitating snow conc for output (Nsm) - nsnow_all_pts = real( X_nl_all_levs(:,:,iiPDF_Ns), kind=r8 ) - end if - - if ( iiPDF_ri > 0 ) then - ! Calc subcolumn cloud ice mixing ratio - ice_all_pts = real( X_nl_all_levs(:,:,iiPDF_ri), kind=r8) - end if + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + khzm(i,k) = khzm_in(i,pverp-k+1) + end do + end do + + ! Allocate 2D arrays in precip_fracs for all grid columns and vertical levels + call init_precip_fracs_api( pverp-top_lev+1, ngrdcol, & + precip_fracs ) + + call setup_pdf_parameters_api( gr, pverp-top_lev+1, ngrdcol, pdf_dim, ztodt, & ! In + Nc_in_cloud, rcm_in, cld_frac_in, khzm, & ! In + ice_supersat_frac_in, hydromet, wphydrometp, & ! In + corr_array_n_cloud, corr_array_n_below, & ! In + pdf_params_chnk(lchnk), l_stats_samp, & ! In + clubb_params, & ! In + clubb_config_flags%iiPDF_type, & ! In + clubb_config_flags%l_use_precip_frac, & ! In + clubb_config_flags%l_predict_upwp_vpwp, & ! In + clubb_config_flags%l_diagnose_correlations, & ! In + clubb_config_flags%l_calc_w_corr, & ! In + clubb_config_flags%l_const_Nc_in_cloud, & ! In + clubb_config_flags%l_fix_w_chi_eta_correlations, & ! In + stats_zt, stats_zm, stats_sfc, & ! In + hydrometp2, & ! Inout + mu_x_1, mu_x_2, & ! Out + sigma_x_1, sigma_x_2, & ! Out + corr_array_1, corr_array_2, & ! Out + corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! Out + precip_fracs ) ! Inout + + ! In order for Lscale to be used properly, it needs to be passed out of + ! advance_clubb_core, saved to the pbuf, and then pulled out of the + ! pbuf for use here. The profile of Lscale is passed into subroutine + ! generate_silhs_sample_api for use in calculating the vertical + ! correlation coefficient. Rather than output Lscale directly, its + ! value can be calculated from other fields that are already output to + ! pbuf. The equation relating Lscale to eddy diffusivity is: + ! + ! Kh = c_K * Lscale * sqrt( TKE ). + ! + ! Both Kh and TKE are written to the pbuf, and c_K is easily extracted + ! from CLUBB's tunable parameters. The equation for Lscale is: + ! + ! Lscale = Kh / ( c_K * sqrt( TKE ) ). + ! + ! Since Kh and TKE are output on momentum (interface) grid levels, the + ! resulting calculation of Lscale is also found on momentum levels. It + ! needs to be interpolated back to thermodynamic (midpoint) grid levels + ! for further use. + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + tke(i,k) = tke_in(i,pverp-k+1) + end do + end do + + do k = 1, pverp-top_lev+1 + do i = 1, ngrdcol + Lscale_zm(i,k) = khzm(i,k) / ( c_K * sqrt( max( tke(i,k), em_min ) ) ) + end do + end do - if ( iiPDF_Ni > 0 ) then - ! Calc subcolumn cloud ice number - nice_all_pts = real( X_nl_all_levs(:,:,iiPDF_Ni), kind=r8) - end if + do i = 1, ngrdcol + Lscale(i,1) = Lscale_zm(i,1) + ( Lscale_zm(i,2) - Lscale_zm(i,1) ) & + * ( zt_g(i,1) - zi_g(i,1) ) / ( zi_g(i,2) - zi_g(i,1) ) + end do + + do k = 2, pverp-top_lev+1 + do i = 1, ngrdcol + Lscale(i,k) = Lscale_zm(i,k-1) + ( Lscale_zm(i,k) - Lscale_zm(i,k-1) ) & + * ( zt_g(i,k) - zi_g(i,k-1) ) / ( zi_g(i,k) - zi_g(i,k-1) ) + end do + end do + + do k = 2, pverp-top_lev+1 + do i = 1, ngrdcol + Lscale(i,:) = max( Lscale(i,:), 0.01_r8 ) + end do + end do + + !$acc data create( X_mixt_comp_all_levs, X_nl_all_levs, lh_rc_clipped, lh_Nc_clipped, & + !$acc& lh_sample_point_weights, lh_rt_clipped, lh_rt_clipped, & + !$acc& lh_rv_clipped, lh_thl_clipped, THL_lh_out, & + !$acc& RT_lh_out, RCM_lh_out, NCLW_lh_out, ICE_lh_out, & + !$acc& NICE_lh_out, RVM_lh_out, THL_lh_out, RAIN_lh_out, & + !$acc& NRAIN_lh_out, SNOW_lh_out, NSNOW_lh_out, WM_lh_out, & + !$acc& OMEGA_lh_out ) & + !$acc& copyin( state, state%zm, state%phis, rho_ds_zt, invs_exner ) & + !$acc& copyout( state%t, state%s, state%omega, state_sc%q ) + !$acc& async(1) + + ! Set the seed to the random number generator based on a quantity that + ! will be reproducible for restarts. + lh_seed = int( 1.0e4_r8 * rtm(1,pver), kind = genrand_intg ) + + ! Let's generate some subcolumns!!!!! + call generate_silhs_sample_api( & + iter, pdf_dim, num_subcols, sequence_length, pverp-top_lev+1, ngrdcol, & ! In + l_calc_weights_all_levs_itime, & ! In + pdf_params_chnk(lchnk), delta_zm, rcm_in, Lscale, & ! In + lh_seed, & ! In + rho_ds_zt, & ! In + mu_x_1, mu_x_2, sigma_x_1, sigma_x_2, & ! In + corr_cholesky_mtx_1, corr_cholesky_mtx_2, & ! In + precip_fracs, silhs_config_flags, & ! In + clubb_params, & ! In + clubb_config_flags%l_uv_nudge, & ! In + clubb_config_flags%l_tke_aniso, & ! In + clubb_config_flags%l_standard_term_ta, & ! In + vert_decorr_coef, & ! In + stats_lh_zt, stats_lh_sfc, & ! intent(inout) + X_nl_all_levs, X_mixt_comp_all_levs, & ! Out + lh_sample_point_weights) ! Out + + ! Extract clipped variables from subcolumns + call clip_transform_silhs_output_api( gr, pverp-top_lev+1, ngrdcol, num_subcols, & ! In + pdf_dim, hydromet_dim, & ! In + X_mixt_comp_all_levs, & ! In + X_nl_all_levs, & ! In + pdf_params_chnk(lchnk), & ! In + l_use_Ncn_to_Nc, & ! In + lh_rt_clipped, lh_thl_clipped, & ! Out + lh_rc_clipped, lh_rv_clipped, & ! Out + lh_Nc_clipped ) ! Out + !$acc wait + + if ( l_est_kessler_microphys ) then + call endrun('subcol_SILHS: l_est_kessler_microphys = T is not currently supported') + end if - ! Calc subcolumn vert velocity for output (wm) - w_all_points = real( X_nl_all_levs(:,:,iiPDF_w), kind=r8 ) - ! Calc cloud liq water number conc - nclw_all_pts = lh_Nc_clipped(:,:) - ! Calc mean liquid water potential temp for clear air - !call THL_profile(pver, state%t(i,:), invs_exner(i,:), No_cloud, Temp_prof) - - ! Calc effective cloud fraction for testing - eff_cldfrac(:,:) = 0.0_r8 - do k = top_lev, pver - do j=1, num_subcols - - if ( ( rc_all_points(pverp-k+1,j) .gt. qsmall ) & - .or. ( ice_all_pts(pverp-k+1,j) .gt. qsmall ) ) then - eff_cldfrac(i,k) = eff_cldfrac(i,k)+lh_sample_point_weights(pverp-k+1,j) - endif - enddo - - eff_cldfrac(i,k) = eff_cldfrac(i,k)/real(num_subcols, kind=r8) - enddo - - ! Pack precip_frac for output - do k = 2, pverp-top_lev+1 - precip_frac_out(i,pver-k+2) = hydromet_pdf_params(k)%precip_frac - enddo - - ! Pack up weights for output - do j = 1, num_subcols - if (subcol_SILHS_weight) then - weights(stncol+j) = lh_sample_point_weights(2,j) ! Using grid level 2 always won't work - ! if weights vary with height. - else - weights(stncol+j) = 1._r8 - endif - enddo + !------------------------------------------------------------------------- + ! Convert from CLUBB vertical grid to CAM grid + !------------------------------------------------------------------------ + ! This kernel is executed in stream 1: + !$acc parallel loop collapse(3) default(present) async(1) + do k = top_lev, pverp + do j = 1, num_subcols + do i = 1, ngrdcol + RT_lh_out( num_subcols*(i-1)+j,k ) = lh_rt_clipped(i,j,pverp-k+1) + RCM_lh_out( num_subcols*(i-1)+j,k ) = lh_rc_clipped(i,j,pverp-k+1) + NCLW_lh_out( num_subcols*(i-1)+j,k ) = lh_Nc_clipped(i,j,pverp-k+1) + RVM_lh_out( num_subcols*(i-1)+j,k ) = lh_rv_clipped(i,j,pverp-k+1) + THL_lh_out( num_subcols*(i-1)+j,k ) = lh_thl_clipped(i,j,pverp-k+1) + end do + end do + end do + + ! This kernel is executed in stream 2: + !$acc parallel loop collapse(3) default(present) async(2) + do k = top_lev, pverp + do j = 1, num_subcols + do i = 1, ngrdcol + ICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_ri) + NICE_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Ni) + RAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_rr) + NRAIN_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Nr) + SNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_rs) + NSNOW_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_Ns) + WM_lh_out( num_subcols*(i-1)+j,k ) = X_nl_all_levs(i,j,pverp-k+1,iiPDF_w) + end do + end do + end do + + ! This kernel is executed in stream 2 because WM_lh_out comes from stream 2: + !$acc parallel loop collapse(3) default(present) async(2) + do k = top_lev, pverp + do j = 1, num_subcols + do i = 1, ngrdcol + OMEGA_lh_out( num_subcols*(i-1)+j,k ) = -1._r8 * WM_lh_out(num_subcols*(i-1)+j,k) & + * rho_ds_zt(i,pverp-k+1) * gravit + end do + end do + end do + + if ( l_est_kessler_microphys ) then + do k = top_lev, pverp + do j = 1, num_subcols + do i = 1, ngrdcol + AKm_out(i,k) = AKm(i,pverp-k+1) + lh_AKm_out(i,k) = lh_AKm(i,pverp-k+1) + end do + end do + end do + end if - ! Convert from CLUBB vertical grid to CAM grid for history output and - ! Updating state variables - do k = top_lev, pverp - do j = 1, num_subcols - RT_lh_out( stncol+j,k ) = lh_rt_clipped(pverp-k+1,j) - RCM_lh_out( stncol+j,k ) = rc_all_points(pverp-k+1,j) - NCLW_lh_out( stncol+j,k ) = nclw_all_pts(pverp-k+1,j) - ICE_lh_out( stncol+j,k ) = ice_all_pts(pverp-k+1,j) - NICE_lh_out( stncol+j,k ) = nice_all_pts(pverp-k+1,j) -! RVM_lh_out(j,k) = RT_lh_out(stncol+j,k)-RCM_lh_out(stncol+j,k)-ICE_lh_out(stncol+j,k) - RVM_lh_out( stncol+j,k ) = lh_rv_clipped(pverp-k+1,j) - THL_lh_out( stncol+j,k ) = lh_thl_clipped(pverp-k+1,j) - RAIN_lh_out( stncol+j,k ) = rain_all_pts(pverp-k+1,j) - NRAIN_lh_out( stncol+j,k ) = nrain_all_pts(pverp-k+1,j) - SNOW_lh_out( stncol+j,k ) = snow_all_pts(pverp-k+1,j) - NSNOW_lh_out( stncol+j,k ) = nsnow_all_pts(pverp-k+1,j) - WM_lh_out( stncol+j,k ) = w_all_points(pverp-k+1,j) - OMEGA_lh_out( stncol+j,k ) = -1._r8*WM_lh_out(stncol+j,k)*rho_ds_zt(pverp-k+1)*gravit - AKm_out(i,k) = AKm(pverp-k+1) - lh_AKm_out(i,k) = lh_AKm(pverp-k+1) - enddo - enddo - - ! Constrain the sample distribution of cloud water and ice to the same mean - ! as the grid to prevent negative condensate errors - if(subcol_SILHS_constrainmn) then - call subcol_constrainmn( num_subcols, ICE_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixcldice), meansc_ice(i,:), stdsc_ice(i,:) ) - if ( ixrain > 0 ) & - call subcol_constrainmn( num_subcols, RAIN_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixrain) ) - if ( ixsnow > 0 ) & - call subcol_constrainmn( num_subcols, SNOW_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixsnow) ) - call subcol_constrainmn( num_subcols, RCM_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixcldliq), meansc_liq(i,:), stdsc_liq(i,:) ) - call subcol_constrainmn( num_subcols, RVM_lh_out(stncol+1:stncol+num_subcols,:), & - weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixq), meansc_vap(i,:), stdsc_vap(i,:) ) - call subcol_constrainmn( num_subcols, NICE_lh_out(stncol+1:stncol+num_subcols,:), & + ! Pack up weights + ! Using grid level 2 always won't work if weights vary with height. + call subcol_pack(lchnk, lh_sample_point_weights(:,:,2), weights ) + call subcol_set_weight(lchnk, weights) + + ! Constrain the sample distribution of cloud water and ice to the same mean + ! as the grid to prevent negative condensate errors + if(subcol_SILHS_constrainmn) then + + do i = 1, ngrdcol + + stncol = num_subcols*(i-1) + + call subcol_constrainmn( num_subcols, ICE_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixcldice), meansc_ice(i,:), stdsc_ice(i,:) ) + if ( ixrain > 0 ) & + call subcol_constrainmn( num_subcols, RAIN_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixrain) ) + if ( ixsnow > 0 ) & + call subcol_constrainmn( num_subcols, SNOW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixsnow) ) + call subcol_constrainmn( num_subcols, RCM_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixcldliq), meansc_liq(i,:), stdsc_liq(i,:) ) + call subcol_constrainmn( num_subcols, RVM_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixq), meansc_vap(i,:), stdsc_vap(i,:) ) + call subcol_constrainmn( num_subcols, NICE_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumice) ) + if ( ixnumrain > 0 ) & + call subcol_constrainmn( num_subcols, NRAIN_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumrain) ) + if ( ixnumsnow > 0 ) & + call subcol_constrainmn( num_subcols, NSNOW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumsnow) ) + call subcol_constrainmn( num_subcols, NCLW_lh_out(stncol+1:stncol+num_subcols,:), & + weights(stncol+1:stncol+num_subcols), & + state%q(i,:,ixnumliq) ) + do k = top_lev, pver + ! Look for exceptionally large values of condensate + if(ANY(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8)) then + ! Clip the large values + where(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8) + ICE_lh_out(stncol+1:stncol+num_subcols,k) = 0.01_r8 + NICE_lh_out(stncol+1:stncol+num_subcols,k) = 1.5e+7_r8 + end where + ! Recalculate the weighted subcolumn mean + tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumice) ) - if ( ixnumrain > 0 ) & - call subcol_constrainmn( num_subcols, NRAIN_lh_out(stncol+1:stncol+num_subcols,:), & + real(num_subcols,r8) ) + ! Calculate the difference between the weighted mean and grid mean + diff_mean = state%q(i,k,ixcldice)-tmp_mean + ! Add the difference to each subcolumn + ICE_lh_out(stncol+1:stncol+num_subcols,k) = & + ICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean + ! Recalculate the weight subcolumn mean for ice num conc + tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumrain) ) - if ( ixnumsnow > 0 ) & - call subcol_constrainmn( num_subcols, NSNOW_lh_out(stncol+1:stncol+num_subcols,:), & + real(num_subcols,r8) ) + ! Calculate the difference between the weighted mean and grid mean + diff_mean = state%q(i,k,ixnumice)-tmp_mean + ! Add the difference to each subcolumn + if(diff_mean.gt.0.0_r8) then + NICE_lh_out(stncol+1:stncol+num_subcols,k) = & + NICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean + else ! just use the grid mean in each subcolumn + NICE_lh_out(stncol+1:stncol+num_subcols,k) = & + state%q(i,k,ixnumice) + end if + ! Test adjusted means for debugging + tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumsnow) ) - call subcol_constrainmn( num_subcols, NCLW_lh_out(stncol+1:stncol+num_subcols,:), & + real(num_subcols,r8) ) + diff_mean = state%q(i,k,ixcldice)-tmp_mean + tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & weights(stncol+1:stncol+num_subcols), & - state%q(i,:,ixnumliq) ) - do k = top_lev, pver - ! Look for exceptionally large values of condensate - if(ANY(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8)) then - ! Clip the large values - where(ICE_lh_out(stncol+1:stncol+num_subcols,k) .gt. 0.01_r8) - ICE_lh_out(stncol+1:stncol+num_subcols,k) = 0.01_r8 - NICE_lh_out(stncol+1:stncol+num_subcols,k) = 1.5e+7_r8 - end where - ! Recalculate the weighted subcolumn mean - tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - ! Calculate the difference between the weighted mean and grid mean - diff_mean = state%q(i,k,ixcldice)-tmp_mean - ! Add the difference to each subcolumn - ICE_lh_out(stncol+1:stncol+num_subcols,k) = & - ICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean - ! Recalculate the weight subcolumn mean for ice num conc - tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - ! Calculate the difference between the weighted mean and grid mean - diff_mean = state%q(i,k,ixnumice)-tmp_mean - ! Add the difference to each subcolumn - if(diff_mean.gt.0.0_r8) then - NICE_lh_out(stncol+1:stncol+num_subcols,k) = & - NICE_lh_out(stncol+1:stncol+num_subcols,k)+diff_mean - else ! just use the grid mean in each subcolumn - NICE_lh_out(stncol+1:stncol+num_subcols,k) = & - state%q(i,k,ixnumice) - end if - ! Test adjusted means for debugging - tmp_mean = meansc( ICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - diff_mean = state%q(i,k,ixcldice)-tmp_mean - tmp_mean = meansc( NICE_lh_out( stncol+1:stncol+num_subcols, k ), & - weights(stncol+1:stncol+num_subcols), & - real(num_subcols,r8) ) - diff_mean = state%q(i,k,ixnumice)-tmp_mean - endif - enddo ! k = top_lev, pver - endif ! subcol_silhs_constrainm - - ! Code to update the state variables for interactive runs - ! Set state variables - do j = 1, numsubcol_arr(i) - - call Abs_Temp_profile( pver-top_lev+1, THL_lh_out(stncol+j,top_lev:pver), & - invs_exner(i,top_lev:pver), RCM_lh_out(stncol+j,top_lev:pver), & - Temp_prof(top_lev:pver) ) - state_sc%t(stncol+j,top_lev:pver) = Temp_prof(top_lev:pver) - call StaticEng_profile( pver-top_lev+1, Temp_prof(top_lev:pver), & - state%zm(i,top_lev:pver), state%phis(i), & - SE_prof(top_lev:pver) ) - state_sc%s(stncol+j,top_lev:pver) = SE_prof(top_lev:pver) - + real(num_subcols,r8) ) + diff_mean = state%q(i,k,ixnumice)-tmp_mean + endif + end do ! k = top_lev, pver + end do + endif ! subcol_silhs_constrainm + + + !--------------------------------------------------- + ! Updating state variables + !--------------------------------------------------- + ! Code to update the state variables for interactive runs + ! This kernel is executed in stream 3, but waits for stream 1 + ! because THL_lh_out and RCM_lh_out come from stream 1: + !$acc parallel loop collapse(3) default(present) wait(1) async(3) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + + state_sc%t(num_subcols*(i-1)+j,k) = THL_lh_out(num_subcols*(i-1)+j,k) * invs_exner(i,k) & + + Lv * RCM_lh_out(num_subcols*(i-1)+j,k) / Cp + + state_sc%s(num_subcols*(i-1)+j,k) = cpair * state_sc%t(num_subcols*(i-1)+j,k) & + + gravit * state%zm(i,k) + state%phis(i) + end do + end do + end do + + ! This kernel is executed in stream 4, but waits for stream 1 and 2 + ! because RVM_lh_out is from stream 1 and OMEGA_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(1,2) async(4) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol ! Vertical Velocity is not part of the energy conservation checks, but ! we need to be careful here, because the SILHS output VV is noisy. - state_sc%omega(stncol+j,top_lev:pver) = OMEGA_lh_out(stncol+j,top_lev:pver) - state_sc%q(stncol+j,top_lev:pver,ixq) = RVM_lh_out(stncol+j,top_lev:pver) - - if( rx_Nc ) then - call endrun('subcol_gen_SILHS: rx_Nc not enabled') - endif - - - if (subcol_SILHS_meanice) then - call endrun('subcol_gen_SILHS: subcol_SILHS_meanice = T not currently available') - state_sc%q(stncol+j,top_lev:pver,ixcldice) = state%q(i,top_lev:pver,ixcldice) - state_sc%q(stncol+j,top_lev:pver,ixnumice) = state%q(i,top_lev:pver,ixnumice) - state_sc%q(stncol+j,top_lev:pver,ixcldliq) = RCM_lh_out(stncol+j,top_lev:pver) - state_sc%q(stncol+j,top_lev:pver,ixnumliq) = NCLW_lh_out(stncol+j,top_lev:pver) - else - if (subcol_SILHS_q_to_micro) then ! Send SILHS predicted constituents to microp - state_sc%q(stncol+j,top_lev:pver,ixcldliq) = RCM_lh_out(stncol+j,top_lev:pver) - state_sc%q(stncol+j,top_lev:pver,ixcldice) = ICE_lh_out(stncol+j,top_lev:pver) - if (ixrain > 0) & - state_sc%q(stncol+j,top_lev:pver,ixrain) = RAIN_lh_out(stncol+j,top_lev:pver) - if (ixsnow > 0) & - state_sc%q(stncol+j,top_lev:pver,ixsnow) = SNOW_lh_out(stncol+j,top_lev:pver) - else - state_sc%q(stncol+j,top_lev:pver,ixcldliq) = state%q(i,top_lev:pver,ixcldliq) - state_sc%q(stncol+j,top_lev:pver,ixcldice) = state%q(i,top_lev:pver,ixcldice) - if (ixrain > 0) & - state_sc%q(stncol+j,top_lev:pver,ixrain) = state%q(i,top_lev:pver,ixrain) - if (ixsnow > 0) & - state_sc%q(stncol+j,top_lev:pver,ixsnow) = state%q(i,top_lev:pver,ixsnow) - endif - if (subcol_SILHS_n_to_micro) then ! Send SILHS predicted number conc to microp - state_sc%q(stncol+j,top_lev:pver,ixnumice) = NICE_lh_out(stncol+j,top_lev:pver) - state_sc%q(stncol+j,top_lev:pver,ixnumliq) = NCLW_lh_out(stncol+j,top_lev:pver) - if (ixnumrain > 0) & - state_sc%q(stncol+j,top_lev:pver,ixnumrain) = NRAIN_lh_out(stncol+j,top_lev:pver) - if (ixnumsnow > 0) & - state_sc%q(stncol+j,top_lev:pver,ixnumsnow) = NSNOW_lh_out(stncol+j,top_lev:pver) - else - state_sc%q(stncol+j,top_lev:pver,ixnumliq) = state%q(i,top_lev:pver,ixnumliq) - state_sc%q(stncol+j,top_lev:pver,ixnumice) = state%q(i,top_lev:pver,ixnumice) - if (ixnumrain > 0) & - state_sc%q(stncol+j,top_lev:pver,ixnumrain) = state%q(i,top_lev:pver,ixnumrain) - if (ixnumsnow > 0) & - state_sc%q(stncol+j,top_lev:pver,ixnumsnow) = state%q(i,top_lev:pver,ixnumsnow) - endif - endif ! meanice + state_sc%omega(num_subcols*(i-1)+j,k) = OMEGA_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixq) = RVM_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + + if (subcol_SILHS_q_to_micro) then ! Send SILHS predicted constituents to microp + + ! This kernel is executed in stream 5, but waits for stream 1 and 2 + ! because RCM_lh_out is from stream 1 and ICE_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(1,2) async(5) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = RCM_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = ICE_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + + if (ixrain > 0) then + ! This kernel is executed in stream 6, but waits for stream 2 + ! because RAIN_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(6) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixrain) = RAIN_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + if (ixsnow > 0) then + ! This kernel is executed in stream 7, but waits for stream 2 + ! because SNOW_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(7) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = SNOW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + else + + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixcldliq) = state%q(i,k,ixcldliq) + state_sc%q(num_subcols*(i-1)+j,k,ixcldice) = state%q(i,k,ixcldice) + if (ixrain > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixrain) = state%q(i,k,ixrain) + end if + if (ixsnow > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixsnow) = state%q(i,k,ixsnow) + end if + end do + end do + end do + + endif + + if (subcol_SILHS_n_to_micro) then ! Send SILHS predicted number conc to microp + + ! This kernel is executed in stream 8, but waits for stream 1 and 2 + ! because NCLW_lh_out is from stream 1 and NICE_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(1,2) async(8) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = NICE_lh_out(num_subcols*(i-1)+j,k) + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = NCLW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + + if (ixnumrain > 0) then + ! This kernel is executed in stream 9, but waits for stream 2 + ! because NRAIN_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(9) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = NRAIN_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + if (ixnumsnow > 0) then + ! This kernel is executed in stream 10, but waits for stream 2 + ! because NSNOW_lh_out is from stream 2: + !$acc parallel loop collapse(3) default(present) wait(2) async(10) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = NSNOW_lh_out(num_subcols*(i-1)+j,k) + end do + end do + end do + end if + + else + + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = state%q(i,k,ixnumliq) + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = state%q(i,k,ixnumice) + if (ixnumrain > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = state%q(i,k,ixnumrain) + end if + if (ixnumsnow > 0) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = state%q(i,k,ixnumsnow) + end if + end do + end do + end do + + endif + + ! This kernel is executed in stream 8, because state_sc%q(:,:,ixnumliq) and + ! state_sc%q(:,:,ixnumice) are from stream 8 + !$acc parallel loop collapse(3) default(present) async(8) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol ! Change liq and ice (and rain and snow) num conc zeros to min values (1e-12) - where (state_sc%q(stncol+j,top_lev:pver,ixnumliq) .lt. min_num_conc) - state_sc%q(stncol+j,top_lev:pver,ixnumliq) = min_num_conc - end where - where (state_sc%q(stncol+j,top_lev:pver,ixnumice) .lt. min_num_conc) - state_sc%q(stncol+j,top_lev:pver,ixnumice) = min_num_conc - end where - if (ixnumrain > 0) then - where(state_sc%q(stncol+j,top_lev:pver,ixnumrain) .lt. min_num_conc) - state_sc%q(stncol+j,top_lev:pver,ixnumrain) = min_num_conc - end where - endif - if (ixnumsnow > 0) then - where(state_sc%q(stncol+j,top_lev:pver,ixnumsnow) .lt. min_num_conc) - state_sc%q(stncol+j,top_lev:pver,ixnumsnow) = min_num_conc - end where - endif + if (state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumliq) = min_num_conc + end if + + if (state_sc%q(num_subcols*(i-1)+j,k,ixnumice) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumice) = min_num_conc + end if + end do + end do + end do + + if (ixnumrain > 0) then + ! This kernel is executed in stream 9, because state_sc%q(:,:,ixnumrain) is + ! from stream 9 + !$acc parallel loop collapse(3) default(present) async(9) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + if(state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumrain) = min_num_conc + end if + end do + end do + end do + endif + + if (ixnumsnow > 0) then + ! This kernel is executed in stream 10, because state_sc%q(:,:,ixnumsnow) is + ! from stream 10 + !$acc parallel loop collapse(3) default(present) async(10) + do k = 1, pver-top_lev+1 + do j = 1, num_subcols + do i = 1, ngrdcol + if(state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) .lt. min_num_conc) then + state_sc%q(num_subcols*(i-1)+j,k,ixnumsnow) = min_num_conc + end if + end do + end do + end do + endif + + if ( l_outfld_subcol ) then + + do k = 1, pver-top_lev+1 + do i = 1, ngrdcol + do j = 1, num_subcols - enddo - - ! Only use weights if namelist variable turned on - if (subcol_SILHS_weight) call subcol_set_weight(state_sc%lchnk, weights) - - - ! Deallocate the dynamic arrays used - deallocate( lh_sample_point_weights, X_mixt_comp_all_levs, & - X_nl_all_levs, lh_rt_clipped, lh_thl_clipped, lh_rc_clipped, & - lh_rv_clipped, lh_Nc_clipped, & - corr_array_1, corr_array_2, mu_x_1, mu_x_2, sigma_x_1, & - sigma_x_2, corr_cholesky_mtx_1, corr_cholesky_mtx_2 ) - ! deallocate( RVM_lh_out ) - deallocate( rc_all_points, rain_all_pts, nrain_all_pts, snow_all_pts, nsnow_all_pts, ice_all_pts, & - nice_all_pts, nclw_all_pts, w_all_points ) - enddo ! ngrdcol - - call outfld( 'SILHS_THLM_SCOL', THL_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RT_SCOL', RT_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_OMEGA_SCOL', OMEGA_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_WM_SCOL', WM_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RCM_SCOL', RCM_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RICLD_SCOL', ICE_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NICLD_SCOL', NICE_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NCLD_SCOL', NCLW_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_RRAIN_SCOL', RAIN_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_NRAIN_SCOL', NRAIN_lh_out, pcols*psubcols, lchnk ) - call outfld( 'SILHS_WEIGHT_SCOL', weights, pcols*psubcols, lchnk ) - call outfld( 'NR_IN_LH', nrain, pcols, lchnk ) - call outfld( 'RTM_CLUBB', rtm, pcols, lchnk ) - call outfld( 'THLM_CLUBB', thlm, pcols, lchnk ) - call outfld( 'SILHS_QC_IN', state%q(:,:,ixcldliq), pcols, lchnk ) - call outfld( 'SILHS_QI_IN', state%q(:,:,ixcldice), pcols, lchnk ) - call outfld( 'SILHS_NC_IN', state%q(:,:,ixnumliq), pcols, lchnk ) - call outfld( 'SILHS_NI_IN', state%q(:,:,ixnumice), pcols, lchnk ) - call outfld( 'AKM_CLUBB', AKm_out, pcols, lchnk ) - call outfld( 'AKM_LH_CLUBB', lh_AKm_out, pcols, lchnk ) - call outfld( 'INVS_EXNER', invs_exner, pcols, lchnk ) - call outfld( 'SILHS_ZTODT', ztodt_ptr, pcols, lchnk ) - if ( subcol_SILHS_constrainmn ) then - call outfld( 'SILHS_MSC_CLDICE', meansc_ice, pcols, lchnk ) - call outfld( 'SILHS_STDSC_CLDICE', stdsc_ice, pcols, lchnk ) - if ( ixsnow > 0 ) then + ! Calc effective cloud fraction for testing + if ( ( lh_rc_clipped(i,j,pverp-k+1) .gt. qsmall ) & + .or. ( X_nl_all_levs(i,j,pverp-k+1,iiPDF_ri) .gt. qsmall ) ) then + eff_cldfrac(i,k) = eff_cldfrac(i,k) + lh_sample_point_weights(i,j,pverp-k+1) + else + eff_cldfrac(i,k) = 0.0_r8 + endif + + end do + + eff_cldfrac(i,k) = eff_cldfrac(i,k)/real(num_subcols, kind=r8) + + end do + end do + + ! Pack precip_frac for output + do k = 2, pverp-top_lev+1 + do i = 1, ngrdcol + precip_frac_out(i,pver-k+2) = precip_fracs%precip_frac(i,k) + end do + end do + + call outfld( 'SILHS_THLM_SCOL', THL_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RT_SCOL', RT_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_OMEGA_SCOL', OMEGA_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_WM_SCOL', WM_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RCM_SCOL', RCM_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RICLD_SCOL', ICE_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NICLD_SCOL', NICE_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NCLD_SCOL', NCLW_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_RRAIN_SCOL', RAIN_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_NRAIN_SCOL', NRAIN_lh_out, pcols*psubcols, lchnk ) + call outfld( 'SILHS_WEIGHT_SCOL', weights, pcols*psubcols, lchnk ) + call outfld( 'NR_IN_LH', nrain, pcols, lchnk ) + call outfld( 'RTM_CLUBB', rtm, pcols, lchnk ) + call outfld( 'THLM_CLUBB', thlm, pcols, lchnk ) + call outfld( 'SILHS_QC_IN', state%q(:,:,ixcldliq), pcols, lchnk ) + call outfld( 'SILHS_QI_IN', state%q(:,:,ixcldice), pcols, lchnk ) + call outfld( 'SILHS_NC_IN', state%q(:,:,ixnumliq), pcols, lchnk ) + call outfld( 'SILHS_NI_IN', state%q(:,:,ixnumice), pcols, lchnk ) + if ( l_est_kessler_microphys ) then + call outfld( 'AKM_CLUBB', AKm_out, pcols, lchnk ) + call outfld( 'AKM_LH_CLUBB', lh_AKm_out, pcols, lchnk ) + end if + call outfld( 'INVS_EXNER', invs_exner, pcols, lchnk ) + call outfld( 'SILHS_ZTODT', ztodt_ptr, pcols, lchnk ) + if ( subcol_SILHS_constrainmn ) then + call outfld( 'SILHS_MSC_CLDICE', meansc_ice, pcols, lchnk ) + call outfld( 'SILHS_STDSC_CLDICE', stdsc_ice, pcols, lchnk ) + if ( ixsnow > 0 ) then call outfld( 'SILHS_MSC_CLDLIQ', meansc_liq, pcols, lchnk ) call outfld( 'SILHS_STDSC_CLDLIQ', stdsc_liq, pcols, lchnk ) call outfld( 'SILHS_MSC_Q', meansc_vap, pcols, lchnk ) call outfld( 'SILHS_STDSC_Q', stdsc_vap, pcols, lchnk ) - endif ! ixsnow > 0 - endif ! subcol_SILHS_constrainmn - call outfld( 'SILHS_EFF_CLDFRAC', eff_cldfrac, pcols, lchnk ) - call outfld( 'SILHS_CLUBB_PRECIP_FRAC', precip_frac_out, pcols, lchnk ) - call outfld( 'SILHS_CLUBB_ICE_SS_FRAC', ice_supersat_frac, pcols, lchnk ) + endif ! ixsnow > 0 + endif ! subcol_SILHS_constrainmn + call outfld( 'SILHS_EFF_CLDFRAC', eff_cldfrac, pcols, lchnk ) + call outfld( 'SILHS_CLUBB_PRECIP_FRAC', precip_frac_out, pcols, lchnk ) + call outfld( 'SILHS_CLUBB_ICE_SS_FRAC', ice_supersat_frac, pcols, lchnk ) + end if + + !$acc end data + !$acc wait #endif #endif @@ -1443,10 +1712,12 @@ subroutine subcol_SILHS_var_covar_driver & use physics_buffer, only: physics_buffer_desc, pbuf_get_index, pbuf_get_field #ifdef CLUBB_SGS #ifdef SILHS - use ref_pres, only: top_lev => trop_cloud_top_lev use subcol_utils, only: subcol_get_weight use subcol_pack_mod, only: subcol_unpack, subcol_get_nsubcol - use clubb_api_module, only: T_in_K2thlm_api + use clubb_api_module, only: T_in_K2thlm_api, & + init_pdf_params_api, & + copy_multi_pdf_params_to_single,& + pdf_parameter use silhs_api_module, only: lh_microphys_var_covar_driver_api #endif #endif @@ -1484,9 +1755,9 @@ subroutine subcol_SILHS_var_covar_driver & real(r8), dimension(pcols,psubcols,pver ) :: exner ! Inputs to lh_microphys_var_covar_driver - real(r8), dimension(pcols,pverp,psubcols) :: rt_all_clubb, thl_all_clubb, w_all_clubb, & + real(r8), dimension(pcols,psubcols,pverp) :: rt_all_clubb, thl_all_clubb, w_all_clubb, & qctend_clubb, qvtend_clubb, thltend_clubb - real(r8), dimension(pcols,pverp-top_lev+1,psubcols) :: height_depndt_weights + real(r8), dimension(pcols,psubcols,pverp-top_lev+1) :: height_depndt_weights ! Outputs from lh_microphys_var_covar_driver real(r8), dimension(:,:), pointer :: rtp2_mc_zt, thlp2_mc_zt, wprtp_mc_zt, & @@ -1499,8 +1770,12 @@ subroutine subcol_SILHS_var_covar_driver & wprtp_mc_zt_idx, & wpthlp_mc_zt_idx, & rtpthlp_mc_zt_idx + + type(pdf_parameter) :: pdf_params_single_col !----- Begin Code ----- + + call init_pdf_params_api( pverp+1-top_lev, 1, pdf_params_single_col ) ! Don't do anything if this option isn't enabled. if ( .not. subcol_SILHS_var_covar_src ) return @@ -1558,8 +1833,8 @@ subroutine subcol_SILHS_var_covar_driver & ! Compute dry static density on CLUBB vertical grid do k = top_lev, pver dz_g(igrdcol,isubcol,k) = zi_all(igrdcol,isubcol,k) - zi_all(igrdcol,isubcol,k+1) ! thickness - rho(igrdcol,isubcol,k) = (1._r8/gravit)*pdel_all(igrdcol,isubcol,k)/dz_g(igrdcol,isubcol,k) - enddo + rho(igrdcol,isubcol,k) = (rga)*pdel_all(igrdcol,isubcol,k)/dz_g(igrdcol,isubcol,k) + end do ! Compute w from omega w_all(igrdcol,isubcol,top_lev:pver) = -omega_all(igrdcol,isubcol,top_lev:pver) & @@ -1575,7 +1850,7 @@ subroutine subcol_SILHS_var_covar_driver & t_all(igrdcol,isubcol,k) = ( s_all(igrdcol,isubcol,k) & - gravit * zm_all(igrdcol,isubcol,k) & - phis_all(igrdcol,isubcol) ) / cpair - enddo ! k = 1, pver + end do ! k = 1, pver ! This formula is taken from earlier in this file. exner(igrdcol,isubcol,top_lev:pver) & @@ -1590,7 +1865,7 @@ subroutine subcol_SILHS_var_covar_driver & thl_all(igrdcol,isubcol,k) & = T_in_K2thlm_api( t_all(igrdcol,isubcol,k), exner(igrdcol,isubcol,k), & rc_all(igrdcol,isubcol,k) ) - enddo ! k = 1, pver + end do ! k = 1, pver ! Add ghost points rt_all (igrdcol,isubcol,pverp) = rt_all (igrdcol,isubcol,pver) @@ -1601,15 +1876,15 @@ subroutine subcol_SILHS_var_covar_driver & thltend(igrdcol,isubcol,pverp) = thltend(igrdcol,isubcol,pver) ! Flip inputs to CLUBB's grid. Note the dimension ordering change. - rt_all_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pverp) ) - thl_all_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pverp) ) - w_all_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pverp) ) - qctend_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pverp) ) - qvtend_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pverp) ) - thltend_clubb(igrdcol,1:pverp,isubcol) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pverp) ) + rt_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( rt_all(igrdcol,isubcol,1:pverp) ) + thl_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( thl_all(igrdcol,isubcol,1:pverp) ) + w_all_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( w_all(igrdcol,isubcol,1:pverp) ) + qctend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( qctend(igrdcol,isubcol,1:pverp) ) + qvtend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( qvtend(igrdcol,isubcol,1:pverp) ) + thltend_clubb(igrdcol,isubcol,1:pverp) = clubb_flip_grid( thltend(igrdcol,isubcol,1:pverp) ) - enddo ! isubcol = 1, nsubcol(igrdcol) - enddo ! igrdcol = 1, ngrdcol + end do ! isubcol = 1, nsubcol(igrdcol) + end do ! igrdcol = 1, ngrdcol ! Obtain weights call subcol_get_weight(lchnk, weights_packed) @@ -1623,16 +1898,22 @@ subroutine subcol_SILHS_var_covar_driver & ! It will have to change once the weights vary with altitude! ! I'm not sure whether the grid will need to be flipped. do k = 1, pverp-top_lev+1 - height_depndt_weights(igrdcol,k,1:ns) = weights(igrdcol,1:ns) + height_depndt_weights(igrdcol,1:ns,k) = weights(igrdcol,1:ns) end do + ! Copy the igrdcol column from the multicolumn pdf_params_chnk to the single column + ! version of pdf_params_single_col since lh_microphys_var_covar_driver_api only + ! works over 1 column currently + call copy_multi_pdf_params_to_single( pdf_params_chnk(lchnk), igrdcol, & + pdf_params_single_col ) + ! Make the call!!!!! call lh_microphys_var_covar_driver_api & - ( pverp-top_lev+1, ns, ztodt, height_depndt_weights(igrdcol,1:pverp-top_lev+1,1:ns), & - pdf_params_chnk(igrdcol,lchnk), & - rt_all_clubb(igrdcol,1:pverp-top_lev+1,1:ns), thl_all_clubb(igrdcol,1:pverp-top_lev+1,1:ns), & - w_all_clubb(igrdcol,1:pverp-top_lev+1,1:ns), qctend_clubb(igrdcol,1:pverp-top_lev+1,1:ns), & - qvtend_clubb(igrdcol,1:pverp-top_lev+1,1:ns), thltend_clubb(igrdcol,1:pverp-top_lev+1,1:ns), & + ( pverp-top_lev+1, ns, ztodt, height_depndt_weights(igrdcol,1:ns,1:pverp-top_lev+1), & + pdf_params_single_col, & + rt_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), thl_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & + w_all_clubb(igrdcol,1:ns,1:pverp-top_lev+1), qctend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & + qvtend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), thltend_clubb(igrdcol,1:ns,1:pverp-top_lev+1), & silhs_config_flags%l_lh_instant_var_covar_src, & rtp2_mc_zt(igrdcol,1:pverp-top_lev+1), thlp2_mc_zt(igrdcol,1:pverp-top_lev+1), & wprtp_mc_zt(igrdcol,1:pverp-top_lev+1), wpthlp_mc_zt(igrdcol,1:pverp-top_lev+1), & @@ -1654,7 +1935,7 @@ subroutine subcol_SILHS_var_covar_driver & rtpthlp_mc_zt(igrdcol,pverp-top_lev+2:pverp) = 0.0_r8 endif ! pverp > pverp-top_lev+1 - enddo ! igrdcol = 1, ngrdcol + end do ! igrdcol = 1, ngrdcol #endif #endif @@ -1671,7 +1952,7 @@ real(r8) function meansc(arr_in, w_in, ns) result(val) val = 0 do i=1,ns acc = acc + arr_in(i)*w_in(i) - enddo + end do val = acc/ns end function @@ -1684,28 +1965,11 @@ real(r8) function stdsc(arr_in, w_in, mn_in, ns) result(val) accvar = 0 do i=1,ns accvar = accvar + ((arr_in(i)-mn_in)**2)*w_in(i) - enddo + end do var = accvar/ns val = sqrt(var) end function - subroutine Abs_Temp_profile(nz, LWPT_prof, ex_prof, rcm_prof, ABST_prof) - - use clubb_api_module, only : thlm2T_in_K_api - - integer, intent(in) :: nz ! Num vert levels - real(r8), dimension(nz), intent(in) :: LWPT_prof ! Temp prof in LWPT - real(r8), dimension(nz), intent(in) :: ex_prof ! Profile of Exner func - real(r8), dimension(nz), intent(in) :: rcm_prof ! Profile of Cld Wat MR - real(r8), dimension(nz), intent(out) :: ABST_prof ! Abs Temp prof - integer :: i - - do i=1,nz - ABST_prof(i) = thlm2T_in_K_api(LWPT_prof(i), ex_prof(i), rcm_prof(i)) - enddo - - end subroutine - subroutine THL_profile(nz, ABST_prof, ex_prof, rcm_prof, THL_prof) use clubb_api_module, only : T_in_K2thlm_api @@ -1719,24 +1983,10 @@ subroutine THL_profile(nz, ABST_prof, ex_prof, rcm_prof, THL_prof) do i=1,nz THL_prof(i) = T_in_K2thlm_api(ABST_prof(i), ex_prof(i), rcm_prof(i)) - enddo + end do end subroutine - subroutine StaticEng_profile(nz, ABST_prof, zm_prof, zsfc, s_prof) - integer, intent(in) :: nz - real(r8), dimension(nz), intent(in) :: ABST_prof - real(r8), dimension(nz), intent(in) :: zm_prof - real(r8), intent(in) :: zsfc - real(r8), dimension(nz), intent(out) :: s_prof - integer :: i - - do i=1,nz - s_prof(i) = cpair*(ABST_prof(i)) + gravit*zm_prof(i)+zsfc - enddo - - end subroutine - subroutine subcol_constrainmn( num_subcols, samples, weights, grid_mean, mean_sc, std_sc ) ! Input/Output Variables @@ -2153,24 +2403,24 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) + ptend%q(icol,k,ixcldliq) * dt & + state%q(icol,k,ixcldice) & + ptend%q(icol,k,ixcldice) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga if ( ixrain > 0 ) then grand_total_water_column_start(icol) & = grand_total_water_column_start(icol) & + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif if ( ixsnow > 0 ) then grand_total_water_column_start(icol) & = grand_total_water_column_start(icol) & + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif - enddo ! k = top_lev, pver + end do ! k = top_lev, pver grand_total_water_column_start(icol) & = grand_total_water_column_start(icol) & + prect(icol) * dt * 1000.0_r8 - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Calculate total energy in each column. ! This calculation is the vertically-integrated total energy in each @@ -2188,19 +2438,19 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & + latice * ( state%q(icol,k,ixcldliq) & + ptend%q(icol,k,ixcldliq) * dt ) ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga if ( ixrain > 0 ) then total_energy_column_start(icol) & = total_energy_column_start(icol) & + latice * ( state%q(icol,k,ixrain) & + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif - enddo ! k = top_lev, pver + end do ! k = top_lev, pver total_energy_column_start(icol) & = total_energy_column_start(icol) & + latice * precl(icol) * dt * 1000.0_r8 - enddo ! icol = 1, ncol + end do ! icol = 1, ncol endif ! l_check_conservation @@ -2810,9 +3060,9 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) endif ! ixsnow > 0 .and. ( .not. l_pos_rs_mc_tend ) - enddo ! k = top_lev, pver + end do ! k = top_lev, pver - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Calculate the new overall tendencies by adding the sedimentation ! tendencies back onto the new microphysics process tendencies. @@ -2990,24 +3240,24 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) + ptend%q(icol,k,ixcldliq) * dt & + state%q(icol,k,ixcldice) & + ptend%q(icol,k,ixcldice) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga if ( ixrain > 0 ) then grand_total_water_column_finish(icol) & = grand_total_water_column_finish(icol) & + ( state%q(icol,k,ixrain) + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif if ( ixsnow > 0 ) then grand_total_water_column_finish(icol) & = grand_total_water_column_finish(icol) & + ( state%q(icol,k,ixsnow) + ptend%q(icol,k,ixsnow) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif - enddo ! k = top_lev, pver + end do ! k = top_lev, pver grand_total_water_column_finish(icol) & = grand_total_water_column_finish(icol) & + prect(icol) * dt * 1000.0_r8 - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Calculate total energy in each column. ! This calculation is the vertically-integrated total energy in each @@ -3026,19 +3276,19 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) * ( state%q(icol,k,1) + ptend%q(icol,k,1) * dt ) & + latice * ( state%q(icol,k,ixcldliq) & + ptend%q(icol,k,ixcldliq) * dt ) ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga if ( ixrain > 0 ) then total_energy_column_finish(icol) & = total_energy_column_finish(icol) & + latice * ( state%q(icol,k,ixrain) & + ptend%q(icol,k,ixrain) * dt ) & - * state%pdel(icol,k) / gravit + * state%pdel(icol,k) * rga endif - enddo ! k = top_lev, pver + end do ! k = top_lev, pver total_energy_column_finish(icol) & = total_energy_column_finish(icol) & + latice * precl(icol) * dt * 1000.0_r8 - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Calculate the total relative error in each grid column. do icol = 1, ncol @@ -3055,7 +3305,7 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) / min( total_energy_column_finish(icol), & total_energy_column_start(icol) ) - enddo ! icol = 1, ncol + end do ! icol = 1, ncol ! Print an error message if any total water relative error is found to ! be greater than the threshold. @@ -3070,7 +3320,7 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) "Column-integrated grand total water at finish = ", & grand_total_water_column_finish(icol) endif ! tot_water_rel_err(icol) >= err_thresh - enddo ! icol = 1, ncol + end do ! icol = 1, ncol endif ! any( tot_water_rel_err >= err_thresh ) ! Print an error message if any total energy relative error is found to @@ -3086,7 +3336,7 @@ subroutine subcol_SILHS_fill_holes_conserv( state, dt, ptend, pbuf ) "Column-integrated total energy at finish = ", & total_energy_column_finish(icol) endif ! tot_energy_rel_err(icol) >= err_thresh - enddo ! icol = 1, ncol + end do ! icol = 1, ncol endif ! any( tot_energy_rel_err >= err_thresh ) endif ! l_check_conservation @@ -3224,7 +3474,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & else ! hm_curr < qmin_hm l_pos_hm(k) = .false. endif ! hm_curr >= qmin_hm - enddo ! k = top_lev, pver + end do ! k = top_lev, pver do k = pver, top_lev, -1 @@ -3236,7 +3486,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & ! to be filled. ! The value of the hydrometeor mixing ratio is negative, but ! the value of total_hole is positive. - total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) / gravit + total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga ! Calculate the total hydrometeor mass available from below ! to fill the hole. @@ -3304,7 +3554,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & idx = idx + 1 endif ! idx == pver endif ! sum_pdel >= total_fall_Pa - enddo + end do ! Calculate the available amount of hydrometeor mass to ! fill the hole. @@ -3318,9 +3568,9 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & total_fill_mass & = total_fill_mass & + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) / gravit + * pdel(icol,idx) * rga endif ! l_pos_hm(idx) - enddo ! idx = k+1, pver, 1 + end do ! idx = k+1, pver, 1 ! Contribution to total fill mass from the surface. total_fill_mass & = total_fill_mass + prec(icol) * dt * 1000.0_r8 @@ -3332,7 +3582,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & total_fill_mass & = total_fill_mass & + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) / gravit + * pdel(icol,idx) * rga endif ! l_pos_hm(idx) if ( idx >= lowest_level_idx ) then ! Check if enough mass has been gathered in @@ -3369,7 +3619,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & ! increment and keep going. idx = idx + 1 endif ! idx >= lowest_level_idx - enddo + end do endif ! l_reached_surface endif ! k == pver @@ -3386,9 +3636,9 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & total_fill_mass & = total_fill_mass & + ( hm_curr(idx) - qmin_hm ) & - * pdel(icol,idx) / gravit + * pdel(icol,idx) * rga endif ! l_pos_hm(idx) - enddo ! idx = top_lev, k-1, 1 + end do ! idx = top_lev, k-1, 1 endif ! total_fill_mass >= total_hole ! Calculate the ratio of total hole to total fill mass. This @@ -3411,7 +3661,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & + ( hm_curr(idx) - qmin_hm ) & * ( 1.0_r8 - hole_fillmass_ratio ) endif ! l_pos_hm(idx) - enddo ! idx = k+1, lowest_level_idx + end do ! idx = k+1, lowest_level_idx endif ! k < pver if ( l_reached_surface ) then @@ -3435,7 +3685,7 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & + ( hm_curr(idx) - qmin_hm ) & * ( 1.0_r8 - hole_fillmass_ratio ) endif ! l_pos_hm(idx) - enddo ! idx = top_lev, k-1 + end do ! idx = top_lev, k-1 endif ! l_fill_from_above ! Update the value of the hydrometeor at the level where the @@ -3449,14 +3699,14 @@ subroutine fill_holes_sedimentation( dt, ncol, hm_start, pdel, & endif ! .not. l_pos_hm(k) - enddo ! k = pver, top_lev, -1 + end do ! k = pver, top_lev, -1 endif ! any( hm_curr(top_lev:pver) < qmin_hm ) ! Update the value of total microphysics tendency after hole filling. hm_tend(icol,:) = hm_tend(icol,:) + ( hm_curr - hm_update ) / dt - enddo ! icol = 1, ncol + end do ! icol = 1, ncol return @@ -3617,7 +3867,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & else ! hm_curr_filler < qmin_hm_filler l_pos_hm_filler(k) = .false. endif ! hm_curr_filler >= qmin_hm_filler - enddo ! k = top_lev, pver + end do ! k = top_lev, pver do k = top_lev, pver @@ -3629,7 +3879,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & ! to be filled. ! The value of the hydrometeor mixing ratio is negative, but ! the value of total_hole is positive. - total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) / gravit + total_hole = ( qmin_hm - hm_curr(k) ) * pdel(icol,k) * rga ! Calculate the total hydrometeor mass available from the ! filler hydrometeor to fill the hole. @@ -3639,9 +3889,9 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & total_fill_mass & = total_fill_mass & + ( hm_curr_filler(idx) - qmin_hm_filler ) & - * pdel(icol,idx) / gravit + * pdel(icol,idx) * rga endif ! l_pos_hm_filler(idx) - enddo ! idx = top_lev, pver, 1 + end do ! idx = top_lev, pver, 1 ! Calculate the ratio of total hole to total fill mass. This ! should not exceed 1 except as a result of numerical round-off @@ -3661,7 +3911,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & + ( hm_curr_filler(idx) - qmin_hm_filler ) & * ( 1.0_r8 - hole_fillmass_ratio ) endif ! l_pos_hm_filler(idx) - enddo ! idx = top_lev, pver + end do ! idx = top_lev, pver ! Update the value of the hydrometeor at the level where the ! hole was found. Mathematically, as long as the available @@ -3674,7 +3924,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & endif ! .not. l_pos_hm(k) - enddo ! k = top_lev, pver + end do ! k = top_lev, pver endif ! any( hm_curr(top_lev:pver) < qmin_hm ) @@ -3686,7 +3936,7 @@ subroutine fill_holes_same_phase_vert( dt, ncol, hm_start, hm_start_filler, & hm_tend_filler(icol,:) & = hm_tend_filler(icol,:) + ( hm_curr_filler - hm_update_filler ) / dt - enddo ! icol = 1, ncol + end do ! icol = 1, ncol return @@ -3867,9 +4117,9 @@ subroutine subcol_SILHS_hydromet_conc_tend_lim( state, dt, ptend ) endif ! ixsnow > 0 .and. ixnumsnow > 0 - enddo ! k = top_lev, pver + end do ! k = top_lev, pver - enddo ! icol = 1, ncol + end do ! icol = 1, ncol return @@ -3877,5 +4127,27 @@ subroutine subcol_SILHS_hydromet_conc_tend_lim( state, dt, ptend ) end subroutine subcol_SILHS_hydromet_conc_tend_lim !============================================================================ + + ! Getunit and Freeunit are depreciated in Fortran going forward, so this is a + ! small function to get an unused stream identifier to send to setup_corr_varnce_array_api + ! or any other silhs/clubb functions that require a unit number argument + ! This comes directly from the Fortran wiki + integer function getnewunit(unit) + integer, intent(out), optional :: unit + + integer, parameter :: LUN_MIN=10, LUN_MAX=1000 + logical :: opened + integer :: lun, newunit + + newunit=-1 + do lun=LUN_MIN,LUN_MAX + inquire(unit=lun,opened=opened) + if (.not. opened) then + newunit=lun + exit + end if + end do + if (present(unit)) unit=newunit + end function getnewunit end module subcol_SILHS