Index: /trunk/WRF.COMMON/WRFV3/README.diff_to_planetary_version =================================================================== --- /trunk/WRF.COMMON/WRFV3/README.diff_to_planetary_version (revision 2761) +++ /trunk/WRF.COMMON/WRFV3/README.diff_to_planetary_version (revision 2761) @@ -0,0 +1,6543 @@ +diff --git a/WRF.COMMON/WRFV3/Registry/Registry.EM b/WRF.COMMON/WRFV3/Registry/Registry.EM +index 20d7e8f5..f484568d 100644 +--- a/WRF.COMMON/WRFV3/Registry/Registry.EM ++++ b/WRF.COMMON/WRFV3/Registry/Registry.EM +@@ -70,6 +70,121 @@ dimspec v - constant=1 z one + ################################################################################ + ################################################################################ + ++ ++####MARS MARS MARS MARS MARS ++####MARS MARS MARS MARS MARS ++#### ++#### variables physiques ecrites dans les fichiers WRF ++#### - h indique l'ecriture ++#### ++#### ++#### RADIATIVE TRANSFER ++state real HR_SW ikj misc 1 - - "HR_SW" "HEATING RATE SW" "K/s" ++state real HR_LW ikj misc 1 - - "HR_LW" "HEATING RATE LW" "K/s" ++state real HR_DYN ikj misc 1 - - "HR_DYN" "HEATING RATE DYN" "K/s" ++state real DDT ikj misc 1 - - "DDT" "TEMPERATURE TENDENCY" "K/s" ++state real DT_RAD ikj misc 1 - - "DT_RAD" "RADIATIVE TEMPERATURE TENDENCY" "K/s" ++state real DT_VDF ikj misc 1 - - "DT_VDF" "PBL CLMAIN TEMPERATURE TENDENCY" "K/s" ++state real DT_AJS ikj misc 1 - - "DT_AJS" "AJUSTEMENT SEC TEMPERATURE TENDENCY" "K/s" ++ ++state real SWDOWNZ ij misc 1 - - "SWDOWNZ" "DOWNWARD SW FLUX AT SURFACE" "W m-2" ++#### DUST CYCLE ++state real TAU_DUST ij misc 1 - - "TAU_DUST" "REFERENCE VISIBLE DUST OPACITY" "" ++state real RDUST ikj misc 1 - - "RDUST" "DUST RADIUS" "m" ++state real QSURFDUST ij misc 1 - - "QSURFDUST" "DUST MASS AT SURFACE" "kg m-2" ++#### CLOUDS ++state real MTOT ij misc 1 - - "MTOT" "TOTAL MASS WATER VAPOR in pmic" "pmic" ++state real ICETOT ij misc 1 - - "ICETOT" "TOTAL MASS WATER ICE" "kg m-2" ++state real VMR_ICE ikj misc 1 - - "VMR_ICE" "VOL. MIXING RATIO ICE" "ppm" ++state real TAU_ICE ij misc 1 - - "TAU_ICE" "CLOUD OD at 825 cm-1 TES" "" ++state real RICE ikj misc 1 - - "RICE" "ICE RADIUS" "m" ++#### THERMALS ++state real ZMAX ij misc 1 - - "ZMAX" "MAXIMUM LEVEL THERMALS" "m" ++state real HFMAX ij misc 1 - - "HFMAX" "MAXIMUM PBL HEAT FLUX" "m.K/s" ++#### GENERIC OUTPUTS ++state real CLOUDFRAC ikj misc 1 - - "CLOUDFRAC" "CLOUD FRACTION" "" ++state real TOTCLOUDFRAC ij misc 1 - - "TOTCLOUDFRAC" "COLUMN CLOUD FRACTION" "" ++state real GRAIN ikj misc 1 - - "RAIN" "RAIN kg/kg.s-1" "" ++state real GSNOW ikj misc 1 - - "SNOW" "SNOW kg/kg.s-1" "" ++state real ALBEQ ij misc 1 - - "ALBEQ" "ALBEDO EQUIVALENT" "" ++state real FLUXTOP_DN ij misc 1 - - "FLUXTOP_DN" "Incoming SW radiation at the TOA" "W.m-2" ++state real FLUXABS_SW ij misc 1 - - "FLUXABS_SW" "Absorbed SW flux" "W.m-2" ++state real FLUXTOP_LW ij misc 1 - - "FLUXTOP_LW" "Outgoing LW flux TOA" "W.m-2" ++state real FLUXSURF_SW ij misc 1 - - "FLUXSURF_SW" "SW Surface flux" "W.m-2" ++state real FLUXSURF_LW ij misc 1 - - "FLUXSURF_LW" "LW Surface flux" "W.m-2" ++state real FLXGRD ij misc 1 - h "FLXGRD" "heat flux from ground" "W.m-2" ++state real LSCEZ ikj misc 1 - - "LSCEZ" "heat from largescale" "W.m-2" ++state real H2OICE_REFF ikj misc 1 - - "H2OICE_REFF" "Radii of H2O ice" "m" ++state real LATENT_HF ij misc 1 - - "LATENT_HF" "Latent heat flux" "W.m-2" ++state real REEVAP ij misc 1 - - "REEVAP" "Re-evaporation flux of precipitation (integrated over the atmospheric column)" ++state real SURFRAIN ij misc 1 - - "SURFRAIN" "Rainfall" "kg m-2 s-1" ++ ++#### ++#### ++####MARS MARS MARS MARS MARS ++####MARS MARS MARS MARS MARS ++ ++####MARS MARS MARS MARS MARS ++####MARS MARS MARS MARS MARS ++#### ++#### ++#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE (>> mais l'ordre n'est-il pas defini plus bas ? dans les options mars ?) ++#### - effacer le h si l'on veut eviter les sorties ++#### ++state real - ikjftb scalar 1 - - - ++state real QH2O ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2O" "Water vapor mixing ratio" "kg kg-1" ++state real QH2O_ICE ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2O_ICE" "Water ice mixing ratio" "kg kg-1" ++state real qdust ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QDUST" "Dust mixing ratio" "kg kg-1" ++state real qdustn ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QDUSTN" "Dust number density" " m-3 " ++state real qtrac1 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "qtrac1" "Decaying tracer 1" "kg kg-1" ++state real qccn ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCCN" "CCN mixing ratio" "kg kg-1" ++state real qccnn ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCCNN" "CCN number mixing ratio" "kg kg-1" ++#### ++#### ++####MARS MARS MARS MARS MARS ++####MARS MARS MARS MARS MARS ++###VENUS TRACER ++state real qco2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCO2" "CO2 number mixing ratio" "kg kg-1" ++state real qco ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCO" "CO number mixing ratio" "kg kg-1" ++state real qh2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2" "H2 number mixing ratio" "kg kg-1" ++state real qo1d ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO1D" "O1d number mixing ratio" "kg kg-1" ++state real qo ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO" "O number mixing ratio" "kg kg-1" ++state real qo2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO2" "O2 number mixing ratio" "kg kg-1" ++state real qo2dg ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO2dg" "O2dg number mixing ratio" "kg kg-1" ++state real qo3 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO3" "O3 number mixing ratio" "kg kg-1" ++state real qh ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH" "H number mixing ratio" "kg kg-1" ++state real qoh ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QOH" "OH number mixing ratio" "kg kg-1" ++state real qho2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QHO2" "HO2 number mixing ratio" "kg kg-1" ++state real qh2o2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2O2" "H2O2 number mixing ratio" "kg kg-1" ++state real qcl ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCL" "Cl number mixing ratio" "kg kg-1" ++state real qclo ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCLO" "ClO number mixing ratio" "kg kg-1" ++state real qcl2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCL2" "Cl2 number mixing ratio" "kg kg-1" ++state real qhcl ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QHCL" "HCl number mixing ratio" "kg kg-1" ++state real qhocl ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QHOCL" "HOCl number mixing ratio" "kg kg-1" ++state real qclco ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCLCO" "ClCO number mixing ratio" "kg kg-1" ++state real qclco3 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCLCO3" "ClCO3 number mixing ratio" "kg kg-1" ++state real qcocl2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCOCL2" "COCl2 number mixing ratio" "kg kg-1" ++state real qss ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QS" "S number mixing ratio" "kg kg-1" ++state real qso ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QSO" "SO number mixing ratio" "kg kg-1" ++state real qso2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QSO2" "SO2 number mixing ratio" "kg kg-1" ++state real qso3 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QSO3" "SO3 number mixing ratio" "kg kg-1" ++state real qs2o2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QS2O2" "S2O2 number mixing ratio" "kg kg-1" ++state real qocs ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QOCS" "OCS number mixing ratio" "kg kg-1" ++state real qhso3 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QHSO3" "HSO3 number mixing ratio" "kg kg-1" ++state real qh2so4 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2SO4" "H2SO4 number mixing ratio" "kg kg-1" ++state real qs2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QS2" "S2 number mixing ratio" "kg kg-1" ++state real qclso2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCLSO2" "ClSO2 number mixing ratio" "kg kg-1" ++state real qoscl ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QOSCL" "OSCl number mixing ratio" "kg kg-1" ++state real qh2oliq ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2OLIQ" "H2O liq number mixing ratio" "kg kg-1" ++state real qh2so4liq ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2SO4LIQ" "H2SO4 liq number mixing ratio" "kg kg-1" ++ ++ ++ ++ ++ ++ ++ ++ + #state real floob ikjb dyn_em 1 - + #state real floob_x ikjx dyn_em 1 - + #state real floob_y ikjy dyn_em 1 - +@@ -90,7 +205,7 @@ dimspec v - constant=1 z one + # interpolated with a mask, as lu_index supplies that mask. + # this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling + # with wave model, only if compiled with -DMCELIO, JM 2003/05/29 +-state real LU_INDEX ij misc 1 - i02rh01d=(interp_fcnm)u=(copy_fcnm) "LU_INDEX" "LAND USE CATEGORY" "" ++state real LU_INDEX ij misc 1 - i02r01d=(interp_fcnm)u=(copy_fcnm) "LU_INDEX" "LAND USE CATEGORY" "" + state real LU_MASK ij misc 1 - i3h1 "LU_MASK" "0 land 1 water" "" + + # znw, znu, dzs, and zs must be listed before any 3-d fields +@@ -101,8 +216,8 @@ state real LU_MASK ij misc 1 - i3h1 "LU + + state real znu k dyn_em 1 - irh "znu" "eta values on half (mass) levels" "" + state real znw k dyn_em 1 Z i01rh "znw" "eta values on full (w) levels" "" +-state real ZS l misc - Z irh "ZS" "DEPTHS OF CENTERS OF SOIL LAYERS" "m" +-state real DZS l misc - Z irh "DZS" "THICKNESSES OF SOIL LAYERS" "m" ++state real ZS l misc - Z ir "ZS" "DEPTHS OF CENTERS OF SOIL LAYERS" "m" ++state real DZS l misc - Z ir "DZS" "THICKNESSES OF SOIL LAYERS" "m" + + # + # Variables from WPS +@@ -136,12 +251,58 @@ state real qg_gc igj dyn_em 1 Z i1 "QG" " + state real qni_gc igj dyn_em 1 Z i1 "QNI" "ice no concentration" "m-3" + endif + ++####MARS MARS MARS MARS MARS ++####MARS MARS MARS MARS MARS ++#### ++#### INITIALISATION ++#### ++#### variables dans real ++#### ++ ++state real albedo_gcm_gc ij dyn_em 1 - i1 "ALBEDO_GCM" "albedo of naked ground" "0 - 1 fraction" ++state real therm_inert_gc ij dyn_em 1 - i1 "THERMAL_INERTIA" "thermal inertia" "J/m2/K/s0.5" ++state real z0_gc ij dyn_em 1 - i1 "SURF_ROUGHNESS" "surface roughness" "cm" ++state real slpx_gc ij dyn_em 1 - i1 "SLPX" "slope x direction" "rad" ++state real slpy_gc ij dyn_em 1 - i1 "SLPY" "slope y direction" "rad" ++state real hv_gc igj dyn_em 1 Z i1 "HV" "water vapor" "kg/kg" ++state real hi_gc igj dyn_em 1 Z i1 "HI" "water ice" "kg/kg" ++state real tsoil_gc igj dyn_em 1 Z i1 "TSOIL" "soil temperatures" "K" ++state real isoil_gc igj dyn_em 1 Z i1 "ISOIL" "soil thermal inertia" "tiu" ++state real dsoil_gc igj dyn_em 1 Z i1 "DSOIL" "soil depths" "m" ++#### ++#### variables dans wrf ++#### ++#### 'm_' prefix is to avoid redundancies with possible existing terrestrial variables ++#### ++#### vvvv nom pour module_initialize, solve_em, lmd_driver (interne fortran) ++#### vvvv nom fichier netCDF (important initialisation ++################################################################################################################ ++state real m_albedo ij misc 1 - i012rd "MARS_ALB" "albedo of naked ground" "0 - 1 fraction" ++state real m_ti ij misc 1 - i012rd "MARS_TI" "thermal inertia" "J/m2/K/s0.5" ++state real m_z0 ij misc 1 - i012rd "MARS_Z0" "surface roughness" "m" ++state real slpx ij misc 1 - i012rd "SLOPEX" "slope x direction" "rad" ++state real slpy ij misc 1 - i012rd "SLOPEY" "slope y direction" "rad" ++state real m_emiss ij misc 1 - i012rd "MARS_EMISS" "emissivity" "0 - 1 fraction" ++state real m_co2ice ij misc 1 - i012rd "MARS_CICE" "co2 ground ice" "kg/m2" ++state real m_h2oice ij misc 1 - i012rd "MARS_WICE" "h2o ground ice" "kg/m2" ++state real m_fluxrad ij misc 1 - i012rd "MARS_FLUXRAD" "net rad flux at surf" "W.m-2" ++state real m_wstar ij misc 1 - i012rd "MARS_WSTAR" "free convection velocity" "m.s-1" ++state real m_tsurf ij misc 1 - i012rhd "MARS_TSURF" "surface temperature" "K" ++state real m_tsoil ilj misc 1 - i012rd "MARS_TSOIL" "soil temperatures" "K" ++state real m_q2 ikj misc 1 Z i012rd "MARS_Q2" "parameterized TKE" "kg.m-3" ++state real m_isoil ilj misc 1 - i012rd "MARS_ISOIL" "soil thermal inertia" "tiu" ++state real m_dsoil ilj misc 1 - i012rd "MARS_DSOIL" "soil depths" "m" ++state real m_gw ilj misc 1 - i012rd "MARS_GW" "gwparam" " " ++#### ++#### ++####MARS MARS MARS MARS MARS ++####MARS MARS MARS MARS MARS ++ + #----------------------------------------------------------------------------------------------------------------------------------------------------------------- + # + # Variables for Eulerian mass coordinate dynamics + # + +- + # Velocities + # + # U Vel +@@ -176,14 +337,18 @@ i1 real w_save ikj dyn_em 1 Z + + # Geopotential + state real ph ikjb dyn_em 2 Z \ +- irhusdf=(bdy_interp:dt) "ph" "perturbation geopotential" "m2 s-2" +-state real phb ikj dyn_em 1 Z irhdus "phb" "base-state geopotential" "m2 s-2" ++ irusdf=(bdy_interp:dt) "ph" "perturbation geopotential" "m2 s-2" ++state real phb ikj dyn_em 1 Z irdus "phb" "base-state geopotential" "m2 s-2" + state real phb_fine ikj dyn_em 1 Z - "phb_fine" "for nesting, temp holding interpolated coarse grid phb" "m2 s-2" + state real ph0 ikj dyn_em 1 Z r "ph0" "initial geopotential" "m2 s-2" + state real php ikj dyn_em 1 Z r "php" "geopotential" "m2 s-2" + i1 real ph_tend ikj dyn_em 1 Z + i1 real ph_tendf ikj dyn_em 1 Z + i1 real ph_save ikj dyn_em 1 Z ++## ++## MARS: TO GET LIGHTER HISTORY FILES ++## ++state real phtot ikj dyn_em 1 Z irh "PHTOT" "total geopotential" "m2 s-2" + + # Potential Temperature + state real t ikjb dyn_em 2 - \ +@@ -195,13 +360,13 @@ i1 real t_tendf ikj dyn_em 1 - + state real tp ikj dyn_em 2 - + i1 real t_2save ikj dyn_em 1 - + state real t_save ikj dyn_em 1 - "t_save" +-# +- ++# ++state real tz_init ikj dyn_em 1 - ir "tz_init" "initial potential temperature" "K" + + # Mass + state real mu ijb dyn_em 2 - \ +- irhusdf=(bdy_interp:dt) "mu" "perturbation dry air mass in column" "Pa" +-state real mub ij dyn_em 1 - irhdus "mub" "base state dry air mass in column" "Pa" ++ irusdf=(bdy_interp:dt) "mu" "perturbation dry air mass in column" "Pa" ++state real mub ij dyn_em 1 - irdus "mub" "base state dry air mass in column" "Pa" + state real mub_fine ij dyn_em 1 - - "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa" + state real mub_save ij dyn_em 1 - - "mub_save" "nest temp, holds orig fine grid mub" "Pa" + state real mu0 ij dyn_em 1 - i01rdu "mu0" "initial dry mass in column" "Pa" +@@ -218,7 +383,7 @@ i1 real mu_tend ij dyn_em 1 - + i1 real mu_tendf ij dyn_em 1 - + + #diagnostic for looking at nest position in output. A mungy version of terrain height. +-state real nest_pos ij misc 1 - rhu=(mark_domain) "NEST_POS" ++state real nest_pos ij misc 1 - ru=(mark_domain) "NEST_POS" + state real nest_mask ij misc 1 - ru=(mark_domain) "NEST_MASK" "LOCATION OF NEST IF ANY" + state real ht_coarse ij misc 1 - r - "STORAGE FOR LOW-RES TERRAIN" + +@@ -228,7 +393,7 @@ state real tke ikj dyn_em 2 - r "t + i1 real tke_tend ikj dyn_em 1 - + + # Pressure and Density +-state real p ikj dyn_em 1 - rh "p" "perturbation pressure" "Pa" ++state real p ikj dyn_em 1 - r "p" "perturbation pressure" "Pa" + state real al ikj dyn_em 1 - r "al" "inverse perturbation density" "m3 kg-1" + state real alt ikj dyn_em 1 - r "alt" "inverse density" "m3 kg-1" + state real alb ikj dyn_em 1 - rdus "alb" "inverse base density" "m3 kg-1" +@@ -236,7 +401,11 @@ state real zx ikj dyn_em 1 X - " + state real zy ikj dyn_em 1 Y - " " " " " " + state real rdz ikj dyn_em 1 Z - " " " " " " + state real rdzw ikj dyn_em 1 Z - " " " " " " +-state real pb ikj dyn_em 1 - rhdus "pb" "BASE STATE PRESSURE " "Pa" ++state real pb ikj dyn_em 1 - rdus "pb" "BASE STATE PRESSURE " "Pa" ++## ++## MARS: TO GET LIGHTER HISTORY FILES ++## ++state real ptot ikj dyn_em 1 - irh "PTOT" "total pressure" "Pa" + + # + # Other dyn +@@ -252,34 +421,34 @@ i1 real cqu ikj dyn_em 1 - - + i1 real cqv ikj dyn_em 1 - - + i1 real cqw ikj dyn_em 1 - - + i1 real pm1 ikj dyn_em 1 - - +-state real sr ij dyn_em 1 - irh "sr" "fraction of frozen precipitation" +-state real potevp ij dyn_em 1 - rh "potevp" "accumulated potential evaporation" "W m-2" +-state real snopcx ij dyn_em 1 - rh "snopcx" "snow phase change heat flux" "W m-2" +-state real soiltb ij dyn_em 1 - h "soiltb" "bottom soil temperature" "K" +-state real fnm k dyn_em 1 - irh "fnm" "upper weight for vertical stretching" "" +-state real fnp k dyn_em 1 - irh "fnp" "lower weight for vertical stretching" "" +-state real rdnw k dyn_em 1 - irh "rdnw" "inverse d(eta) values between full (w) levels" "" +-state real rdn k dyn_em 1 - irh "rdn" "inverse d(eta) values between half (mass) levels" "" +-state real dnw k dyn_em 1 - irh "dnw" "d(eta) values between full (w) levels" "" +-state real dn k dyn_em 1 - irh "dn " "d(eta) values between half (mass) levels" "" ++state real sr ij dyn_em 1 - ir "sr" "fraction of frozen precipitation" ++state real potevp ij dyn_em 1 - r "potevp" "accumulated potential evaporation" "W m-2" ++state real snopcx ij dyn_em 1 - r "snopcx" "snow phase change heat flux" "W m-2" ++state real soiltb ij dyn_em 1 - - "soiltb" "bottom soil temperature" "K" ++state real fnm k dyn_em 1 - ir "fnm" "upper weight for vertical stretching" "" ++state real fnp k dyn_em 1 - ir "fnp" "lower weight for vertical stretching" "" ++state real rdnw k dyn_em 1 - ir "rdnw" "inverse d(eta) values between full (w) levels" "" ++state real rdn k dyn_em 1 - ir "rdn" "inverse d(eta) values between half (mass) levels" "" ++state real dnw k dyn_em 1 - ir "dnw" "d(eta) values between full (w) levels" "" ++state real dn k dyn_em 1 - ir "dn " "d(eta) values between half (mass) levels" "" + state real t_base k dyn_em 1 - ir "t_base" "BASE STATE T IN IDEALIZED CASES" "K" + state real z ikj dyn_em 1 - - " " " " " " + i1 real mu_3d ikj dyn_em 1 - + i1 real z_at_w ikj dyn_em 1 Z +-state real cfn - misc - - irh "cfn" "extrapolation constant" "" +-state real cfn1 - misc - - irh "cfn1" "extrapolation constant" "" ++state real cfn - misc - - ir "cfn" "extrapolation constant" "" ++state real cfn1 - misc - - ir "cfn1" "extrapolation constant" "" + state integer step_number - misc - - ir "step_number" "" + + # 2m and 10m output diagnostics +-state real Q2 ij misc 1 - irhd "Q2" "QV at 2 M" "kg kg-1" +-state real T2 ij misc 1 - irhd "T2" "TEMP at 2 M" "K" +-state real TH2 ij misc 1 - irhd "TH2" "POT TEMP at 2 M" "K" ++state real Q2 ij misc 1 - ird "Q2" "QV at 2 M" "kg kg-1" ++state real T2 ij misc 1 - ird "T2" "TEMP at 2 M" "K" ++state real TH2 ij misc 1 - ird "TH2" "POT TEMP at 2 M" "K" + state real PSFC ij misc 1 - i01rhd "PSFC" "SFC PRESSURE" "Pa" + + # these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling + # with wave model, only if compiled with -DMCELIO, JM 2003/05/29 +-state real U10 ij misc 1 - irh01d "U10" "U at 10 M" "m s-1" +-state real V10 ij misc 1 - irh01d "V10" "V at 10 M" "m s-1" ++state real U10 ij misc 1 - ir01d "U10" "U at 10 M" "m s-1" ++state real V10 ij misc 1 - ir01d "V10" "V at 10 M" "m s-1" + + # these next 4 are for observational nudging + state real uratx ij misc 1 - r "URATX" "Ratio of U over U10 on mass points " "dimensionless" +@@ -288,20 +457,20 @@ state real tratx ij misc 1 - r + state real obs_savwt hikj dyn_em 1 X - "OBS_SAVWT" + + # Other +-state real rdx - misc - - irh "rdx" "INVERSE X GRID LENGTH" "" +-state real rdy - misc - - irh "rdy" "INVERSE Y GRID LENGTH" "" ++state real rdx - misc - - ir "rdx" "INVERSE X GRID LENGTH" "" ++state real rdy - misc - - ir "rdy" "INVERSE Y GRID LENGTH" "" + state real dts - misc - - ir "dts" "SMALL TIMESTEP" "" + state real dtseps - misc - - ir "dtseps" "TIME WEIGHT CONSTANT FOR SMALL STEPS" "" +-state real resm - misc - - irh "resm" "TIME WEIGHT CONSTANT FOR SMALL STEPS" "" +-state real zetatop - misc - - irh "zetatop" "ZETA AT MODEL TOP" "" +-state real cf1 - misc - - irh "cf1" "2nd order extrapolation constant" "" +-state real cf2 - misc - - irh "cf2" "2nd order extrapolation constant" "" +-state real cf3 - misc - - irh "cf3" "2nd order extrapolation constant" "" ++state real resm - misc - - ir "resm" "TIME WEIGHT CONSTANT FOR SMALL STEPS" "" ++state real zetatop - misc - - ir "zetatop" "ZETA AT MODEL TOP" "" ++state real cf1 - misc - - ir "cf1" "2nd order extrapolation constant" "" ++state real cf2 - misc - - ir "cf2" "2nd order extrapolation constant" "" ++state real cf3 - misc - - ir "cf3" "2nd order extrapolation constant" "" + state integer number_at_same_level - - - - - "number_at_same_level" "" "" + + # State for derived time quantities. +-state integer itimestep - - - - rh "itimestep" "" "" +-state real xtime - - - - rh "xtime" "minutes since simulation start" "" ++state integer itimestep - - - - r "itimestep" "" "" ++state real xtime - - - - r "xtime" "minutes since simulation start" "" + state real julian - - - - - "julian" "day of year, 0.0 at 0Z on 1 Jan." "days" + + +@@ -338,17 +507,17 @@ state real vc_j - misc - - r + # + state real - ikjftb moist 1 - - - + state real qv ikjftb moist 1 - \ +- i01rhusdf=(bdy_interp:dt) "QVAPOR" "Water vapor mixing ratio" "kg kg-1" ++ i01rusdf=(bdy_interp:dt) "QVAPOR" "Water vapor mixing ratio" "kg kg-1" + state real qc ikjftb moist 1 - \ +- i01rhusdf=(bdy_interp:dt) "QCLOUD" "Cloud water mixing ratio" "kg kg-1" ++ i01rusdf=(bdy_interp:dt) "QCLOUD" "Cloud water mixing ratio" "kg kg-1" + state real qr ikjftb moist 1 - \ +- i01rhusdf=(bdy_interp:dt) "QRAIN" "Rain water mixing ratio" "kg kg-1" ++ i01rusdf=(bdy_interp:dt) "QRAIN" "Rain water mixing ratio" "kg kg-1" + state real qi ikjftb moist 1 - \ +- i01rhusdf=(bdy_interp:dt) "QICE" "Ice mixing ratio" "kg kg-1" ++ i01rusdf=(bdy_interp:dt) "QICE" "Ice mixing ratio" "kg kg-1" + state real qs ikjftb moist 1 - \ +- i01rhusdf=(bdy_interp:dt) "QSNOW" "Snow mixing ratio" "kg kg-1" ++ i01rusdf=(bdy_interp:dt) "QSNOW" "Snow mixing ratio" "kg kg-1" + state real qg ikjftb moist 1 - \ +- i01rhusdf=(bdy_interp:dt) "QGRAUP" "Graupel mixing ratio" "kg kg-1" ++ i01rusdf=(bdy_interp:dt) "QGRAUP" "Graupel mixing ratio" "kg kg-1" + state real - ikjftb dfi_moist 1 - - - + state real dfi_qv ikjftb dfi_moist 1 - \ + rusdf=(bdy_interp:dt) "DFI_QVAPOR" "Water vapor mixing ratio" "kg kg-1" +@@ -370,17 +539,17 @@ state real - ikjftb chem 1 - - - + # Other Scalars + state real - ikjftb scalar 1 - - - + state real qndrop ikjftb scalar 1 - \ +- i01rhusdf=(bdy_interp:dt) "QNDROP" "Droplet number mixing ratio" "# kg-1" ++ i01rusdf=(bdy_interp:dt) "QNDROP" "Droplet number mixing ratio" "# kg-1" + state real qni ikjftb scalar 1 - \ +- i01rhusdf=(bdy_interp:dt) "QNICE" "Ice Number concentration" "# kg-1" ++ i01rusdf=(bdy_interp:dt) "QNICE" "Ice Number concentration" "# kg-1" + state real qt ikjftb scalar 1 - \ +- i01rhusdf=(bdy_interp:dt) "CWM" "Total condensate mixing ratio" "kg kg-1" ++ i01rusdf=(bdy_interp:dt) "CWM" "Total condensate mixing ratio" "kg kg-1" + state real qns ikjftb scalar 1 - \ +- i01rhusdf=(bdy_interp:dt) "QNSNOW" "Snow Number concentration" "# kg(-1)" ++ i01rusdf=(bdy_interp:dt) "QNSNOW" "Snow Number concentration" "# kg(-1)" + state real qnr ikjftb scalar 1 - \ +- i01rhusdf=(bdy_interp:dt) "QNRAIN" "Rain Number concentration" "# kg(-1)" ++ i01rusdf=(bdy_interp:dt) "QNRAIN" "Rain Number concentration" "# kg(-1)" + state real qng ikjftb scalar 1 - \ +- i01rhusdf=(bdy_interp:dt) "QNGRAUPEL" "Graupel Number concentration" "# kg(-1)" ++ i01rusdf=(bdy_interp:dt) "QNGRAUPEL" "Graupel Number concentration" "# kg(-1)" + state real - ikjftb dfi_scalar 1 - - - + state real dfi_qndrop ikjftb dfi_scalar 1 - \ + rusdf=(bdy_interp:dt) "DFI_QNDROP" "Droplet number mixing ratio" "# kg-1" +@@ -452,7 +621,7 @@ state real soilt020 ij misc 1 - i1 "SOIL + state real soilt040 ij misc 1 - i1 "SOILT040" "LAYER SOIL TEMPERATURE" "K" + state real soilt160 ij misc 1 - i1 "SOILT160" "LAYER SOIL TEMPERATURE" "K" + state real soilt300 ij misc 1 - i1 "SOILT300" "LAYER SOIL TEMPERATURE" "K" +-state real landmask ij misc 1 - i012rhd=(interp_fcnm)u=(copy_fcnm) "LANDMASK" "LAND MASK (1 FOR LAND, 0 FOR WATER)" "" ++state real landmask ij misc 1 - i012rd=(interp_fcnm)u=(copy_fcnm) "LANDMASK" "LAND MASK (1 FOR LAND, 0 FOR WATER)" "" + state real topostdv ij misc 1 - i12 "TOPOSTDV" "ELEVATION STD DEV" "m" + state real toposlpx ij misc 1 - i12 "TOPOSLPX" "ELEVATION X SLOPE" "" + state real toposlpy ij misc 1 - i12 "TOPOSLPY" "ELEVATION Y SLOPE" "" +@@ -473,7 +642,7 @@ state real vegcat ij misc 1 - i12 "VEGC + + # soil model variables (Note that they are marked as staggered in the vertical dimension + # because they are "fully dimensioned" -- they use every element in that dim +-state real TSLB ilj misc 1 Z i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TSLB" "SOIL TEMPERATURE" "K" ++state real TSLB ilj misc 1 Z i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TSLB" "SOIL TEMPERATURE" "K" + + # Time series variables + state real ts_hour ?! misc - - r "TS_HOUR" "Model integration time, hours" +@@ -499,29 +668,29 @@ state real DZG l em - Z r "DZ + + # lsm State Variables + +-state real SMOIS ilj - 1 Z i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SMOIS" "SOIL MOISTURE" "m3 m-3" +-state real SH2O ilj - 1 Z i02rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SH2O" "SOIL LIQUID WATER" "m3 m-3" +-state real XICE ij misc 1 - i0124rhd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "SEAICE" "SEA ICE FLAG" "" +-state real XICEM ij misc 1 - rhd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "XICEM" "SEA ICE FLAG (PREVIOUS STEP)" "" ++state real SMOIS ilj - 1 Z i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SMOIS" "SOIL MOISTURE" "m3 m-3" ++state real SH2O ilj - 1 Z i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SH2O" "SOIL LIQUID WATER" "m3 m-3" ++state real XICE ij misc 1 - i0124rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "SEAICE" "SEA ICE FLAG" "" ++state real XICEM ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "XICEM" "SEA ICE FLAG (PREVIOUS STEP)" "" + state real SMSTAV ij misc 1 - rd=(interp_mask_land_field:lu_index) "SMSTAV" "MOISTURE AVAILABILITY" "" + state real SMSTOT ij misc 1 - r "SMSTOT" "TOTAL SOIL MOISTURE" "m3 m-3" + +-state real SFCRUNOFF ij misc 1 - rhd=(interp_mask_land_field:lu_index) "SFROFF" "SURFACE RUNOFF" "mm" +-state real UDRUNOFF ij misc 1 - rhd=(interp_mask_land_field:lu_index) "UDROFF" "UNDERGROUND RUNOFF" "mm" +-state integer IVGTYP ij misc 1 - i02rhd=(interp_fcni)u=(copy_fcni) "IVGTYP" "DOMINANT VEGETATION CATEGORY" "" +-state integer ISLTYP ij misc 1 - i02rhd=(interp_fcni)u=(copy_fcni) "ISLTYP" "DOMINANT SOIL CATEGORY" "" +-state real VEGFRA ij misc 1 - i0124rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "VEGFRA" "VEGETATION FRACTION" "" ++state real SFCRUNOFF ij misc 1 - rd=(interp_mask_land_field:lu_index) "SFROFF" "SURFACE RUNOFF" "mm" ++state real UDRUNOFF ij misc 1 - rd=(interp_mask_land_field:lu_index) "UDROFF" "UNDERGROUND RUNOFF" "mm" ++state integer IVGTYP ij misc 1 - i02rd=(interp_fcni)u=(copy_fcni) "IVGTYP" "DOMINANT VEGETATION CATEGORY" "" ++state integer ISLTYP ij misc 1 - i02rd=(interp_fcni)u=(copy_fcni) "ISLTYP" "DOMINANT SOIL CATEGORY" "" ++state real VEGFRA ij misc 1 - i0124rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "VEGFRA" "VEGETATION FRACTION" "" + state real SFCEVP ij misc 1 - r "SFCEVP" "SURFACE EVAPORATION" "kg m-2" +-state real GRDFLX ij misc 1 - rh "GRDFLX" "GROUND HEAT FLUX" "W m-2" ++state real GRDFLX ij misc 1 - r "GRDFLX" "GROUND HEAT FLUX" "W m-2" + state real SFCEXC ij misc 1 - r "SFCEXC " "SURFACE EXCHANGE COEFFICIENT" "m s-1" + + state real ACSNOW ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "ACSNOW" "ACCUMULATED SNOW" "kg m-2" + state real ACSNOM ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "ACSNOM" "ACCUMULATED MELTED SNOW" "kg m-2" +-state real SNOW ij misc 1 - i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SNOW" "SNOW WATER EQUIVALENT" "kg m-2" +-state real SNOWH ij misc 1 - i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SNOWH" "PHYSICAL SNOW DEPTH" "m" +-state real RHOSN ij misc 1 - i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "RHOSN" " SNOW DENSITY" "kg m-3" +-state real CANWAT ij misc 1 - i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "CANWAT" "CANOPY WATER" "kg m-2" +-state real SST ij misc 1 - i0124rhd=(interp_mask_water_field:lu_index) "SST" "SEA SURFACE TEMPERATURE" "K" ++state real SNOW ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SNOW" "SNOW WATER EQUIVALENT" "kg m-2" ++state real SNOWH ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SNOWH" "PHYSICAL SNOW DEPTH" "m" ++state real RHOSN ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "RHOSN" " SNOW DENSITY" "kg m-3" ++state real CANWAT ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "CANWAT" "CANOPY WATER" "kg m-2" ++state real SST ij misc 1 - i0124rd=(interp_mask_water_field:lu_index) "SST" "SEA SURFACE TEMPERATURE" "K" + state integer IFNDSNOWH - misc 1 - i "FNDSNOWH" "SNOWH_LOGICAL" + state integer IFNDSOILW - misc 1 - i "FNDSOILW" "SOILW_LOGICAL" + +@@ -675,35 +844,35 @@ state real m_hybi d misc 1 - - "m_hybi" "MATCH h + state real F_ICE_PHY ikj misc 1 - rdu "F_ICE_PHY" "FRACTION OF ICE" "" + state real F_RAIN_PHY ikj misc 1 - rdu "F_RAIN_PHY" "FRACTION OF RAIN " "" + state real F_RIMEF_PHY ikj misc 1 - rdu "F_RIMEF_PHY" "MASS RATIO OF RIMED ICE " "" +-state real qndropsource ikj misc 1 - h "qndropsource" "Droplet number source" "#/kg/s" ++state real qndropsource ikj misc 1 - - "qndropsource" "Droplet number source" "#/kg/s" + + # Other Misc State Variables + state real h_diabatic ikj misc 1 - rdu "h_diabatic" "PREVIOUS TIMESTEP CONDENSATIONAL HEATING" "K s-1" +-state real msft ij misc 1 - i012rhdu=(copy_fcnm) "MAPFAC_M" "Map scale factor on mass grid" "" +-state real msfu ij misc 1 X i012rhdu=(copy_fcnm) "MAPFAC_U" "Map scale factor on u-grid" "" +-state real msfv ij misc 1 Y i012rhdu=(copy_fcnm) "MAPFAC_V" "Map scale factor on v-grid" "" +-state real msftx ij misc 1 - i012rhdu=(copy_fcnm) "MAPFAC_MX" "Map scale factor on mass grid, x direction" "" +-state real msfty ij misc 1 - i012rhdu=(copy_fcnm) "MAPFAC_MY" "Map scale factor on mass grid, y direction" "" +-state real msfux ij misc 1 X i012rhdu=(copy_fcnm) "MAPFAC_UX" "Map scale factor on u-grid, x direction" "" +-state real msfuy ij misc 1 X i012rhdu=(copy_fcnm) "MAPFAC_UY" "Map scale factor on u-grid, y direction" "" +-state real msfvx ij misc 1 Y i012rhdu=(copy_fcnm) "MAPFAC_VX" "Map scale factor on v-grid, x direction" "" +-state real msfvx_inv ij misc 1 Y i012rhdu=(copy_fcnm) "MF_VX_INV" "Inverse map scale factor on v-grid, x direction" "" +-state real msfvy ij misc 1 Y i012rhdu=(copy_fcnm) "MAPFAC_VY" "Map scale factor on v-grid, y direction" "" +- +-state real f ij misc 1 - i012rhdu=(copy_fcnm) "f" "Coriolis sine latitude term" "s-1" +-state real e ij misc 1 - i012rhdu=(copy_fcnm) "e" "Coriolis cosine latitude term" "s-1" +-state real sina ij misc 1 - i012rhdu=(copy_fcnm) "SINALPHA" "Local sine of map rotation" "" +-state real cosa ij misc 1 - i012rhdu=(copy_fcnm) "COSALPHA" "Local cosine of map rotation" "" +-state real ht ij misc 1 - i012rhdus "HGT" "Terrain Height" "m" ++state real msft ij misc 1 - i012rdu=(copy_fcnm) "MAPFAC_M" "Map scale factor on mass grid" "" ++state real msfu ij misc 1 X i012rdu=(copy_fcnm) "MAPFAC_U" "Map scale factor on u-grid" "" ++state real msfv ij misc 1 Y i012rdu=(copy_fcnm) "MAPFAC_V" "Map scale factor on v-grid" "" ++state real msftx ij misc 1 - i012rdu=(copy_fcnm) "MAPFAC_MX" "Map scale factor on mass grid, x direction" "" ++state real msfty ij misc 1 - i012rdu=(copy_fcnm) "MAPFAC_MY" "Map scale factor on mass grid, y direction" "" ++state real msfux ij misc 1 X i012rdu=(copy_fcnm) "MAPFAC_UX" "Map scale factor on u-grid, x direction" "" ++state real msfuy ij misc 1 X i012rdu=(copy_fcnm) "MAPFAC_UY" "Map scale factor on u-grid, y direction" "" ++state real msfvx ij misc 1 Y i012rdu=(copy_fcnm) "MAPFAC_VX" "Map scale factor on v-grid, x direction" "" ++state real msfvx_inv ij misc 1 Y i012rdu=(copy_fcnm) "MF_VX_INV" "Inverse map scale factor on v-grid, x direction" "" ++state real msfvy ij misc 1 Y i012rdu=(copy_fcnm) "MAPFAC_VY" "Map scale factor on v-grid, y direction" "" ++ ++state real f ij misc 1 - i012rdu=(copy_fcnm) "f" "Coriolis sine latitude term" "s-1" ++state real e ij misc 1 - i012rdu=(copy_fcnm) "e" "Coriolis cosine latitude term" "s-1" ++state real sina ij misc 1 - i012rdu=(copy_fcnm) "SINALPHA" "Local sine of map rotation" "" ++state real cosa ij misc 1 - i012rdu=(copy_fcnm) "COSALPHA" "Local cosine of map rotation" "" ++state real ht ij misc 1 - i012rdus "HGT" "Terrain Height" "m" + state real ht_fine ij misc 1 - - "HGT_FINE" "Fine Terrain Height" "m" + state real ht_int ij misc 1 - - "HGT_INT" "Terrain Height Horizontally Interpolated" "m" + state real ht_input ij misc 1 - - "HGT_INPUT" "Terrain Height from FG Input File" "m" +-state real ht_shad ijb misc 1 - hdf=(bdy_interp:dt) "HGT_SHAD" "Height of orographic shadow" "m" ++state real ht_shad ijb misc 1 - df=(bdy_interp:dt) "HGT_SHAD" "Height of orographic shadow" "m" + i1 real ht_loc ij misc 1 - - + i1 integer shadowmask ij misc 1 - - + state integer min_ptchsz - misc 1 - r + +-state real TSK ij misc 1 - i012rhdu=(copy_fcnm) "TSK" "SURFACE SKIN TEMPERATURE" "K" ++state real TSK ij misc 1 - i012rdu=(copy_fcnm) "TSK" "SURFACE SKIN TEMPERATURE" "K" + state real dfi_TSK ij misc 1 - r "TSK_dfi" "saved SURFACE SKIN TEMPERATURE" + state real TSK_SAVE ij misc 1 - - "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL" "K" + state real u_base k misc 1 - ir "u_base" "BASE STATE X WIND IN IDEALIZED CASES" "" +@@ -721,9 +890,9 @@ state real v_frame - misc 1 - ir "v + # collision between a metadata name and a field record in the I/O data + # resolve this how? Have the real program throw a switch to tell the code to get it + # from the metadata? Otherwise it's a field? +-state real p_top - misc - - irh "p_top" "PRESSURE TOP OF THE MODEL" "Pa" +-state real max_msftx - misc - - rh "max_mstfx" "Max map factor in domain" "" +-state real max_msfty - misc - - rh "max_mstfy" "Max map factor in domain" "" ++state real p_top - misc - - ir "p_top" "PRESSURE TOP OF THE MODEL" "Pa" ++state real max_msftx - misc - - r "max_mstfx" "Max map factor in domain" "" ++state real max_msfty - misc - - r "max_mstfy" "Max map factor in domain" "" + + # Other physics variables + +@@ -735,14 +904,14 @@ state real RQSCUTEN ikj misc 1 - r "R + state real RQICUTEN ikj misc 1 - r "RQICUTEN" "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME" "Pa kg kg-1 s-1" + state real W0AVG ikj misc 1 - r "W0AVG" "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME" "m s-1" + +-state real RAINC ij misc 1 - rhdu "RAINC" "ACCUMULATED TOTAL CUMULUS PRECIPITATION" "mm" +-state real RAINNC ij misc 1 - rhdu "RAINNC" "ACCUMULATED TOTAL GRID SCALE PRECIPITATION" "mm" +-state real PRATEC ij misc 1 - rh "PRATEC" "PRECIP RATE FROM CUMULUS SCHEME" "mm s-1" +-state real RAINCV ij misc 1 - rh "RAINCV" "TIME-STEP CUMULUS PRECIPITATION" "mm" ++state real RAINC ij misc 1 - rdu "RAINC" "ACCUMULATED TOTAL CUMULUS PRECIPITATION" "mm" ++state real RAINNC ij misc 1 - rdu "RAINNC" "ACCUMULATED TOTAL GRID SCALE PRECIPITATION" "mm" ++state real PRATEC ij misc 1 - r "PRATEC" "PRECIP RATE FROM CUMULUS SCHEME" "mm s-1" ++state real RAINCV ij misc 1 - r "RAINCV" "TIME-STEP CUMULUS PRECIPITATION" "mm" + state real RAINNCV ij misc 1 - r "RAINNCV" "TIME-STEP NONCONVECTIVE PRECIPITATION" "mm" + state real RAINBL ij misc 1 - r "RAINBL" "PBL TIME-STEP TOTAL PRECIPITATION" "mm" +-state real SNOWNC ij misc 1 - rhdu "SNOWNC" "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE" "mm" +-state real GRAUPELNC ij misc 1 - rhdu "GRAUPELNC" "ACCUMULATED TOTAL GRID SCALE GRAUPEL" "mm" ++state real SNOWNC ij misc 1 - rdu "SNOWNC" "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE" "mm" ++state real GRAUPELNC ij misc 1 - rdu "GRAUPELNC" "ACCUMULATED TOTAL GRID SCALE GRAUPEL" "mm" + state real SNOWNCV ij misc 1 - r "SNOWNCV" "TIME-STEP NONCONVECTIVE SNOW AND ICE" "mm" + state real GRAUPELNCV ij misc 1 - r "GRAUPELNCV" "TIME-STEP NONCONVECTIVE GRAUPEL" "mm" + state real NCA ij misc 1 - r "NCA" "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME" "" +@@ -756,7 +925,7 @@ state real apr_as ij misc 1 - r "AP + state real apr_capma ij misc 1 - r "APR_CAPMA" "PRECIP FROM MAX CAP" "mm hour-1" + state real apr_capme ij misc 1 - r "APR_CAPME" "PRECIP FROM MEAN CAP" "mm hour-1" + state real apr_capmi ij misc 1 - r "APR_CAPMI" "PRECIP FROM MIN CAP" "mm hour-1" +-state real edt_out ij misc 1 - h "EDT_OUT" "EDT FROM GD SCHEME" "" ++state real edt_out ij misc 1 - - "EDT_OUT" "EDT FROM GD SCHEME" "" + state real xf_ens ije misc 1 Z r "XF_ENS" "MASS FLUX PDF IN GRELL CUMULUS SCHEME" "mb hour-1" + state real pr_ens ije misc 1 Z r "PR_ENS" "PRECIP RATE PDF IN GRELL CUMULUS SCHEME" "mb hour-1" + state real cugd_tten ikj misc 1 - h "CUGD_TTEN" "INITIAL TTENDENCY OUT OFF GRELL CUMULUS SCHEME" "K s-1" +@@ -775,10 +944,10 @@ state real RTHRATENLW ikj misc 1 - r "R + state real RTHRATENSW ikj misc 1 - r "RTHRATSW" "UNCOUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION" "K s-1" + state real CLDFRA ikj misc 1 - r "CLDFRA" "CLOUD FRACTION" "" + +-state real SWDOWN ij misc 1 - rhd "SWDOWN" "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE" "W m-2" ++state real SWDOWN ij misc 1 - rd "SWDOWN" "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE" "W m-2" + state real SWDOWNC ij misc 1 - - "SWDOWNC" "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE" "W m-2" + state real GSW ij misc 1 - rd "GSW" "NET SHORT WAVE FLUX AT GROUND SURFACE" "W m-2" +-state real GLW ij misc 1 - rhd "GLW" "DOWNWARD LONG WAVE FLUX AT GROUND SURFACE" "W m-2" ++state real GLW ij misc 1 - rd "GLW" "DOWNWARD LONG WAVE FLUX AT GROUND SURFACE" "W m-2" + + # upward and downward clearsky and total diagnostic fluxes for CAM radiation + #state real ACSWUPT ij misc 1 - rhdu "ACSWUPT" "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP" "J m-2" +@@ -816,22 +985,22 @@ state real GLW ij misc 1 - rhd "G + + state real SWCF ij misc 1 - r "SWCF" "SHORT WAVE CLOUD FORCING AT TOA" "W m-2" + state real LWCF ij misc 1 - r "LWCF" "LONG WAVE CLOUD FORCING AT TOA" "W m-2" +-state real OLR ij misc 1 - rh "OLR" "TOA OUTGOING LONG WAVE" "W m-2" ++state real OLR ij misc 1 - r "OLR" "TOA OUTGOING LONG WAVE" "W m-2" + + # these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling + # with wave model, only if compiled with -DMCELIO, JM 2003/05/29 +-state real XLAT ij misc 1 - i0123rh01du=(copy_fcnm) "XLAT" "LATITUDE, SOUTH IS NEGATIVE" "degree_north" +-state real XLONG ij misc 1 - i0123rh01du=(copy_fcnm) "XLONG" "LONGITUDE, WEST IS NEGATIVE" "degree_east" +-state real XLAT_U ij dyn_em 1 X i012rh01du=(copy_fcnm) "XLAT_U" "LATITUDE, SOUTH IS NEGATIVE" "degree_north" +-state real XLONG_U ij dyn_em 1 X i012rh01du=(copy_fcnm) "XLONG_U" "LONGITUDE, WEST IS NEGATIVE" "degree_east" +-state real XLAT_V ij dyn_em 1 Y i012rh01du=(copy_fcnm) "XLAT_V" "LATITUDE, SOUTH IS NEGATIVE" "degree_north" +-state real XLONG_V ij dyn_em 1 Y i012rh01du=(copy_fcnm) "XLONG_V" "LONGITUDE, WEST IS NEGATIVE" "degree_east" +-state real ALBEDO ij misc 1 - rh "ALBEDO" "ALBEDO" ++state real XLAT ij misc 1 - i0123r01du=(copy_fcnm) "XLAT" "LATITUDE, SOUTH IS NEGATIVE" "degree_north" ++state real XLONG ij misc 1 - i0123r01du=(copy_fcnm) "XLONG" "LONGITUDE, WEST IS NEGATIVE" "degree_east" ++state real XLAT_U ij dyn_em 1 X i012r01du=(copy_fcnm) "XLAT_U" "LATITUDE, SOUTH IS NEGATIVE" "degree_north" ++state real XLONG_U ij dyn_em 1 X i012r01du=(copy_fcnm) "XLONG_U" "LONGITUDE, WEST IS NEGATIVE" "degree_east" ++state real XLAT_V ij dyn_em 1 Y i012r01du=(copy_fcnm) "XLAT_V" "LATITUDE, SOUTH IS NEGATIVE" "degree_north" ++state real XLONG_V ij dyn_em 1 Y i012r01du=(copy_fcnm) "XLONG_V" "LONGITUDE, WEST IS NEGATIVE" "degree_east" ++state real ALBEDO ij misc 1 - r "ALBEDO" "ALBEDO" + state real CLAT ij misc 1 - i012rdu=(copy_fcnm) "CLAT" "COMPUTATIONAL GRID LATITUDE, SOUTH IS NEGATIVE" "degree_north" + state real CLONG ij misc 1 - i012rdu=(copy_fcnm) "CLONG" "COMPUTATIONAL GRID LONGITUDE, WEST IS NEGATIVE" "degree_east" +-state real ALBBCK ij misc 1 - i0124rh "ALBBCK" "BACKGROUND ALBEDO" "" ++state real ALBBCK ij misc 1 - i0124r "ALBBCK" "BACKGROUND ALBEDO" "" + state real EMBCK ij misc 1 - r "EMBCK" "BACKGROUND EMISSIVITY" "" +-state real EMISS ij misc 1 - rh "EMISS" "SURFACE EMISSIVITY" "" ++state real EMISS ij misc 1 - r "EMISS" "SURFACE EMISSIVITY" "" + + state real CLDEFI ij misc 1 - r "CLDEFI" "precipitation efficiency in BMJ SCHEME" "" + state integer STEPRA - misc 1 - r "STEPRA" "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS" "" +@@ -869,24 +1038,24 @@ i1 real rho_phy ikj misc 1 - + i1 logical CU_ACT_FLAG ij misc 1 - + + +-state real TMN ij misc 1 - i012rhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TMN" "SOIL TEMPERATURE AT LOWER BOUNDARY" "K" +-state real XLAND ij misc 1 - i02rhd=(interp_fcnm)u=(copy_fcnm) "XLAND" "LAND MASK (1 FOR LAND, 2 FOR WATER)" "" ++state real TMN ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TMN" "SOIL TEMPERATURE AT LOWER BOUNDARY" "K" ++state real XLAND ij misc 1 - i02rd=(interp_fcnm)u=(copy_fcnm) "XLAND" "LAND MASK (1 FOR LAND, 2 FOR WATER)" "" + state real ZNT ij misc 1 - i3r "ZNT" "TIME-VARYING ROUGHNESS LENGTH" "m" + state real CK ij misc 1 - r "CK" "ENTHALPY EXCHANGE COEFF AT 10 m" "" + state real CKA ij misc 1 - r "CKA" "ENTHALPY EXCHANGE COEFF AT LOWEST MODEL LVL" "" + state real CD ij misc 1 - r "CD" "DRAG COEFF AT 10m" "" + state real CDA ij misc 1 - r "CDA" "DRAG COEFF AT LOWEST MODEL LVL" "" +-state real UST ij misc 1 - rh "UST" "U* IN SIMILARITY THEORY" "m s-1" +-state real USTM ij misc 1 - r "USTM" "U* IN SIMILARITY THEORY WITHOUT VCONV" "m s-1" ++state real UST ij misc 1 - r "UST" "U* IN SIMILARITY THEORY" "m s-1" ++state real USTM ij misc 1 - rh "USTM" "U* IN SIMILARITY THEORY WITHOUT VCONV" "m s-1" #SAVEMARS2 ustar + i1 real HOL ij misc 1 - - "HOL" "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH" "" + state real RMOL ij misc 1 - r "RMOL" "1./Monin Ob. Length" "" + state real MOL ij misc 1 - r "MOL" "T* IN SIMILARITY THEORY" "K" +-state real PBLH ij misc 1 - rh "PBLH" "PBL HEIGHT" "m" ++state real PBLH ij misc 1 - r "PBLH" "PBL HEIGHT" "m" + state real CAPG ij misc 1 - r "CAPG" "HEAT CAPACITY FOR SOIL" "J K-1 m-3" + state real THC ij misc 1 - r "THC" "THERMAL INERTIA" "Cal cm-1 K-1 s-0.5" +-state real HFX ij misc 1 - rh "HFX" "UPWARD HEAT FLUX AT THE SURFACE" "W m-2" +-state real QFX ij misc 1 - rh "QFX" "UPWARD MOISTURE FLUX AT THE SURFACE" "kg m-2 s-1" +-state real LH ij misc 1 - rh "LH" "LATENT HEAT FLUX AT THE SURFACE" "W m-2" ++state real HFX ij misc 1 - rh "HFX" "UPWARD HEAT FLUX AT THE SURFACE" "W m-2" #SAVEMARS2 sensheat ++state real QFX ij misc 1 - r "QFX" "UPWARD MOISTURE FLUX AT THE SURFACE" "kg m-2 s-1" ++state real LH ij misc 1 - r "LH" "LATENT HEAT FLUX AT THE SURFACE" "W m-2" + state real FLHC ij misc 1 - r "FLHC" "SURFACE EXCHANGE COEFFICIENT FOR HEAT" "" + state real FLQC ij misc 1 - r "FLQC" "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE" "" + state real QSG ij misc 1 - r "QSG" "SURFACE SATURATION WATER VAPOR MIXING RATIO" "kg kg-1" +@@ -898,7 +1067,7 @@ state real dfi_SOILT1 ij misc 1 - r "S + state real TSNAV ij misc 1 - r "TSNAV" "AVERAGE SNOW TEMPERATURE " "C" + state real dfi_TSNAV ij misc 1 - r "TSNAV_dfi" "AVERAGE SNOW TEMPERATURE " "C" + state real REGIME ij misc 1 - r "REGIME" "FLAGS: 1=Night/Stable, 2=Mechanical Turbulent, 3=Forced Conv, 4=Free Conv" "" +-state real SNOWC ij misc 1 - irhd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SNOWC" "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)" "" ++state real SNOWC ij misc 1 - ird=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SNOWC" "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)" "" + state real dfi_SNOWC ij misc 1 - r "SNOWC_dfi" "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)" "" + state real MAVAIL ij misc 1 - r "MAVAIL" "SURFACE MOISTURE AVAILABILITY" "" + +@@ -992,16 +1161,16 @@ rconfig integer run_days namelist,time_control 1 0 + rconfig integer run_hours namelist,time_control 1 0 irh "run_hours" "NUMBER OF HOURS TO RUN" + rconfig integer run_minutes namelist,time_control 1 0 irh "run_minutes" "NUMBER OF MINUTES TO RUN" + rconfig integer run_seconds namelist,time_control 1 0 irh "run_seconds" "NUMBER OF SECONDS TO RUN" +-rconfig integer start_year namelist,time_control max_domains 1993 irh "start_year" "4 DIGIT YEAR OF START OF MODEL" "YEARS" +-rconfig integer start_month namelist,time_control max_domains 03 irh "start_month" "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS" +-rconfig integer start_day namelist,time_control max_domains 13 irh "start_day" "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS" +-rconfig integer start_hour namelist,time_control max_domains 12 irh "start_hour" "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS" ++rconfig integer start_year namelist,time_control max_domains 2024 irh "start_year" "4 DIGIT YEAR OF START OF MODEL" "YEARS" ++rconfig integer start_month namelist,time_control max_domains 01 irh "start_month" "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS" ++rconfig integer start_day namelist,time_control max_domains 01 irh "start_day" "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS" ++rconfig integer start_hour namelist,time_control max_domains 00 irh "start_hour" "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS" + rconfig integer start_minute namelist,time_control max_domains 00 irh "start_minute" "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES" + rconfig integer start_second namelist,time_control max_domains 00 irh "start_second" "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS" +-rconfig integer end_year namelist,time_control max_domains 1993 irh "end_year" "4 DIGIT YEAR OF END OF MODEL" "YEARS" +-rconfig integer end_month namelist,time_control max_domains 03 irh "end_month" "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS" +-rconfig integer end_day namelist,time_control max_domains 14 irh "end_day" "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS" +-rconfig integer end_hour namelist,time_control max_domains 12 irh "end_hour" "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS" ++rconfig integer end_year namelist,time_control max_domains 2024 irh "end_year" "4 DIGIT YEAR OF END OF MODEL" "YEARS" ++rconfig integer end_month namelist,time_control max_domains 01 irh "end_month" "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS" ++rconfig integer end_day namelist,time_control max_domains 02 irh "end_day" "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS" ++rconfig integer end_hour namelist,time_control max_domains 00 irh "end_hour" "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS" + rconfig integer end_minute namelist,time_control max_domains 00 irh "end_minute" "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES" + rconfig integer end_second namelist,time_control max_domains 00 irh "end_second" "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS" + rconfig integer interval_seconds namelist,time_control 1 43200 irh "interval_seconds" "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS" +@@ -1128,13 +1297,32 @@ rconfig real eta_levels namelist,domains max_eta -1. + rconfig real max_dz namelist,domains 1 1000. + + # Physics ++###### ++###### MARS SPECIFIC NAMELIST ENTRIES ++###### ++rconfig character planet namelist,physics 1 "mars" - "planet" "selection of the planet" "" ++rconfig integer mars namelist,physics max_domains 0 rh "mars" "model mode" "" ++rconfig real init_TI namelist,physics max_domains 0 irh "init_TI" "thermal inertia" "" ++rconfig real init_AL namelist,physics max_domains 0 irh "init_AL" "albedo" "" ++rconfig real init_Z0 namelist,physics max_domains 0 irh "init_Z0" "surface roughness" "" ++rconfig real init_U namelist,physics max_domains 0 irh "init_U" "zonal wind" "" ++rconfig real init_V namelist,physics max_domains 0 irh "init_V" "meridional wind" "" ++rconfig integer init_WX namelist,physics max_domains 0 irh "init_WX" "x coord" "" ++rconfig integer init_WY namelist,physics max_domains 0 irh "init_WY" "y coord" "" ++rconfig real init_MU namelist,physics max_domains 0 irh "init_MU" "zonal wind mult." "" ++rconfig real init_MV namelist,physics max_domains 0 irh "init_MV" "meridional wind mult." "" ++rconfig logical init_LES namelist,physics max_domains .false. irh "init_LES" "LES mode" "" ++rconfig logical modif_wrf namelist,physics max_domains .true. ir "modif_wrf" "true if tweaked WRF" "" ++####### ++####### MARS SPECIFIC NAMELIST ENTRIES ++####### + rconfig integer mp_physics namelist,physics max_domains 0 rh "mp_physics" "" "" + rconfig integer gsfcgce_hail namelist,physics 1 0 rh "gsfcgce select hail/graupel" "" "" + rconfig integer gsfcgce_2ice namelist,physics 1 0 rh "gsfcgce select 2ice/3ice" "" "" + rconfig integer progn namelist,physics max_domains 0 rh "progn" "" "" + rconfig integer ra_lw_physics namelist,physics max_domains 0 rh "ra_lw_physics" "" "" + rconfig integer ra_sw_physics namelist,physics max_domains 0 rh "ra_sw_physics" "" "" +-rconfig real radt namelist,physics max_domains 0 h "RADT" "" "" ++rconfig real radt namelist,physics max_domains 1 h "RADT" "" "" + rconfig real naer namelist,physics max_domains 1e9 rh "NAER" "" "" + rconfig integer sf_sfclay_physics namelist,physics max_domains 0 rh "sf_sfclay_physics" "" "" + rconfig integer sf_surface_physics namelist,physics max_domains 0 rh "sf_surface_physics" "" "" +@@ -1148,7 +1336,7 @@ rconfig integer IFSNOW namelist,physics 1 0 + rconfig integer ICLOUD namelist,physics 1 1 irh "ICLOUD" "" "" + rconfig real swrad_scat namelist,physics 1 1 irh "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD" "" + rconfig integer surface_input_source namelist,physics 1 1 irh "surface_input_source" "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)" "" +-rconfig integer num_soil_layers namelist,physics 1 5 irh "num_soil_layers" "" "" ++rconfig integer num_soil_layers namelist,physics 1 10 irh "num_soil_layers" "" "" + rconfig integer num_months namelist,physics 1 12 irh "num_months" "" "" + rconfig integer maxiens namelist,physics 1 1 irh "maxiens" "" "" + rconfig integer maxens namelist,physics 1 3 irh "maxens" "" "" +@@ -1245,15 +1433,15 @@ rconfig real zdamp namelist,dynamics max_domains 5000. + rconfig real dampcoef namelist,dynamics max_domains 0. h "dampcoef" "" "" + rconfig real khdif namelist,dynamics max_domains 0 h "khdif" "" "" + rconfig real kvdif namelist,dynamics max_domains 0 h "kvdif" "" "" +-rconfig real diff_6th_factor namelist,dynamics max_domains 0.12 h "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion" +-rconfig integer diff_6th_opt namelist,dynamics max_domains 0 irh "diff_6th_opt" "switch for 6th-order numerical diffusion" ++rconfig real diff_6th_factor namelist,dynamics max_domains 0.2 h "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion" ++rconfig integer diff_6th_opt namelist,dynamics max_domains 2 irh "diff_6th_opt" "switch for 6th-order numerical diffusion" + rconfig real c_s namelist,dynamics max_domains 0.25 h "c_s" "Smagorinsky coeff" "" + rconfig real c_k namelist,dynamics max_domains 0.15 h "c_k" "TKE coeff" "" + rconfig real smdiv namelist,dynamics max_domains 0.1 h "smdiv" "" "" + rconfig real emdiv namelist,dynamics max_domains 0.01 h "emdiv" "" "" +-rconfig real epssm namelist,dynamics max_domains .1 h "epssm" "" "" ++rconfig real epssm namelist,dynamics max_domains 0.1 h "epssm" "" "" + rconfig logical non_hydrostatic namelist,dynamics max_domains .true. irh "non_hydrostatic" "" "" +-rconfig integer time_step_sound namelist,dynamics max_domains 0 h "time_step_sound" "" "" ++rconfig integer time_step_sound namelist,dynamics max_domains 6 h "time_step_sound" "" "" + rconfig integer h_mom_adv_order namelist,dynamics max_domains 5 rh "h_mom_adv_order" "" "" + rconfig integer v_mom_adv_order namelist,dynamics max_domains 3 rh "v_mom_adv_order" "" "" + rconfig integer h_sca_adv_order namelist,dynamics max_domains 5 rh "h_sca_adv_order" "" "" +@@ -1261,7 +1449,7 @@ rconfig integer v_sca_adv_order namelist,dynamics max_domains 3 + rconfig logical pd_moist namelist,dynamics max_domains .false. rh "pd_moist" "positive-definite RK3 transport switch" "" + rconfig logical pd_moist_dfi namelist,dynamics max_domains .false. rh "pd_moist_dfi" "positive-definite RK3 transport switch" "" + rconfig logical pd_chem namelist,dynamics max_domains .false. rh "pd_chem" "positive-definite RK3 transport switch" "" +-rconfig logical pd_scalar namelist,dynamics max_domains .false. rh "pd_scalar" "positive-definite RK3 transport switch" "" ++rconfig logical pd_scalar namelist,dynamics max_domains .true. rh "pd_scalar" "positive-definite RK3 transport switch" "" + rconfig logical pd_tke namelist,dynamics max_domains .false. rh "pd_tke" "positive-definite RK3 transport switch" "" + rconfig logical top_radiation namelist,dynamics max_domains .false. rh "top_radiation" "" "" + rconfig integer mix_isotropic namelist,dynamics max_domains 0 h "mix_isotropic" "0=anistropic, 1=isotropic" "" +@@ -1339,6 +1527,39 @@ state integer nodyn_dummy - dyn_nodyn - - - "" "" "" + #key package associated package associated 4d scalars + # name namelist choice state vars + ++ ++##### MARS OPTIONS ++##### MARS OPTIONS ++##### MARS OPTIONS ++## ++## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF ++## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION ++## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION ++## ------- ++## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE ++## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS ++## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...) ++## ------- ++## ++## ++package default mars==0 - - ++package water mars==1 - scalar:qh2o,qh2o_ice ++package dust1 mars==2 - scalar:qdust ++package dust2eq mars==3 - scalar:qdust,qdustn ++package newbasis mars==10 - scalar:qco2 ++package newwater mars==11 - scalar:qh2o,qh2o_ice,qdust,qdustn ++package newwatersca mars==12 - scalar:qh2o,qh2o_ice,qdust,qdustn,qccn,qccnn ++package radioac mars==20 - scalar:qtrac1 ++package VenusPC mars==34 - scalar:qco2,qco,qh2,qh2o,qo1d,qo,qo2,qo2dg,qo3,qh,qoh,qho2,qh2o2,qcl,qclo,qcl2,qhcl,qhocl,qclco,qclco3,qcocl2,qss,qso,qso2,qso3,qs2o2,qocs,qhso3,qh2so4,qs2,qclso2,qoscl,qh2oliq,qh2so4liq ++package waterdyn mars==42 - scalar:qh2o,qh2o_ice;moist:qv,qc ++package zemoist mars==51 - moist:qv;scalar:qh2o_ice ++##### MARS OPTIONS ++##### MARS OPTIONS ++##### MARS OPTIONS ++ ++ ++ ++ + #package passivec1 chem_opt==0 - + package passiveqv mp_physics==0 - moist:qv + package kesslerscheme mp_physics==1 - moist:qv,qc,qr +diff --git a/WRF.COMMON/WRFV3/arch/configure_new.defaults b/WRF.COMMON/WRFV3/arch/configure_new.defaults +index 68f3a95e..a7828a0c 100644 +--- a/WRF.COMMON/WRFV3/arch/configure_new.defaults ++++ b/WRF.COMMON/WRFV3/arch/configure_new.defaults +@@ -414,8 +414,8 @@ OMPCPP = # -D_OPENMP + OMP = # -fopenmp + SFC = gfortran + SCC = gcc +-DM_FC = mpif90 -f90=$(SFC) +-DM_CC = mpicc -cc=$(SCC) ++DM_FC = mpif90 ++DM_CC = mpicc + FC = CONFIGURE_FC + CC = CONFIGURE_CC + LD = $(FC) +diff --git a/WRF.COMMON/WRFV3/dyn_em/Makefile b/WRF.COMMON/WRFV3/dyn_em/Makefile +index 8b9bedbc..6d78dab8 100644 +--- a/WRF.COMMON/WRFV3/dyn_em/Makefile ++++ b/WRF.COMMON/WRFV3/dyn_em/Makefile +@@ -242,16 +242,11 @@ solve_em.o: module_small_step_em.o \ + ../share/module_llxy.o \ + ../share/module_model_constants.o \ + ../share/module_bc.o \ +- ../phys/module_microphysics_driver.o \ +- ../phys/module_microphysics_zero_out.o \ + ../phys/module_physics_addtendc.o + ++### pas sur + module_first_rk_step_part1.o : \ +- ../phys/module_radiation_driver.o \ +- ../phys/module_surface_driver.o \ +- ../phys/module_cumulus_driver.o \ +- ../phys/module_pbl_driver.o \ +- ../phys/module_fddagd_driver.o ++ ../phys/module_lmd_driver.o + + module_first_rk_step_part2.o : \ + module_diffusion_em.o \ +@@ -261,8 +256,7 @@ module_first_rk_step_part2.o : \ + ../frame/module_driver_constants.o \ + ../frame/module_configure.o \ + ../frame/module_dm.o \ +- ../share/module_bc.o \ +- ../phys/module_fddaobs_driver.o ++ ../share/module_bc.o + + adapt_timestep_em.o: \ + module_bc_em.o \ +diff --git a/WRF.COMMON/WRFV3/dyn_em/module_big_step_utilities_em.F b/WRF.COMMON/WRFV3/dyn_em/module_big_step_utilities_em.F +index 523d9433..a0c95691 100644 +--- a/WRF.COMMON/WRFV3/dyn_em/module_big_step_utilities_em.F ++++ b/WRF.COMMON/WRFV3/dyn_em/module_big_step_utilities_em.F +@@ -4346,10 +4346,10 @@ END SUBROUTINE pole_point_bc + !====================================================================== + + SUBROUTINE phy_prep ( config_flags, & ! input +- mu, muu, muv, u, v, p, pb, alt, ph, & ! input ++ mu, muu, muv, u, v, w, p, pb, alt, ph, & ! input + phb, t, tsk, moist, n_moist, & ! input + mu_3d, rho, th_phy, p_phy , pi_phy , & ! output +- u_phy, v_phy, p8w, t_phy, t8w, & ! output ++ u_phy, v_phy, w_phy, p8w, t_phy, t8w, & ! output + z, z_at_w, dz8w, & ! output + fzm, fzp, & ! params + RTHRATEN, & +@@ -4382,6 +4382,7 @@ END SUBROUTINE pole_point_bc + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & + INTENT( OUT) :: u_phy, & + v_phy, & ++ w_phy, & + pi_phy, & + p_phy, & + p8w, & +@@ -4399,6 +4400,7 @@ END SUBROUTINE pole_point_bc + p, & + u, & + v, & ++ w, & + alt, & + ph, & + phb, & +@@ -4472,7 +4474,12 @@ END SUBROUTINE pole_point_bc + th_phy(i,k,j) = t(i,k,j) + t0 + p_phy(i,k,j) = p(i,k,j) + pb(i,k,j) + pi_phy(i,k,j) = (p_phy(i,k,j)/p1000mb)**rcp +- t_phy(i,k,j) = th_phy(i,k,j)*pi_phy(i,k,j) ++ !! TAKE INTO ACCOUNT cp=f(T) on Venus ++ IF (planet.eq. "venus" ) THEN ++ t_phy(i,k,j)= (th_phy(i,k,j)**nu - nu*(TT00**nu)*log((p1000mb/p_phy(i,k,j))**rcp))**(1/nu) ++ ELSE ++ t_phy(i,k,j) = th_phy(i,k,j)*pi_phy(i,k,j) ++ ENDIF + rho(i,k,j) = 1./alt(i,k,j)*(1.+moist(i,k,j,P_QV)) + mu_3d(i,k,j) = mu(i,j) + u_phy(i,k,j) = 0.5*(u(i,k,j)+u(i+1,k,j)) +@@ -4511,7 +4518,9 @@ END SUBROUTINE pole_point_bc + do j = j_start,j_end + do k = k_start, k_end + do i = i_start, i_end +- z(i,k,j) = 0.5*(z_at_w(i,k,j) +z_at_w(i,k+1,j) ) ++ z(i,k,j) = 0.5*(z_at_w(i,k,j) + z_at_w(i,k+1,j) ) ++!!!! MARS MARS ajout aymeric (ainsi que les arguments de cette routine) ++ w_phy(i,k,j) = 0.5*(w(i,k,j) + w(i,k+1,j) ) + enddo + enddo + enddo +@@ -4635,8 +4644,11 @@ END SUBROUTINE pole_point_bc + + ENDIF + +- IF (config_flags%bl_pbl_physics .gt. 0) THEN +- ++!!MARS MARS ++! IF (config_flags%bl_pbl_physics .gt. 0) THEN ++ IF ( (config_flags%bl_pbl_physics .gt. 0) & ++ .OR. (config_flags%modif_wrf) ) THEN ++!****MARS + DO J=j_start,j_end + DO K=k_start,k_end + DO I=i_start,i_end +diff --git a/WRF.COMMON/WRFV3/dyn_em/module_diffusion_em.F b/WRF.COMMON/WRFV3/dyn_em/module_diffusion_em.F +index 79b07942..3c8caa5c 100644 +--- a/WRF.COMMON/WRFV3/dyn_em/module_diffusion_em.F ++++ b/WRF.COMMON/WRFV3/dyn_em/module_diffusion_em.F +@@ -4443,7 +4443,9 @@ SUBROUTINE phy_bc ( config_flags,div,defor11,defor22,defor33, & + ! End declarations. + !----------------------------------------------------------------------- + +- IF(config_flags%bl_pbl_physics .GT. 0) THEN ++ IF( (config_flags%bl_pbl_physics .GT. 0) & ++ .OR. (config_flags%modif_wrf) ) THEN ++!****MARS: Always do that ?? > yes, for periodic simu -- grep in share + + CALL set_physical_bc3d( RUBLTEN , 't', config_flags, & + ids, ide, jds, jde, kds, kde, & +@@ -4755,6 +4757,7 @@ END SUBROUTINE phy_bc + ! set in namelist.input + ! LES mods + K=KTS ++ PRINT *, 'USE constant H/rho/cp : e.g. value of Hs ', heat_flux0*cp*rho(i_start,k,j_start) + DO j = j_start, j_end + DO i = i_start, i_end + heat_flux = heat_flux0 +@@ -4765,6 +4768,7 @@ END SUBROUTINE phy_bc + ENDDO + + CASE (1) ! use surface heat flux computed from surface routine ++ PRINT *, 'USE surface heat flux from PHYSICS', hfx(i_start,j_start) + K=KTS + DO j = j_start, j_end + DO i = i_start, i_end +@@ -5167,6 +5171,7 @@ END SUBROUTINE phy_bc + + CASE (1,2) ! ustar computed from surface routine + ++ PRINT *, 'USE u star (surf drag) from PHYSICS', ust(i_start,j_start) + DO j = j_start, j_end + DO i = i_start, i_end + +diff --git a/WRF.COMMON/WRFV3/dyn_em/module_em.F b/WRF.COMMON/WRFV3/dyn_em/module_em.F +index 73f73371..acf92c56 100644 +--- a/WRF.COMMON/WRFV3/dyn_em/module_em.F ++++ b/WRF.COMMON/WRFV3/dyn_em/module_em.F +@@ -570,7 +570,10 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +- pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN ++! pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN ++!!!****MARS: vertical diffusion is done in the physics (TODO: consider the nonhydrostatic case ?) ++ pbl_test : IF ( (config_flags%bl_pbl_physics .eq. 0) & ++ .AND. (.not. config_flags%modif_wrf) ) THEN + + CALL vertical_diffusion_u ( u, ru_tendf, config_flags, & + u_base, & +@@ -948,7 +951,10 @@ SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +- pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN ++!!!****MARS: done in the physics ++ pbl_test : IF ( (config_flags%bl_pbl_physics .eq. 0) & ++ .AND. (.not. config_flags%modif_wrf) ) THEN ++! pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN + + IF( (moist_step) .and. ( im == P_QV)) THEN + +@@ -1601,7 +1607,9 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & + + ! pbl + +- IF (config_flags%bl_pbl_physics .gt. 0) THEN ++! IF (config_flags%bl_pbl_physics .gt. 0) THEN ++!!****MARS ++ IF ( (config_flags%bl_pbl_physics .gt. 0) .OR. (config_flags%modif_wrf) ) THEN + + DO J=jts,jtf + DO K=kts,ktf +diff --git a/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part1.F b/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part1.F +index 2383e8bd..f7d5b539 100644 +--- a/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part1.F ++++ b/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part1.F +@@ -31,12 +31,17 @@ CONTAINS + USE module_model_constants + USE module_domain, ONLY : domain + USE module_configure, ONLY : grid_config_rec_type, model_config_rec +- USE module_radiation_driver, ONLY : pre_radiation_driver, radiation_driver +- USE module_surface_driver, ONLY : surface_driver +- USE module_cumulus_driver, ONLY : cumulus_driver +- USE module_pbl_driver, ONLY : pbl_driver +- USE module_fddagd_driver, ONLY : fddagd_driver ++!!!!****MARS MARS ++!!!!****MARS MARS ++! USE module_radiation_driver, ONLY : pre_radiation_driver, radiation_driver ++! USE module_surface_driver, ONLY : surface_driver ++! USE module_cumulus_driver, ONLY : cumulus_driver ++! USE module_pbl_driver, ONLY : pbl_driver ++! USE module_fddagd_driver, ONLY : fddagd_driver + USE module_em, ONLY : init_zero_tendency ++!!MARS ++ USE module_lmd_driver ++!!MARS + USE module_big_step_utilities_em, ONLY : phy_prep + USE module_dm + IMPLICIT NONE +@@ -74,6 +79,7 @@ CONTAINS + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: u_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: v_phy ++ REAL ,DIMENSION(ims:ime,kms:kme,jms:jme) :: w_phy !!MARS aymeric var loc + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: dz8w + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p8w + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t8w +@@ -143,10 +149,10 @@ BENCH_END(init_zero_tend_tim) + CALL wrf_debug ( 200 , ' call phy_prep' ) + CALL phy_prep ( config_flags, & + grid%mut, grid%muu, grid%muv, grid%u_2, & +- grid%v_2, grid%p, grid%pb, grid%alt, & ++ grid%v_2, grid%w_2, grid%p, grid%pb, grid%alt, & + grid%ph_2, grid%phb, grid%t_2, grid%tsk, moist, num_moist, & + mu_3d, rho, & +- th_phy, p_phy, pi_phy, u_phy, v_phy, & ++ th_phy, p_phy, pi_phy, u_phy, v_phy, w_phy, & + p8w, t_phy, t8w, grid%z, z_at_w, & + dz8w, grid%fnm, grid%fnp, & + grid%rthraten, & +@@ -167,394 +173,527 @@ BENCH_END(init_zero_tend_tim) + + BENCH_END(phy_prep_tim) + +-! radiation ++!!!!****MARS MARS ++!!!!****MARS MARS + +-! this driver is only needed to handle non-local shadowing effects +- CALL pre_radiation_driver ( grid, config_flags & +- & ,itimestep=grid%itimestep, ra_call_offset=grid%ra_call_offset & +- & ,XLAT=grid%xlat, XLONG=grid%xlong, GMT=grid%gmt & +- & ,julian=grid%julian, xtime=grid%xtime, RADT=grid%radt & +- & ,STEPRA=grid%stepra & +- & ,ht=grid%ht,dx=grid%dx,dy=grid%dy,sina=grid%sina,cosa=grid%cosa & +- & ,shadowmask=shadowmask,slope_rad=config_flags%slope_rad & +- & ,topo_shading=config_flags%topo_shading & +- & ,shadlen=config_flags%shadlen,ht_shad=grid%ht_shad,ht_loc=ht_loc & +- & ,ht_shad_bxs=grid%ht_shad_bxs, ht_shad_bxe=grid%ht_shad_bxe & +- & ,ht_shad_bys=grid%ht_shad_bys, ht_shad_bye=grid%ht_shad_bye & +- & ,nested=config_flags%nested, min_ptchsz=grid%min_ptchsz & +- & ,spec_bdy_width=config_flags%spec_bdy_width & +- ! indexes +- & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & +- & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & +- & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe & +- & ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1) & +- & ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1) & +- & ,kts=k_start, kte=min(k_end,kde-1) & +- & ,num_tiles=grid%num_tiles ) +- +- CALL wrf_debug ( 200 , ' call radiation_driver' ) +-BENCH_START(rad_driver_tim) +- +- CALL radiation_driver( & +- & ACFRCV=grid%acfrcv ,ACFRST=grid%acfrst ,ALBEDO=grid%albedo & +- & ,CFRACH=grid%cfrach ,CFRACL=grid%cfracl ,CFRACM=grid%cfracm & +- & ,CUPPT=grid%cuppt ,CZMEAN=grid%czmean ,DT=grid%dt & +- & ,DZ8W=dz8w ,EMISS=grid%emiss ,GLW=grid%glw & +- & ,GMT=grid%gmt ,GSW=grid%gsw ,HBOT=grid%hbot & +- & ,HTOP=grid%htop ,HBOTR=grid%hbotr ,HTOPR=grid%htopr & +- & ,ICLOUD=config_flags%icloud & +- & ,ITIMESTEP=grid%itimestep,JULDAY=grid%julday , JULIAN=grid%julian & +- & ,JULYR=grid%julyr ,LW_PHYSICS=config_flags%ra_lw_physics & +- & ,NCFRCV=grid%ncfrcv ,NCFRST=grid%ncfrst ,NPHS=1 & +- & ,P8W=p8w ,P=p_phy ,PI=pi_phy & +- & ,RADT=grid%radt ,RA_CALL_OFFSET=grid%ra_call_offset & +- & ,RHO=rho ,RLWTOA=grid%rlwtoa & +- & ,RSWTOA=grid%rswtoa ,RTHRATEN=grid%rthraten & +- & ,RTHRATENLW=grid%rthratenlw ,RTHRATENSW=grid%rthratensw & +- & ,SNOW=grid%snow ,STEPRA=grid%stepra ,SWDOWN=grid%swdown & +- & ,SWDOWNC=grid%swdownc ,SW_PHYSICS=config_flags%ra_sw_physics & +- & ,T8W=t8w ,T=t_phy ,TAUCLDC=grid%taucldc & +- & ,TAUCLDI=grid%taucldi ,TSK=grid%tsk ,VEGFRA=grid%vegfra & +- & ,WARM_RAIN=grid%warm_rain ,XICE=grid%xice ,XLAND=grid%xland & +- & ,XLAT=grid%xlat ,XLONG=grid%xlong & +-!Optional urban +- & ,DECLIN_URB=grid%declin_urb ,COSZ_URB2D=grid%cosz_urb2d & +- & ,OMG_URB2D=grid%omg_urb2d & ++!! radiation + ! +- & ,Z=grid%z & +- & ,LEVSIZ=grid%levsiz, N_OZMIXM=num_ozmixm & +- & ,N_AEROSOLC=num_aerosolc & +- & ,PAERLEV=grid%paerlev & +- & ,CAM_ABS_DIM1=grid%cam_abs_dim1, CAM_ABS_DIM2=grid%cam_abs_dim2 & +- & ,CAM_ABS_FREQ_S=grid%cam_abs_freq_s & +- & ,XTIME=grid%xtime & +- ,CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag & +- ! indexes ++!! this driver is only needed to handle non-local shadowing effects ++! CALL pre_radiation_driver ( grid, config_flags & ++! & ,itimestep=grid%itimestep, ra_call_offset=grid%ra_call_offset & ++! & ,XLAT=grid%xlat, XLONG=grid%xlong, GMT=grid%gmt & ++! & ,julian=grid%julian, xtime=grid%xtime, RADT=grid%radt & ++! & ,STEPRA=grid%stepra & ++! & ,ht=grid%ht,dx=grid%dx,dy=grid%dy,sina=grid%sina,cosa=grid%cosa & ++! & ,shadowmask=shadowmask,slope_rad=config_flags%slope_rad & ++! & ,topo_shading=config_flags%topo_shading & ++! & ,shadlen=config_flags%shadlen,ht_shad=grid%ht_shad,ht_loc=ht_loc & ++! & ,ht_shad_bxs=grid%ht_shad_bxs, ht_shad_bxe=grid%ht_shad_bxe & ++! & ,ht_shad_bys=grid%ht_shad_bys, ht_shad_bye=grid%ht_shad_bye & ++! & ,nested=config_flags%nested, min_ptchsz=grid%min_ptchsz & ++! & ,spec_bdy_width=config_flags%spec_bdy_width & ++! ! indexes ++! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & ++! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & ++! & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe & ++! & ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1) & ++! & ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1) & ++! & ,kts=k_start, kte=min(k_end,kde-1) & ++! & ,num_tiles=grid%num_tiles ) ++! ++! CALL wrf_debug ( 200 , ' call radiation_driver' ) ++!BENCH_START(rad_driver_tim) ++! ++! CALL radiation_driver( & ++! & ACFRCV=grid%acfrcv ,ACFRST=grid%acfrst ,ALBEDO=grid%albedo & ++! & ,CFRACH=grid%cfrach ,CFRACL=grid%cfracl ,CFRACM=grid%cfracm & ++! & ,CUPPT=grid%cuppt ,CZMEAN=grid%czmean ,DT=grid%dt & ++! & ,DZ8W=dz8w ,EMISS=grid%emiss ,GLW=grid%glw & ++! & ,GMT=grid%gmt ,GSW=grid%gsw ,HBOT=grid%hbot & ++! & ,HTOP=grid%htop ,HBOTR=grid%hbotr ,HTOPR=grid%htopr & ++! & ,ICLOUD=config_flags%icloud & ++! & ,ITIMESTEP=grid%itimestep,JULDAY=grid%julday , JULIAN=grid%julian & ++! & ,JULYR=grid%julyr ,LW_PHYSICS=config_flags%ra_lw_physics & ++! & ,NCFRCV=grid%ncfrcv ,NCFRST=grid%ncfrst ,NPHS=1 & ++! & ,P8W=p8w ,P=p_phy ,PI=pi_phy & ++! & ,RADT=grid%radt ,RA_CALL_OFFSET=grid%ra_call_offset & ++! & ,RHO=rho ,RLWTOA=grid%rlwtoa & ++! & ,RSWTOA=grid%rswtoa ,RTHRATEN=grid%rthraten & ++! & ,RTHRATENLW=grid%rthratenlw ,RTHRATENSW=grid%rthratensw & ++! & ,SNOW=grid%snow ,STEPRA=grid%stepra ,SWDOWN=grid%swdown & ++! & ,SWDOWNC=grid%swdownc ,SW_PHYSICS=config_flags%ra_sw_physics & ++! & ,T8W=t8w ,T=t_phy ,TAUCLDC=grid%taucldc & ++! & ,TAUCLDI=grid%taucldi ,TSK=grid%tsk ,VEGFRA=grid%vegfra & ++! & ,WARM_RAIN=grid%warm_rain ,XICE=grid%xice ,XLAND=grid%xland & ++! & ,XLAT=grid%xlat ,XLONG=grid%xlong & ++!!Optional urban ++! & ,DECLIN_URB=grid%declin_urb ,COSZ_URB2D=grid%cosz_urb2d & ++! & ,OMG_URB2D=grid%omg_urb2d & ++!! ++! & ,Z=grid%z & ++! & ,LEVSIZ=grid%levsiz, N_OZMIXM=num_ozmixm & ++! & ,N_AEROSOLC=num_aerosolc & ++! & ,PAERLEV=grid%paerlev & ++! & ,CAM_ABS_DIM1=grid%cam_abs_dim1, CAM_ABS_DIM2=grid%cam_abs_dim2 & ++! & ,CAM_ABS_FREQ_S=grid%cam_abs_freq_s & ++! & ,XTIME=grid%xtime & ++! ,CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag & ++! ! indexes ++! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & ++! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & ++! & ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1) & ++! & ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1) & ++! & ,kts=k_start, kte=min(k_end,kde-1) & ++! & ,num_tiles=grid%num_tiles & ++! ! Optional ++! & , CLDFRA=grid%cldfra & ++! & , PB=grid%pb & ++! & , F_ICE_PHY=grid%f_ice_phy,F_RAIN_PHY=grid%f_rain_phy & ++! & , QV=moist(ims,kms,jms,P_QV), F_QV=F_QV & ++! & , QC=moist(ims,kms,jms,P_QC), F_QC=F_QC & ++! & , QR=moist(ims,kms,jms,P_QR), F_QR=F_QR & ++! & , QI=moist(ims,kms,jms,P_QI), F_QI=F_QI & ++! & , QS=moist(ims,kms,jms,P_QS), F_QS=F_QS & ++! & , QG=moist(ims,kms,jms,P_QG), F_QG=F_QG & ++! & , QNDROP=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP & ++!#ifdef ACFLUX ++! & ,ACSWUPT=acswupt ,ACSWUPTC=acswuptc & ++! & ,ACSWDNT=acswdnt ,ACSWDNTC=acswdntc & ++! & ,ACSWUPB=acswupb ,ACSWUPBC=acswupbc & ++! & ,ACSWDNB=acswdnb ,ACSWDNBC=acswdnbc & ++! & ,ACLWUPT=aclwupt ,ACLWUPTC=aclwuptc & ++! & ,ACLWDNT=aclwdnt ,ACLWDNTC=aclwdntc & ++! & ,ACLWUPB=aclwupb ,ACLWUPBC=aclwupbc & ++! & ,ACLWDNB=aclwdnb ,ACLWDNBC=aclwdnbc & ++! & ,SWUPT=swupt ,SWUPTC=swuptc & ++! & ,SWDNT=swdnt ,SWDNTC=swdntc & ++! & ,SWUPB=swupb ,SWUPBC=swupbc & ++! & ,SWDNB=swdnb ,SWDNBC=swdnbc & ++! & ,LWUPT=lwupt ,LWUPTC=lwuptc & ++! & ,LWDNT=lwdnt ,LWDNTC=lwdntc & ++! & ,LWUPB=lwupb ,LWUPBC=lwupbc & ++! & ,LWDNB=lwdnb ,LWDNBC=lwdnbc & ++!#endif ++! & ,LWCF=grid%lwcf & ++! & ,SWCF=grid%swcf & ++! & ,OLR=grid%olr & ++! & ,OZMIXM=grid%ozmixm, PIN=grid%pin & ++! & ,M_PS_1=grid%m_ps_1, M_PS_2=grid%m_ps_2, AEROSOLC_1=grid%aerosolc_1 & ++! & ,AEROSOLC_2=grid%aerosolc_2, M_HYBI0=grid%m_hybi & ++! & ,ABSTOT=grid%abstot, ABSNXT=grid%absnxt, EMSTOT=grid%emstot & ++!#ifdef WRF_CHEM ++! & ,CU_RAD_FEEDBACK=config_flags%cu_rad_feedback & ++! & ,AER_RA_FEEDBACK=config_flags%aer_ra_feedback & ++! & ,QC_ADJUST=grid%GD_CLOUD_B , QI_ADJUST=grid%GD_CLOUD2_B & ++! & ,PM2_5_DRY=grid%pm2_5_dry, PM2_5_WATER=grid%pm2_5_water & ++! & ,PM2_5_DRY_EC=grid%pm2_5_dry_ec & ++! & ,TAUAER300=grid%tauaer1, TAUAER400=grid%tauaer2 & ! jcb ++! & ,TAUAER600=grid%tauaer3, TAUAER999=grid%tauaer4 & ! jcb ++! & ,GAER300=grid%gaer1, GAER400=grid%gaer2, GAER600=grid%gaer3, GAER999=grid%gaer4 & ! jcb ++! & ,WAER300=grid%waer1, WAER400=grid%waer2, WAER600=grid%waer3, WAER999=grid%waer4 & ! jcb ++!#endif ++! & ,slope_rad=config_flags%slope_rad,topo_shading=config_flags%topo_shading & ++! & ,shadowmask=shadowmask,ht=grid%ht,dx=grid%dx,dy=grid%dy,sina=grid%sina,cosa=grid%cosa ) ++! ++!BENCH_END(rad_driver_tim) ++! ++!!********* Surface driver ++!! surface ++! ++!BENCH_START(surf_driver_tim) ++! ++!!----------------------------------------------------------------- ++!! urban related variable are added to arguments of surface_driver ++!!----------------------------------------------------------------- ++! num_roof_layers = grid%num_soil_layers !urban ++! num_wall_layers = grid%num_soil_layers !urban ++! num_road_layers = grid%num_soil_layers !urban ++! CALL nl_get_iswater(grid%id, iswater) ++! ++! CALL wrf_debug ( 200 , ' call surface_driver' ) ++! ++! CALL surface_driver( & ++! & ACSNOM=grid%acsnom ,ACSNOW=grid%acsnow ,AKHS=grid%akhs & ++! & ,AKMS=grid%akms ,ALBBCK=grid%albbck ,ALBEDO=grid%albedo & ++! & ,EMBCK=grid%embck & ++! & ,BR=br ,CANWAT=grid%canwat ,CHKLOWQ=chklowq & ++! & ,CT=grid%ct ,DT=grid%dt ,DX=grid%dx & ++! & ,DZ8W=dz8w ,DZS=grid%dzs ,FLHC=grid%flhc & ++! & ,FLQC=grid%flqc ,GLW=grid%glw ,GRDFLX=grid%grdflx & ++! & ,GSW=grid%gsw ,SWDOWN=grid%swdown ,GZ1OZ0=gz1oz0 ,HFX=grid%hfx & ++! & ,HT=grid%ht ,IFSNOW=config_flags%ifsnow ,ISFFLX=config_flags%isfflx & ++! & ,ISLTYP=grid%isltyp ,ITIMESTEP=grid%itimestep & ++! & ,IVGTYP=grid%ivgtyp ,LH=grid%lh ,LOWLYR=grid%lowlyr & ++! & ,MAVAIL=grid%mavail ,NUM_SOIL_LAYERS=config_flags%num_soil_layers & ++! & ,P8W=p8w ,PBLH=grid%pblh ,PI_PHY=pi_phy & ++! & ,PSFC=grid%psfc ,PSHLTR=grid%pshltr ,PSIH=psih & ++! & ,BLDT=grid%bldt ,CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag & ++! & ,PSIM=psim ,P_PHY=p_phy ,Q10=grid%q10 & ++! & ,Q2=grid%q2 ,QFX=grid%qfx ,QSFC=grid%qsfc & ++! & ,QSHLTR=grid%qshltr ,QZ0=grid%qz0 ,RAINCV=grid%raincv & ++! & ,RA_LW_PHYSICS=config_flags%ra_lw_physics ,RHO=rho & ++! & ,RMOL=grid%rmol ,SFCEVP=grid%sfcevp ,SFCEXC=grid%sfcexc & ++! & ,SFCRUNOFF=grid%sfcrunoff & ++! & ,SF_SFCLAY_PHYSICS=config_flags%sf_sfclay_physics & ++! & ,SF_SURFACE_PHYSICS=config_flags%sf_surface_physics ,SH2O=grid%sh2o & ++! & ,SHDMAX=grid%shdmax ,SHDMIN=grid%shdmin ,SMOIS=grid%smois & ++! & ,SMSTAV=grid%smstav ,SMSTOT=grid%smstot ,SNOALB=grid%snoalb & ++! & ,SNOW=grid%snow ,SNOWC=grid%snowc ,SNOWH=grid%snowh & ++! & ,SST=grid%sst ,SST_UPDATE=grid%sst_update & ++! & ,STEPBL=grid%stepbl ,TH10=grid%th10 ,TH2=grid%th2 & ++! & ,THZ0=grid%thz0 ,TH_PHY=th_phy ,TKE_MYJ=grid%tke_myj & ++! & ,TMN=grid%tmn ,TSHLTR=grid%tshltr ,TSK=grid%tsk & ++! & ,TSLB=grid%tslb ,T_PHY=t_phy ,U10=grid%u10 & ++! & ,URATX=grid%uratx ,VRATX=grid%vratx ,TRATX=grid%tratx & ++! & ,UDRUNOFF=grid%udrunoff ,UST=grid%ust ,UZ0=grid%uz0 & ++! & ,U_FRAME=grid%u_frame ,U_PHY=u_phy ,V10=grid%v10 & ++! & ,VEGFRA=grid%vegfra ,VZ0=grid%vz0 ,V_FRAME=grid%v_frame & ++! & ,V_PHY=v_phy ,WARM_RAIN=grid%warm_rain & ++! & ,WSPD=wspd ,XICE=grid%xice ,XLAND=grid%xland & ++! & ,Z0=grid%z0 ,Z=grid%z ,ZNT=grid%znt & ++! & ,ZS=grid%zs ,XICEM=grid%xicem ,ISICE=grid%landuse_isice& ++! & ,USTM=grid%ustm ,CK=grid%ck ,CKA=grid%cka & ++! & ,CD=grid%cd ,CDA=grid%cda & ++! & ,ISFTCFLX=config_flags%isftcflx & ++! & ,OMLCALL=config_flags%omlcall ,OML_HML0=config_flags%oml_hml0 ,OML_GAMMA=config_flags%oml_gamma & ++! & ,TML=grid%tml, T0ML=grid%t0ml, HML=grid%hml, H0ML=grid%h0ml, HUML=grid%huml, HVML=grid%hvml, F=grid%f & ++! & ,ISWATER=iswater & ++! & ,DECLIN_URB=grid%declin_urb ,COSZ_URB2D=grid%cosz_urb2d & !I urban ++! & ,OMG_URB2D=grid%omg_urb2d ,xlat_urb2d=grid%XLAT & !I urban ++! & ,NUM_ROOF_LAYERS=num_roof_layers & !I urban ++! & ,NUM_WALL_LAYERS=num_wall_layers & !I urban ++! & ,NUM_ROAD_LAYERS=num_road_layers & ++! & ,DZR=grid%dzr ,DZB=grid%dzb ,DZG=grid%dzg & !I urban ++! & ,TR_URB2D=grid%tr_urb2d ,TB_URB2D=grid%tb_urb2d & ++! & ,TG_URB2D=grid%tg_urb2d & !H urban ++! & ,TC_URB2D=grid%tc_urb2d ,QC_URB2D=grid%qc_urb2d & !H urban ++! & ,UC_URB2D=grid%uc_urb2d & !H urban ++! & ,XXXR_URB2D=grid%xxxr_urb2d & ++! & ,XXXB_URB2D=grid%xxxb_urb2d & !H urban ++! & ,XXXG_URB2D=grid%xxxg_urb2d & ++! & ,XXXC_URB2D=grid%xxxc_urb2d & !H urban ++! & ,TRL_URB3D=grid%trl_urb3d ,TBL_URB3D=grid%tbl_urb3d & !H urban ++! & ,TGL_URB3D=grid%tgl_urb3d & !H urban ++! & ,SH_URB2D=grid%sh_urb2d ,LH_URB2D=grid%lh_urb2d & ++! & ,G_URB2D=grid%g_urb2d & !H urban ++! & ,RN_URB2D=grid%rn_urb2d , TS_URB2D=grid%ts_urb2d & !H urban ++! & ,FRC_URB2D=grid%frc_urb2d & !H urban ++! & ,UTYPE_URB2D=grid%utype_urb2d & !H urban ++! & ,ucmcall=grid%ucmcall & !H urban ++! ! P-X LSM Variables ++! & ,LANDUSEF=grid%landusef, SOILCTOP=grid%soilctop & ! P-X LSM ++! & ,SOILCBOT=grid%soilcbot & ! P-X LSM ++! & ,RA=grid%ra, RS=grid%rs, LAI=grid%lai & ! P-X LSM ++! & ,NLCAT=grid%num_land_cat, NSCAT=grid%num_soil_cat & ! P-X LSM ++! & ,VEGF_PX=grid%vegf_px, SNOWNCV=grid%snowncv & ! P-X LSM ++! & ,ANAL_INTERVAL=config_flags%interval_seconds & ! P-X LSM ++! & ,PXLSM_SMOIS_INIT=config_flags%pxlsm_smois_init & ! P-X LSM ++! & ,PXLSM_SOIL_NUDGE=config_flags%grid_fdda & ! P-X LSM ++! ! Optional PX LSM nudging ++! & ,t2_ndg_old=fdda2d(ims,1,jms,P_t2_ndg_old) & ++! & ,q2_ndg_old=fdda2d(ims,1,jms,P_q2_ndg_old) & ++! & ,t2_ndg_new=fdda2d(ims,1,jms,P_t2_ndg_new) & ++! & ,q2_ndg_new=fdda2d(ims,1,jms,P_q2_ndg_new) & ++! & ,sn_ndg_old=fdda2d(ims,1,jms,P_sn_ndg_old) & ++! & ,sn_ndg_new=fdda2d(ims,1,jms,P_sn_ndg_new) & ++! ! Indexes ++! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & ++! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & ++! & , I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & ++! & , J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & ++! & , KTS=k_start, KTE=min(k_end,kde-1) & ++! & , NUM_TILES=grid%num_tiles & ++! ! Optional ++! & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & ++! & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & ++! & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & ++! & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & ++! & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & ++! & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & ++! & ,CAPG=grid%capg, EMISS=grid%emiss, HOL=hol,MOL=grid%mol & ++! & ,T2OBS=grid%t2obs, Q2OBS=grid%q2obs & ++! & ,RAINBL=grid%rainbl,SR=grid%sr & ++! & ,RAINNCV=grid%rainncv,REGIME=grid%regime,T2=grid%t2,THC=grid%thc & ++! & ,QSG=grid%qsg,QVG=grid%qvg,QCG=grid%qcg,SOILT1=grid%soilt1,TSNAV=grid%tsnav & ! ruc lsm ++! & ,SMFR3D=grid%smfr3d,KEEPFR3DFLAG=grid%keepfr3dflag & ! ruc lsm ++! & ,POTEVP=grid%POTEVP, SNOPCX=grid%SNOPCX, SOILTB=grid%SOILTB & ! ruc lsm ++! & ) ++!BENCH_END(surf_driver_tim) ++! ++!!********* ++!! pbl ++! ++! CALL wrf_debug ( 200 , ' call pbl_driver' ) ++!BENCH_START(pbl_driver_tim) ++! CALL pbl_driver( & ++! & AKHS=grid%akhs ,AKMS=grid%akms & ++! & ,BL_PBL_PHYSICS=config_flags%bl_pbl_physics & ++! & ,BLDT=grid%bldt, CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag & ++! & ,BR=br ,CHKLOWQ=chklowq ,CT=grid%ct & ++! & ,DT=grid%dt ,DX=grid%dx ,DZ8W=dz8w & ++! & ,EL_MYJ=grid%el_myj ,EXCH_H=grid%exch_h ,GRDFLX=grid%grdflx & ++! & ,GZ1OZ0=gz1oz0 ,HFX=grid%hfx ,HT=grid%ht & ++! & ,ITIMESTEP=grid%itimestep ,KPBL=grid%kpbl & ++! & ,LH=grid%lh ,LOWLYR=grid%lowlyr ,P8W=p8w & ++! & ,PBLH=grid%pblh ,PI_PHY=pi_phy ,PSIH=psih & ++! & ,PSIM=psim ,P_PHY=p_phy ,QFX=grid%qfx & ++! & ,QSFC=grid%qsfc ,QZ0=grid%qz0 & ++! & ,RA_LW_PHYSICS=config_flags%ra_lw_physics & ++! & ,RHO=rho ,RQCBLTEN=grid%rqcblten ,RQIBLTEN=grid%rqiblten & ++! & ,RQVBLTEN=grid%rqvblten ,RTHBLTEN=grid%rthblten ,RUBLTEN=grid%rublten & ++! & ,RVBLTEN=grid%rvblten ,SNOW=grid%snow ,STEPBL=grid%stepbl & ++! & ,THZ0=grid%thz0 ,TH_PHY=th_phy ,TKE_MYJ=grid%tke_myj & ++! & ,TSK=grid%tsk ,T_PHY=t_phy ,UST=grid%ust & ++! & ,U10=grid%u10 ,UZ0=grid%uz0 ,U_FRAME=grid%u_frame ,U_PHY=u_phy & ++! & ,V10=grid%v10 ,VZ0=grid%vz0 ,V_FRAME=grid%v_frame ,V_PHY=v_phy & ++! & ,WARM_RAIN=grid%warm_rain ,WSPD=wspd & ++! & ,XICE=grid%xice ,XLAND=grid%xland ,Z=grid%z & ++! & ,ZNT=grid%znt & ++! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & ++! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & ++! & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & ++! & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & ++! & ,KTS=k_start, KTE=min(k_end,kde-1) & ++! & ,NUM_TILES=grid%num_tiles & ++! ! Variables Required by ACM PBL - jp ++! & ,ZNU=grid%znu,ZNW=grid%znw,MUT=grid%mut,P_TOP=grid%p_top & ++! ! optional ++! & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & ++! & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & ++! & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & ++! & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & ++! & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & ++! & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & ++! & ,HOL=HOL, MOL=grid%mol, REGIME=grid%REGIME & ++! & ) ++! ++!BENCH_END(pbl_driver_tim) ++! ++!! cumulus para. ++! ++! CALL wrf_debug ( 200 , ' call cumulus_driver' ) ++! ++! ++!BENCH_START(cu_driver_tim) ++! CALL cumulus_driver(grid & ++! ! Prognostic variables ++! & ,U=u_phy ,V=v_phy ,TH=th_phy ,T=t_phy & ++! & ,W=grid%w_2 ,P=p_phy ,PI=pi_phy ,RHO=rho & ++! ! Other arguments ++! & ,ITIMESTEP=grid%itimestep ,DT=grid%dt ,DX=grid%dx & ++! & ,CUDT=grid%cudt,CURR_SECS=curr_secs,ADAPT_STEP_FLAG=adapt_step_flag & ++! & ,RAINC=grid%rainc ,RAINCV=grid%raincv ,PRATEC=grid%pratec & ++! & , NCA=grid%nca & ++! & ,HTOP=grid%cutop ,HBOT=grid%cubot ,KPBL=grid%kpbl & ++! & ,DZ8W=dz8w ,P8W=p8w & ++! & ,W0AVG=grid%w0avg ,STEPCU=grid%stepcu & ++! & ,CLDEFI=grid%cldefi ,LOWLYR=grid%lowlyr ,XLAND=grid%xland & ++! & ,APR_GR=grid%apr_gr ,APR_W=grid%apr_w ,APR_MC=grid%apr_mc & ++! & ,APR_ST=grid%apr_st ,APR_AS=grid%apr_as ,APR_CAPMA=grid%apr_capma & ++! & ,APR_CAPME=grid%apr_capme ,APR_CAPMI=grid%apr_capmi & ++! & ,MASS_FLUX=grid%mass_flux ,XF_ENS=grid%xf_ens & ++! & ,PR_ENS=grid%pr_ens ,HT=grid%ht,EDT_OUT=grid%edt_out & ++! & ,imomentum=grid%imomentum,clos_choice=grid%clos_choice & ++! & ,cugd_tten=grid%cugd_tten,cugd_qvten=grid%cugd_qvten,cugd_qcten=grid%cugd_qcten & ++! & ,cugd_ttens=grid%cugd_ttens,cugd_qvtens=grid%cugd_qvtens & ++! & ,ENSDIM=config_flags%ensdim ,MAXIENS=config_flags%maxiens ,MAXENS=config_flags%maxens & ++! & ,MAXENS2=config_flags%maxens2 ,MAXENS3=config_flags%maxens3 & ++! & ,CU_ACT_FLAG=cu_act_flag ,WARM_RAIN=grid%warm_rain & ++! & ,GSW=grid%gsw,cugd_avedx=config_flags%cugd_avedx & ++! & ,PERIODIC_X=(config_flags%polar .OR. config_flags%periodic_x) & ++! & ,PERIODIC_Y=config_flags%periodic_y & ++! ! Selection flag ++! & ,CU_PHYSICS=config_flags%cu_physics & ++! ! Dimension arguments ++! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & ++! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & ++! & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe & ++! & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & ++! & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & ++! & ,KTS=k_start, KTE=min(k_end,kde-1) & ++! & ,NUM_TILES=grid%num_tiles & ++! ! Moisture tendency arguments ++! & ,RQVCUTEN=grid%rqvcuten , RQCCUTEN=grid%rqccuten & ++! & ,RQSCUTEN=grid%rqscuten , RQICUTEN=grid%rqicuten & ++! & ,RQRCUTEN=grid%rqrcuten , RQVBLTEN=grid%rqvblten & ++! & ,RQVFTEN=grid%rqvften & ++! ! Other tendency arguments ++! & ,RTHRATEN=grid%rthraten , RTHBLTEN=grid%rthblten & ++! & ,RTHCUTEN=grid%rthcuten , RTHFTEN=grid%rthften & ++! ! Moisture tracer arguments ++! & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & ++! & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & ++! & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & ++! & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & ++! & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & ++! & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & ++!#ifdef WRF_CHEM ++! & ,GD_CLOUD=grid%GD_CLOUD,GD_CLOUD2=grid%GD_CLOUD2 & ++!#endif ++! & ) ++!BENCH_END(cu_driver_tim) ++! ++! CALL wrf_debug ( 200 , ' call fddagd_driver' ) ++! ++!BENCH_START(fdda_driver_tim) ++! CALL fddagd_driver(itimestep=grid%itimestep,dt=grid%dt,xtime=grid%XTIME, & ++! id=grid%id, & ++! RUNDGDTEN=grid%rundgdten,RVNDGDTEN=grid%rvndgdten, & ++! RTHNDGDTEN=grid%rthndgdten,RQVNDGDTEN=grid%rqvndgdten, & ++! RMUNDGDTEN=grid%rmundgdten, & ++! u_ndg_old=fdda3d(ims,kms,jms,P_u_ndg_old), & ++! v_ndg_old=fdda3d(ims,kms,jms,P_v_ndg_old), & ++! t_ndg_old=fdda3d(ims,kms,jms,P_t_ndg_old), & ++! q_ndg_old=fdda3d(ims,kms,jms,P_q_ndg_old), & ++! mu_ndg_old=fdda2d(ims,1,jms,P_mu_ndg_old), & ++! u_ndg_new=fdda3d(ims,kms,jms,P_u_ndg_new), & ++! v_ndg_new=fdda3d(ims,kms,jms,P_v_ndg_new), & ++! t_ndg_new=fdda3d(ims,kms,jms,P_t_ndg_new), & ++! q_ndg_new=fdda3d(ims,kms,jms,P_q_ndg_new), & ++! mu_ndg_new=fdda2d(ims,1,jms,P_mu_ndg_new), & ++! u3d=grid%u_2,v3d=grid%v_2,th_phy=th_phy,rho=rho,moist=moist, & ++! p_phy=p_phy,pi_phy=pi_phy,p8w=p8w,t_phy=t_phy, & ++! dz8w=dz8w,z=grid%z,z_at_w=z_at_w, & ++! config_flags=config_flags,dx=grid%DX,n_moist=num_moist, & ++! STEPFG=grid%STEPFG, & ++! pblh=grid%pblh,ht=grid%ht, & ++! IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & ++! ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & ++! ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & ++! ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & ++! ,KTS=k_start, KTE=min(k_end,kde-1) & ++! , num_tiles=grid%num_tiles ) ++!BENCH_END(fdda_driver_tim) ++ ++!!****MARS ++IF (config_flags%modif_wrf) THEN ++!!!!!!!!!!!!!!!!!!!!!!! ++! call to LMD physics ! ++!!!!!!!!!!!!!!!!!!!!!!! ++ CALL wrf_debug ( 200 , ' call lmd_driver' ) ++ CALL lmd_driver( & ++ ! structure ++ & id=grid%id,max_dom=grid%max_dom & ++ & ,DT=grid%dt & ++ & ,ITIMESTEP=grid%itimestep & ++ ! position ++ & ,XLAT=grid%xlat,XLONG=grid%xlong & ++ & ,DX=grid%dx ,DY=grid%dy & ++ & ,MSFT=grid%msftx,MSFU=grid%msfux,MSFV=grid%msfvx & ++! & ,MSFT=grid%msft,MSFU=grid%msfu,MSFV=grid%msfv & ++ ! indexes + & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & + & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & + & ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1) & + & ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1) & + & ,kts=k_start, kte=min(k_end,kde-1) & + & ,num_tiles=grid%num_tiles & +- ! Optional +- & , CLDFRA=grid%cldfra & +- & , PB=grid%pb & +- & , F_ICE_PHY=grid%f_ice_phy,F_RAIN_PHY=grid%f_rain_phy & +- & , QV=moist(ims,kms,jms,P_QV), F_QV=F_QV & +- & , QC=moist(ims,kms,jms,P_QC), F_QC=F_QC & +- & , QR=moist(ims,kms,jms,P_QR), F_QR=F_QR & +- & , QI=moist(ims,kms,jms,P_QI), F_QI=F_QI & +- & , QS=moist(ims,kms,jms,P_QS), F_QS=F_QS & +- & , QG=moist(ims,kms,jms,P_QG), F_QG=F_QG & +- & , QNDROP=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP & +-#ifdef ACFLUX +- & ,ACSWUPT=acswupt ,ACSWUPTC=acswuptc & +- & ,ACSWDNT=acswdnt ,ACSWDNTC=acswdntc & +- & ,ACSWUPB=acswupb ,ACSWUPBC=acswupbc & +- & ,ACSWDNB=acswdnb ,ACSWDNBC=acswdnbc & +- & ,ACLWUPT=aclwupt ,ACLWUPTC=aclwuptc & +- & ,ACLWDNT=aclwdnt ,ACLWDNTC=aclwdntc & +- & ,ACLWUPB=aclwupb ,ACLWUPBC=aclwupbc & +- & ,ACLWDNB=aclwdnb ,ACLWDNBC=aclwdnbc & +- & ,SWUPT=swupt ,SWUPTC=swuptc & +- & ,SWDNT=swdnt ,SWDNTC=swdntc & +- & ,SWUPB=swupb ,SWUPBC=swupbc & +- & ,SWDNB=swdnb ,SWDNBC=swdnbc & +- & ,LWUPT=lwupt ,LWUPTC=lwuptc & +- & ,LWDNT=lwdnt ,LWDNTC=lwdntc & +- & ,LWUPB=lwupb ,LWUPBC=lwupbc & +- & ,LWDNB=lwdnb ,LWDNBC=lwdnbc & ++ ! time variables ++ & ,GMT=grid%gmt ,JULYR=grid%julyr ,JULDAY=grid%julday & ++ ! output from phy_prep ++ & ,P8W=p8w ,DZ8W=dz8w ,T8W=t8w & ++ ! Prognostic variables at p points ++! & ,Z=grid%em_z & ++ & ,Z=grid%z & ++ ! z is the geopotential height at p points ++ ! ... (cf phy_prep in module_big_step_utilities_em) ++ & ,HT=grid%ht & ++ & ,U=u_phy ,V=v_phy ,W=w_phy & ++ & ,TH=th_phy ,T=t_phy & ++ & ,P=p_phy ,EXNER=pi_phy ,RHO=rho & ++!!!!!ADDITION CAS IDEALISES ++ & ,PTOP=grid%p_top & ++ ! physics calls ++ & ,RADT=grid%radt & ++ & ,CUDT=grid%cudt & ++ ! surface temperature and surface pressure ++ & ,TSK=grid%tsk,PSFC=grid%psfc & ++ ! tendencies for the dynamics ++ & ,RTHBLTEN=grid%rthblten ,RUBLTEN=grid%rublten,RVBLTEN=grid%rvblten & ++ ! scalars ++! & ,NUM_3D_S=num_3d_s,SCALAR=grid%scalar & ++ & ,NUM_3D_S=num_scalar,SCALAR=grid%scalar & ++ & ,NUM_3D_M=num_moist,MOIST=grid%moist & ++ ! mode ++ & ,MARS_MODE=config_flags%mars & ++#ifdef NEWPHYS ++ ! planet ++ & ,planet_type=config_flags%planet & + #endif +- & ,LWCF=grid%lwcf & +- & ,SWCF=grid%swcf & +- & ,OLR=grid%olr & +- & ,OZMIXM=grid%ozmixm, PIN=grid%pin & +- & ,M_PS_1=grid%m_ps_1, M_PS_2=grid%m_ps_2, AEROSOLC_1=grid%aerosolc_1 & +- & ,AEROSOLC_2=grid%aerosolc_2, M_HYBI0=grid%m_hybi & +- & ,ABSTOT=grid%abstot, ABSNXT=grid%absnxt, EMSTOT=grid%emstot & +-#ifdef WRF_CHEM +- & ,CU_RAD_FEEDBACK=config_flags%cu_rad_feedback & +- & ,AER_RA_FEEDBACK=config_flags%aer_ra_feedback & +- & ,QC_ADJUST=grid%GD_CLOUD_B , QI_ADJUST=grid%GD_CLOUD2_B & +- & ,PM2_5_DRY=grid%pm2_5_dry, PM2_5_WATER=grid%pm2_5_water & +- & ,PM2_5_DRY_EC=grid%pm2_5_dry_ec & +- & ,TAUAER300=grid%tauaer1, TAUAER400=grid%tauaer2 & ! jcb +- & ,TAUAER600=grid%tauaer3, TAUAER999=grid%tauaer4 & ! jcb +- & ,GAER300=grid%gaer1, GAER400=grid%gaer2, GAER600=grid%gaer3, GAER999=grid%gaer4 & ! jcb +- & ,WAER300=grid%waer1, WAER400=grid%waer2, WAER600=grid%waer3, WAER999=grid%waer4 & ! jcb ++ ! added variables ++ & ,M_ALBEDO=grid%m_albedo,M_TI=grid%m_ti & ++ & ,M_CO2ICE=grid%m_co2ice,M_EMISS=grid%m_emiss & ++ & ,M_H2OICE=grid%m_h2oice & ++ & ,M_TSOIL=grid%m_tsoil & ++ & ,M_Q2=grid%m_q2 & ++ & ,M_TSURF=grid%m_tsurf & ++#ifdef NEWPHYS ++ & ,M_FLUXRAD=grid%m_fluxrad & ++ & ,M_WSTAR=grid%m_wstar & ++ & ,M_ISOIL=grid%m_isoil & ++ & ,M_DSOIL=grid%m_dsoil & ++ & ,M_Z0=grid%m_z0 & ++ & ,CST_Z0=config_flags%init_Z0 & + #endif +- & ,slope_rad=config_flags%slope_rad,topo_shading=config_flags%topo_shading & +- & ,shadowmask=shadowmask,ht=grid%ht,dx=grid%dx,dy=grid%dy,sina=grid%sina,cosa=grid%cosa ) +- +-BENCH_END(rad_driver_tim) +- +-!********* Surface driver +-! surface +- +-BENCH_START(surf_driver_tim) +- +-!----------------------------------------------------------------- +-! urban related variable are added to arguments of surface_driver +-!----------------------------------------------------------------- +- num_roof_layers = grid%num_soil_layers !urban +- num_wall_layers = grid%num_soil_layers !urban +- num_road_layers = grid%num_soil_layers !urban +- CALL nl_get_iswater(grid%id, iswater) +- +- CALL wrf_debug ( 200 , ' call surface_driver' ) +- +- CALL surface_driver( & +- & ACSNOM=grid%acsnom ,ACSNOW=grid%acsnow ,AKHS=grid%akhs & +- & ,AKMS=grid%akms ,ALBBCK=grid%albbck ,ALBEDO=grid%albedo & +- & ,EMBCK=grid%embck & +- & ,BR=br ,CANWAT=grid%canwat ,CHKLOWQ=chklowq & +- & ,CT=grid%ct ,DT=grid%dt ,DX=grid%dx & +- & ,DZ8W=dz8w ,DZS=grid%dzs ,FLHC=grid%flhc & +- & ,FLQC=grid%flqc ,GLW=grid%glw ,GRDFLX=grid%grdflx & +- & ,GSW=grid%gsw ,SWDOWN=grid%swdown ,GZ1OZ0=gz1oz0 ,HFX=grid%hfx & +- & ,HT=grid%ht ,IFSNOW=config_flags%ifsnow ,ISFFLX=config_flags%isfflx & +- & ,ISLTYP=grid%isltyp ,ITIMESTEP=grid%itimestep & +- & ,IVGTYP=grid%ivgtyp ,LH=grid%lh ,LOWLYR=grid%lowlyr & +- & ,MAVAIL=grid%mavail ,NUM_SOIL_LAYERS=config_flags%num_soil_layers & +- & ,P8W=p8w ,PBLH=grid%pblh ,PI_PHY=pi_phy & +- & ,PSFC=grid%psfc ,PSHLTR=grid%pshltr ,PSIH=psih & +- & ,BLDT=grid%bldt ,CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag & +- & ,PSIM=psim ,P_PHY=p_phy ,Q10=grid%q10 & +- & ,Q2=grid%q2 ,QFX=grid%qfx ,QSFC=grid%qsfc & +- & ,QSHLTR=grid%qshltr ,QZ0=grid%qz0 ,RAINCV=grid%raincv & +- & ,RA_LW_PHYSICS=config_flags%ra_lw_physics ,RHO=rho & +- & ,RMOL=grid%rmol ,SFCEVP=grid%sfcevp ,SFCEXC=grid%sfcexc & +- & ,SFCRUNOFF=grid%sfcrunoff & +- & ,SF_SFCLAY_PHYSICS=config_flags%sf_sfclay_physics & +- & ,SF_SURFACE_PHYSICS=config_flags%sf_surface_physics ,SH2O=grid%sh2o & +- & ,SHDMAX=grid%shdmax ,SHDMIN=grid%shdmin ,SMOIS=grid%smois & +- & ,SMSTAV=grid%smstav ,SMSTOT=grid%smstot ,SNOALB=grid%snoalb & +- & ,SNOW=grid%snow ,SNOWC=grid%snowc ,SNOWH=grid%snowh & +- & ,SST=grid%sst ,SST_UPDATE=grid%sst_update & +- & ,STEPBL=grid%stepbl ,TH10=grid%th10 ,TH2=grid%th2 & +- & ,THZ0=grid%thz0 ,TH_PHY=th_phy ,TKE_MYJ=grid%tke_myj & +- & ,TMN=grid%tmn ,TSHLTR=grid%tshltr ,TSK=grid%tsk & +- & ,TSLB=grid%tslb ,T_PHY=t_phy ,U10=grid%u10 & +- & ,URATX=grid%uratx ,VRATX=grid%vratx ,TRATX=grid%tratx & +- & ,UDRUNOFF=grid%udrunoff ,UST=grid%ust ,UZ0=grid%uz0 & +- & ,U_FRAME=grid%u_frame ,U_PHY=u_phy ,V10=grid%v10 & +- & ,VEGFRA=grid%vegfra ,VZ0=grid%vz0 ,V_FRAME=grid%v_frame & +- & ,V_PHY=v_phy ,WARM_RAIN=grid%warm_rain & +- & ,WSPD=wspd ,XICE=grid%xice ,XLAND=grid%xland & +- & ,Z0=grid%z0 ,Z=grid%z ,ZNT=grid%znt & +- & ,ZS=grid%zs ,XICEM=grid%xicem ,ISICE=grid%landuse_isice& +- & ,USTM=grid%ustm ,CK=grid%ck ,CKA=grid%cka & +- & ,CD=grid%cd ,CDA=grid%cda & +- & ,ISFTCFLX=config_flags%isftcflx & +- & ,OMLCALL=config_flags%omlcall ,OML_HML0=config_flags%oml_hml0 ,OML_GAMMA=config_flags%oml_gamma & +- & ,TML=grid%tml, T0ML=grid%t0ml, HML=grid%hml, H0ML=grid%h0ml, HUML=grid%huml, HVML=grid%hvml, F=grid%f & +- & ,ISWATER=iswater & +- & ,DECLIN_URB=grid%declin_urb ,COSZ_URB2D=grid%cosz_urb2d & !I urban +- & ,OMG_URB2D=grid%omg_urb2d ,xlat_urb2d=grid%XLAT & !I urban +- & ,NUM_ROOF_LAYERS=num_roof_layers & !I urban +- & ,NUM_WALL_LAYERS=num_wall_layers & !I urban +- & ,NUM_ROAD_LAYERS=num_road_layers & +- & ,DZR=grid%dzr ,DZB=grid%dzb ,DZG=grid%dzg & !I urban +- & ,TR_URB2D=grid%tr_urb2d ,TB_URB2D=grid%tb_urb2d & +- & ,TG_URB2D=grid%tg_urb2d & !H urban +- & ,TC_URB2D=grid%tc_urb2d ,QC_URB2D=grid%qc_urb2d & !H urban +- & ,UC_URB2D=grid%uc_urb2d & !H urban +- & ,XXXR_URB2D=grid%xxxr_urb2d & +- & ,XXXB_URB2D=grid%xxxb_urb2d & !H urban +- & ,XXXG_URB2D=grid%xxxg_urb2d & +- & ,XXXC_URB2D=grid%xxxc_urb2d & !H urban +- & ,TRL_URB3D=grid%trl_urb3d ,TBL_URB3D=grid%tbl_urb3d & !H urban +- & ,TGL_URB3D=grid%tgl_urb3d & !H urban +- & ,SH_URB2D=grid%sh_urb2d ,LH_URB2D=grid%lh_urb2d & +- & ,G_URB2D=grid%g_urb2d & !H urban +- & ,RN_URB2D=grid%rn_urb2d , TS_URB2D=grid%ts_urb2d & !H urban +- & ,FRC_URB2D=grid%frc_urb2d & !H urban +- & ,UTYPE_URB2D=grid%utype_urb2d & !H urban +- & ,ucmcall=grid%ucmcall & !H urban +- ! P-X LSM Variables +- & ,LANDUSEF=grid%landusef, SOILCTOP=grid%soilctop & ! P-X LSM +- & ,SOILCBOT=grid%soilcbot & ! P-X LSM +- & ,RA=grid%ra, RS=grid%rs, LAI=grid%lai & ! P-X LSM +- & ,NLCAT=grid%num_land_cat, NSCAT=grid%num_soil_cat & ! P-X LSM +- & ,VEGF_PX=grid%vegf_px, SNOWNCV=grid%snowncv & ! P-X LSM +- & ,ANAL_INTERVAL=config_flags%interval_seconds & ! P-X LSM +- & ,PXLSM_SMOIS_INIT=config_flags%pxlsm_smois_init & ! P-X LSM +- & ,PXLSM_SOIL_NUDGE=config_flags%grid_fdda & ! P-X LSM +- ! Optional PX LSM nudging +- & ,t2_ndg_old=fdda2d(ims,1,jms,P_t2_ndg_old) & +- & ,q2_ndg_old=fdda2d(ims,1,jms,P_q2_ndg_old) & +- & ,t2_ndg_new=fdda2d(ims,1,jms,P_t2_ndg_new) & +- & ,q2_ndg_new=fdda2d(ims,1,jms,P_q2_ndg_new) & +- & ,sn_ndg_old=fdda2d(ims,1,jms,P_sn_ndg_old) & +- & ,sn_ndg_new=fdda2d(ims,1,jms,P_sn_ndg_new) & +- ! Indexes +- & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & +- & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & +- & , I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & +- & , J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & +- & , KTS=k_start, KTE=min(k_end,kde-1) & +- & , NUM_TILES=grid%num_tiles & +- ! Optional +- & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & +- & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & +- & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & +- & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & +- & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & +- & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & +- & ,CAPG=grid%capg, EMISS=grid%emiss, HOL=hol,MOL=grid%mol & +- & ,T2OBS=grid%t2obs, Q2OBS=grid%q2obs & +- & ,RAINBL=grid%rainbl,SR=grid%sr & +- & ,RAINNCV=grid%rainncv,REGIME=grid%regime,T2=grid%t2,THC=grid%thc & +- & ,QSG=grid%qsg,QVG=grid%qvg,QCG=grid%qcg,SOILT1=grid%soilt1,TSNAV=grid%tsnav & ! ruc lsm +- & ,SMFR3D=grid%smfr3d,KEEPFR3DFLAG=grid%keepfr3dflag & ! ruc lsm +- & ,POTEVP=grid%POTEVP, SNOPCX=grid%SNOPCX, SOILTB=grid%SOILTB & ! ruc lsm +- & ) +-BENCH_END(surf_driver_tim) +- +-!********* +-! pbl +- +- CALL wrf_debug ( 200 , ' call pbl_driver' ) +-BENCH_START(pbl_driver_tim) +- CALL pbl_driver( & +- & AKHS=grid%akhs ,AKMS=grid%akms & +- & ,BL_PBL_PHYSICS=config_flags%bl_pbl_physics & +- & ,BLDT=grid%bldt, CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag & +- & ,BR=br ,CHKLOWQ=chklowq ,CT=grid%ct & +- & ,DT=grid%dt ,DX=grid%dx ,DZ8W=dz8w & +- & ,EL_MYJ=grid%el_myj ,EXCH_H=grid%exch_h ,GRDFLX=grid%grdflx & +- & ,GZ1OZ0=gz1oz0 ,HFX=grid%hfx ,HT=grid%ht & +- & ,ITIMESTEP=grid%itimestep ,KPBL=grid%kpbl & +- & ,LH=grid%lh ,LOWLYR=grid%lowlyr ,P8W=p8w & +- & ,PBLH=grid%pblh ,PI_PHY=pi_phy ,PSIH=psih & +- & ,PSIM=psim ,P_PHY=p_phy ,QFX=grid%qfx & +- & ,QSFC=grid%qsfc ,QZ0=grid%qz0 & +- & ,RA_LW_PHYSICS=config_flags%ra_lw_physics & +- & ,RHO=rho ,RQCBLTEN=grid%rqcblten ,RQIBLTEN=grid%rqiblten & +- & ,RQVBLTEN=grid%rqvblten ,RTHBLTEN=grid%rthblten ,RUBLTEN=grid%rublten & +- & ,RVBLTEN=grid%rvblten ,SNOW=grid%snow ,STEPBL=grid%stepbl & +- & ,THZ0=grid%thz0 ,TH_PHY=th_phy ,TKE_MYJ=grid%tke_myj & +- & ,TSK=grid%tsk ,T_PHY=t_phy ,UST=grid%ust & +- & ,U10=grid%u10 ,UZ0=grid%uz0 ,U_FRAME=grid%u_frame ,U_PHY=u_phy & +- & ,V10=grid%v10 ,VZ0=grid%vz0 ,V_FRAME=grid%v_frame ,V_PHY=v_phy & +- & ,WARM_RAIN=grid%warm_rain ,WSPD=wspd & +- & ,XICE=grid%xice ,XLAND=grid%xland ,Z=grid%z & +- & ,ZNT=grid%znt & +- & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & +- & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & +- & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & +- & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & +- & ,KTS=k_start, KTE=min(k_end,kde-1) & +- & ,NUM_TILES=grid%num_tiles & +- ! Variables Required by ACM PBL - jp +- & ,ZNU=grid%znu,ZNW=grid%znw,MUT=grid%mut,P_TOP=grid%p_top & +- ! optional +- & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & +- & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & +- & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & +- & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & +- & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & +- & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & +- & ,HOL=HOL, MOL=grid%mol, REGIME=grid%REGIME & +- & ) +- +-BENCH_END(pbl_driver_tim) +- +-! cumulus para. +- +- CALL wrf_debug ( 200 , ' call cumulus_driver' ) +- +- +-BENCH_START(cu_driver_tim) +- CALL cumulus_driver(grid & +- ! Prognostic variables +- & ,U=u_phy ,V=v_phy ,TH=th_phy ,T=t_phy & +- & ,W=grid%w_2 ,P=p_phy ,PI=pi_phy ,RHO=rho & +- ! Other arguments +- & ,ITIMESTEP=grid%itimestep ,DT=grid%dt ,DX=grid%dx & +- & ,CUDT=grid%cudt,CURR_SECS=curr_secs,ADAPT_STEP_FLAG=adapt_step_flag & +- & ,RAINC=grid%rainc ,RAINCV=grid%raincv ,PRATEC=grid%pratec & +- & , NCA=grid%nca & +- & ,HTOP=grid%cutop ,HBOT=grid%cubot ,KPBL=grid%kpbl & +- & ,DZ8W=dz8w ,P8W=p8w & +- & ,W0AVG=grid%w0avg ,STEPCU=grid%stepcu & +- & ,CLDEFI=grid%cldefi ,LOWLYR=grid%lowlyr ,XLAND=grid%xland & +- & ,APR_GR=grid%apr_gr ,APR_W=grid%apr_w ,APR_MC=grid%apr_mc & +- & ,APR_ST=grid%apr_st ,APR_AS=grid%apr_as ,APR_CAPMA=grid%apr_capma & +- & ,APR_CAPME=grid%apr_capme ,APR_CAPMI=grid%apr_capmi & +- & ,MASS_FLUX=grid%mass_flux ,XF_ENS=grid%xf_ens & +- & ,PR_ENS=grid%pr_ens ,HT=grid%ht,EDT_OUT=grid%edt_out & +- & ,imomentum=grid%imomentum,clos_choice=grid%clos_choice & +- & ,cugd_tten=grid%cugd_tten,cugd_qvten=grid%cugd_qvten,cugd_qcten=grid%cugd_qcten & +- & ,cugd_ttens=grid%cugd_ttens,cugd_qvtens=grid%cugd_qvtens & +- & ,ENSDIM=config_flags%ensdim ,MAXIENS=config_flags%maxiens ,MAXENS=config_flags%maxens & +- & ,MAXENS2=config_flags%maxens2 ,MAXENS3=config_flags%maxens3 & +- & ,CU_ACT_FLAG=cu_act_flag ,WARM_RAIN=grid%warm_rain & +- & ,GSW=grid%gsw,cugd_avedx=config_flags%cugd_avedx & +- & ,PERIODIC_X=(config_flags%polar .OR. config_flags%periodic_x) & +- & ,PERIODIC_Y=config_flags%periodic_y & +- ! Selection flag +- & ,CU_PHYSICS=config_flags%cu_physics & +- ! Dimension arguments +- & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & +- & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & +- & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe & +- & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & +- & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & +- & ,KTS=k_start, KTE=min(k_end,kde-1) & +- & ,NUM_TILES=grid%num_tiles & +- ! Moisture tendency arguments +- & ,RQVCUTEN=grid%rqvcuten , RQCCUTEN=grid%rqccuten & +- & ,RQSCUTEN=grid%rqscuten , RQICUTEN=grid%rqicuten & +- & ,RQRCUTEN=grid%rqrcuten , RQVBLTEN=grid%rqvblten & +- & ,RQVFTEN=grid%rqvften & +- ! Other tendency arguments +- & ,RTHRATEN=grid%rthraten , RTHBLTEN=grid%rthblten & +- & ,RTHCUTEN=grid%rthcuten , RTHFTEN=grid%rthften & +- ! Moisture tracer arguments +- & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & +- & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & +- & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & +- & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & +- & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & +- & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & +-#ifdef WRF_CHEM +- & ,GD_CLOUD=grid%GD_CLOUD,GD_CLOUD2=grid%GD_CLOUD2 & ++ & ,M_GW=grid%m_gw & ++ & ,NUM_SOIL_LAYERS=config_flags%num_soil_layers & ++ ! cst fields ++ & ,CST_AL=config_flags%init_AL & ++ & ,CST_TI=config_flags%init_TI & ++ & ,ISFFLX=config_flags%isfflx & ++ & ,DIFF_OPT=config_flags%diff_opt & ++ & ,KM_OPT=config_flags%km_opt & ++ & ,HISTORY_INTERVAL=model_config_rec%history_interval(1) & ++ !------------------! ++ ! OUTPUT VARIABLES ! ++ !------------------! ++#ifdef NEWPHYS ++ & ,HR_SW=grid%HR_SW & ++ & ,HR_LW=grid%HR_LW & ++ & ,HR_DYN=grid%HR_DYN & ++ & ,DDT=grid%DDT & ++ & ,DT_RAD=grid%DT_RAD & ++ & ,DT_VDF=grid%DT_VDF & ++ & ,DT_AJS=grid%DT_AJS & ++ & ,CLOUDFRAC=grid%CLOUDFRAC & ++ & ,TOTCLOUDFRAC=grid%TOTCLOUDFRAC & ++ & ,GRAIN=grid%GRAIN & ++ & ,GSNOW=grid%GSNOW & ++ & ,REEVAP=grid%REEVAP & ++ & ,SURFRAIN=grid%SURFRAIN & ++ & ,ALBEQ=grid%ALBEQ & ++ & ,FLUXTOP_DN=grid%FLUXTOP_DN & ++ & ,FLUXABS_SW=grid%FLUXABS_SW & ++ & ,FLUXTOP_LW=grid%FLUXTOP_LW & ++ & ,FLUXSURF_SW=grid%FLUXSURF_SW & ++ & ,FLUXSURF_LW=grid%FLUXSURF_LW & ++ & ,FLXGRD=grid%FLXGRD & ++ & ,LSCEZ=grid%LSCEZ & ++ & ,H2OICE_REFF=grid%H2OICE_REFF & ++ & ,LATENT_HF=grid%LATENT_HF & ++ & ,SWDOWNZ=grid%SWDOWNZ & ++ & ,TAU_DUST=grid%TAU_DUST & ++ & ,RDUST=grid%RDUST & ++ & ,QSURFDUST=grid%QSURFDUST & ++ & ,MTOT=grid%MTOT & ++ & ,ICETOT=grid%ICETOT & ++ & ,VMR_ICE=grid%VMR_ICE & ++ & ,TAU_ICE=grid%TAU_ICE & ++ & ,RICE=grid%RICE & ++ & ,ZMAX=grid%ZMAX & ++ & ,HFMAX=grid%HFMAX & ++ & ,USTM=grid%USTM & ++ & ,HFX=grid%HFX & ++#else ++#include "module_lmd_driver_output4.inc" + #endif +- & ) +-BENCH_END(cu_driver_tim) +- +- CALL wrf_debug ( 200 , ' call fddagd_driver' ) ++ & ,SLPX=grid%slpx,SLPY=grid%slpy,RESTART=config_flags%restart) ++ENDIF + +-BENCH_START(fdda_driver_tim) +- CALL fddagd_driver(itimestep=grid%itimestep,dt=grid%dt,xtime=grid%XTIME, & +- id=grid%id, & +- RUNDGDTEN=grid%rundgdten,RVNDGDTEN=grid%rvndgdten, & +- RTHNDGDTEN=grid%rthndgdten,RQVNDGDTEN=grid%rqvndgdten, & +- RMUNDGDTEN=grid%rmundgdten, & +- u_ndg_old=fdda3d(ims,kms,jms,P_u_ndg_old), & +- v_ndg_old=fdda3d(ims,kms,jms,P_v_ndg_old), & +- t_ndg_old=fdda3d(ims,kms,jms,P_t_ndg_old), & +- q_ndg_old=fdda3d(ims,kms,jms,P_q_ndg_old), & +- mu_ndg_old=fdda2d(ims,1,jms,P_mu_ndg_old), & +- u_ndg_new=fdda3d(ims,kms,jms,P_u_ndg_new), & +- v_ndg_new=fdda3d(ims,kms,jms,P_v_ndg_new), & +- t_ndg_new=fdda3d(ims,kms,jms,P_t_ndg_new), & +- q_ndg_new=fdda3d(ims,kms,jms,P_q_ndg_new), & +- mu_ndg_new=fdda2d(ims,1,jms,P_mu_ndg_new), & +- u3d=grid%u_2,v3d=grid%v_2,th_phy=th_phy,rho=rho,moist=moist, & +- p_phy=p_phy,pi_phy=pi_phy,p8w=p8w,t_phy=t_phy, & +- dz8w=dz8w,z=grid%z,z_at_w=z_at_w, & +- config_flags=config_flags,dx=grid%DX,n_moist=num_moist, & +- STEPFG=grid%STEPFG, & +- pblh=grid%pblh,ht=grid%ht, & +- IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & +- ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & +- ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & +- ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & +- ,KTS=k_start, KTE=min(k_end,kde-1) & +- , num_tiles=grid%num_tiles ) +-BENCH_END(fdda_driver_tim) ++!!!!!!!!!!!!!!!!!!!!!!! ++! call to LMD physics ! ++!!!!!!!!!!!!!!!!!!!!!!! ++!****MARS + + END SUBROUTINE first_rk_step_part1 + +diff --git a/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part2.F b/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part2.F +index 66b8c832..0084c01b 100644 +--- a/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part2.F ++++ b/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part2.F +@@ -36,7 +36,8 @@ CONTAINS + vertical_diffusion_2, horizontal_diffusion_2, calculate_km_kh, & + tke_rhs + USE module_em, ONLY : calculate_phy_tend +- USE module_fddaobs_driver, ONLY : fddaobs_driver ++!!!!****MARS MARS ++! USE module_fddaobs_driver, ONLY : fddaobs_driver + USE module_bc, ONLY : set_physical_bc3d, set_physical_bc2d + USE module_physics_addtendc, ONLY : update_phy_ten + +@@ -350,7 +351,11 @@ BENCH_END(phy_bc_tim) + ! tke x + ! + !----------------------------------------------------------------------- +- IF ( config_flags%bl_pbl_physics .ge. 1 ) THEN ++ ++!!****MARS: always include this HALO for Mars version ... ++ IF ( ( config_flags%bl_pbl_physics .ge. 1 ) & ++ .OR. ( config_flags%modif_wrf ) ) THEN ++! IF ( config_flags%bl_pbl_physics .ge. 1 ) THEN + # include "HALO_EM_PHYS_PBL.inc" + ENDIF + IF ( config_flags%grid_fdda .eq. 1) THEN +@@ -460,8 +465,19 @@ BENCH_END(tke_rhs_tim) + + IF(config_flags%diff_opt .eq. 2) THEN + +- IF (config_flags%bl_pbl_physics .eq. 0) THEN +- ++!!!!****MARS: vertical diffusion is done by the physics ++!!!!****MARS: a part si isfflx=1 (SGS completement fait par WRF) ++!!!!****MARS: ou si TKE_heat precisee dans la namelist ++! IF ( (config_flags%bl_pbl_physics .eq. 0) & ++! .AND. (.not. config_flags%modif_wrf ) ) THEN ++!! IF (config_flags%bl_pbl_physics .eq. 0) THEN ++!! ++!! ++ IF ( ( config_flags%bl_pbl_physics .eq. 0 ) & ++ .AND. ( ( config_flags%isfflx .ge. 1 ) & ++ .OR. ( config_flags%tke_heat_flux .ne. 0.) ) ) THEN ++!! ++!! + BENCH_START(vert_diff_tim) + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) +@@ -524,74 +540,77 @@ BENCH_START(hor_diff_tim) + BENCH_END(hor_diff_tim) + ENDIF + +- IF ( grid%obs_nudge_opt .EQ. 1 ) THEN +-# ifdef DM_PARALLEL +-# include "HALO_OBS_NUDGE.inc" +-#endif +-!*********************************************************************** +-! This section for obs nudging +- !$OMP PARALLEL DO & +- !$OMP PRIVATE ( ij ) +- +- DO ij = 1 , grid%num_tiles +- +- CALL fddaobs_driver (grid%grid_id, model_config_rec%grid_id, & +- model_config_rec%parent_id, config_flags%restart, & +- grid%obs_nudge_opt, & +- grid%obs_ipf_errob, & +- grid%obs_ipf_nudob, & +- grid%fdda_start, & +- grid%fdda_end, & +- grid%obs_nudge_wind, & +- grid%obs_nudge_temp, & +- grid%obs_nudge_mois, & +- grid%obs_nudge_pstr, & +- grid%obs_coef_wind, & +- grid%obs_coef_temp, & +- grid%obs_coef_mois, & +- grid%obs_coef_pstr, & +- grid%obs_rinxy, & +- grid%obs_rinsig, & +- grid%obs_npfi, & +- grid%obs_ionf, & +- grid%obs_nobs_prt, & +- grid%obs_idynin, & +- grid%obs_dtramp, & +- model_config_rec%cen_lat(1), & +- model_config_rec%cen_lon(1), & +- config_flags%truelat1, & +- config_flags%truelat2, & +- config_flags%map_proj, & +- model_config_rec%i_parent_start, & +- model_config_rec%j_parent_start, & +- grid%parent_grid_ratio, & +- grid%max_dom, grid%itimestep, & +- grid%dt, grid%gmt, grid%julday, grid%fdob, & +- grid%max_obs, & +- model_config_rec%nobs_ndg_vars, & +- model_config_rec%nobs_err_flds, & +- grid%fdob%nstat, grid%fdob%varobs, grid%fdob%errf, & +- grid%dx, grid%KPBL,grid%HT, & +- grid%mut, grid%muu, grid%muv, & +- grid%msftx, grid%msfty, grid%msfux, grid%msfuy, grid%msfvx, grid%msfvy, & +- p_phy, t_tendf, t0, & +- grid%u_2, grid%v_2, grid%t_2, & +- moist(ims,kms,jms,P_QV), & +- grid%pb, grid%p_top, grid%p, & +- grid%uratx, grid%vratx, grid%tratx, & +- ru_tendf, rv_tendf, & +- moist_tend(ims,kms,jms,P_QV), grid%obs_savwt, & +- ids,ide, jds,jde, kds,kde, & +- ims,ime, jms,jme, kms,kme, & +- grid%i_start(ij), min(grid%i_end(ij),ide-1), & +- grid%j_start(ij), min(grid%j_end(ij),jde-1), & +- k_start , min(k_end,kde-1) ) +- +- ENDDO +- !$OMP END PARALLEL DO +- ENDIF ! obs_nudge_opt .eq. 1 ++!!!!****MARS MARS ++!!!!****MARS MARS ++ ++! IF ( grid%obs_nudge_opt .EQ. 1 ) THEN ++!# ifdef DM_PARALLEL ++!# include "HALO_OBS_NUDGE.inc" ++!#endif ++!!*********************************************************************** ++!! This section for obs nudging ++! !$OMP PARALLEL DO & ++! !$OMP PRIVATE ( ij ) ++! ++! DO ij = 1 , grid%num_tiles ++! ++! CALL fddaobs_driver (grid%grid_id, model_config_rec%grid_id, & ++! model_config_rec%parent_id, config_flags%restart, & ++! grid%obs_nudge_opt, & ++! grid%obs_ipf_errob, & ++! grid%obs_ipf_nudob, & ++! grid%fdda_start, & ++! grid%fdda_end, & ++! grid%obs_nudge_wind, & ++! grid%obs_nudge_temp, & ++! grid%obs_nudge_mois, & ++! grid%obs_nudge_pstr, & ++! grid%obs_coef_wind, & ++! grid%obs_coef_temp, & ++! grid%obs_coef_mois, & ++! grid%obs_coef_pstr, & ++! grid%obs_rinxy, & ++! grid%obs_rinsig, & ++! grid%obs_npfi, & ++! grid%obs_ionf, & ++! grid%obs_nobs_prt, & ++! grid%obs_idynin, & ++! grid%obs_dtramp, & ++! model_config_rec%cen_lat(1), & ++! model_config_rec%cen_lon(1), & ++! config_flags%truelat1, & ++! config_flags%truelat2, & ++! config_flags%map_proj, & ++! model_config_rec%i_parent_start, & ++! model_config_rec%j_parent_start, & ++! grid%parent_grid_ratio, & ++! grid%max_dom, grid%itimestep, & ++! grid%dt, grid%gmt, grid%julday, grid%fdob, & ++! grid%max_obs, & ++! model_config_rec%nobs_ndg_vars, & ++! model_config_rec%nobs_err_flds, & ++! grid%fdob%nstat, grid%fdob%varobs, grid%fdob%errf, & ++! grid%dx, grid%KPBL,grid%HT, & ++! grid%mut, grid%muu, grid%muv, & ++! grid%msftx, grid%msfty, grid%msfux, grid%msfuy, grid%msfvx, grid%msfvy, & ++! p_phy, t_tendf, t0, & ++! grid%u_2, grid%v_2, grid%t_2, & ++! moist(ims,kms,jms,P_QV), & ++! grid%pb, grid%p_top, grid%p, & ++! grid%uratx, grid%vratx, grid%tratx, & ++! ru_tendf, rv_tendf, & ++! moist_tend(ims,kms,jms,P_QV), grid%obs_savwt, & ++! ids,ide, jds,jde, kds,kde, & ++! ims,ime, jms,jme, kms,kme, & ++! grid%i_start(ij), min(grid%i_end(ij),ide-1), & ++! grid%j_start(ij), min(grid%j_end(ij),jde-1), & ++! k_start , min(k_end,kde-1) ) + ! +-!*********************************************************************** ++! ENDDO ++! !$OMP END PARALLEL DO ++! ENDIF ! obs_nudge_opt .eq. 1 ++!! ++!!*********************************************************************** + + END SUBROUTINE first_rk_step_part2 + +diff --git a/WRF.COMMON/WRFV3/dyn_em/module_init_utilities.F b/WRF.COMMON/WRFV3/dyn_em/module_init_utilities.F +index 9c140a92..223252ee 100644 +--- a/WRF.COMMON/WRFV3/dyn_em/module_init_utilities.F ++++ b/WRF.COMMON/WRFV3/dyn_em/module_init_utilities.F +@@ -90,6 +90,183 @@ CONTAINS + return + END FUNCTION interp_0 + ++ real function interp_0_log( v_in, & ++ p_in, p_out, nz_in ) ++ implicit none ++ integer nz_in, nz_out ++ real v_in(nz_in), p_in(nz_in) ++ real p_out ++ ++ integer kp, k, im, ip ++ logical interp, increasing_z ++ real height, w1, w2 ++ logical debug ++ parameter ( debug = .false. ) ++ ++! does vertical coordinate increase or decrease with increasing k? ++! set offset appropriately ++ ++ height = p_out ++ ++ if(debug) write(6,*) ' height in interp_0 ',height ++ ++ if (p_in(nz_in) .gt. p_in(1)) then ++ ++ if(debug) write(6,*) ' monotonic increase in z in interp_0 ' ++ IF (height > p_in(nz_in)) then ++ if(debug) write(6,*) ' point 1 in interp_0 ' ++ w2 = log(p_in(nz_in)/height)/log(p_in(nz_in)/p_in(nz_in-1)) ++ w1 = 1.-w2 ++ interp_0_log = w1*v_in(nz_in) + w2*v_in(nz_in-1) ++ ELSE IF (height < p_in(1)) then ++ if(debug) write(6,*) ' point 2 in interp_0 ' ++ w2 = log(p_in(2)/height)/log(p_in(2)/p_in(1)) ++ w1 = 1.-w2 ++ interp_0_log = w1*v_in(2) + w2*v_in(1) ++ ELSE ++ if(debug) write(6,*) ' point 3 in interp_0 ' ++ interp = .false. ++ kp = nz_in ++ DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) ) ++ IF( ((p_in(kp) .ge. height) .and. & ++ (p_in(kp-1) .le. height)) ) THEN ++ w2 = log(height/p_in(kp))/log(p_in(kp-1)/p_in(kp)) ++ w1 = 1.-w2 ++ interp_0_log = w1*v_in(kp) + w2*v_in(kp-1) ++ if(debug) write(6,*) ' interp data, kp, w1, w2 ',kp, w1, w2 ++ if(debug) write(6,*) ' interp data, v_in(kp), v_in(kp-1), interp_0_p ', & ++ v_in(kp), v_in(kp-1), interp_0_log ++ interp = .true. ++ END IF ++ kp = kp-1 ++ ENDDO ++ ENDIF ++ ++ else ++ ++ if(debug) write(6,*) ' monotonic decrease in z in interp_0 ' ++ ++ IF (height < p_in(nz_in)) then ++ if(debug) write(6,*) ' point 1 in interp_0 ' ++ w2 = log(p_in(nz_in)/height)/log(p_in(nz_in)/p_in(nz_in-1)) ++ w1 = 1.-w2 ++ interp_0_log = w1*v_in(nz_in) + w2*v_in(nz_in-1) ++ ELSE IF (height > p_in(1)) then ++ if(debug) write(6,*) ' point 2 in interp_0 ' ++ w2 = log(p_in(2)/height)/log(p_in(2)/p_in(1)) ++ w1 = 1.-w2 ++ interp_0_log = w1*v_in(2) + w2*v_in(1) ++ ELSE ++ if(debug) write(6,*) ' point 3 in interp_0 ' ++ interp = .false. ++ kp = nz_in ++ height = p_out ++ DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) ) ++ IF( ((p_in(kp) .le. height) .and. & ++ (p_in(kp-1) .ge. height)) ) THEN ++ w2 = log(height/p_in(kp))/log(p_in(kp-1)/p_in(kp)) ++ w1 = 1.-w2 ++ interp_0_log = w1*v_in(kp) + w2*v_in(kp-1) ++ interp = .true. ++ END IF ++ kp = kp-1 ++ ENDDO ++ ENDIF ++ ++ end if ++ ++ return ++ END FUNCTION interp_0_log ++ ++ real function interp_0_log2( v_in, & ++ p_in, p_out, nz_in ) ++ implicit none ++ integer nz_in, nz_out ++ real*8 v_in(nz_in) ++ real*8 p_in(nz_in) ++ real*8 p_out ++ ++ integer kp, k, im, ip ++ logical interp, increasing_z ++ real height, w1, w2 ++ logical debug ++ parameter ( debug = .false. ) ++ ++! does vertical coordinate increase or decrease with increasing k? ++! set offset appropriately ++ ++ height = p_out ++ ++ if(debug) write(6,*) ' height in interp_0 ',height ++ ++ if (p_in(nz_in) .gt. p_in(1)) then ++ ++ if(debug) write(6,*) ' monotonic increase in z in interp_0 ' ++ IF (height > p_in(nz_in)) then ++ if(debug) write(6,*) ' point 1 in interp_0 ' ++ w2 = log(p_in(nz_in)/height)/log(p_in(nz_in)/p_in(nz_in-1)) ++ w1 = 1.-w2 ++ interp_0_log2 = w1*v_in(nz_in) + w2*v_in(nz_in-1) ++ ELSE IF (height < p_in(1)) then ++ if(debug) write(6,*) ' point 2 in interp_0 ' ++ w2 = log(p_in(2)/height)/log(p_in(2)/p_in(1)) ++ w1 = 1.-w2 ++ interp_0_log2 = w1*v_in(2) + w2*v_in(1) ++ ELSE ++ if(debug) write(6,*) ' point 3 in interp_0 ' ++ interp = .false. ++ kp = nz_in ++ DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) ) ++ IF( ((p_in(kp) .ge. height) .and. & ++ (p_in(kp-1) .le. height)) ) THEN ++ w2 = log(height/p_in(kp))/log(p_in(kp-1)/p_in(kp)) ++ w1 = 1.-w2 ++ interp_0_log2 = w1*v_in(kp) + w2*v_in(kp-1) ++ if(debug) write(6,*) ' interp data, kp, w1, w2 ',kp, w1, w2 ++ if(debug) write(6,*) ' interp data, v_in(kp), v_in(kp-1), interp_0_p', & ++ v_in(kp), v_in(kp-1), interp_0_log2 ++ interp = .true. ++ END IF ++ kp = kp-1 ++ ENDDO ++ ENDIF ++ ++ else ++ ++ if(debug) write(6,*) ' monotonic decrease in z in interp_0 ' ++ ++ IF (height < p_in(nz_in)) then ++ if(debug) write(6,*) ' point 1 in interp_0 ' ++ w2 = log(p_in(nz_in)/height)/log(p_in(nz_in)/p_in(nz_in-1)) ++ w1 = 1.-w2 ++ interp_0_log2 = w1*v_in(nz_in) + w2*v_in(nz_in-1) ++ ELSE IF (height > p_in(1)) then ++ if(debug) write(6,*) ' point 2 in interp_0 ' ++ w2 = log(p_in(2)/height)/log(p_in(2)/p_in(1)) ++ w1 = 1.-w2 ++ interp_0_log2 = w1*v_in(2) + w2*v_in(1) ++ ELSE ++ if(debug) write(6,*) ' point 3 in interp_0 ' ++ interp = .false. ++ kp = nz_in ++ height = p_out ++ DO WHILE ( (interp .eqv. .false.) .and. (kp .ge. 2) ) ++ IF( ((p_in(kp) .le. height) .and. & ++ (p_in(kp-1) .ge. height)) ) THEN ++ w2 = log(height/p_in(kp))/log(p_in(kp-1)/p_in(kp)) ++ w1 = 1.-w2 ++ interp_0_log2 = w1*v_in(kp) + w2*v_in(kp-1) ++ interp = .true. ++ END IF ++ kp = kp-1 ++ ENDDO ++ ENDIF ++ ++ end if ++ ++ return ++ END FUNCTION interp_0_log2 ++ + END MODULE module_init_utilities + + +diff --git a/WRF.COMMON/WRFV3/dyn_em/module_initialize_les.F b/WRF.COMMON/WRFV3/dyn_em/module_initialize_les.F +index 59298026..abb2bdbf 100644 +--- a/WRF.COMMON/WRFV3/dyn_em/module_initialize_les.F ++++ b/WRF.COMMON/WRFV3/dyn_em/module_initialize_les.F +@@ -86,12 +86,13 @@ CONTAINS + + INTEGER, PARAMETER :: nl_max = 1000 + REAL, DIMENSION(nl_max) :: zk, p_in, theta, rho, u, v, qv, pd_in ++ REAL*8, DIMENSION(nl_max) :: pd_in8 + INTEGER :: nl_in + +- + INTEGER :: icm,jcm, ii, im1, jj, jm1, loop, error, fid, nxc, nyc + REAL :: u_mean,v_mean, f0, p_surf, p_level, qvf, z_at_v, z_at_u +- REAL :: z_scale, xrad, yrad, zrad, rad, delt, cof1, cof2 ++ REAL*8 :: p_level8 ++ REAL :: xrad, yrad, zrad, rad, delt, cof1, cof2 + ! REAL, EXTERNAL :: interp_0 + REAL :: hm + REAL :: pi +@@ -111,6 +112,24 @@ CONTAINS + ! For LES, add randx + real :: randx + ++!!MARS ++ REAL :: lon_input, lat_input, alt_input, tsurf_input ++ ! for mode 3 ++ REAL, DIMENSION(nl_max) :: profdustq,profdustn ++ REAL, DIMENSION(nl_max) :: prescribed_sw,prescribed_lw,prescribed_dyn ++ REAL, DIMENSION(nl_max) :: hrsw,hrlw,hrdyn ++ REAL, DIMENSION(nl_max) :: lsf_dt,lsf_dq,lsfdt,lsfdq ++ REAL, DIMENSION(nl_max) :: venus_hrdyn ++ REAL, DIMENSION(nl_max) :: altitude ++ REAL*8, DIMENSION(nl_max) :: trac ++!!MARS ++ ++ REAL :: pfu, pfd, phm ++ INTEGER :: hypsometric_opt = 1 ! classic ++ !INTEGER :: hypsometric_opt = 2 ! Wee et al. 2012 correction ++ ++ LOGICAL :: logp = .true. ! use logp to interpolate (and not p) ++ + #ifdef DM_PARALLEL + # include + #endif +@@ -156,13 +175,17 @@ CONTAINS + + END SELECT + +- +-! stretch_grid = .true. +-! FOR LES, set stretch to false +- stretch_grid = .false. ++ IF (planet == "mars") THEN ++ stretch_grid = .false. ++ !! FOR LES, set stretch to false ++ ELSE ++ stretch_grid = .true. !! VENUS ++ ENDIF + delt = 3. + ! z_scale = .50 +- z_scale = .40 ++! z_scale = .10 ++! z_scale = .25 ++! z_scale = .15 + pi = 2.*asin(1.0) + write(6,*) ' pi is ',pi + nxc = (ide-ids)/2 +@@ -210,8 +233,8 @@ CONTAINS + grid%cosa(i,j) = 1. + grid%e(i,j) = 0. + ! for LES, include Coriolis force +- grid%f(i,j) = 1.e-4 +- ++ grid%f(i,j) = 0. !!MARS MARS 1.e-4 ++!! grid%f(i,j) = 2*EOMEG*SIN(grid%xlat(i,j)*degrad) + END DO + END DO + +@@ -233,11 +256,37 @@ CONTAINS + (1.-exp(-1./z_scale)) + ENDDO + ELSE +- DO k=1, kde +- grid%znw(k) = 1. - float(k-1)/float(kde-1) ++ !!MARS ++ !!MARS ++ IF (planet .ne. "mars") THEN ++ open(unit=12,file='levels',form='formatted',status='old') ++ rewind(12) ++ DO k=1, kde ++ read(12,*) grid%znw(k) ++ write(6,*) 'read level ', k,grid%znw(k) ++ ENDDO ++ close(12) ++ ENDIF ++ !!MARS ++ !!MARS ++ ! !DO k=1, kde ++ ! ! grid%znw(k) = 1. - float(k-1)/float(kde-1) ++ ! !ENDDO ++ ENDIF ++ ++ !! SPECIFIC FOR LES PBL MARS ++ IF (planet == "mars") THEN ++ !!!MARS ++ grid%znw(1)=1.000 ++ grid%znw(2)=0.9995 !5m ++ grid%znw(3)=0.9980 !20m ++ grid%znw(4)=0.9950 !55m ++ DO k=5, kde ++ grid%znw(k) = grid%znw(4) * ( 1. - float(k-4)/float(kde-4) ) + ENDDO + ENDIF + ++ + DO k=1, kde-1 + grid%dnw(k) = grid%znw(k+1) - grid%znw(k) + grid%rdnw(k) = 1./grid%dnw(k) +@@ -282,14 +331,63 @@ CONTAINS + + write(6,*) ' returned from reading sounding, nl_in is ',nl_in + ++!!MARS ++!!MARS ++ open(unit=14,file='input_coord',form='formatted',status='old') ++ rewind(14) ++ read(14,*) lon_input ++ read(14,*) lat_input ++ close(14) ++ write(6,*) ' lon is ',lon_input ++ write(6,*) ' lat is ',lat_input ++!!MARS ++!!MARS ++ ++!!MARS ++!!MARS ++ open(unit=18,file='input_more',form='formatted',status='old') ++ rewind(18) ++ read(18,*) alt_input, tsurf_input ++ close(18) ++ write(6,*) ' alt is ',alt_input ++ write(6,*) ' tsurf is ',tsurf_input ++!!MARS ++!!MARS ++ + ! find ptop for the desired ztop (ztop is input from the namelist), + ! and find surface pressure + +- grid%p_top = interp_0( p_in, zk, config_flags%ztop, nl_in ) ++ write(6,*) ' ztop above ground is ',config_flags%ztop ++ write(6,*) ' real ztop is ',config_flags%ztop + alt_input ++ grid%p_top = interp_0( p_in, zk, config_flags%ztop + alt_input, nl_in ) + + DO j=jts,jte + DO i=its,ite +- grid%ht(i,j) = 0. ++!!MARS ++ grid%ht(i,j) = alt_input ++ grid%m_tsurf(i,j) = tsurf_input ++!!MARS ++ grid%xlat(i,j) = lat_input !+ float(j)*config_flags%dy/59000. ++ grid%xlong(i,j) = lon_input !+ float(i)*config_flags%dx/59000. ++ grid%m_emiss(i,j)=0.95 ++ grid%m_co2ice(i,j)=0. ++ grid%m_h2oice(i,j)=0. ++!! >> Used for restarts only: ++ grid%m_q2(i,:,j)=0. ++ grid%m_fluxrad(i,j)=0. ++ grid%m_wstar(i,j)=0. ++!! << ++ grid%slpx(i,j) = 0. ++ grid%slpy(i,j) = 0. ++ DO k=1,config_flags%num_soil_layers ++ grid%m_tsoil(i,k,j) = 0. ++ ENDDO ++ grid%m_gw(i,1,j) = 0. ++ grid%m_gw(i,2,j) = 0. ++ grid%m_gw(i,3,j) = 0. ++ grid%m_gw(i,4,j) = 0. ++ grid%m_gw(i,5,j) = 0. ++!!MARS + ENDDO + ENDDO + +@@ -302,7 +400,7 @@ CONTAINS + #ifdef MTN + DO j=max(ys,jds),min(ye,jde-1) + DO i=max(xs,ids),min(xe,ide-1) +- grid%ht(i,j) = mtn_ht * 0.25 * & ++ grid%ht(i,j) = alt_input + mtn_ht * 0.25 * & + ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) ) * & + ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) ) + ENDDO +@@ -331,6 +429,12 @@ CONTAINS + ENDDO + ENDDO + ++ IF (.not.logp) THEN ++ write(6,*) 'interpolate in p' ++ ELSE ++ write(6,*) 'interpolate in logp' ++ ENDIF ++ + DO J = jts, jte + DO I = its, ite + +@@ -343,7 +447,11 @@ CONTAINS + DO K = 1, kte-1 + p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top + grid%pb(i,k,j) = p_level ++ IF (.not.logp) THEN + grid%t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0 ++ ELSE ++ grid%t_init(i,k,j) = interp_0_log( theta, p_in, p_level, nl_in ) - t0 ++ ENDIF + grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm + ENDDO + +@@ -351,13 +459,22 @@ CONTAINS + ! sounding, but this assures that the base state is in exact hydrostatic balance with + ! respect to the model eqns. + ++ IF (hypsometric_opt == 1) THEN + DO k = 2,kte + grid%phb(i,k,j) = grid%phb(i,k-1,j) - grid%dnw(k-1)*grid%mub(i,j)*grid%alb(i,k-1,j) + ENDDO ++ ELSE IF (hypsometric_opt == 2) THEN ++ DO k = 2,kte ++ pfu = grid%mub(i,j)*grid%znw(k) + grid%p_top ++ pfd = grid%mub(i,j)*grid%znw(k-1) + grid%p_top ++ phm = grid%mub(i,j)*grid%znu(k-1) + grid%p_top ++ grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu) ++ END DO ++ END IF ++ + + ENDDO + ENDDO +- + IF ( wrf_dm_on_monitor() ) THEN + write(6,*) ' ptop is ',grid%p_top + write(6,*) ' base state grid%mub(1,1), p_surf is ',grid%mub(1,1),grid%mub(1,1)+grid%p_top +@@ -389,9 +506,13 @@ CONTAINS + do k=1,kde-1 + + p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top +- ++ IF (.not.logp) THEN + moist(i,k,j,P_QV) = interp_0( qv, pd_in, p_level, nl_in ) + grid%t_1(i,k,j) = interp_0( theta, pd_in, p_level, nl_in ) - t0 ++ ELSE ++ moist(i,k,j,P_QV) = interp_0_log( qv, pd_in, p_level, nl_in ) ++ grid%t_1(i,k,j) = interp_0_log( theta, pd_in, p_level, nl_in ) - t0 ++ ENDIF + grid%t_2(i,k,j) = grid%t_1(i,k,j) + + +@@ -433,6 +554,7 @@ CONTAINS + + + grid%ph_1(i,1,j) = 0. ++ IF (hypsometric_opt == 1) THEN + DO k = 2,kte + grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (1./grid%rdnw(k-1))*( & + (grid%mub(i,j)+grid%mu_1(i,j))*grid%al(i,k-1,j)+ & +@@ -441,6 +563,28 @@ CONTAINS + grid%ph_2(i,k,j) = grid%ph_1(i,k,j) + grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j) + ENDDO ++ ELSE IF (hypsometric_opt == 2) THEN ++ ++ ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure. ++ ! Note that al*p approximates Rd*T and dLOG(p) does z. ++ ! Here T varies mostly linear with z, the first-order integration produces better result. ++ ++ grid%ph_2(i,1,j) = grid%phb(i,1,j) ++ DO k = 2,kte ++ pfu = grid%mu0(i,j)*grid%znw(k) + grid%p_top ++ pfd = grid%mu0(i,j)*grid%znw(k-1) + grid%p_top ++ phm = grid%mu0(i,j)*grid%znu(k-1) + grid%p_top ++ grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu) ++ END DO ++ ++ DO k = 1,kte ++ grid%ph_2(i,k,j) = grid%ph_2(i,k,j) - grid%phb(i,k,j) ++ grid%ph_1(i,k,j) = grid%ph_2(i,k,j) ++ END DO ++ ++ END IF ++ ++ + + IF ( wrf_dm_on_monitor() ) THEN + if((i==2) .and. (j==2)) then +@@ -498,6 +642,8 @@ CONTAINS + + ! rebalance hydrostatically + ++ IF (hypsometric_opt == 1) THEN ++ + DO k = 2,kte + grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (1./grid%rdnw(k-1))*( & + (grid%mub(i,j)+grid%mu_1(i,j))*grid%al(i,k-1,j)+ & +@@ -507,6 +653,28 @@ CONTAINS + grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j) + ENDDO + ++ ELSE IF (hypsometric_opt == 2) THEN ++ ++ ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure. ++ ! Note that al*p approximates Rd*T and dLOG(p) does z. ++ ! Here T varies mostly linear with z, the first-order integration produces better result. ++ ++ grid%ph_2(i,1,j) = grid%phb(i,1,j) ++ DO k = 2,kte ++ pfu = grid%mu0(i,j)*grid%znw(k) + grid%p_top ++ pfd = grid%mu0(i,j)*grid%znw(k-1) + grid%p_top ++ phm = grid%mu0(i,j)*grid%znu(k-1) + grid%p_top ++ grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu) ++ END DO ++ ++ DO k = 1,kte ++ grid%ph_2(i,k,j) = grid%ph_2(i,k,j) - grid%phb(i,k,j) ++ grid%ph_1(i,k,j) = grid%ph_2(i,k,j) ++ END DO ++ ++ END IF ++ ++ + ENDDO + ENDDO + +@@ -514,9 +682,9 @@ CONTAINS + + IF ( wrf_dm_on_monitor() ) THEN + write(6,*) ' grid%mu_1 from comp ', grid%mu_1(1,1) +- write(6,*) ' full state sounding from comp, ph, grid%p, grid%al, grid%t_1, qv ' ++ write(6,*) ' full state sounding from comp, ph/g, grid%p, grid%al, grid%t_1, qv ' + do k=1,kde-1 +- write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%ph_1(1,k,1)+grid%phb(1,k,1), & ++ write(6,'(i3,1x,5(1x,1pe10.3))') k, (grid%ph_1(1,k,1)+grid%phb(1,k,1))/g, & + grid%p(1,k,1)+grid%pb(1,k,1), grid%alt(1,k,1), & + grid%t_1(1,k,1)+t0, moist(1,k,1,P_QV) + enddo +@@ -541,11 +709,16 @@ CONTAINS + ELSE + z_at_v = 0.5*(grid%phb(i,1,j)+grid%phb(i,1,j-1))/g + END IF ++ + p_surf = interp_0( p_in, zk, z_at_v, nl_in ) + + DO K = 1, kte-1 + p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top ++ IF (.not.logp) THEN + grid%v_1(i,k,j) = interp_0( v, p_in, p_level, nl_in ) ++ ELSE ++ grid%v_1(i,k,j) = interp_0_log( v, p_in, p_level, nl_in ) ++ ENDIF + grid%v_2(i,k,j) = grid%v_1(i,k,j) + ENDDO + +@@ -569,7 +742,11 @@ CONTAINS + + DO K = 1, kte-1 + p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top ++ IF (.not.logp) THEN + grid%u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in ) ++ ELSE ++ grid%u_1(i,k,j) = interp_0_log( u, p_in, p_level, nl_in ) ++ ENDIF + grid%u_2(i,k,j) = grid%u_1(i,k,j) + ENDDO + +@@ -587,12 +764,58 @@ CONTAINS + ENDDO + ENDDO + ++!!!MARS MARS ++IF (config_flags%init_MU .ne. 0.) THEN ++ grid%u_1 = grid%u_1*config_flags%init_MU ++ grid%u_2 = grid%u_2*config_flags%init_MU ++ print *, 'multiply zonal wind ', config_flags%init_MU ++ENDIF ++IF (config_flags%init_MV .ne. 0.) THEN ++ grid%v_1 = grid%v_1*config_flags%init_MV ++ grid%v_2 = grid%v_2*config_flags%init_MV ++ print *, 'multiply meridional wind ', config_flags%init_MV ++ENDIF ++IF (config_flags%init_U .ne. 0.) THEN ++ DO J = jts, min(jde-1,jte) ++ DO K = kts, kte-1 ++ DO I = its, min(ide-1,ite) ++ grid%u_1(i,k,j) = config_flags%init_U ++ grid%u_2(i,k,j) = config_flags%init_U ++ ENDDO ++ ENDDO ++ ENDDO ++ print *, 'constant zonal wind ', config_flags%init_U ++ !!! ****** ou autre possibilité ++ !!! > grid%u_1 = grid%u_1*0. + config_flags%init_U ++ !!! > grid%u_2 = grid%u_2*0. + config_flags%init_U ++ENDIF ++IF (config_flags%init_V .ne. 0.) THEN ++ DO J = jts, min(jde-1,jte) ++ DO K = kts, kte-1 ++ DO I = its, min(ide-1,ite) ++ grid%v_1(i,k,j) = config_flags%init_V ++ grid%v_2(i,k,j) = config_flags%init_V ++ ENDDO ++ ENDDO ++ ENDDO ++ print *, 'constant meridional wind ', config_flags%init_V ++ENDIF ++ ++!!!MARS MARS ++ ++ + ! set a few more things + + DO J = jts, min(jde-1,jte) + DO K = kts, kte-1 + DO I = its, min(ide-1,ite) + grid%h_diabatic(i,k,j) = 0. ++ !!!!! MARS NO WIND CASE ++ !grid%u_1(i,k,j) = 0. ++ !grid%u_2(i,k,j) = 0. ++ !grid%v_1(i,k,j) = 0. ++ !grid%v_2(i,k,j) = 0. ++ !!!!! MARS NO WIND CASE + ENDDO + ENDDO + ENDDO +@@ -604,6 +827,16 @@ CONTAINS + grid%u_base(k) = grid%u_1(1,k,1) + grid%v_base(k) = grid%v_1(1,k,1) + grid%z_base(k) = 0.5*(grid%phb(1,k,1)+grid%phb(1,k+1,1)+grid%ph_1(1,k,1)+grid%ph_1(1,k+1,1))/g ++ ++!!!!! MARS SIMPLE LES (PURE BUOYANCY) ++!! grid%t_base(k) = grid%t_init(its,k,jts) ++! grid%t_base(k) = 0. ++! grid%qv_base(k) = 0. ++! grid%u_base(k) = 0. ++! grid%v_base(k) = 0. ++! grid%z_base(k) = 0. ++!!!!! MARS SIMPLE LES ++ + ENDDO + ENDIF + CALL wrf_dm_bcast_real( grid%t_base , kte ) +@@ -624,14 +857,147 @@ CONTAINS + ptmp = grid%p(i,3,j)+grid%pb(i,3,j) + temp(3) = thtmp * (ptmp/p1000mb)**rcp + +-! For LES-CBL, add 5 degrees to the surface temperature! +-! +-! grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3) +- grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)+5. ++!! For LES-CBL, add 5 degrees to the surface temperature! ++!! ++! grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3) ++!! grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)+5. + grid%tmn(I,J)=grid%tsk(I,J)-0.5 ++ + ENDDO + ENDDO + ++!!!!! MARS ++ ++ ! interpolate water vapor ++ if ( ( config_flags%mars == 1 ) & ++ .OR. ( config_flags%mars == 11 ) & ++ .OR. ( config_flags%mars == 12 ) ) then ++ print *, '**** INTERPOLATE HV **** RANK 2 in SCALAR' ++ DO k=1,kte-1 ++ p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top ++ IF (.not.logp) THEN ++ scalar(its:ite,k,jts:jte,2) = interp_0( qv, pd_in, p_level, nl_in ) ++ ELSE ++ scalar(its:ite,k,jts:jte,2) = interp_0_log( qv, pd_in, p_level, nl_in ) ++ ENDIF ++ scalar(its:ite,k,jts:jte,3) = 0. ++ !! water ice is set to 0 (was put into water vapor when building prof from MCD) ++ ENDDO ++ print *, "WATER VAPOR",scalar(its,:,jts,2) ++ endif ++ ++ ! interpolate qdust ++ if ( ( config_flags%mars == 11 ) & ++ .OR. ( config_flags%mars == 12 ) ) then ++ call read_dust(profdustq,profdustn,nl_in) ++ print *, '**** INTERPOLATE DUSTQ **** RANK 4 in SCALAR' ++ print *, '**** INTERPOLATE DUSTN **** RANK 5 in SCALAR' ++ DO k=1,kte-1 ++ p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top ++ IF (.not.logp) THEN ++ scalar(its:ite,k,jts:jte,4) = interp_0( profdustq, pd_in, p_level,nl_in ) ++ scalar(its:ite,k,jts:jte,5) = interp_0( profdustn, pd_in, p_level,nl_in ) ++ ELSE ++ scalar(its:ite,k,jts:jte,4) = interp_0_log( profdustq, pd_in, p_level, nl_in ) ++ scalar(its:ite,k,jts:jte,5) = interp_0_log( profdustn, pd_in, p_level, nl_in ) ++ ENDIF ++ ENDDO ++ print *, "DUST Q", scalar(its,:,jts,4) ++ print *, "DUST N", scalar(its,:,jts,5) ++ endif ++ ++ if ( config_flags%mars == 12 ) then ++ scalar(its:ite,1:kte-1,jts:jte,6) = 0. ++ scalar(its:ite,1:kte-1,jts:jte,7) = 0. ++ endif ++ ++!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ++!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ++ IF (planet .ne. "mars") THEN ++ call read_dust(profdustq,profdustn,nl_in) ++ DO k=1,kte!-1 ++ p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top ++ DO j = jts, jte ++ DO i = its, ite ++ !!! we use Q2 as a vehicle for heating rates! sick! ++ grid%m_q2(i,k,j) = interp_0_log( profdustq, pd_in, p_level, nl_in ) & ++ + interp_0_log( profdustn, pd_in, p_level, nl_in ) ++ ENDDO ++ ENDDO ++ !print*,'grid%m_q2' ++ !print*,k,grid%m_q2(1,k,1) ++ ENDDO ++ ENDIF ++ ++ IF (planet.eq."prescribed") Then ++ call read_hr(hrsw,hrlw,hrdyn,nl_in) ++ open(unit=17,file="prescribed_sw.txt",action="write") ++ open(unit=18,file="prescribed_lw.txt",action="write") ++ open(unit=19,file="prescribed_dyn.txt",action="write") ++ DO k=1,kte!-1 ++ p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top ++ prescribed_sw(k) = interp_0_log( hrsw, pd_in, p_level, nl_in ) ++ prescribed_lw(k) = interp_0_log( hrlw, pd_in, p_level, nl_in ) ++ prescribed_dyn(k) = interp_0_log( hrdyn, pd_in, p_level, nl_in ) ++ write (17,*) prescribed_sw(k) ++ write (18,*) prescribed_lw(k) ++ write (19,*) prescribed_dyn(k) ++ ENDDO ++ close(unit=19) ++ close(unit=18) ++ close(unit=17) ++ ENDIF ++ ++ IF (planet.eq."venus") Then ++ call read_hr(hrsw,hrlw,hrdyn,nl_in) ++ open(unit=20,file="venus_hrdyn.txt",action="write") ++ DO k=1,kte!-1 ++ p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top ++ venus_hrdyn(k) = interp_0_log( hrdyn, pd_in, p_level, nl_in ) ++ write (20,*) venus_hrdyn(k) ++ ENDDO ++ close(unit=20) ++ ENDIF ++ ++ IF (planet.eq."generic") THEN ++ call read_lsf(lsfdt,lsfdq,nl_in) ++ open(unit=17,file="lsf.txt",action="write") ++ DO k=1,kte!-1 ++ p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top ++ lsf_dt = interp_0_log( lsfdt, pd_in, p_level, nl_in ) ++ lsf_dq = interp_0_log( lsfdq, pd_in, p_level, nl_in ) ++ write (17,*) lsf_dt(k),lsf_dq(k) ++ ENDDO ++ ENDIF ++ ++ IF ((planet.eq."venus") .AND. ( config_flags%mars == 34 )) Then ++ pd_in8(:)=pd_in(:) ++ do i = 1,34 ++ call read_tracer(trac,num_scalar,i,nl_in) ++ DO k=1,kte-1 ++ p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top ++ p_level8=p_level ++ scalar(its:ite,k,jts:jte,i+1) = interp_0_log2( trac, pd_in8, p_level8, nl_in ) ++ ENDDO ++ ENDDO ++ !close(unit=22) ++ ENDIF ++ ++ open(unit=21,file="altitude.txt",action="write") ++ DO k=1,kte!-1 ++ p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top ++ altitude(k) = interp_0_log( zk, pd_in, p_level, nl_in ) ++ write (21,*) altitude(k) ++ ENDDO ++ close(unit=21) ++ ++!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ++!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ++ ++ ++!!!!! MARS ++ ++ + END SUBROUTINE init_domain_rk + + SUBROUTINE init_module_initialize +@@ -681,6 +1047,10 @@ CONTAINS + real pi_surf, pi(n) + real h_input(n), th_input(n), qv_input(n), u_input(n), v_input(n) + ++! input therm data (element 0 is the ground so it's n+1 but n is 1000 anyway so...) ++ ++ real r_therm(n),cp_therm(n),p_therm(n),rho_therm(n),t_therm(n) ++ + ! diagnostics + + real rho_surf, p_input(n), rho_input(n) +@@ -688,41 +1058,72 @@ CONTAINS + + ! local data + +- real p1000mb,cv,cp,r,cvpm,g +- parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 ) ++! real p1000mb,cv,cp,r,cvpm,g ++! parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 ) ++! parameter (p1000mb = 610., r = 192., cp = 844.6, cv = cp-r, cvpm = -cv/cp, g=3.72) ++! parameter (p1000mb = 610., r = 191., cp = 744.5, cv = cp-r, cvpm = -cv/cp, g=3.72) ++ !parameter (p1000mb = 92.e+05, r = 192., cp = 900.0, cv = cp-r, cvpm = -cv/cp, g=8.87) + integer k, it, nl + real qvf, qvf1, dz + ++ LOGICAL :: direct_from_file ++ ++ IF (planet == "mars") THEN ++ direct_from_file = .false. ++ ELSE ++ direct_from_file = .true. ++ ENDIF ++ + ! first, read the sounding + + call read_sounding( p_surf, th_surf, qv_surf, & +- h_input, th_input, qv_input, u_input, v_input,n, nl, debug ) ++ h_input, th_input, qv_input, & ++ u_input, v_input,n, nl, debug ) ++ ++! and the therm : + +- if(dry) then +- do k=1,nl +- qv_input(k) = 0. +- enddo +- endif ++ call read_therm(r_therm,cp_therm,p_therm,rho_therm,t_therm,n) + + if(debug) write(6,*) ' number of input levels = ',nl ++ nl_in = nl ++ if(nl_in .gt. nl_max ) then ++ write(6,*) ' too many levels for input arrays ',nl_in,nl_max ++ call wrf_error_fatal ( ' too many levels for input arrays ' ) ++ end if + +- nl_in = nl +- if(nl_in .gt. nl_max ) then +- write(6,*) ' too many levels for input arrays ',nl_in,nl_max +- call wrf_error_fatal ( ' too many levels for input arrays ' ) +- end if ++ IF (.NOT. direct_from_file) THEN ++ ++! To use r/cp as defined above, one has to recompute teta from T (default MCD computes ++! teta for a variable r/cp) ++ ++ do k=1,nl ++ th_input(k) = t_therm(k)*(p1000mb/p_therm(k))**(rcp) ++ enddo ++ th_surf = t_therm(1)*(p1000mb/p_therm(1))**(rcp) ++! ----- ++ ++ !if(dry) then ++ ! do k=1,nl ++ ! qv_input(k) = 0. ++ ! enddo ++ !endif + + ! compute diagnostics, + ! first, convert qv(g/kg) to qv(g/g) + + do k=1,nl ++ !!!!!!!!!!!!!! MARS ++ !! from mol/mol to kg/kg ++ qv_input(k) = qv_input(k)*18./mwdry + qv_input(k) = 0.001*qv_input(k) + enddo + + p_surf = 100.*p_surf ! convert to pascals + qvf = 1. + rvovrd*qv_input(1) +- rho_surf = 1./((r/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm)) +- pi_surf = (p_surf/p1000mb)**(r/cp) ++!!MARS ++ qvf = 1. ++ rho_surf = 1./((r_d/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm)) ++ pi_surf = (p_surf/p1000mb)**(rcp) + + if(debug) then + write(6,*) ' surface density is ',rho_surf +@@ -736,12 +1137,17 @@ CONTAINS + + qvf = 1. + rvovrd*qv_input(1) + qvf1 = 1. + qv_input(1) ++!!MARS ++ qvf = 1. ++ qvf1 = 1. + rho_input(1) = rho_surf + dz = h_input(1) + do it=1,10 +- pm_input(1) = p_surf & +- - 0.5*dz*(rho_surf+rho_input(1))*g*qvf1 +- rho_input(1) = 1./((r/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm)) ++! pm_input(1) = p_surf & ++! - 0.5*dz*(rho_surf+rho_input(1))*g*qvf1 ++!!!MARS MARS MARS ++ pm_input(1) = p_surf ++ rho_input(1) = 1./((r_d/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm)) + enddo + + ! integrate up the column +@@ -751,11 +1157,15 @@ CONTAINS + dz = h_input(k)-h_input(k-1) + qvf1 = 0.5*(2.+(qv_input(k-1)+qv_input(k))) + qvf = 1. + rvovrd*qv_input(k) ! qv is in g/kg here +- ++!!MARS ++ qvf = 1. ++ qvf1 = 1. ++!!MARS ++ + do it=1,10 + pm_input(k) = pm_input(k-1) & + - 0.5*dz*(rho_input(k)+rho_input(k-1))*g*qvf1 +- rho_input(k) = 1./((r/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm)) ++ rho_input(k) = 1./((r_d/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm)) + enddo + enddo + +@@ -771,6 +1181,18 @@ CONTAINS + p_input(k) = p_input(k+1) + 0.5*dz*(rho_input(k)+rho_input(k+1))*g + enddo + ++ ELSE !IF (.NOT. direct_from_file) THEN ++ ++ do k=1,nl ++ !!!! direct input from file ++ write(6,*) '*** DIRECT INPUT FROM FILE ***' ++ pm_input(k) = p_therm(k) ++ p_input(k) = p_therm(k) ++ rho_input(k) = rho_therm(k) ++ enddo ++ ++ ENDIF ++ + + do k=1,nl + +@@ -836,4 +1258,140 @@ CONTAINS + + end subroutine read_sounding + ++ subroutine read_therm(r,cp,p,rho,t,n) ++ implicit none ++ integer n ++ real r(n),cp(n),p(n),rho(n),t(n) ++ logical end_of_file ++ ++ integer k ++ ++! first element is the surface ++ ++ open(unit=11,file='input_therm',form='formatted',status='old') ++ rewind(11) ++ end_of_file = .false. ++ k = 0 ++ do while (.not. end_of_file) ++ ++ read(11,*,end=101) r(k+1), cp(k+1), p(k+1), rho(k+1), t(k+1) ++ write(*,*) k, r(k+1), cp(k+1), p(k+1), rho(k+1), t(k+1) ++ k = k+1 ++ go to 112 ++ 101 end_of_file = .true. ++ 112 continue ++ enddo ++ ++ close(unit=11,status = 'keep') ++ ++ end subroutine read_therm ++ ++!!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ++ subroutine read_dust(pdustq,pdustn,n) ++ implicit none ++ integer n ++ real pdustq(n+1),pdustn(n+1) ++ logical end_of_file ++ ++ integer k ++ ++! first element is the surface ++ ++ open(unit=11,file='input_dust',form='formatted',status='old') ++ rewind(11) ++ end_of_file = .false. ++ k = 0 ++ do while (.not. end_of_file) ++ ++ read(11,*,end=102) pdustq(k+1),pdustn(k+1) ++ write(*,*) k,pdustq(k+1),pdustn(k+1) ++ k = k+1 ++ go to 113 ++ 102 end_of_file = .true. ++ 113 continue ++ enddo ++ ++ close(unit=11,status = 'keep') ++ ++ end subroutine read_dust ++!!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ++ subroutine read_hr(hr_sw,hr_lw,hr_dyn,n) ++ implicit none ++ integer n ++ real hr_sw(n+1),hr_lw(n+1),hr_dyn(n+1) ++ logical end_of_file ++ ++ integer k ++ ++! first element is the surface ++ ++ open(unit=11,file='input_hr',form='formatted',status='old') ++ rewind(11) ++ end_of_file = .false. ++ k = 0 ++ do while (.not. end_of_file) ++ ++ read(11,*,end=103) hr_sw(k+1),hr_lw(k+1),hr_dyn(k+1) ++ write(*,*) k,hr_sw(k+1),hr_lw(k+1),hr_dyn(k+1) ++ k = k+1 ++ go to 114 ++ 103 end_of_file = .true. ++ 114 continue ++ enddo ++ ++ close(unit=11,status = 'keep') ++ ++ end subroutine read_hr ++ ++ subroutine read_lsf(dt,dq,n) ++ implicit none ++ integer n ++ real dt(n+1),dq(n+1) ++ logical end_of_file ++ ++ integer k ++ ++! first element is the surface ++ ++ open(unit=12,file='input_lsf',form='formatted',status='old') ++ rewind(12) ++ end_of_file = .false. ++ k = 0 ++ do while (.not. end_of_file) ++ ++ read(12,*,end=103) dt(k+1),dq(k+1) ++ write(*,*) k,dt(k+1),dq(k+1) ++ k = k+1 ++ go to 114 ++ 103 end_of_file = .true. ++ 114 continue ++ enddo ++ ++ close(unit=12,status = 'keep') ++ ++ end subroutine read_lsf ++ ++ subroutine read_tracer(trace,nq,qn,n) ++ implicit none ++ integer n,qn,nq ! qn : number of the tracer ++ real*8 tra(nq-1,n+1) ++ real*8 trace(n+1) !output ++ logical end_of_file ++ ++ integer k,j ++ ++! first element is the surface ++ open(unit=14,file='input_tracer',form='formatted',status='old') ++ rewind(14) ++ end_of_file = .false. ++ DO k=1,n ++ read(14,*) tra(:,k) ++ write(*,*) k,tra(qn,k) ++ ENDDO ++ ++ close(14) ++ trace(:)=tra(qn,:) ++ end subroutine read_tracer ++ ++ + END MODULE module_initialize_ideal +diff --git a/WRF.COMMON/WRFV3/dyn_em/solve_em.F b/WRF.COMMON/WRFV3/dyn_em/solve_em.F +index 1c04c6e7..36647050 100644 +--- a/WRF.COMMON/WRFV3/dyn_em/solve_em.F ++++ b/WRF.COMMON/WRFV3/dyn_em/solve_em.F +@@ -31,10 +31,12 @@ SUBROUTINE solve_em ( grid , config_flags & + USE module_physics_addtendc + USE module_diffusion_em + USE module_polarfft +- USE module_microphysics_driver +- USE module_microphysics_zero_out +- USE module_fddaobs_driver +- USE module_diagnostics ++!!!!****MARS MARS ++!!!!****MARS MARS ++! USE module_microphysics_driver ++! USE module_microphysics_zero_out ++! USE module_fddaobs_driver ++! USE module_diagnostics + #ifdef WRF_CHEM + USE module_input_chem_data + USE module_chem_utilities +@@ -2637,154 +2639,157 @@ BENCH_END(advance_ppt_tim) + sz = 0 + ENDIF + +- IF (config_flags%mp_physics /= 0) then ++!!!!****MARS MARS ++!!!!****MARS MARS + +- !$OMP PARALLEL DO & +- !$OMP PRIVATE ( ij, its, ite, jts, jte ) +- +- scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles +- +- IF ( config_flags%periodic_x ) THEN +- its = max(grid%i_start(ij),ids) +- ite = min(grid%i_end(ij),ide-1) +- ELSE +- its = max(grid%i_start(ij),ids+sz) +- ite = min(grid%i_end(ij),ide-1-sz) +- ENDIF +- jts = max(grid%j_start(ij),jds+sz) +- jte = min(grid%j_end(ij),jde-1-sz) +- +- CALL wrf_debug ( 200 , ' call moist_physics_prep' ) +-BENCH_START(moist_physics_prep_tim) +- CALL moist_physics_prep_em( grid%t_2, grid%t_1, t0, rho, & +- grid%al, grid%alb, grid%p, p8w, p0, grid%pb, & +- grid%ph_2, grid%phb, th_phy, pi_phy, p_phy, & +- grid%z, z_at_w, dz8w, & +- dtm, grid%h_diabatic, & +- config_flags,grid%fnm, grid%fnp, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, & +- k_start , k_end ) +-BENCH_END(moist_physics_prep_tim) +- END DO scalar_tile_loop_1a +- !$OMP END PARALLEL DO +- +- CALL wrf_debug ( 200 , ' call microphysics_driver' ) +- +- grid%sr = 0. +- specified_bdy = config_flags%specified .OR. config_flags%nested +- channel_bdy = config_flags%specified .AND. config_flags%periodic_x +- +-BENCH_START(micro_driver_tim) +- +- CALL microphysics_driver( & +- & DT=dtm ,DX=grid%dx ,DY=grid%dy & +- & ,DZ8W=dz8w ,F_ICE_PHY=grid%f_ice_phy & +- & ,ITIMESTEP=grid%itimestep ,LOWLYR=grid%lowlyr & +- & ,P8W=p8w ,P=p_phy ,PI_PHY=pi_phy & +- & ,RHO=rho ,SPEC_ZONE=grid%spec_zone & +- & ,SR=grid%sr ,TH=th_phy & +- & ,WARM_RAIN=grid%warm_rain & +- & ,T8W=t8w & +- & ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h & +- & ,NSOURCE=grid%qndropsource & +-#ifdef WRF_CHEM +- & ,QLSINK=grid%qlsink,CLDFRA_OLD=grid%cldfra_old & +- & ,PRECR=grid%precr, PRECI=grid%preci, PRECS=grid%precs, PRECG=grid%precg & +- & ,CHEM_OPT=config_flags%chem_opt, PROGN=config_flags%progn & +-#endif +- & ,XLAND=grid%xland & +- & ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy & +- & ,F_RAIN_PHY=grid%f_rain_phy & +- & ,F_RIMEF_PHY=grid%f_rimef_phy & +- & ,MP_PHYSICS=config_flags%mp_physics & +- & ,ID=grid%id & +- & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & +- & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & +-#ifdef RUN_ON_GPU +- & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe & +-#endif +- & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & +- & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & +- & ,KTS=k_start, KTE=min(k_end,kde-1) & +- & ,NUM_TILES=grid%num_tiles & +- & ,NAER=grid%naer & +- ! Optional +- & , RAINNC=grid%rainnc, RAINNCV=grid%rainncv & +- & , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv & +- & , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv & +- & , W=grid%w_2, Z=grid%z, HT=grid%ht & +- & , MP_RESTART_STATE=grid%mp_restart_state & +- & , TBPVS_STATE=grid%tbpvs_state & ! etampnew +- & , TBPVS0_STATE=grid%tbpvs0_state & ! etampnew +- & , QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & +- & , QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & +- & , QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & +- & , QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & +- & , QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & +- & , QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & +- & , QNDROP_CURR=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP & +- & , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI & +- & , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT & +- & , QNS_CURR=scalar(ims,kms,jms,P_QNS), F_QNS=F_QNS & +- & , QNR_CURR=scalar(ims,kms,jms,P_QNR), F_QNR=F_QNR & +- & , QNG_CURR=scalar(ims,kms,jms,P_QNG), F_QNG=F_QNG & +- & , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten & +- & , qicuten=grid%rqicuten,mu=grid%mut & +- & , HAIL=config_flags%gsfcgce_hail & ! for gsfcgce +- & , ICE2=config_flags%gsfcgce_2ice & ! for gsfcgce +- ) +-BENCH_END(micro_driver_tim) +- +-#if 0 +-BENCH_START(microswap_2) +-! for load balancing; communication to redistribute the points +- IF ( config_flags%mp_physics .EQ. ETAMPNEW ) THEN +-#include "SWAP_ETAMP_NEW.inc" +- ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN +-#include "SWAP_WSM3.inc" +- ENDIF +-BENCH_END(microswap_2) +-#endif +- +- CALL wrf_debug ( 200 , ' call moist_physics_finish' ) +-BENCH_START(moist_phys_end_tim) +- +- !$OMP PARALLEL DO & +- !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk ) +- +- DO ij = 1 , grid%num_tiles +- +- IF ( config_flags%periodic_x ) THEN +- its = max(grid%i_start(ij),ids) +- ite = min(grid%i_end(ij),ide-1) +- ELSE +- its = max(grid%i_start(ij),ids+sz) +- ite = min(grid%i_end(ij),ide-1-sz) +- ENDIF +- jts = max(grid%j_start(ij),jds+sz) +- jte = min(grid%j_end(ij),jde-1-sz) +- +- CALL microphysics_zero_out ( & +- moist , num_moist , config_flags , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, & +- k_start , k_end ) +- +- +- CALL moist_physics_finish_em( grid%t_2, grid%t_1, t0, grid%muts, th_phy, & +- grid%h_diabatic, dtm, config_flags, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, & +- k_start , k_end ) +- +- END DO +- !$OMP END PARALLEL DO +- +- ENDIF ! microphysics test ++! IF (config_flags%mp_physics /= 0) then ++! ++! !$OMP PARALLEL DO & ++! !$OMP PRIVATE ( ij, its, ite, jts, jte ) ++! ++! scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles ++! ++! IF ( config_flags%periodic_x ) THEN ++! its = max(grid%i_start(ij),ids) ++! ite = min(grid%i_end(ij),ide-1) ++! ELSE ++! its = max(grid%i_start(ij),ids+sz) ++! ite = min(grid%i_end(ij),ide-1-sz) ++! ENDIF ++! jts = max(grid%j_start(ij),jds+sz) ++! jte = min(grid%j_end(ij),jde-1-sz) ++! ++! CALL wrf_debug ( 200 , ' call moist_physics_prep' ) ++!BENCH_START(moist_physics_prep_tim) ++! CALL moist_physics_prep_em( grid%t_2, grid%t_1, t0, rho, & ++! grid%al, grid%alb, grid%p, p8w, p0, grid%pb, & ++! grid%ph_2, grid%phb, th_phy, pi_phy, p_phy, & ++! grid%z, z_at_w, dz8w, & ++! dtm, grid%h_diabatic, & ++! config_flags,grid%fnm, grid%fnp, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, & ++! k_start , k_end ) ++!BENCH_END(moist_physics_prep_tim) ++! END DO scalar_tile_loop_1a ++! !$OMP END PARALLEL DO ++! ++! CALL wrf_debug ( 200 , ' call microphysics_driver' ) ++! ++! grid%sr = 0. ++! specified_bdy = config_flags%specified .OR. config_flags%nested ++! channel_bdy = config_flags%specified .AND. config_flags%periodic_x ++! ++!BENCH_START(micro_driver_tim) ++! ++! CALL microphysics_driver( & ++! & DT=dtm ,DX=grid%dx ,DY=grid%dy & ++! & ,DZ8W=dz8w ,F_ICE_PHY=grid%f_ice_phy & ++! & ,ITIMESTEP=grid%itimestep ,LOWLYR=grid%lowlyr & ++! & ,P8W=p8w ,P=p_phy ,PI_PHY=pi_phy & ++! & ,RHO=rho ,SPEC_ZONE=grid%spec_zone & ++! & ,SR=grid%sr ,TH=th_phy & ++! & ,WARM_RAIN=grid%warm_rain & ++! & ,T8W=t8w & ++! & ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h & ++! & ,NSOURCE=grid%qndropsource & ++!#ifdef WRF_CHEM ++! & ,QLSINK=grid%qlsink,CLDFRA_OLD=grid%cldfra_old & ++! & ,PRECR=grid%precr, PRECI=grid%preci, PRECS=grid%precs, PRECG=grid%precg & ++! & ,CHEM_OPT=config_flags%chem_opt, PROGN=config_flags%progn & ++!#endif ++! & ,XLAND=grid%xland & ++! & ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy & ++! & ,F_RAIN_PHY=grid%f_rain_phy & ++! & ,F_RIMEF_PHY=grid%f_rimef_phy & ++! & ,MP_PHYSICS=config_flags%mp_physics & ++! & ,ID=grid%id & ++! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & ++! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & ++!#ifdef RUN_ON_GPU ++! & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe & ++!#endif ++! & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & ++! & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & ++! & ,KTS=k_start, KTE=min(k_end,kde-1) & ++! & ,NUM_TILES=grid%num_tiles & ++! & ,NAER=grid%naer & ++! ! Optional ++! & , RAINNC=grid%rainnc, RAINNCV=grid%rainncv & ++! & , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv & ++! & , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv & ++! & , W=grid%w_2, Z=grid%z, HT=grid%ht & ++! & , MP_RESTART_STATE=grid%mp_restart_state & ++! & , TBPVS_STATE=grid%tbpvs_state & ! etampnew ++! & , TBPVS0_STATE=grid%tbpvs0_state & ! etampnew ++! & , QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & ++! & , QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & ++! & , QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & ++! & , QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & ++! & , QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & ++! & , QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & ++! & , QNDROP_CURR=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP & ++! & , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI & ++! & , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT & ++! & , QNS_CURR=scalar(ims,kms,jms,P_QNS), F_QNS=F_QNS & ++! & , QNR_CURR=scalar(ims,kms,jms,P_QNR), F_QNR=F_QNR & ++! & , QNG_CURR=scalar(ims,kms,jms,P_QNG), F_QNG=F_QNG & ++! & , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten & ++! & , qicuten=grid%rqicuten,mu=grid%mut & ++! & , HAIL=config_flags%gsfcgce_hail & ! for gsfcgce ++! & , ICE2=config_flags%gsfcgce_2ice & ! for gsfcgce ++! ) ++!BENCH_END(micro_driver_tim) ++! ++!#if 0 ++!BENCH_START(microswap_2) ++!! for load balancing; communication to redistribute the points ++! IF ( config_flags%mp_physics .EQ. ETAMPNEW ) THEN ++!#include "SWAP_ETAMP_NEW.inc" ++! ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN ++!#include "SWAP_WSM3.inc" ++! ENDIF ++!BENCH_END(microswap_2) ++!#endif ++! ++! CALL wrf_debug ( 200 , ' call moist_physics_finish' ) ++!BENCH_START(moist_phys_end_tim) ++! ++! !$OMP PARALLEL DO & ++! !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk ) ++! ++! DO ij = 1 , grid%num_tiles ++! ++! IF ( config_flags%periodic_x ) THEN ++! its = max(grid%i_start(ij),ids) ++! ite = min(grid%i_end(ij),ide-1) ++! ELSE ++! its = max(grid%i_start(ij),ids+sz) ++! ite = min(grid%i_end(ij),ide-1-sz) ++! ENDIF ++! jts = max(grid%j_start(ij),jds+sz) ++! jte = min(grid%j_end(ij),jde-1-sz) ++! ++! CALL microphysics_zero_out ( & ++! moist , num_moist , config_flags , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, & ++! k_start , k_end ) ++! ++! ++! CALL moist_physics_finish_em( grid%t_2, grid%t_1, t0, grid%muts, th_phy, & ++! grid%h_diabatic, dtm, config_flags, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, & ++! k_start , k_end ) ++! ++! END DO ++! !$OMP END PARALLEL DO ++! ++! ENDIF ! microphysics test + + !----------------------------------------------------------- + ! filter for moist variables post-microphysics and end of timestep +@@ -3130,31 +3135,34 @@ BENCH_END(bc_2d_tim) + grid%dtbc = grid%dtbc + grid%dt + ENDIF + +-! calculate some model diagnostics. ++!!!!****MARS MARS ++!!!!****MARS MARS + +- CALL wrf_debug ( 200 , ' call diagnostic_driver' ) +- +- CALL diagnostic_output_calc( & +- & DPSDT=grid%dpsdt ,DMUDT=grid%dmudt & +- & ,P8W=p8w ,PK1M=grid%pk1m & +- & ,MU_2=grid%mu_2 ,MU_2M=grid%mu_2m & +- & ,U=grid%u_2 ,V=grid%v_2 & +- & ,RAINCV=grid%raincv ,RAINNCV=grid%rainncv & +- & ,RAINC=grid%rainc ,RAINNC=grid%rainnc & +- & ,HFX=grid%hfx ,SFCEVP=grid%sfcevp ,LH=grid%lh & +- & ,DT=grid%dt ,SBW=config_flags%spec_bdy_width & +- & ,XTIME=grid%xtime & +- ! Selection flag +- & ,DIAG_PRINT=config_flags%diag_print & +- ! Dimension arguments +- & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & +- & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & +- & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe & +- & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & +- & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & +- & ,KTS=k_start, KTE=min(k_end,kde-1) & +- & ,NUM_TILES=grid%num_tiles & +- & ) ++!! calculate some model diagnostics. ++! ++! CALL wrf_debug ( 200 , ' call diagnostic_driver' ) ++! ++! CALL diagnostic_output_calc( & ++! & DPSDT=grid%dpsdt ,DMUDT=grid%dmudt & ++! & ,P8W=p8w ,PK1M=grid%pk1m & ++! & ,MU_2=grid%mu_2 ,MU_2M=grid%mu_2m & ++! & ,U=grid%u_2 ,V=grid%v_2 & ++! & ,RAINCV=grid%raincv ,RAINNCV=grid%rainncv & ++! & ,RAINC=grid%rainc ,RAINNC=grid%rainnc & ++! & ,HFX=grid%hfx ,SFCEVP=grid%sfcevp ,LH=grid%lh & ++! & ,DT=grid%dt ,SBW=config_flags%spec_bdy_width & ++! & ,XTIME=grid%xtime & ++! ! Selection flag ++! & ,DIAG_PRINT=config_flags%diag_print & ++! ! Dimension arguments ++! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & ++! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & ++! & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe & ++! & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & ++! & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & ++! & ,KTS=k_start, KTE=min(k_end,kde-1) & ++! & ,NUM_TILES=grid%num_tiles & ++! & ) + + #ifdef DM_PARALLEL + !----------------------------------------------------------------------- +@@ -3221,6 +3229,25 @@ BENCH_END(bc_2d_tim) + DEALLOCATE(max_vert_cfl_tmp) + DEALLOCATE(max_horiz_cfl_tmp) + ++ ++!!!!!!!!!!!!!MARS ++!!!!!!!!!!!!!MARS ++!! ++!! to get lighter output files, output the sum of the constant value phb (pb) ++!with ph (p) ++!! --- these variables were added to the Registry ++!! ++!!pressure ++ grid%ptot = grid%p + grid%pb ++!!geopotential: already in php ++ grid%phtot = grid%php ++!!mass ++ !grid%em_mutot = grid%em_mub + grid%em_mu_2 ++!! ++!!!!!!!!!!!!!MARS ++!!!!!!!!!!!!!MARS ++ ++ + CALL wrf_debug ( 200 , ' call end of solve_em' ) + + ! Finish timers if compiled with -DBENCH. +diff --git a/WRF.COMMON/WRFV3/frame/module_driver_constants.F b/WRF.COMMON/WRFV3/frame/module_driver_constants.F +index 0e094785..9933689e 100644 +--- a/WRF.COMMON/WRFV3/frame/module_driver_constants.F ++++ b/WRF.COMMON/WRFV3/frame/module_driver_constants.F +@@ -90,16 +90,18 @@ MODULE module_driver_constants + ! + ! P2SI is the number of SI seconds in an planetary solar day + ! divided by the number of SI seconds in an earth solar day +-#if defined MARS +- ! For Mars, P2SI = 88775.2/86400. +- REAL , PARAMETER :: P2SI = 1.0274907 +-#elif defined TITAN +- ! For Titan, P2SI = 1378080.0/86400. +- REAL , PARAMETER :: P2SI = 15.95 +-#else ++!#if defined MARS ++! ! For Mars, P2SI = 88775.2/86400. ++! REAL , PARAMETER :: P2SI = 1.0274907 ++!#elif defined TITAN ++! ! For Titan, P2SI = 1378080.0/86400. ++! REAL , PARAMETER :: P2SI = 15.95 ++!#else + ! Default for Earth + REAL , PARAMETER :: P2SI = 1.0 +-#endif ++!!!!MARS ++! REAL , PARAMETER :: P2SI = 1.0274907 ++!#endif + CONTAINS + SUBROUTINE init_module_driver_constants + END SUBROUTINE init_module_driver_constants +diff --git a/WRF.COMMON/WRFV3/phys/Makefile b/WRF.COMMON/WRFV3/phys/Makefile +index 327966c5..636bd4c2 100644 +--- a/WRF.COMMON/WRFV3/phys/Makefile ++++ b/WRF.COMMON/WRFV3/phys/Makefile +@@ -6,64 +6,14 @@ RM = rm -f + + + MODULES = \ +- module_bl_ysu.o \ +- module_bl_mrf.o \ +- module_bl_gfs.o \ +- module_bl_myjpbl.o \ +- module_bl_acm.o \ +- module_cu_g3.o \ +- module_cu_kf.o \ +- module_cu_bmj.o \ +- module_cu_kfeta.o \ +- module_cu_gd.o \ +- module_cu_sas.o \ +- module_mp_kessler.o \ +- module_mp_lin.o \ +- module_mp_wsm3.o \ +- module_mp_wsm5.o \ +- module_mp_wsm6.o \ +- module_mp_etanew.o \ +- module_mp_thompson.o \ +- module_mp_gsfcgce.o \ +- module_mp_morr_two_moment.o \ +- module_ra_sw.o \ +- module_ra_gsfcsw.o \ +- module_ra_rrtm.o \ +- module_ra_cam_support.o \ +- module_ra_cam.o \ +- module_ra_gfdleta.o \ +- module_ra_hs.o \ +- module_sf_sfclay.o \ +- module_sf_gfs.o \ +- module_sf_slab.o \ +- module_sf_noahdrv.o \ +- module_sf_noahlsm.o \ +- module_sf_urban.o \ +- module_sf_lsm_nmm.o \ +- module_sf_pxlsm.o \ +- module_sf_ruclsm.o \ +- module_sf_sfcdiags.o \ +- module_sf_myjsfc.o \ +- module_sf_pxsfclay.o \ + module_physics_addtendc.o \ + module_physics_init.o \ +- module_gfs_machine.o \ +- module_gfs_funcphys.o \ +- module_gfs_physcons.o \ +- module_progtm.o \ +- module_pbl_driver.o \ +- module_data_gocart_dust.o \ +- module_cumulus_driver.o \ +- module_microphysics_driver.o \ +- module_microphysics_zero_out.o \ +- module_mixactivate.o \ +- module_radiation_driver.o \ +- module_surface_driver.o \ +- module_diagnostics.o \ +- module_fdda_psufddagd.o \ +- module_fddagd_driver.o \ +- module_fddaobs_rtfdda.o \ +- module_fddaobs_driver.o ++ variables_mod.o \ ++ update_inputs_physiq_mod.o \ ++ update_outputs_physiq_mod.o \ ++ iniphysiq_mod.o \ ++ callphysiq_mod.o \ ++ module_lmd_driver.o + + OBJS = + +@@ -92,195 +42,23 @@ clean: + + # DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES) + +-module_bl_myjpbl.o: ../share/module_model_constants.o +- +-module_bl_gfs.o: module_gfs_machine.o \ +- module_gfs_physcons.o +- +-module_cu_bmj.o: ../share/module_model_constants.o +- +-module_cu_kf.o: ../frame/module_wrf_error.o +- +-module_cu_kfeta.o: ../frame/module_wrf_error.o +- +-module_cu_gd.o: +- +-module_gfs_physcons.o: module_gfs_machine.o +- +-module_gfs_funcphys.o: module_gfs_machine.o \ +- module_gfs_physcons.o +- +-module_cu_sas.o: module_gfs_machine.o \ +- module_gfs_funcphys.o \ +- module_gfs_physcons.o +- +-module_ra_gfdleta.o: ../frame/module_dm.o +- +-module_ra_rrtm.o: ../frame/module_wrf_error.o \ +- ../frame/module_dm.o +- +-module_ra_cam_support.o: ../frame/module_wrf_error.o +- +-module_ra_cam.o: module_ra_cam_support.o \ +- ../frame/module_wrf_error.o +- +-module_mp_lin.o : ../frame/module_wrf_error.o +- +-module_sf_lsm_nmm.o: ../share/module_model_constants.o \ +- ../share/module_MPP.o +- +-module_sf_myjsfc.o: ../share/module_model_constants.o +- +-module_sf_gfs.o: module_gfs_machine.o \ +- module_gfs_funcphys.o \ +- module_gfs_physcons.o \ +- module_progtm.o +- +-module_sf_noahdrv.o: module_sf_noahlsm.o module_data_gocart_dust.o \ +- module_sf_urban.o +- +-module_sf_noahlsm.o: ../share/module_model_constants.o +- +-module_sf_ruclsm.o: ../frame/module_wrf_error.o module_data_gocart_dust.o +- +-module_sf_pxlsm.o: ../share/module_model_constants.o +- + module_physics_addtendc.o: \ +- module_cu_kf.o \ +- module_cu_kfeta.o \ + ../frame/module_state_description.o \ + ../frame/module_configure.o + + module_physics_init.o : \ +- module_ra_rrtm.o \ +- module_ra_cam.o \ +- module_ra_cam_support.o \ +- module_ra_sw.o \ +- module_ra_gsfcsw.o \ +- module_ra_gfdleta.o \ +- module_ra_hs.o \ +- module_sf_sfclay.o \ +- module_sf_slab.o \ +- module_sf_myjsfc.o \ +- module_sf_pxsfclay.o \ +- module_sf_noahlsm.o \ +- module_sf_noahdrv.o \ +- module_sf_ruclsm.o \ +- module_sf_pxlsm.o \ +- module_bl_ysu.o \ +- module_bl_mrf.o \ +- module_bl_gfs.o \ +- module_bl_acm.o \ +- module_bl_myjpbl.o \ +- module_cu_kf.o \ +- module_cu_g3.o \ +- module_cu_kfeta.o \ +- module_cu_bmj.o \ +- module_cu_gd.o \ +- module_cu_sas.o \ +- module_mp_wsm3.o \ +- module_mp_wsm5.o \ +- module_mp_wsm6.o \ +- module_mp_etanew.o \ +- module_fdda_psufddagd.o \ +- module_fddaobs_rtfdda.o \ +- module_mp_thompson.o \ +- module_mp_gsfcgce.o \ +- module_mp_morr_two_moment.o \ + ../frame/module_state_description.o \ + ../frame/module_configure.o \ + ../frame/module_wrf_error.o \ + ../frame/module_dm.o \ +- ../share/module_model_constants.o \ +- module_sf_lsm_nmm.o +- +-module_microphysics_driver.o: \ +- module_mixactivate.o \ +- module_mp_kessler.o module_mp_lin.o \ +- module_mp_wsm3.o module_mp_wsm5.o \ +- module_mp_wsm6.o module_mp_etanew.o \ +- module_mp_thompson.o \ +- module_mp_gsfcgce.o \ +- module_mp_morr_two_moment.o \ +- ../frame/module_driver_constants.o \ +- ../frame/module_state_description.o \ +- ../frame/module_wrf_error.o \ +- ../frame/module_configure.o \ +- ../share/module_model_constants.o +- +-module_cumulus_driver.o: \ +- module_cu_kf.o \ +- module_cu_g3.o \ +- module_cu_kfeta.o \ +- module_cu_bmj.o \ +- module_cu_gd.o \ +- module_cu_sas.o \ +- ../frame/module_state_description.o \ +- ../frame/module_configure.o \ +- ../share/module_model_constants.o +- +-module_pbl_driver.o: \ +- module_bl_myjpbl.o \ +- module_bl_acm.o \ +- module_bl_ysu.o \ +- module_bl_mrf.o \ +- module_bl_gfs.o \ +- ../frame/module_state_description.o \ +- ../frame/module_configure.o \ + ../share/module_model_constants.o + +-module_data_gocart_dust.o: +- +-module_mixactivate.o: \ +- module_radiation_driver.o +- +-module_radiation_driver.o: \ +- module_ra_sw.o \ +- module_ra_gsfcsw.o \ +- module_ra_rrtm.o \ +- module_ra_cam.o \ +- module_ra_gfdleta.o \ +- module_ra_hs.o \ +- ../frame/module_driver_constants.o \ ++module_lmd_driver.o: \ + ../frame/module_state_description.o \ +- ../frame/module_dm.o \ +- ../frame/module_domain.o \ + ../frame/module_wrf_error.o \ + ../frame/module_configure.o \ +- ../share/module_bc.o \ +- ../share/module_model_constants.o +- +-module_surface_driver.o: \ +- module_sf_sfclay.o \ +- module_sf_slab.o \ +- module_sf_myjsfc.o \ +- module_sf_pxsfclay.o \ +- module_sf_gfs.o \ +- module_sf_noahdrv.o \ +- module_sf_ruclsm.o \ +- module_sf_pxlsm.o \ +- module_sf_sfcdiags.o \ +- ../frame/module_state_description.o \ +- ../frame/module_configure.o \ +- ../share/module_model_constants.o \ +- module_sf_lsm_nmm.o +- +-module_diagnostics.o: ../frame/module_dm.o +- +- +-module_mixactivate.o: \ +- module_radiation_driver.o +- +-module_fddagd_driver.o: \ +- ../frame/module_state_description.o \ +- ../frame/module_configure.o \ +- ../share/module_model_constants.o \ +- module_fdda_psufddagd.o +- +-module_fddaobs_driver.o: \ +- ../frame/module_domain.o \ +- ../share/module_bc.o \ +- ../share/module_model_constants.o \ +- module_fddaobs_rtfdda.o ++ ../share/module_model_constants.o \ ++#../frame/module_wrf_error.o \ ++#../share/module_model_constants.o + + # DO NOT DELETE +diff --git a/WRF.COMMON/WRFV3/phys/module_physics_addtendc.F b/WRF.COMMON/WRFV3/phys/module_physics_addtendc.F +index 199b9b73..aedba100 100644 +--- a/WRF.COMMON/WRFV3/phys/module_physics_addtendc.F ++++ b/WRF.COMMON/WRFV3/phys/module_physics_addtendc.F +@@ -93,7 +93,13 @@ SUBROUTINE update_phy_ten(rt_tendf,ru_tendf,rv_tendf,moist_tendf, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +- if (config_flags%bl_pbl_physics .gt. 0) & ++! if (config_flags%bl_pbl_physics .gt. 0) & ++!****MARS ++! - All the LMD physics packages provide one tendency in the WRF sense ++! - PBL was chosen for practical reasons (U+V+T) ++! - The tendencies are supposed to be A-gridded ++ if ( (config_flags%bl_pbl_physics .gt. 0) & ++ .OR. (config_flags%modif_wrf) ) & + CALL phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, & + rt_tendf,ru_tendf,rv_tendf,moist_tendf, & + scalar_tendf,adv_moist_cond, & +@@ -199,6 +205,28 @@ SUBROUTINE phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, & + + !----------------------------------------------------------------- + ++ ++!****MARS ++!****MARS ++!update with LMD physics tendencies ++if (config_flags%modif_wrf) then ++CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & ++ ids,ide, jds, jde, kds, kde, & ++ ims, ime, jms, jme, kms, kme, & ++ its, ite, jts, jte, kts, kte ) ++CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & ++ ids,ide, jds, jde, kds, kde, & ++ ims, ime, jms, jme, kms, kme, & ++ its, ite, jts, jte, kts, kte ) ++CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & ++ ids,ide, jds, jde, kds, kde, & ++ ims, ime, jms, jme, kms, kme, & ++ its, ite, jts, jte, kts, kte ) ++endif ++!****MARS ++!****MARS ++ ++ + SELECT CASE(config_flags%bl_pbl_physics) + + CASE (YSUSCHEME) +@@ -468,7 +496,7 @@ SUBROUTINE phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, & + + CASE DEFAULT + +- print*,'phy_bl_ten: The pbl scheme does not exist' ++ ! print*,'phy_bl_ten: The pbl scheme does not exist' + + END SELECT + +@@ -759,8 +787,10 @@ SUBROUTINE advance_ppt(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & + its,ite, jts,jte, kts,kte ) + !---------------------------------------------------------------------- + USE module_state_description +- USE module_cu_kf +- USE module_cu_kfeta ++!!!******MARS MARS ++!!!******MARS MARS ++! USE module_cu_kf ++! USE module_cu_kfeta + !---------------------------------------------------------------------- + IMPLICIT NONE + !---------------------------------------------------------------------- +diff --git a/WRF.COMMON/WRFV3/phys/module_physics_init.F b/WRF.COMMON/WRFV3/phys/module_physics_init.F +index f40e5b10..cbc3dd93 100644 +--- a/WRF.COMMON/WRFV3/phys/module_physics_init.F ++++ b/WRF.COMMON/WRFV3/phys/module_physics_init.F +@@ -398,131 +398,136 @@ integer myproc + allowed_to_read, & + kds,kde,kms,kme,kts,kte) + +-!-- initialize physics +-!-- ra: radiation +-!-- bl: pbl +-!-- cu: cumulus +-!-- mp: microphysics +- +- CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to ra_init' ) +- +- CALL ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW, & +- RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT, & +- levsiz,XLAT,n_ozmixm, & +- cldfra_old, & ! Optional +- ozmixm,pin, & ! Optional +- m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2, & ! Optional +- paerlev,n_aerosolc, & +- sfull,shalf,pptop,swrad_scat, & +- config_flags,restart, & +- allowed_to_read, start_of_simulation, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- +- CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to bl_init' ) +- +- CALL bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN, & +- RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN, & +- config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS, & +- num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA, & +- SNOW,SNOWC, CANWAT,SMSTAV, & +- SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM, & +- IVGTYP,ISLTYP,SMOIS,SMFR3D,MAVAIL, & +- SNOWH,SH2O,FNDSOILW, FNDSNOWH, & +-#if (NMM_CORE == 1) +- Z0,XLAND,XICE, & +-#else +- ZNT,XLAND,XICE, & +-#endif +- SFCEVP,GRDFLX, & +- allowed_to_read , & +- start_of_simulation , & +- DZR, DZB, DZG, & !Optional urban +- TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !Optional urban +- XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !Optional urban +- TRL_URB3D, TBL_URB3D, TGL_URB3D, & !Optional urban +- SH_URB2D, LH_URB2D, G_URB2D, RN_URB2D, & !Optional urban +- TS_URB2D, FRC_URB2D, UTYPE_URB2D, UCMCALL, & !Optional urban +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte, & +- oml_hml0, omlcall, & !Optional oml +- TML,T0ML,HML,H0ML,HUML,HVML ) !Optional oml +- +- CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to cu_init' ) +- +- CALL cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN, & +- RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC, & +- RAINCV,W0AVG,config_flags,restart, & +- CLDEFI,LOWLYR,MASS_FLUX, & +- RTHFTEN, RQVFTEN, & +- APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & +- APR_CAPMA,APR_CAPME,APR_CAPMI, & +- cugd_tten,cugd_ttens,cugd_qvten, & +- cugd_qvtens,cugd_qcten, & +- allowed_to_read, start_of_simulation, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- +- CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to mp_init' ) +- +- CALL mp_init(RAINNC,config_flags,restart,warm_rain, & +- adv_moist_cond, & +- MPDT, DT, DX, DY, LOWLYR, & +- F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & +- mp_restart_state,tbpvs_state,tbpvs0_state, & +- allowed_to_read, start_of_simulation, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- +- write(message,*)'STEPRA,STEPCU,STEPBL',STEPRA,STEPCU,STEPBL +- CALL wrf_message( message ) +- +-#if ( EM_CORE == 1 ) +- CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to fg_init' ) +- +- CALL fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN, & +- RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, & +- config_flags,restart, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- +- CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to fdob_init' ) +- +- CALL fdob_init(model_config_rec%obs_nudge_opt, & +- model_config_rec%max_dom, & +- id, & +- model_config_rec%parent_id, & +- model_config_rec%obs_idynin, & +- model_config_rec%obs_dtramp, & +- model_config_rec%fdda_end, & +- config_flags%restart, & +- obs_twindo_cg, obs_twindo, & +- itimestep, & +- config_flags%cen_lat, & +- config_flags%cen_lon, & +- config_flags%stand_lon, & +- config_flags%truelat1, & +- config_flags%truelat2, & +- config_flags%map_proj, & +- xlat, & +- xlong, & +- model_config_rec%s_sn(1), & +- model_config_rec%e_sn(1), & +- model_config_rec%s_we(1), & +- model_config_rec%e_we(1), & +- fdob, & +- model_config_rec%obs_ipf_init, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) ++!!!!******MARS MARS MARS ++!!!!******MARS MARS MARS ++!!!!******MARS MARS MARS + +-#endif ++! ++!!-- initialize physics ++!!-- ra: radiation ++!!-- bl: pbl ++!!-- cu: cumulus ++!!-- mp: microphysics ++! ++! CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to ra_init' ) ++! ++! CALL ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW, & ++! RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT, & ++! levsiz,XLAT,n_ozmixm, & ++! cldfra_old, & ! Optional ++! ozmixm,pin, & ! Optional ++! m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2, & ! Optional ++! paerlev,n_aerosolc, & ++! sfull,shalf,pptop,swrad_scat, & ++! config_flags,restart, & ++! allowed_to_read, start_of_simulation, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ++! CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to bl_init' ) ++! ++! CALL bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN, & ++! RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN, & ++! config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS, & ++! num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA, & ++! SNOW,SNOWC, CANWAT,SMSTAV, & ++! SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM, & ++! IVGTYP,ISLTYP,SMOIS,SMFR3D,MAVAIL, & ++! SNOWH,SH2O,FNDSOILW, FNDSNOWH, & ++!#if (NMM_CORE == 1) ++! Z0,XLAND,XICE, & ++!#else ++! ZNT,XLAND,XICE, & ++!#endif ++! SFCEVP,GRDFLX, & ++! allowed_to_read , & ++! start_of_simulation , & ++! DZR, DZB, DZG, & !Optional urban ++! TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !Optional urban ++! XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !Optional urban ++! TRL_URB3D, TBL_URB3D, TGL_URB3D, & !Optional urban ++! SH_URB2D, LH_URB2D, G_URB2D, RN_URB2D, & !Optional urban ++! TS_URB2D, FRC_URB2D, UTYPE_URB2D, UCMCALL, & !Optional urban ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte, & ++! oml_hml0, omlcall, & !Optional oml ++! TML,T0ML,HML,H0ML,HUML,HVML ) !Optional oml ++! ++! CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to cu_init' ) ++! ++! CALL cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN, & ++! RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC, & ++! RAINCV,W0AVG,config_flags,restart, & ++! CLDEFI,LOWLYR,MASS_FLUX, & ++! RTHFTEN, RQVFTEN, & ++! APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & ++! APR_CAPMA,APR_CAPME,APR_CAPMI, & ++! cugd_tten,cugd_ttens,cugd_qvten, & ++! cugd_qvtens,cugd_qcten, & ++! allowed_to_read, start_of_simulation, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ++! CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to mp_init' ) ++! ++! CALL mp_init(RAINNC,config_flags,restart,warm_rain, & ++! adv_moist_cond, & ++! MPDT, DT, DX, DY, LOWLYR, & ++! F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & ++! mp_restart_state,tbpvs_state,tbpvs0_state, & ++! allowed_to_read, start_of_simulation, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ++! write(message,*)'STEPRA,STEPCU,STEPBL',STEPRA,STEPCU,STEPBL ++! CALL wrf_message( message ) ++! ++!#if ( EM_CORE == 1 ) ++! CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to fg_init' ) ++! ++! CALL fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN, & ++! RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, & ++! config_flags,restart, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ++! CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to fdob_init' ) ++! ++! CALL fdob_init(model_config_rec%obs_nudge_opt, & ++! model_config_rec%max_dom, & ++! id, & ++! model_config_rec%parent_id, & ++! model_config_rec%obs_idynin, & ++! model_config_rec%obs_dtramp, & ++! model_config_rec%fdda_end, & ++! config_flags%restart, & ++! obs_twindo_cg, obs_twindo, & ++! itimestep, & ++! config_flags%cen_lat, & ++! config_flags%cen_lon, & ++! config_flags%stand_lon, & ++! config_flags%truelat1, & ++! config_flags%truelat2, & ++! config_flags%map_proj, & ++! xlat, & ++! xlong, & ++! model_config_rec%s_sn(1), & ++! model_config_rec%e_sn(1), & ++! model_config_rec%s_we(1), & ++! model_config_rec%e_we(1), & ++! fdob, & ++! model_config_rec%obs_ipf_init, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ++!#endif + + END SUBROUTINE phy_init + +@@ -766,958 +771,962 @@ integer myproc + + END SUBROUTINE landuse_init + +-!===================================================================== +- SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW, & +- RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT, & +- levsiz,XLAT,n_ozmixm, & +- cldfra_old, & ! Optional +- ozmixm,pin, & ! Optional +- m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2, & ! Optional +- paerlev,n_aerosolc, & +- sfull,shalf,pptop,swrad_scat, & +- config_flags,restart, & +- allowed_to_read, start_of_simulation, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +-!--------------------------------------------------------------------- +- USE module_ra_rrtm +- USE module_ra_cam +- USE module_ra_sw +- USE module_ra_gsfcsw +- USE module_ra_gfdleta +- USE module_ra_hs +- USE module_domain +-!--------------------------------------------------------------------- +- IMPLICIT NONE +-!--------------------------------------------------------------------- +- INTEGER, INTENT(IN) :: id +- TYPE (grid_config_rec_type) :: config_flags +- LOGICAL , INTENT(IN) :: restart +- LOGICAL, INTENT(IN) :: allowed_to_read +- +- INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte +- +- INTEGER , INTENT(IN) :: JULDAY,JULYR +- REAL , INTENT(IN) :: DT, RADT, cen_lat, GMT, pptop, & +- swrad_scat +- LOGICAL, INTENT(IN) :: start_of_simulation +- +- INTEGER, INTENT(IN ) :: levsiz, n_ozmixm +- INTEGER, INTENT(IN ) :: paerlev, n_aerosolc +- +- REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: XLAT +- +- REAL, DIMENSION( ims:ime, levsiz, jms:jme, n_ozmixm ), OPTIONAL, & +- INTENT(INOUT) :: OZMIXM +- +- REAL, DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(INOUT) :: m_ps_1,m_ps_2 +- REAL, DIMENSION(paerlev), OPTIONAL, INTENT(INOUT) :: m_hybi +- REAL, DIMENSION( ims:ime, paerlev, jms:jme, n_aerosolc ), OPTIONAL, & +- INTENT(INOUT) :: aerosolc_1, aerosolc_2 +- +- REAL, DIMENSION(levsiz), OPTIONAL, INTENT(INOUT) :: PIN +- +- INTEGER , INTENT(INOUT) :: STEPRA +- INTEGER :: isn +- +- REAL , DIMENSION( kms:kme ) , INTENT(IN) :: sfull, shalf +- REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & +- RTHRATEN, & +- RTHRATENLW, & +- RTHRATENSW, & +- CLDFRA +- +- REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: & +- CLDFRA_OLD +- +- REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: EMISS +- LOGICAL :: etalw = .false. +- LOGICAL :: camlw = .false. +- LOGICAL :: etamp = .false. +- integer :: month,iday +- INTEGER :: i, j, k, itf, jtf, ktf +-!--------------------------------------------------------------------- +- +- jtf=min0(jte,jde-1) +- ktf=min0(kte,kde-1) +- itf=min0(ite,ide-1) +- +-!--------------------------------------------------------------------- +- +-!-- calculate radiation time step +- +- STEPRA = nint(RADT*60./DT) +- STEPRA = max(STEPRA,1) +- +-!-- initialization +- +- IF(start_of_simulation)THEN +- DO j=jts,jtf +- DO k=kts,ktf +- DO i=its,itf +- RTHRATEN(i,k,j)=0. +- RTHRATENLW(i,k,j)=0. +- RTHRATENSW(i,k,j)=0. +- CLDFRA(i,k,j)=0. +- ENDDO +- ENDDO +- ENDDO +- +- if( present(cldfra_old) ) then +- DO j=jts,jtf +- DO k=kts,ktf +- DO i=its,itf +- cldfra_old(i,k,j) = 0. +- ENDDO +- ENDDO +- ENDDO +- end if +- ENDIF +- +-!-- find out which microphysics option is used first +- +- mp_select: SELECT CASE(config_flags%mp_physics) +- +- CASE (ETAMPNEW) +- etamp = .true. +- +- END SELECT mp_select +- +-!-- chose long wave radiation scheme +- +- lwrad_select: SELECT CASE(config_flags%ra_lw_physics) +- +- CASE (RRTMSCHEME) +- CALL rrtminit( & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- +- CASE (CAMLWSCHEME) +-#ifdef MAC_KLUDGE +- CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' ) +-#endif +- IF ( PRESENT( OZMIXM ) .AND. PRESENT( PIN ) .AND. & +- PRESENT(M_PS_1) .AND. PRESENT(M_PS_2) .AND. & +- PRESENT(M_HYBI) .AND. PRESENT(AEROSOLC_1) & +- .AND. PRESENT(AEROSOLC_2)) THEN +- CALL camradinit( & +- R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop, & +- ozmixm,pin,levsiz,XLAT,n_ozmixm, & +- m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,& +- paerlev, n_aerosolc, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- ELSE +- CALL wrf_error_fatal ( 'arguments not present for calling cam radiation' ) +- ENDIF +- +- camlw = .true. +- +- CASE (GFDLLWSCHEME) +- CALL nl_get_start_month(id,month) +- CALL nl_get_start_day(id,iday) +- CALL gfdletainit(emiss,sfull,shalf,pptop, & +- julyr,month,iday,gmt, & +- config_flags,allowed_to_read, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- etalw = .true. +- CASE (HELDSUAREZ) +- CALL hsinit(RTHRATEN,restart, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- CASE DEFAULT +- +- END SELECT lwrad_select +-!-- initialize short wave radiation scheme +- +- swrad_select: SELECT CASE(config_flags%ra_sw_physics) +- +- CASE (SWRADSCHEME) +- CALL swinit( & +- swrad_scat, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- +- CASE (CAMSWSCHEME) +-#ifdef MAC_KLUDGE +- CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' ) +-#endif +- IF(.not.camlw)THEN +- CALL camradinit( & +- R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop, & +- ozmixm,pin,levsiz,XLAT,n_ozmixm, & +- m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,& +- paerlev, n_aerosolc, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- ENDIF +- +- CASE (GSFCSWSCHEME) +- CALL gsfc_swinit(cen_lat, allowed_to_read ) +- +- CASE (GFDLSWSCHEME) +- IF(.not.etalw)THEN +- CALL nl_get_start_month(id,month) +- CALL nl_get_start_day(id,iday) +- CALL gfdletainit(emiss,sfull,shalf,pptop, & +- julyr,month,iday,gmt, & +- config_flags,allowed_to_read, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- ENDIF +- +- CASE DEFAULT +- +- END SELECT swrad_select +- +- END SUBROUTINE ra_init +- +- SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN, & +- RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN, & +- config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS, & +- num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA, & +- SNOW,SNOWC, CANWAT,SMSTAV, & +- SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM, & +- IVGTYP,ISLTYP,SMOIS,SMFR3D,mavail, & +- SNOWH,SH2O,FNDSOILW, FNDSNOWH, & +-#if ( NMM_CORE == 1 ) +- Z0,XLAND,XICE, & +-#else +- ZNT,XLAND,XICE, & +-#endif +- SFCEVP,GRDFLX, & +- allowed_to_read, & +- start_of_simulation, & +-! num_roof_layers,num_wall_layers,num_road_layers,& !Optional urban +- DZR, DZB, DZG, & !Optional urban +- TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !Optional urban +- XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !Optional urban +- TRL_URB3D, TBL_URB3D, TGL_URB3D, & !Optional urban +- SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D, & !Optional urban +- TS_URB2D, FRC_URB2D, UTYPE_URB2D,UCMCALL, & !Optional urban +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte, & +- oml_hml0, omlcall, & !Optional oml +- TML,T0ML,HML,H0ML,HUML,HVML ) !Optional oml +-!-------------------------------------------------------------------- +- USE module_sf_sfclay +- USE module_sf_slab +- USE module_sf_pxsfclay +- USE module_bl_ysu +- USE module_bl_mrf +- USE module_bl_gfs +- USE module_bl_acm +- USE module_sf_myjsfc +- USE module_sf_noahdrv +- USE module_sf_urban +- USE module_sf_ruclsm +- USE module_sf_pxlsm +- USE module_bl_myjpbl +-#if (NMM_CORE == 1) +- USE module_sf_lsm_nmm +-#endif +-!-------------------------------------------------------------------- +- IMPLICIT NONE +-!-------------------------------------------------------------------- +- TYPE (grid_config_rec_type) :: config_flags +- LOGICAL , INTENT(IN) :: restart +- LOGICAL, INTENT(IN) :: FNDSOILW, FNDSNOWH +- +- INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte +- INTEGER , INTENT(IN) :: num_soil_layers +- INTEGER , INTENT(IN) :: UCMCALL +- +- REAL , INTENT(IN) :: DT, BLDT +- INTEGER , INTENT(INOUT) :: STEPBL +- +- REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ), & +- INTENT(OUT) :: SMFR3D +- +- REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),& +- INTENT(INOUT) :: SMOIS,SH2O,TSLB +- +- REAL, DIMENSION( ims:ime, jms:jme ) , & +- INTENT(INOUT) :: SNOW, & +- SNOWH, & +- SNOWC, & +- CANWAT, & +- MAVAIL, & +- SMSTAV, & +- SMSTOT, & +- SFCRUNOFF, & +- UDRUNOFF, & +- ACSNOW, & +- VEGFRA, & +- ACSNOM, & +- SFCEVP, & +- GRDFLX, & +- UST, & +-#if ( NMM_CORE == 1 ) +- Z0, & +-#else +- ZNT, & +-#endif +- XLAND, & +- XICE +- +- INTEGER, DIMENSION( ims:ime, jms:jme ) , & +- INTENT(INOUT) :: IVGTYP, & +- ISLTYP, & +- LOWLYR +- +- +- REAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: ZS,DZS +- +- REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & +- RUBLTEN, & +- RVBLTEN, & +- EXCH_H, & +- RTHBLTEN, & +- RQVBLTEN, & +- RQCBLTEN, & +- RQIBLTEN, & +- TKE_MYJ +- +- REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: TSK +- REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: TMN +- LOGICAL, INTENT(IN) :: allowed_to_read +- INTEGER :: isn, isfc +- +-!URBAN +-! REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR !Optional urban +-! REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB !Optional urban +-! REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG !Optional urban +- REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR !Optional urban +- REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB !Optional urban +- REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !Optional urban +- INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !Optional urban +-! REAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban +-! REAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban +-! REAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban +- REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban +- +-! Optional OML variables +- REAL, DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(INOUT) :: & +- TML,T0ML,HML,H0ML,HUML,HVML +- INTEGER, OPTIONAL, INTENT(IN) :: omlcall +- REAL, OPTIONAL, INTENT(IN) :: oml_hml0 +- LOGICAL, INTENT(IN) :: start_of_simulation +- +-!-- calculate pbl time step +- +- STEPBL = nint(BLDT*60./DT) +- STEPBL = max(STEPBL,1) +- +- +-!-- initialize surface layer scheme +- +- sfclay_select: SELECT CASE(config_flags%sf_sfclay_physics) +- +- CASE (SFCLAYSCHEME) +- CALL sfclayinit( allowed_to_read ) +- isfc = 1 +- CASE (PXSFCSCHEME) +- CALL pxsfclayinit( allowed_to_read ) +- isfc = 1 +- CASE (MYJSFCSCHEME) +- CALL myjsfcinit(LOWLYR,UST, & +-#if ( NMM_CORE == 1 ) +- Z0, & +-#else +- ZNT, & +-#endif +- XLAND,XICE, & +- IVGTYP,restart, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- isfc = 2 +- +- CASE (GFSSFCSCHEME) +- CALL myjsfcinit(LOWLYR,UST, & +-#if ( NMM_CORE == 1 ) +- Z0, & +-#else +- ZNT, & +-#endif +- XLAND,XICE, & +- IVGTYP,restart, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- isfc = 1 +- +- CASE DEFAULT +- +- END SELECT sfclay_select +- +- +-!-- initialize surface scheme +- +- sfc_select: SELECT CASE(config_flags%sf_surface_physics) +- +- CASE (SLABSCHEME) +- +- CALL slabinit(TSK,TMN, & +- TSLB,ZS,DZS,num_soil_layers, & +- allowed_to_read ,start_of_simulation ,& +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte, & +- oml_hml0, omlcall, & +- tml, t0ml, hml, h0ml, huml, hvml ) +- +-#if (NMM_CORE == 1) +- CASE (NMMLSMSCHEME) +- CALL nmmlsminit(isn,XICE,VEGFRA,SNOW,SNOWC, CANWAT,SMSTAV, & +- SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW, & +- ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,DZS,SFCEVP, & +- TMN, & +- num_soil_layers, & +- allowed_to_read , & +- ids,ide, jds,jde, kds,kde, & +- ims,ime, jms,jme, kms,kme, & +- its,ite, jts,jte, kts,kte ) +-#endif +- CASE (LSMSCHEME) +- CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV, & +- SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW, & +- ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, & +- FNDSOILW, FNDSNOWH, & +- num_soil_layers, restart, & +- allowed_to_read , & +- ids,ide, jds,jde, kds,kde, & +- ims,ime, jms,jme, kms,kme, & +- its,ite, jts,jte, kts,kte ) +- +-!URBAN +- IF(UCMCALL.eq.1) THEN +- +- IF ( PRESENT( FRC_URB2D ) .AND. PRESENT( UTYPE_URB2D )) THEN +- +- CALL urban_param_init(DZR,DZB,DZG,num_soil_layers & !urban +- ) +-! num_roof_layers,num_wall_layers,road_soil_layers) !urban +- CALL urban_var_init(TSK,TSLB,TMN,IVGTYP, & !urban +- ims,ime,jms,jme,num_soil_layers, & !urban +-! num_roof_layers,num_wall_layers,num_road_layers, & !urban +- restart, & !urban +- XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !urban +- TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !urban +- TRL_URB3D,TBL_URB3D,TGL_URB3D, & !urban +- SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D, TS_URB2D, & ! urban +- FRC_URB2D, UTYPE_URB2D) !urban +- ELSE +- CALL wrf_error_fatal ( 'arguments not present for calling urban model' ) +- ENDIF +- ENDIF +- +- +- CASE (RUCLSMSCHEME) +-! if(isfc .ne. 2)CALL wrf_error_fatal & +-! ( 'module_physics_init: use myjsfc and myjpbl scheme for this lsm option' ) +- CALL lsmrucinit( SMFR3D,TSLB,SMOIS,ISLTYP,mavail, & +- num_soil_layers, restart, & +- allowed_to_read , & +- ids,ide, jds,jde, kds,kde, & +- ims,ime, jms,jme, kms,kme, & +- its,ite, jts,jte, kts,kte ) +- +- CASE (PXLSMSCHEME) +- CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV, & +- SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW, & +- ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, & +- FNDSOILW, FNDSNOWH, & +- num_soil_layers, restart, & +- allowed_to_read , & +- ids,ide, jds,jde, kds,kde, & +- ims,ime, jms,jme, kms,kme, & +- its,ite, jts,jte, kts,kte ) +- +- CASE DEFAULT +- +- END SELECT sfc_select +- +- +-!-- initialize pbl scheme +- +- pbl_select: SELECT CASE(config_flags%bl_pbl_physics) +- +- CASE (YSUSCHEME) +- if(isfc .ne. 1)CALL wrf_error_fatal & +- ( 'module_physics_init: use sfclay scheme for this pbl option' ) +- CALL ysuinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & +- RQCBLTEN,RQIBLTEN,P_QI, & +- PARAM_FIRST_SCALAR, & +- restart, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- CASE (MRFSCHEME) +- if(isfc .ne. 1)CALL wrf_error_fatal & +- ( 'module_physics_init: use sfclay scheme for this pbl option' ) +- CALL mrfinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & +- RQCBLTEN,RQIBLTEN,P_QI, & +- PARAM_FIRST_SCALAR, & +- restart, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- CASE (ACMPBLSCHEME) +- if(isfc .ne. 1)CALL wrf_error_fatal & +- ( 'module_physics_init: use sfclay scheme for this pbl option' ) +- CALL acminit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & +- RQCBLTEN,RQIBLTEN,P_QI, & +- PARAM_FIRST_SCALAR, & +- restart, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- CASE (GFSSCHEME) +- if(isfc .ne. 1)CALL wrf_error_fatal & +- ( 'module_physics_init: use sfclay scheme for this pbl option' ) +- CALL gfsinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & +- RQCBLTEN,RQIBLTEN,P_QI, & +- PARAM_FIRST_SCALAR, & +- restart, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- CASE (MYJPBLSCHEME) +- if(isfc .ne. 2)CALL wrf_error_fatal & +- ( 'module_physics_init: use myjsfc scheme for this pbl option' ) +- CALL myjpblinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & +- TKE_MYJ,EXCH_H,restart, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- CASE DEFAULT +- +- END SELECT pbl_select +- +- END SUBROUTINE bl_init +- +-!================================================================== +- SUBROUTINE cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN, & +- RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC, & +- RAINCV,W0AVG,config_flags,restart, & +- CLDEFI,LOWLYR,MASS_FLUX, & +- RTHFTEN, RQVFTEN, & +- APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & +- APR_CAPMA,APR_CAPME,APR_CAPMI, & +- cugd_tten,cugd_ttens,cugd_qvten, & +- cugd_qvtens,cugd_qcten, & +- allowed_to_read, start_of_simulation, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +-!------------------------------------------------------------------ +- USE module_cu_kf +- USE module_cu_kfeta +- USE MODULE_CU_BMJ +- USE module_cu_gd, ONLY : GDINIT +- USE module_cu_g3, ONLY : G3INIT +- USE module_cu_sas +-!------------------------------------------------------------------ +- IMPLICIT NONE +-!------------------------------------------------------------------ +- TYPE (grid_config_rec_type) :: config_flags +- LOGICAL , INTENT(IN) :: restart +- +- +- INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte +- +- REAL , INTENT(IN) :: DT, CUDT +- LOGICAL , INTENT(IN) :: start_of_simulation +- LOGICAL , INTENT(IN) :: allowed_to_read +- INTEGER , INTENT(INOUT) :: STEPCU +- +- REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: & +- RTHCUTEN, RQVCUTEN, RQCCUTEN, RQRCUTEN, RQICUTEN, RQSCUTEN +- REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(INOUT) :: & +- cugd_tten,cugd_ttens,cugd_qvten, & +- cugd_qvtens,cugd_qcten +- +- REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG +- +- REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & +- RTHFTEN, RQVFTEN +- +- REAL , DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: RAINC, RAINCV +- +- REAL , DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: CLDEFI +- +- REAL , DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: NCA +- +- REAL , DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MASS_FLUX, & +- APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & +- APR_CAPMA,APR_CAPME,APR_CAPMI +- +- INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: LOWLYR +- +-! LOCAL VAR +- +- INTEGER :: i,j,itf,jtf +- +-!-------------------------------------------------------------------- +- +-!-- calculate cumulus parameterization time step +- +- itf=min0(ite,ide-1) +- jtf=min0(jte,jde-1) ++!!!!******MARS MARS MARS ++!!!!******MARS MARS MARS ++!!!!******MARS MARS MARS ++ ++!!===================================================================== ++! SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW, & ++! RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT, & ++! levsiz,XLAT,n_ozmixm, & ++! cldfra_old, & ! Optional ++! ozmixm,pin, & ! Optional ++! m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2, & ! Optional ++! paerlev,n_aerosolc, & ++! sfull,shalf,pptop,swrad_scat, & ++! config_flags,restart, & ++! allowed_to_read, start_of_simulation, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++!!--------------------------------------------------------------------- ++! USE module_ra_rrtm ++! USE module_ra_cam ++! USE module_ra_sw ++! USE module_ra_gsfcsw ++! USE module_ra_gfdleta ++! USE module_ra_hs ++! USE module_domain ++!!--------------------------------------------------------------------- ++! IMPLICIT NONE ++!!--------------------------------------------------------------------- ++! INTEGER, INTENT(IN) :: id ++! TYPE (grid_config_rec_type) :: config_flags ++! LOGICAL , INTENT(IN) :: restart ++! LOGICAL, INTENT(IN) :: allowed_to_read + ! +- STEPCU = nint(CUDT*60./DT) +- STEPCU = max(STEPCU,1) +- +-!-- initialization +- +- IF(start_of_simulation)THEN +- DO j=jts,jtf +- DO i=its,itf +- RAINC(i,j)=0. +- RAINCV(i,j)=0. +- ENDDO +- ENDDO +- ENDIF +- +- cps_select: SELECT CASE(config_flags%cu_physics) +- +- CASE (KFSCHEME) +- CALL kfinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & +- RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS, & +- PARAM_FIRST_SCALAR,restart, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- +- CASE (BMJSCHEME) +- CALL bmjinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & +- CLDEFI,LOWLYR,cp,r_d,restart, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- +- CASE (KFETASCHEME) +- CALL kf_eta_init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & +- RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS, & +- SVP1,SVP2,SVP3,SVPT0, & +- PARAM_FIRST_SCALAR,restart, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- CASE (GDSCHEME) +- CALL gdinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, & +- MASS_FLUX,cp,restart, & +- P_QC,P_QI,PARAM_FIRST_SCALAR, & +- RTHFTEN, RQVFTEN, & +- APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & +- APR_CAPMA,APR_CAPME,APR_CAPMI, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +-#if ( EM_CORE == 1 ) +- CASE (G3SCHEME) +- CALL g3init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, & +- MASS_FLUX,cp,restart, & +- P_QC,P_QI,PARAM_FIRST_SCALAR, & +- RTHFTEN, RQVFTEN, & +- APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & +- APR_CAPMA,APR_CAPME,APR_CAPMI, & +- cugd_tten,cugd_ttens,cugd_qvten, & +- cugd_qvtens,cugd_qcten, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +-#endif +- CASE (SASSCHEME) +- CALL sasinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, & +- restart,P_QC,P_QI,PARAM_FIRST_SCALAR, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- +- CASE DEFAULT +- +- END SELECT cps_select +- +- END SUBROUTINE cu_init +- +-!================================================================== +- SUBROUTINE mp_init(RAINNC,config_flags,restart,warm_rain, & +- adv_moist_cond, & +- MPDT, DT, DX, DY, LOWLYR, & ! for eta mp +- F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & ! for eta mp +- mp_restart_state,tbpvs_state,tbpvs0_state, & ! eta mp +- allowed_to_read, start_of_simulation, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +-!------------------------------------------------------------------ +- USE module_mp_wsm3 +- USE module_mp_wsm5 +- USE module_mp_wsm6 +- USE module_mp_etanew +- USE module_mp_thompson +- USE module_mp_morr_two_moment +-!------------------------------------------------------------------ +- IMPLICIT NONE +-!------------------------------------------------------------------ +-! Arguments +- TYPE (grid_config_rec_type) :: config_flags +- LOGICAL , INTENT(IN) :: restart +- LOGICAL , INTENT(OUT) :: warm_rain,adv_moist_cond +- REAL , INTENT(IN) :: MPDT, DT, DX, DY +- LOGICAL , INTENT(IN) :: start_of_simulation +- +- INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte +- +- INTEGER , DIMENSION( ims:ime , jms:jme ) ,INTENT(INOUT) :: LOWLYR +- REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: RAINNC +- REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: & +- F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY +- REAL , DIMENSION(:) ,INTENT(INOUT) :: mp_restart_state,tbpvs_state,tbpvs0_state +- LOGICAL , INTENT(IN) :: allowed_to_read +- +-! Local +- INTEGER :: i, j, itf, jtf +- +- warm_rain = .false. +- adv_moist_cond = .true. +- itf=min0(ite,ide-1) +- jtf=min0(jte,jde-1) +- +- IF(start_of_simulation)THEN +- DO j=jts,jtf +- DO i=its,itf +- RAINNC(i,j) = 0. +- ENDDO +- ENDDO +- ENDIF +- +- mp_select: SELECT CASE(config_flags%mp_physics) +- +- CASE (KESSLERSCHEME) +- warm_rain = .true. +- CASE (WSM3SCHEME) +- CALL wsm3init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read ) +- CASE (WSM5SCHEME) +- CALL wsm5init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read ) +- CASE (WSM6SCHEME) +- CALL wsm6init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read ) +- CASE (ETAMPNEW) +- adv_moist_cond = .false. +- CALL etanewinit (MPDT,DT,DX,DY,LOWLYR,restart, & +- F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & +- mp_restart_state,tbpvs_state,tbpvs0_state,& +- allowed_to_read, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- CASE (THOMPSON) +- CALL thompson_init +- CASE (MORR_TWO_MOMENT) +- CALL morr_two_moment_init +- +- CASE DEFAULT +- +- END SELECT mp_select +- +- END SUBROUTINE mp_init +- +-#if ( EM_CORE == 1 ) +-!========================================================== +- SUBROUTINE fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN, & +- RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, & +- config_flags,restart, & +- allowed_to_read , & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- +- +-!-------------------------------------------------------------------- +- USE module_fdda_psufddagd +-!-------------------------------------------------------------------- +- IMPLICIT NONE +-!-------------------------------------------------------------------- +- TYPE (grid_config_rec_type) :: config_flags +- LOGICAL , INTENT(IN) :: restart +- +- INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte +- +- REAL , INTENT(IN) :: DT, FGDT +- INTEGER , INTENT(IN) :: id +- INTEGER , INTENT(INOUT) :: STEPFG +- REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & +- RUNDGDTEN, & +- RVNDGDTEN, & +- RTHNDGDTEN, & +- RQVNDGDTEN +- REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: RMUNDGDTEN +- +- LOGICAL, INTENT(IN) :: allowed_to_read +-!-------------------------------------------------------------------- +- +-!-- calculate pbl time step +- +- STEPFG = nint(FGDT*60./DT) +- STEPFG = max(STEPFG,1) +- +- +-!-- initialize fdda scheme +- +- fdda_select: SELECT CASE(config_flags%grid_fdda) +- +- CASE (PSUFDDAGD) +- CALL fddagdinit(id,rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten,& +- config_flags%run_hours, & +- config_flags%if_no_pbl_nudging_uv, & +- config_flags%if_no_pbl_nudging_t, & +- config_flags%if_no_pbl_nudging_q, & +- config_flags%if_zfac_uv, & +- config_flags%k_zfac_uv, & +- config_flags%if_zfac_t, & +- config_flags%k_zfac_t, & +- config_flags%if_zfac_q, & +- config_flags%k_zfac_q, & +- config_flags%guv, & +- config_flags%gt, config_flags%gq, & +- config_flags%if_ramping, config_flags%dtramp_min, & +- config_flags%gfdda_end_h, & +- restart, allowed_to_read, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- CASE DEFAULT +- +- END SELECT fdda_select +- +- END SUBROUTINE fg_init +- +-!------------------------------------------------------------------- +- SUBROUTINE fdob_init(obs_nudge_opt, maxdom, inest, parid, & +- idynin, dtramp, fdaend, restart, & +- obs_twindo_cg, obs_twindo, itimestep, & +- cen_lat, cen_lon, stand_lon, & +- true_lat1, true_lat2, map_proj, & +- xlat, xlong, & +- s_sn_cg, e_sn_cg, s_we_cg, e_we_cg, & +- fdob, ipf_init, & +- ids, ide, jds, jde, kds, kde, & +- ims, ime, jms, jme, kms, kme, & +- its, ite, jts, jte, kts, kte ) +- +-!-------------------------------------------------------------------- +- USE module_domain +- USE module_fddaobs_rtfdda +- USE module_llxy +-!-------------------------------------------------------------------- +- IMPLICIT NONE +-!-------------------------------------------------------------------- +- INTEGER , INTENT(IN) :: maxdom +- INTEGER , INTENT(IN) :: obs_nudge_opt(maxdom) +- INTEGER , INTENT(IN) :: ids,ide, jds,jde, kds,kde, & +- ims,ime, jms,jme, kms,kme, & +- its,ite, jts,jte, kts,kte +- INTEGER , INTENT(IN) :: inest +- INTEGER , INTENT(IN) :: parid(maxdom) +- INTEGER , INTENT(IN) :: idynin ! flag for dynamic initialization +- REAL , INTENT(IN) :: dtramp ! time period for ramping (idynin) +- REAL , INTENT(IN) :: fdaend(maxdom) ! nudging end time for domain (min) +- LOGICAL , INTENT(IN) :: restart +- REAL , INTENT(IN) :: obs_twindo_cg ! twindo on course grid +- REAL , INTENT(IN) :: obs_twindo +- INTEGER , INTENT(IN) :: itimestep +- REAL , INTENT(IN) :: cen_lat ! domain center latitude +- REAL , INTENT(IN) :: cen_lon ! domain center longitude +- REAL , INTENT(IN) :: stand_lon ! domain longitude +- REAL , INTENT(IN) :: true_lat1 ! domain standard parallel +- REAL , INTENT(IN) :: true_lat2 ! domain second standard parallel +- INTEGER , INTENT(IN) :: map_proj ! map projection +- REAL, DIMENSION( ims:ime, jms:jme ), & +- INTENT(IN ) :: xlat, xlong ! lat/long locations on mass point grid +- INTEGER, intent(in) :: s_sn_cg ! starting north-south coarse-grid index +- INTEGER, intent(in) :: e_sn_cg ! ending north-south coarse-grid index +- INTEGER, intent(in) :: s_we_cg ! starting west-east coarse-grid index +- INTEGER, intent(in) :: e_we_cg ! ending west-east coarse-grid index +- +- TYPE(fdob_type), INTENT(INOUT) :: fdob +- +- INTEGER :: e_sn ! ending north-south grid index +- LOGICAL :: ipf_init ! print warnings detected at initialzn +-!-------------------------------------------------------------------- +-!-- initialize fdda obs-nudging scheme +- +- IF ( obs_nudge_opt(inest) .eq. 0 ) RETURN +- +- e_sn = jde +- CALL fddaobs_init(obs_nudge_opt, maxdom, inest, parid, & +- idynin, dtramp, fdaend, restart, & +- obs_twindo_cg, & +- obs_twindo, itimestep, & +- cen_lat, cen_lon, stand_lon, & +- true_lat1, true_lat2, map_proj, & +- xlat, xlong, & +- e_sn, s_sn_cg, e_sn_cg, s_we_cg, e_we_cg, & +- fdob, ipf_init, & +- ids,ide, jds,jde, kds,kde, & +- ims,ime, jms,jme, kms,kme, & +- its,ite, jts,jte, kts,kte) +- +- END SUBROUTINE fdob_init +-#endif ++! INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ++! ++! INTEGER , INTENT(IN) :: JULDAY,JULYR ++! REAL , INTENT(IN) :: DT, RADT, cen_lat, GMT, pptop, & ++! swrad_scat ++! LOGICAL, INTENT(IN) :: start_of_simulation ++! ++! INTEGER, INTENT(IN ) :: levsiz, n_ozmixm ++! INTEGER, INTENT(IN ) :: paerlev, n_aerosolc ++! ++! REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: XLAT ++! ++! REAL, DIMENSION( ims:ime, levsiz, jms:jme, n_ozmixm ), OPTIONAL, & ++! INTENT(INOUT) :: OZMIXM ++! ++! REAL, DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(INOUT) :: m_ps_1,m_ps_2 ++! REAL, DIMENSION(paerlev), OPTIONAL, INTENT(INOUT) :: m_hybi ++! REAL, DIMENSION( ims:ime, paerlev, jms:jme, n_aerosolc ), OPTIONAL, & ++! INTENT(INOUT) :: aerosolc_1, aerosolc_2 ++! ++! REAL, DIMENSION(levsiz), OPTIONAL, INTENT(INOUT) :: PIN ++! ++! INTEGER , INTENT(INOUT) :: STEPRA ++! INTEGER :: isn ++! ++! REAL , DIMENSION( kms:kme ) , INTENT(IN) :: sfull, shalf ++! REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & ++! RTHRATEN, & ++! RTHRATENLW, & ++! RTHRATENSW, & ++! CLDFRA ++! ++! REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: & ++! CLDFRA_OLD ++! ++! REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: EMISS ++! LOGICAL :: etalw = .false. ++! LOGICAL :: camlw = .false. ++! LOGICAL :: etamp = .false. ++! integer :: month,iday ++! INTEGER :: i, j, k, itf, jtf, ktf ++!!--------------------------------------------------------------------- ++! ++! jtf=min0(jte,jde-1) ++! ktf=min0(kte,kde-1) ++! itf=min0(ite,ide-1) ++! ++!!--------------------------------------------------------------------- ++! ++!!-- calculate radiation time step ++! ++! STEPRA = nint(RADT*60./DT) ++! STEPRA = max(STEPRA,1) ++! ++!!-- initialization ++! ++! IF(start_of_simulation)THEN ++! DO j=jts,jtf ++! DO k=kts,ktf ++! DO i=its,itf ++! RTHRATEN(i,k,j)=0. ++! RTHRATENLW(i,k,j)=0. ++! RTHRATENSW(i,k,j)=0. ++! CLDFRA(i,k,j)=0. ++! ENDDO ++! ENDDO ++! ENDDO ++! ++! if( present(cldfra_old) ) then ++! DO j=jts,jtf ++! DO k=kts,ktf ++! DO i=its,itf ++! cldfra_old(i,k,j) = 0. ++! ENDDO ++! ENDDO ++! ENDDO ++! end if ++! ENDIF ++! ++!!-- find out which microphysics option is used first ++! ++! mp_select: SELECT CASE(config_flags%mp_physics) ++! ++! CASE (ETAMPNEW) ++! etamp = .true. ++! ++! END SELECT mp_select ++! ++!!-- chose long wave radiation scheme ++! ++! lwrad_select: SELECT CASE(config_flags%ra_lw_physics) ++! ++! CASE (RRTMSCHEME) ++! CALL rrtminit( & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ++! CASE (CAMLWSCHEME) ++!#ifdef MAC_KLUDGE ++! CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' ) ++!#endif ++! IF ( PRESENT( OZMIXM ) .AND. PRESENT( PIN ) .AND. & ++! PRESENT(M_PS_1) .AND. PRESENT(M_PS_2) .AND. & ++! PRESENT(M_HYBI) .AND. PRESENT(AEROSOLC_1) & ++! .AND. PRESENT(AEROSOLC_2)) THEN ++! CALL camradinit( & ++! R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop, & ++! ozmixm,pin,levsiz,XLAT,n_ozmixm, & ++! m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,& ++! paerlev, n_aerosolc, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ELSE ++! CALL wrf_error_fatal ( 'arguments not present for calling cam radiation' ) ++! ENDIF ++! ++! camlw = .true. ++! ++! CASE (GFDLLWSCHEME) ++! CALL nl_get_start_month(id,month) ++! CALL nl_get_start_day(id,iday) ++! CALL gfdletainit(emiss,sfull,shalf,pptop, & ++! julyr,month,iday,gmt, & ++! config_flags,allowed_to_read, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! etalw = .true. ++! CASE (HELDSUAREZ) ++! CALL hsinit(RTHRATEN,restart, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! CASE DEFAULT ++! ++! END SELECT lwrad_select ++!!-- initialize short wave radiation scheme ++! ++! swrad_select: SELECT CASE(config_flags%ra_sw_physics) ++! ++! CASE (SWRADSCHEME) ++! CALL swinit( & ++! swrad_scat, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ++! CASE (CAMSWSCHEME) ++!#ifdef MAC_KLUDGE ++! CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' ) ++!#endif ++! IF(.not.camlw)THEN ++! CALL camradinit( & ++! R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop, & ++! ozmixm,pin,levsiz,XLAT,n_ozmixm, & ++! m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,& ++! paerlev, n_aerosolc, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ENDIF ++! ++! CASE (GSFCSWSCHEME) ++! CALL gsfc_swinit(cen_lat, allowed_to_read ) ++! ++! CASE (GFDLSWSCHEME) ++! IF(.not.etalw)THEN ++! CALL nl_get_start_month(id,month) ++! CALL nl_get_start_day(id,iday) ++! CALL gfdletainit(emiss,sfull,shalf,pptop, & ++! julyr,month,iday,gmt, & ++! config_flags,allowed_to_read, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ENDIF ++! ++! CASE DEFAULT ++! ++! END SELECT swrad_select ++! ++! END SUBROUTINE ra_init ++! ++! SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN, & ++! RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN, & ++! config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS, & ++! num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA, & ++! SNOW,SNOWC, CANWAT,SMSTAV, & ++! SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM, & ++! IVGTYP,ISLTYP,SMOIS,SMFR3D,mavail, & ++! SNOWH,SH2O,FNDSOILW, FNDSNOWH, & ++!#if ( NMM_CORE == 1 ) ++! Z0,XLAND,XICE, & ++!#else ++! ZNT,XLAND,XICE, & ++!#endif ++! SFCEVP,GRDFLX, & ++! allowed_to_read, & ++! start_of_simulation, & ++!! num_roof_layers,num_wall_layers,num_road_layers,& !Optional urban ++! DZR, DZB, DZG, & !Optional urban ++! TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !Optional urban ++! XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !Optional urban ++! TRL_URB3D, TBL_URB3D, TGL_URB3D, & !Optional urban ++! SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D, & !Optional urban ++! TS_URB2D, FRC_URB2D, UTYPE_URB2D,UCMCALL, & !Optional urban ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte, & ++! oml_hml0, omlcall, & !Optional oml ++! TML,T0ML,HML,H0ML,HUML,HVML ) !Optional oml ++!!-------------------------------------------------------------------- ++! USE module_sf_sfclay ++! USE module_sf_slab ++! USE module_sf_pxsfclay ++! USE module_bl_ysu ++! USE module_bl_mrf ++! USE module_bl_gfs ++! USE module_bl_acm ++! USE module_sf_myjsfc ++! USE module_sf_noahdrv ++! USE module_sf_urban ++! USE module_sf_ruclsm ++! USE module_sf_pxlsm ++! USE module_bl_myjpbl ++!#if (NMM_CORE == 1) ++! USE module_sf_lsm_nmm ++!#endif ++!!-------------------------------------------------------------------- ++! IMPLICIT NONE ++!!-------------------------------------------------------------------- ++! TYPE (grid_config_rec_type) :: config_flags ++! LOGICAL , INTENT(IN) :: restart ++! LOGICAL, INTENT(IN) :: FNDSOILW, FNDSNOWH ++! ++! INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ++! INTEGER , INTENT(IN) :: num_soil_layers ++! INTEGER , INTENT(IN) :: UCMCALL ++! ++! REAL , INTENT(IN) :: DT, BLDT ++! INTEGER , INTENT(INOUT) :: STEPBL ++! ++! REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ), & ++! INTENT(OUT) :: SMFR3D ++! ++! REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),& ++! INTENT(INOUT) :: SMOIS,SH2O,TSLB ++! ++! REAL, DIMENSION( ims:ime, jms:jme ) , & ++! INTENT(INOUT) :: SNOW, & ++! SNOWH, & ++! SNOWC, & ++! CANWAT, & ++! MAVAIL, & ++! SMSTAV, & ++! SMSTOT, & ++! SFCRUNOFF, & ++! UDRUNOFF, & ++! ACSNOW, & ++! VEGFRA, & ++! ACSNOM, & ++! SFCEVP, & ++! GRDFLX, & ++! UST, & ++!#if ( NMM_CORE == 1 ) ++! Z0, & ++!#else ++! ZNT, & ++!#endif ++! XLAND, & ++! XICE ++! ++! INTEGER, DIMENSION( ims:ime, jms:jme ) , & ++! INTENT(INOUT) :: IVGTYP, & ++! ISLTYP, & ++! LOWLYR ++! ++! ++! REAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: ZS,DZS ++! ++! REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & ++! RUBLTEN, & ++! RVBLTEN, & ++! EXCH_H, & ++! RTHBLTEN, & ++! RQVBLTEN, & ++! RQCBLTEN, & ++! RQIBLTEN, & ++! TKE_MYJ ++! ++! REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: TSK ++! REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: TMN ++! LOGICAL, INTENT(IN) :: allowed_to_read ++! INTEGER :: isn, isfc ++! ++!!URBAN ++!! REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR !Optional urban ++!! REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB !Optional urban ++!! REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG !Optional urban ++! REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR !Optional urban ++! REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB !Optional urban ++! REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !Optional urban ++! INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !Optional urban ++!! REAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban ++!! REAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban ++!! REAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban ++! REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban ++! ++!! Optional OML variables ++! REAL, DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(INOUT) :: & ++! TML,T0ML,HML,H0ML,HUML,HVML ++! INTEGER, OPTIONAL, INTENT(IN) :: omlcall ++! REAL, OPTIONAL, INTENT(IN) :: oml_hml0 ++! LOGICAL, INTENT(IN) :: start_of_simulation ++! ++!!-- calculate pbl time step ++! ++! STEPBL = nint(BLDT*60./DT) ++! STEPBL = max(STEPBL,1) ++! ++! ++!!-- initialize surface layer scheme ++! ++! sfclay_select: SELECT CASE(config_flags%sf_sfclay_physics) ++! ++! CASE (SFCLAYSCHEME) ++! CALL sfclayinit( allowed_to_read ) ++! isfc = 1 ++! CASE (PXSFCSCHEME) ++! CALL pxsfclayinit( allowed_to_read ) ++! isfc = 1 ++! CASE (MYJSFCSCHEME) ++! CALL myjsfcinit(LOWLYR,UST, & ++!#if ( NMM_CORE == 1 ) ++! Z0, & ++!#else ++! ZNT, & ++!#endif ++! XLAND,XICE, & ++! IVGTYP,restart, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! isfc = 2 ++! ++! CASE (GFSSFCSCHEME) ++! CALL myjsfcinit(LOWLYR,UST, & ++!#if ( NMM_CORE == 1 ) ++! Z0, & ++!#else ++! ZNT, & ++!#endif ++! XLAND,XICE, & ++! IVGTYP,restart, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! isfc = 1 ++! ++! CASE DEFAULT ++! ++! END SELECT sfclay_select ++! ++! ++!!-- initialize surface scheme ++! ++! sfc_select: SELECT CASE(config_flags%sf_surface_physics) ++! ++! CASE (SLABSCHEME) ++! ++! CALL slabinit(TSK,TMN, & ++! TSLB,ZS,DZS,num_soil_layers, & ++! allowed_to_read ,start_of_simulation ,& ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte, & ++! oml_hml0, omlcall, & ++! tml, t0ml, hml, h0ml, huml, hvml ) ++! ++!#if (NMM_CORE == 1) ++! CASE (NMMLSMSCHEME) ++! CALL nmmlsminit(isn,XICE,VEGFRA,SNOW,SNOWC, CANWAT,SMSTAV, & ++! SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW, & ++! ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,DZS,SFCEVP, & ++! TMN, & ++! num_soil_layers, & ++! allowed_to_read , & ++! ids,ide, jds,jde, kds,kde, & ++! ims,ime, jms,jme, kms,kme, & ++! its,ite, jts,jte, kts,kte ) ++!#endif ++! CASE (LSMSCHEME) ++! CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV, & ++! SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW, & ++! ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, & ++! FNDSOILW, FNDSNOWH, & ++! num_soil_layers, restart, & ++! allowed_to_read , & ++! ids,ide, jds,jde, kds,kde, & ++! ims,ime, jms,jme, kms,kme, & ++! its,ite, jts,jte, kts,kte ) ++! ++!!URBAN ++! IF(UCMCALL.eq.1) THEN ++! ++! IF ( PRESENT( FRC_URB2D ) .AND. PRESENT( UTYPE_URB2D )) THEN ++! ++! CALL urban_param_init(DZR,DZB,DZG,num_soil_layers & !urban ++! ) ++!! num_roof_layers,num_wall_layers,road_soil_layers) !urban ++! CALL urban_var_init(TSK,TSLB,TMN,IVGTYP, & !urban ++! ims,ime,jms,jme,num_soil_layers, & !urban ++!! num_roof_layers,num_wall_layers,num_road_layers, & !urban ++! restart, & !urban ++! XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !urban ++! TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !urban ++! TRL_URB3D,TBL_URB3D,TGL_URB3D, & !urban ++! SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D, TS_URB2D, & ! urban ++! FRC_URB2D, UTYPE_URB2D) !urban ++! ELSE ++! CALL wrf_error_fatal ( 'arguments not present for calling urban model' ) ++! ENDIF ++! ENDIF ++! ++! ++! CASE (RUCLSMSCHEME) ++!! if(isfc .ne. 2)CALL wrf_error_fatal & ++!! ( 'module_physics_init: use myjsfc and myjpbl scheme for this lsm option' ) ++! CALL lsmrucinit( SMFR3D,TSLB,SMOIS,ISLTYP,mavail, & ++! num_soil_layers, restart, & ++! allowed_to_read , & ++! ids,ide, jds,jde, kds,kde, & ++! ims,ime, jms,jme, kms,kme, & ++! its,ite, jts,jte, kts,kte ) ++! ++! CASE (PXLSMSCHEME) ++! CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV, & ++! SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW, & ++! ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, & ++! FNDSOILW, FNDSNOWH, & ++! num_soil_layers, restart, & ++! allowed_to_read , & ++! ids,ide, jds,jde, kds,kde, & ++! ims,ime, jms,jme, kms,kme, & ++! its,ite, jts,jte, kts,kte ) ++! ++! CASE DEFAULT ++! ++! END SELECT sfc_select ++! ++! ++!!-- initialize pbl scheme ++! ++! pbl_select: SELECT CASE(config_flags%bl_pbl_physics) ++! ++! CASE (YSUSCHEME) ++! if(isfc .ne. 1)CALL wrf_error_fatal & ++! ( 'module_physics_init: use sfclay scheme for this pbl option' ) ++! CALL ysuinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & ++! RQCBLTEN,RQIBLTEN,P_QI, & ++! PARAM_FIRST_SCALAR, & ++! restart, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! CASE (MRFSCHEME) ++! if(isfc .ne. 1)CALL wrf_error_fatal & ++! ( 'module_physics_init: use sfclay scheme for this pbl option' ) ++! CALL mrfinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & ++! RQCBLTEN,RQIBLTEN,P_QI, & ++! PARAM_FIRST_SCALAR, & ++! restart, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! CASE (ACMPBLSCHEME) ++! if(isfc .ne. 1)CALL wrf_error_fatal & ++! ( 'module_physics_init: use sfclay scheme for this pbl option' ) ++! CALL acminit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & ++! RQCBLTEN,RQIBLTEN,P_QI, & ++! PARAM_FIRST_SCALAR, & ++! restart, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! CASE (GFSSCHEME) ++! if(isfc .ne. 1)CALL wrf_error_fatal & ++! ( 'module_physics_init: use sfclay scheme for this pbl option' ) ++! CALL gfsinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & ++! RQCBLTEN,RQIBLTEN,P_QI, & ++! PARAM_FIRST_SCALAR, & ++! restart, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! CASE (MYJPBLSCHEME) ++! if(isfc .ne. 2)CALL wrf_error_fatal & ++! ( 'module_physics_init: use myjsfc scheme for this pbl option' ) ++! CALL myjpblinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & ++! TKE_MYJ,EXCH_H,restart, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! CASE DEFAULT ++! ++! END SELECT pbl_select ++! ++! END SUBROUTINE bl_init ++! ++!!================================================================== ++! SUBROUTINE cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN, & ++! RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC, & ++! RAINCV,W0AVG,config_flags,restart, & ++! CLDEFI,LOWLYR,MASS_FLUX, & ++! RTHFTEN, RQVFTEN, & ++! APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & ++! APR_CAPMA,APR_CAPME,APR_CAPMI, & ++! cugd_tten,cugd_ttens,cugd_qvten, & ++! cugd_qvtens,cugd_qcten, & ++! allowed_to_read, start_of_simulation, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++!!------------------------------------------------------------------ ++! USE module_cu_kf ++! USE module_cu_kfeta ++! USE MODULE_CU_BMJ ++! USE module_cu_gd, ONLY : GDINIT ++! USE module_cu_g3, ONLY : G3INIT ++! USE module_cu_sas ++!!------------------------------------------------------------------ ++! IMPLICIT NONE ++!!------------------------------------------------------------------ ++! TYPE (grid_config_rec_type) :: config_flags ++! LOGICAL , INTENT(IN) :: restart ++! ++! ++! INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ++! ++! REAL , INTENT(IN) :: DT, CUDT ++! LOGICAL , INTENT(IN) :: start_of_simulation ++! LOGICAL , INTENT(IN) :: allowed_to_read ++! INTEGER , INTENT(INOUT) :: STEPCU ++! ++! REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: & ++! RTHCUTEN, RQVCUTEN, RQCCUTEN, RQRCUTEN, RQICUTEN, RQSCUTEN ++! REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(INOUT) :: & ++! cugd_tten,cugd_ttens,cugd_qvten, & ++! cugd_qvtens,cugd_qcten ++! ++! REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG ++! ++! REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & ++! RTHFTEN, RQVFTEN ++! ++! REAL , DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: RAINC, RAINCV ++! ++! REAL , DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: CLDEFI ++! ++! REAL , DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: NCA ++! ++! REAL , DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MASS_FLUX, & ++! APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & ++! APR_CAPMA,APR_CAPME,APR_CAPMI ++! ++! INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: LOWLYR ++! ++!! LOCAL VAR ++! ++! INTEGER :: i,j,itf,jtf ++! ++!!-------------------------------------------------------------------- ++! ++!!-- calculate cumulus parameterization time step ++! ++! itf=min0(ite,ide-1) ++! jtf=min0(jte,jde-1) ++!! ++! STEPCU = nint(CUDT*60./DT) ++! STEPCU = max(STEPCU,1) ++! ++!!-- initialization ++! ++! IF(start_of_simulation)THEN ++! DO j=jts,jtf ++! DO i=its,itf ++! RAINC(i,j)=0. ++! RAINCV(i,j)=0. ++! ENDDO ++! ENDDO ++! ENDIF ++! ++! cps_select: SELECT CASE(config_flags%cu_physics) ++! ++! CASE (KFSCHEME) ++! CALL kfinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & ++! RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS, & ++! PARAM_FIRST_SCALAR,restart, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ++! CASE (BMJSCHEME) ++! CALL bmjinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & ++! CLDEFI,LOWLYR,cp,r_d,restart, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ++! CASE (KFETASCHEME) ++! CALL kf_eta_init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & ++! RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS, & ++! SVP1,SVP2,SVP3,SVPT0, & ++! PARAM_FIRST_SCALAR,restart, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! CASE (GDSCHEME) ++! CALL gdinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, & ++! MASS_FLUX,cp,restart, & ++! P_QC,P_QI,PARAM_FIRST_SCALAR, & ++! RTHFTEN, RQVFTEN, & ++! APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & ++! APR_CAPMA,APR_CAPME,APR_CAPMI, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++!#if ( EM_CORE == 1 ) ++! CASE (G3SCHEME) ++! CALL g3init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, & ++! MASS_FLUX,cp,restart, & ++! P_QC,P_QI,PARAM_FIRST_SCALAR, & ++! RTHFTEN, RQVFTEN, & ++! APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & ++! APR_CAPMA,APR_CAPME,APR_CAPMI, & ++! cugd_tten,cugd_ttens,cugd_qvten, & ++! cugd_qvtens,cugd_qcten, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++!#endif ++! CASE (SASSCHEME) ++! CALL sasinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, & ++! restart,P_QC,P_QI,PARAM_FIRST_SCALAR, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ++! CASE DEFAULT ++! ++! END SELECT cps_select ++! ++! END SUBROUTINE cu_init ++! ++!!================================================================== ++! SUBROUTINE mp_init(RAINNC,config_flags,restart,warm_rain, & ++! adv_moist_cond, & ++! MPDT, DT, DX, DY, LOWLYR, & ! for eta mp ++! F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & ! for eta mp ++! mp_restart_state,tbpvs_state,tbpvs0_state, & ! eta mp ++! allowed_to_read, start_of_simulation, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++!!------------------------------------------------------------------ ++! USE module_mp_wsm3 ++! USE module_mp_wsm5 ++! USE module_mp_wsm6 ++! USE module_mp_etanew ++! USE module_mp_thompson ++! USE module_mp_morr_two_moment ++!!------------------------------------------------------------------ ++! IMPLICIT NONE ++!!------------------------------------------------------------------ ++!! Arguments ++! TYPE (grid_config_rec_type) :: config_flags ++! LOGICAL , INTENT(IN) :: restart ++! LOGICAL , INTENT(OUT) :: warm_rain,adv_moist_cond ++! REAL , INTENT(IN) :: MPDT, DT, DX, DY ++! LOGICAL , INTENT(IN) :: start_of_simulation ++! ++! INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ++! ++! INTEGER , DIMENSION( ims:ime , jms:jme ) ,INTENT(INOUT) :: LOWLYR ++! REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: RAINNC ++! REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: & ++! F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY ++! REAL , DIMENSION(:) ,INTENT(INOUT) :: mp_restart_state,tbpvs_state,tbpvs0_state ++! LOGICAL , INTENT(IN) :: allowed_to_read ++! ++!! Local ++! INTEGER :: i, j, itf, jtf ++! ++! warm_rain = .false. ++! adv_moist_cond = .true. ++! itf=min0(ite,ide-1) ++! jtf=min0(jte,jde-1) ++! ++! IF(start_of_simulation)THEN ++! DO j=jts,jtf ++! DO i=its,itf ++! RAINNC(i,j) = 0. ++! ENDDO ++! ENDDO ++! ENDIF ++! ++! mp_select: SELECT CASE(config_flags%mp_physics) ++! ++! CASE (KESSLERSCHEME) ++! warm_rain = .true. ++! CASE (WSM3SCHEME) ++! CALL wsm3init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read ) ++! CASE (WSM5SCHEME) ++! CALL wsm5init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read ) ++! CASE (WSM6SCHEME) ++! CALL wsm6init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read ) ++! CASE (ETAMPNEW) ++! adv_moist_cond = .false. ++! CALL etanewinit (MPDT,DT,DX,DY,LOWLYR,restart, & ++! F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & ++! mp_restart_state,tbpvs_state,tbpvs0_state,& ++! allowed_to_read, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! CASE (THOMPSON) ++! CALL thompson_init ++! CASE (MORR_TWO_MOMENT) ++! CALL morr_two_moment_init ++! ++! CASE DEFAULT ++! ++! END SELECT mp_select ++! ++! END SUBROUTINE mp_init ++! ++!#if ( EM_CORE == 1 ) ++!!========================================================== ++! SUBROUTINE fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN, & ++! RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, & ++! config_flags,restart, & ++! allowed_to_read , & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ++! ++!!-------------------------------------------------------------------- ++! USE module_fdda_psufddagd ++!!-------------------------------------------------------------------- ++! IMPLICIT NONE ++!!-------------------------------------------------------------------- ++! TYPE (grid_config_rec_type) :: config_flags ++! LOGICAL , INTENT(IN) :: restart ++! ++! INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ++! ++! REAL , INTENT(IN) :: DT, FGDT ++! INTEGER , INTENT(IN) :: id ++! INTEGER , INTENT(INOUT) :: STEPFG ++! REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & ++! RUNDGDTEN, & ++! RVNDGDTEN, & ++! RTHNDGDTEN, & ++! RQVNDGDTEN ++! REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: RMUNDGDTEN ++! ++! LOGICAL, INTENT(IN) :: allowed_to_read ++!!-------------------------------------------------------------------- ++! ++!!-- calculate pbl time step ++! ++! STEPFG = nint(FGDT*60./DT) ++! STEPFG = max(STEPFG,1) ++! ++! ++!!-- initialize fdda scheme ++! ++! fdda_select: SELECT CASE(config_flags%grid_fdda) ++! ++! CASE (PSUFDDAGD) ++! CALL fddagdinit(id,rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten,& ++! config_flags%run_hours, & ++! config_flags%if_no_pbl_nudging_uv, & ++! config_flags%if_no_pbl_nudging_t, & ++! config_flags%if_no_pbl_nudging_q, & ++! config_flags%if_zfac_uv, & ++! config_flags%k_zfac_uv, & ++! config_flags%if_zfac_t, & ++! config_flags%k_zfac_t, & ++! config_flags%if_zfac_q, & ++! config_flags%k_zfac_q, & ++! config_flags%guv, & ++! config_flags%gt, config_flags%gq, & ++! config_flags%if_ramping, config_flags%dtramp_min, & ++! config_flags%gfdda_end_h, & ++! restart, allowed_to_read, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! CASE DEFAULT ++! ++! END SELECT fdda_select ++! ++! END SUBROUTINE fg_init ++! ++!!------------------------------------------------------------------- ++! SUBROUTINE fdob_init(obs_nudge_opt, maxdom, inest, parid, & ++! idynin, dtramp, fdaend, restart, & ++! obs_twindo_cg, obs_twindo, itimestep, & ++! cen_lat, cen_lon, stand_lon, & ++! true_lat1, true_lat2, map_proj, & ++! xlat, xlong, & ++! s_sn_cg, e_sn_cg, s_we_cg, e_we_cg, & ++! fdob, ipf_init, & ++! ids, ide, jds, jde, kds, kde, & ++! ims, ime, jms, jme, kms, kme, & ++! its, ite, jts, jte, kts, kte ) ++! ++!!-------------------------------------------------------------------- ++! USE module_domain ++! USE module_fddaobs_rtfdda ++! USE module_llxy ++!!-------------------------------------------------------------------- ++! IMPLICIT NONE ++!!-------------------------------------------------------------------- ++! INTEGER , INTENT(IN) :: maxdom ++! INTEGER , INTENT(IN) :: obs_nudge_opt(maxdom) ++! INTEGER , INTENT(IN) :: ids,ide, jds,jde, kds,kde, & ++! ims,ime, jms,jme, kms,kme, & ++! its,ite, jts,jte, kts,kte ++! INTEGER , INTENT(IN) :: inest ++! INTEGER , INTENT(IN) :: parid(maxdom) ++! INTEGER , INTENT(IN) :: idynin ! flag for dynamic initialization ++! REAL , INTENT(IN) :: dtramp ! time period for ramping (idynin) ++! REAL , INTENT(IN) :: fdaend(maxdom) ! nudging end time for domain (min) ++! LOGICAL , INTENT(IN) :: restart ++! REAL , INTENT(IN) :: obs_twindo_cg ! twindo on course grid ++! REAL , INTENT(IN) :: obs_twindo ++! INTEGER , INTENT(IN) :: itimestep ++! REAL , INTENT(IN) :: cen_lat ! domain center latitude ++! REAL , INTENT(IN) :: cen_lon ! domain center longitude ++! REAL , INTENT(IN) :: stand_lon ! domain longitude ++! REAL , INTENT(IN) :: true_lat1 ! domain standard parallel ++! REAL , INTENT(IN) :: true_lat2 ! domain second standard parallel ++! INTEGER , INTENT(IN) :: map_proj ! map projection ++! REAL, DIMENSION( ims:ime, jms:jme ), & ++! INTENT(IN ) :: xlat, xlong ! lat/long locations on mass point grid ++! INTEGER, intent(in) :: s_sn_cg ! starting north-south coarse-grid index ++! INTEGER, intent(in) :: e_sn_cg ! ending north-south coarse-grid index ++! INTEGER, intent(in) :: s_we_cg ! starting west-east coarse-grid index ++! INTEGER, intent(in) :: e_we_cg ! ending west-east coarse-grid index ++! ++! TYPE(fdob_type), INTENT(INOUT) :: fdob ++! ++! INTEGER :: e_sn ! ending north-south grid index ++! LOGICAL :: ipf_init ! print warnings detected at initialzn ++!!-------------------------------------------------------------------- ++!!-- initialize fdda obs-nudging scheme ++! ++! IF ( obs_nudge_opt(inest) .eq. 0 ) RETURN ++! ++! e_sn = jde ++! CALL fddaobs_init(obs_nudge_opt, maxdom, inest, parid, & ++! idynin, dtramp, fdaend, restart, & ++! obs_twindo_cg, & ++! obs_twindo, itimestep, & ++! cen_lat, cen_lon, stand_lon, & ++! true_lat1, true_lat2, map_proj, & ++! xlat, xlong, & ++! e_sn, s_sn_cg, e_sn_cg, s_we_cg, e_we_cg, & ++! fdob, ipf_init, & ++! ids,ide, jds,jde, kds,kde, & ++! ims,ime, jms,jme, kms,kme, & ++! its,ite, jts,jte, kts,kte) ++! ++! END SUBROUTINE fdob_init ++!#endif + + !-------------------------------------------------------------------- + SUBROUTINE z2sigma(zf,zh,sf,sh,p_top,pptop,config_flags, & +diff --git a/WRF.COMMON/WRFV3/share/module_model_constants.F b/WRF.COMMON/WRFV3/share/module_model_constants.F +index 6cfad577..44c0b46c 100644 +--- a/WRF.COMMON/WRFV3/share/module_model_constants.F ++++ b/WRF.COMMON/WRFV3/share/module_model_constants.F +@@ -1,51 +1,23 @@ + !WRF:MODEL_LAYER:CONSTANTS + ! ++!PLANET MARS + + MODULE module_model_constants +- ++ USE module_configure + ! 2. Following are constants for use in defining real number bounds. + + ! A really small number. +- ++ character(len=15) :: planet + REAL , PARAMETER :: epsilon = 1.E-15 + + ! 4. Following is information related to the physical constants. + +- ! These are the physical constants used within the model. +- +-! JM NOTE -- can we name this grav instead? +- REAL , PARAMETER :: g = 9.81 ! acceleration due to gravity (m {s}^-2) +- +-#if ( NMM_CORE == 1 ) +- REAL , PARAMETER :: r_d = 287.04 +- REAL , PARAMETER :: cp = 1004.6 +-#else +- REAL , PARAMETER :: r_d = 287. +- REAL , PARAMETER :: cp = 7.*r_d/2. +-#endif ++ ! These are the physical parameter used within the model. + +- REAL , PARAMETER :: r_v = 461.6 +- REAL , PARAMETER :: cv = cp-r_d +- REAL , PARAMETER :: cpv = 4.*r_v +- REAL , PARAMETER :: cvv = cpv-r_v +- REAL , PARAMETER :: cvpm = -cv/cp +- REAL , PARAMETER :: cliq = 4190. +- REAL , PARAMETER :: cice = 2106. +- REAL , PARAMETER :: psat = 610.78 +- REAL , PARAMETER :: rcv = r_d/cv +- REAL , PARAMETER :: rcp = r_d/cp +- REAL , PARAMETER :: rovg = r_d/g +- REAL , PARAMETER :: c2 = cp * rcv +- real , parameter :: mwdry = 28.966 ! molecular weight of dry air (g/mole) +- +- REAL , PARAMETER :: p1000mb = 100000. +- REAL , PARAMETER :: t0 = 300. +- REAL , PARAMETER :: p0 = p1000mb +- REAL , PARAMETER :: cpovcv = cp/(cp-r_d) +- REAL , PARAMETER :: cvovcp = 1./cpovcv +- REAL , PARAMETER :: rvovrd = r_v/r_d +- +- REAL , PARAMETER :: reradius = 1./6370.0e03 ++ !! added in WRFV3 ++ real , parameter :: mwdry = 43.49 ! molecular weight of dry air (g/mole) ++! ++!------------------------------- + + REAL , PARAMETER :: asselin = .025 + ! REAL , PARAMETER :: asselin = .0 +@@ -62,26 +34,31 @@ + + REAL , PARAMETER :: rhowater = 1000. + REAL , PARAMETER :: rhosnow = 100. +- REAL , PARAMETER :: rhoair0 = 1.28 +- ++ REAL , PARAMETER :: rhoair0 = 0.02 !Earth Surface density: 1.217 kg/m3 ++ !Mars Surface density: 0.020 kg/m3 + REAL , PARAMETER :: DEGRAD = 3.1415926/180. +- REAL , PARAMETER :: DPD = 360./365. ++ REAL , PARAMETER :: DPD = 360./669. ! longitude solaire d'un jour? + + REAL , PARAMETER :: SVP1=0.6112 + REAL , PARAMETER :: SVP2=17.67 + REAL , PARAMETER :: SVP3=29.65 + REAL , PARAMETER :: SVPT0=273.15 +- REAL , PARAMETER :: EP_1=R_v/R_d-1. +- REAL , PARAMETER :: EP_2=R_d/R_v +- REAL , PARAMETER :: KARMAN=0.4 +- REAL , PARAMETER :: EOMEG=7.2921E-5 +- REAL , PARAMETER :: STBOLT=5.67051E-8 ++ REAL , PARAMETER :: KARMAN=0.4 ! von karman constant ++ REAL , PARAMETER :: STBOLT=5.67051E-8 ! stefan-boltzmann constant + ++ !! NB: c_s and c_k in WRFV2 moved to module_diffusion_em.F ++ !! NB: no need in WRFV3 because set in namelist + REAL , PARAMETER :: prandtl = 1./3.0 + ! constants for w-damping option +- REAL , PARAMETER :: w_alpha = 0.3 ! strength m/s/s +- REAL , PARAMETER :: w_beta = 1.0 ! activation cfl number ++! REAL , PARAMETER :: w_alpha = 0.3 ! strength m/s/s ++ REAL , PARAMETER :: w_alpha = 2.0 ! strength m/s/s ++! REAL , PARAMETER :: w_beta = 1.0 ! activation cfl number ++ REAL , PARAMETER :: w_beta = 0.8 ! activation cfl number + ++!! in WRFV3 ++! REAL , PARAMETER :: w_alpha = 0.3 ! strength m/s/s ++! REAL , PARAMETER :: w_beta = 1.0 ! activation cfl number ++!! + REAL , PARAMETER :: pq0=379.90516 + REAL , PARAMETER :: epsq2=0.2 + ! REAL , PARAMETER :: epsq2=0.02 +@@ -89,7 +66,6 @@ + REAL , PARAMETER :: a3=273.16 + REAL , PARAMETER :: a4=35.86 + REAL , PARAMETER :: epsq=1.e-12 +- REAL , PARAMETER :: p608=rvovrd-1. + !#if ( NMM_CORE == 1 ) + REAL , PARAMETER :: climit=1.e-20 + REAL , PARAMETER :: cm1=2937.4 +@@ -102,8 +78,9 @@ + REAL , PARAMETER :: epsfc=1./1.05 + REAL , PARAMETER :: epswet=0.0 + REAL , PARAMETER :: fcdif=1./3. ++! REAL , PARAMETER :: fcm=0.003 + REAL , PARAMETER :: fcm=0.00003 +- REAL , PARAMETER :: gma=-r_d*(1.-rcp)*0.5 ++! REAL , PARAMETER :: fcm=0.0 + REAL , PARAMETER :: p400=40000.0 + REAL , PARAMETER :: phitp=15000.0 + REAL , PARAMETER :: pi2=2.*3.1415926 +@@ -111,7 +88,6 @@ + REAL , PARAMETER :: plomd=64200.0 + REAL , PARAMETER :: pmdhi=35000.0 + REAL , PARAMETER :: q2ini=0.50 +- REAL , PARAMETER :: rfcp=0.25/cp + REAL , PARAMETER :: rhcrit_land=0.75 + REAL , PARAMETER :: rhcrit_sea=0.80 + REAL , PARAMETER :: rlag=14.8125 +@@ -123,11 +99,13 @@ + REAL , PARAMETER :: wght=0.35 + REAL , PARAMETER :: wpc=0.075 + REAL , PARAMETER :: z0land=0.10 ++! REAL , PARAMETER :: z0max=0.01 + REAL , PARAMETER :: z0max=0.008 + REAL , PARAMETER :: z0sea=0.001 ++ REAL, PARAMETER :: r_v=461.6 ! gas constant for water vapor + !#endif + +- ++!!!! needed in WRFV3 + ! Earth + + ! The value for P2SI *must* be set to 1.0 for Earth +@@ -145,8 +123,202 @@ + ! Fraction into the year (from perhelion) of the + ! occurrence of the Northern Spring Equinox + REAL , PARAMETER :: EQUINOX_FRACTION= 0.0 ++!!!! needed in WRFV3 ++ ++ ! These are the physical constants planet dependent used within the model. ++ ++ real :: g ++ REAL :: r_d ++ REAL :: cp ++ !REAL :: cpp ++ REAL :: cv ++ REAL :: cpv ++ REAL :: cvv ++ REAL :: cvpm ++ REAL :: cliq ++ REAL :: cice ++ REAL :: psat ++ REAL :: rcv ++ REAL :: rcp ++ REAL :: rovg ++ REAL :: c2 ++ REAL :: EOMEG ! angular rotation rate (rad.s-1) + ++ REAL :: p1000mb ++ REAL :: t0 ++ REAL :: p0 ++ REAL :: cpovcv ++ REAL :: cvovcp ++ REAL :: rvovrd ++ REAL :: gma ++ REAL :: EP_1 ++ REAL :: EP_2 ++ REAL :: rfcp ++ REAL :: p608 ++ REAL :: rad ++ REAL :: reradius ++ Real :: molmas !Molecular mass ++ ++ REAL :: wdaysec ! duree du sol (s) ~88775 s ++ REAL :: wmugaz ! Masse molaire de l'atm (g.mol-1) ~43.49 ++ REAL :: womeg ! omega (rad.s-1) ++ REAL :: wyear_day ! Duree de l'annee (sols) ~668.6 ++ REAL :: wperiheli ! Dist.min. soleil-mars (Mkm) ~206.66 ++ REAL :: waphelie ! Dist.max. soleil-mars (Mkm) ~249.22 ++ REAL :: wperi_day ! Date du perihelie (sols depuis printemps) ++ REAL :: wobliquit ! Obliquite de la planete (deg) ~25.2 ++ REAL :: wz0 ! surface roughness (m) ~0.01 ++ REAL :: wlmixmin ! longueur de melange ~100 ++ REAL :: wemin_turb ! energie minimale ~1.e-8 ++ REAL :: wemissiv ! Emissivite du sol martien ~.95 ++ REAL :: wemissiceN ! Emissivite calotte nord ++ REAL :: wemissiceS ! Emissivite calotte sud ++ REAL :: walbediceN ! Albedo calotte nord !0.5 ++ REAL :: walbediceS ! Albedo calotte sud !0.5 ++ REAL :: wiceradiusN ! mean scat radius of CO2 snow (north) ++ REAL :: wiceradiusS ! mean scat radius of CO2 snow (south) ++ REAL :: wdtemisiceN ! time scale for snow metamorphism (north) !2 ++ REAL :: wdtemisiceS ! time scale for snow metamorphism (south) !2 ++ REAL :: wvolcapa ! volumetric capacity of soil (new soil model) ++ REAL :: z_scale ! scale height ++ ++ REAL :: TT00 ++ REAL :: nu + CONTAINS +- SUBROUTINE init_module_model_constants +- END SUBROUTINE init_module_model_constants ++ SUBROUTINE init_module_model_constants ++ IMPLICIT NONE ++ Call initial_config ++ planet=model_config_rec%planet ++ !write(*,*) "unknown planet type", planet ++ !stop ++ ++ ! These are the physical constants used within the model ++ ++ IF ( planet == "mars" ) then ++! JM NOTE -- can we name this grav instead? ++ g = 3.72 ! acceleration due to gravity (m {s}^-2) ++ ++!#if ( NMM_CORE == 1 ) ++! REAL :: r_d = 192. ! gas constant m2 s-2 K-1 ++! REAL :: cp = 844.6 ! r= 8.314511E+0 *1000.E+0/mugaz ++!#else ++! REAL :: r_d = 192. ++! REAL :: cp = 844.6 ++!#endif ++ ++ r_d = 191. ++ cp = 744.5 ++ cliq = 4190. ++ cice = 2106. ++ psat = 610.78 ++ t0 = 220. ! earth : 300 ... à remplacer par 220 ? ++ p0 = 610. ++ p1000mb = 610. ++ reradius = 1./3397200. ! Rayon de mars (m) ~3397200 m ++ EOMEG =7.0721E-5 ! angular rotation rate (rad.s-1) ++ wdaysec = 88800. ! duree du sol (s) ~88775 s ++ wmugaz = 43.49 ! Masse molaire de l'atm (g.mol-1) ~43.49 ++ womeg = 7.0721E-5 ! omega (rad.s-1) ++ wyear_day = 669. ! Duree de l'annee (sols) ~668.6 ++ wperiheli = 206.66 ! Dist.min. soleil-mars (Mkm) ~206.66 ++ waphelie = 249.22 ! Dist.max. soleil-mars (Mkm) ~249.22 ++ wperi_day = 485. ! Date du perihelie (sols depuis printemps) ++ wobliquit = 25.2 ! Obliquite de la planete (deg) ~25.2 ++ wz0 = 1.e-2 ! surface roughness (m) ~0.01 ++ wlmixmin = 30. ! longueur de melange ~100 ++ wemin_turb = 1.e-6 ! energie minimale ~1.e-8 ++ wemissiv = 0.95 ! Emissivite du sol martien ~.95 ++ wemissiceN = 0.95 ! Emissivite calotte nord ++ wemissiceS = 0.95 ! Emissivite calotte sud ++ walbediceN = 0.65 ! Albedo calotte nord !0.5 ++ walbediceS = 0.65 ! Albedo calotte sud !0.5 ++ wiceradiusN = 100.e-6 ! mean scat radius of CO2 snow (north) ++ wiceradiusS = 100.e-6 ! mean scat radius of CO2 snow (south) ++ wdtemisiceN = 0.4 ! time scale for snow metamorphism (north) !2 ++ wdtemisiceS = 0.4 ! time scale for snow metamorphism (south) !2 ++#ifdef NEWPHYS ++ wvolcapa = 1.e6 ! volumetric capacity of soil (new soil model) ++#endif ++ TT00=0. ++ nu=0. ++!#endif ++ ELSE if ( planet == "venus") then ++ g = 8.87 ++ r_d = 191.84383904727036 ++ !cpp = 1000. ++ cp = 1000. ++ cliq = 4190. ++ psat = 610.78 ++ t0 = 735. ! earth : 300 ++ p0 = 92.e5 ++ p1000mb = 92.e5 ++ reradius = 1./6051800. ! Rayon de mars (m) ~6051800 m ++ rad = 6051800. ++ wmugaz = 43.49 ++ womeg = 0.2992549E-06 ++ wdaysec = 0.1008707E08 ++ TT00=460. ++ nu=0.35 ++ ELSE if ( planet == "titan") then ++ g = 1.35 ++ r_d = 290.6 ++ !cpp = 1000. ++ cp = 1051. ++ cliq = 4190. ++ psat = 610.78 ++ t0 = 94. ! earth : 300 ++ p0 = 1.45e5 ++ p1000mb = 1.45e5 ++ reradius = 1./2575500.0 ! Rayon de mars (m) ~6051800 m ++ rad = 2575500.0 ++ wmugaz = 28.6 ++ womeg = 0.2992549E-06 !!!!!!!!!!!!!!!!!!! ++ wdaysec = 1377665.28 ++ TT00=0. ++ nu=0. ++ ELSE if (( planet == "prescribed").or.(planet == "generic")) then ++ open(17,file='planet_constant',form='formatted',status='old') ++ rewind(17) ++ read(17,*) g ++ read(17,*) cp ++ read(17,*) molmas ++ read(17,*) t0 ++ read(17,*) p0 ++ read(17,*) rad ++ close(17) ++ r_d=8.314/(molmas*1e-3) ++ p1000mb=p0 ++ reradius=1./rad ++ TT00=0. ++ nu=0. ++ Else ++ write(*,*) "unknown planet type:", planet ++ stop ++ endif ++ cv = cp-r_d ++ cpv = 3.9*r_v ++ cvv = cpv-r_v ++ cvpm = -cv/cp ++ rcv = r_d/cv ++ rcp = r_d/cp ++ rovg = r_d/g ++ c2 = cp * rcv ++ cpovcv = cp/(cp-r_d) ++ cvovcp = 1./cpovcv ++ rvovrd = r_v/r_d ++ gma = -r_d*(1.-rcp)*0.5 ++ EP_1 = r_v/r_d-1. ++ EP_2 = r_d/r_v ++ rfcp =0.25/cp ++ p608 =rvovrd-1. ++ z_scale =(r_d*t0/g)*1e-3 ++ write(*,*) "planet : ", planet ++ write(*,*) "g = ", g ++ write(*,*) "cp = ", cp ++ write(*,*) "r_d = ", r_d ++ write(*,*) "t0 = ", t0 ++ write(*,*) "p0 = ", p0 ++ write(*,*) "T0 = ", TT00 ++ write(*,*) "nu = ", nu ++ END SUBROUTINE init_module_model_constants + END MODULE module_model_constants Index: /trunk/WRF.COMMON/WRFV3/Registry/Registry.EM =================================================================== --- /trunk/WRF.COMMON/WRFV3/Registry/Registry.EM (revision 2761) +++ /trunk/WRF.COMMON/WRFV3/Registry/Registry.EM (revision 2761) @@ -0,0 +1,1841 @@ +# Registry file, EM +# +# At the present time this file is managed manually and edited by hand. +# +################################################################################ +# Dimension specifications +# +# This section of the Registry file is used to specify the dimensions +# that will be used to define arrays. Dim is the one-letter name of the +# dimension. How defined can either be "standard_domain", which means +# that the dimension (1) is one of the three spatial dimensions and (2) +# it will be set using the standard namelist mechanism and domain data +# structure dimension fields (e.g. sd31,ed31,sd32...). +# +# Order refers to which of the three sets of just-mentioned internal +# dimension variables the dimension is referred to by in the driver. +# That is, is it the first, second, or third dimension. The registry +# infers the mapping of its internal dimensions according to the +# combination of Order and Coord-axis that are specified in this table. +# Note that it is all right to more than one dimension name for, say, the +# x dimension. However, the Order and Coord-axis relationship must be +# consistent throughout. +# +# Note: these entries do not enforce storage order on a particular field. +# That is determined by the dimension strings for each field. But it does +# relate the dimspec to the internal data structures that the driver uses +# to maintain the three physical domain dimensions. +# +# "How defined" can also specify the name of a namelist variable from which +# the definition for the dimension will come; this is specified as +# "namelist=". The namelist variable must have been +# defined as an integer and with only one entry in the rconfig table. Or +# a constant can be specified. The coordinate axis for the dimension is +# either X, Y, Z, or C (for "not a spatial dimension"). The Dimname is +# the descriptive name of the dimension that will be included in the +# metadata in data sets. Note that the b, f, and t modifiers that appear +# as the last characters of dimension strings used # in state and # i1 +# registry definitions are not dimensions and do not need to be declared +# here. +# + +# Available characters for dimspec: 0123456789@%+=|?.!&[{}] + +# +dimspec i 1 standard_domain x west_east +dimspec j 3 standard_domain y south_north +dimspec k 2 standard_domain z bottom_top +dimspec l 2 namelist=num_soil_layers z soil_layers +dimspec u 2 namelist=num_land_cat z land_cat +dimspec s 2 namelist=num_soil_cat z soil_cat +dimspec p - constant=7501 c microphysics_rstrt_state +dimspec w - namelist=spec_bdy_width c spec_bdy_width +dimspec e 3 namelist=ensdim z ensemble dimension +dimspec n 1 namelist=dfi_time_dim c dfi time dimension +dimspec z - namelist=max_obs c max_obs +dimspec h - namelist=nobs_err_flds c nobs_err_flds +dimspec r - namelist=nobs_ndg_vars c nobs_ndg_vars +dimspec g 2 namelist=num_metgrid_levels z num_metgrid_levels +dimspec m 2 constant=12 z months_per_year +dimspec a - namelist=cam_abs_dim1 c cam_abs_dim1 +dimspec c - namelist=cam_abs_dim2 z cam_abs_dim2 +dimspec q 2 namelist=levsiz z levsiz +dimspec d 2 namelist=paerlev z paerlev +dimspec ? - namelist=ts_buf_size c ts_buf_size +dimspec ! - namelist=max_ts_locs c max_ts_locs +dimspec v - constant=1 z one + + +################################################################################ +################################################################################ +################################################################################ + + +####MARS MARS MARS MARS MARS +####MARS MARS MARS MARS MARS +#### +#### variables physiques ecrites dans les fichiers WRF +#### - h indique l'ecriture +#### +#### +#### RADIATIVE TRANSFER +state real HR_SW ikj misc 1 - - "HR_SW" "HEATING RATE SW" "K/s" +state real HR_LW ikj misc 1 - - "HR_LW" "HEATING RATE LW" "K/s" +state real HR_DYN ikj misc 1 - - "HR_DYN" "HEATING RATE DYN" "K/s" +state real DDT ikj misc 1 - - "DDT" "TEMPERATURE TENDENCY" "K/s" +state real DT_RAD ikj misc 1 - - "DT_RAD" "RADIATIVE TEMPERATURE TENDENCY" "K/s" +state real DT_VDF ikj misc 1 - - "DT_VDF" "PBL CLMAIN TEMPERATURE TENDENCY" "K/s" +state real DT_AJS ikj misc 1 - - "DT_AJS" "AJUSTEMENT SEC TEMPERATURE TENDENCY" "K/s" + +state real SWDOWNZ ij misc 1 - - "SWDOWNZ" "DOWNWARD SW FLUX AT SURFACE" "W m-2" +#### DUST CYCLE +state real TAU_DUST ij misc 1 - - "TAU_DUST" "REFERENCE VISIBLE DUST OPACITY" "" +state real RDUST ikj misc 1 - - "RDUST" "DUST RADIUS" "m" +state real QSURFDUST ij misc 1 - - "QSURFDUST" "DUST MASS AT SURFACE" "kg m-2" +#### CLOUDS +state real MTOT ij misc 1 - - "MTOT" "TOTAL MASS WATER VAPOR in pmic" "pmic" +state real ICETOT ij misc 1 - - "ICETOT" "TOTAL MASS WATER ICE" "kg m-2" +state real VMR_ICE ikj misc 1 - - "VMR_ICE" "VOL. MIXING RATIO ICE" "ppm" +state real TAU_ICE ij misc 1 - - "TAU_ICE" "CLOUD OD at 825 cm-1 TES" "" +state real RICE ikj misc 1 - - "RICE" "ICE RADIUS" "m" +#### THERMALS +state real ZMAX ij misc 1 - - "ZMAX" "MAXIMUM LEVEL THERMALS" "m" +state real HFMAX ij misc 1 - - "HFMAX" "MAXIMUM PBL HEAT FLUX" "m.K/s" +#### GENERIC OUTPUTS +state real CLOUDFRAC ikj misc 1 - - "CLOUDFRAC" "CLOUD FRACTION" "" +state real TOTCLOUDFRAC ij misc 1 - - "TOTCLOUDFRAC" "COLUMN CLOUD FRACTION" "" +state real GRAIN ikj misc 1 - - "RAIN" "RAIN kg/kg.s-1" "" +state real GSNOW ikj misc 1 - - "SNOW" "SNOW kg/kg.s-1" "" +state real ALBEQ ij misc 1 - - "ALBEQ" "ALBEDO EQUIVALENT" "" +state real FLUXTOP_DN ij misc 1 - h "FLUXTOP_DN" "Incoming SW radiation at the TOA" "W.m-2" +state real FLUXABS_SW ij misc 1 - h "FLUXABS_SW" "Absorbed SW flux" "W.m-2" +state real FLUXTOP_LW ij misc 1 - h "FLUXTOP_LW" "Outgoing LW flux TOA" "W.m-2" +state real FLUXSURF_SW ij misc 1 - h "FLUXSURF_SW" "SW Surface flux" "W.m-2" +state real FLUXSURF_LW ij misc 1 - h "FLUXSURF_LW" "LW Surface flux" "W.m-2" +state real FLXGRD ij misc 1 - h "FLXGRD" "heat flux from ground" "W.m-2" +state real LSCEZ ikj misc 1 - - "LSCEZ" "heat from largescale" "W.m-2" +state real H2OICE_REFF ikj misc 1 - - "H2OICE_REFF" "Radii of H2O ice" "m" +state real LATENT_HF ij misc 1 - - "LATENT_HF" "Latent heat flux" "W.m-2" +state real REEVAP ij misc 1 - - "REEVAP" "Re-evaporation flux of precipitation (integrated over the atmospheric column)" +state real SURFRAIN ij misc 1 - - "SURFRAIN" "Rainfall" "kg m-2 s-1" + +#### +#### +####MARS MARS MARS MARS MARS +####MARS MARS MARS MARS MARS + +####MARS MARS MARS MARS MARS +####MARS MARS MARS MARS MARS +#### +#### +#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE (>> mais l'ordre n'est-il pas defini plus bas ? dans les options mars ?) +#### - effacer le h si l'on veut eviter les sorties +#### +state real - ikjftb scalar 1 - - - +state real QH2O ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2O" "Water vapor mixing ratio" "kg kg-1" +state real QH2O_ICE ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2O_ICE" "Water ice mixing ratio" "kg kg-1" +state real qdust ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QDUST" "Dust mixing ratio" "kg kg-1" +state real qdustn ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QDUSTN" "Dust number density" " m-3 " +state real qtrac1 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "qtrac1" "Decaying tracer 1" "kg kg-1" +state real qccn ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCCN" "CCN mixing ratio" "kg kg-1" +state real qccnn ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCCNN" "CCN number mixing ratio" "kg kg-1" +#### +#### +####MARS MARS MARS MARS MARS +####MARS MARS MARS MARS MARS +###VENUS TRACER +state real qco2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCO2" "CO2 number mixing ratio" "kg kg-1" +state real qco ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCO" "CO number mixing ratio" "kg kg-1" +state real qh2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2" "H2 number mixing ratio" "kg kg-1" +state real qo1d ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO1D" "O1d number mixing ratio" "kg kg-1" +state real qo ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO" "O number mixing ratio" "kg kg-1" +state real qo2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO2" "O2 number mixing ratio" "kg kg-1" +state real qo2dg ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO2dg" "O2dg number mixing ratio" "kg kg-1" +state real qo3 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO3" "O3 number mixing ratio" "kg kg-1" +state real qh ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH" "H number mixing ratio" "kg kg-1" +state real qoh ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QOH" "OH number mixing ratio" "kg kg-1" +state real qho2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QHO2" "HO2 number mixing ratio" "kg kg-1" +state real qh2o2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2O2" "H2O2 number mixing ratio" "kg kg-1" +state real qcl ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCL" "Cl number mixing ratio" "kg kg-1" +state real qclo ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCLO" "ClO number mixing ratio" "kg kg-1" +state real qcl2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCL2" "Cl2 number mixing ratio" "kg kg-1" +state real qhcl ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QHCL" "HCl number mixing ratio" "kg kg-1" +state real qhocl ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QHOCL" "HOCl number mixing ratio" "kg kg-1" +state real qclco ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCLCO" "ClCO number mixing ratio" "kg kg-1" +state real qclco3 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCLCO3" "ClCO3 number mixing ratio" "kg kg-1" +state real qcocl2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCOCL2" "COCl2 number mixing ratio" "kg kg-1" +state real qss ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QS" "S number mixing ratio" "kg kg-1" +state real qso ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QSO" "SO number mixing ratio" "kg kg-1" +state real qso2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QSO2" "SO2 number mixing ratio" "kg kg-1" +state real qso3 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QSO3" "SO3 number mixing ratio" "kg kg-1" +state real qs2o2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QS2O2" "S2O2 number mixing ratio" "kg kg-1" +state real qocs ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QOCS" "OCS number mixing ratio" "kg kg-1" +state real qhso3 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QHSO3" "HSO3 number mixing ratio" "kg kg-1" +state real qh2so4 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2SO4" "H2SO4 number mixing ratio" "kg kg-1" +state real qs2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QS2" "S2 number mixing ratio" "kg kg-1" +state real qclso2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCLSO2" "ClSO2 number mixing ratio" "kg kg-1" +state real qoscl ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QOSCL" "OSCl number mixing ratio" "kg kg-1" +state real qh2oliq ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2OLIQ" "H2O liq number mixing ratio" "kg kg-1" +state real qh2so4liq ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2SO4LIQ" "H2SO4 liq number mixing ratio" "kg kg-1" + + + + + + + + +#state real floob ikjb dyn_em 1 - +#state real floob_x ikjx dyn_em 1 - +#state real floob_y ikjy dyn_em 1 - +#xpose FLOOB dyn_em floob,floob_x,floob_y + +#state real xxx ijk misc 2 - h6ud +#halo HALO_FLOOB dyn_em 4:xxx_2 + +# Lines that start with the word 'state' form a table that is +# used by the script use_registry to generate module_state_descript.F +# and other files. Also see documentation in use_registry. +# +# table entries are of the form +#
+# + +# It is required that LU_INDEX appears before any variable that is +# interpolated with a mask, as lu_index supplies that mask. +# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling +# with wave model, only if compiled with -DMCELIO, JM 2003/05/29 +state real LU_INDEX ij misc 1 - i02r01d=(interp_fcnm)u=(copy_fcnm) "LU_INDEX" "LAND USE CATEGORY" "" +state real LU_MASK ij misc 1 - i3h1 "LU_MASK" "0 land 1 water" "" + +# znw, znu, dzs, and zs must be listed before any 3-d fields +# in order for the grib output module to work correctly. The grib output +# module retrieves the vertical levels from these parameters. If znw, znu +# dzs, and zs are not listed first, vertical level will not be encoded at +# time 0. + +state real znu k dyn_em 1 - irh "znu" "eta values on half (mass) levels" "" +state real znw k dyn_em 1 Z i01rh "znw" "eta values on full (w) levels" "" +state real ZS l misc - Z ir "ZS" "DEPTHS OF CENTERS OF SOIL LAYERS" "m" +state real DZS l misc - Z ir "DZS" "THICKNESSES OF SOIL LAYERS" "m" + +# +# Variables from WPS +# +state real u_gc igj dyn_em 1 XZ i1 "UU" "x-wind component" "m s-1" +state real v_gc igj dyn_em 1 YZ i1 "VV" "y-wind component" "m s-1" +state real t_gc igj dyn_em 1 Z i1 "TT" "temperature" "K" +state real rh_gc igj dyn_em 1 Z i1 "RH" "relative humidity" "%" +state real ght_gc igj dyn_em 1 Z i1 "GHT" "geopotential height" "m" +state real p_gc igj dyn_em 1 Z i1 "PRES" "pressure" "Pa" +state real xlat_gc ij dyn_em 1 - i1 "XLAT_M" "latitude, positive north" "degrees" +state real xlong_gc ij dyn_em 1 - i1 "XLONG_M" "longitude, positive east" "degrees" +state real ht_gc ij dyn_em 1 - i1 "HGT_M" "topography elevation" "m" +state real tsk_gc ij dyn_em 1 - i1 "SKINTEMP" "skin temperature" "K" +state real tavgsfc ij dyn_em 1 - i1 "TAVGSFC" "daily mean of surface air temperature" "K" +state real tmn_gc ij dyn_em 1 - i1 "SOILTEMP" "annual mean deep soil temperature" "K" +state real pslv_gc ij dyn_em 1 - i1 "PMSL" "sea level pressure" "Pa" +state real greenfrac imj dyn_em 1 Z i1 "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction" +state real albedo12m imj dyn_em 1 Z i1 "ALBEDO12M" "background albedo" "0 - 1 fraction" +state real pd_gc igj dyn_em 1 Z - "PD" "dry pressure" "Pa" +state real psfc_gc ij dyn_em 1 - - "PSFC_GC" "surface pressure" "Pa" +state real intq_gc ij dyn_em 1 - - "INTQ" "integrated mixing ratio" "Pa" +state real pdhs ij dyn_em 1 - - "PDHS" "hydrostatic dry surface pressure" "Pa" +state real qv_gc igj dyn_em 1 Z i1 "QV" "mixing ratio" "kg kg-1" +ifdef RUC_CLOUD +state real qr_gc igj dyn_em 1 Z i1 "QR" "rain water mixing ratio" "kg kg-1" +state real qc_gc igj dyn_em 1 Z i1 "QC" "cloud water mixing ratio" "kg kg-1" +state real qs_gc igj dyn_em 1 Z i1 "QS" "snow mixing ratio" "kg kg-1" +state real qi_gc igj dyn_em 1 Z i1 "QI" "cloud ice mixing ratio" "kg kg-1" +state real qg_gc igj dyn_em 1 Z i1 "QG" "graupel mixing ratio" "kg kg-1" +state real qni_gc igj dyn_em 1 Z i1 "QNI" "ice no concentration" "m-3" +endif + +####MARS MARS MARS MARS MARS +####MARS MARS MARS MARS MARS +#### +#### INITIALISATION +#### +#### variables dans real +#### + +state real albedo_gcm_gc ij dyn_em 1 - i1 "ALBEDO_GCM" "albedo of naked ground" "0 - 1 fraction" +state real therm_inert_gc ij dyn_em 1 - i1 "THERMAL_INERTIA" "thermal inertia" "J/m2/K/s0.5" +state real z0_gc ij dyn_em 1 - i1 "SURF_ROUGHNESS" "surface roughness" "cm" +state real slpx_gc ij dyn_em 1 - i1 "SLPX" "slope x direction" "rad" +state real slpy_gc ij dyn_em 1 - i1 "SLPY" "slope y direction" "rad" +state real hv_gc igj dyn_em 1 Z i1 "HV" "water vapor" "kg/kg" +state real hi_gc igj dyn_em 1 Z i1 "HI" "water ice" "kg/kg" +state real tsoil_gc igj dyn_em 1 Z i1 "TSOIL" "soil temperatures" "K" +state real isoil_gc igj dyn_em 1 Z i1 "ISOIL" "soil thermal inertia" "tiu" +state real dsoil_gc igj dyn_em 1 Z i1 "DSOIL" "soil depths" "m" +#### +#### variables dans wrf +#### +#### 'm_' prefix is to avoid redundancies with possible existing terrestrial variables +#### +#### vvvv nom pour module_initialize, solve_em, lmd_driver (interne fortran) +#### vvvv nom fichier netCDF (important initialisation +################################################################################################################ +state real m_albedo ij misc 1 - i012rd "MARS_ALB" "albedo of naked ground" "0 - 1 fraction" +state real m_ti ij misc 1 - i012rd "MARS_TI" "thermal inertia" "J/m2/K/s0.5" +state real m_z0 ij misc 1 - i012rd "MARS_Z0" "surface roughness" "m" +state real slpx ij misc 1 - i012rd "SLOPEX" "slope x direction" "rad" +state real slpy ij misc 1 - i012rd "SLOPEY" "slope y direction" "rad" +state real m_emiss ij misc 1 - i012rd "MARS_EMISS" "emissivity" "0 - 1 fraction" +state real m_co2ice ij misc 1 - i012rd "MARS_CICE" "co2 ground ice" "kg/m2" +state real m_h2oice ij misc 1 - i012rd "MARS_WICE" "h2o ground ice" "kg/m2" +state real m_fluxrad ij misc 1 - i012rd "MARS_FLUXRAD" "net rad flux at surf" "W.m-2" +state real m_wstar ij misc 1 - i012rd "MARS_WSTAR" "free convection velocity" "m.s-1" +state real m_tsurf ij misc 1 - i012rhd "MARS_TSURF" "surface temperature" "K" +state real m_tsoil ilj misc 1 - i012rd "MARS_TSOIL" "soil temperatures" "K" +state real m_q2 ikj misc 1 Z i012rd "MARS_Q2" "parameterized TKE" "kg.m-3" +state real m_isoil ilj misc 1 - i012rd "MARS_ISOIL" "soil thermal inertia" "tiu" +state real m_dsoil ilj misc 1 - i012rd "MARS_DSOIL" "soil depths" "m" +state real m_gw ilj misc 1 - i012rd "MARS_GW" "gwparam" " " +#### +#### +####MARS MARS MARS MARS MARS +####MARS MARS MARS MARS MARS + +#----------------------------------------------------------------------------------------------------------------------------------------------------------------- +# +# Variables for Eulerian mass coordinate dynamics +# + +# Velocities +# +# U Vel +state real u ikjb dyn_em 2 X \ + i01rhusdf=(bdy_interp:dt) "U" "x-wind component" "m s-1" +state real ru ikj dyn_em 1 X - "MU_U" "mu-coupled u" "Pa m s-1" +state real ru_m ikj dyn_em 1 X - "ru_m" "" "" +state real ru_tend ikj dyn_em 1 X - "ru_tend" "" "" +i1 real ru_tendf ikj dyn_em 1 X +state real u_save ikj dyn_em 1 X - "u_save" +# +# V Vel +state real v ikjb dyn_em 2 Y \ + i01rhusdf=(bdy_interp:dt) "V" "y-wind component" "m s-1" +state real rv ikj dyn_em 1 Y - "MU_V" "mu-coupled v" "Pa m s-1" +state real rv_m ikj dyn_em 1 Y - "rv_m" +state real rv_tend ikj dyn_em 1 Y - "rv_tend" +i1 real rv_tendf ikj dyn_em 1 Y +state real v_save ikj dyn_em 1 Y - "v_save" +# +# Vertical Vel +state real w ikjb dyn_em 2 Z \ + irhusdf=(bdy_interp:dt) "w" "z-wind component" "m s-1" +state real ww ikj dyn_em 1 Z r "ww" "mu-coupled eta-dot" "Pa s-1" +state real rw ikj dyn_em 1 Z - "rw" "mu-coupled w" "Pa m s-1" +i1 real ww1 ikj dyn_em 1 Z +state real ww_m ikj dyn_em 1 Z r "ww_m" "time-avg mu-coupled eta-dot" "Pa s-1" +i1 real wwp ikj dyn_em 1 Z +i1 real rw_tend ikj dyn_em 1 Z +i1 real rw_tendf ikj dyn_em 1 Z +i1 real w_save ikj dyn_em 1 Z + +# Geopotential +state real ph ikjb dyn_em 2 Z \ + irusdf=(bdy_interp:dt) "ph" "perturbation geopotential" "m2 s-2" +state real phb ikj dyn_em 1 Z irdus "phb" "base-state geopotential" "m2 s-2" +state real phb_fine ikj dyn_em 1 Z - "phb_fine" "for nesting, temp holding interpolated coarse grid phb" "m2 s-2" +state real ph0 ikj dyn_em 1 Z r "ph0" "initial geopotential" "m2 s-2" +state real php ikj dyn_em 1 Z r "php" "geopotential" "m2 s-2" +i1 real ph_tend ikj dyn_em 1 Z +i1 real ph_tendf ikj dyn_em 1 Z +i1 real ph_save ikj dyn_em 1 Z +## +## MARS: TO GET LIGHTER HISTORY FILES +## +state real phtot ikj dyn_em 1 Z irh "PHTOT" "total geopotential" "m2 s-2" + +# Potential Temperature +state real t ikjb dyn_em 2 - \ + i01rhusdf=(bdy_interp:dt) "t" "perturbation potential temperature (theta-t0)" "K" + +state real t_init ikj dyn_em 1 - ir "t_init" "initial potential temperature" "K" +i1 real t_tend ikj dyn_em 1 - +i1 real t_tendf ikj dyn_em 1 - +state real tp ikj dyn_em 2 - +i1 real t_2save ikj dyn_em 1 - +state real t_save ikj dyn_em 1 - "t_save" +# +state real tz_init ikj dyn_em 1 - ir "tz_init" "initial potential temperature" "K" + +# Mass +state real mu ijb dyn_em 2 - \ + irusdf=(bdy_interp:dt) "mu" "perturbation dry air mass in column" "Pa" +state real mub ij dyn_em 1 - irdus "mub" "base state dry air mass in column" "Pa" +state real mub_fine ij dyn_em 1 - - "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa" +state real mub_save ij dyn_em 1 - - "mub_save" "nest temp, holds orig fine grid mub" "Pa" +state real mu0 ij dyn_em 1 - i01rdu "mu0" "initial dry mass in column" "Pa" +state real mudf ij dyn_em 1 - - "mudf" "" "" +state real muu ij dyn_em 1 - "muu" +i1 real muus ij dyn_em 1 - +state real muv ij dyn_em 1 - "muv" +i1 real muvs ij dyn_em 1 - +state real mut ij dyn_em 1 - "mut" +state real muts ij dyn_em 1 - "muts" +i1 real muave ij dyn_em 1 - +i1 real mu_save ij dyn_em 1 - +i1 real mu_tend ij dyn_em 1 - +i1 real mu_tendf ij dyn_em 1 - + +#diagnostic for looking at nest position in output. A mungy version of terrain height. +state real nest_pos ij misc 1 - ru=(mark_domain) "NEST_POS" +state real nest_mask ij misc 1 - ru=(mark_domain) "NEST_MASK" "LOCATION OF NEST IF ANY" +state real ht_coarse ij misc 1 - r - "STORAGE FOR LOW-RES TERRAIN" + + +# TKE +state real tke ikj dyn_em 2 - r "tke" "TURBULENCE KINETIC ENERGY" "m2 s-2" +i1 real tke_tend ikj dyn_em 1 - + +# Pressure and Density +state real p ikj dyn_em 1 - r "p" "perturbation pressure" "Pa" +state real al ikj dyn_em 1 - r "al" "inverse perturbation density" "m3 kg-1" +state real alt ikj dyn_em 1 - r "alt" "inverse density" "m3 kg-1" +state real alb ikj dyn_em 1 - rdus "alb" "inverse base density" "m3 kg-1" +state real zx ikj dyn_em 1 X - " " " " " " +state real zy ikj dyn_em 1 Y - " " " " " " +state real rdz ikj dyn_em 1 Z - " " " " " " +state real rdzw ikj dyn_em 1 Z - " " " " " " +state real pb ikj dyn_em 1 - rdus "pb" "BASE STATE PRESSURE " "Pa" +## +## MARS: TO GET LIGHTER HISTORY FILES +## +state real ptot ikj dyn_em 1 - irh "PTOT" "total pressure" "Pa" + +# +# Other dyn +# +i1 real advect_tend ikj dyn_em 1 - +i1 real alpha ikj dyn_em 1 - +i1 real a ikj dyn_em 1 - +i1 real gamma ikj dyn_em 1 - +i1 real c2a ikj dyn_em 1 - - +i1 real rho ikj dyn_em 1 - - +i1 real phm ikj dyn_em 1 - - +i1 real cqu ikj dyn_em 1 - - +i1 real cqv ikj dyn_em 1 - - +i1 real cqw ikj dyn_em 1 - - +i1 real pm1 ikj dyn_em 1 - - +state real sr ij dyn_em 1 - ir "sr" "fraction of frozen precipitation" +state real potevp ij dyn_em 1 - r "potevp" "accumulated potential evaporation" "W m-2" +state real snopcx ij dyn_em 1 - r "snopcx" "snow phase change heat flux" "W m-2" +state real soiltb ij dyn_em 1 - - "soiltb" "bottom soil temperature" "K" +state real fnm k dyn_em 1 - ir "fnm" "upper weight for vertical stretching" "" +state real fnp k dyn_em 1 - ir "fnp" "lower weight for vertical stretching" "" +state real rdnw k dyn_em 1 - ir "rdnw" "inverse d(eta) values between full (w) levels" "" +state real rdn k dyn_em 1 - ir "rdn" "inverse d(eta) values between half (mass) levels" "" +state real dnw k dyn_em 1 - ir "dnw" "d(eta) values between full (w) levels" "" +state real dn k dyn_em 1 - ir "dn " "d(eta) values between half (mass) levels" "" +state real t_base k dyn_em 1 - ir "t_base" "BASE STATE T IN IDEALIZED CASES" "K" +state real z ikj dyn_em 1 - - " " " " " " +i1 real mu_3d ikj dyn_em 1 - +i1 real z_at_w ikj dyn_em 1 Z +state real cfn - misc - - ir "cfn" "extrapolation constant" "" +state real cfn1 - misc - - ir "cfn1" "extrapolation constant" "" +state integer step_number - misc - - ir "step_number" "" + +# 2m and 10m output diagnostics +state real Q2 ij misc 1 - ird "Q2" "QV at 2 M" "kg kg-1" +state real T2 ij misc 1 - ird "T2" "TEMP at 2 M" "K" +state real TH2 ij misc 1 - ird "TH2" "POT TEMP at 2 M" "K" +state real PSFC ij misc 1 - i01rhd "PSFC" "SFC PRESSURE" "Pa" + +# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling +# with wave model, only if compiled with -DMCELIO, JM 2003/05/29 +state real U10 ij misc 1 - ir01d "U10" "U at 10 M" "m s-1" +state real V10 ij misc 1 - ir01d "V10" "V at 10 M" "m s-1" + +# these next 4 are for observational nudging +state real uratx ij misc 1 - r "URATX" "Ratio of U over U10 on mass points " "dimensionless" +state real vratx ij misc 1 - r "VRATX" "Ratio of V over V10 on mass points " "dimensionless" +state real tratx ij misc 1 - r "TRATX" "Ratio of T over TH2 on mass points " "dimensionless" +state real obs_savwt hikj dyn_em 1 X - "OBS_SAVWT" + +# Other +state real rdx - misc - - ir "rdx" "INVERSE X GRID LENGTH" "" +state real rdy - misc - - ir "rdy" "INVERSE Y GRID LENGTH" "" +state real dts - misc - - ir "dts" "SMALL TIMESTEP" "" +state real dtseps - misc - - ir "dtseps" "TIME WEIGHT CONSTANT FOR SMALL STEPS" "" +state real resm - misc - - ir "resm" "TIME WEIGHT CONSTANT FOR SMALL STEPS" "" +state real zetatop - misc - - ir "zetatop" "ZETA AT MODEL TOP" "" +state real cf1 - misc - - ir "cf1" "2nd order extrapolation constant" "" +state real cf2 - misc - - ir "cf2" "2nd order extrapolation constant" "" +state real cf3 - misc - - ir "cf3" "2nd order extrapolation constant" "" +state integer number_at_same_level - - - - - "number_at_same_level" "" "" + +# State for derived time quantities. +state integer itimestep - - - - r "itimestep" "" "" +state real xtime - - - - r "xtime" "minutes since simulation start" "" +state real julian - - - - - "julian" "day of year, 0.0 at 0Z on 1 Jan." "days" + + +# input file descriptor for lbcs on parent domain +state integer lbc_fid - - - - - "lbc_fid" "" "" +# indicates if tiling has been computed +state logical tiled - - - - - "tiled" "" "" +# indicates if patches have been computed +state logical patched - - - - - "patched" "" "" +# indicates whether to read input from file or generate +#state logical input_from_file - - - - - "input_from_file" "" "" +# indicates whether to recompute mu +state logical press_adj - - - - - "press_adj" "T/F flag adjust mu" "" + +# Mask for moving nest interpolations +state integer imask_nostag ij misc 1 - +state integer imask_xstag ij misc 1 X +state integer imask_ystag ij misc 1 Y +state integer imask_xystag ij misc 1 XY +# vortex center indices; need for restarts of moving nests +state real xi - misc - - r +state real xj - misc - - r +state real vc_i - misc - - r +state real vc_j - misc - - r + +#----------------------------------------------------------------------------------------------------------------------------------------------------------------- +# Scalar (4D) arrays + +# Moist Scalars +# +# The first line ensures that there will be identifiers named moist and +# moist_tend even if there are not any moist scalars (so the essentially +# dry code will will still link properly) +# +state real - ikjftb moist 1 - - - +state real qv ikjftb moist 1 - \ + i01rusdf=(bdy_interp:dt) "QVAPOR" "Water vapor mixing ratio" "kg kg-1" +state real qc ikjftb moist 1 - \ + i01rusdf=(bdy_interp:dt) "QCLOUD" "Cloud water mixing ratio" "kg kg-1" +state real qr ikjftb moist 1 - \ + i01rusdf=(bdy_interp:dt) "QRAIN" "Rain water mixing ratio" "kg kg-1" +state real qi ikjftb moist 1 - \ + i01rusdf=(bdy_interp:dt) "QICE" "Ice mixing ratio" "kg kg-1" +state real qs ikjftb moist 1 - \ + i01rusdf=(bdy_interp:dt) "QSNOW" "Snow mixing ratio" "kg kg-1" +state real qg ikjftb moist 1 - \ + i01rusdf=(bdy_interp:dt) "QGRAUP" "Graupel mixing ratio" "kg kg-1" +state real - ikjftb dfi_moist 1 - - - +state real dfi_qv ikjftb dfi_moist 1 - \ + rusdf=(bdy_interp:dt) "DFI_QVAPOR" "Water vapor mixing ratio" "kg kg-1" +state real dfi_qc ikjftb dfi_moist 1 - \ + rusdf=(bdy_interp:dt) "DFI_QCLOUD" "Cloud water mixing ratio" "kg kg-1" +state real dfi_qr ikjftb dfi_moist 1 - \ + rusdf=(bdy_interp:dt) "DFI_QRAIN" "Rain water mixing ratio" "kg kg-1" +state real dfi_qi ikjftb dfi_moist 1 - \ + rusdf=(bdy_interp:dt) "DFI_QICE" "Ice mixing ratio" "kg kg-1" +state real dfi_qs ikjftb dfi_moist 1 - \ + rusdf=(bdy_interp:dt) "DFI_QSNOW" "Snow mixing ratio" "kg kg-1" +state real dfi_qg ikjftb dfi_moist 1 - \ + rusdf=(bdy_interp:dt) "DFI_QGRAUP" "Graupel mixing ratio" "kg kg-1" + + +# Chem Scalars +state real - ikjftb chem 1 - - - + +# Other Scalars +state real - ikjftb scalar 1 - - - +state real qndrop ikjftb scalar 1 - \ + i01rusdf=(bdy_interp:dt) "QNDROP" "Droplet number mixing ratio" "# kg-1" +state real qni ikjftb scalar 1 - \ + i01rusdf=(bdy_interp:dt) "QNICE" "Ice Number concentration" "# kg-1" +state real qt ikjftb scalar 1 - \ + i01rusdf=(bdy_interp:dt) "CWM" "Total condensate mixing ratio" "kg kg-1" +state real qns ikjftb scalar 1 - \ + i01rusdf=(bdy_interp:dt) "QNSNOW" "Snow Number concentration" "# kg(-1)" +state real qnr ikjftb scalar 1 - \ + i01rusdf=(bdy_interp:dt) "QNRAIN" "Rain Number concentration" "# kg(-1)" +state real qng ikjftb scalar 1 - \ + i01rusdf=(bdy_interp:dt) "QNGRAUPEL" "Graupel Number concentration" "# kg(-1)" +state real - ikjftb dfi_scalar 1 - - - +state real dfi_qndrop ikjftb dfi_scalar 1 - \ + rusdf=(bdy_interp:dt) "DFI_QNDROP" "Droplet number mixing ratio" "# kg-1" +state real dfi_qni ikjftb dfi_scalar 1 - \ + rusdf=(bdy_interp:dt) "DFI_QNICE" "Ice Number concentration" "# kg-1" +state real dfi_qt ikjftb dfi_scalar 1 - \ + rusdf=(bdy_interp:dt) "DFI_CWM" "Total condensate mixing ratio" "kg kg-1" +state real dfi_qns ikjftb dfi_scalar 1 - \ + rusdf=(bdy_interp:dt) "DFI_QNSNOW" "Snow Number concentration" "# kg(-1)" +state real dfi_qnr ikjftb dfi_scalar 1 - \ + rusdf=(bdy_interp:dt) "DFI_QNRAIN" "Rain Number concentration" "# kg(-1)" +state real dfi_qng ikjftb dfi_scalar 1 - \ + rusdf=(bdy_interp:dt) "DFI_QNGRAUPEL" "Graupel Number concentration" "# kg(-1)" + +#----------------------------------------------------------------------------------------------------------------------------------------------------------------- + +# Arrays for Specified LBCs (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM ) + +state real fcx w misc - - ir "fcx" "RELAXATION TERM FOR BOUNDARY ZONE" "" +state real gcx w misc - - ir "gcx" "2ND RELAXATION TERM FOR BOUNDARY ZONE" "" +state real dtbc - misc - - ir "dtbc" "TIME SINCE BOUNDARY READ" "" + +#------------------------------------------------------------------------------------------------------------------------------------------- +#------------------------------------------------------------------------------------------------------------------------------------------- +# Physics Related State Varibles + +#------------------------------------------------------------------------------------------------------------------------------------------- +# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes +#------------------------------------------------------------------------------------------------------------------------------------------- + +state real sm000007 ij misc 1 - i1 "SM000007" "LAYER SOIL MOISTURE" "m3 m-3" +state real sm007028 ij misc 1 - i1 "SM007028" "LAYER SOIL MOISTURE" "m3 m-3" +state real sm028100 ij misc 1 - i1 "SM028100" "LAYER SOIL MOISTURE" "m3 m-3" +state real sm100255 ij misc 1 - i1 "SM100255" "LAYER SOIL MOISTURE" "m3 m-3" +state real st000007 ij misc 1 - i1 "ST000007" "LAYER SOIL TEMPERATURE" "K" +state real st007028 ij misc 1 - i1 "ST007028" "LAYER SOIL TEMPERATURE" "K" +state real st028100 ij misc 1 - i1 "ST028100" "LAYER SOIL TEMPERATURE" "K" +state real st100255 ij misc 1 - i1 "ST100255" "LAYER SOIL TEMPERATURE" "K" +state real sm000010 ij misc 1 - i1 "SM000010" "LAYER SOIL MOISTURE" "m3 m-3" +state real sm010040 ij misc 1 - i1 "SM010040 " "LAYER SOIL MOISTURE" "m3 m-3" +state real sm040100 ij misc 1 - i1 "SM040100 " "LAYER SOIL MOISTURE" "m3 m-3" +state real sm100200 ij misc 1 - i1 "SM100200 " "LAYER SOIL MOISTURE" "m3 m-3" +state real sm010200 ij misc 1 - i1 "SM010200" "LAYER SOIL MOISTURE" "m3 m-3" +state real soilm000 ij misc 1 - i1 "SOILM000" "LAYER SOIL MOISTURE" "m3 m-3" +state real soilm005 ij misc 1 - i1 "SOILM005" "LAYER SOIL MOISTURE" "m3 m-3" +state real soilm020 ij misc 1 - i1 "SOILM020" "LAYER SOIL MOISTURE" "m3 m-3" +state real soilm040 ij misc 1 - i1 "SOILM040" "LAYER SOIL MOISTURE" "m3 m-3" +state real soilm160 ij misc 1 - i1 "SOILM160" "LAYER SOIL MOISTURE" "m3 m-3" +state real soilm300 ij misc 1 - i1 "SOILM300" "LAYER SOIL MOISTURE" "m3 m-3" +state real sw000010 ij misc 1 - i1 "SW000010" "LAYER SOIL LIQUID" "m3 m-3" +state real sw010040 ij misc 1 - i1 "SW010040" "LAYER SOIL LIQUID" "m3 m-3" +state real sw040100 ij misc 1 - i1 "SW040100" "LAYER SOIL LIQUID" "m3 m-3" +state real sw100200 ij misc 1 - i1 "SW100200" "LAYER SOIL LIQUID" "m3 m-3" +state real sw010200 ij misc 1 - i1 "SW010200" "LAYER SOIL LIQUID" "m3 m-3" +state real soilw000 ij misc 1 - i1 "SOILW000" "LAYER SOIL LIQUID" "m3 m-3" +state real soilw005 ij misc 1 - i1 "SOILW005" "LAYER SOIL LIQUID" "m3 m-3" +state real soilw020 ij misc 1 - i1 "SOILW020" "LAYER SOIL LIQUID" "m3 m-3" +state real soilw040 ij misc 1 - i1 "SOILW040" "LAYER SOIL LIQUID" "m3 m-3" +state real soilw160 ij misc 1 - i1 "SOILW160" "LAYER SOIL LIQUID" "m3 m-3" +state real soilw300 ij misc 1 - i1 "SOILW300" "LAYER SOIL LIQUID" "m3 m-3" +state real st000010 ij misc 1 - i1 "ST000010" "LAYER SOIL TEMPERATURE" "K" +state real st010040 ij misc 1 - i1 "ST010040" "LAYER SOIL TEMPERATURE" "K" +state real st040100 ij misc 1 - i1 "ST040100" "LAYER SOIL TEMPERATURE" "K" +state real st100200 ij misc 1 - i1 "ST100200" "LAYER SOIL TEMPERATURE" "K" +state real st010200 ij misc 1 - i1 "ST010200" "LAYER SOIL TEMPERATURE" "K" +state real soilt000 ij misc 1 - i1 "SOILT000" "LAYER SOIL TEMPERATURE" "K" +state real soilt005 ij misc 1 - i1 "SOILT005" "LAYER SOIL TEMPERATURE" "K" +state real soilt020 ij misc 1 - i1 "SOILT020" "LAYER SOIL TEMPERATURE" "K" +state real soilt040 ij misc 1 - i1 "SOILT040" "LAYER SOIL TEMPERATURE" "K" +state real soilt160 ij misc 1 - i1 "SOILT160" "LAYER SOIL TEMPERATURE" "K" +state real soilt300 ij misc 1 - i1 "SOILT300" "LAYER SOIL TEMPERATURE" "K" +state real landmask ij misc 1 - i012rd=(interp_fcnm)u=(copy_fcnm) "LANDMASK" "LAND MASK (1 FOR LAND, 0 FOR WATER)" "" +state real topostdv ij misc 1 - i12 "TOPOSTDV" "ELEVATION STD DEV" "m" +state real toposlpx ij misc 1 - i12 "TOPOSLPX" "ELEVATION X SLOPE" "" +state real toposlpy ij misc 1 - i12 "TOPOSLPY" "ELEVATION Y SLOPE" "" +state real shdmax ij misc 1 - i012r "SHDMAX" "ANNUAL MAX VEG FRACTION" "" +state real shdmin ij misc 1 - i012r "SHDMIN" "ANNUAL MIN VEG FRACTION" "" +state real snoalb ij misc 1 - i012r "SNOALB" "ANNUAL MAX SNOW ALBEDO IN FRACTION" "" +state real slopecat ij misc 1 - i12 "SLOPECAT" "SLOPE CATEGORY" "" +state real toposoil ij misc 1 - i12 "SOILHGT" "ELEVATION OF LSM DATA" "m" +state real landusef iuj misc 1 Z i012r "LANDUSEF" "LANDUSE FRACTION BY CATEGORY" "" +state real soilctop isj misc 1 Z i012 "SOILCTOP" "SOIL CAT FRACTION (TOP)" "" +state real soilcbot isj misc 1 Z i012 "SOILCBOT" "SOIL CAT FRACTION (BOTTOM)" "" +state real soilcat ij misc 1 - i12 "SOILCAT" "SOIL CAT DOMINANT TYPE" "" +state real vegcat ij misc 1 - i12 "VEGCAT" "VEGETATION CAT DOMINANT TYPE" "" + +#--------------------------------------------------------------------------------------------------------------------------------------- +# SI - end variables from netCDF format from Standard Initialization +#--------------------------------------------------------------------------------------------------------------------------------------- + +# soil model variables (Note that they are marked as staggered in the vertical dimension +# because they are "fully dimensioned" -- they use every element in that dim +state real TSLB ilj misc 1 Z i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TSLB" "SOIL TEMPERATURE" "K" + +# Time series variables +state real ts_hour ?! misc - - r "TS_HOUR" "Model integration time, hours" +state real ts_u ?! misc - - r "TS_U" "Surface wind U-component, earth-relative" +state real ts_v ?! misc - - r "TS_V" "Surface wind V-component, earth-relative" +state real ts_q ?! misc - - r "TS_Q" "Surface mixing ratio" +state real ts_t ?! misc - - r "TS_T" "Surface temperature" +state real ts_psfc ?! misc - - r "TS_PSFC" "Surface pressure" +state real ts_glw ?! misc - - r "TS_GLW" "Downward long wave flux at surface" +state real ts_gsw ?! misc - - r "TS_GSW" "Net short wave flux at surface" +state real ts_hfx ?! misc - - r "TS_HFX" "Upward heat flux at surface" +state real ts_lh ?! misc - - r "TS_LH" "Upward moisture flux at surface" +state real ts_tsk ?! misc - - r "TS_TSK" "Skin temperature" +state real ts_tslb ?! misc - - r "TS_TSLB" "Soil temperature" +state real ts_clw ?! misc - - r "TS_CLW" "Column integrated cloud water" +state real ts_rainc ?! misc - - r "TS_RAINC" "Cumulus precip" +state real ts_rainnc ?! misc - - r "TS_RAINNC" "Grid-scale precip" + +# urban model variables +state real DZR l em - Z r "DZR" "THICKNESSES OF ROOF LAYERS" "m" +state real DZB l em - Z r "DZB" "THICKNESSES OF WALL LAYERS" "m" +state real DZG l em - Z r "DZG" "THICKNESSES OF ROAD LAYERS" "m" + +# lsm State Variables + +state real SMOIS ilj - 1 Z i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SMOIS" "SOIL MOISTURE" "m3 m-3" +state real SH2O ilj - 1 Z i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SH2O" "SOIL LIQUID WATER" "m3 m-3" +state real XICE ij misc 1 - i0124rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "SEAICE" "SEA ICE FLAG" "" +state real XICEM ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "XICEM" "SEA ICE FLAG (PREVIOUS STEP)" "" +state real SMSTAV ij misc 1 - rd=(interp_mask_land_field:lu_index) "SMSTAV" "MOISTURE AVAILABILITY" "" +state real SMSTOT ij misc 1 - r "SMSTOT" "TOTAL SOIL MOISTURE" "m3 m-3" + +state real SFCRUNOFF ij misc 1 - rd=(interp_mask_land_field:lu_index) "SFROFF" "SURFACE RUNOFF" "mm" +state real UDRUNOFF ij misc 1 - rd=(interp_mask_land_field:lu_index) "UDROFF" "UNDERGROUND RUNOFF" "mm" +state integer IVGTYP ij misc 1 - i02rd=(interp_fcni)u=(copy_fcni) "IVGTYP" "DOMINANT VEGETATION CATEGORY" "" +state integer ISLTYP ij misc 1 - i02rd=(interp_fcni)u=(copy_fcni) "ISLTYP" "DOMINANT SOIL CATEGORY" "" +state real VEGFRA ij misc 1 - i0124rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "VEGFRA" "VEGETATION FRACTION" "" +state real SFCEVP ij misc 1 - r "SFCEVP" "SURFACE EVAPORATION" "kg m-2" +state real GRDFLX ij misc 1 - r "GRDFLX" "GROUND HEAT FLUX" "W m-2" +state real SFCEXC ij misc 1 - r "SFCEXC " "SURFACE EXCHANGE COEFFICIENT" "m s-1" + +state real ACSNOW ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "ACSNOW" "ACCUMULATED SNOW" "kg m-2" +state real ACSNOM ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "ACSNOM" "ACCUMULATED MELTED SNOW" "kg m-2" +state real SNOW ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SNOW" "SNOW WATER EQUIVALENT" "kg m-2" +state real SNOWH ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SNOWH" "PHYSICAL SNOW DEPTH" "m" +state real RHOSN ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "RHOSN" " SNOW DENSITY" "kg m-3" +state real CANWAT ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "CANWAT" "CANOPY WATER" "kg m-2" +state real SST ij misc 1 - i0124rd=(interp_mask_water_field:lu_index) "SST" "SEA SURFACE TEMPERATURE" "K" +state integer IFNDSNOWH - misc 1 - i "FNDSNOWH" "SNOWH_LOGICAL" +state integer IFNDSOILW - misc 1 - i "FNDSOILW" "SOILW_LOGICAL" + +# DFI variables +state real hcoeff n misc 1 - - "HCOEFF" "initialization weights" +state real hcoeff_tot - misc 1 - - "HCOEFF_TOT" "initialization weights" +state real dfi_p ikj misc 1 - r "P_DFI" "perturbation pressure" "Pa" +state real dfi_al ikj misc 1 - r "AL_DFI" "inverse perturbation density" "m3 kg-1" +state real dfi_mu ij misc 1 - r "MU_DFI" "perturbation dry air mass in column" "Pa" +state real dfi_phb ikj misc 1 Z r "PHB_DFI" "base-state geopotential" "m2 s-2" +state real dfi_ph0 ikj misc 1 Z r "PH0_DFI" "initial geopotential" "m2 s-2" +state real dfi_php ikj misc 1 Z r "PHP_DFI" "geopotential" "m2 s-2" +state real dfi_u ikj misc 1 - r "U_DFI" "u accumulation array" " " +state real dfi_v ikj misc 1 - r "V_DFI" "v accumulation array" " " +state real dfi_w ikj misc 1 - r "W_DFI" "w accumulation array" " " +state real dfi_ww ikj misc 1 Z r "WW_DFI" "mu-coupled eta-dot" "Pa s-1" +state real dfi_t ikj misc 1 - r "TT_DFI" "t accumulation array" " " +state real dfi_ph ikj misc 1 - r "PH_DFI" "p accumulation array" " " +state real dfi_pb ikj misc 1 - r "PB_DFI" "pb accumulation array" " " +state real dfi_alt ikj misc 1 - r "ALT_DFI" "1/rho accumulation array" " " +state real dfi_tke ikj misc 1 - r "TKE_DFI" "TURBULENCE KINETIC ENERGY" "m2 s-2" + +state real dfi_TSLB ilj misc 1 Z r "TSLB_dfi" "SOIL TEMPERATURE" "K" +state real dfi_SMOIS ilj - 1 Z r "SMOIS_dfi" "SOIL MOISTURE" "m3 m-3" +state real dfi_SNOW ij misc 1 - r "SNOW_dfi" "SNOW WATER EQUIVALENT" "kg m-2" +state real dfi_SNOWH ij misc 1 - r "SNOWH_dfi" "PHYSICAL SNOW DEPTH" "m" +state real dfi_CANWAT ij misc 1 - r "CANWAT_dfi" "CANOPY WATER" "kg m-2" +state real dfi_SMFR3D ilj misc 1 Z r "SMFR3D_dfi" "SOIL ICE" "" +state real dfi_KEEPFR3DFLAG ilj misc 1 Z r "KEEPFR3DFLAG_dfi" "FLAG - 1. FROZEN SOIL YES, 0 - NO" "" + +# urban state variables +state real TR_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TR_URB" "URBAN ROOF SKIN TEMPERATURE" "K" +state real TB_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TB_URB" "URBAN WALL SKIN TEMPERATURE" "K" +state real TG_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TG_URB" "URBAN ROAD SKIN TEMPERATURE" "K" +state real TC_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TC_URB" "URBAN CANOPY TEMPERATURE" "K" +state real QC_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "QC_URB" "URBAN CANOPY HUMIDITY" "kg kg{-1}" +state real UC_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "UC_URB" "URBAN CANOPY WIND" "m s{-1}" +state real XXXR_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF" "dimensionless" +state real XXXB_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL" "dimensionless" +state real XXXG_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD" "dimensionless" +state real XXXC_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless" +state real TRL_URB3D ilj misc 1 Z rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TRL_URB" "ROOF LAYER TEMPERATURE" "K" +state real TBL_URB3D ilj misc 1 Z rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TBL_URB" "WALL LAYER TEMPERATURE" "K" +state real TGL_URB3D ilj misc 1 Z rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TGL_URB" "ROAD LAYER TEMPERATURE" "K" +state real SH_URB2D ij misc 1 - r "SH_URB" "SENSIBLE HEAT FLUX FROM URBAN SFC" "W m{-2}" +state real LH_URB2D ij misc 1 - r "LH_URB" "LATENT HEAT FLUX FROM URBAN SFC" "W m{-2}" +state real G_URB2D ij misc 1 - r "G_URB" "GROUND HEAT FLUX INTO URBAN" "W m{-2}" +state real RN_URB2D ij misc 1 - r "RN_URB" "NET RADIATION ON URBAN SFC" "W m{-2}" +state real TS_URB2D ij misc 1 - r "TS_URB" "SKIN TEMPERATURE" "K" +state real FRC_URB2D ij misc 1 - rd=(interp_fcnm)u=(copy_fcnm) "FRC_URB" "URBAN FRACTION" "dimensionless" +state integer UTYPE_URB2D ij misc 1 - rd=(interp_fcnm)u=(copy_fcnm) "UTYPE_URB" "URBAN TYPE" "dimensionless" + + +# urban variables from radiation model +state real COSZ_URB2D ij misc 1 - r "COSZ_URB" "COS of SOLAR ZENITH ANGLE" "dimensionless" +state real OMG_URB2D ij misc 1 - r "OMG_URB" "SOLAR HOUR ANGLE" "dimensionless" +state real DECLIN_URB - misc 1 - r "DECLIN_URB" "SOLAR DECLINATION" "dimensionless" + + +# RUC LSM +state real SMFR3D ilj misc 1 Z r "SMFR3D" "SOIL ICE" "" +state real KEEPFR3DFLAG ilj misc 1 Z r "KEEPFR3DFLAG" "FLAG - 1. FROZEN SOIL YES, 0 - NO" "" + +# Additional for P-X PBL and LSM +state real RA ij misc 1 - r "RA" "AERODYNAMIC RESISTANCE" "s m-1" +state real RS ij misc 1 - r "RS" "SURFACE RESISTANCE" "s m-1" +state real LAI ij misc 1 - r "LAI" "Leaf area index" "area/area" +state real VEGF_PX ij misc 1 - r "VEGF_PX" "Vegetation Fraction for PX LSM" "area/area" +state real T2OBS ij misc 1 - r "T2OBS" "2-m temperature from analysis " "K" +state real Q2OBS ij misc 1 - r "Q2OBS" "2-m mixing ratio from analysis " "kg/kg" + +# MRF PBL variables +i1 real PSIM ij misc 1 - - "PSIM" "SIMILARITY FUNCTION FOR MOMENTUM" "" +i1 real PSIH ij misc 1 - - "PSIH" "SIMILARITY FUNCTION FOR HEAT" "" +i1 real WSPD ij misc 1 - - "WSPD" "Wind speed" "m s-1" +i1 real GZ1OZ0 ij misc 1 - - "GZ1OZ0" "LOG OF Z1 over Z0" "" +i1 real BR ij misc 1 - - "BR" "Bulk Richardson" "" + +# MYJ PBL variables +state real tke_myj ikj misc 1 - r "tke_myj" "TKE FROM MELLOR-YAMADA-JANJIC" "m2 s-2" +state real EL_MYJ ikj misc 1 - - "el_myj" "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC" "m" +state real EXCH_H ikj misc 1 - r "EXCH_H" "EXCHANGE COEFFICIENTS " +state real CT ij misc 1 - r "CT" "COUNTERGRADIENT TERM" "K" +state real THZ0 ij misc 1 - r "THZ0" "POTENTIAL TEMPERATURE AT ZNT" "K" +state real Z0 ij misc 1 - r "Z0" "Background ROUGHNESS LENGTH" "m" +state real QZ0 ij misc 1 - r "QZ0" "SPECIFIC HUMIDITY AT ZNT" "kg kg-1" +state real UZ0 ij misc 1 - r "UZ0" "U WIND COMPONENT AT ZNT" "m s-1" +state real VZ0 ij misc 1 - r "VZ0" "V WIND COMPONENT AT ZNT" "m s-1" +state real QSFC ij misc 1 - r "QSFC" "SPECIFIC HUMIDITY AT LOWER BOUNDARY" "kg kg-1" +state real AKHS ij misc 1 - r "AKHS" "SFC EXCH COEFF FOR HEAT" "m s-1" +state real AKMS ij misc 1 - r "AKMS" "SFC EXCH COEFF FOR MOMENTUM" "m s-1" +state integer KPBL ij misc 1 - r "KPBL" "LEVEL OF PBL TOP" "" +state real TSHLTR ij misc 1 - ir "TSHLTR" "SHELTER THETA FROM MYJ" "K" +state real QSHLTR ij misc 1 - ir "QSHLTR" "SHELTER SPECIFIC HUMIDITY FROM MYJ" "kg kg-1" +state real PSHLTR ij misc 1 - ir "PSHLTR" "SHELTER PRESSURE FROM MYJ" "Pa" +state real TH10 ij misc 1 - ir "TH10" "10-M THETA FROM MYJ" "K" +state real Q10 ij misc 1 - ir "Q10" "10-M SPECIFIC HUMIDITY FROM MYJ" "kg kg-1" +i1 real CHKLOWQ ij misc 1 - - "CHKLOWQ" "SURFACE SATURATION FLAG" "" + +# gfdl (eta) radiation State Variables +state real HTOP ij misc 1 - r "HTOP" "TOP OF CONVECTION LEVEL" "" +state real HBOT ij misc 1 - r "HBOT" "BOT OF CONVECTION LEVEL" "" +state real HTOPR ij misc 1 - r "HTOPR" "TOP OF CONVECTION LEVEL FOR RADIATION" "" +state real HBOTR ij misc 1 - r "HBOTR" "BOT OF CONVECTION LEVEL FOR RADIATION" "" +state real CUTOP ij misc 1 - r "CUTOP" "TOP OF CONVECTION LEVEL FROM CUMULUS PAR" "" +state real CUBOT ij misc 1 - r "CUBOT" "BOT OF CONVECTION LEVEL FROM CUMULUS PAR" "" +state REAL CUPPT ij misc 1 - r "CUPPT" "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION" "" +state real rswtoa ij misc 1 - i +state real rlwtoa ij misc 1 - i +state real czmean ij misc 1 - i +state real cfracl ij misc 1 - i +state real cfracm ij misc 1 - i +state real cfrach ij misc 1 - i +state real acfrst ij misc 1 - i +state integer ncfrst ij misc 1 - i +state real acfrcv ij misc 1 - i +state integer ncfrcv ij misc 1 - i + +# cam radiation variables +state real - iqjf ozmixm 1 - - - +state real mth01 iqjf ozmixm 1 - - - +state real mth02 iqjf ozmixm 1 - - - +state real mth03 iqjf ozmixm 1 - - - +state real mth04 iqjf ozmixm 1 - - - +state real mth05 iqjf ozmixm 1 - - - +state real mth06 iqjf ozmixm 1 - - - +state real mth07 iqjf ozmixm 1 - - - +state real mth08 iqjf ozmixm 1 - - - +state real mth09 iqjf ozmixm 1 - - - +state real mth10 iqjf ozmixm 1 - - - +state real mth11 iqjf ozmixm 1 - - - +state real mth12 iqjf ozmixm 1 - - - +state real pin q misc 1 - - "PIN" "PRESSURE LEVEL OF OZONE MIXING RATIO" "millibar" +state real m_ps ij misc 2 - - "m_ps" "PS from MATCH on WRF grids" +state real - idjf aerosolc 2 - - - +state real SUL idjf aerosolc 2 - - "SUL" "SUL aerosol concentration" +state real SSLT idjf aerosolc 2 - - "SSLT" "SSLT aerosol concentration" +state real DUST1 idjf aerosolc 2 - - "DUST1" "DUST1 aerosol concentration" +state real DUST2 idjf aerosolc 2 - - "DUST2" "DUST2 aerosol concentration" +state real DUST3 idjf aerosolc 2 - - "DUST3" "DUST3 aerosol concentration" +state real DUST4 idjf aerosolc 2 - - "DUST4" "DUST4 aerosol concentration" +state real OCPHO idjf aerosolc 2 - - "OCPHO" "OCPHO aerosol concentration" +state real BCPHO idjf aerosolc 2 - - "BCPHO" "BCPHO aerosol concentration" +state real OCPHI idjf aerosolc 2 - - "OCPHI" "OCPHI aerosol concentration" +state real BCPHI idjf aerosolc 2 - - "BCPHI" "BCPHI aerosol concentration" +state real BG idjf aerosolc 2 - - "BG" "BG aerosol concentration" +state real VOLC idjf aerosolc 2 - - "VOLC" "VOLC aerosol concentration" +state real m_hybi d misc 1 - - "m_hybi" "MATCH hybi" + +# new eta microphpysics State Variables +state real F_ICE_PHY ikj misc 1 - rdu "F_ICE_PHY" "FRACTION OF ICE" "" +state real F_RAIN_PHY ikj misc 1 - rdu "F_RAIN_PHY" "FRACTION OF RAIN " "" +state real F_RIMEF_PHY ikj misc 1 - rdu "F_RIMEF_PHY" "MASS RATIO OF RIMED ICE " "" +state real qndropsource ikj misc 1 - - "qndropsource" "Droplet number source" "#/kg/s" + +# Other Misc State Variables +state real h_diabatic ikj misc 1 - rdu "h_diabatic" "PREVIOUS TIMESTEP CONDENSATIONAL HEATING" "K s-1" +state real msft ij misc 1 - i012rdu=(copy_fcnm) "MAPFAC_M" "Map scale factor on mass grid" "" +state real msfu ij misc 1 X i012rdu=(copy_fcnm) "MAPFAC_U" "Map scale factor on u-grid" "" +state real msfv ij misc 1 Y i012rdu=(copy_fcnm) "MAPFAC_V" "Map scale factor on v-grid" "" +state real msftx ij misc 1 - i012rdu=(copy_fcnm) "MAPFAC_MX" "Map scale factor on mass grid, x direction" "" +state real msfty ij misc 1 - i012rdu=(copy_fcnm) "MAPFAC_MY" "Map scale factor on mass grid, y direction" "" +state real msfux ij misc 1 X i012rdu=(copy_fcnm) "MAPFAC_UX" "Map scale factor on u-grid, x direction" "" +state real msfuy ij misc 1 X i012rdu=(copy_fcnm) "MAPFAC_UY" "Map scale factor on u-grid, y direction" "" +state real msfvx ij misc 1 Y i012rdu=(copy_fcnm) "MAPFAC_VX" "Map scale factor on v-grid, x direction" "" +state real msfvx_inv ij misc 1 Y i012rdu=(copy_fcnm) "MF_VX_INV" "Inverse map scale factor on v-grid, x direction" "" +state real msfvy ij misc 1 Y i012rdu=(copy_fcnm) "MAPFAC_VY" "Map scale factor on v-grid, y direction" "" + +state real f ij misc 1 - i012rdu=(copy_fcnm) "f" "Coriolis sine latitude term" "s-1" +state real e ij misc 1 - i012rdu=(copy_fcnm) "e" "Coriolis cosine latitude term" "s-1" +state real sina ij misc 1 - i012rdu=(copy_fcnm) "SINALPHA" "Local sine of map rotation" "" +state real cosa ij misc 1 - i012rdu=(copy_fcnm) "COSALPHA" "Local cosine of map rotation" "" +state real ht ij misc 1 - i012rdus "HGT" "Terrain Height" "m" +state real ht_fine ij misc 1 - - "HGT_FINE" "Fine Terrain Height" "m" +state real ht_int ij misc 1 - - "HGT_INT" "Terrain Height Horizontally Interpolated" "m" +state real ht_input ij misc 1 - - "HGT_INPUT" "Terrain Height from FG Input File" "m" +state real ht_shad ijb misc 1 - df=(bdy_interp:dt) "HGT_SHAD" "Height of orographic shadow" "m" +i1 real ht_loc ij misc 1 - - +i1 integer shadowmask ij misc 1 - - +state integer min_ptchsz - misc 1 - r + +state real TSK ij misc 1 - i012rdu=(copy_fcnm) "TSK" "SURFACE SKIN TEMPERATURE" "K" +state real dfi_TSK ij misc 1 - r "TSK_dfi" "saved SURFACE SKIN TEMPERATURE" +state real TSK_SAVE ij misc 1 - - "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL" "K" +state real u_base k misc 1 - ir "u_base" "BASE STATE X WIND IN IDEALIZED CASES" "" +state real v_base k misc 1 - ir "v_base" "BASE STATE Y WIND IN IDEALIZED CASES" "" +state real qv_base k misc 1 - ir "qv_base" "BASE STATE QV IN IDEALIZED CASES" "" +state real z_base k misc 1 - ir "z_base" "BASE STATE HEIGHT IN IDEALIZED CASES" "" +state real u_frame - misc 1 - ir "u_frame" "FRAME X WIND" "m s-1" +state real v_frame - misc 1 - ir "v_frame" "FRAME Y WIND" "m s-1" +# p_top appears as metadata between SI and real but as a state variable in real and WRF +# since it is a scalar and a constant, it makes sense to have it as metadata -- there +# are, however, probably post-processing programs that expect to see it as an I/O record +# another problem: share/input_wrf tries to read this as metadata (fine for real reading +# SI, but with model reading real output, it generates a warning when debug is > 0 in +# namelist and causes repeated questions from users. A third problem is the potential +# collision between a metadata name and a field record in the I/O data +# resolve this how? Have the real program throw a switch to tell the code to get it +# from the metadata? Otherwise it's a field? +state real p_top - misc - - ir "p_top" "PRESSURE TOP OF THE MODEL" "Pa" +state real max_msftx - misc - - r "max_mstfx" "Max map factor in domain" "" +state real max_msfty - misc - - r "max_mstfy" "Max map factor in domain" "" + +# Other physics variables + +state real RTHCUTEN ikj misc 1 - r "RTHCUTEN" "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME" "Pa K s-1" +state real RQVCUTEN ikj misc 1 - r "RQVCUTEN" "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME" "Pa kg kg-1 s-1" +state real RQRCUTEN ikj misc 1 - r "RQRCUTEN" "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME" "Pa kg kg-1 s-1" +state real RQCCUTEN ikj misc 1 - r "RQCCUTEN" "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME" "Pa kg kg-1 s-1" +state real RQSCUTEN ikj misc 1 - r "RQSCUTEN" "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME" "Pa kg kg-1 s-1" +state real RQICUTEN ikj misc 1 - r "RQICUTEN" "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME" "Pa kg kg-1 s-1" +state real W0AVG ikj misc 1 - r "W0AVG" "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME" "m s-1" + +state real RAINC ij misc 1 - rdu "RAINC" "ACCUMULATED TOTAL CUMULUS PRECIPITATION" "mm" +state real RAINNC ij misc 1 - rdu "RAINNC" "ACCUMULATED TOTAL GRID SCALE PRECIPITATION" "mm" +state real PRATEC ij misc 1 - r "PRATEC" "PRECIP RATE FROM CUMULUS SCHEME" "mm s-1" +state real RAINCV ij misc 1 - r "RAINCV" "TIME-STEP CUMULUS PRECIPITATION" "mm" +state real RAINNCV ij misc 1 - r "RAINNCV" "TIME-STEP NONCONVECTIVE PRECIPITATION" "mm" +state real RAINBL ij misc 1 - r "RAINBL" "PBL TIME-STEP TOTAL PRECIPITATION" "mm" +state real SNOWNC ij misc 1 - rdu "SNOWNC" "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE" "mm" +state real GRAUPELNC ij misc 1 - rdu "GRAUPELNC" "ACCUMULATED TOTAL GRID SCALE GRAUPEL" "mm" +state real SNOWNCV ij misc 1 - r "SNOWNCV" "TIME-STEP NONCONVECTIVE SNOW AND ICE" "mm" +state real GRAUPELNCV ij misc 1 - r "GRAUPELNCV" "TIME-STEP NONCONVECTIVE GRAUPEL" "mm" +state real NCA ij misc 1 - r "NCA" "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME" "" +state integer LOWLYR ij misc 1 - - "LOWLYR" "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME" "" +state real MASS_FLUX ij misc 1 - r "MASS_FLUX" "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME" "mb hour-1" +state real apr_gr ij misc 1 - r "APR_GR" "PRECIP FROM CLOSURE OLD_GRELL" "mm hour-1" +state real apr_w ij misc 1 - r "APR_W" "PRECIP FROM CLOSURE W" "mm hour-1" +state real apr_mc ij misc 1 - r "APR_MC" "PRECIP FROM CLOSURE KRISH MV" "mm hour-1" +state real apr_st ij misc 1 - r "APR_ST" "PRECIP FROM CLOSURE STABILITY" "mm hour-1" +state real apr_as ij misc 1 - r "APR_AS" "PRECIP FROM CLOSURE AS-TYPE" "mm hour-1" +state real apr_capma ij misc 1 - r "APR_CAPMA" "PRECIP FROM MAX CAP" "mm hour-1" +state real apr_capme ij misc 1 - r "APR_CAPME" "PRECIP FROM MEAN CAP" "mm hour-1" +state real apr_capmi ij misc 1 - r "APR_CAPMI" "PRECIP FROM MIN CAP" "mm hour-1" +state real edt_out ij misc 1 - - "EDT_OUT" "EDT FROM GD SCHEME" "" +state real xf_ens ije misc 1 Z r "XF_ENS" "MASS FLUX PDF IN GRELL CUMULUS SCHEME" "mb hour-1" +state real pr_ens ije misc 1 Z r "PR_ENS" "PRECIP RATE PDF IN GRELL CUMULUS SCHEME" "mb hour-1" +state real cugd_tten ikj misc 1 - h "CUGD_TTEN" "INITIAL TTENDENCY OUT OFF GRELL CUMULUS SCHEME" "K s-1" +state real cugd_qvten ikj misc 1 - h "CUGD_QVTEN" "INITIAL QTENDENCY OUT OFF GRELL CUMULUS SCHEME" "K s-1" +state real cugd_ttens ikj misc 1 - h "CUGD_TTENS" "INITIAL SUBSIDENCE TTENDENCY OUT OFF GRELL CUMULUS SCHEME" "K s-1" +state real cugd_qvtens ikj misc 1 - h "CUGD_QVTENS" "INITIAL SUBSIDNCE QTENDENCY OUT OFF GRELL CUMULUS SCHEME" "K s-1" +state real cugd_qcten ikj misc 1 - h "CUGD_QCTEN" "INITIAL TEMPERATURE TENDENCY OUT OFF GRELL CUMULUS SCHEME" "K s-1" +#state real ACLWUPTC ij misc 1 - rhdu "ACLWUPTC" "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2" +state real RTHFTEN ikj misc 1 - r "RTHFTEN" "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME" "K s-1" +state real RQVFTEN ikj misc 1 - r "RQVFTEN" "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME" "kg s-1" + +state integer STEPCU - misc 1 - r "STEPCU" "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS" "" + +state real RTHRATEN ikj misc 1 - rd "RTHRATEN" "COUPLED THETA TENDENCY DUE TO RADIATION" "Pa K s-1" +state real RTHRATENLW ikj misc 1 - r "RTHRATLW" "UNCOUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION" "K s-1" +state real RTHRATENSW ikj misc 1 - r "RTHRATSW" "UNCOUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION" "K s-1" +state real CLDFRA ikj misc 1 - r "CLDFRA" "CLOUD FRACTION" "" + +state real SWDOWN ij misc 1 - rd "SWDOWN" "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE" "W m-2" +state real SWDOWNC ij misc 1 - - "SWDOWNC" "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE" "W m-2" +state real GSW ij misc 1 - rd "GSW" "NET SHORT WAVE FLUX AT GROUND SURFACE" "W m-2" +state real GLW ij misc 1 - rd "GLW" "DOWNWARD LONG WAVE FLUX AT GROUND SURFACE" "W m-2" + +# upward and downward clearsky and total diagnostic fluxes for CAM radiation +#state real ACSWUPT ij misc 1 - rhdu "ACSWUPT" "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP" "J m-2" +#state real ACSWUPTC ij misc 1 - rhdu "ACSWUPTC" "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2" +#state real ACSWDNT ij misc 1 - rhdu "ACSWDNT" "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP" "J m-2" +#state real ACSWDNTC ij misc 1 - rhdu "ACSWDNTC" "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2" +#state real ACSWUPB ij misc 1 - rhdu "ACSWUPB" "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM" "J m-2" +#state real ACSWUPBC ij misc 1 - rhdu "ACSWUPBC" "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2" +#state real ACSWDNB ij misc 1 - rhdu "ACSWDNB" "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM" "J m-2" +#state real ACSWDNBC ij misc 1 - rhdu "ACSWDNBC" "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2" +#state real ACLWUPT ij misc 1 - rhdu "ACLWUPT" "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP" "J m-2" +#state real ACLWUPTC ij misc 1 - rhdu "ACLWUPTC" "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2" +#state real ACLWDNT ij misc 1 - rhdu "ACLWDNT" "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP" "J m-2" +#state real ACLWDNTC ij misc 1 - rhdu "ACLWDNTC" "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2" +#state real ACLWUPB ij misc 1 - rhdu "ACLWUPB" "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM" "J m-2" +#state real ACLWUPBC ij misc 1 - rhdu "ACLWUPBC" "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2" +#state real ACLWDNB ij misc 1 - rhdu "ACLWDNB" "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM" "J m-2" +#state real ACLWDNBC ij misc 1 - rhdu "ACLWDNBC" "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2" +#state real SWUPT ij misc 1 - rhdu "SWUPT" "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP" "J m-2" +#state real SWUPTC ij misc 1 - rhdu "SWUPTC" "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2" +#state real SWDNT ij misc 1 - rhdu "SWDNT" "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP" "J m-2" +#state real SWDNTC ij misc 1 - rhdu "SWDNTC" "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2" +#state real SWUPB ij misc 1 - rhdu "SWUPB" "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM" "J m-2" +#state real SWUPBC ij misc 1 - rhdu "SWUPBC" "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2" +#state real SWDNB ij misc 1 - rhdu "SWDNB" "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM" "J m-2" +#state real SWDNBC ij misc 1 - rhdu "SWDNBC" "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2" +#state real LWUPT ij misc 1 - rhdu "LWUPT" "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP" "J m-2" +#state real LWUPTC ij misc 1 - rhdu "LWUPTC" "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2" +#state real LWDNT ij misc 1 - rhdu "LWDNT" "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP" "J m-2" +#state real LWDNTC ij misc 1 - rhdu "LWDNTC" "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2" +#state real LWUPB ij misc 1 - rhdu "LWUPB" "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM" "J m-2" +#state real LWUPBC ij misc 1 - rhdu "LWUPBC" "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2" +#state real LWDNB ij misc 1 - rhdu "LWDNB" "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM" "J m-2" +#state real LWDNBC ij misc 1 - rhdu "LWDNBC" "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2" + +state real SWCF ij misc 1 - r "SWCF" "SHORT WAVE CLOUD FORCING AT TOA" "W m-2" +state real LWCF ij misc 1 - r "LWCF" "LONG WAVE CLOUD FORCING AT TOA" "W m-2" +state real OLR ij misc 1 - r "OLR" "TOA OUTGOING LONG WAVE" "W m-2" + +# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling +# with wave model, only if compiled with -DMCELIO, JM 2003/05/29 +state real XLAT ij misc 1 - i0123r01du=(copy_fcnm) "XLAT" "LATITUDE, SOUTH IS NEGATIVE" "degree_north" +state real XLONG ij misc 1 - i0123r01du=(copy_fcnm) "XLONG" "LONGITUDE, WEST IS NEGATIVE" "degree_east" +state real XLAT_U ij dyn_em 1 X i012r01du=(copy_fcnm) "XLAT_U" "LATITUDE, SOUTH IS NEGATIVE" "degree_north" +state real XLONG_U ij dyn_em 1 X i012r01du=(copy_fcnm) "XLONG_U" "LONGITUDE, WEST IS NEGATIVE" "degree_east" +state real XLAT_V ij dyn_em 1 Y i012r01du=(copy_fcnm) "XLAT_V" "LATITUDE, SOUTH IS NEGATIVE" "degree_north" +state real XLONG_V ij dyn_em 1 Y i012r01du=(copy_fcnm) "XLONG_V" "LONGITUDE, WEST IS NEGATIVE" "degree_east" +state real ALBEDO ij misc 1 - r "ALBEDO" "ALBEDO" +state real CLAT ij misc 1 - i012rdu=(copy_fcnm) "CLAT" "COMPUTATIONAL GRID LATITUDE, SOUTH IS NEGATIVE" "degree_north" +state real CLONG ij misc 1 - i012rdu=(copy_fcnm) "CLONG" "COMPUTATIONAL GRID LONGITUDE, WEST IS NEGATIVE" "degree_east" +state real ALBBCK ij misc 1 - i0124r "ALBBCK" "BACKGROUND ALBEDO" "" +state real EMBCK ij misc 1 - r "EMBCK" "BACKGROUND EMISSIVITY" "" +state real EMISS ij misc 1 - r "EMISS" "SURFACE EMISSIVITY" "" + +state real CLDEFI ij misc 1 - r "CLDEFI" "precipitation efficiency in BMJ SCHEME" "" +state integer STEPRA - misc 1 - r "STEPRA" "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS" "" + +state real RUBLTEN ikj misc 1 - r "RUBLTEN" "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION" "Pa m s-2" +state real RVBLTEN ikj misc 1 - r "RVBLTEN" "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION" "Pa m s-2" +state real RTHBLTEN ikj misc 1 - r "RTHBLTEN" "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION" "Pa K s-1" +state real RQVBLTEN ikj misc 1 - r "RQVBLTEN" "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION" "Pa kg kg-1 s-1" +state real RQCBLTEN ikj misc 1 - r "RQCBLTEN" "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION" "Pa kg kg-1 s-1" +state real RQIBLTEN ikj misc 1 - r "RQIBLTEN" "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION" "Pa kg kg-1 s-1" + +# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting. +state real mp_restart_state p misc 1 - r "MP_RESTART_STATE" "STATE VECTOR FOR MICROPHYSICS RESTARTS" +state real tbpvs_state p misc 1 - r "TBPVS_STATE" "STATE FOR ETAMPNEW MICROPHYSICS" +state real tbpvs0_state p misc 1 - r "TBPVS0_STATE" "STATE FOR ETAMPNEW MICROPHYSICS" + +# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in +# landuse_init (phys/module_physics_init.F) +state integer landuse_isice - misc - - r +state integer landuse_lucats - misc - - r +state integer landuse_luseas - misc - - r +state integer landuse_isn - misc - - r +state real lu_state p misc - - r + +i1 real th_phy ikj misc 1 - +i1 real pi_phy ikj misc 1 - +i1 real p_phy ikj misc 1 - +i1 real t_phy ikj misc 1 - +i1 real u_phy ikj misc 1 - +i1 real v_phy ikj misc 1 - +i1 real dz8w ikj misc 1 Z +i1 real p8w ikj misc 1 Z +i1 real t8w ikj misc 1 Z +i1 real rho_phy ikj misc 1 - +i1 logical CU_ACT_FLAG ij misc 1 - + + +state real TMN ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TMN" "SOIL TEMPERATURE AT LOWER BOUNDARY" "K" +state real XLAND ij misc 1 - i02rd=(interp_fcnm)u=(copy_fcnm) "XLAND" "LAND MASK (1 FOR LAND, 2 FOR WATER)" "" +state real ZNT ij misc 1 - i3r "ZNT" "TIME-VARYING ROUGHNESS LENGTH" "m" +state real CK ij misc 1 - r "CK" "ENTHALPY EXCHANGE COEFF AT 10 m" "" +state real CKA ij misc 1 - r "CKA" "ENTHALPY EXCHANGE COEFF AT LOWEST MODEL LVL" "" +state real CD ij misc 1 - r "CD" "DRAG COEFF AT 10m" "" +state real CDA ij misc 1 - r "CDA" "DRAG COEFF AT LOWEST MODEL LVL" "" +state real UST ij misc 1 - r "UST" "U* IN SIMILARITY THEORY" "m s-1" +state real USTM ij misc 1 - rh "USTM" "U* IN SIMILARITY THEORY WITHOUT VCONV" "m s-1" #SAVEMARS2 ustar +i1 real HOL ij misc 1 - - "HOL" "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH" "" +state real RMOL ij misc 1 - r "RMOL" "1./Monin Ob. Length" "" +state real MOL ij misc 1 - r "MOL" "T* IN SIMILARITY THEORY" "K" +state real PBLH ij misc 1 - r "PBLH" "PBL HEIGHT" "m" +state real CAPG ij misc 1 - r "CAPG" "HEAT CAPACITY FOR SOIL" "J K-1 m-3" +state real THC ij misc 1 - r "THC" "THERMAL INERTIA" "Cal cm-1 K-1 s-0.5" +state real HFX ij misc 1 - rh "HFX" "UPWARD HEAT FLUX AT THE SURFACE" "W m-2" #SAVEMARS2 sensheat +state real QFX ij misc 1 - r "QFX" "UPWARD MOISTURE FLUX AT THE SURFACE" "kg m-2 s-1" +state real LH ij misc 1 - r "LH" "LATENT HEAT FLUX AT THE SURFACE" "W m-2" +state real FLHC ij misc 1 - r "FLHC" "SURFACE EXCHANGE COEFFICIENT FOR HEAT" "" +state real FLQC ij misc 1 - r "FLQC" "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE" "" +state real QSG ij misc 1 - r "QSG" "SURFACE SATURATION WATER VAPOR MIXING RATIO" "kg kg-1" +state real QVG ij misc 1 - r "QVG" "WATER VAPOR MIXING RATIO AT THE SURFACE" "kg kg-1" +state real dfi_QVG ij misc 1 - r "QVG_dfi" "WATER VAPOR MIXING RATIO AT THE SURFACE" "kg kg-1" +state real QCG ij misc 1 - r "QCG" "CLOUD WATER MIXING RATIO AT THE SURFACE" "kg kg-1" +state real SOILT1 ij misc 1 - r "SOILT1" "TEMPERATURE INSIDE SNOW " "K" +state real dfi_SOILT1 ij misc 1 - r "SOILT1_dfi" "TEMPERATURE INSIDE SNOW " "K" +state real TSNAV ij misc 1 - r "TSNAV" "AVERAGE SNOW TEMPERATURE " "C" +state real dfi_TSNAV ij misc 1 - r "TSNAV_dfi" "AVERAGE SNOW TEMPERATURE " "C" +state real REGIME ij misc 1 - r "REGIME" "FLAGS: 1=Night/Stable, 2=Mechanical Turbulent, 3=Forced Conv, 4=Free Conv" "" +state real SNOWC ij misc 1 - ird=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SNOWC" "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)" "" +state real dfi_SNOWC ij misc 1 - r "SNOWC_dfi" "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)" "" +state real MAVAIL ij misc 1 - r "MAVAIL" "SURFACE MOISTURE AVAILABILITY" "" + +state real tkesfcf ij misc 1 - r "tkesfcf" "TKE AT THE SURFACE" "m2 s-2" + +state integer STEPBL - misc 1 - r "STEPBL" "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" "" +state real taucldi ikj misc 1 - r "TAUCLDI" "CLOUD OPTICAL THICKNESS FOR ICE" "" +state real taucldc ikj misc 1 - r "TAUCLDC" "CLOUD OPTICAL THICKNESS FOR WATER" "" + +state real defor11 ikj misc 1 - r "defor11" "DEFORMATION 11" "s-1" +state real defor22 ikj misc 1 - r "defor22" "DEFORMATION 22" "s-1" +state real defor12 ikj misc 1 - r "defor12" "DEFORMATION 12" "s-1" +state real defor33 ikj misc 1 z r "defor33" "DEFORMATION 33" "s-1" +state real defor13 ikj misc 1 z r "defor13" "DEFORMATION 13" "s-1" +state real defor23 ikj misc 1 z r "defor23" "DEFORMATION 23" "s-1" +state real xkmv ikj misc 1 - r "xkmv" "VERTICAL EDDY VISCOSITY" "m2 s-1" +state real xkmh ikj misc 1 - r "xkmh" "HORIZONTAL EDDY VISCOSITY" "m2 s-1" +state real xkhv ikj misc 1 - r "xkhv" "VERTICAL EDDY DIFFUSIVITY OF HEAT" "m2 s-1" +state real xkhh ikj misc 1 - r "xkhh" "HORIZONTAL EDDY DIFFUSIVITY OF HEAT" "m2 s-1" +state real div ikj misc 1 - r "div" "DIVERGENCE" "s-1" +state real BN2 ikj misc 1 - r "BN2" "BRUNT-VAISALA FREQUENCY" "s-2" +state logical warm_rain - misc 1 - - "warm_rain" "WARM_RAIN_LOGICAL" +state logical adv_moist_cond - misc 1 - - "adv_moist_cond" "ADVECT MOIST CONDENSATES LOGICAL" + +## FDDA variables + +state integer STEPFG - misc 1 - r "STEPFG" "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" "" +state real RUNDGDTEN ikj misc 1 X r "RUNDGDTEN" "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING" "Pa m s-2" +state real RVNDGDTEN ikj misc 1 Y r "RVNDGDTEN" "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING" "Pa m s-2" +state real RTHNDGDTEN ikj misc 1 - r "RTHNDGDTEN" "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING" "Pa K s-1" +state real RQVNDGDTEN ikj misc 1 - r "RQVNDGDTEN" "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING" "Pa kg kg-1 s-1" +state real RMUNDGDTEN ij misc 1 - r "RMUNDGDTEN" "MU TENDENCY DUE TO FDDA GRID NUDGING" "Pa s-1" +state real - ikjf fdda3d 1 - - - +state real U_NDG_NEW ikjf fdda3d 1 X igr "U_NDG_NEW" "NEW X WIND FOR FDDA GRID NUDGING" "m s-1" +state real V_NDG_NEW ikjf fdda3d 1 Y igr "V_NDG_NEW" "NEW Y WIND FOR FDDA GRID NUDGING" "m s-1" +state real T_NDG_NEW ikjf fdda3d 1 - igr "T_NDG_NEW" "NEW PERT POT TEMP FOR FDDA GRID NUDGING" "K" +state real Q_NDG_NEW ikjf fdda3d 1 - igr "Q_NDG_NEW" "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING" "kg/kg" +state real PH_NDG_NEW ikjf fdda3d 1 Z igr "PH_NDG_NEW" "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING" "kg/kg" +state real U_NDG_OLD ikjf fdda3d 1 X igr "U_NDG_OLD" "OLD X WIND FOR FDDA GRID NUDGING" "m s-1" +state real V_NDG_OLD ikjf fdda3d 1 Y igr "V_NDG_OLD" "OLD Y WIND FOR FDDA GRID NUDGING" "m s-1" +state real T_NDG_OLD ikjf fdda3d 1 - igr "T_NDG_OLD" "OLD PERT POT TEMP FOR FDDA GRID NUDGING" "K" +state real Q_NDG_OLD ikjf fdda3d 1 - igr "Q_NDG_OLD" "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING" "kg/kg" +state real PH_NDG_OLD ikjf fdda3d 1 Z igr "PH_NDG_OLD" "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING" "kg/kg" +state real - ivjf fdda2d 1 Z - - +state real MU_NDG_NEW ivjf fdda2d 1 Z igr "MU_NDG_NEW" "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING" "Pa" +state real T2_NDG_NEW ivjf fdda2d 1 - igr "T2_NDG_NEW" "NEW 2m TEMP FOR PX LSM " "K" +state real Q2_NDG_NEW ivjf fdda2d 1 - igr "Q2_NDG_NEW" "NEW 2m WATER VAPOR MIX RATIO FOR PX LSM " "kg/kg" +state real MU_NDG_OLD ivjf fdda2d 1 Z igr "MU_NDG_OLD" "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING" "Pa" +state real T2_NDG_OLD ivjf fdda2d 1 - igr "T2_NDG_OLD" "OLD 2m TEMP F FOR PX LSM" "K" +state real Q2_NDG_OLD ivjf fdda2d 1 - igr "Q2_NDG_OLD" "OLD 2m WATER VAPOR MIX RATIO FOR PX LSM" "kg/kg" +state real SN_NDG_NEW ivjf fdda2d 1 - igr "SN_NDG_NEW" "NEW Snow Depth " "m" +state real SN_NDG_OLD ivjf fdda2d 1 - igr "SN_NDG_OLD" "OLD Snow Depth" "m" + + +# flag for nest movement +state logical moved - misc 1 - - + +# special cam radiation restart arrays +state real abstot ikcj misc 1 Z - "" "" " " +state real absnxt ikaj misc 1 - - "" "" " " +state real emstot ikj misc 1 Z - "" "" " " + +# model diagnostics +state real dpsdt ij misc 1 - - "dpsdt" "surface pressure tendency" "Pa/sec" +state real dmudt ij misc 1 - - "dmudt" "mu tendency" "Pa/sec" +state real pk1m ij misc 1 - - "pk1m" "surface pressure at previous step" "Pa" +state real mu_2m ij misc 1 - - "mu_2m" "mu_2 at previous step" "Pa" + +state real max_cfl - misc 1 - - "max_cfl" "maximum CFL value in grid at a time" "-" + +# Ocean Mixed-Layer State Variables +state real TML ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "TML" "OCEAN MIXED-LAYER TEMPERATURE" "K" +state real T0ML ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "T0ML" "INITIAL OCEAN MIXED-LAYER TEMPERATURE" "K" +state real HML ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "HML" "OCEAN MIXED-LAYER DEPTH" "m" +state real H0ML ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "H0ML" "INITIAL OCEAN MIXED-LAYER DEPTH" "m" +state real HUML ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "HUML" "OCEAN MIXED-LAYER DEPTH * U-CURRENT" " m2s-1 " +state real HVML ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "HVML" "OCEAN MIXED-LAYER DEPTH * V-CURRENT" " m2s-1 " +# +#--------------------------------------------------------------------------------------------------------------------------------------- +# + +###### +# +# Variables that are set at run-time to control configuration (namelist-settable) +# +#
+ + +# Time Control +rconfig integer run_days namelist,time_control 1 0 irh "run_days" "NUMBER OF DAYS TO RUN" +rconfig integer run_hours namelist,time_control 1 0 irh "run_hours" "NUMBER OF HOURS TO RUN" +rconfig integer run_minutes namelist,time_control 1 0 irh "run_minutes" "NUMBER OF MINUTES TO RUN" +rconfig integer run_seconds namelist,time_control 1 0 irh "run_seconds" "NUMBER OF SECONDS TO RUN" +rconfig integer start_year namelist,time_control max_domains 2024 irh "start_year" "4 DIGIT YEAR OF START OF MODEL" "YEARS" +rconfig integer start_month namelist,time_control max_domains 01 irh "start_month" "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS" +rconfig integer start_day namelist,time_control max_domains 01 irh "start_day" "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS" +rconfig integer start_hour namelist,time_control max_domains 00 irh "start_hour" "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS" +rconfig integer start_minute namelist,time_control max_domains 00 irh "start_minute" "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES" +rconfig integer start_second namelist,time_control max_domains 00 irh "start_second" "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS" +rconfig integer end_year namelist,time_control max_domains 2024 irh "end_year" "4 DIGIT YEAR OF END OF MODEL" "YEARS" +rconfig integer end_month namelist,time_control max_domains 01 irh "end_month" "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS" +rconfig integer end_day namelist,time_control max_domains 02 irh "end_day" "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS" +rconfig integer end_hour namelist,time_control max_domains 00 irh "end_hour" "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS" +rconfig integer end_minute namelist,time_control max_domains 00 irh "end_minute" "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES" +rconfig integer end_second namelist,time_control max_domains 00 irh "end_second" "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS" +rconfig integer interval_seconds namelist,time_control 1 43200 irh "interval_seconds" "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS" +rconfig logical input_from_file namelist,time_control max_domains .false. irh "input_from_file" "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE" "" +rconfig integer fine_input_stream namelist,time_control max_domains 0 irh "fine_input_stream" "0 THROUGH 11, WHAT INPUT STREAM IS FINE GRID IC FROM" "" +rconfig logical input_from_hires namelist,time_control max_domains .false. irh "input_from_hires" "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN" "" +rconfig character rsmas_data_path namelist,time_control 1 "." - "rsmas_data_path" "" "" +rconfig logical all_ic_times namelist,time_control 1 .false. irh "all_ic_times" "T/F WRITE ALL IC TIME PERIODS" "" + +include registry.io_boilerplate + +rconfig integer JULYR namelist,time_control max_domains 0 h "JULYR" "" "" +rconfig integer JULDAY namelist,time_control max_domains 1 h "JULDAY" "" "" +rconfig real GMT namelist,time_control max_domains 0. h "GMT" "" "" +rconfig character input_inname namelist,time_control 1 "wrfinput_d" - "name of input infile" "" "" +rconfig character input_outname namelist,time_control 1 "wrfinput_d" - "name of input outfile" "" "" +rconfig character bdy_inname namelist,time_control 1 "wrfbdy_d" - "name of boundary infile" "" "" +rconfig character bdy_outname namelist,time_control 1 "wrfbdy_d" - "name of boundary outfile" "" "" +rconfig character rst_inname namelist,time_control 1 "wrfrst_d_" - "name of restrt infile" "" "" +rconfig character rst_outname namelist,time_control 1 "wrfrst_d_" - "name of restrt outfile" "" "" +rconfig logical write_input namelist,time_control 1 .false. - "write input data for 3dvar etc." "" "" +rconfig logical write_restart_at_0h namelist,time_control 1 .false. h "write_restart_at_0h" "" "" +rconfig logical adjust_output_times namelist,time_control 1 .false. - "adjust_output_times" +rconfig logical adjust_input_times namelist,time_control 1 .false. - "adjust_input_times" + +rconfig integer diag_print namelist,time_control 1 0 - "print out time series of model diagnostics" +rconfig logical nocolons namelist,time_control 1 .false. - "nocolons" + +# DFI namelist +rconfig integer dfi_opt namelist,dfi_control 1 0 rh "dfi_opt" "" "" +rconfig integer dfi_nfilter namelist,dfi_control 1 7 rh "dfi_nfilter" "Digital filter type" "" +rconfig logical dfi_write_filtered_input namelist,dfi_control 1 .true. rh "dfi_write_filtered_input" "Write a wrfinput_filtered_d0n file?" "" +rconfig logical dfi_write_dfi_history namelist,dfi_control 1 .false. rh "dfi_write_dfi_history" "Write history files during filtering?" "" +rconfig integer dfi_cutoff_seconds namelist,dfi_control 1 3600 rh "dfi_cutoff_seconds" "Digital filter cutoff time" "" +rconfig integer dfi_time_dim namelist,dfi_control 1 1000 rh "dfi_time_dim" "MAX DIMENSION FOR HCOEFF" +rconfig integer dfi_fwdstop_year namelist,dfi_control 1 2004 rh "dfi_fwdstop_year" "4 DIGIT YEAR OF START OF DFI" "YEARS" +rconfig integer dfi_fwdstop_month namelist,dfi_control 1 03 rh "dfi_fwdstop_month" "2 DIGIT MONTH OF THE YEAR OF START OF DFI" "MONTHS" +rconfig integer dfi_fwdstop_day namelist,dfi_control 1 13 rh "dfi_fwdstop_day" "2 DIGIT DAY OF THE MONTH OF START OF DFI" "DAYS" +rconfig integer dfi_fwdstop_hour namelist,dfi_control 1 12 rh "dfi_fwdstop_hour" "2 DIGIT HOUR OF THE DAY OF START OF DFI" "HOURS" +rconfig integer dfi_fwdstop_minute namelist,dfi_control 1 00 rh "dfi_fwdstop_minute" "2 DIGIT MINUTE OF THE HOUR OF START OF DFI" "MINUTES" +rconfig integer dfi_fwdstop_second namelist,dfi_control 1 00 rh "dfi_fwdstop_second" "2 DIGIT SECOND OF THE MINUTE OF START OF DFI" "SECONDS" +rconfig integer dfi_bckstop_year namelist,dfi_control 1 2004 rh "dfi_bckstop_year" "4 DIGIT YEAR OF END OF DFI" "YEARS" +rconfig integer dfi_bckstop_month namelist,dfi_control 1 03 rh "dfi_bckstop_month" "2 DIGIT MONTH OF THE YEAR OF END OF DFI" "MONTHS" +rconfig integer dfi_bckstop_day namelist,dfi_control 1 14 rh "dfi_bckstop_day" "2 DIGIT DAY OF THE MONTH OF END OF DFI" "DAYS" +rconfig integer dfi_bckstop_hour namelist,dfi_control 1 12 rh "dfi_bckstop_hour" "2 DIGIT HOUR OF THE DAY OF END OF DFI" "HOURS" +rconfig integer dfi_bckstop_minute namelist,dfi_control 1 00 rh "dfi_bckstop_minute" "2 DIGIT MINUTE OF THE HOUR OF END OF DFI" "MINUTES" +rconfig integer dfi_bckstop_second namelist,dfi_control 1 00 rh "dfi_bckstop_second" "2 DIGIT SECOND OF THE MINUTE OF END OF DFI" "SECONDS" + +# Domains +rconfig integer time_step namelist,domains 1 - ih "time_step" +rconfig integer time_step_fract_num namelist,domains 1 0 ih "time_step_fract_num" +rconfig integer time_step_fract_den namelist,domains 1 1 ih "time_step_fract_den" + +rconfig integer min_time_step namelist,domains max_domains -1 h "min_time_step" +rconfig integer max_time_step namelist,domains max_domains -1 h "max_time_step" +rconfig real target_cfl namelist,domains max_domains 1.2 h "target_cfl" +rconfig integer max_step_increase_pct namelist,domains max_domains 5 h "max_step_increase_pct" +rconfig integer starting_time_step namelist,domains max_domains -1 h "starting_time_step" +rconfig logical step_to_output_time namelist,domains 1 .true. h "step_to_output_time" +rconfig logical use_adaptive_time_step namelist,domains 1 .false. h "use_adaptive_time_step" + +rconfig integer max_dom namelist,domains 1 1 irh "max_dom" "" "" +rconfig integer s_we namelist,domains max_domains 1 irh "s_we" "" "" +rconfig integer e_we namelist,domains max_domains 32 irh "e_we" "" "" +rconfig integer s_sn namelist,domains max_domains 1 irh "s_sn" "" "" +rconfig integer e_sn namelist,domains max_domains 32 irh "e_sn" "" "" +rconfig integer s_vert namelist,domains max_domains 1 irh "s_vert" "" "" +rconfig integer e_vert namelist,domains max_domains 31 irh "e_vert" "" "" +rconfig integer num_metgrid_levels namelist,domains 1 27 irh "num_metgrid_levels" "" "" +rconfig real p_top_requested namelist,domains 1 5000 irh "p_top_requested" "Pa" "" +rconfig integer interp_type namelist,domains 1 2 irh "interp_type" "1=interp in pressure, 2=interp in LOG pressure" "" +rconfig integer extrap_type namelist,domains 1 2 irh "extrap_type" "1= use 2 lowest levels, 2=constant" "" +rconfig integer t_extrap_type namelist,domains 1 2 irh "t_extrap_type" "1=isothermal, 2=6.5 K/km, 3=adiabatic" "" +rconfig logical lowest_lev_from_sfc namelist,domains 1 .false. irh "lowest_lev_from_sfc" "" "" +rconfig logical use_levels_below_ground namelist,domains 1 .true. irh "use_levels_below_ground" "T/F: use input data levels below input sfc pres" "" +rconfig logical use_surface namelist,domains 1 .true. irh "use_surface" "T/F: use input surface level in interpolation" "" +rconfig integer lagrange_order namelist,domains 1 1 irh "lagrange_order" "1=linear, 2=quadratic vertical interpolation" "" +rconfig integer force_sfc_in_vinterp namelist,domains 1 1 irh "force_sfc_in_vinterp" "number of eta levels forced to use sfc in vert interp" "" +rconfig real zap_close_levels namelist,domains 1 500 irh "zap_close_levels" "delta p where level is removed in vert interp" "Pa" +rconfig logical sfcp_to_sfcp namelist,domains 1 .false. irh "sfcp_to_sfcp" "T/F use incoming sfc pres to compute new sfc pres" "flag" +rconfig logical adjust_heights namelist,domains 1 .false. irh "adjust_heights" "T/F adjust pressure level input to match 500 mb height" "flag" +rconfig logical smooth_cg_topo namelist,domains 1 .false. irh "smooth_cg_topo" "T/F smooth CG topo on boundarries" "flag" +rconfig real dx namelist,domains max_domains 200 h "dx" "X HORIZONTAL RESOLUTION" "METERS" +rconfig real dy namelist,domains max_domains 200 h "dy" "Y HORIZONTAL RESOLUTION" "METERS" +rconfig integer grid_id namelist,domains max_domains 1 irh "id" "" "" +rconfig logical grid_allowed namelist,domains max_domains .true. irh "allowed" "" "" +rconfig integer parent_id namelist,domains max_domains 0 h "parent_id" "" "" +rconfig integer i_parent_start namelist,domains max_domains 1 rh "i_parent_start" "" "" +rconfig integer j_parent_start namelist,domains max_domains 1 rh "j_parent_start" "" "" +rconfig integer parent_grid_ratio namelist,domains max_domains 1 h "parent_grid_ratio" "" "" +rconfig integer parent_time_step_ratio namelist,domains max_domains 1 h "parent_time_step_ratio" "" "" +rconfig integer feedback namelist,domains 1 1 h "feedback" "" "" +rconfig integer smooth_option namelist,domains 1 2 h "smooth_option" "" "" +rconfig integer blend_width namelist,domains 1 5 h "blend_width" "width of cg fg terrain blended zone" "" +rconfig real ztop namelist,domains max_domains 15000. h "ztop" "" "" +rconfig integer moad_grid_ratio namelist,domains max_domains 1 h "moad_grid_ratio" "" "" +rconfig integer moad_time_step_ratio namelist,domains max_domains 1 h "moad_time_step_ratio" "" "" +rconfig integer shw namelist,domains max_domains 2 h "stencil_half_width" "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH" "GRID POINTS" +rconfig integer tile_sz_x namelist,domains 1 0 - "tile_sz_x" "" "" +rconfig integer tile_sz_y namelist,domains 1 0 - "tile_sz_y" "" "" +rconfig integer numtiles namelist,domains 1 1 - "numtiles" "" "" +rconfig integer nproc_x namelist,domains 1 -1 - "nproc_x" "-1 means not set" "" +rconfig integer nproc_y namelist,domains 1 -1 - "nproc_y" "-1 means not set" "" +rconfig integer irand namelist,domains 1 0 - "irand" "" "" +rconfig real dt derived max_domains 2. h "dt" "TEMPORAL RESOLUTION" "SECONDS" +rconfig integer num_moves namelist,domains 1 0 +rconfig integer ts_buf_size namelist,domains 1 200 - "ts_buf_size" "Size of time series buffer" +rconfig integer max_ts_locs namelist,domains 1 5 - "max_ts_locs" "Maximum number of time series locations" +rconfig integer vortex_interval namelist,domains max_domains 15 - "" "" "minutes" +rconfig integer max_vortex_speed namelist,domains max_domains 40 - "" "" "meters per second" +rconfig integer corral_dist namelist,domains max_domains 8 +rconfig integer track_level namelist,domains 1 50000 +rconfig integer move_id namelist,domains max_moves 0 +rconfig integer move_interval namelist,domains max_moves 999999999 +rconfig integer move_cd_x namelist,domains max_moves 0 +rconfig integer move_cd_y namelist,domains max_moves 0 +rconfig logical swap_x namelist,domains max_domains .false. rh "swap_x" "" "" +rconfig logical swap_y namelist,domains max_domains .false. rh "swap_y" "" "" +rconfig logical cycle_x namelist,domains max_domains .false. rh "cycle_x" "" "" +rconfig logical cycle_y namelist,domains max_domains .false. rh "cycle_y" "" "" +rconfig logical reorder_mesh namelist,domains 1 .false. rh "reorder_mesh" "" "" +rconfig logical perturb_input namelist,domains 1 .false. h "" "" "" +rconfig real eta_levels namelist,domains max_eta -1. +rconfig real max_dz namelist,domains 1 1000. + +# Physics +###### +###### MARS SPECIFIC NAMELIST ENTRIES +###### +rconfig character planet namelist,physics 1 "mars" - "planet" "selection of the planet" "" +rconfig integer mars namelist,physics max_domains 0 rh "mars" "model mode" "" +rconfig real init_TI namelist,physics max_domains 0 irh "init_TI" "thermal inertia" "" +rconfig real init_AL namelist,physics max_domains 0 irh "init_AL" "albedo" "" +rconfig real init_Z0 namelist,physics max_domains 0 irh "init_Z0" "surface roughness" "" +rconfig real init_U namelist,physics max_domains 0 irh "init_U" "zonal wind" "" +rconfig real init_V namelist,physics max_domains 0 irh "init_V" "meridional wind" "" +rconfig integer init_WX namelist,physics max_domains 0 irh "init_WX" "x coord" "" +rconfig integer init_WY namelist,physics max_domains 0 irh "init_WY" "y coord" "" +rconfig real init_MU namelist,physics max_domains 0 irh "init_MU" "zonal wind mult." "" +rconfig real init_MV namelist,physics max_domains 0 irh "init_MV" "meridional wind mult." "" +rconfig logical init_LES namelist,physics max_domains .false. irh "init_LES" "LES mode" "" +rconfig logical modif_wrf namelist,physics max_domains .true. ir "modif_wrf" "true if tweaked WRF" "" +####### +####### MARS SPECIFIC NAMELIST ENTRIES +####### +rconfig integer mp_physics namelist,physics max_domains 0 rh "mp_physics" "" "" +rconfig integer gsfcgce_hail namelist,physics 1 0 rh "gsfcgce select hail/graupel" "" "" +rconfig integer gsfcgce_2ice namelist,physics 1 0 rh "gsfcgce select 2ice/3ice" "" "" +rconfig integer progn namelist,physics max_domains 0 rh "progn" "" "" +rconfig integer ra_lw_physics namelist,physics max_domains 0 rh "ra_lw_physics" "" "" +rconfig integer ra_sw_physics namelist,physics max_domains 0 rh "ra_sw_physics" "" "" +rconfig real radt namelist,physics max_domains 1 h "RADT" "" "" +rconfig real naer namelist,physics max_domains 1e9 rh "NAER" "" "" +rconfig integer sf_sfclay_physics namelist,physics max_domains 0 rh "sf_sfclay_physics" "" "" +rconfig integer sf_surface_physics namelist,physics max_domains 0 rh "sf_surface_physics" "" "" +rconfig integer bl_pbl_physics namelist,physics max_domains 0 rh "bl_pbl_physics" "" "" +rconfig real BLDT namelist,physics max_domains 0 h "BLDT" "" "" +rconfig integer cu_physics namelist,physics max_domains 0 rh "cu_physics" "" "" +rconfig real CUDT namelist,physics max_domains 0 h "CUDT" "" "" +rconfig real GSMDT namelist,physics max_domains 0 h "GSMDT" "" "" +rconfig integer ISFFLX namelist,physics 1 1 irh "ISFFLX" "" "" +rconfig integer IFSNOW namelist,physics 1 0 irh "IFSNOW" "" "" +rconfig integer ICLOUD namelist,physics 1 1 irh "ICLOUD" "" "" +rconfig real swrad_scat namelist,physics 1 1 irh "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD" "" +rconfig integer surface_input_source namelist,physics 1 1 irh "surface_input_source" "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)" "" +rconfig integer num_soil_layers namelist,physics 1 10 irh "num_soil_layers" "" "" +rconfig integer num_months namelist,physics 1 12 irh "num_months" "" "" +rconfig integer maxiens namelist,physics 1 1 irh "maxiens" "" "" +rconfig integer maxens namelist,physics 1 3 irh "maxens" "" "" +rconfig integer maxens2 namelist,physics 1 3 irh "maxens2" "" "" +rconfig integer maxens3 namelist,physics 1 16 irh "maxens3" "" "" +rconfig integer ensdim namelist,physics 1 144 irh "ensdim" "" "" +rconfig integer cugd_avedx namelist,physics 1 1 irh "cugd_avedx" "" "" +rconfig integer clos_choice namelist,physics 1 0 rh "clos_choice" "" "" +rconfig integer imomentum namelist,physics 1 0 rh "imomentum" "momentum transport in G3 scheme" "" +rconfig integer chem_opt namelist,physics max_domains 0 rh "chem_opt" "" "" +rconfig integer num_land_cat namelist,physics 1 24 - "num_land_cat" "" "" +rconfig integer num_soil_cat namelist,physics 1 16 - "num_soil_cat" "" "" +rconfig integer mp_zero_out namelist,physics 1 0 - "mp_zero_out" "microphysics fields set to zero 0=no action taken, 1=all fields but Qv, 2=all fields including Qv" "flag" +rconfig real mp_zero_out_thresh namelist,physics 1 1.e-8 - "mp_zero_out_thresh" "minimum threshold for non-Qv moist fields, below are set to zero" "kg/kg" +rconfig real seaice_threshold namelist,physics 1 271 h "seaice_threshold" "tsk below which which water points are set to sea ice for slab scheme" "K" +rconfig integer sst_update namelist,physics 1 0 h "sst_update" "update sst from wrflowinp file 0=no, 1=yes" "" +rconfig integer ucmcall namelist,physics max_domains 0 h "ucmcall" "activate urban model 0=no, 1=yes" "" +rconfig logical usemonalb namelist,physics 1 .false. h "usemonalb" "use 2d field vs table values false=table, True=2d" "" +rconfig integer co2tf namelist,physics 1 1 - "co2tf" "GFDL radiation co2 flag" "" +rconfig integer ra_call_offset namelist,physics 1 0 - "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" "" +rconfig real cam_abs_freq_s namelist,physics 1 21600. - "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s" +rconfig integer levsiz namelist,physics 1 1 - "levsiz" "Number of ozone data levels for CAM radiation (59)" "" +rconfig integer paerlev namelist,physics 1 1 - "paerlev" "Number of aerosol data levels for CAM radiation (29)" "" +rconfig integer cam_abs_dim1 namelist,physics 1 1 - "cam_abs_dim1" "dimension for absnxt in CAM radiation" "" +rconfig integer cam_abs_dim2 namelist,physics 1 1 - "cam_abs_dim2" "dimension for abstot in CAM radiation" "" +rconfig logical cu_rad_feedback namelist,physics max_domains .false. - "feedback cumulus to radiation" "" +rconfig integer pxlsm_smois_init namelist,physics max_domains 1 irh "PXLSM_SMOIS_INIT" "Soil moisture initialization option 0-From analysis 1-From MAVAIL" "" +rconfig integer omlcall namelist,physics 1 0 h "omlcall" "activate simple ocean mixed layer model 0=no, 1=yes" "" +rconfig real oml_hml0 namelist,physics 1 50 h "oml_hml0" "oml initial mixed layer depth value" "m" +rconfig real oml_gamma namelist,physics 1 0.14 h "oml_gamma" "oml deep water lapse rate" "K m-1" +rconfig integer isftcflx namelist,physics 1 0 h "isftcflx" "switch to control sfc fluxes" "" +rconfig real shadlen namelist,physics 1 25000. - "shadow_length" "maximum length of orographic shadow" "m" +rconfig integer slope_rad namelist,physics max_domains 0 - "slope_rad" "1: use slope-dependent radiation, 0:not" "" +rconfig integer topo_shading namelist,physics max_domains 0 - "topo_shading" "1: apply topographic shading to radiation, 0:not" "" +rconfig integer no_mp_heating namelist,physics 1 0 - "no_mp_heating" "switch to turn of latent heating in mp schemes" "" + +#FDDA namelist parameters +rconfig real FGDT namelist,fdda max_domains 0 h "FGDT" "" "" +rconfig integer grid_fdda namelist,fdda max_domains 0 rh "grid_fdda" "" "" +rconfig integer if_no_pbl_nudging_uv namelist,fdda max_domains 0 rh "grid_fdda" "" "" +rconfig integer if_no_pbl_nudging_t namelist,fdda max_domains 0 rh "grid_fdda" "" "" +rconfig integer if_no_pbl_nudging_q namelist,fdda max_domains 0 rh "grid_fdda" "" "" +rconfig integer if_zfac_uv namelist,fdda max_domains 0 rh "grid_fdda" "" "" +rconfig integer k_zfac_uv namelist,fdda max_domains 0 rh "grid_fdda" "" "" +rconfig integer if_zfac_t namelist,fdda max_domains 0 rh "grid_fdda" "" "" +rconfig integer k_zfac_t namelist,fdda max_domains 0 rh "grid_fdda" "" "" +rconfig integer if_zfac_q namelist,fdda max_domains 0 rh "grid_fdda" "" "" +rconfig integer k_zfac_q namelist,fdda max_domains 0 rh "grid_fdda" "" "" +rconfig real guv namelist,fdda max_domains 0 rh "grid_fdda" "" "" +rconfig real gt namelist,fdda max_domains 0 rh "grid_fdda" "" "" +rconfig real gq namelist,fdda max_domains 0 rh "grid_fdda" "" "" +rconfig real dtramp_min namelist,fdda 1 0 h "grid_fdda" "" "" +rconfig integer if_ramping namelist,fdda 1 0 h "grid_fdda" "" "" + +#Observational Nudging +rconfig integer obs_nudge_opt namelist,fdda max_domains 0 rh "obs_nudge_opt" "Obs-nudging flag for domain" "" +rconfig integer max_obs namelist,fdda 1 0 h "max_obs" "Maximum number of observations" "" +rconfig real fdda_start namelist,fdda max_domains 0 rh "fdda_start" "Nudging start time for domain" "min" +rconfig real fdda_end namelist,fdda max_domains 0 rh "fdda_end" "Nudging end time for domain" "min" +rconfig integer obs_nudge_wind namelist,fdda max_domains 0 rh "obs_nudge_wind" "Wind-nudging flag for domain" "" +rconfig real obs_coef_wind namelist,fdda max_domains 0 rh "obs_coef_wind" "Wind-nudging coeficient for domain" "s-1" +rconfig integer obs_nudge_temp namelist,fdda max_domains 0 rh "obs_nudge_temp" "Temperature-nudging flag for domain" "" +rconfig real obs_coef_temp namelist,fdda max_domains 0 rh "obs_coef_temp" "Temperature-nudging coef for domain" "s-1" +rconfig integer obs_nudge_mois namelist,fdda max_domains 0 rh "obs_nudge_mois" "Moisture-nudging flag for domain" "" +rconfig real obs_coef_mois namelist,fdda max_domains 0 rh "obs_coef_mois" "Moisture-nudging coef for domain" "s-1" +rconfig integer obs_nudge_pstr namelist,fdda max_domains 0 rh "obs_nudge_pstr" "Not used" "" +rconfig real obs_coef_pstr namelist,fdda max_domains 0 rh "obs_coef_pstr" "Not used" "" +rconfig real obs_rinxy namelist,fdda max_domains 0 rh "obs_rinxy" "Horizontal radius of influence" "km" +rconfig real obs_rinsig namelist,fdda 1 0 h "obs_rinsig" "Vertical radius of influence" "sigma" +rconfig real obs_twindo namelist,fdda max_domains 0 rh "obs_twindo" "Half-period time window for nudging" "hrs" +rconfig integer obs_npfi namelist,fdda 1 0 h "obs_npfi" "Freq in cg timesteps for diag print" "" +rconfig integer obs_ionf namelist,fdda max_domains 1 rh "obs_ionf" "Freq in cg timesteps for obs input and error calc" "" +rconfig integer obs_idynin namelist,fdda 1 0 h "obs_idynin" "Flag for dynamic initialization" "" +rconfig real obs_dtramp namelist,fdda 1 0 h "obs_dtramp" "Time period for ramping (idynin)" "min" +rconfig integer obs_nobs_prt namelist,fdda max_domains 0 rh "obs_nobs_prt" "Number of current obs to print grid coord. info." "" +rconfig logical obs_ipf_in4dob namelist,fdda 1 .false. h "obs_ipf_in4dob" "Print obs input diagnostics" "" +rconfig logical obs_ipf_errob namelist,fdda 1 .false. h "obs_ipf_errob" "Print obs error diagnostics" "" +rconfig logical obs_ipf_nudob namelist,fdda 1 .false. h "obs_ipf_nudob" "Print obs nudge diagnostics" "" +rconfig logical obs_ipf_init namelist,fdda 1 .true. h "obs_ipf_init" "Enable obs init warning messages" "" + + +# Dynamics +# dynamics option (see package definitions, below) +rconfig integer rk_ord namelist,dynamics 1 3 irh "rk_order" "" "" +rconfig integer w_damping namelist,dynamics 1 0 irh "w_damping" "" "" +# diff_opt 1=old diffusion, 2=new +rconfig integer diff_opt namelist,dynamics 1 1 irh "diff_opt" "" "" +# km_opt 1=old coefs, 2=tke, 3=Smagorinksy +rconfig integer km_opt namelist,dynamics 1 1 irh "km_opt" "" "" +# km_opt_dfi is needed for backward integration in dfi +rconfig integer km_opt_dfi namelist,dynamics 1 1 irh "km_opt_dfi" "" "" +rconfig integer damp_opt namelist,dynamics 1 0 irh "damp_opt" "" "" +rconfig real zdamp namelist,dynamics max_domains 5000. h "zdamp" "" "" +rconfig real dampcoef namelist,dynamics max_domains 0. h "dampcoef" "" "" +rconfig real khdif namelist,dynamics max_domains 0 h "khdif" "" "" +rconfig real kvdif namelist,dynamics max_domains 0 h "kvdif" "" "" +rconfig real diff_6th_factor namelist,dynamics max_domains 0.2 h "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion" +rconfig integer diff_6th_opt namelist,dynamics max_domains 2 irh "diff_6th_opt" "switch for 6th-order numerical diffusion" +rconfig real c_s namelist,dynamics max_domains 0.25 h "c_s" "Smagorinsky coeff" "" +rconfig real c_k namelist,dynamics max_domains 0.15 h "c_k" "TKE coeff" "" +rconfig real smdiv namelist,dynamics max_domains 0.1 h "smdiv" "" "" +rconfig real emdiv namelist,dynamics max_domains 0.01 h "emdiv" "" "" +rconfig real epssm namelist,dynamics max_domains 0.1 h "epssm" "" "" +rconfig logical non_hydrostatic namelist,dynamics max_domains .true. irh "non_hydrostatic" "" "" +rconfig integer time_step_sound namelist,dynamics max_domains 6 h "time_step_sound" "" "" +rconfig integer h_mom_adv_order namelist,dynamics max_domains 5 rh "h_mom_adv_order" "" "" +rconfig integer v_mom_adv_order namelist,dynamics max_domains 3 rh "v_mom_adv_order" "" "" +rconfig integer h_sca_adv_order namelist,dynamics max_domains 5 rh "h_sca_adv_order" "" "" +rconfig integer v_sca_adv_order namelist,dynamics max_domains 3 rh "v_sca_adv_order" "" "" +rconfig logical pd_moist namelist,dynamics max_domains .false. rh "pd_moist" "positive-definite RK3 transport switch" "" +rconfig logical pd_moist_dfi namelist,dynamics max_domains .false. rh "pd_moist_dfi" "positive-definite RK3 transport switch" "" +rconfig logical pd_chem namelist,dynamics max_domains .false. rh "pd_chem" "positive-definite RK3 transport switch" "" +rconfig logical pd_scalar namelist,dynamics max_domains .true. rh "pd_scalar" "positive-definite RK3 transport switch" "" +rconfig logical pd_tke namelist,dynamics max_domains .false. rh "pd_tke" "positive-definite RK3 transport switch" "" +rconfig logical top_radiation namelist,dynamics max_domains .false. rh "top_radiation" "" "" +rconfig integer mix_isotropic namelist,dynamics max_domains 0 h "mix_isotropic" "0=anistropic, 1=isotropic" "" +rconfig real mix_upper_bound namelist,dynamics max_domains 0.1 h "mix_upper_bound" "non-dimensional limit" "" +rconfig logical top_lid namelist,dynamics max_domains .false. rh "top_lid" "" "" +rconfig real tke_upper_bound namelist,dynamics max_domains 1000. h "tke_upper_bound" "" "" +rconfig real tke_drag_coefficient namelist,dynamics max_domains 0. h "tke_drag_coefficient" "" "dimensionless" +rconfig real tke_heat_flux namelist,dynamics max_domains 0. h "tke_heat_flux" "" "K m s-1" +rconfig logical pert_coriolis namelist,dynamics max_domains .false. irh "pert_coriolis" "" "" +rconfig logical coriolis2d namelist,dynamics max_domains .false. irh "coriolis2d" "" "" +rconfig logical mix_full_fields namelist,dynamics max_domains .false. irh "mix_full_field" "" "" +rconfig real base_pres namelist,dynamics 1 100000. h "base_pres" "Base state pressure - do not change (10^5 Pa), real only" "Pa" +rconfig real base_temp namelist,dynamics 1 290. h "base_temp" "Base state sea level temperature, real only" "K" +rconfig real base_lapse namelist,dynamics 1 50. h "base_lapse" "Base state temperature difference between base pres and 1/e of atm depth - do not change, real only" "K" +rconfig real fft_filter_lat namelist,dynamics 1 45. h "fft_filter_lat" "" "grid latitude to start polar filter" +rconfig logical rotated_pole namelist,dynamics 1 .false. irh "rotated_pole" "" "" +rconfig logical do_coriolis namelist,dynamics max_domains .true. irh "do_coriolis" "" "" +rconfig logical do_curvature namelist,dynamics max_domains .true. irh "do_curvature" "" "" +rconfig logical do_gradp namelist,dynamics max_domains .true. irh "do_gradp" "" "" + + +# Bdy_control +rconfig integer spec_bdy_width namelist,bdy_control 1 5 irh "spec_bdy_width" "" "" +rconfig integer spec_zone namelist,bdy_control 1 1 irh "spec_zone" "" "" +rconfig integer relax_zone namelist,bdy_control 1 4 irh "relax_zone" "" "" +rconfig logical specified namelist,bdy_control max_domains .false. rh "specified" "" "" +rconfig logical periodic_x namelist,bdy_control max_domains .false. rh "periodic_x" "" "" +rconfig logical symmetric_xs namelist,bdy_control max_domains .false. rh "symmetric_xs" "" "" +rconfig logical symmetric_xe namelist,bdy_control max_domains .false. rh "symmetric_xe" "" "" +rconfig logical open_xs namelist,bdy_control max_domains .false. rh "open_xs" "" "" +rconfig logical open_xe namelist,bdy_control max_domains .false. rh "open_xe" "" "" +rconfig logical periodic_y namelist,bdy_control max_domains .false. rh "periodic_y" "" "" +rconfig logical symmetric_ys namelist,bdy_control max_domains .false. rh "symmetric_ys" "" "" +rconfig logical symmetric_ye namelist,bdy_control max_domains .false. rh "symmetric_ye" "" "" +rconfig logical open_ys namelist,bdy_control max_domains .false. rh "open_ys" "" "" +rconfig logical open_ye namelist,bdy_control max_domains .false. rh "open_ye" "" "" +rconfig logical polar namelist,bdy_control max_domains .false. rh "polar" "" "" +rconfig logical nested namelist,bdy_control max_domains .false. rh "nested" "" "" +rconfig real spec_exp namelist,bdy_control 1 0. irh "spec_exp" "" "" +rconfig integer real_data_init_type namelist,bdy_control 1 1 irh "real_data_init_type" "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES" + +rconfig integer background_proc_id namelist,grib2 1 255 rh "background_proc_id" "Background processing id for grib2" "" +rconfig integer forecast_proc_id namelist,grib2 1 255 rh "forecast_proc_id" "Analysis and forecast processing id for grib2" "" +rconfig integer production_status namelist,grib2 1 255 rh "production_status" "Background processing id for grib2" "" +rconfig integer compression namelist,grib2 1 40 rh "compression" "grib2 compression, 40 for JPEG2000 or 41 for PNG" "" + +# NAMELIST DERIVED +rconfig integer nobs_ndg_vars derived 1 5 - "num_ndg_vars" "Number of nudging variables" "" +rconfig integer nobs_err_flds derived 1 9 - "num_err_flds" "Number of error fields" "" +rconfig real cen_lat derived max_domains 0 - "cen_lat" "center latitude" "degrees, negative is south" +rconfig real cen_lon derived max_domains 0 - "cen_lon" "central longitude" "degrees, negative is west" +rconfig real truelat1 derived max_domains 0 - "true_lat1" "first standard parallel" "degrees, negative is south" +rconfig real truelat2 derived max_domains 0 - "true_lat2" "second standard parallel" "degrees, negative is south" +rconfig real moad_cen_lat derived max_domains 0 - "moad_cen_lat" "center latitude of the most coarse grid" "degrees, negative is south" +rconfig real stand_lon derived max_domains 0 - "stand_lon" "standard longitude, parallel to j-direction, perpendicular to i-direction " "degrees, negative is west" +rconfig real bdyfrq derived max_domains 0 - "bdyfrq" "lateral boundary input frequency" "seconds" +rconfig integer iswater derived max_domains 0 - "iswater" "land use index of water" "index category" +rconfig integer isice derived max_domains 0 - "isice" "land use index of ice" "index category" +rconfig integer isurban derived max_domains 0 - "isurban" "land use index for 'urban and built-up" "index category" +rconfig integer isoilwater derived max_domains 0 - "isoilwater" "land use index of water for soil" "index category" +rconfig integer map_proj derived max_domains 0 - "map_proj" "domain map projection" "0=none (Cylindrical), 1=Lambert, 2=polar, 3=Mercator" +rconfig integer use_wps_input derived 1 0 - "use_wps_input" "0/1 flag, using wps input" "0=no, 1=yes" +rconfig integer dfi_stage derived 1 3 - "dfi_stage" "current stage of DFI processing" "0=DFI setup, 1=DFI backward integration, 2=DFI forward integration, 3=WRF forecast" +rconfig integer mp_physics_dfi derived max_domains -1 - "mp_physics_dfi" "" "-1 = no DFI and so no need to allocate DFI moist and scalar variables, >0 = running with DFI, so allocate DFI moist and scalar variables appropriate for selected microphysics package" + +# +# Single dummy declaration to define a nodyn dyn option +state integer nodyn_dummy - dyn_nodyn - - - "" "" "" + +# +#--------------------------------------------------------------------------------------------------------------------------------------- +# Package Declarations +# + +#key package associated package associated 4d scalars +# name namelist choice state vars + + +##### MARS OPTIONS +##### MARS OPTIONS +##### MARS OPTIONS +## +## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF +## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION +## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION +## ------- +## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE +## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS +## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...) +## ------- +## +## +package default mars==0 - - +package water mars==1 - scalar:qh2o,qh2o_ice +package dust1 mars==2 - scalar:qdust +package dust2eq mars==3 - scalar:qdust,qdustn +package newbasis mars==10 - scalar:qco2 +package newwater mars==11 - scalar:qh2o,qh2o_ice,qdust,qdustn +package newwatersca mars==12 - scalar:qh2o,qh2o_ice,qdust,qdustn,qccn,qccnn +package radioac mars==20 - scalar:qtrac1 +package VenusPC mars==34 - scalar:qco2,qco,qh2,qh2o,qo1d,qo,qo2,qo2dg,qo3,qh,qoh,qho2,qh2o2,qcl,qclo,qcl2,qhcl,qhocl,qclco,qclco3,qcocl2,qss,qso,qso2,qso3,qs2o2,qocs,qhso3,qh2so4,qs2,qclso2,qoscl,qh2oliq,qh2so4liq +package waterdyn mars==42 - scalar:qh2o,qh2o_ice;moist:qv,qc +##### MARS OPTIONS +##### MARS OPTIONS +##### MARS OPTIONS + + + + +#package passivec1 chem_opt==0 - +package passiveqv mp_physics==0 - moist:qv +package kesslerscheme mp_physics==1 - moist:qv,qc,qr +package linscheme mp_physics==2 - moist:qv,qc,qr,qi,qs,qg +package wsm3scheme mp_physics==3 - moist:qv,qc,qr +package wsm5scheme mp_physics==4 - moist:qv,qc,qr,qi,qs +package etampnew mp_physics==5 - moist:qv,qc,qr,qi,qs,qg;scalar:qt +package wsm6scheme mp_physics==6 - moist:qv,qc,qr,qi,qs,qg +package gsfcgcescheme mp_physics==7 - moist:qv,qc,qr,qi,qs,qg +package thompson mp_physics==8 - moist:qv,qc,qr,qi,qs,qg;scalar:qni +package morr_two_moment mp_physics==10 - moist:qv,qc,qr,qi,qs,qg;scalar:qni,qns,qnr,qng + +package nodfimoist mp_physics_dfi==-1 - - +package passiveqv_dfi mp_physics_dfi==0 - dfi_moist:dfi_qv +package kesslerscheme_dfi mp_physics_dfi==1 - dfi_moist:dfi_qv,dfi_qc,dfi_qr +package linscheme_dfi mp_physics_dfi==2 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg +package wsm3scheme_dfi mp_physics_dfi==3 - dfi_moist:dfi_qv,dfi_qc,dfi_qr +package wsm5scheme_dfi mp_physics_dfi==4 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs +package etampnew_dfi mp_physics_dfi==5 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qt +package wsm6scheme_dfi mp_physics_dfi==6 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg +package gsfcgcescheme_dfi mp_physics_dfi==7 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg +package thompson_dfi mp_physics_dfi==8 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qni +package morr_two_moment_dfi mp_physics_dfi==10 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qni,dfi_qns,dfi_qnr,dfi_qng + +package noprogn progn==0 - - +package progndrop progn==1 - scalar:qndrop;dfi_scalar:dfi_qndrop + +package rrtmscheme ra_lw_physics==1 - - +package camlwscheme ra_lw_physics==3 - ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc +package gfdllwscheme ra_lw_physics==99 - - +package heldsuarez ra_lw_physics==31 - - + +package swradscheme ra_sw_physics==1 - - +package gsfcswscheme ra_sw_physics==2 - - +package camswscheme ra_sw_physics==3 - ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc +package gfdlswscheme ra_sw_physics==99 - - + +package sfclayscheme sf_sfclay_physics==1 - state:regime +package myjsfcscheme sf_sfclay_physics==2 - - +package gfssfcscheme sf_sfclay_physics==3 - - +package pxsfcscheme sf_sfclay_physics==7 - state:regime + +package slabscheme sf_surface_physics==1 - - +package lsmscheme sf_surface_physics==2 - - +package ruclsmscheme sf_surface_physics==3 - - +package pxlsmscheme sf_surface_physics==7 - fdda2d:t2_ndg_new,q2_ndg_new,t2_ndg_old,q2_ndg_old + +package ysuscheme bl_pbl_physics==1 - state:regime +package myjpblscheme bl_pbl_physics==2 - - +package gfsscheme bl_pbl_physics==3 - - +package acmpblscheme bl_pbl_physics==7 - state:regime +package mrfscheme bl_pbl_physics==99 - state:regime + +package kfetascheme cu_physics==1 - - +package bmjscheme cu_physics==2 - - +package gdscheme cu_physics==3 - - +package sasscheme cu_physics==4 - - +package g3scheme cu_physics==5 - state:cugd_qvten,cugd_tten,cugd_qvtens,cugd_ttens,cugd_qcten +package kfscheme cu_physics==99 - - + +package psufddagd grid_fdda==1 - fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new,t2_ndg_new,q2_ndg_new,t2_ndg_old,q2_ndg_old,sn_ndg_new,sn_ndg_old;state:rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten + +package restofwrf use_wps_input==0 - - + +package dfi_setup dfi_stage==0 - - +package dfi_bck dfi_stage==1 - - +package dfi_fwd dfi_stage==2 - - +package dfi_fst dfi_stage==3 - - + +#package digifilter dfi_opt==1 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qndrop,dfi_qni,dfi_qt,dfi_qns,dfi_qnr,dfi_qng;state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt +package dfi_nodfi dfi_opt==0 - - +package dfi_dfl dfi_opt==1 - state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG +package dfi_ddfi dfi_opt==2 - state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG +package dfi_tdfi dfi_opt==3 - state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG +ifdef RUC_CLOUD +package realonly use_wps_input==1 - state:u_gc,v_gc,t_gc,rh_gc,ght_gc,p_gc,xlat_gc,xlong_gc,ht_gc,tsk_gc,tavgsfc,tmn_gc,pslv_gc,greenfrac,albedo12m,pd_gc,psfc_gc,intq_gc,pdhs,qv_gc,qr_gc,qc_gc,qs_gc,qi_gc,qg_gc,qni_gc +endif +ifndef RUC_CLOUD +package realonly use_wps_input==1 - state:u_gc,v_gc,t_gc,rh_gc,ght_gc,p_gc,xlat_gc,xlong_gc,ht_gc,tsk_gc,tavgsfc,tmn_gc,pslv_gc,greenfrac,albedo12m,pd_gc,psfc_gc,intq_gc,pdhs,qv_gc +endif + + +# only need to specify these once; not for every io_form* variable +package io_intio io_form_restart==1 - - +package io_netcdf io_form_restart==2 - - +# Placeholders for additional packages (we can go beyond zzz +# but that will entail modifying frame/module_io.F and frame/md_calls.m4) +# Please note these are placeholders; HDF has not been implemented yet. +package io_hdf io_form_restart==3 - - +package io_phdf5 io_form_restart==4 - - +package io_grib1 io_form_restart==5 - - +package io_mcel io_form_restart==6 - - +package io_esmf io_form_restart==7 - - +package io_yyy io_form_restart==8 - - +package io_zzz io_form_restart==9 - - +package io_grib2 io_form_restart==10 - - +package io_pnetcdf io_form_restart==11 - - + +#--------------------------------------------------------------------------------------------------------------------------------------- +## communications + +### 8. Edit the Registry file and create a halo-exchange for x_1. + +# Halo Update Communications + +halo HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2 +halo HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb +halo HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb +halo HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msftx,msfty,msfux,msfuy,msfvx,msfvy,msfvx_inv,f,e,sina,cosa,ht,potevp,snopcx,soiltb,xlat,xlong,xlat_u,xlat_v,xlong_u,xlong_v,clat,clong +halo HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar +halo HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb +halo HALO_EM_A dyn_em 8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut +halo HALO_EM_PHYS_A dyn_em 4:u_2,v_2 +halo HALO_EM_PHYS_PBL dyn_em 4:rublten,rvblten +halo HALO_EM_FDDA dyn_em 4:rundgdten,rvndgdten +halo HALO_EM_PHYS_DIFFUSION dyn_em 4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkhv,xkhh,tke_1,tke_2 +halo HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2 +halo HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2 +halo HALO_EM_TKE_A dyn_em 4:ph_2,phb +halo HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy +halo HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw,ustm +halo HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div +halo HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkhv,xkhh,BN2,moist +halo HALO_EM_TKE_3 dyn_em 24:tke_1,tke_2 +halo HALO_EM_TKE_5 dyn_em 48:tke_1,tke_2 +halo HALO_EM_TKE_7 dyn_em 80:tke_1,tke_2 +halo HALO_EM_TKE_F dyn_em 48:tke_1,tke_2 +halo HALO_EM_TKE_OLD_E_5 dyn_em 48:tke_1 +halo HALO_EM_TKE_OLD_E_7 dyn_em 80:tke_1 +halo HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb +halo HALO_EM_B2 dyn_em 4:ru_tend,rv_tend +halo HALO_EM_C dyn_em 4:u_2,v_2 +halo HALO_EM_C2 dyn_em 4:ph_2,al,p,mu_2,muts,mudf +halo HALO_EM_D dyn_em 24:ru_m,rv_m,ww_m,mut +halo HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al +halo HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al +halo HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2 +halo HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2 +halo HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2 +halo HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2 +halo HALO_EM_MOIST_E_3 dyn_em 24:moist +halo HALO_EM_MOIST_E_5 dyn_em 48:moist +halo HALO_EM_MOIST_E_7 dyn_em 80:moist +halo HALO_CUP_G3_IN dyn_em 24:RTHFTEN,RQVFTEN,w_2 +halo HALO_CUP_G3_OUT dyn_em 48:cugd_tten,cugd_qvten,cugd_ttens,cugd_qvtens,raincv +halo HALO_EM_CHEM_E_3 dyn_em 24:chem +halo HALO_EM_CHEM_E_5 dyn_em 48:chem +halo HALO_EM_CHEM_E_7 dyn_em 80:chem +halo HALO_EM_SCALAR_E_3 dyn_em 24:scalar +halo HALO_EM_SCALAR_E_5 dyn_em 48:scalar +halo HALO_EM_SCALAR_E_7 dyn_em 80:scalar +halo HALO_TOPOSHAD phys 24:ht_shad + +halo HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old +halo HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old +halo HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old +halo HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old +halo HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old +halo HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old +halo HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old +halo HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old +halo HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old + +halo HALO_EM_FEEDBACK dyn_em 48:ht +halo HALO_EM_HYDRO_UV dyn_em 8:u_2,v_2 + +halo HALO_EM_COUPLE_A dyn_em 24:mub,mu_1,mu_2 +period PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2 +halo HALO_EM_COUPLE_B dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\ + moist,chem,scalar +period PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\ + moist,chem,scalar + +# For moving nests +halo em_shift_halo_y dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2 +halo em_shift_halo_x dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2 + +# For observational nudging +halo HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx + +# Periodic Boundary Communications + +period PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msftx,msfty,msfux,msfuy,msfvx,msfvy,msfvx_inv,sina,cosa,e,f +period PERIOD_BDY_EM_MOIST dyn_em 3:moist +period PERIOD_BDY_EM_CHEM dyn_em 3:chem +period PERIOD_BDY_EM_SCALAR dyn_em 3:scalar +period PERIOD_BDY_EM_MOIST2 dyn_em 3:moist +period PERIOD_BDY_EM_CHEM2 dyn_em 3:chem +period PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar +period PERIOD_BDY_EM_MOIST_OLD dyn_em 3:moist_old +period PERIOD_BDY_EM_CHEM_OLD dyn_em 3:chem_old +period PERIOD_BDY_EM_SCALAR_OLD dyn_em 3:scalar_old +period PERIOD_BDY_EM_TKE_OLD dyn_em 3:tke_1 +period PERIOD_EM_HYDRO_UV dyn_em 1:u_2,v_2 +period PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al +period PERIOD_BDY_EM_A1 dyn_em 3:rdzw,rdz,z,zx,zy,ustm +period PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2 +period PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten +period PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb +period PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf +period PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend +period PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfvx,msfvy,muu,msfux,msfuy,msfvx_inv +period PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2 +period PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2 + +# +#swap SWAP_ETAMP_NEW dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR +#swap SWAP_WSM3 dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv +#cycle CYCLE_TEST dyn_em 1:xlong + +## + +# FDDA (Observational-nudging) Variables +typedef fdob_type integer domain_tot # total number of domains to apply obs-nudging +typedef fdob_type integer IEODI # end of obs data flag for current model step +typedef fdob_type integer IWTSIG # flag for nudging on pressure surfaces +typedef fdob_type integer NSTAT # number of obs stations used to nudge current model step +typedef fdob_type integer NSTAW # number of obs stations within current time window +typedef fdob_type integer KTAUR # restart model step +typedef fdob_type integer SN_MAXCG # coarse domain grid dimension in south-north coordinate +typedef fdob_type integer WE_MAXCG # coarse domain grid dimension in west-east coordinate +typedef fdob_type integer SN_END # ending north-south grid index +typedef fdob_type integer LEVIDN(max_domains) # level of nest +typedef fdob_type real WINDOW # time window half-period for nudging (in minutes) +typedef fdob_type real RTLAST # time in hours of last obs used in current model step +typedef fdob_type real DATEND # time in minutes after which data are asuumed to have ended +typedef fdob_type real RINFMN # minimum radius of influence +typedef fdob_type real RINFMX # maximum radius of influence +typedef fdob_type real PFREE # pressure level (cb) where terrain effect becomes small +typedef fdob_type real DCON # 1/DPSMX +typedef fdob_type real DPSMX # max pres change (cb) allowed within infl range of surf obs +typedef fdob_type real TFACI # scale factor used for ramp-down in dynamic initialization +typedef fdob_type real KNOWN_LAT # Latitude of origin point (i,j)=(1,1) +typedef fdob_type real KNOWN_LON # Longitude of origin point (i,j)=(1,1) + +# table entries are of the form +#
+#Grid variables +typedef fdob_type real varobs rz - 1 - - "varobs" "observational values in each variable" +typedef fdob_type real errf hz - 1 - - "errf" "errors between model and obs values" +typedef fdob_type real timeob z - 1 - - "timeob" "model times for each observation" "hours" +typedef fdob_type real nlevs_ob z - 1 - - "nlevs_ob" "numbers of levels in sounding obs" +typedef fdob_type real lev_in_ob z - 1 - - "lev_in_ob" "level in sounding-type obs" +typedef fdob_type real plfo z - 1 - - "plfo" "index for type of obs-platform" +typedef fdob_type real elevob z - 1 - - "elevob" "elevation of observation" "meters" +typedef fdob_type real rio z - 1 - - "rio" "west-east grid coordinate" +typedef fdob_type real rjo z - 1 - - "rjo" "south-north grid coordinate" +typedef fdob_type real rko z - 1 - - "rko" "vertical grid coordinate" + +state fdob_type fdob - - + +# xpose variables for polar fft +state real t_xxx ikjx - 1 - +state real u_xxx ikjx - 1 X +state real ru_xxx ikjx - 1 X +state real v_xxx ikjx - 1 Y +state real rv_xxx ikjx - 1 Y +state real w_xxx ikjx - 1 Z +state real ww_xxx ikjx - 1 Z +state real ph_xxx ikjx - 1 Z +state real dum_yyy ikjy - 1 - +state real fourd_xxx ikjx - 1 - +state real clat_xxx ijx - 1 - +state real ht_xxx ijx - 1 - +state real mf_xxx ijx - 1 - + +xpose XPOSE_POLAR_FILTER_TOPO dyn_em t_init,t_xxx,dum_yyy +xpose XPOSE_POLAR_FILTER_T dyn_em t_2,t_xxx,dum_yyy +xpose XPOSE_POLAR_FILTER_U dyn_em u_2,u_xxx,dum_yyy +xpose XPOSE_POLAR_FILTER_RU dyn_em ru_m,ru_xxx,dum_yyy +xpose XPOSE_POLAR_FILTER_V dyn_em v_2,v_xxx,dum_yyy +xpose XPOSE_POLAR_FILTER_RV dyn_em rv_m,rv_xxx,dum_yyy +xpose XPOSE_POLAR_FILTER_W dyn_em w_2,w_xxx,dum_yyy +xpose XPOSE_POLAR_FILTER_WW dyn_em ww_m,ww_xxx,dum_yyy +xpose XPOSE_POLAR_FILTER_PH dyn_em ph_2,ph_xxx,dum_yyy +xpose XPOSE_POLAR_FILTER_MOIST dyn_em moist,fourd_xxx,dum_yyy +xpose XPOSE_POLAR_FILTER_CHEM dyn_em chem,fourd_xxx,dum_yyy +xpose XPOSE_POLAR_FILTER_SCALAR dyn_em scalar,fourd_xxx,dum_yyy + +## Index: /trunk/WRF.COMMON/WRFV3/Registry/Registry.bash =================================================================== --- /trunk/WRF.COMMON/WRFV3/Registry/Registry.bash (revision 2761) +++ /trunk/WRF.COMMON/WRFV3/Registry/Registry.bash (revision 2761) @@ -0,0 +1,1 @@ +link ../../WRFV2/Registry/Registry.bash Index: /trunk/WRF.COMMON/WRFV3/arch/configure_new.defaults =================================================================== --- /trunk/WRF.COMMON/WRFV3/arch/configure_new.defaults (revision 2761) +++ /trunk/WRF.COMMON/WRFV3/arch/configure_new.defaults (revision 2761) @@ -0,0 +1,862 @@ + +########################################################### +#ARCH Linux i486 i586 i686, gfortran compiler with gcc #serial smpar dmpar dm+sm +# +DMPARALLEL = # 1 +OMPCPP = # -D_OPENMP +OMP = # -fopenmp +SFC = gfortran +SCC = gcc +DM_FC = mpif90 -f90=$(SFC) +DM_CC = mpicc -cc=$(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = # -fdefault-real-8 # uncomment manually +ARCH_LOCAL = -DNONSTANDARD_SYSTEM_SUBR +CFLAGS_LOCAL = -w -O3 -c -DLANDREAD_STUB +LDFLAGS_LOCAL = +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O3 -ftree-vectorize -ftree-loop-linear -funroll-loops +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) +FORMAT_FIXED = -ffixed-form +FORMAT_FREE = -ffree-form -ffree-line-length-none +FCSUFFIX = +BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 +FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +MODULE_SRCH_FLAG = +TRADFLAG = -traditional +CPP = /lib/cpp -C -P +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH Linux i486 i586 i686, g95 compiler with gcc #serial dmpar +# +DMPARALLEL = # 1 +OMPCPP = # not supported +OMP = # not supported +SFC = g95 +SCC = gcc +DM_FC = mpif90 -f90=$(SFC) +DM_CC = mpicc -cc=$(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -r$(RWORDSIZE) -i4 +ARCH_LOCAL = -DF2CSTYLE -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR +CFLAGS_LOCAL = -DF2CSTYLE +LDFLAGS_LOCAL = +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O2 #-fast +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) +FORMAT_FIXED = -ffixed-form +FORMAT_FREE = -ffree-form -ffree-line-length-huge +FCSUFFIX = +BYTESWAPIO = -fendian=big +FCBASEOPTS = -Wno=101,139,155,158 $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +MODULE_SRCH_FLAG = -fmod=$(WRF_SRC_ROOT_DIR)/main +TRADFLAG = -traditional +CPP = /lib/cpp -C -P +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH Linux x86_64, PGI compiler with gcc # serial smpar dmpar dm+sm +# +DMPARALLEL = # 1 +OMPCPP = # -D_OPENMP +OMP = # -mp -Minfo=mp +SFC = pgf90 +SCC = gcc +DM_FC = mpif90 -f90=$(SFC) +DM_CC = mpicc -cc=$(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -r$(RWORDSIZE) -i4 +ARCH_LOCAL = -DNONSTANDARD_SYSTEM_SUBR +CFLAGS_LOCAL = -w -O3 +LDFLAGS_LOCAL = +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -fastsse -Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed # -Minfo=all =Mneginfo=all +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) +FORMAT_FIXED = -Mfixed +FORMAT_FREE = -Mfree +FCSUFFIX = +BYTESWAPIO = -byteswapio +FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main +TRADFLAG = -traditional +CPP = /lib/cpp -C -P +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH Linux i486 i586 i686, PGI compiler with gcc #serial smpar dmpar dm+sm +# +DMPARALLEL = # 1 +OMPCPP = # -D_OPENMP +OMP = # -mp +SFC = pgf90 +SCC = gcc +DM_FC = mpif90 -f90=$(SFC) +DM_CC = mpicc -cc=$(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -r$(RWORDSIZE) -i4 +ARCH_LOCAL = -DNONSTANDARD_SYSTEM_SUBR +CFLAGS_LOCAL = +LDFLAGS_LOCAL = +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O2 -fast +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) +FORMAT_FIXED = -Mfixed +FORMAT_FREE = -Mfree +FCSUFFIX = +BYTESWAPIO = -byteswapio +FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main +TRADFLAG = -traditional +CPP = /lib/cpp -C -P +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH Linux x86_64 i486 i586 i686, ifort compiler with icc #serial smpar dmpar dm+sm +# +# By default, some files are compiled without optimizations to speed up compilation. Removing +# respective makefile rules in the end of this file will result in longer compilation time, and, possibly +# Out Of Memory messages, but might produce binaries which are substantially faster. +# +# Please visit http://www.intel.com/support/performancetools/sb/cs-028607.htm +# for latest info on how to build WRF with Intel compilers. +# +# If you got Out Of Memory message, there are several options: +# 1. Check your memory limits (ulimit -a), possibly increasing swap partitions size. +# 2. Remove any debugging flags (-g, -check, -traceback). +# 3. Force the problematic file to be compiled with less optimizations (see examples at the +# end of this file), try -no-ip compiler flag. +# +# This configuration is aimed at accuracy. To improve performance (at the expence of accuracy) you might +# consider removing '-fp-model precise' flag from FCBASEOPTS. This enables non value-safe optimizations. +# Another option is to add '-ftz' flag, which flushes denormal results to zero when the application is in +# the gradual underflow mode. It may improve performance if the denormal values are not critical to the +# behavior of your workload. To further improve performance, add suitable vectorization options for your +# processor to FCOPTIM (see ifort manpage). +# +# If you have Intel MPI installed and wish to use instead, make the +# following changes to settings below: +# DM_FC = mpiifort +# DM_CC = mpiicc +# and source bin64/mpivars.sh file from your Intel MPI installation +# before the build. + +DMPARALLEL = # 1 +OMPCPP = # -D_OPENMP +OMP = # -openmp -fpp -auto +SFC = ifort +SCC = icc +DM_FC = mpif90 -f90=$(SFC) +DM_CC = mpicc -cc=$(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -i4 +ARCH_LOCAL = -DNONSTANDARD_SYSTEM_FUNC +CFLAGS_LOCAL = -w -O3 -ip +LDFLAGS_LOCAL = -ip +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O3 +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) -traceback +FORMAT_FIXED = -FI +FORMAT_FREE = -FR +FCSUFFIX = +BYTESWAPIO = -convert big_endian +FCBASEOPTS = -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +MODULE_SRCH_FLAG = +TRADFLAG = -traditional +CPP = /lib/cpp -C -P +AR = ar +ARFLAGS = ru +M4 = m4 +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH ia64 Linux ifort compiler with icc 9.x,10.x #serial smpar dmpar dm+sm +# +# By default, some files are compiled without optimizations to +# speed up compilation. Removing respective makefile rules in the +# end of this file will result in longer compilation time, and, +# possibly Out Of Memory messages, but might produce binaries +# which are substantially faster. +# +# Please visit http://www.intel.com/support/performancetools/sb/cs-028607.htm +# for latest info on how to build WRF with Intel compilers. +# +# If you get Out Of Memory messages, there are several options: +# 1. Check your memory limits (ulimit -a), possibly increasing +# swap partitions size. +# 2. Remove any debugging flags (-g, -check, -traceback). +# 3. Force the problematic file to be compiled with lower +# optimization (see examples at the end of this file), +# try the -no-ip compiler flag. +# +# The default configuration is aimed at accuracy. To improve speed +# with only negligible effect on floating point accuracy, +# consider removing "-fp-model precise" from FCBASEOPTS. If +# you are using ifort 9.1.x compiler or earlier, consider +# uncommenting the version of the FCBASEOPTS settings that uses +# the -IPF-fp-relaxed option. +# +# If you can tolerate a longer build, change the setting of +# FCNOOPT to -O1, for slightly faster performance. +# +# If you have Intel MPI installed and wish to use instead, make the +# following changes to settings below: +# DM_FC = mpiifort +# DM_CC = mpiicc +# and source bin/mpivars.sh file from your Intel MPI installation +# before the build. +# + +DMPARALLEL = # 1 +OMPCPP = # -D_OPENMP +OMP = # -openmp -fpp -auto +SFC = ifort +SCC = icc +DM_FC = mpif90 -f90=$(SFC) +DM_CC = mpicc -cc=$(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -i4 +ARCH_LOCAL = -DNONSTANDARD_SYSTEM_FUNC +CFLAGS_LOCAL = -w -O3 -ip +LDFLAGS_LOCAL = -ip +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O3 +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) -traceback +FORMAT_FIXED = -FI +FORMAT_FREE = -FR +FCSUFFIX = +BYTESWAPIO = -convert big_endian +FCBASEOPTS = -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +#FCBASEOPTS = -w -ftz -align all -fno-alias -IPF-fp-relaxed $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +LIB_LOCAL = -L/usr/lib -lmpi +MODULE_SRCH_FLAG = +TRADFLAG = -traditional +CPP = /lib/cpp -C -P +AR = ar +ARFLAGS = ru +M4 = m4 +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH Linux SGI Altix, ifort compiler with icc 9.x,10.x #serial smpar dmpar dm+sm +# +# By default, some files are compiled without optimizations to +# speed up compilation. Removing respective makefile rules in the +# end of this file will result in longer compilation time, and, +# possibly Out Of Memory messages, but might produce binaries +# which are substantially faster. +# +# If you get Out Of Memory messages, there are several options: +# 1. Check your memory limits (ulimit -a), possibly increasing +# swap partitions size. +# 2. Remove any debugging flags (-g, -check, -traceback). +# 3. Force the problematic file to be compiled with lower +# optimization (see examples at the end of this file), +# try the -no-ip compiler flag. +# +# Please visit http://www.intel.com/support/performancetools/sb/cs-028607.htm +# for latest info on how to build WRF with Intel compilers. +# +# The default configuration is aimed at accuracy. To improve speed +# with only negligible effect on floating point accuracy, +# consider removing "-fp-model precise" from FCBASEOPTS. If +# you are using an ifort 9.1.x compiler or earlier, consider +# uncommenting the version of the FCBASEOPTS settings that uses +# the -IPF-fp-relaxed option. To further improve performance, +# add processor-specific options to FCOPTIM (see ifort manpage). +# +# If you can tolerate a longer build, change the setting of +# FCNOOPT to -O1, for slightly faster performance. +# +# If your SGI MPI library is not installed in the default +# locations (/usr/bin, /usr/include, /usr/lib), set MPI_HOME +# to be the path to the directory where the SGI MPI bin, +# include and lib directories are, and change the DM_FC, +# DM_CC and LIB_LOCAL settings as follows: +# DM_FC = $(SFC) -I$(MPI_HOME)/include +# DM_CC = $(SFC) -I$(MPI_HOME)/include +# LIB_LOCAL = -L$(MPI_HOME)/lib -lmpi + +DMPARALLEL = # 1 +OMPCPP = # -D_OPENMP +OMP = # -openmp -fpp -auto +SFC = ifort +SCC = icc +DM_FC = $(SFC) +DM_CC = $(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -i4 +ARCH_LOCAL = -DNONSTANDARD_SYSTEM_FUNC +CFLAGS_LOCAL = -w -O3 -ip +LDFLAGS_LOCAL = -ip +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O3 +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) -traceback +FORMAT_FIXED = -FI +FORMAT_FREE = -FR +FCSUFFIX = +BYTESWAPIO = -convert big_endian +FCBASEOPTS = -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +#FCBASEOPTS = -w -ftz -align all -fno-alias -IPF-fp-relaxed $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +LIB_LOCAL = -L/usr/lib -lmpi +MODULE_SRCH_FLAG = +TRADFLAG = -traditional +CPP = /lib/cpp -C -P +AR = ar +ARFLAGS = ru +M4 = m4 +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH Linux i486 i586 i686 x86_64, PathScale compiler with pathcc #serial dmpar +# +DMPARALLEL = # 1 +OMPCPP = # not supported +OMP = # not supported +SFC = pathf90 +SCC = pathcc +DM_FC = mpif90 -f90=$(SFC) +DM_CC = mpicc -cc=$(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -r$(RWORDSIZE) -i4 +ARCH_LOCAL = -DF2CSTYLE -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR +CFLAGS_LOCAL = -DF2CSTYLE +LDFLAGS_LOCAL = +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O3 -OPT:Ofast:Olimit=5000 +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) +FORMAT_FIXED = -fixed-form +FORMAT_FREE = -free-form +FCSUFFIX = +BYTESWAPIO = -byteswapio +FCBASEOPTS = -w -fno-second-underscore $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +MODULE_SRCH_FLAG = -fmod=$(WRF_SRC_ROOT_DIR)/main +TRADFLAG = -traditional +CPP = /lib/cpp -C -P +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH x86_64 Linux, gfortran compiler with gcc #serial smpar dmpar dm+sm +# +DMPARALLEL = # 1 +OMPCPP = # -D_OPENMP +OMP = # -fopenmp +SFC = gfortran +SCC = gcc +DM_FC = mpif90 +DM_CC = mpicc +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = # -fdefault-real-8 # uncomment manually +ARCH_LOCAL = -DNONSTANDARD_SYSTEM_SUBR +CFLAGS_LOCAL = -w -O3 -c -DLANDREAD_STUB +LDFLAGS_LOCAL = +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O3 -ftree-vectorize -ftree-loop-linear -funroll-loops +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) +FORMAT_FIXED = -ffixed-form +FORMAT_FREE = -ffree-form -ffree-line-length-none +FCSUFFIX = +BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 +FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +MODULE_SRCH_FLAG = +TRADFLAG = -traditional +CPP = /lib/cpp -C -P +AR = ar +ARFLAGS = ru +M4 = m4 -G +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH Darwin (MACOS) PGI compiler with pgcc #serial smpar dmpar dm+sm +# +DMPARALLEL = # 1 +OMPCPP = # -D_OPENMP +OMP = # -mp +SFC = pgf90 +SCC = pgcc +DM_FC = mpif90 -f90=$(SFC) +DM_CC = mpicc -cc=$(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -r$(RWORDSIZE) -i4 +ARCH_LOCAL = -DMACOS -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR +CFLAGS_LOCAL = -DMACOS +LDFLAGS_LOCAL = +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O2 -fast +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) +FORMAT_FIXED = -Mfixed +FORMAT_FREE = -Mfree +FCSUFFIX = +BYTESWAPIO = -byteswapio +FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main +TRADFLAG = -traditional +CPP = cpp -C -P -xassembler-with-cpp +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = cc + +########################################################### +#ARCH Darwin (MACOS) intel compiler with icc #serial smpar dmpar dm+sm +# +DMPARALLEL = # 1 +OMPCPP = # -D_OPENMP +OMP = # -openmp -fpp -auto +SFC = ifort +SCC = icc +DM_FC = mpif90 -f90=$(SFC) +DM_CC = mpicc -cc=$(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -i4 +ARCH_LOCAL = -DMACOS -DNONSTANDARD_SYSTEM_FUNC +CFLAGS_LOCAL = -w -O3 -ip -DMACOS +LDFLAGS_LOCAL = -ip +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O3 +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) -traceback +FORMAT_FIXED = -FI +FORMAT_FREE = -FR +FCSUFFIX = +BYTESWAPIO = -convert big_endian +FCBASEOPTS = -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +MODULE_SRCH_FLAG = +TRADFLAG = -traditional +CPP = cpp -C -P -xassembler-with-cpp +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = cc + +########################################################### +#ARCH Darwin (MACOS) intel compiler with cc #serial smpar dmpar dm+sm +# +DMPARALLEL = # 1 +OMPCPP = # -D_OPENMP +OMP = # -openmp -fpp -auto +SFC = ifort +SCC = cc +DM_FC = mpif90 -f90=$(SFC) +DM_CC = mpicc -cc=$(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -i4 +ARCH_LOCAL = -DMACOS -DNONSTANDARD_SYSTEM_FUNC +CFLAGS_LOCAL = -w -O3 -DMACOS +LDFLAGS_LOCAL = +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O3 +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) -traceback +FORMAT_FIXED = -FI +FORMAT_FREE = -FR +FCSUFFIX = +BYTESWAPIO = -convert big_endian +FCBASEOPTS = -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +MODULE_SRCH_FLAG = +TRADFLAG = -traditional +CPP = cpp -C -P -xassembler-with-cpp +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = cc + +########################################################### +#ARCH Darwin (MACOS) g95 with gcc #serial dmpar +# +DMPARALLEL = # 1 +OMPCPP = # not supported +OMP = # not supported +SFC = g95 +SCC = gcc +DM_FC = mpif90 -f90=$(SFC) +DM_CC = mpicc -cc=$(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -r$(RWORDSIZE) -i4 +ARCH_LOCAL = -DG95 -DMACOS -DF2CSTYLE -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR +CFLAGS_LOCAL = -DMACOS -DF2CSTYLE +LDFLAGS_LOCAL = +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O2 # -fast +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) +FORMAT_FIXED = -ffixed-form +FORMAT_FREE = -ffree-form -ffree-line-length-huge +FCSUFFIX = +BYTESWAPIO = -fendian=big +FCBASEOPTS = -Wno=101,139,155,158 $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +MODULE_SRCH_FLAG = -fmod=$(WRF_SRC_ROOT_DIR)/main +TRADFLAG = -traditional +CPP = cpp -C -P -xassembler-with-cpp +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH Darwin (MACOS) xlf #serial dmpar +# +DMPARALLEL = # 1 +OMPCPP = # not supported +OMP = # not supported +SFC = xlf90_r +SCC = cc +DM_FC = mpif90 -f90=$(SFC) +DM_CC = mpicc -cc=$(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -qrealsize=$(RWORDSIZE) -qintsize=4 +ARCH_LOCAL = -DMAC_KLUDGE -DF2CSTYLE -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR +CFLAGS_LOCAL = -DMACOS -DF2CSTYLE +LDFLAGS_LOCAL = +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O3 -qarch=auto +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -qnoopt +FCDEBUG = # -g $(FCNOOPT) -qfullpath +FORMAT_FIXED = -qfixed +FORMAT_FREE = -qfree=f90 +FCSUFFIX = -qsuffix=f=f90 +BYTESWAPIO = +FCBASEOPTS = -qsave $(FCDEBUG) -qmaxmem=32767 -qspillsize=32767 -w +MODULE_SRCH_FLAG = -fmod=$(WRF_SRC_ROOT_DIR)/main +TRADFLAG = +CPP = cpp -C -P +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH AIX xlf compiler with xlc #serial smpar dmpar dm+sm +# +DMPARALLEL = # 1 +OMPCPP = # -D_OPENMP +OMP = # -qsmp=noauto +SFC = xlf90_r +SCC = cc_r +DM_FC = mpxlf90_r +DM_CC = mpcc_r +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -qrealsize=$(RWORDSIZE) -qintsize=4 +ARCH_LOCAL = -DNONSTANDARD_SYSTEM_SUBR +CFLAGS_LOCAL = -DNOUNDERSCORE +LDFLAGS_LOCAL = +CPLUSPLUSLIB = -lC +ESMF_LDFLAG = $(CPLUSPLUSLIB) +# -qhot commented out in 3.0.1.1 release because of reported problems with +# model results under certain configurations. Use at your own risk. +FCOPTIM = -O3 # -qhot +FCREDUCEDOPT = -O2 +FCNOOPT = -qnoopt +FCDEBUG = # -g $(FCNOOPT) -qfullpath +FORMAT_FIXED = -qfixed +FORMAT_FREE = -qfree=f90 +FCSUFFIX = -qsuffix=f=f90 +BYTESWAPIO = +FCBASEOPTS = -w -qspill=20000 -qmaxmem=32767 $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) #-qflttrap=zerodivide:invalid:enable -qsigtrap +MODULE_SRCH_FLAG = +TRADFLAG = +CPP = /lib/cpp -C -P +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = cc + +########################################################### +#ARCH Cray XT Catamount/Linux x86_64, PGI compiler with gcc # serial dmpar +# +DMPARALLEL = # 1 +OMPCPP = # not supported +OMP = # not supported +SFC = ftn +SCC = gcc +DM_FC = ftn +DM_CC = gcc -I$(MPICH_DIR)/include +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -r$(RWORDSIZE) -i4 +ARCH_LOCAL = -DLANDREAD_STUB -DXT3_Catamount +CFLAGS_LOCAL = -w -O3 -DLANDREAD_STUB -DXT3_Catamount +LDFLAGS_LOCAL = +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +# Use this to add XT iobuf library after loading iobuf module, also requires +# properly built netCDF library that includes iobuf (Catamount OS only) +#LDFLAGS_LOCAL = $(IOBUF_POST_LINK_OPTS) +# PGI recommended +#FCOPTIM = -fastsse -Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed +FCOPTIM = -O3 -fastsse +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +FCDEBUG = # -g $(FCNOOPT) +FORMAT_FIXED = -Mfixed +FORMAT_FREE = -Mfree +FCSUFFIX = +BYTESWAPIO = -byteswapio +FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) +MODULE_SRCH_FLAG = +TRADFLAG = -traditional +CPP = /lib/cpp -C -P $(TRADFLAG) +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH Cray XT CNL/Linux x86_64, PGI compiler with gcc # serial dmpar smpar dm+sm +# +# Recommended CNL/Linux memory allocation settings at run time: +# export MALLOC_MMAP_MAX_=0 +# export MALLOC_TRIM_THRESHOLD_=536870912 +# +DMPARALLEL = # 1 +OMPCPP = # -D_OPENMP +OMP = # -mp=nonuma +SFC = ftn +SCC = gcc +DM_FC = ftn +DM_CC = gcc -I$(MPICH_DIR)/include +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -r$(RWORDSIZE) -i4 +ARCH_LOCAL = -DLANDREAD_STUB +CFLAGS_LOCAL = -w -O3 -DLANDREAD_STUB +LDFLAGS_LOCAL = +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +# PGI recommended +#FCOPTIM = -O3 -fastsse -Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed +FCOPTIM = -O3 -fastsse +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O0 +OPTERON_TYPE = +# Use this for AMD Opteron quad-core +#OPTERON_TYPE = -tp barcelona-64 +FCDEBUG = # -g $(FCNOOPT) +FORMAT_FIXED = -Mfixed +FORMAT_FREE = -Mfree +FCSUFFIX = +BYTESWAPIO = -byteswapio +FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) $(OPTERON_TYPE) +MODULE_SRCH_FLAG = +TRADFLAG = -traditional +CPP = /lib/cpp -C -P $(TRADFLAG) +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH Cray XT CNL/Linux x86_64, Pathscale compiler with gcc # serial dmpar smpar dm+sm +# +# Recommended CNL/Linux memory allocation settings at run time: +# export MALLOC_MMAP_MAX_=0 +# export MALLOC_TRIM_THRESHOLD_=536870912 +# +DMPARALLEL = # 1 +OMPCPP = # -D_OPENMP +OMP = # -mp +SFC = ftn +SCC = gcc +DM_FC = ftn +DM_CC = gcc -I$(MPICH_DIR)/include +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -r$(RWORDSIZE) -i4 +ARCH_LOCAL = -DLANDREAD_STUB +CFLAGS_LOCAL = -w -O3 -DLANDREAD_STUB +LDFLAGS_LOCAL = +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O3 -OPT:Ofast +FCREDUCEDOPT = $(FCOPTIM) +FCNOOPT = -O1 +OPTERON_TYPE = +# Use this for AMD Opteron quad-core +#OPTERON_TYPE = -march=barcelona -mcpu=barcelona -mtune=barcelona -msse4a +FCDEBUG = # -g $(FCNOOPT) +FORMAT_FIXED = -fixedform +FORMAT_FREE = -freeform +FCSUFFIX = +BYTESWAPIO = -byteswapio +FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) $(OPTERON_TYPE) +MODULE_SRCH_FLAG = +TRADFLAG = -traditional +CPP = /lib/cpp -C -P $(TRADFLAG) +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = $(SCC) + +########################################################### +#ARCH Linux ppc64 BG blxlf compiler with blxlc # dmpar +# +DMPARALLEL = # 1 +OMPCPP = # not supported +OMP = # not supported +BGL_SYS = /bgl/BlueLight/ppcfloor/bglsys +MPI_INC = -I$(BGL_SYS)/include +MPI_LIB = -L$(BGL_SYS)/lib -lmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts +SFC = blrts_xlf90 +SCC = blrts_xlc +DM_FC = $(SFC) +DM_CC = $(SCC) +FC = CONFIGURE_FC +CC = CONFIGURE_CC +LD = $(FC) +RWORDSIZE = CONFIGURE_RWORDSIZE +PROMOTION = -qrealsize=$(RWORDSIZE) -qintsize=4 +# If system has even more processors, set VERY_LARGE_MAXPROC to that number +ARCH_LOCAL = -DMOVE_NL_OUTSIDE_MODULE_CONFIGURE -DNONSTANDARD_SYSTEM_SUBR -DLANDREAD_STUB -DVERY_LARGE_MAXPROC=36768 +CFLAGS_LOCAL = -DNOUNDERSCORE -DNCARIBM_NOC99 $(MPI_INC) -DLANDREAD_STUB +LIB_LOCAL = $(MPI_LIB) +LDFLAGS_LOCAL = -Wl,--allow-multiple-definition -qstatic +CPLUSPLUSLIB = +ESMF_LDFLAG = $(CPLUSPLUSLIB) +FCOPTIM = -O2 -qarch=440 +FCNOOPT = -qnoopt +FCDEBUG = # $(FCNOOPT) -qfullpath +FORMAT_FIXED = -qfixed +FORMAT_FREE = -qfree=f90 +FCSUFFIX = -qsuffix=f=f90 +BYTESWAPIO = +FCBASEOPTS = -w -qspill=20000 -qmaxmem=64000 $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) $(MPI_INC) #-qflttrap=zerodivide:invalid:enable -qsigtrap +MODULE_SRCH_FLAG = +TRADFLAG = +# this might be different on different systems but we want the xlf version of cpp, not Linux's +# NYBlue +CPP = /opt/ibmcmp/xlf/bg/10.1/exe/cpp -C -P +# frost.ucar.edu +CPP = /opt/ibmcmp/xlf/9.1/exe/cpp -C -P +AR = ar +ARFLAGS = ru +M4 = m4 -B 14000 +RANLIB = ranlib +CC_TOOLS = cc + +########################################################### +#ARCH NULL + Index: /trunk/WRF.COMMON/WRFV3/dyn_em/Makefile =================================================================== --- /trunk/WRF.COMMON/WRFV3/dyn_em/Makefile (revision 2761) +++ /trunk/WRF.COMMON/WRFV3/dyn_em/Makefile (revision 2761) @@ -0,0 +1,270 @@ +# + +LN = ln -sf +MAKE = make -i -r +RM = rm -f + + +MODULES = \ + module_advect_em.o \ + module_diffusion_em.o \ + module_small_step_em.o \ + module_big_step_utilities_em.o \ + module_em.o \ + module_solvedebug_em.o \ + module_bc_em.o \ + module_init_utilities.o \ + module_damping_em.o \ + module_polarfft.o \ + module_first_rk_step_part1.o \ + module_first_rk_step_part2.o \ + $(CASE_MODULE) + +# possible CASE_MODULE settings +# module_initialize_b_wave.o \ +# module_initialize_grav2d_x.o \ +# module_initialize_heldsuarez.o \ +# module_initialize_hill2d_x.o \ +# module_initialize_quarter_ss.o \ +# module_initialize_real.o \ +# module_initialize_lsm_x.o \ +# module_initialize_les.o \ +# module_initialize_squall2d_x.o \ +# module_initialize_squall2d_y.o + +OBJS = \ + init_modules_em.o \ + solve_em.o \ + start_em.o \ + shift_domain_em.o \ + couple_or_uncouple_em.o \ + nest_init_utils.o \ + adapt_timestep_em.o \ + interp_domain_em.o + + +LIBTARGET = dyn_em +TARGETDIR = ./ +$(LIBTARGET) : $(MODULES) $(OBJS) + $(AR) $(ARFLAGS) ../main/$(LIBWRFLIB) $(MODULES) $(OBJS) + +include ../configure.wrf + +cio.o : + $(CC) -c $(CFLAGS) cio.c + +clean: + @ echo 'use the clean script' + +# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES) + +couple_or_uncouple_em.o: ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_driver_constants.o \ + ../frame/module_machine.o \ + ../frame/module_tiles.o \ + ../frame/module_dm.o \ + ../frame/module_state_description.o + +init_modules_em.o: module_big_step_utilities_em.o + +interp_domain_em.o: ../frame/module_domain.o \ + ../frame/module_configure.o + +module_advect_em.o: ../share/module_bc.o \ + ../share/module_model_constants.o \ + ../frame/module_wrf_error.o + +module_bc_em.o: ../share/module_bc.o ../frame/module_configure.o \ + ../frame/module_wrf_error.o + +module_big_step_utilities_em.o: \ + ../share/module_llxy.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../share/module_model_constants.o + +module_damping_em.o: ../frame/module_wrf_error.o + +module_diffusion_em.o: module_big_step_utilities_em.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../share/module_model_constants.o \ + ../share/module_bc.o \ + ../frame/module_wrf_error.o + +module_em.o: module_big_step_utilities_em.o module_advect_em.o \ + module_damping_em.o \ + ../frame/module_state_description.o \ + ../share/module_model_constants.o + +module_polarfft.o: ../share/module_model_constants.o \ + ../frame/module_wrf_error.o + +module_small_step_em.o: \ + ../frame/module_configure.o \ + ../share/module_model_constants.o + +module_initialize_b_wave.o : \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_bc.o \ + module_init_utilities.o + +module_initialize_grav2d_x.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_bc.o \ + module_init_utilities.o + +module_initialize_heldsuarez.o : \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_bc.o \ + module_init_utilities.o + +module_initialize_hill2d_x.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_bc.o \ + module_init_utilities.o + +module_initialize_quarter_ss.o : \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_bc.o \ + module_init_utilities.o + +module_initialize_les.o : \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_bc.o \ + module_init_utilities.o + +module_initialize_real.o : \ + nest_init_utils.o \ + ../share/module_llxy.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_bc.o \ + ../share/module_soil_pre.o \ + ../share/module_optional_input.o + +module_initialize_squall2d_x.o : \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_bc.o \ + module_init_utilities.o + +module_initialize_squall2d_y.o : \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_bc.o \ + module_init_utilities.o + +nest_init_utils.o: \ + ../frame/module_domain.o \ + ../frame/module_configure.o + +start_em.o: module_bc_em.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_state_description.o \ + ../frame/module_timing.o \ + ../frame/module_dm.o \ + ../share/module_io_domain.o \ + ../share/module_model_constants.o \ + ../share/module_bc.o \ + ../share/module_date_time.o \ + ../phys/module_physics_init.o + +solve_em.o: module_small_step_em.o \ + module_em.o \ + module_solvedebug_em.o \ + module_bc_em.o \ + module_diffusion_em.o \ + module_big_step_utilities_em.o \ + module_first_rk_step_part1.o \ + module_first_rk_step_part2.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_driver_constants.o \ + ../frame/module_state_description.o \ + ../frame/module_machine.o \ + ../frame/module_tiles.o \ + ../frame/module_dm.o \ + ../share/module_llxy.o \ + ../share/module_model_constants.o \ + ../share/module_bc.o \ + ../phys/module_physics_addtendc.o + +### pas sur +module_first_rk_step_part1.o : \ + ../phys/module_lmd_driver.o + +module_first_rk_step_part2.o : \ + module_diffusion_em.o \ + module_bc_em.o \ + ../frame/module_domain.o \ + ../frame/module_state_description.o \ + ../frame/module_driver_constants.o \ + ../frame/module_configure.o \ + ../frame/module_dm.o \ + ../share/module_bc.o + +adapt_timestep_em.o: \ + module_bc_em.o \ + ../frame/module_domain.o \ + ../frame/module_configure.o \ + ../frame/module_dm.o + +# ../chem/module_chem_utilities.o \ +# ../chem/module_input_chem_data.o + +# DO NOT DELETE Index: /trunk/WRF.COMMON/WRFV3/dyn_em/module_big_step_utilities_em.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/dyn_em/module_big_step_utilities_em.F (revision 2761) +++ /trunk/WRF.COMMON/WRFV3/dyn_em/module_big_step_utilities_em.F (revision 2761) @@ -0,0 +1,5606 @@ +!wrf:MODEL_LAYER:DYNAMICS +! + +#if (RWORDSIZE == 4) +# define VPOWX vspowx +# define VPOW vspow +#else +# define VPOWX vpowx +# define VPOW vpow +#endif + + +MODULE module_big_step_utilities_em + + USE module_domain, ONLY : domain + USE module_model_constants + USE module_state_description + USE module_configure, ONLY : grid_config_rec_type + USE module_wrf_error + +CONTAINS + +!------------------------------------------------------------------------------- + +SUBROUTINE calc_mu_uv ( config_flags, & + mu, mub, muu, muv, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, DIMENSION( ims:ime , jms:jme ) , INTENT( OUT) :: muu, muv + REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu, mub + + ! local stuff + + INTEGER :: i, j, itf, jtf, im, jm + +! +! +! calc_mu_uv calculates the full column dry-air mass at the staggered +! horizontal velocity points (u,v) and places the results in muu and muv. +! This routine uses the reference state (mub) and perturbation state (mu) +! +! + + + itf=ite + jtf=MIN(jte,jde-1) + + IF ( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN + DO j=jts,jtf + DO i=its,itf + muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) + ENDDO + ENDDO + ELSE IF ( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN + DO j=jts,jtf + DO i=its+1,itf + muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) + ENDDO + ENDDO + i=its + im = its + if(config_flags%periodic_x) im = its-1 + DO j=jts,jtf +! muu(i,j) = mu(i,j) +mub(i,j) +! fix for periodic b.c., 13 march 2004, wcs + muu(i,j) = 0.5*(mu(i,j)+mu(im,j)+mub(i,j)+mub(im,j)) + ENDDO + ELSE IF ( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN + DO j=jts,jtf + DO i=its,itf-1 + muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) + ENDDO + ENDDO + i=ite + im = ite-1 + if(config_flags%periodic_x) im = ite + DO j=jts,jtf +! muu(i,j) = mu(i-1,j) +mub(i-1,j) +! fix for periodic b.c., 13 march 2004, wcs + muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)+mub(i-1,j)+mub(im,j)) + ENDDO + ELSE IF ( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN + DO j=jts,jtf + DO i=its+1,itf-1 + muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) + ENDDO + ENDDO + i=its + im = its + if(config_flags%periodic_x) im = its-1 + DO j=jts,jtf +! muu(i,j) = mu(i,j) +mub(i,j) +! fix for periodic b.c., 13 march 2004, wcs + muu(i,j) = 0.5*(mu(i,j)+mu(im,j)+mub(i,j)+mub(im,j)) + ENDDO + i=ite + im = ite-1 + if(config_flags%periodic_x) im = ite + DO j=jts,jtf +! muu(i,j) = mu(i-1,j) +mub(i-1,j) +! fix for periodic b.c., 13 march 2004, wcs + muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)+mub(i-1,j)+mub(im,j)) + ENDDO + END IF + + itf=MIN(ite,ide-1) + jtf=jte + + IF ( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN + DO j=jts,jtf + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) + ENDDO + ENDDO + ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN + DO j=jts+1,jtf + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) + ENDDO + ENDDO + j=jts + jm = jts + if(config_flags%periodic_y) jm = jts-1 + DO i=its,itf +! muv(i,j) = mu(i,j) +mub(i,j) +! fix for periodic b.c., 13 march 2004, wcs + muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)+mub(i,j)+mub(i,jm)) + ENDDO + ELSE IF ( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN + DO j=jts,jtf-1 + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) + ENDDO + ENDDO + j=jte + jm = jte-1 + if(config_flags%periodic_y) jm = jte + DO i=its,itf + muv(i,j) = mu(i,j-1) +mub(i,j-1) +! fix for periodic b.c., 13 march 2004, wcs + muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)+mub(i,j-1)+mub(i,jm)) + ENDDO + ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN + DO j=jts+1,jtf-1 + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) + ENDDO + ENDDO + j=jts + jm = jts + if(config_flags%periodic_y) jm = jts-1 + DO i=its,itf +! muv(i,j) = mu(i,j) +mub(i,j) +! fix for periodic b.c., 13 march 2004, wcs + muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)+mub(i,j)+mub(i,jm)) + ENDDO + j=jte + jm = jte-1 + if(config_flags%periodic_y) jm = jte + DO i=its,itf +! muv(i,j) = mu(i,j-1) +mub(i,j-1) +! fix for periodic b.c., 13 march 2004, wcs + muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)+mub(i,j-1)+mub(i,jm)) + ENDDO + END IF + +END SUBROUTINE calc_mu_uv + +!------------------------------------------------------------------------------- + +SUBROUTINE calc_mu_uv_1 ( config_flags, & + mu, muu, muv, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, DIMENSION( ims:ime , jms:jme ) , INTENT( OUT) :: muu, muv + REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu + + ! local stuff + + INTEGER :: i, j, itf, jtf, im, jm + +! +! +! calc_mu_uv calculates the full column dry-air mass at the staggered +! horizontal velocity points (u,v) and places the results in muu and muv. +! This routine uses the full state (mu) +! +! + + itf=ite + jtf=MIN(jte,jde-1) + + IF ( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN + DO j=jts,jtf + DO i=its,itf + muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)) + ENDDO + ENDDO + ELSE IF ( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN + DO j=jts,jtf + DO i=its+1,itf + muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)) + ENDDO + ENDDO + i=its + im = its + if(config_flags%periodic_x) im = its-1 + DO j=jts,jtf + muu(i,j) = 0.5*(mu(i,j)+mu(im,j)) + ENDDO + ELSE IF ( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN + DO j=jts,jtf + DO i=its,itf-1 + muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)) + ENDDO + ENDDO + i=ite + im = ite-1 + if(config_flags%periodic_x) im = ite + DO j=jts,jtf + muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)) + ENDDO + ELSE IF ( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN + DO j=jts,jtf + DO i=its+1,itf-1 + muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)) + ENDDO + ENDDO + i=its + im = its + if(config_flags%periodic_x) im = its-1 + DO j=jts,jtf + muu(i,j) = 0.5*(mu(i,j)+mu(im,j)) + ENDDO + i=ite + im = ite-1 + if(config_flags%periodic_x) im = ite + DO j=jts,jtf + muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)) + ENDDO + END IF + + itf=MIN(ite,ide-1) + jtf=jte + + IF ( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN + DO j=jts,jtf + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)) + ENDDO + ENDDO + ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN + DO j=jts+1,jtf + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)) + ENDDO + ENDDO + j=jts + jm = jts + if(config_flags%periodic_y) jm = jts-1 + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)) + ENDDO + ELSE IF ( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN + DO j=jts,jtf-1 + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)) + ENDDO + ENDDO + j=jte + jm = jte-1 + if(config_flags%periodic_y) jm = jte + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)) + ENDDO + ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN + DO j=jts+1,jtf-1 + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)) + ENDDO + ENDDO + j=jts + jm = jts + if(config_flags%periodic_y) jm = jts-1 + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)) + ENDDO + j=jte + jm = jte-1 + if(config_flags%periodic_y) jm = jte + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)) + ENDDO + END IF + +END SUBROUTINE calc_mu_uv_1 + +!------------------------------------------------------------------------------- + +! Map scale factor comments for this routine: +! Locally not changed, but sent the correct map scale factors +! from module_em (msfuy, msfvx, msfty) + +SUBROUTINE couple_momentum ( muu, ru, u, msfu, & + muv, rv, v, msfv, msfv_inv, & + mut, rw, w, msft, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT( OUT) :: ru, rv, rw + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: muu, muv, mut + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfu, msfv, msft, msfv_inv + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: u, v, w + + ! Local data + + INTEGER :: i, j, k, itf, jtf, ktf + +! +! +! couple_momentum couples the velocities to the full column mass and +! the map factors. +! +! + + ktf=MIN(kte,kde-1) + + itf=ite + jtf=MIN(jte,jde-1) + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + ru(i,k,j)=u(i,k,j)*muu(i,j)/msfu(i,j) + ENDDO + ENDDO + ENDDO + + itf=MIN(ite,ide-1) + jtf=jte + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + rv(i,k,j)=v(i,k,j)*muv(i,j)*msfv_inv(i,j) +! rv(i,k,j)=v(i,k,j)*muv(i,j)/msfv(i,j) + ENDDO + ENDDO + ENDDO + + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + + DO j=jts,jtf + DO k=kts,kte + DO i=its,itf + rw(i,k,j)=w(i,k,j)*mut(i,j)/msft(i,j) + ENDDO + ENDDO + ENDDO + +END SUBROUTINE couple_momentum + +!------------------------------------------------------------------- + +SUBROUTINE calc_mu_staggered ( mu, mub, muu, muv, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, DIMENSION( ims:ime , jms:jme ) , INTENT( OUT) :: muu, muv + REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu, mub + + ! local stuff + + INTEGER :: i, j, itf, jtf + +! +! +! calc_mu_staggered calculates the full dry air mass at the staggered +! velocity points (u,v). +! +! + + itf=ite + jtf=MIN(jte,jde-1) + + IF ( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN + DO j=jts,jtf + DO i=its,itf + muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) + ENDDO + ENDDO + ELSE IF ( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN + DO j=jts,jtf + DO i=its+1,itf + muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) + ENDDO + ENDDO + i=its + DO j=jts,jtf + muu(i,j) = mu(i,j) +mub(i,j) + ENDDO + ELSE IF ( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN + DO j=jts,jtf + DO i=its,itf-1 + muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) + ENDDO + ENDDO + i=ite + DO j=jts,jtf + muu(i,j) = mu(i-1,j) +mub(i-1,j) + ENDDO + ELSE IF ( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN + DO j=jts,jtf + DO i=its+1,itf-1 + muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) + ENDDO + ENDDO + i=its + DO j=jts,jtf + muu(i,j) = mu(i,j) +mub(i,j) + ENDDO + i=ite + DO j=jts,jtf + muu(i,j) = mu(i-1,j) +mub(i-1,j) + ENDDO + END IF + + itf=MIN(ite,ide-1) + jtf=jte + + IF ( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN + DO j=jts,jtf + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) + ENDDO + ENDDO + ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN + DO j=jts+1,jtf + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) + ENDDO + ENDDO + j=jts + DO i=its,itf + muv(i,j) = mu(i,j) +mub(i,j) + ENDDO + ELSE IF ( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN + DO j=jts,jtf-1 + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) + ENDDO + ENDDO + j=jte + DO i=its,itf + muv(i,j) = mu(i,j-1) +mub(i,j-1) + ENDDO + ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN + DO j=jts+1,jtf-1 + DO i=its,itf + muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) + ENDDO + ENDDO + j=jts + DO i=its,itf + muv(i,j) = mu(i,j) +mub(i,j) + ENDDO + j=jte + DO i=its,itf + muv(i,j) = mu(i,j-1) +mub(i,j-1) + ENDDO + END IF + +END SUBROUTINE calc_mu_staggered + +!------------------------------------------------------------------------------- + +SUBROUTINE couple ( mu, mub, rfield, field, name, & + msf, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + CHARACTER(LEN=1) , INTENT(IN ) :: name + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT( OUT) :: rfield + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu, mub, msf + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: field + + ! Local data + + INTEGER :: i, j, k, itf, jtf, ktf + REAL , DIMENSION(ims:ime,jms:jme) :: muu , muv + +! +! +! subroutine couple couples the input variable with the dry-air +! column mass (mu). +! +! + + + ktf=MIN(kte,kde-1) + + IF (name .EQ. 'u')THEN + + CALL calc_mu_staggered ( mu, mub, muu, muv, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + itf=ite + jtf=MIN(jte,jde-1) + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + rfield(i,k,j)=field(i,k,j)*muu(i,j)/msf(i,j) + ENDDO + ENDDO + ENDDO + + ELSE IF (name .EQ. 'v')THEN + + CALL calc_mu_staggered ( mu, mub, muu, muv, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + itf=ite + itf=MIN(ite,ide-1) + jtf=jte + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + rfield(i,k,j)=field(i,k,j)*muv(i,j)/msf(i,j) + ENDDO + ENDDO + ENDDO + + ELSE IF (name .EQ. 'w')THEN + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + DO j=jts,jtf + DO k=kts,kte + DO i=its,itf + rfield(i,k,j)=field(i,k,j)*(mu(i,j)+mub(i,j))/msf(i,j) + ENDDO + ENDDO + ENDDO + + ELSE IF (name .EQ. 'h')THEN + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + DO j=jts,jtf + DO k=kts,kte + DO i=its,itf + rfield(i,k,j)=field(i,k,j)*(mu(i,j)+mub(i,j)) + ENDDO + ENDDO + ENDDO + + ELSE + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + rfield(i,k,j)=field(i,k,j)*(mu(i,j)+mub(i,j)) + ENDDO + ENDDO + ENDDO + + ENDIF + +END SUBROUTINE couple + + +!------------------------------------------------------------------------------- + +SUBROUTINE calc_ww_cp ( u, v, mup, mub, ww, & + rdx, rdy, msftx, msfty, & + msfux, msfuy, msfvx, msfvx_inv, & + msfvy, dnw, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: u, v + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mup, mub, & + msftx, msfty, & + msfux, msfuy, & + msfvx, msfvy, & + msfvx_inv + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT ) :: ww + REAL , INTENT(IN ) :: rdx, rdy + + ! Local data + + INTEGER :: i, j, k, itf, jtf, ktf + REAL , DIMENSION( its:ite ) :: dmdt + REAL , DIMENSION( its:ite, kts:kte ) :: divv + REAL , DIMENSION( its:ite+1, jts:jte+1 ) :: muu, muv + +! +! +! calc_ww calculates omega using the velocities (u,v) and the dry-air +! column mass (mup+mub). +! The algorithm integrates the continuity equation through the column +! followed by a diagnosis of omega. +! +! + +! +! +! calc_ww_cp calculates omega using the velocities (u,v) and the +! column mass mu. +! +! + + jtf=MIN(jte,jde-1) + ktf=MIN(kte,kde-1) + itf=MIN(ite,ide-1) + +! mu coupled with the appropriate map factor + + DO j=jts,jtf + DO i=its,min(ite+1,ide) + ! u is always coupled with my + muu(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i-1,j)+mub(i-1,j))/msfuy(i,j) + ENDDO + ENDDO + + DO j=jts,min(jte+1,jde) + DO i=its,itf + ! v is always coupled with mx +! muv(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i,j-1)+mub(i,j-1))/msfvx(i,j) + muv(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i,j-1)+mub(i,j-1))*msfvx_inv(i,j) + ENDDO + ENDDO + + DO j=jts,jtf + + DO i=its,ite + dmdt(i) = 0. + ww(i,1,j) = 0. + ww(i,kte,j) = 0. + ENDDO + +! Comments on the modifications for map scale factors +! ADT eqn 47 / my (putting rho -> 'mu') is: +! (1/my) partial d mu/dt = -mx partial d/dx(mu u/my) +! -mx partial d/dy(mu v/mx) +! -partial d/dz(mu w/my) +! +! Using nu instead of z the last term becomes: +! -partial d/dnu(mu (dnu/dt)/my) +! +! Integrating with respect to nu over ALL levels, with dnu/dt=0 at top +! and bottom, the last term becomes = 0 +! +! Integral|bot->top[(1/my) partial d mu/dt]dnu = +! Integral|bot->top[-mx partial d/dx(mu u/my) +! -mx partial d/dy(mu v/mx)]dnu +! +! muu='mu'[on u]/my, muv='mu'[on v]/mx +! (1/my) partial d mu/dt is independent of nu +! => LHS = Integral|bot->top[con]dnu = conservation*(-1) = -dmdt +! +! => dmdt = mx*Integral|bot->top[partial d/dx(mu u/my) + +! partial d/dy(mu v/mx)]dnu +! => dmdt = sum_bot->top[divv] +! where +! divv=mx*[partial d/dx(mu u/my) + partial d/dy(mu v/mx)]*delta nu + + DO k=kts,ktf + DO i=its,itf + + divv(i,k) = msftx(i,j)*dnw(k)*( rdx*(muu(i+1,j)*u(i+1,k,j)-muu(i,j)*u(i,k,j)) & + +rdy*(muv(i,j+1)*v(i,k,j+1)-muv(i,j)*v(i,k,j)) ) + +! dmdt(i) = dmdt(i) + dnw(k)* ( rdx*(ru(i+1,k,j)-ru(i,k,j)) & +! +rdy*(rv(i,k,j+1)-rv(i,k,j)) ) + + dmdt(i) = dmdt(i) + divv(i,k) + + + ENDDO + ENDDO + +! Further map scale factor notes: +! Now integrate from bottom to top, level by level: +! mu dnu/dt/my [k+1] = mu dnu/dt/my [k] + [-(1/my) partial d mu/dt +! -mx partial d/dx(mu u/my) +! -mx partial d/dy(mu v/mx)]*dnu[k->k+1] +! ww [k+1] = ww [k] -(1/my) partial d mu/dt * dnu[k->k+1] - divv[k] +! = ww [k] -dmdt * dnw[k] - divv[k] + + DO k=2,ktf + DO i=its,itf + +! ww(i,k,j)=ww(i,k-1,j) & +! - dnw(k-1)* ( dmdt(i) & +! +rdx*(ru(i+1,k-1,j)-ru(i,k-1,j)) & +! +rdy*(rv(i,k-1,j+1)-rv(i,k-1,j)) ) + + ww(i,k,j)=ww(i,k-1,j) - dnw(k-1)*dmdt(i) - divv(i,k-1) + + ENDDO + ENDDO + ENDDO + + +END SUBROUTINE calc_ww_cp + + +!------------------------------------------------------------------------------- + +SUBROUTINE calc_cq ( moist, cqu, cqv, cqw, n_moist, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER , INTENT(IN ) :: n_moist + + + REAL, DIMENSION( ims:ime, kms:kme , jms:jme , n_moist ), INTENT(IN ) :: moist + + REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT( OUT) :: cqu, cqv, cqw + + ! Local stuff + + REAL :: qtot + + INTEGER :: i, j, k, itf, jtf, ktf, ispe + +! +! +! calc_cq calculates moist coefficients for the momentum equations. +! +! + + itf=ite + jtf=MIN(jte,jde-1) + ktf=MIN(kte,kde-1) + + IF( n_moist >= PARAM_FIRST_SCALAR ) THEN + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + qtot = 0. +!DEC$ loop count(3) + DO ispe=PARAM_FIRST_SCALAR,n_moist + qtot = qtot + moist(i,k,j,ispe) + moist(i-1,k,j,ispe) + ENDDO +! qtot = 0.5*( moist(i ,k,j,1)+moist(i ,k,j,2)+moist(i ,k,j,3)+ & +! & moist(i-1,k,j,1)+moist(i-1,k,j,2)+moist(i-1,k,j,3) ) +! cqu(i,k,j) = 1./(1.+qtot) + cqu(i,k,j) = 1./(1.+0.5*qtot) + ENDDO + ENDDO + ENDDO + + itf=MIN(ite,ide-1) + jtf=jte + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + qtot = 0. +!DEC$ loop count(3) + DO ispe=PARAM_FIRST_SCALAR,n_moist + qtot = qtot + moist(i,k,j,ispe) + moist(i,k,j-1,ispe) + ENDDO +! qtot = 0.5*( moist(i,k,j ,1)+moist(i,k,j ,2)+moist(i,k,j ,3)+ & +! & moist(i,k,j-1,1)+moist(i,k,j-1,2)+moist(i,k,j-1,3) ) +! cqv(i,k,j) = 1./(1.+qtot) + cqv(i,k,j) = 1./(1.+0.5*qtot) + ENDDO + ENDDO + ENDDO + + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + DO j=jts,jtf + DO k=kts+1,ktf + DO i=its,itf + qtot = 0. +!DEC$ loop count(3) + DO ispe=PARAM_FIRST_SCALAR,n_moist + qtot = qtot + moist(i,k,j,ispe) + moist(i,k-1,j,ispe) + ENDDO +! qtot = 0.5*( moist(i,k ,j,1)+moist(i,k ,j,2)+moist(i,k-1,j,3)+ & +! & moist(i,k-1,j,1)+moist(i,k-1,j,2)+moist(i,k ,j,3) ) +! cqw(i,k,j) = qtot + cqw(i,k,j) = 0.5*qtot + ENDDO + ENDDO + ENDDO + + ELSE + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + cqu(i,k,j) = 1. + ENDDO + ENDDO + ENDDO + + itf=MIN(ite,ide-1) + jtf=jte + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + cqv(i,k,j) = 1. + ENDDO + ENDDO + ENDDO + + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + DO j=jts,jtf + DO k=kts+1,ktf + DO i=its,itf + cqw(i,k,j) = 0. + ENDDO + ENDDO + ENDDO + + END IF + +END SUBROUTINE calc_cq + +!---------------------------------------------------------------------- + +SUBROUTINE calc_alt ( alt, al, alb, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: alb, al + REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT( OUT) :: alt + + ! Local stuff + + INTEGER :: i, j, k, itf, jtf, ktf + +! +! +! calc_alt computes the full inverse density +! +! + + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + ktf=MIN(kte,kde-1) + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + alt(i,k,j) = al(i,k,j)+alb(i,k,j) + ENDDO + ENDDO + ENDDO + + +END SUBROUTINE calc_alt + +!---------------------------------------------------------------------- + +SUBROUTINE calc_p_rho_phi ( moist, n_moist, & + al, alb, mu, muts, ph, p, pb, & + t, p0, t0, znu, dnw, rdnw, & + rdn, non_hydrostatic, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + LOGICAL , INTENT(IN ) :: non_hydrostatic + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER , INTENT(IN ) :: n_moist + + REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: alb, & + pb, & + t + + REAL, DIMENSION( ims:ime , kms:kme , jms:jme, n_moist ), INTENT(IN ) :: moist + + REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT( OUT) :: al, p + + REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: ph + + REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: mu, muts + + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: znu, dnw, rdnw, rdn + + REAL, INTENT(IN ) :: t0, p0 + + ! Local stuff + + INTEGER :: i, j, k, itf, jtf, ktf, ispe + REAL :: qvf, qtot, qf1, qf2 + REAL, DIMENSION( its:ite) :: temp,cpovcv_v + + +! +! +! For the nonhydrostatic option, calc_p_rho_phi calculates the +! diagnostic quantities pressure and (inverse) density from the +! prognostic variables using the equation of state. +! +! For the hydrostatic option, calc_p_rho_phi calculates the +! diagnostic quantities (inverse) density and geopotential from the +! prognostic variables using the equation of state and the hydrostatic +! equation. +! +! + + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + ktf=MIN(kte,kde-1) + +#ifndef INTELMKL + cpovcv_v = cpovcv +#endif + + IF (non_hydrostatic) THEN + + IF (n_moist >= PARAM_FIRST_SCALAR ) THEN + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + qvf = 1.+rvovrd*moist(i,k,j,P_QV) + al(i,k,j)=-1./muts(i,j)*(alb(i,k,j)*mu(i,j) & + +rdnw(k)*(ph(i,k+1,j)-ph(i,k,j))) + temp(i)=(r_d*(t0+t(i,k,j))*qvf)/ & + (p0*(al(i,k,j)+alb(i,k,j))) + ENDDO +#ifdef INTELMKL + CALL VPOWX ( itf-its+1, temp(its), cpovcv, p(its,k,j) ) +#else +! use vector version from libmassv or from compat lib in frame/libmassv.F + CALL VPOW ( p(its,k,j), temp(its), cpovcv_v(its), itf-its+1 ) +#endif + DO i=its,itf + p(i,k,j)= p(i,k,j)*p0-pb(i,k,j) + ENDDO + ENDDO + ENDDO + + ELSE + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + al(i,k,j)=-1./muts(i,j)*(alb(i,k,j)*mu(i,j) & + +rdnw(k)*(ph(i,k+1,j)-ph(i,k,j))) + p(i,k,j)=p0*( (r_d*(t0+t(i,k,j)))/ & + (p0*(al(i,k,j)+alb(i,k,j))) )**cpovcv & + -pb(i,k,j) + ENDDO + ENDDO + ENDDO + + END IF + + ELSE + +! hydrostatic pressure, al, and ph1 calc; WCS, 5 sept 2001 + + + IF (n_moist >= PARAM_FIRST_SCALAR ) THEN + + DO j=jts,jtf + + k=ktf ! top layer + DO i=its,itf + + qtot = 0. + DO ispe=PARAM_FIRST_SCALAR,n_moist + qtot = qtot + moist(i,k,j,ispe) + ENDDO + qf2 = 1./(1.+qtot) + qf1 = qtot*qf2 + + p(i,k,j) = - 0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2 + qvf = 1.+rvovrd*moist(i,k,j,P_QV) + al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* & + (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j) + + ENDDO + + DO k=ktf-1,kts,-1 ! remaining layers, integrate down + DO i=its,itf + + qtot = 0. + DO ispe=PARAM_FIRST_SCALAR,n_moist + qtot = qtot + 0.5*( moist(i,k ,j,ispe) + moist(i,k+1,j,ispe) ) + ENDDO + qf2 = 1./(1.+qtot) + qf1 = qtot*qf2 + + p(i,k,j) = p(i,k+1,j) - (mu(i,j) + qf1*muts(i,j))/qf2/rdn(k+1) + qvf = 1.+rvovrd*moist(i,k,j,P_QV) + al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* & + (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j) + ENDDO + ENDDO + + DO k=2,ktf+1 ! integrate hydrostatic equation for geopotential + DO i=its,itf + +! ph(i,k,j) = ph(i,k-1,j) - (1./rdnw(k-1))*( & +! (muts(i,j)+mu(i,j))*al(i,k-1,j)+ & +! mu(i,j)*alb(i,k-1,j) ) + ph(i,k,j) = ph(i,k-1,j) - (dnw(k-1))*( & + (muts(i,j))*al(i,k-1,j)+ & + mu(i,j)*alb(i,k-1,j) ) + + + ENDDO + ENDDO + + ENDDO + + ELSE + + DO j=jts,jtf + + k=ktf ! top layer + DO i=its,itf + + qtot = 0. + qf2 = 1./(1.+qtot) + qf1 = qtot*qf2 + + p(i,k,j) = - 0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2 + qvf = 1. + al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* & + (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j) + + ENDDO + + DO k=ktf-1,kts,-1 ! remaining layers, integrate down + DO i=its,itf + + qtot = 0. + qf2 = 1./(1.+qtot) + qf1 = qtot*qf2 + + p(i,k,j) = p(i,k+1,j) - (mu(i,j) + qf1*muts(i,j))/qf2/rdn(k+1) + qvf = 1. + al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* & + (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j) + ENDDO + ENDDO + + DO k=2,ktf+1 ! integrate hydrostatic equation for geopotential + DO i=its,itf + +! ph(i,k,j) = ph(i,k-1,j) - (1./rdnw(k-1))*( & +! (muts(i,j)+mu(i,j))*al(i,k-1,j)+ & +! mu(i,j)*alb(i,k-1,j) ) + ph(i,k,j) = ph(i,k-1,j) - (dnw(k-1))*( & + (muts(i,j))*al(i,k-1,j)+ & + mu(i,j)*alb(i,k-1,j) ) + + + ENDDO + ENDDO + + ENDDO + + END IF + + END IF + +END SUBROUTINE calc_p_rho_phi + +!---------------------------------------------------------------------- + +SUBROUTINE calc_php ( php, ph, phb, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN ) :: phb, ph + REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT( OUT) :: php + + ! Local stuff + + INTEGER :: i, j, k, itf, jtf, ktf + +! +! +! calc_php calculates the full geopotential from the reference state +! geopotential and the perturbation geopotential (phb_ph). +! +! + + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + ktf=MIN(kte,kde-1) + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + php(i,k,j) = 0.5*(phb(i,k,j)+phb(i,k+1,j)+ph(i,k,j)+ph(i,k+1,j)) + ENDDO + ENDDO + ENDDO + +END SUBROUTINE calc_php + +!------------------------------------------------------------------------------- + +SUBROUTINE diagnose_w( ph_tend, ph_new, ph_old, w, mu, dt, & + u, v, ht, & + cf1, cf2, cf3, rdx, rdy, & + msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN ) :: ph_tend, & + ph_new, & + ph_old, & + u, & + v + + + REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT( OUT) :: w + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: mu, ht, msftx, msfty + + REAL, INTENT(IN ) :: dt, cf1, cf2, cf3, rdx, rdy + + INTEGER :: i, j, k, itf, jtf + + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + +! +! +! diagnose_w diagnoses the vertical velocity from the geopoential equation. +! Used with the hydrostatic option. +! +! + + DO j = jts, jtf + +! lower b.c. on w + +! Notes on map scale factors: +! Chain rule: if Z=Z(X,Y) [true at the surface] then +! dZ/dt = dZ/dX * dX/dt + dZ/dY * dY/dt, U=dX/dt, V=dY/dt +! Using capitals to denote actual values +! In mapped values, u=U, v=V, z=Z, 1/dX=mx/dx, 1/dY=my/dy +! => w = dz/dt = mx u dz/dx + my v dz/dy +! [where dz/dx is just the surface height change between x +! gridpoints, and dz/dy is the change between y gridpoints] +! [NB: cf1, cf2 and cf3 do vertical weighting of u or v values +! nearest the surface] + +! Previously msft multiplied by rdy and rdx terms. +! Now msfty multiplies rdy term, and msftx multiplies msftx term + DO i = its, itf + w(i,1,j)= msfty(i,j)*.5*rdy*( & + (ht(i,j+1)-ht(i,j )) & + *(cf1*v(i,1,j+1)+cf2*v(i,2,j+1)+cf3*v(i,3,j+1)) & + +(ht(i,j )-ht(i,j-1)) & + *(cf1*v(i,1,j )+cf2*v(i,2,j )+cf3*v(i,3,j )) ) & + +msftx(i,j)*.5*rdx*( & + (ht(i+1,j)-ht(i,j )) & + *(cf1*u(i+1,1,j)+cf2*u(i+1,2,j)+cf3*u(i+1,3,j)) & + +(ht(i,j )-ht(i-1,j)) & + *(cf1*u(i ,1,j)+cf2*u(i ,2,j)+cf3*u(i ,3,j)) ) + ENDDO + +! use geopotential equation to diagnose w + +! Further notes on map scale factors +! If ph_tend contains: -mx partial d/dx(mu rho u/my) +! -mx partial d/dy(phi mu v/mx) +! -partial d/dz(phi mu w/my) +! then phi eqn is: partial d/dt(mu phi/my) = ph_tend + mu g w/my +! => w = [my/(mu*g)]*[partial d/dt(mu phi/my) - ph_tend] + + DO k = 2, kte + DO i = its, itf + w(i,k,j) = msfty(i,j)*( (ph_new(i,k,j)-ph_old(i,k,j))/dt & + - ph_tend(i,k,j)/mu(i,j) )/g + + ENDDO + ENDDO + + ENDDO + +END SUBROUTINE diagnose_w + +!------------------------------------------------------------------------------- + +SUBROUTINE rhs_ph( ph_tend, u, v, ww, & + ph, ph_old, phb, w, & + mut, muu, muv, & + fnm, fnp, & + rdnw, cfn, cfn1, rdx, rdy, & + msfux, msfuy, msfvx, & + msfvx_inv, msfvy, & + msftx, msfty, & + non_hydrostatic, & + config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + IMPLICIT NONE + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN ) :: & + u, & + v, & + ww, & + ph, & + ph_old, & + phb, & + w + + REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) :: ph_tend + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: muu, muv, mut, & + msfux, msfuy, & + msfvx, msfvy, & + msftx, msfty, & + msfvx_inv + + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: rdnw, fnm, fnp + + REAL, INTENT(IN ) :: cfn, cfn1, rdx, rdy + + LOGICAL, INTENT(IN ) :: non_hydrostatic + + ! Local stuff + + INTEGER :: i, j, k, itf, jtf, ktf, kz, i_start, j_start + REAL :: ur, ul, ub, vr, vl, vb + REAL, DIMENSION(its:ite,kts:kte) :: wdwn + + INTEGER :: advective_order + + LOGICAL :: specified + +! +! +! rhs_ph calculates the large-timestep tendency terms for the geopotential +! equation. These terms include the advection and "gw". The geopotential +! equation is cast in advective form, so we don't use the flux form advection +! algorithms here. +! +! + + specified = .false. + if(config_flags%specified .or. config_flags%nested) specified = .true. + + advective_order = config_flags%h_sca_adv_order +! advective_order = 2 ! original configuration (pre Oct 2001) + + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + ktf=MIN(kte,kde-1) + +! Notes on map scale factors (WCS, 2 march 2008) +! phi equation is: mu/my d/dt(phi) = -(1/my) mx mu u d/dx(phi) +! -(1/my) my mu v d/dy(phi) +! - omega d/d_eta(phi) +! +mu g w/my +! +! A little further explanation... +! The tendency term we are computing here is for mu/my d/dt(phi). It is advective form +! but it is multiplied be mu/my. It will be decoupled from (mu/my) when the implicit w-phi +! solution is computed in subourine advance_w. The formulation dates from the early +! days of the mass coordinate model when we were testing both a flux and an advective formulation +! for the geopotential equation and different forms of the vertical momentum equation and the +! vertically implicit solver. + +! advective form for the geopotential equation + + DO j = jts, jtf + + DO k = 2, kte + DO i = its, itf + wdwn(i,k) = .5*(ww(i,k,j)+ww(i,k-1,j))*rdnw(k-1) & + *(ph(i,k,j)-ph(i,k-1,j)+phb(i,k,j)-phb(i,k-1,j)) + ENDDO + ENDDO + +! RHS term 3 is: - omega partial d/dnu(phi) + + DO k = 2, kte-1 + DO i = its, itf + ph_tend(i,k,j) = ph_tend(i,k,j) & + - (fnm(k)*wdwn(i,k+1)+fnp(k)*wdwn(i,k)) + ENDDO + ENDDO + + ENDDO + + IF (non_hydrostatic) THEN ! add in "gw" term. + DO j = jts, jtf ! in hydrostatic mode, "gw" will be diagnosed + ! after the timestep to give us "w" + DO i = its, itf + ph_tend(i,kde,j) = 0. + ENDDO + + DO k = 2, kte + DO i = its, itf + ! phi equation RHS term 4 + ph_tend(i,k,j) = ph_tend(i,k,j) + mut(i,j)*g*w(i,k,j)/msfty(i,j) + ENDDO + ENDDO + + ENDDO + + END IF + +! Notes on map scale factors: +! RHS terms 1 and 2 are: -(1/my) mx u mu partial d/dx(phi) +! -(1/my) my v mu partial d/dy(phi) + + IF (advective_order <= 2) THEN + +! y (v) advection + + i_start = its + j_start = jts + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + + IF ( (config_flags%open_ys) .and. jts == jds ) j_start = jts+1 + IF ( (config_flags%open_ye) .and. jte == jde ) jtf = jtf-1 + + DO j = j_start, jtf + + DO k = 2, kte-1 + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* & + ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)* & + (phb(i,k,j+1)-phb(i,k,j )+ph(i,k,j+1)-ph(i,k,j )) & + +muv(i,j )*(v(i,k,j )+v(i,k-1,j ))*msfvy(i,j )* & + (phb(i,k,j )-phb(i,k,j-1)+ph(i,k,j )-ph(i,k,j-1)) ) + ENDDO + ENDDO + + k = kte + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* & + ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1)* & + (phb(i,k,j+1)-phb(i,k,j )+ph(i,k,j+1)-ph(i,k,j )) & + +muv(i,j )*(cfn*v(i,k-1,j )+cfn1*v(i,k-2,j ))*msfvy(i,j )* & + (phb(i,k,j )-phb(i,k,j-1)+ph(i,k,j )-ph(i,k,j-1)) ) + ENDDO + + ENDDO + +! x (u) advection + + i_start = its + j_start = jts + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + + IF ( (config_flags%open_xs) .and. its == ids ) i_start = its+1 + IF ( (config_flags%open_xe) .and. ite == ide ) itf = itf-1 + + DO j = j_start, jtf + + DO k = 2, kte-1 + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))* & + ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)* & + (phb(i+1,k,j)-phb(i ,k,j)+ph(i+1,k,j)-ph(i ,k,j)) & + +muu(i ,j)*(u(i ,k,j)+u(i ,k-1,j))*msfux(i ,j)* & + (phb(i ,k,j)-phb(i-1,k,j)+ph(i ,k,j)-ph(i-1,k,j)) ) + ENDDO + ENDDO + + k = kte + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))* & + ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j)* & + (phb(i+1,k,j)-phb(i ,k,j)+ph(i+1,k,j)-ph(i ,k,j)) & + +muu(i ,j)*(cfn*u(i ,k-1,j)+cfn1*u(i ,k-2,j))*msfux( i,j)* & + (phb(i ,k,j)-phb(i-1,k,j)+ph(i ,k,j)-ph(i-1,k,j)) ) + ENDDO + + ENDDO + + ELSE IF (advective_order <= 4) THEN + +! y (v) advection + + i_start = its + j_start = jts + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + + IF ( (config_flags%open_ys) .and. jts == jds ) j_start = jts+1 + IF ( (config_flags%open_ye) .and. jte == jde ) jtf = jtf-1 + + DO j = j_start, jtf + + DO k = 2, kte-1 + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))*( & + ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1) & + +muv(i,j )*(v(i,k,j )+v(i,k-1,j ))*msfvy(i,j ))* (1./12.)*( & + 8.*(ph(i,k,j+1)-ph(i,k,j-1)) & + -(ph(i,k,j+2)-ph(i,k,j-2)) & + +8.*(phb(i,k,j+1)-phb(i,k,j-1)) & + -(phb(i,k,j+2)-phb(i,k,j-2)) ) ) + + + ENDDO + ENDDO + + k = kte + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))*( & + ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) & + +muv(i,j )*(cfn*v(i,k-1,j )+cfn1*v(i,k-2,j ))*msfvy(i,j ))* (1./12.)*( & + 8.*(ph(i,k,j+1)-ph(i,k,j-1)) & + -(ph(i,k,j+2)-ph(i,k,j-2)) & + +8.*(phb(i,k,j+1)-phb(i,k,j-1)) & + -(phb(i,k,j+2)-phb(i,k,j-2)) ) ) + + ENDDO + + ENDDO + + +! x (u) advection + + i_start = its + j_start = jts + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + + IF ( (config_flags%open_xs) .and. its == ids ) i_start = its+1 + IF ( (config_flags%open_xe) .and. ite == ide ) itf = itf-1 + + DO j = j_start, jtf + + DO k = 2, kte-1 + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*( & + ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j) & + +muu(i,j )*(u(i ,k,j)+u(i ,k-1,j))*msfux(i ,j) )* (1./12.)*( & + 8.*(ph(i+1,k,j)-ph(i-1,k,j)) & + -(ph(i+2,k,j)-ph(i-2,k,j)) & + +8.*(phb(i+1,k,j)-phb(i-1,k,j)) & + -(phb(i+2,k,j)-phb(i-2,k,j)) ) ) + ENDDO + ENDDO + + k = kte + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*( & + ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) & + +muu(i,j )*(cfn*u(i ,k-1,j)+cfn1*u(i ,k-2,j))*msfux(i ,j) )* (1./12.)*( & + 8.*(ph(i+1,k,j)-ph(i-1,k,j)) & + -(ph(i+2,k,j)-ph(i-2,k,j)) & + +8.*(phb(i+1,k,j)-phb(i-1,k,j)) & + -(phb(i+2,k,j)-phb(i-2,k,j)) ) ) + ENDDO + + ENDDO + + ELSE IF (advective_order <= 6) THEN + +! y (v) advection + + i_start = its + j_start = jts + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + +! IF ( (config_flags%open_ys) .and. jts == jds ) j_start = jts+1 +! IF ( (config_flags%open_ye) .and. jte == jde ) jtf = jtf-1 + + IF (config_flags%open_ys .or. specified ) j_start = max(jts,jds+2) + IF (config_flags%open_ye .or. specified ) jtf = min(jtf,jde-3) + + DO j = j_start, jtf + + DO k = 2, kte-1 + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* ( & + ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1) & + +muv(i,j )*(v(i,k,j )+v(i,k-1,j ))*msfvy(i,j ) )* (1./60.)*( & + 45.*(ph(i,k,j+1)-ph(i,k,j-1)) & + -9.*(ph(i,k,j+2)-ph(i,k,j-2)) & + +(ph(i,k,j+3)-ph(i,k,j-3)) & + +45.*(phb(i,k,j+1)-phb(i,k,j-1)) & + -9.*(phb(i,k,j+2)-phb(i,k,j-2)) & + +(phb(i,k,j+3)-phb(i,k,j-3)) ) ) + + + ENDDO + ENDDO + + k = kte + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* ( & + ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) & + +muv(i,j )*(cfn*v(i,k-1,j )+cfn1*v(i,k-2,j ))*msfvy(i,j ) )* (1./60.)*( & + 45.*(ph(i,k,j+1)-ph(i,k,j-1)) & + -9.*(ph(i,k,j+2)-ph(i,k,j-2)) & + +(ph(i,k,j+3)-ph(i,k,j-3)) & + +45.*(phb(i,k,j+1)-phb(i,k,j-1)) & + -9.*(phb(i,k,j+2)-phb(i,k,j-2)) & + +(phb(i,k,j+3)-phb(i,k,j-3)) ) ) + + ENDDO + + ENDDO + + +! pick up near boundary rows using 4th order stencil +! (open bc copy only goes out to jds-1 and jde, hence 4rth is ok but 6th is too big) + + IF ( (config_flags%open_ys) .and. jts <= jds+1 ) THEN + + j = jds+1 + DO k = 2, kte-1 + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* ( & + ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1) & + +muv(i,j )*(v(i,k,j )+v(i,k-1,j ))*msfvy(i,j ) )* (1./12.)*( & + 8.*(ph(i,k,j+1)-ph(i,k,j-1)) & + -(ph(i,k,j+2)-ph(i,k,j-2)) & + +8.*(phb(i,k,j+1)-phb(i,k,j-1)) & + -(phb(i,k,j+2)-phb(i,k,j-2)) ) ) + + + ENDDO + ENDDO + + k = kte + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* ( & + ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) & + +muv(i,j )*(cfn*v(i,k-1,j )+cfn1*v(i,k-2,j ))*msfvy(i,j) )* (1./12.)*( & + 8.*(ph(i,k,j+1)-ph(i,k,j-1)) & + -(ph(i,k,j+2)-ph(i,k,j-2)) & + +8.*(phb(i,k,j+1)-phb(i,k,j-1)) & + -(phb(i,k,j+2)-phb(i,k,j-2)) ) ) + + ENDDO + + END IF + + IF ( (config_flags%open_ye) .and. jte >= jde-2 ) THEN + + j = jde-2 + DO k = 2, kte-1 + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* ( & + ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1) & + +muv(i,j )*(v(i,k,j )+v(i,k-1,j ))*msfvy(i,j) )* (1./12.)*( & + 8.*(ph(i,k,j+1)-ph(i,k,j-1)) & + -(ph(i,k,j+2)-ph(i,k,j-2)) & + +8.*(phb(i,k,j+1)-phb(i,k,j-1)) & + -(phb(i,k,j+2)-phb(i,k,j-2)) ) ) + + + ENDDO + ENDDO + + k = kte + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* ( & + ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) & + +muv(i,j )*(cfn*v(i,k-1,j )+cfn1*v(i,k-2,j ))*msfvy(i,j) )* (1./12.)*( & + 8.*(ph(i,k,j+1)-ph(i,k,j-1)) & + -(ph(i,k,j+2)-ph(i,k,j-2)) & + +8.*(phb(i,k,j+1)-phb(i,k,j-1)) & + -(phb(i,k,j+2)-phb(i,k,j-2)) ) ) + + ENDDO + + END IF + +! x (u) advection + + i_start = its + j_start = jts + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + + IF (config_flags%open_xs .or. specified ) i_start = max(its,ids+2) + IF (config_flags%open_xe .or. specified ) itf = min(itf,ide-3) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) itf=MIN(ite,ide-1) + + DO j = j_start, jtf + + DO k = 2, kte-1 + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*( & + ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j) & + +muu(i,j )*(u(i,k,j )+u(i,k-1,j ))*msfux(i,j) )* (1./60.)*( & + 45.*(ph(i+1,k,j)-ph(i-1,k,j)) & + -9.*(ph(i+2,k,j)-ph(i-2,k,j)) & + +(ph(i+3,k,j)-ph(i-3,k,j)) & + +45.*(phb(i+1,k,j)-phb(i-1,k,j)) & + -9.*(phb(i+2,k,j)-phb(i-2,k,j)) & + +(phb(i+3,k,j)-phb(i-3,k,j)) ) ) + ENDDO + ENDDO + + k = kte + DO i = i_start, itf + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*( & + ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) & + +muu(i,j )*(cfn*u(i ,k-1,j)+cfn1*u(i,k-2,j))*msfux(i,j) )* (1./60.)*( & + 45.*(ph(i+1,k,j)-ph(i-1,k,j)) & + -9.*(ph(i+2,k,j)-ph(i-2,k,j)) & + +(ph(i+3,k,j)-ph(i-3,k,j)) & + +45.*(phb(i+1,k,j)-phb(i-1,k,j)) & + -9.*(phb(i+2,k,j)-phb(i-2,k,j)) & + +(phb(i+3,k,j)-phb(i-3,k,j)) ) ) + ENDDO + + ENDDO + + IF ( (config_flags%open_xs) .and. its <= ids+1 ) THEN + i = ids + 1 + DO j = j_start, jtf + DO k = 2, kte-1 + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*( & + ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j) & + +muu(i,j )*(u(i,k,j )+u(i,k-1,j ))*msfux(i,j) )* (1./12.)*( & + 8.*(ph(i+1,k,j)-ph(i-1,k,j)) & + -(ph(i+2,k,j)-ph(i-2,k,j)) & + +8.*(phb(i+1,k,j)-phb(i-1,k,j)) & + -(phb(i+2,k,j)-phb(i-2,k,j)) ) ) + ENDDO + k = kte + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*( & + ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) & + +muu(i,j )*(cfn*u(i ,k-1,j)+cfn1*u(i,k-2,j))*msfux(i,j) )* (1./12.)*( & + 8.*(ph(i+1,k,j)-ph(i-1,k,j)) & + -(ph(i+2,k,j)-ph(i-2,k,j)) & + +8.*(phb(i+1,k,j)-phb(i-1,k,j)) & + -(phb(i+2,k,j)-phb(i-2,k,j)) ) ) + + ENDDO + END IF + + IF ( (config_flags%open_xe) .and. ite >= ide-2 ) THEN + i = ide-2 + DO j = j_start, jtf + DO k = 2, kte-1 + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*( & + ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j) & + +muu(i,j )*(u(i,k,j )+u(i,k-1,j ))*msfux(i,j) )* (1./12.)*( & + 8.*(ph(i+1,k,j)-ph(i-1,k,j)) & + -(ph(i+2,k,j)-ph(i-2,k,j)) & + +8.*(phb(i+1,k,j)-phb(i-1,k,j)) & + -(phb(i+2,k,j)-phb(i-2,k,j)) ) ) + ENDDO + k = kte + ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*( & + ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) & + +muu(i,j )*(cfn*u(i ,k-1,j)+cfn1*u(i,k-2,j))*msfux(i,j) )* (1./12.)*( & + 8.*(ph(i+1,k,j)-ph(i-1,k,j)) & + -(ph(i+2,k,j)-ph(i-2,k,j)) & + +8.*(phb(i+1,k,j)-phb(i-1,k,j)) & + -(phb(i+2,k,j)-phb(i-2,k,j)) ) ) + + ENDDO + END IF + + END IF + +! lateral open boundary conditions, +! start with north and south (y) boundaries + + i_start = its + itf=MIN(ite,ide-1) + + ! south + + IF ( (config_flags%open_ys) .and. jts == jds ) THEN + + j=jts + + DO k=2,kde + kz = min(k,kde-1) + DO i = its,itf + vb =.5*( fnm(kz)*(v(i,kz ,j+1)+v(i,kz ,j )) & + +fnp(kz)*(v(i,kz-1,j+1)+v(i,kz-1,j )) ) + vl=amin1(vb,0.) + ph_tend(i,k,j)=ph_tend(i,k,j)-rdy*mut(i,j)*( & + +vl*(ph_old(i,k,j+1)-ph_old(i,k,j))) + ENDDO + ENDDO + + END IF + + ! north + + IF ( (config_flags%open_ye) .and. jte == jde ) THEN + + j=jte-1 + + DO k=2,kde + kz = min(k,kde-1) + DO i = its,itf + vb=.5*( fnm(kz)*(v(i,kz ,j+1)+v(i,kz ,j)) & + +fnp(kz)*(v(i,kz-1,j+1)+v(i,kz-1,j)) ) + vr=amax1(vb,0.) + ph_tend(i,k,j)=ph_tend(i,k,j)-rdy*mut(i,j)*( & + +vr*(ph_old(i,k,j)-ph_old(i,k,j-1))) + ENDDO + ENDDO + + END IF + + ! now the east and west (y) boundaries + + j_start = its + jtf=MIN(jte,jde-1) + + ! west + + IF ( (config_flags%open_xs) .and. its == ids ) THEN + + i=its + + DO j = jts,jtf + DO k=2,kde-1 + kz = k + ub =.5*( fnm(kz)*(u(i+1,kz ,j)+u(i ,kz ,j)) & + +fnp(kz)*(u(i+1,kz-1,j)+u(i ,kz-1,j)) ) + ul=amin1(ub,0.) + ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*( & + +ul*(ph_old(i+1,k,j)-ph_old(i,k,j))) + ENDDO + + k = kde + kz = k + ub =.5*( fnm(kz)*(u(i+1,kz ,j)+u(i ,kz ,j)) & + +fnp(kz)*(u(i+1,kz-1,j)+u(i ,kz-1,j)) ) + ul=amin1(ub,0.) + ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*( & + +ul*(ph_old(i+1,k,j)-ph_old(i,k,j))) + ENDDO + + END IF + + ! east + + IF ( (config_flags%open_xe) .and. ite == ide ) THEN + + i = ite-1 + + DO j = jts,jtf + DO k=2,kde-1 + kz = k + ub=.5*( fnm(kz)*(u(i+1,kz ,j)+u(i,kz ,j)) & + +fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)) ) + ur=amax1(ub,0.) + ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*( & + +ur*(ph_old(i,k,j)-ph_old(i-1,k,j))) + ENDDO + + k = kde + kz = k-1 + ub=.5*( fnm(kz)*(u(i+1,kz ,j)+u(i,kz ,j)) & + +fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)) ) + ur=amax1(ub,0.) + ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*( & + +ur*(ph_old(i,k,j)-ph_old(i-1,k,j))) + + ENDDO + + END IF + + END SUBROUTINE rhs_ph + + +!------------------------------------------------------------------------------- + +SUBROUTINE horizontal_pressure_gradient( ru_tend,rv_tend, & + ph,alt,p,pb,al,php,cqu,cqv, & + muu,muv,mu,fnm,fnp,rdnw, & + cf1,cf2,cf3,rdx,rdy,msfux,msfuy,& + msfvx,msfvy,msftx,msfty, & + config_flags, non_hydrostatic, & + top_lid, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + LOGICAL, INTENT (IN ) :: non_hydrostatic, top_lid + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN ) :: & + ph, & + alt, & + al, & + p, & + pb, & + php, & + cqu, & + cqv + + + REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) :: & + ru_tend, & + rv_tend + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: muu, muv, mu, & + msfux, msfuy, & + msfvx, msfvy, & + msftx, msfty + + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: rdnw, fnm, fnp + + REAL, INTENT(IN ) :: rdx, rdy, cf1, cf2, cf3 + + INTEGER :: i,j,k, itf, jtf, ktf, i_start, j_start + REAL, DIMENSION( ims:ime, kms:kme ) :: dpn + REAL :: dpx, dpy + + LOGICAL :: specified + +! +! +! horizontal_pressure_gradient calculates the +! horizontal pressure gradient terms for the large-timestep tendency +! in the horizontal momentum equations (u,v). +! +! + + specified = .false. + if(config_flags%specified .or. config_flags%nested) specified = .true. + +! Notes on map scale factors: +! Calculates the pressure gradient terms in ADT eqns 44 and 45 +! With upper rho -> 'mu', these are: +! Eqn 30: -mu*(mx/my)*(1/rho)*partial dp/dx +! Eqn 31: -mu*(my/mx)*(1/rho)*partial dp/dy +! +! As we are on nu, rather than height, surfaces: +! +! mu dp/dx = mu alpha partial dp'/dx + (nu mu partial dmubar/dx) alpha' +! + mu partial dphi'/dx + (partial dphi/dx)*(partial dp'/dnu - mu') +! +! mu dp/dy = mu alpha partial dp'/dy + (nu mu partial dmubar/dy) alpha' +! + mu partial dphi'/dy + (partial dphi/dy)*(partial dp'/dnu - mu') + +! start with the north-south (y) pressure gradient + + itf=MIN(ite,ide-1) + jtf=jte + ktf=MIN(kte,kde-1) + i_start = its + j_start = jts + IF ( (config_flags%open_ys .or. specified .or. & + config_flags%nested .or. config_flags%polar ) .and. jts == jds ) j_start = jts+1 + IF ( (config_flags%open_ye .or. specified .or. & + config_flags%nested .or. config_flags%polar ) .and. jte == jde ) jtf = jtf-1 + + DO j = j_start, jtf + + IF ( non_hydrostatic ) THEN + + k=1 + + DO i = i_start, itf + dpn(i,k) = .5*( cf1*(p(i,k ,j-1)+p(i,k ,j)) & + +cf2*(p(i,k+1,j-1)+p(i,k+1,j)) & + +cf3*(p(i,k+2,j-1)+p(i,k+2,j)) ) + dpn(i,kde) = 0. + ENDDO + IF (top_lid) THEN + DO i = i_start, itf + dpn(i,kde) = .5*( cf1*(p(i,kde-1,j-1)+p(i,kde-1,j)) & + +cf2*(p(i,kde-2,j-1)+p(i,kde-2,j)) & + +cf3*(p(i,kde-3,j-1)+p(i,kde-3,j)) ) + ENDDO + ENDIF + + DO k=2,ktf + DO i = i_start, itf + dpn(i,k) = .5*( fnm(k)*(p(i,k ,j-1)+p(i,k ,j)) & + +fnp(k)*(p(i,k-1,j-1)+p(i,k-1,j)) ) + END DO + END DO + +! ADT eqn 45: -mu*(my/mx)*(1/rho)*partial dp/dy +! [alt, al are 1/rho terms; muv, mu are NOT coupled] + DO K=1,ktf + DO i = i_start, itf + ! Here are mu dp/dy terms 1-3 + dpy = (msfvy(i,j)/msfvx(i,j))*.5*rdy*muv(i,j)*( & + (ph (i,k+1,j)-ph (i,k+1,j-1) + ph(i,k,j)-ph(i,k,j-1)) & + +(alt(i,k ,j)+alt(i,k ,j-1))*(p (i,k,j)-p (i,k,j-1)) & + +(al (i,k ,j)+al (i,k ,j-1))*(pb(i,k,j)-pb(i,k,j-1)) ) + ! Here is mu dp/dy term 4 + dpy = dpy + (msfvy(i,j)/msfvx(i,j))*rdy*(php(i,k,j)-php(i,k,j-1))* & + (rdnw(k)*(dpn(i,k+1)-dpn(i,k))-.5*(mu(i,j-1)+mu(i,j))) + rv_tend(i,k,j) = rv_tend(i,k,j)-cqv(i,k,j)*dpy + END DO + END DO + + ELSE + +! ADT eqn 45: -mu*(my/mx)*(1/rho)*partial dp/dy +! [alt, al are 1/rho terms; muv, mu are NOT coupled] + DO K=1,ktf + DO i = i_start, itf + ! Here are mu dp/dy terms 1-3; term 4 not needed if hydrostatic + dpy = (msfvy(i,j)/msfvx(i,j))*.5*rdy*muv(i,j)*( & + (ph (i,k+1,j)-ph (i,k+1,j-1) + ph(i,k,j)-ph(i,k,j-1)) & + +(alt(i,k ,j)+alt(i,k ,j-1))*(p (i,k,j)-p (i,k,j-1)) & + +(al (i,k ,j)+al (i,k ,j-1))*(pb(i,k,j)-pb(i,k,j-1)) ) + rv_tend(i,k,j) = rv_tend(i,k,j)-cqv(i,k,j)*dpy + END DO + END DO + + END IF + + ENDDO + +! now the east-west (x) pressure gradient + + itf=ite + jtf=MIN(jte,jde-1) + ktf=MIN(kte,kde-1) + i_start = its + j_start = jts + IF ( (config_flags%open_xs .or. specified .or. & + config_flags%nested ) .and. its == ids ) i_start = its+1 + IF ( (config_flags%open_xe .or. specified .or. & + config_flags%nested ) .and. ite == ide ) itf = itf-1 + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) itf=ite + + DO j = j_start, jtf + + IF ( non_hydrostatic ) THEN + + k=1 + + DO i = i_start, itf + dpn(i,k) = .5*( cf1*(p(i-1,k ,j)+p(i,k ,j)) & + +cf2*(p(i-1,k+1,j)+p(i,k+1,j)) & + +cf3*(p(i-1,k+2,j)+p(i,k+2,j)) ) + dpn(i,kde) = 0. + ENDDO + IF (top_lid) THEN + DO i = i_start, itf + dpn(i,kde) = .5*( cf1*(p(i-1,kde-1,j)+p(i,kde-1,j)) & + +cf2*(p(i-1,kde-2,j)+p(i,kde-2,j)) & + +cf3*(p(i-1,kde-3,j)+p(i,kde-3,j)) ) + ENDDO + ENDIF + + DO k=2,ktf + DO i = i_start, itf + dpn(i,k) = .5*( fnm(k)*(p(i-1,k ,j)+p(i,k ,j)) & + +fnp(k)*(p(i-1,k-1,j)+p(i,k-1,j)) ) + END DO + END DO + +! ADT eqn 44: -mu*(mx/my)*(1/rho)*partial dp/dx +! [alt, al are 1/rho terms; muu, mu are NOT coupled] + DO K=1,ktf + DO i = i_start, itf + ! Here are mu dp/dy terms 1-3 + dpx = (msfux(i,j)/msfuy(i,j))*.5*rdx*muu(i,j)*( & + (ph (i,k+1,j)-ph (i-1,k+1,j) + ph(i,k,j)-ph(i-1,k,j)) & + +(alt(i,k ,j)+alt(i-1,k ,j))*(p (i,k,j)-p (i-1,k,j)) & + +(al (i,k ,j)+al (i-1,k ,j))*(pb(i,k,j)-pb(i-1,k,j)) ) + ! Here is mu dp/dy term 4 + dpx = dpx + (msfux(i,j)/msfuy(i,j))*rdx*(php(i,k,j)-php(i-1,k,j))* & + (rdnw(k)*(dpn(i,k+1)-dpn(i,k))-.5*(mu(i-1,j)+mu(i,j))) + ru_tend(i,k,j) = ru_tend(i,k,j)-cqu(i,k,j)*dpx + END DO + END DO + + ELSE + +! ADT eqn 44: -mu*(mx/my)*(1/rho)*partial dp/dx +! [alt, al are 1/rho terms; muu, mu are NOT coupled] + DO K=1,ktf + DO i = i_start, itf + ! Here are mu dp/dy terms 1-3; term 4 not needed if hydrostatic + dpx = (msfux(i,j)/msfuy(i,j))*.5*rdx*muu(i,j)*( & + (ph (i,k+1,j)-ph (i-1,k+1,j) + ph(i,k,j)-ph(i-1,k,j)) & + +(alt(i,k ,j)+alt(i-1,k ,j))*(p (i,k,j)-p (i-1,k,j)) & + +(al (i,k ,j)+al (i-1,k ,j))*(pb(i,k,j)-pb(i-1,k,j)) ) + ru_tend(i,k,j) = ru_tend(i,k,j)-cqu(i,k,j)*dpx + END DO + END DO + + END IF + + ENDDO + +END SUBROUTINE horizontal_pressure_gradient + +!------------------------------------------------------------------------------- + +SUBROUTINE pg_buoy_w( rw_tend, p, cqw, mu, mub, & + rdnw, rdn, g, msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN ) :: p + REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) :: cqw + + + REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) :: rw_tend + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: mub, mu, msftx, msfty + + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: rdnw, rdn + + REAL, INTENT(IN ) :: g + + INTEGER :: itf, jtf, i, j, k + REAL :: cq1, cq2 + + +! +! +! pg_buoy_w calculates the +! vertical pressure gradient and buoyancy terms for the large-timestep +! tendency in the vertical momentum equation. +! +! + +! BUOYANCY AND PRESSURE GRADIENT TERM IN W EQUATION AT TIME T + +! Map scale factor notes +! ADT eqn 46 RHS terms 6 and 7 (where 7 is "-rho g") +! Dividing by my, and using mu and nu (see Klemp et al. eqns 32, 40) +! term 6: +(g/my) partial dp'/dnu +! term 7: -(g/my) mu' +! +! For moisture-free atmosphere, cq1=1, cq2=0 +! => (1./msft(i,j)) * g * [rdn(k)*{p(i,k,j)-p(i,k-1,j)}-mu(i,j)] + + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + + DO j = jts,jtf + + k=kde + DO i=its,itf + cq1 = 1./(1.+cqw(i,k-1,j)) + cq2 = cqw(i,k-1,j)*cq1 + rw_tend(i,k,j) = rw_tend(i,k,j)+(1./msfty(i,j))*g*( & + cq1*2.*rdnw(k-1)*( -p(i,k-1,j)) & + -mu(i,j)-cq2*mub(i,j) ) + END DO + + DO k = 2, kde-1 + DO i = its,itf + cq1 = 1./(1.+cqw(i,k,j)) + cq2 = cqw(i,k,j)*cq1 + cqw(i,k,j) = cq1 + rw_tend(i,k,j) = rw_tend(i,k,j)+(1./msfty(i,j))*g*( & + cq1*rdn(k)*(p(i,k,j)-p(i,k-1,j)) & + -mu(i,j)-cq2*mub(i,j) ) + END DO + ENDDO + + + ENDDO + +END SUBROUTINE pg_buoy_w + +!------------------------------------------------------------------------------- + +SUBROUTINE w_damp( rw_tend, max_vert_cfl,max_horiz_cfl, & + u, v, ww, w, mut, rdnw, & + rdx, rdy, msfux, msfuy, & + msfvx, msfvy, dt, & + config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + USE module_llxy + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN ) :: u, v, ww, w + + REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) :: rw_tend + + REAL, INTENT(OUT) :: max_vert_cfl + REAL, INTENT(OUT) :: max_horiz_cfl + REAL :: horiz_cfl + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: mut + + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: rdnw + + REAL, INTENT(IN) :: dt + REAL, INTENT(IN) :: rdx, rdy + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, msfuy + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfvx, msfvy + + REAL :: vert_cfl, cf_n, cf_d, maxdub, maxdeta + + INTEGER :: itf, jtf, i, j, k, maxi, maxj, maxk + INTEGER :: some + CHARACTER*512 :: temp + + CHARACTER (LEN=256) :: time_str + CHARACTER (LEN=256) :: grid_str + + integer :: total + REAL :: msfuxt , msfxffl + +! +! +! w_damp computes a damping term for the vertical velocity when the +! vertical Courant number is too large. This was found to be preferable to +! decreasing the timestep or increasing the diffusion in real-data applications +! that produced potentially-unstable large vertical velocities because of +! unphysically large heating rates coming from the cumulus parameterization +! schemes run at moderately high resolutions (dx ~ O(10) km). +! +! Additionally, w_damp returns the maximum cfl values due to vertical motion and +! horizontal motion. These values are returned via the max_vert_cfl and +! max_horiz_cfl variables. (Added by T. Hutchinson, WSI, 3/5/2007) +! +! + + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + + some = 0 + max_vert_cfl = 0. + max_horiz_cfl = 0. + total = 0 + + IF(config_flags%map_proj == PROJ_CASSINI ) then + msfxffl = 1.0/COS(config_flags%fft_filter_lat*degrad) + END IF + + IF ( config_flags%w_damping == 1 ) THEN + DO j = jts,jtf + + DO k = 2, kde-1 + DO i = its,itf +#if 1 + IF(config_flags%map_proj == PROJ_CASSINI ) then + msfuxt = MIN(msfux(i,j), msfxffl) + ELSE + msfuxt = msfux(i,j) + END IF + vert_cfl = abs(ww(i,k,j)/mut(i,j)*rdnw(k)*dt) + + IF ( vert_cfl > max_vert_cfl ) THEN + max_vert_cfl = vert_cfl ; maxi = i ; maxj = j ; maxk = k + maxdub = w(i,k,j) ; maxdeta = -1./rdnw(k) + ENDIF + + horiz_cfl = max( abs(u(i,k,j) * rdx * msfuxt * dt), & + abs(v(i,k,j) * rdy * msfvy(i,j) * dt) ) + if (horiz_cfl > max_horiz_cfl) then + max_horiz_cfl = horiz_cfl + endif + + if(vert_cfl .gt. w_beta)then +#else +! restructure to get rid of divide +! +! This had been used for efficiency, but with the addition of returning the cfl values, +! the old version (above) was reinstated. (T. Hutchinson, 3/5/2007) +! + cf_n = abs(ww(i,k,j)*rdnw(k)*dt) + cf_d = abs(mut(i,j)) + if(cf_n .gt. cf_d*w_beta )then +#endif + + WRITE(temp,*)i,j,k,' vert_cfl,w,d(eta)=',vert_cfl,w(i,k,j),-1./rdnw(k) + CALL wrf_debug ( 100 , TRIM(temp) ) + if ( vert_cfl > 2. ) some = some + 1 + rw_tend(i,k,j) = rw_tend(i,k,j)-sign(1.,w(i,k,j))*w_alpha*(vert_cfl-w_beta)*mut(i,j) + endif + END DO + ENDDO + ENDDO + ELSE +! just print + DO j = jts,jtf + + DO k = 2, kde-1 + DO i = its,itf + +#if 1 + IF(config_flags%map_proj == PROJ_CASSINI ) then + msfuxt = MIN(msfux(i,j), msfxffl) + ELSE + msfuxt = msfux(i,j) + END IF + vert_cfl = abs(ww(i,k,j)/mut(i,j)*rdnw(k)*dt) + + IF ( vert_cfl > max_vert_cfl ) THEN + max_vert_cfl = vert_cfl ; maxi = i ; maxj = j ; maxk = k + maxdub = w(i,k,j) ; maxdeta = -1./rdnw(k) + ENDIF + + horiz_cfl = max( abs(u(i,k,j) * rdx * msfuxt * dt), & + abs(v(i,k,j) * rdy * msfvy(i,j) * dt) ) + + if (horiz_cfl > max_horiz_cfl) then + max_horiz_cfl = horiz_cfl + endif + + if(vert_cfl .gt. w_beta)then +#else +! restructure to get rid of divide +! +! This had been used for efficiency, but with the addition of returning the cfl values, +! the old version (above) was reinstated. (T. Hutchinson, 3/5/2007) +! + cf_n = abs(ww(i,k,j)*rdnw(k)*dt) + cf_d = abs(mut(i,j)) + if(cf_n .gt. cf_d*w_beta )then +#endif + WRITE(temp,*)i,j,k,' vert_cfl,w,d(eta)=',vert_cfl,w(i,k,j),-1./rdnw(k) + CALL wrf_debug ( 100 , TRIM(temp) ) + if ( vert_cfl > 2. ) some = some + 1 + endif + END DO + ENDDO + ENDDO + ENDIF + IF ( some .GT. 0 ) THEN + CALL get_current_time_string( time_str ) + CALL get_current_grid_name( grid_str ) + WRITE(wrf_err_message,*)some, & + ' points exceeded cfl=2 in domain '//TRIM(grid_str)//' at time '//TRIM(time_str)//' hours' + CALL wrf_debug ( 0 , TRIM(wrf_err_message) ) + WRITE(wrf_err_message,*)'MAX AT i,j,k: ',maxi,maxj,maxk,' vert_cfl,w,d(eta)=',max_vert_cfl, & + maxdub,maxdeta + CALL wrf_debug ( 0 , TRIM(wrf_err_message) ) + ENDIF + +END SUBROUTINE w_damp + +!------------------------------------------------------------------------------- + +SUBROUTINE horizontal_diffusion ( name, field, tendency, mu, & + config_flags, & + msfux, msfuy, msfvx, msfvx_inv, & + msfvy, msftx, msfty, & + khdif, xkmhd, rdx, rdy, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + CHARACTER(LEN=1) , INTENT(IN ) :: name + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: field, xkmhd + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & + msfuy, & + msfvx, & + msfvx_inv, & + msfvy, & + msftx, & + msfty + + REAL , INTENT(IN ) :: rdx, & + rdy, & + khdif + + ! Local data + + INTEGER :: i, j, k, itf, jtf, ktf + + INTEGER :: i_start, i_end, j_start, j_end + + REAL :: mrdx, mkrdxm, mkrdxp, & + mrdy, mkrdym, mkrdyp + + LOGICAL :: specified + +! +! +! horizontal_diffusion computes the horizontal diffusion tendency +! on model horizontal coordinate surfaces. +! +! + + specified = .false. + if(config_flags%specified .or. config_flags%nested) specified = .true. + + ktf=MIN(kte,kde-1) + + IF (name .EQ. 'u') THEN + + i_start = its + i_end = ite + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-1,ite) + IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. specified ) j_end = MIN(jde-2,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = ite + + + DO j = j_start, j_end + DO k=kts,ktf + DO i = i_start, i_end + + ! The interior is grad: (m_x*d/dx), the exterior is div: (m_x*m_y*d/dx(/m_y)) + ! setting up different averagings of m^2 partial d/dX and m^2 partial d/dY + + mkrdxm=(msftx(i-1,j)/msfty(i-1,j))*mu(i-1,j)*xkmhd(i-1,k,j)*rdx + mkrdxp=(msftx(i,j)/msfty(i,j))*mu(i,j)*xkmhd(i,k,j)*rdx + mrdx=msfux(i,j)*msfuy(i,j)*rdx + mkrdym=( (msfuy(i,j)+msfuy(i,j-1))/(msfux(i,j)+msfux(i,j-1)) )* & + 0.25*(mu(i,j)+mu(i,j-1)+mu(i-1,j-1)+mu(i-1,j))* & + 0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i-1,k,j-1)+xkmhd(i-1,k,j))*rdy + mkrdyp=( (msfuy(i,j)+msfuy(i,j+1))/(msfux(i,j)+msfux(i,j+1)) )* & + 0.25*(mu(i,j)+mu(i,j+1)+mu(i-1,j+1)+mu(i-1,j))* & + 0.25*(xkmhd(i,k,j)+xkmhd(i,k,j+1)+xkmhd(i-1,k,j+1)+xkmhd(i-1,k,j))*rdy + ! need to do four-corners (t) for diffusion coefficient as there are + ! no values at u,v points + ! msfuy - has to be y as part of d/dY + ! has to be u as we're at a u point + mrdy=msfux(i,j)*msfuy(i,j)*rdy + + ! correctly averaged version of rho~ * m^2 * + ! [partial d/dX(partial du^/dX) + partial d/dY(partial du^/dY)] + tendency(i,k,j)=tendency(i,k,j)+( & + mrdx*(mkrdxp*(field(i+1,k,j)-field(i ,k,j)) & + -mkrdxm*(field(i ,k,j)-field(i-1,k,j))) & + +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j )) & + -mkrdym*(field(i,k,j )-field(i,k,j-1)))) + ENDDO + ENDDO + ENDDO + + ELSE IF (name .EQ. 'v')THEN + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = jte + + IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-2,ite) + IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. specified ) j_end = MIN(jde-1,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) + IF ( config_flags%polar ) j_start = MAX(jds+1,jts) + IF ( config_flags%polar ) j_end = MIN(jde-1,jte) + + DO j = j_start, j_end + DO k=kts,ktf + DO i = i_start, i_end + + mkrdxm=( (msfvx(i,j)+msfvx(i-1,j))/(msfvy(i,j)+msfvy(i-1,j)) )* & + 0.25*(mu(i,j)+mu(i,j-1)+mu(i-1,j-1)+mu(i-1,j))* & + 0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i-1,k,j-1)+xkmhd(i-1,k,j))*rdx + mkrdxp=( (msfvx(i,j)+msfvx(i+1,j))/(msfvy(i,j)+msfvy(i+1,j)) )* & + 0.25*(mu(i,j)+mu(i,j-1)+mu(i+1,j-1)+mu(i+1,j))* & + 0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i+1,k,j-1)+xkmhd(i+1,k,j))*rdx + mrdx=msfvx(i,j)*msfvy(i,j)*rdx + mkrdym=(msfty(i,j-1)/msftx(i,j-1))*xkmhd(i,k,j-1)*rdy + mkrdyp=(msfty(i,j)/msftx(i,j))*xkmhd(i,k,j)*rdy + mrdy=msfvx(i,j)*msfvy(i,j)*rdy + + tendency(i,k,j)=tendency(i,k,j)+( & + mrdx*(mkrdxp*(field(i+1,k,j)-field(i ,k,j)) & + -mkrdxm*(field(i ,k,j)-field(i-1,k,j))) & + +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j )) & + -mkrdym*(field(i,k,j )-field(i,k,j-1)))) + ENDDO + ENDDO + ENDDO + + ELSE IF (name .EQ. 'w')THEN + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-2,ite) + IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. specified ) j_end = MIN(jde-2,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) + + DO j = j_start, j_end + DO k=kts+1,ktf + DO i = i_start, i_end + + mkrdxm=(msfux(i,j)/msfuy(i,j))* & + 0.25*(mu(i,j)+mu(i-1,j)+mu(i,j)+mu(i-1,j))* & + 0.25*(xkmhd(i,k,j)+xkmhd(i-1,k,j)+xkmhd(i,k-1,j)+xkmhd(i-1,k-1,j))*rdx + mkrdxp=(msfux(i+1,j)/msfuy(i+1,j))* & + 0.25*(mu(i+1,j)+mu(i,j)+mu(i+1,j)+mu(i,j))* & + 0.25*(xkmhd(i+1,k,j)+xkmhd(i,k,j)+xkmhd(i+1,k-1,j)+xkmhd(i,k-1,j))*rdx + mrdx=msftx(i,j)*msfty(i,j)*rdx +! mkrdym=(msfvy(i,j)/msfvx(i,j))* & + mkrdym=(msfvy(i,j)*msfvx_inv(i,j))* & + 0.25*(mu(i,j)+mu(i,j-1)+mu(i,j)+mu(i,j-1))* & + 0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i,k-1,j)+xkmhd(i,k-1,j-1))*rdy +! mkrdyp=(msfvy(i,j+1)/msfvx(i,j+1))* & + mkrdyp=(msfvy(i,j+1)*msfvx_inv(i,j+1))* & + 0.25*(mu(i,j+1)+mu(i,j)+mu(i,j+1)+mu(i,j))* & + 0.25*(xkmhd(i,k,j+1)+xkmhd(i,k,j)+xkmhd(i,k-1,j+1)+xkmhd(i,k-1,j))*rdy + mrdy=msftx(i,j)*msfty(i,j)*rdy + + tendency(i,k,j)=tendency(i,k,j)+( & + mrdx*(mkrdxp*(field(i+1,k,j)-field(i ,k,j)) & + -mkrdxm*(field(i ,k,j)-field(i-1,k,j))) & + +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j )) & + -mkrdym*(field(i,k,j )-field(i,k,j-1)))) + ENDDO + ENDDO + ENDDO + + ELSE + + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-2,ite) + IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. specified ) j_end = MIN(jde-2,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) + + DO j = j_start, j_end + DO k=kts,ktf + DO i = i_start, i_end + + mkrdxm=(msfux(i,j)/msfuy(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*0.5*(mu(i,j)+mu(i-1,j))*rdx + mkrdxp=(msfux(i+1,j)/msfuy(i+1,j))*0.5*(xkmhd(i+1,k,j)+xkmhd(i,k,j))*0.5*(mu(i+1,j)+mu(i,j))*rdx + mrdx=msftx(i,j)*msfty(i,j)*rdx +! mkrdym=(msfvy(i,j)/msfvx(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy + mkrdym=(msfvy(i,j)*msfvx_inv(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy +! mkrdyp=(msfvy(i,j+1)/msfvx(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy + mkrdyp=(msfvy(i,j+1)*msfvx_inv(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy + mrdy=msftx(i,j)*msfty(i,j)*rdy + + tendency(i,k,j)=tendency(i,k,j)+( & + mrdx*(mkrdxp*(field(i+1,k,j)-field(i ,k,j)) & + -mkrdxm*(field(i ,k,j)-field(i-1,k,j))) & + +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j )) & + -mkrdym*(field(i,k,j )-field(i,k,j-1)))) + ENDDO + ENDDO + ENDDO + + ENDIF + +END SUBROUTINE horizontal_diffusion + +!----------------------------------------------------------------------------------------- + +SUBROUTINE horizontal_diffusion_3dmp ( name, field, tendency, mu, & + config_flags, base_3d, & + msfux, msfuy, msfvx, msfvx_inv, & + msfvy, msftx, msfty, & + khdif, xkmhd, rdx, rdy, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + CHARACTER(LEN=1) , INTENT(IN ) :: name + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: field, & + xkmhd, & + base_3d + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & + msfuy, & + msfvx, & + msfvx_inv, & + msfvy, & + msftx, & + msfty + + REAL , INTENT(IN ) :: rdx, & + rdy, & + khdif + + ! Local data + + INTEGER :: i, j, k, itf, jtf, ktf + + INTEGER :: i_start, i_end, j_start, j_end + + REAL :: mrdx, mkrdxm, mkrdxp, & + mrdy, mkrdym, mkrdyp + + LOGICAL :: specified + +! +! +! horizontal_diffusion_3dmp computes the horizontal diffusion tendency +! on model horizontal coordinate surfaces. This routine computes diffusion +! a perturbation scalar (field-base_3d). +! +! + + specified = .false. + if(config_flags%specified .or. config_flags%nested) specified = .true. + + ktf=MIN(kte,kde-1) + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-2,ite) + IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. specified ) j_end = MIN(jde-2,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) + + DO j = j_start, j_end + DO k=kts,ktf + DO i = i_start, i_end + + mkrdxm=(msfux(i,j)/msfuy(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*0.5*(mu(i,j)+mu(i-1,j))*rdx + mkrdxp=(msfux(i+1,j)/msfuy(i+1,j))*0.5*(xkmhd(i+1,k,j)+xkmhd(i,k,j))*0.5*(mu(i+1,j)+mu(i,j))*rdx + mrdx=msftx(i,j)*msfty(i,j)*rdx +! mkrdym=(msfvy(i,j)/msfvx(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy +! mkrdyp=(msfvy(i,j+1)/msfvx(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy + mkrdym=(msfvy(i,j)*msfvx_inv(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy + mkrdyp=(msfvy(i,j+1)*msfvx_inv(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy + mrdy=msftx(i,j)*msfty(i,j)*rdy + + tendency(i,k,j)=tendency(i,k,j)+( & + mrdx*( mkrdxp*( field(i+1,k,j) -field(i ,k,j) & + -base_3d(i+1,k,j)+base_3d(i ,k,j) ) & + -mkrdxm*( field(i ,k,j) -field(i-1,k,j) & + -base_3d(i ,k,j)+base_3d(i-1,k,j) ) ) & + +mrdy*( mkrdyp*( field(i,k,j+1) -field(i,k,j ) & + -base_3d(i,k,j+1)+base_3d(i,k,j ) ) & + -mkrdym*( field(i,k,j ) -field(i,k,j-1) & + -base_3d(i,k,j )+base_3d(i,k,j-1) ) ) & + ) + ENDDO + ENDDO + ENDDO + +END SUBROUTINE horizontal_diffusion_3dmp + +!----------------------------------------------------------------------------------------- + +SUBROUTINE vertical_diffusion ( name, field, tendency, & + config_flags, & + alt, mut, rdn, rdnw, kvdif, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + CHARACTER(LEN=1) , INTENT(IN ) :: name + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & + INTENT(IN ) :: field, & + alt + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, rdnw + + REAL , INTENT(IN ) :: kvdif + + ! Local data + + INTEGER :: i, j, k, itf, jtf, ktf + INTEGER :: i_start, i_end, j_start, j_end + + REAL , DIMENSION(its:ite, jts:jte) :: vfluxm, vfluxp, zz + REAL , DIMENSION(its:ite, 0:kte+1) :: vflux + + REAL :: rdz + + LOGICAL :: specified + +! +! +! vertical_diffusion +! computes vertical diffusion tendency. +! +! + + specified = .false. + if(config_flags%specified .or. config_flags%nested) specified = .true. + + ktf=MIN(kte,kde-1) + + IF (name .EQ. 'w')THEN + + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + +j_loop_w : DO j = j_start, j_end + + DO k=kts,ktf-1 + DO i = i_start, i_end + vflux(i,k)= (kvdif/alt(i,k,j))*rdnw(k)*(field(i,k+1,j)-field(i,k,j)) + ENDDO + ENDDO + + DO i = i_start, i_end + vflux(i,ktf)=0. + ENDDO + + DO k=kts+1,ktf + DO i = i_start, i_end + tendency(i,k,j)=tendency(i,k,j) & + +rdn(k)*g*g/mut(i,j)/(0.5*(alt(i,k,j)+alt(i,k-1,j))) & + *(vflux(i,k)-vflux(i,k-1)) + ENDDO + ENDDO + + ENDDO j_loop_w + + ELSE IF(name .EQ. 'm')THEN + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + +j_loop_s : DO j = j_start, j_end + + DO k=kts,ktf-1 + DO i = i_start, i_end + vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))) & + *(field(i,k+1,j)-field(i,k,j)) + ENDDO + ENDDO + + DO i = i_start, i_end + vflux(i,0)=vflux(i,1) + ENDDO + + DO i = i_start, i_end + vflux(i,ktf)=0. + ENDDO + + DO k=kts,ktf + DO i = i_start, i_end + tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j) & + *rdnw(k)*(vflux(i,k)-vflux(i,k-1)) + ENDDO + ENDDO + + ENDDO j_loop_s + + ENDIF + +END SUBROUTINE vertical_diffusion + + +!------------------------------------------------------------------------------- + +SUBROUTINE vertical_diffusion_mp ( field, tendency, config_flags, & + base, & + alt, mut, rdn, rdnw, kvdif, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & + INTENT(IN ) :: field, & + alt + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, & + rdnw, & + base + + REAL , INTENT(IN ) :: kvdif + + ! Local data + + INTEGER :: i, j, k, itf, jtf, ktf + INTEGER :: i_start, i_end, j_start, j_end + + REAL , DIMENSION(its:ite, 0:kte+1) :: vflux + + REAL :: rdz + + LOGICAL :: specified + +! +! +! vertical_diffusion_mp +! computes vertical diffusion tendency of a perturbation variable +! (field-base). Note that base as a 1D (k) field. +! +! + + specified = .false. + if(config_flags%specified .or. config_flags%nested) specified = .true. + + ktf=MIN(kte,kde-1) + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + +j_loop_s : DO j = j_start, j_end + + DO k=kts,ktf-1 + DO i = i_start, i_end + vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))) & + *(field(i,k+1,j)-field(i,k,j)-base(k+1)+base(k)) + ENDDO + ENDDO + + DO i = i_start, i_end + vflux(i,0)=vflux(i,1) + ENDDO + + DO i = i_start, i_end + vflux(i,ktf)=0. + ENDDO + + DO k=kts,ktf + DO i = i_start, i_end + tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j) & + *rdnw(k)*(vflux(i,k)-vflux(i,k-1)) + ENDDO + ENDDO + + ENDDO j_loop_s + +END SUBROUTINE vertical_diffusion_mp + + +!------------------------------------------------------------------------------- + +SUBROUTINE vertical_diffusion_3dmp ( field, tendency, config_flags, & + base_3d, & + alt, mut, rdn, rdnw, kvdif, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & + INTENT(IN ) :: field, & + alt, & + base_3d + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, & + rdnw + + REAL , INTENT(IN ) :: kvdif + + ! Local data + + INTEGER :: i, j, k, itf, jtf, ktf + INTEGER :: i_start, i_end, j_start, j_end + + REAL , DIMENSION(its:ite, 0:kte+1) :: vflux + + REAL :: rdz + + LOGICAL :: specified + +! +! +! vertical_diffusion_3dmp +! computes vertical diffusion tendency of a perturbation variable +! (field-base_3d). +! +! + + specified = .false. + if(config_flags%specified .or. config_flags%nested) specified = .true. + + ktf=MIN(kte,kde-1) + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + +j_loop_s : DO j = j_start, j_end + + DO k=kts,ktf-1 + DO i = i_start, i_end + vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))) & + *( field(i,k+1,j) -field(i,k,j) & + -base_3d(i,k+1,j)+base_3d(i,k,j) ) + ENDDO + ENDDO + + DO i = i_start, i_end + vflux(i,0)=vflux(i,1) + ENDDO + + DO i = i_start, i_end + vflux(i,ktf)=0. + ENDDO + + DO k=kts,ktf + DO i = i_start, i_end + tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j) & + *rdnw(k)*(vflux(i,k)-vflux(i,k-1)) + ENDDO + ENDDO + + ENDDO j_loop_s + +END SUBROUTINE vertical_diffusion_3dmp + + +!------------------------------------------------------------------------------- + + +SUBROUTINE vertical_diffusion_u ( field, tendency, & + config_flags, u_base, & + alt, muu, rdn, rdnw, kvdif, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & + INTENT(IN ) :: field, & + alt + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: muu + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, rdnw, u_base + + REAL , INTENT(IN ) :: kvdif + + ! Local data + + INTEGER :: i, j, k, itf, jtf, ktf + INTEGER :: i_start, i_end, j_start, j_end + + REAL , DIMENSION(its:ite, 0:kte+1) :: vflux + + REAL :: rdz, zz + + LOGICAL :: specified + +! +! +! vertical_diffusion_u computes vertical diffusion tendency for +! the u momentum equation. This routine assumes a constant eddy +! viscosity kvdif. +! +! + + specified = .false. + if(config_flags%specified .or. config_flags%nested) specified = .true. + + ktf=MIN(kte,kde-1) + + i_start = its + i_end = ite + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-1,ite) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = ite + + +j_loop_u : DO j = j_start, j_end + + DO k=kts,ktf-1 + DO i = i_start, i_end + vflux(i,k)=kvdif*rdn(k+1)/(0.25*( alt(i ,k ,j) & + +alt(i-1,k ,j) & + +alt(i ,k+1,j) & + +alt(i-1,k+1,j) ) ) & + *(field(i,k+1,j)-field(i,k,j) & + -u_base(k+1) +u_base(k) ) + ENDDO + ENDDO + + DO i = i_start, i_end + vflux(i,0)=vflux(i,1) + ENDDO + + DO i = i_start, i_end + vflux(i,ktf)=0. + ENDDO + + DO k=kts,ktf-1 + DO i = i_start, i_end + tendency(i,k,j)=tendency(i,k,j)+ & + g*g*rdnw(k)/muu(i,j)/(0.5*(alt(i-1,k,j)+alt(i,k,j)))* & + (vflux(i,k)-vflux(i,k-1)) + ENDDO + ENDDO + + ENDDO j_loop_u + +END SUBROUTINE vertical_diffusion_u + +!------------------------------------------------------------------------------- + + +SUBROUTINE vertical_diffusion_v ( field, tendency, & + config_flags, v_base, & + alt, muv, rdn, rdnw, kvdif, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & + INTENT(IN ) :: field, & + alt + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, rdnw, v_base + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: muv + + REAL , INTENT(IN ) :: kvdif + + ! Local data + + INTEGER :: i, j, k, itf, jtf, ktf, jm1 + INTEGER :: i_start, i_end, j_start, j_end + + REAL , DIMENSION(its:ite, 0:kte+1) :: vflux + + REAL :: rdz, zz + + LOGICAL :: specified + +! +! +! vertical_diffusion_v computes vertical diffusion tendency for +! the v momentum equation. This routine assumes a constant eddy +! viscosity kvdif. +! +! + + specified = .false. + if(config_flags%specified .or. config_flags%nested) specified = .true. + + ktf=MIN(kte,kde-1) + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. specified ) j_end = MIN(jde-1,jte) + +j_loop_v : DO j = j_start, j_end +! jm1 = max(j-1,1) + jm1 = j-1 + + DO k=kts,ktf-1 + DO i = i_start, i_end + vflux(i,k)=kvdif*rdn(k+1)/(0.25*( alt(i,k ,j ) & + +alt(i,k ,jm1) & + +alt(i,k+1,j ) & + +alt(i,k+1,jm1) ) ) & + *(field(i,k+1,j)-field(i,k,j) & + -v_base(k+1) +v_base(k) ) + ENDDO + ENDDO + + DO i = i_start, i_end + vflux(i,0)=vflux(i,1) + ENDDO + + DO i = i_start, i_end + vflux(i,ktf)=0. + ENDDO + + DO k=kts,ktf-1 + DO i = i_start, i_end + tendency(i,k,j)=tendency(i,k,j)+ & + g*g*rdnw(k)/muv(i,j)/(0.5*(alt(i,k,jm1)+alt(i,k,j)))* & + (vflux(i,k)-vflux(i,k-1)) + ENDDO + ENDDO + + ENDDO j_loop_v + +END SUBROUTINE vertical_diffusion_v + +!*************** end new mass coordinate routines + +!------------------------------------------------------------------------------- + +SUBROUTINE calculate_full ( rfield, rfieldb, rfieldp, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: rfieldb, & + rfieldp + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT ) :: rfield + + ! Local indices. + + INTEGER :: i, j, k, itf, jtf, ktf + +! +! +! calculate_full +! calculates full 3D field from pertubation and base field. +! +! + + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + ktf=MIN(kte,kde-1) + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + rfield(i,k,j)=rfieldb(i,k,j)+rfieldp(i,k,j) + ENDDO + ENDDO + ENDDO + +END SUBROUTINE calculate_full + +!------------------------------------------------------------------------------ + +SUBROUTINE coriolis ( ru, rv, rw, ru_tend, rv_tend, rw_tend, & + config_flags, & + msftx, msfty, msfux, msfuy, & + msfvx, msfvy, & + f, e, sina, cosa, fzm, fzp, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: ru_tend, & + rv_tend, & + rw_tend + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: ru, & + rv, & + rw + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & + msfuy, & + msfvx, & + msfvy, & + msftx, & + msfty + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: f, & + e, & + sina, & + cosa + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & + fzp + + ! Local indices. + + INTEGER :: i, j , k, ktf + INTEGER :: i_start, i_end, j_start, j_end + + LOGICAL :: specified + +! +! +! coriolis calculates the large timestep tendency terms in the +! u, v, and w momentum equations arise from the coriolis force. +! +! + + specified = .false. + if(config_flags%specified .or. config_flags%nested) specified = .true. + + ktf=MIN(kte,kde-1) + +! coriolis for u-momentum equation + +! Notes on map scale factor +! cosa, sina are related to rotating the coordinate frame if desired +! generally sina=0, cosa=1 +! ADT eqn 44, RHS terms 6 and 7: -2 mu w omega cos(lat)/my +! + 2 mu v omega sin(lat)/my +! Define f=2 omega sin(lat), e=2 omega cos(lat) +! => terms are: -e mu w / my + f mu v / my +! rv = mu v / mx ; rw = mu w / my +! => terms are: -e rw + f rv *mx / my + + i_start = its + i_end = ite + IF ( config_flags%open_xs .or. specified .or. & + config_flags%nested) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. specified .or. & + config_flags%nested) i_end = MIN(ide-1,ite) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = ite + + DO j = jts, MIN(jte,jde-1) + + DO k=kts,ktf + DO i = i_start, i_end + + ru_tend(i,k,j)=ru_tend(i,k,j) + (msfux(i,j)/msfuy(i,j))*0.5*(f(i,j)+f(i-1,j)) & + *0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j)) & + - 0.5*(e(i,j)+e(i-1,j))*0.5*(cosa(i,j)+cosa(i-1,j)) & + *0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j)) + + ENDDO + ENDDO + + IF ( (config_flags%open_xs) .and. (its == ids) ) THEN + + DO k=kts,ktf + + ru_tend(its,k,j)=ru_tend(its,k,j) + (msfux(its,j)/msfuy(its,j))*0.5*(f(its,j)+f(its,j)) & + *0.25*(rv(its,k,j+1)+rv(its,k,j+1)+rv(its,k,j)+rv(its,k,j)) & + - 0.5*(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j)) & + *0.25*(rw(its,k+1,j)+rw(its,k,j)+rw(its,k+1,j)+rw(its,k,j)) + + ENDDO + + ENDIF + + IF ( (config_flags%open_xe) .and. (ite == ide) ) THEN + + DO k=kts,ktf + + ru_tend(ite,k,j)=ru_tend(ite,k,j) + (msfux(ite,j)/msfuy(ite,j))*0.5*(f(ite-1,j)+f(ite-1,j)) & + *0.25*(rv(ite-1,k,j+1)+rv(ite-1,k,j+1)+rv(ite-1,k,j)+rv(ite-1,k,j)) & + - 0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j)) & + *0.25*(rw(ite-1,k+1,j)+rw(ite-1,k,j)+rw(ite-1,k+1,j)+rw(ite-1,k,j)) + + ENDDO + + ENDIF + + ENDDO + +! coriolis term for v-momentum equation + +! Notes on map scale factors +! ADT eqn 45, RHS terms 6 and 6b [0 for sina=0]: -2 mu u omega sin(lat)/mx + ? +! Define f=2 omega sin(lat), e=2 omega cos(lat) +! => terms are: -f mu u / mx +! ru = mu u / my ; rw = mu w / my +! => terms are: -f ru *my / mx + ? + + j_start = jts + j_end = jte + + IF ( config_flags%open_ys .or. specified .or. & + config_flags%nested .or. config_flags%polar) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. specified .or. & + config_flags%nested .or. config_flags%polar) j_end = MIN(jde-1,jte) + + IF ( (config_flags%open_ys) .and. (jts == jds) ) THEN + + DO k=kts,ktf + DO i=its,MIN(ide-1,ite) + + rv_tend(i,k,jts)=rv_tend(i,k,jts) - (msfvy(i,jts)/msfvx(i,jts))*0.5*(f(i,jts)+f(i,jts)) & + *0.25*(ru(i,k,jts)+ru(i+1,k,jts)+ru(i,k,jts)+ru(i+1,k,jts)) & + + (msfvy(i,jts)/msfvx(i,jts))*0.5*(e(i,jts)+e(i,jts))*0.5*(sina(i,jts)+sina(i,jts)) & + *0.25*(rw(i,k+1,jts)+rw(i,k,jts)+rw(i,k+1,jts)+rw(i,k,jts)) + + ENDDO + ENDDO + + ENDIF + + DO j=j_start, j_end + DO k=kts,ktf + DO i=its,MIN(ide-1,ite) + + rv_tend(i,k,j)=rv_tend(i,k,j) - (msfvy(i,j)/msfvx(i,j))*0.5*(f(i,j)+f(i,j-1)) & + *0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) & + + (msfvy(i,j)/msfvx(i,j))*0.5*(e(i,j)+e(i,j-1))*0.5*(sina(i,j)+sina(i,j-1)) & + *0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j)) + + ENDDO + ENDDO + ENDDO + + + IF ( (config_flags%open_ye) .and. (jte == jde) ) THEN + + DO k=kts,ktf + DO i=its,MIN(ide-1,ite) + + rv_tend(i,k,jte)=rv_tend(i,k,jte) - (msfvy(i,jte)/msfvx(i,jte))*0.5*(f(i,jte-1)+f(i,jte-1)) & + *0.25*(ru(i,k,jte-1)+ru(i+1,k,jte-1)+ru(i,k,jte-1)+ru(i+1,k,jte-1)) & + + (msfvy(i,jte)/msfvx(i,jte))*0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i,jte-1)+sina(i,jte-1)) & + *0.25*(rw(i,k+1,jte-1)+rw(i,k,jte-1)+rw(i,k+1,jte-1)+rw(i,k,jte-1)) + + ENDDO + ENDDO + + ENDIF + +! coriolis term for w-mometum + +! Notes on map scale factors +! ADT eqn 46/my, RHS terms 5 and 5b [0 for sina=0]: 2 mu u omega cos(lat)/my +? +! Define e=2 omega cos(lat) +! => terms are: e mu u / my + ??? +! ru = mu u / my ; ru = mu v / mx +! => terms are: e ru + ??? + + DO j=jts,MIN(jte, jde-1) + DO k=kts+1,ktf + DO i=its,MIN(ite, ide-1) + + rw_tend(i,k,j)=rw_tend(i,k,j) + e(i,j)* & + (cosa(i,j)*0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j)) & + +fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j))) & + -(msftx(i,j)/msfty(i,j))* & + sina(i,j)*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1)) & + +fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1)))) + + ENDDO + ENDDO + ENDDO + +END SUBROUTINE coriolis + +!------------------------------------------------------------------------------ + +SUBROUTINE perturbation_coriolis ( ru_in, rv_in, rw, ru_tend, rv_tend, rw_tend, & + config_flags, & + u_base, v_base, z_base, & + muu, muv, phb, ph, & + msftx, msfty, msfux, msfuy, msfvx, msfvy, & + f, e, sina, cosa, fzm, fzp, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: ru_tend, & + rv_tend, & + rw_tend + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: ru_in, & + rv_in, & + rw, & + ph, & + phb + + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & + msfuy, & + msfvx, & + msfvy, & + msftx, & + msfty + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: f, & + e, & + sina, & + cosa + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: muu, & + muv + + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & + fzp + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: u_base, & + v_base, & + z_base + + ! Local storage + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: ru, & + rv + + REAL :: z_at_u, z_at_v, wkp1, wk, wkm1 + + ! Local indices. + + INTEGER :: i, j , k, ktf + INTEGER :: i_start, i_end, j_start, j_end + + LOGICAL :: specified + +! +! +! perturbation_coriolis calculates the large timestep tendency terms in the +! u, v, and w momentum equations arise from the coriolis force. This version +! subtracts off the horizontal velocities from the initial sounding when +! computing the forcing terms, hence "perturbation" coriolis. +! +! + + specified = .false. + if(config_flags%specified .or. config_flags%nested) specified = .true. + + ktf=MIN(kte,kde-1) + +! coriolis for u-momentum equation + + i_start = its + i_end = ite + IF ( config_flags%open_xs .or. specified .or. & + config_flags%nested) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. specified .or. & + config_flags%nested) i_end = MIN(ide-1,ite) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = ite + +! compute perturbation mu*v for use in u momentum equation + + DO j = jts, MIN(jte,jde-1)+1 + DO k=kts+1,ktf-1 + DO i = i_start-1, i_end + z_at_v = 0.25*( phb(i,k,j )+phb(i,k+1,j ) & + +phb(i,k,j-1)+phb(i,k+1,j-1) & + +ph(i,k,j )+ph(i,k+1,j ) & + +ph(i,k,j-1)+ph(i,k+1,j-1))/g + wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k))) + wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1))) + wk = 1.-wkp1-wkm1 + rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*( & + wkm1*v_base(k-1) & + +wk *v_base(k ) & + +wkp1*v_base(k+1) ) + ENDDO + ENDDO + ENDDO + + +! pick up top and bottom v + + DO j = jts, MIN(jte,jde-1)+1 + DO i = i_start-1, i_end + + k = kts + z_at_v = 0.25*( phb(i,k,j )+phb(i,k+1,j ) & + +phb(i,k,j-1)+phb(i,k+1,j-1) & + +ph(i,k,j )+ph(i,k+1,j ) & + +ph(i,k,j-1)+ph(i,k+1,j-1))/g + wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k))) + wk = 1.-wkp1 + rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*( & + +wk *v_base(k ) & + +wkp1*v_base(k+1) ) + + k = ktf + z_at_v = 0.25*( phb(i,k,j )+phb(i,k+1,j ) & + +phb(i,k,j-1)+phb(i,k+1,j-1) & + +ph(i,k,j )+ph(i,k+1,j ) & + +ph(i,k,j-1)+ph(i,k+1,j-1))/g + wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1))) + wk = 1.-wkm1 + rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*( & + wkm1*v_base(k-1) & + +wk *v_base(k ) ) + + ENDDO + ENDDO + +! compute coriolis forcing for u + +! Map scale factors: see comments above for Coriolis + + DO j = jts, MIN(jte,jde-1) + + DO k=kts,ktf + DO i = i_start, i_end + ru_tend(i,k,j)=ru_tend(i,k,j) + (msfux(i,j)/msfuy(i,j))*0.5*(f(i,j)+f(i-1,j)) & + *0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j)) & + - 0.5*(e(i,j)+e(i-1,j))*0.5*(cosa(i,j)+cosa(i-1,j)) & + *0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j)) + ENDDO + ENDDO + + IF ( (config_flags%open_xs) .and. (its == ids) ) THEN + + DO k=kts,ktf + + ru_tend(its,k,j)=ru_tend(its,k,j) + (msfux(its,j)/msfuy(its,j))*0.5*(f(its,j)+f(its,j)) & + *0.25*(rv(its,k,j+1)+rv(its,k,j+1)+rv(its,k,j)+rv(its,k,j)) & + - 0.5*(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j)) & + *0.25*(rw(its,k+1,j)+rw(its,k,j)+rw(its,k+1,j)+rw(its,k,j)) + + ENDDO + + ENDIF + + IF ( (config_flags%open_xe) .and. (ite == ide) ) THEN + + DO k=kts,ktf + + ru_tend(ite,k,j)=ru_tend(ite,k,j) + (msfux(ite,j)/msfuy(ite,j))*0.5*(f(ite-1,j)+f(ite-1,j)) & + *0.25*(rv(ite-1,k,j+1)+rv(ite-1,k,j+1)+rv(ite-1,k,j)+rv(ite-1,k,j)) & + - 0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j)) & + *0.25*(rw(ite-1,k+1,j)+rw(ite-1,k,j)+rw(ite-1,k+1,j)+rw(ite-1,k,j)) + + ENDDO + + ENDIF + + ENDDO + +! coriolis term for v-momentum equation +! Map scale factors: see comments above for Coriolis + + j_start = jts + j_end = jte + + IF ( config_flags%open_ys .or. specified .or. & + config_flags%nested .or. config_flags%polar) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. specified .or. & + config_flags%nested .or. config_flags%polar) j_end = MIN(jde-1,jte) + +! compute perturbation mu*u for use in v momentum equation + + DO j = j_start-1,j_end + DO k=kts+1,ktf-1 + DO i = its, MIN(ite,ide-1)+1 + z_at_u = 0.25*( phb(i ,k,j)+phb(i ,k+1,j) & + +phb(i-1,k,j)+phb(i-1,k+1,j) & + +ph(i ,k,j)+ph(i ,k+1,j) & + +ph(i-1,k,j)+ph(i-1,k+1,j))/g + wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k))) + wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1))) + wk = 1.-wkp1-wkm1 + ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*( & + wkm1*u_base(k-1) & + +wk *u_base(k ) & + +wkp1*u_base(k+1) ) + ENDDO + ENDDO + ENDDO + +! pick up top and bottom u + + DO j = j_start-1,j_end + DO i = its, MIN(ite,ide-1)+1 + + k = kts + z_at_u = 0.25*( phb(i ,k,j)+phb(i ,k+1,j) & + +phb(i-1,k,j)+phb(i-1,k+1,j) & + +ph(i ,k,j)+ph(i ,k+1,j) & + +ph(i-1,k,j)+ph(i-1,k+1,j))/g + wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k))) + wk = 1.-wkp1 + ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*( & + +wk *u_base(k ) & + +wkp1*u_base(k+1) ) + + + k = ktf + z_at_u = 0.25*( phb(i ,k,j)+phb(i ,k+1,j) & + +phb(i-1,k,j)+phb(i-1,k+1,j) & + +ph(i ,k,j)+ph(i ,k+1,j) & + +ph(i-1,k,j)+ph(i-1,k+1,j))/g + wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1))) + wk = 1.-wkm1 + ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*( & + wkm1*u_base(k-1) & + +wk *u_base(k ) ) + + ENDDO + ENDDO + +! compute coriolis forcing for v momentum equation +! Map scale factors: see comments above for Coriolis + + IF ( (config_flags%open_ys) .and. (jts == jds) ) THEN + + DO k=kts,ktf + DO i=its,MIN(ide-1,ite) + + rv_tend(i,k,jts)=rv_tend(i,k,jts) - (msfvy(i,jts)/msfvx(i,jts))*0.5*(f(i,jts)+f(i,jts)) & + *0.25*(ru(i,k,jts)+ru(i+1,k,jts)+ru(i,k,jts)+ru(i+1,k,jts)) & + + (msfvy(i,jts)/msfvx(i,jts))*0.5*(e(i,jts)+e(i,jts))*0.5*(sina(i,jts)+sina(i,jts)) & + *0.25*(rw(i,k+1,jts)+rw(i,k,jts)+rw(i,k+1,jts)+rw(i,k,jts)) + + ENDDO + ENDDO + + ENDIF + + DO j=j_start, j_end + DO k=kts,ktf + DO i=its,MIN(ide-1,ite) + + rv_tend(i,k,j)=rv_tend(i,k,j) - (msfvy(i,j)/msfvx(i,j))*0.5*(f(i,j)+f(i,j-1)) & + *0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) & + + (msfvy(i,j)/msfvx(i,j))*0.5*(e(i,j)+e(i,j-1))*0.5*(sina(i,j)+sina(i,j-1)) & + *0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j)) + + ENDDO + ENDDO + ENDDO + + + IF ( (config_flags%open_ye) .and. (jte == jde) ) THEN + + DO k=kts,ktf + DO i=its,MIN(ide-1,ite) + + rv_tend(i,k,jte)=rv_tend(i,k,jte) - (msfvy(i,jte)/msfvx(i,jte))*0.5*(f(i,jte-1)+f(i,jte-1)) & + *0.25*(ru(i,k,jte-1)+ru(i+1,k,jte-1)+ru(i,k,jte-1)+ru(i+1,k,jte-1)) & + + (msfvy(i,jte)/msfvx(i,jte))*0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i,jte-1)+sina(i,jte-1)) & + *0.25*(rw(i,k+1,jte-1)+rw(i,k,jte-1)+rw(i,k+1,jte-1)+rw(i,k,jte-1)) + + ENDDO + ENDDO + + ENDIF + +! coriolis term for w-mometum +! Map scale factors: see comments above for Coriolis + + DO j=jts,MIN(jte, jde-1) + DO k=kts+1,ktf + DO i=its,MIN(ite, ide-1) + + rw_tend(i,k,j)=rw_tend(i,k,j) + e(i,j)* & + (cosa(i,j)*0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j)) & + +fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j))) & + -(msftx(i,j)/msfty(i,j))*sina(i,j)*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1)) & + +fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1)))) + + ENDDO + ENDDO + ENDDO + +END SUBROUTINE perturbation_coriolis + +!------------------------------------------------------------------------------ + +SUBROUTINE curvature ( ru, rv, rw, u, v, w, ru_tend, rv_tend, rw_tend, & + config_flags, & + msfux, msfuy, msfvx, msfvy, msftx, msfty, & + xlat, fzm, fzp, rdx, rdy, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & + INTENT(INOUT) :: ru_tend, & + rv_tend, & + rw_tend + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & + INTENT(IN ) :: ru, & + rv, & + rw, & + u, & + v, & + w + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & + msfuy, & + msfvx, & + msfvy, & + msftx, & + msfty, & + xlat + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & + fzp + + REAL , INTENT(IN ) :: rdx, & + rdy + + ! Local data + +! INTEGER :: i, j, k, itf, jtf, ktf, kp1, im, ip, jm, jp + INTEGER :: i, j, k, itf, jtf, ktf + INTEGER :: i_start, i_end, j_start, j_end +! INTEGER :: irmin, irmax, jrmin, jrmax + + REAL , DIMENSION( its-1:ite , kts:kte, jts-1:jte ) :: vxgm + + LOGICAL :: specified + +! +! +! curvature calculates the large timestep tendency terms in the +! u, v, and w momentum equations arise from the curvature terms. +! +! + + specified = .false. + if(config_flags%specified .or. config_flags%nested) specified = .true. + + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + ktf=MIN(kte,kde-1) + +! irmin = ims +! irmax = ime +! jrmin = jms +! jrmax = jme +! IF ( config_flags%open_xs ) irmin = ids +! IF ( config_flags%open_xe ) irmax = ide-1 +! IF ( config_flags%open_ys ) jrmin = jds +! IF ( config_flags%open_ye ) jrmax = jde-1 + +! Define v cross grad m at scalar points - vxgm(i,j) + + i_start = its-1 + i_end = ite + j_start = jts-1 + j_end = jte + + IF ( ( config_flags%open_xs .or. specified .or. & + config_flags%nested) .and. (its == ids) ) i_start = its + IF ( ( config_flags%open_xe .or. specified .or. & + config_flags%nested) .and. (ite == ide) ) i_end = ite-1 + IF ( ( config_flags%open_ys .or. specified .or. & + config_flags%nested .or. config_flags%polar) .and. (jts == jds) ) j_start = jts + IF ( ( config_flags%open_ye .or. specified .or. & + config_flags%nested .or. config_flags%polar) .and. (jte == jde) ) j_end = jte-1 + IF ( config_flags%periodic_x ) i_start = its-1 + IF ( config_flags%periodic_x ) i_end = ite + + DO j=j_start, j_end + DO k=kts,ktf + DO i=i_start, i_end +! Map scale factor notes: +! msf...y is constant everywhere for cylindrical map projection +! msf...x varies with y only +! But we know that this is not = 0 for cylindrical, +! therefore use msfvX in 1st line +! which => by symmetry use msfuY in 2nd line - ??? + vxgm(i,k,j)=0.5*(u(i,k,j)+u(i+1,k,j))*(msfvx(i,j+1)-msfvx(i,j))*rdy - & + 0.5*(v(i,k,j)+v(i,k,j+1))*(msfuy(i+1,j)-msfuy(i,j))*rdx + ENDDO + ENDDO + ENDDO + +! Pick up the boundary rows for open (radiation) lateral b.c. +! Rather crude at present, we are assuming there is no +! variation in this term at the boundary. + + IF ( ( config_flags%open_xs .or. (specified .AND. .NOT. config_flags%periodic_x) .or. & + config_flags%nested) .and. (its == ids) ) THEN + + DO j = jts, jte-1 + DO k = kts, ktf + vxgm(its-1,k,j) = vxgm(its,k,j) + ENDDO + ENDDO + + ENDIF + + IF ( ( config_flags%open_xe .or. (specified .AND. .NOT. config_flags%periodic_x) .or. & + config_flags%nested) .and. (ite == ide) ) THEN + + DO j = jts, jte-1 + DO k = kts, ktf + vxgm(ite,k,j) = vxgm(ite-1,k,j) + ENDDO + ENDDO + + ENDIF + +! Polar boundary condition: +! The following change is needed in case one tries using the vxgm route with +! polar B.C.'s in the future, but not needed if 'tan' used + IF ( ( config_flags%open_ys .or. specified .or. & + config_flags%nested .or. config_flags%polar) .and. (jts == jds) ) THEN + + DO k = kts, ktf + DO i = its-1, ite + vxgm(i,k,jts-1) = vxgm(i,k,jts) + ENDDO + ENDDO + + ENDIF + +! Polar boundary condition: +! The following change is needed in case one tries using the vxgm route with +! polar B.C.'s in the future, but not needed if 'tan' used + IF ( ( config_flags%open_ye .or. specified .or. & + config_flags%nested .or. config_flags%polar) .and. (jte == jde) ) THEN + + DO k = kts, ktf + DO i = its-1, ite + vxgm(i,k,jte) = vxgm(i,k,jte-1) + ENDDO + ENDDO + + ENDIF + +! curvature term for u momentum eqn. + +! Map scale factor notes: +! ADT eqn 44, RHS terms 4 and 5, in cylindrical: mu u v tan(lat)/(a my) +! - mu u w /(a my) +! ru = mu u / my ; rw = mu w / my ; rv = mu v / mx +! => terms are: +! (mx/my)*u rv tan(lat) / a - u rw / a = (u/a)*[(mx/my) rv tan(lat) - rw] +! ru v tan(lat) / a - u rw / a +! xlat defined with end points half grid space from pole, +! hence are on u latitude points + + i_start = its + IF ( config_flags%open_xs .or. specified .or. & + config_flags%nested) i_start = MAX ( ids+1 , its ) + IF ( config_flags%open_xe .or. specified .or. & + config_flags%nested) i_end = MIN ( ide-1 , ite ) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = ite + +! Polar boundary condition + IF ((config_flags%map_proj == 6) .OR. (config_flags%polar)) THEN + + DO j=jts,MIN(jde-1,jte) + DO k=kts,ktf + DO i=i_start,i_end + + ru_tend(i,k,j)=ru_tend(i,k,j) + u(i,k,j)*reradius* ( & + (msfux(i,j)/msfuy(i,j))*0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+ & + rv(i-1,k,j)+rv(i,k,j))*tan(xlat(i,j)*degrad) & + - 0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j)) ) + ENDDO + ENDDO + ENDDO + + ELSE ! normal code + + + DO j=jts,MIN(jde-1,jte) + DO k=kts,ktf + DO i=i_start,i_end + + ru_tend(i,k,j)=ru_tend(i,k,j) + 0.5*(vxgm(i,k,j)+vxgm(i-1,k,j)) & + *0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j)) & + - u(i,k,j)*reradius & + *0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j)) + + ENDDO + ENDDO + ENDDO + + END IF + +! curvature term for v momentum eqn. + +! Map scale factor notes +! ADT eqn 45, RHS terms 4 and 5, in cylindrical: mu u*u tan(lat)/(a mx) +! - mu v w /(a mx) +! ru = mu u / my ; rw = mu w / my ; rv = mu v / mx +! terms are: +! (my/mx)*u ru tan(lat) / a - (my/mx)*v rw / a +! = [my/(mx*a)]*[u ru tan(lat) - v rw] +! (1/a)*[(my/mx)*u ru tan(lat) - w rv] +! xlat defined with end points half grid space from pole, hence are on +! u latitude points => av here +! +! in original wrf, there was a sign error for the rw contribution + + j_start = jts + IF ( config_flags%open_ys .or. specified .or. & + config_flags%nested .or. config_flags%polar) j_start = MAX ( jds+1 , jts ) + IF ( config_flags%open_ye .or. specified .or. & + config_flags%nested .or. config_flags%polar) j_end = MIN ( jde-1 , jte ) + + IF ((config_flags%map_proj == 6) .OR. (config_flags%polar)) THEN + + DO j=j_start,j_end + DO k=kts,ktf + DO i=its,MIN(ite,ide-1) + rv_tend(i,k,j)=rv_tend(i,k,j) - (msfvy(i,j)/msfvx(i,j))*reradius* ( & + 0.25*(u(i,k,j)+u(i+1,k,j)+u(i,k,j-1)+u(i+1,k,j-1))* & + tan((xlat(i,j)+xlat(i,j-1))*0.5*degrad)* & + 0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) & + - v(i,k,j)*0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+ & + rw(i,k+1,j)+rw(i,k,j)) ) + ENDDO + ENDDO + ENDDO + + ELSE ! normal code + + DO j=j_start,j_end + DO k=kts,ktf + DO i=its,MIN(ite,ide-1) + + rv_tend(i,k,j)=rv_tend(i,k,j) - 0.5*(vxgm(i,k,j)+vxgm(i,k,j-1)) & + *0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) & + - (msfvy(i,j)/msfvx(i,j))*v(i,k,j)*reradius & + *0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j)) + + ENDDO + ENDDO + ENDDO + + END IF + +! curvature term for vertical momentum eqn. + +! Notes on map scale factors: +! ADT eqn 46, RHS term 4: [mu/(a my)]*[u*u + v*v] +! ru = mu u / my ; rw = mu w / my ; rv = mu v / mx +! terms are: u ru / a + (mx/my)v rv / a + + DO j=jts,MIN(jte,jde-1) + DO k=MAX(2,kts),ktf + DO i=its,MIN(ite,ide-1) + + rw_tend(i,k,j)=rw_tend(i,k,j) + reradius* & + (0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j))+fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j))) & + *0.5*(fzm(k)*( u(i,k,j) +u(i+1,k,j))+fzp(k)*( u(i,k-1,j) +u(i+1,k-1,j))) & + +(msftx(i,j)/msfty(i,j))*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1))+fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1))) & + *0.5*(fzm(k)*( v(i,k,j) +v(i,k,j+1))+fzp(k)*( v(i,k-1,j) +v(i,k-1,j+1)))) + + ENDDO + ENDDO + ENDDO + +END SUBROUTINE curvature + +!------------------------------------------------------------------------------ + +SUBROUTINE decouple ( rr, rfield, field, name, config_flags, & + fzm, fzp, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + CHARACTER(LEN=1) , INTENT(IN ) :: name + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: rfield + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: rr + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT ) :: field + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, fzp + + ! Local data + + INTEGER :: i, j, k, itf, jtf, ktf + +! +! +! decouple decouples a variable from the column dry-air mass. +! +! + + ktf=MIN(kte,kde-1) + + IF (name .EQ. 'u')THEN + itf=ite + jtf=MIN(jte,jde-1) + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + field(i,k,j)=rfield(i,k,j)/(0.5*(rr(i,k,j)+rr(i-1,k,j))) + ENDDO + ENDDO + ENDDO + + ELSE IF (name .EQ. 'v')THEN + itf=MIN(ite,ide-1) + jtf=jte + + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + field(i,k,j)=rfield(i,k,j)/(0.5*(rr(i,k,j)+rr(i,k,j-1))) + ENDDO + ENDDO + ENDDO + + ELSE IF (name .EQ. 'w')THEN + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + DO j=jts,jtf + DO k=kts+1,ktf + DO i=its,itf + field(i,k,j)=rfield(i,k,j)/(fzm(k)*rr(i,k,j)+fzp(k)*rr(i,k-1,j)) + ENDDO + ENDDO + ENDDO + + DO j=jts,jtf + DO i=its,itf + field(i,kte,j) = 0. + ENDDO + ENDDO + + ELSE + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + ! For theta we will decouple tb and tp and add them to give t afterwards + DO j=jts,jtf + DO k=kts,ktf + DO i=its,itf + field(i,k,j)=rfield(i,k,j)/rr(i,k,j) + ENDDO + ENDDO + ENDDO + + ENDIF + +END SUBROUTINE decouple + +!------------------------------------------------------------------------------- + + +SUBROUTINE zero_tend ( tendency, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + + IMPLICIT NONE + + ! Input data + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency + + ! Local data + + INTEGER :: i, j, k, itf, jtf, ktf + +! +! +! zero_tend sets the input tendency array to zero. +! +! + + DO j = jts, jte + DO k = kts, kte + DO i = its, ite + tendency(i,k,j) = 0. + ENDDO + ENDDO + ENDDO + + END SUBROUTINE zero_tend + +!------------------------------------------------------------------------------- +! Sets the an array on the polar v point(s) to zero +SUBROUTINE zero_pole ( field, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + + IMPLICIT NONE + + ! Input data + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: field + + ! Local data + + INTEGER :: i, k + + IF (jts == jds) THEN + DO k = kts, kte + DO i = its-1, ite+1 + field(i,k,jts) = 0. + END DO + END DO + END IF + IF (jte == jde) THEN + DO k = kts, kte + DO i = its-1, ite+1 + field(i,k,jte) = 0. + END DO + END DO + END IF + +END SUBROUTINE zero_pole + +!------------------------------------------------------------------------------- +! Sets the an array on the polar v point(s) +SUBROUTINE pole_point_bc ( field, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + + IMPLICIT NONE + + ! Input data + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: field + + ! Local data + + INTEGER :: i, k + + IF (jts == jds) THEN + DO k = kts, kte + DO i = its, ite +! field(i,k,jts) = 2*field(i,k,jts+1) - field(i,k,jts+2) + field(i,k,jts) = field(i,k,jts+1) + END DO + END DO + END IF + IF (jte == jde) THEN + DO k = kts, kte + DO i = its, ite +! field(i,k,jte) = 2*field(i,k,jte-1) - field(i,k,jte-2) + field(i,k,jte) = field(i,k,jte-1) + END DO + END DO + END IF + +END SUBROUTINE pole_point_bc + +!====================================================================== +! physics prep routines +!====================================================================== + + SUBROUTINE phy_prep ( config_flags, & ! input + mu, muu, muv, u, v, w, p, pb, alt, ph, & ! input + phb, t, tsk, moist, n_moist, & ! input + mu_3d, rho, th_phy, p_phy , pi_phy , & ! output + u_phy, v_phy, w_phy, p8w, t_phy, t8w, & ! output + z, z_at_w, dz8w, & ! output + fzm, fzp, & ! params + RTHRATEN, & + RTHBLTEN, RUBLTEN, RVBLTEN, & + RQVBLTEN, RQCBLTEN, RQIBLTEN, & + RTHCUTEN, RQVCUTEN, RQCCUTEN, & + RQRCUTEN, RQICUTEN, RQSCUTEN, & + RTHFTEN, RQVFTEN, & + RUNDGDTEN, RVNDGDTEN, RTHNDGDTEN, & + RQVNDGDTEN, RMUNDGDTEN, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) +!---------------------------------------------------------------------- + IMPLICIT NONE +!---------------------------------------------------------------------- + + TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + INTEGER , INTENT(IN ) :: n_moist + + REAL, DIMENSION( ims:ime, kms:kme , jms:jme , n_moist ), INTENT(IN) :: moist + + + REAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: TSK, mu, muu, muv + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & + INTENT( OUT) :: u_phy, & + v_phy, & + w_phy, & + pi_phy, & + p_phy, & + p8w, & + t_phy, & + th_phy, & + t8w, & + mu_3d, & + rho, & + z, & + dz8w, & + z_at_w + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & + INTENT(IN ) :: pb, & + p, & + u, & + v, & + w, & + alt, & + ph, & + phb, & + t + + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & + fzp + + REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & + INTENT(INOUT) :: RTHRATEN + + REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & + INTENT(INOUT) :: RTHCUTEN, & + RQVCUTEN, & + RQCCUTEN, & + RQRCUTEN, & + RQICUTEN, & + RQSCUTEN + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , & + INTENT(INOUT) :: RUBLTEN, & + RVBLTEN, & + RTHBLTEN, & + RQVBLTEN, & + RQCBLTEN, & + RQIBLTEN + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , & + INTENT(INOUT) :: RTHFTEN, & + RQVFTEN + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , & + INTENT(INOUT) :: RUNDGDTEN, & + RVNDGDTEN, & + RTHNDGDTEN, & + RQVNDGDTEN, & + RMUNDGDTEN + + INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end, i_startu, j_startv + INTEGER :: i, j, k + REAL :: w1, w2, z0, z1, z2 + +!----------------------------------------------------------------------- + +! +! +! phys_prep calculates a number of diagnostic quantities needed by +! the physics routines. It also decouples the physics tendencies from +! the column dry-air mass (the physics routines expect to see/update the +! uncoupled tendencies). +! +! + +! set up loop bounds for this grid's boundary conditions + + i_start = its + i_end = min( ite,ide-1 ) + j_start = jts + j_end = min( jte,jde-1 ) + + k_start = kts + k_end = min( kte, kde-1 ) + +! compute thermodynamics and velocities at pressure points + + do j = j_start,j_end + do k = k_start, k_end + do i = i_start, i_end + + th_phy(i,k,j) = t(i,k,j) + t0 + p_phy(i,k,j) = p(i,k,j) + pb(i,k,j) + pi_phy(i,k,j) = (p_phy(i,k,j)/p1000mb)**rcp + !! TAKE INTO ACCOUNT cp=f(T) on Venus + IF (planet.eq. "venus" ) THEN + t_phy(i,k,j)= (th_phy(i,k,j)**nu - nu*(TT00**nu)*log((p1000mb/p_phy(i,k,j))**rcp))**(1/nu) + ELSE + t_phy(i,k,j) = th_phy(i,k,j)*pi_phy(i,k,j) + ENDIF + rho(i,k,j) = 1./alt(i,k,j)*(1.+moist(i,k,j,P_QV)) + mu_3d(i,k,j) = mu(i,j) + u_phy(i,k,j) = 0.5*(u(i,k,j)+u(i+1,k,j)) + v_phy(i,k,j) = 0.5*(v(i,k,j)+v(i,k,j+1)) + + enddo + enddo + enddo + +! compute z at w points + + do j = j_start,j_end + do k = k_start, kte + do i = i_start, i_end + z_at_w(i,k,j) = (phb(i,k,j)+ph(i,k,j))/g + enddo + enddo + enddo + + do j = j_start,j_end + do k = k_start, kte-1 + do i = i_start, i_end + dz8w(i,k,j) = z_at_w(i,k+1,j)-z_at_w(i,k,j) + enddo + enddo + enddo + + do j = j_start,j_end + do i = i_start, i_end + dz8w(i,kte,j) = 0. + enddo + enddo + +! compute z at p points (average of z at w points) + + do j = j_start,j_end + do k = k_start, k_end + do i = i_start, i_end + z(i,k,j) = 0.5*(z_at_w(i,k,j) + z_at_w(i,k+1,j) ) +!!!! MARS MARS ajout aymeric (ainsi que les arguments de cette routine) + w_phy(i,k,j) = 0.5*(w(i,k,j) + w(i,k+1,j) ) + enddo + enddo + enddo + +! interp t and p at w points + + do j = j_start,j_end + do k = 2, k_end + do i = i_start, i_end + p8w(i,k,j) = fzm(k)*p_phy(i,k,j)+fzp(k)*p_phy(i,k-1,j) + t8w(i,k,j) = fzm(k)*t_phy(i,k,j)+fzp(k)*t_phy(i,k-1,j) + enddo + enddo + enddo + +! extrapolate p and t to surface and top. +! we'll use an extrapolation in z for now + + do j = j_start,j_end + do i = i_start, i_end + +! bottom + + z0 = z_at_w(i,1,j) + z1 = z(i,1,j) + z2 = z(i,2,j) + w1 = (z0 - z2)/(z1 - z2) + w2 = 1. - w1 + p8w(i,1,j) = w1*p_phy(i,1,j)+w2*p_phy(i,2,j) + t8w(i,1,j) = w1*t_phy(i,1,j)+w2*t_phy(i,2,j) + +! top + + z0 = z_at_w(i,kte,j) + z1 = z(i,k_end,j) + z2 = z(i,k_end-1,j) + w1 = (z0 - z2)/(z1 - z2) + w2 = 1. - w1 + +! p8w(i,kde,j) = w1*p_phy(i,kde-1,j)+w2*p_phy(i,kde-2,j) +!!! bug fix extrapolate ln(p) so p is positive definite + p8w(i,kde,j) = exp(w1*log(p_phy(i,kde-1,j))+w2*log(p_phy(i,kde-2,j))) + t8w(i,kde,j) = w1*t_phy(i,kde-1,j)+w2*t_phy(i,kde-2,j) + + enddo + enddo + +! decouple all physics tendencies + + IF (config_flags%ra_lw_physics .gt. 0 .or. config_flags%ra_sw_physics .gt. 0) THEN + + DO J=j_start,j_end + DO K=k_start,k_end + DO I=i_start,i_end + RTHRATEN(I,K,J)=RTHRATEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + + ENDIF + + IF (config_flags%cu_physics .gt. 0) THEN + + DO J=j_start,j_end + DO I=i_start,i_end + DO K=k_start,k_end + RTHCUTEN(I,K,J)=RTHCUTEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + + IF (P_QV .ge. PARAM_FIRST_SCALAR)THEN + DO J=j_start,j_end + DO I=i_start,i_end + DO K=k_start,k_end + RQVCUTEN(I,K,J)=RQVCUTEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + ENDIF + + IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN + DO J=j_start,j_end + DO I=i_start,i_end + DO K=k_start,k_end + RQCCUTEN(I,K,J)=RQCCUTEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + ENDIF + + IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN + DO J=j_start,j_end + DO I=i_start,i_end + DO K=k_start,k_end + RQRCUTEN(I,K,J)=RQRCUTEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + ENDIF + + IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN + DO J=j_start,j_end + DO I=i_start,i_end + DO K=k_start,k_end + RQICUTEN(I,K,J)=RQICUTEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + ENDIF + + IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN + DO J=j_start,j_end + DO I=i_start,i_end + DO K=k_start,k_end + RQSCUTEN(I,K,J)=RQSCUTEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + ENDIF + + ENDIF + +!!MARS MARS +! IF (config_flags%bl_pbl_physics .gt. 0) THEN + IF ( (config_flags%bl_pbl_physics .gt. 0) & + .OR. (config_flags%modif_wrf) ) THEN +!****MARS + DO J=j_start,j_end + DO K=k_start,k_end + DO I=i_start,i_end + RUBLTEN(I,K,J) =RUBLTEN(I,K,J)/mu(I,J) + RVBLTEN(I,K,J) =RVBLTEN(I,K,J)/mu(I,J) + RTHBLTEN(I,K,J)=RTHBLTEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + + IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN + DO J=j_start,j_end + DO K=k_start,k_end + DO I=i_start,i_end + RQVBLTEN(I,K,J)=RQVBLTEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + ENDIF + + IF (P_QC .ge. PARAM_FIRST_SCALAR) THEN + DO J=j_start,j_end + DO K=k_start,k_end + DO I=i_start,i_end + RQCBLTEN(I,K,J)=RQCBLTEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + ENDIF + + IF (P_QI .ge. PARAM_FIRST_SCALAR) THEN + DO J=j_start,j_end + DO K=k_start,k_end + DO I=i_start,i_end + RQIBLTEN(I,K,J)=RQIBLTEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + ENDIF + + ENDIF + +! decouple advective forcing required by Grell-Devenyi scheme + + if(( config_flags%cu_physics == GDSCHEME ) .OR. & + ( config_flags%cu_physics == G3SCHEME )) then + + DO J=j_start,j_end + DO I=i_start,i_end + DO K=k_start,k_end + RTHFTEN(I,K,J)=RTHFTEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + + IF (P_QV .ge. PARAM_FIRST_SCALAR)THEN + DO J=j_start,j_end + DO I=i_start,i_end + DO K=k_start,k_end + RQVFTEN(I,K,J)=RQVFTEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + ENDIF + + END IF + +! fdda +! note fdda u and v tendencies are staggered, also only interior points have muu/muv, +! so only decouple those + + IF (config_flags%grid_fdda .gt. 0) THEN + + i_startu=MAX(its,ids+1) + j_startv=MAX(jts,jds+1) + + DO J=j_start,j_end + DO K=k_start,k_end + DO I=i_startu,i_end + RUNDGDTEN(I,K,J) =RUNDGDTEN(I,K,J)/muu(I,J) + ENDDO + ENDDO + ENDDO + DO J=j_startv,j_end + DO K=k_start,k_end + DO I=i_start,i_end + RVNDGDTEN(I,K,J) =RVNDGDTEN(I,K,J)/muv(I,J) + ENDDO + ENDDO + ENDDO + DO J=j_start,j_end + DO K=k_start,k_end + DO I=i_start,i_end + RTHNDGDTEN(I,K,J)=RTHNDGDTEN(I,K,J)/mu(I,J) +! RMUNDGDTEN(I,J) - no coupling + ENDDO + ENDDO + ENDDO + IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN + DO J=j_start,j_end + DO K=k_start,k_end + DO I=i_start,i_end + RQVNDGDTEN(I,K,J)=RQVNDGDTEN(I,K,J)/mu(I,J) + ENDDO + ENDDO + ENDDO + ENDIF + + ENDIF + +END SUBROUTINE phy_prep + +!------------------------------------------------------------ + + SUBROUTINE moist_physics_prep_em( t_new, t_old, t0, rho, al, alb, & + p, p8w, p0, pb, ph, phb, & + th_phy, pii, pf, & + z, z_at_w, dz8w, & + dt,h_diabatic, & + config_flags,fzm, fzp, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + + IMPLICIT NONE + +! Here we construct full fields +! needed by the microphysics + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde + INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme + INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte + + REAL, INTENT(IN ) :: dt + + REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & + INTENT(IN ) :: al, & + alb, & + p, & + pb, & + ph, & + phb + + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & + fzp + + REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & + INTENT( OUT) :: rho, & + th_phy, & + pii, & + pf, & + z, & + z_at_w, & + dz8w, & + p8w + + REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & + INTENT(INOUT) :: h_diabatic + + REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & + INTENT(INOUT) :: t_new, & + t_old + + REAL, INTENT(IN ) :: t0, p0 + REAL :: z0,z1,z2,w1,w2 + + INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end + INTEGER :: i, j, k + +!-------------------------------------------------------------------- + +! +! +! moist_phys_prep_em calculates a number of diagnostic quantities needed by +! the microphysics routines. +! +! + +! set up loop bounds for this grid's boundary conditions + + i_start = its + i_end = min( ite,ide-1 ) + j_start = jts + j_end = min( jte,jde-1 ) + + k_start = kts + k_end = min( kte, kde-1 ) + + DO j = j_start, j_end + DO k = k_start, kte + DO i = i_start, i_end + z_at_w(i,k,j) = (ph(i,k,j)+phb(i,k,j))/g + ENDDO + ENDDO + ENDDO + + do j = j_start,j_end + do k = k_start, kte-1 + do i = i_start, i_end + dz8w(i,k,j) = z_at_w(i,k+1,j)-z_at_w(i,k,j) + enddo + enddo + enddo + + do j = j_start,j_end + do i = i_start, i_end + dz8w(i,kte,j) = 0. + enddo + enddo + + + ! compute full pii, rho, and z at the new time-level + ! (needed for physics). + ! convert perturbation theta to full theta (th_phy) + ! use h_diabatic to temporarily save pre-microphysics full theta + + DO j = j_start, j_end + DO k = k_start, k_end + DO i = i_start, i_end + +#ifdef REVERT + t_new(i,k,j) = t_new(i,k,j)-h_diabatic(i,k,j)*dt +#endif + th_phy(i,k,j) = t_new(i,k,j) + t0 + h_diabatic(i,k,j) = th_phy(i,k,j) + rho(i,k,j) = 1./(al(i,k,j)+alb(i,k,j)) + pii(i,k,j) = ((p(i,k,j)+pb(i,k,j))/p0)**rcp + z(i,k,j) = 0.5*(z_at_w(i,k,j) +z_at_w(i,k+1,j) ) + pf(i,k,j) = p(i,k,j)+pb(i,k,j) + + ENDDO + ENDDO + ENDDO + +! interp t and p at w points + + do j = j_start,j_end + do k = 2, k_end + do i = i_start, i_end + p8w(i,k,j) = fzm(k)*pf(i,k,j)+fzp(k)*pf(i,k-1,j) + enddo + enddo + enddo + +! extrapolate p and t to surface and top. +! we'll use an extrapolation in z for now + + do j = j_start,j_end + do i = i_start, i_end + +! bottom + + z0 = z_at_w(i,1,j) + z1 = z(i,1,j) + z2 = z(i,2,j) + w1 = (z0 - z2)/(z1 - z2) + w2 = 1. - w1 + p8w(i,1,j) = w1*pf(i,1,j)+w2*pf(i,2,j) + +! top + + z0 = z_at_w(i,kte,j) + z1 = z(i,k_end,j) + z2 = z(i,k_end-1,j) + w1 = (z0 - z2)/(z1 - z2) + w2 = 1. - w1 +! p8w(i,kde,j) = w1*pf(i,kde-1,j)+w2*pf(i,kde-2,j) + p8w(i,kde,j) = exp(w1*log(pf(i,kde-1,j))+w2*log(pf(i,kde-2,j))) + + enddo + enddo + + END SUBROUTINE moist_physics_prep_em + +!------------------------------------------------------------------------------ + + SUBROUTINE moist_physics_finish_em( t_new, t_old, t0, mut, & + th_phy, h_diabatic, dt, & + config_flags, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + + IMPLICIT NONE + +! Here we construct full fields +! needed by the microphysics + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde + INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme + INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte + + REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & + INTENT(INOUT) :: t_new, & + t_old, & + th_phy, & + h_diabatic + + REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: mut + + + REAL, INTENT(IN ) :: t0, dt + + INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end + INTEGER :: i, j, k + +!-------------------------------------------------------------------- + +! +! +! moist_phys_finish_em resets theta to its perturbation value and +! computes and stores the microphysics diabatic heating term. +! +! + +! set up loop bounds for this grid's boundary conditions + + + i_start = its + i_end = min( ite,ide-1 ) + j_start = jts + j_end = min( jte,jde-1 ) + + k_start = kts + k_end = min( kte, kde-1 ) + +! add microphysics theta diff to perturbation theta, set h_diabatic + + IF ( config_flags%no_mp_heating .eq. 0 ) THEN + DO j = j_start, j_end + DO k = k_start, k_end + DO i = i_start, i_end + t_new(i,k,j) = t_new(i,k,j) + (th_phy(i,k,j)-h_diabatic(i,k,j)) + h_diabatic(i,k,j) = (th_phy(i,k,j)-h_diabatic(i,k,j))/dt + ENDDO + ENDDO + ENDDO + + ELSE + + DO j = j_start, j_end + DO k = k_start, k_end + DO i = i_start, i_end +! t_new(i,k,j) = t_new(i,k,j) + h_diabatic(i,k,j) = 0. + ENDDO + ENDDO + ENDDO + ENDIF + + END SUBROUTINE moist_physics_finish_em + +!---------------------------------------------------------------- + + + SUBROUTINE init_module_big_step + END SUBROUTINE init_module_big_step + +SUBROUTINE set_tend ( field, field_adv_tend, msf, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: field + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN) :: field_adv_tend + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: msf + + ! Local data + + INTEGER :: i, j, k, itf, jtf, ktf + +! +! +! set_tend copies the advective tendency array into the tendency array. +! +! + + jtf = MIN(jte,jde-1) + ktf = MIN(kte,kde-1) + itf = MIN(ite,ide-1) + DO j = jts, jtf + DO k = kts, ktf + DO i = its, itf + field(i,k,j) = field_adv_tend(i,k,j)*msf(i,j) + ENDDO + ENDDO + ENDDO + +END SUBROUTINE set_tend + +!------------------------------------------------------------------------------ + + SUBROUTINE rk_rayleigh_damp( ru_tendf, rv_tendf, & + rw_tendf, t_tendf, & + u, v, w, t, t_init, & + mut, muu, muv, ph, phb, & + u_base, v_base, t_base, z_base, & + dampcoef, zdamp, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! History: Apr 2005 Modifications by George Bryan, NCAR: +! - Generalized the code in a way that allows for +! simulations with steep terrain. +! +! Jul 2004 Modifications by George Bryan, NCAR: +! - Modified the code to use u_base, v_base, and t_base +! arrays for the background state. Removed the hard-wired +! base-state values. +! - Modified the code to use dampcoef, zdamp, and damp_opt, +! i.e., the upper-level damper variables in namelist.input. +! Removed the hard-wired variables in the older version. +! This damper is used when damp_opt = 2. +! - Modified the code to account for the movement of the +! model surfaces with time. The code now obtains a base- +! state value by interpolation using the "_base" arrays. + +! Nov 2003 Bug fix by Jason Knievel, NCAR + +! Aug 2003 Meridional dimension, some comments, and +! changes in layout of the code added by +! Jason Knievel, NCAR + +! Jul 2003 Original code by Bill Skamarock, NCAR + +! Purpose: This routine applies Rayleigh damping to a layer at top +! of the model domain. + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + INTEGER, INTENT( IN ) & + :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: ru_tendf, rv_tendf, rw_tendf, t_tendf + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: u, v, w, t, t_init, ph, phb + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & + :: mut, muu, muv + + REAL, DIMENSION( kms:kme ) , INTENT(IN ) & + :: u_base, v_base, t_base, z_base + + REAL, INTENT(IN ) & + :: dampcoef, zdamp + +! Local variables. + + INTEGER & + :: i_start, i_end, j_start, j_end, k_start, k_end, i, j, k, ktf, k1, k2 + + REAL & + :: pii, dcoef, z, ztop + + REAL :: wkp1, wk, wkm1 + + REAL, DIMENSION( kms:kme ) :: z00, u00, v00, t00 + +! End declarations. +!----------------------------------------------------------------------- + + pii = 2.0 * asin(1.0) + + ktf = MIN( kte, kde-1 ) + +!----------------------------------------------------------------------- +! Adjust u to base state. + + DO j = jts, MIN( jte, jde-1 ) + DO i = its, MIN( ite, ide ) + + ! Get height at top of model + ztop = 0.5*( phb(i ,kde,j)+phb(i-1,kde,j) & + +ph(i ,kde,j)+ph(i-1,kde,j) )/g + + ! Find bottom of damping layer + k1 = ktf + z = ztop + DO WHILE( z >= (ztop-zdamp) ) + z = 0.25*( phb(i ,k1,j)+phb(i ,k1+1,j) & + +phb(i-1,k1,j)+phb(i-1,k1+1,j) & + +ph(i ,k1,j)+ph(i ,k1+1,j) & + +ph(i-1,k1,j)+ph(i-1,k1+1,j))/g + z00(k1) = z + k1 = k1 - 1 + ENDDO + k1 = k1 + 2 + + ! Get reference state at model levels + DO k = k1, ktf + k2 = ktf + DO WHILE( z_base(k2) .gt. z00(k) ) + k2 = k2 - 1 + ENDDO + if(k2+1.gt.ktf)then + u00(k) = u_base(k2) + ( u_base(k2) - u_base(k2-1) ) & + * ( z00(k) - z_base(k2) ) & + / ( z_base(k2) - z_base(k2-1) ) + else + u00(k) = u_base(k2) + ( u_base(k2+1) - u_base(k2) ) & + * ( z00(k) - z_base(k2) ) & + / ( z_base(k2+1) - z_base(k2) ) + endif + ENDDO + + ! Apply the Rayleigh damper + DO k = k1, ktf + dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp ) + dcoef = (SIN( 0.5 * pii * dcoef ) )**2 + ru_tendf(i,k,j) = ru_tendf(i,k,j) - & + muu(i,j) * ( dcoef * dampcoef ) * & + ( u(i,k,j) - u00(k) ) + END DO + + END DO + END DO + +! End adjustment of u. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Adjust v to base state. + + DO j = jts, MIN( jte, jde ) + DO i = its, MIN( ite, ide-1 ) + + ! Get height at top of model + ztop = 0.5*( phb(i,kde,j )+phb(i,kde,j-1) & + +ph(i,kde,j )+ph(i,kde,j-1) )/g + + ! Find bottom of damping layer + k1 = ktf + z = ztop + DO WHILE( z >= (ztop-zdamp) ) + z = 0.25*( phb(i,k1,j )+phb(i,k1+1,j ) & + +phb(i,k1,j-1)+phb(i,k1+1,j-1) & + +ph(i,k1,j )+ph(i,k1+1,j ) & + +ph(i,k1,j-1)+ph(i,k1+1,j-1))/g + z00(k1) = z + k1 = k1 - 1 + ENDDO + k1 = k1 + 2 + + ! Get reference state at model levels + DO k = k1, ktf + k2 = ktf + DO WHILE( z_base(k2) .gt. z00(k) ) + k2 = k2 - 1 + ENDDO + if(k2+1.gt.ktf)then + v00(k) = v_base(k2) + ( v_base(k2) - v_base(k2-1) ) & + * ( z00(k) - z_base(k2) ) & + / ( z_base(k2) - z_base(k2-1) ) + else + v00(k) = v_base(k2) + ( v_base(k2+1) - v_base(k2) ) & + * ( z00(k) - z_base(k2) ) & + / ( z_base(k2+1) - z_base(k2) ) + endif + ENDDO + + ! Apply the Rayleigh damper + DO k = k1, ktf + dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp ) + dcoef = (SIN( 0.5 * pii * dcoef ) )**2 + rv_tendf(i,k,j) = rv_tendf(i,k,j) - & + muv(i,j) * ( dcoef * dampcoef ) * & + ( v(i,k,j) - v00(k) ) + END DO + + END DO + END DO + +! End adjustment of v. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Adjust w to base state. + + DO j = jts, MIN( jte, jde-1 ) + DO i = its, MIN( ite, ide-1 ) + ztop = ( phb(i,kde,j) + ph(i,kde,j) ) / g + DO k = kts, MIN( kte, kde ) + z = ( phb(i,k,j) + ph(i,k,j) ) / g + IF ( z >= (ztop-zdamp) ) THEN + dcoef = 1.0 - MIN( 1.0, ( ztop - z ) / zdamp ) + dcoef = ( SIN( 0.5 * pii * dcoef ) )**2 + rw_tendf(i,k,j) = rw_tendf(i,k,j) - & + mut(i,j) * ( dcoef * dampcoef ) * w(i,k,j) + END IF + END DO + END DO + END DO + +! End adjustment of w. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Adjust potential temperature to base state. + + DO j = jts, MIN( jte, jde-1 ) + DO i = its, MIN( ite, ide-1 ) + + ! Get height at top of model + ztop = ( phb(i,kde,j) + ph(i,kde,j) ) / g + + ! Find bottom of damping layer + k1 = ktf + z = ztop + DO WHILE( z >= (ztop-zdamp) ) + z = 0.5 * ( phb(i,k1,j) + phb(i,k1+1,j) + & + ph(i,k1,j) + ph(i,k1+1,j) ) / g + z00(k1) = z + k1 = k1 - 1 + ENDDO + k1 = k1 + 2 + + ! Get reference state at model levels + DO k = k1, ktf + k2 = ktf + DO WHILE( z_base(k2) .gt. z00(k) ) + k2 = k2 - 1 + ENDDO + if(k2+1.gt.ktf)then + t00(k) = t_base(k2) + ( t_base(k2) - t_base(k2-1) ) & + * ( z00(k) - z_base(k2) ) & + / ( z_base(k2) - z_base(k2-1) ) + else + t00(k) = t_base(k2) + ( t_base(k2+1) - t_base(k2) ) & + * ( z00(k) - z_base(k2) ) & + / ( z_base(k2+1) - z_base(k2) ) + endif + ENDDO + + ! Apply the Rayleigh damper + DO k = k1, ktf + dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp ) + dcoef = (SIN( 0.5 * pii * dcoef ) )**2 + t_tendf(i,k,j) = t_tendf(i,k,j) - & + mut(i,j) * ( dcoef * dampcoef ) * & + ( t(i,k,j) - t00(k) ) + END DO + + END DO + END DO + +! End adjustment of potential temperature. +!----------------------------------------------------------------------- + + END SUBROUTINE rk_rayleigh_damp + +!============================================================================== +!============================================================================== + + SUBROUTINE sixth_order_diffusion( name, field, tendency, mu, dt, & + config_flags, & + diff_6th_opt, diff_6th_factor, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! History: 14 Nov 2006 Name of variable changed by Jason Knievel +! 07 Jun 2006 Revised and generalized by Jason Knievel +! 25 Apr 2005 Original code by Jason Knievel, NCAR + +! Purpose: Apply 6th-order, monotonic (flux-limited), numerical +! diffusion to 3-d velocity and to scalars. + +! References: Ming Xue (MWR Aug 2000) +! Durran ("Numerical Methods for Wave Equations..." 1999) +! George Bryan (personal communication) + +!------------------------------------------------------------------------------ +! Begin: Declarations. + + IMPLICIT NONE + + INTEGER, INTENT(IN) & + :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + TYPE(grid_config_rec_type), INTENT(IN) & + :: config_flags + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) & + :: tendency + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) & + :: field + + REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) & + :: mu + + REAL, INTENT(IN) & + :: dt + + REAL, INTENT(IN) & + :: diff_6th_factor + + INTEGER, INTENT(IN) & + :: diff_6th_opt + + CHARACTER(LEN=1) , INTENT(IN) & + :: name + + INTEGER & + :: i, j, k, & + i_start, i_end, & + j_start, j_end, & + k_start, k_end, & + ktf + + REAL & + :: dflux_x_p0, dflux_y_p0, & + dflux_x_p1, dflux_y_p1, & + tendency_x, tendency_y, & + mu_avg_p0, mu_avg_p1, & + diff_6th_coef + + LOGICAL & + :: specified + +! End: Declarations. +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +! Begin: Translate the diffusion factor into a diffusion coefficient. See +! Durran's text, section 2.4.3, then adjust for sixth-order diffusion (not +! fourth) and for diffusion in two dimensions (not one). For reference, a +! factor of 1.0 would mean complete diffusion of a 2dx wave in one time step, +! although application of the flux limiter reduces somewhat the effects of +! diffusion for a given coefficient. + + diff_6th_coef = diff_6th_factor * 0.015625 / ( 2.0 * dt ) + +! End: Translate diffusion factor. +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +! Begin: Assign limits of spatial loops depending on variable to be diffused. +! The halo regions are already filled with values by the time this subroutine +! is called, which allows the stencil to extend beyond the domains' edges. + + ktf = MIN( kte, kde-1 ) + + IF ( name .EQ. 'u' ) THEN + + i_start = its + i_end = ite + j_start = jts + j_end = MIN(jde-1,jte) + k_start = kts + k_end = ktf + + ELSE IF ( name .EQ. 'v' ) THEN + + i_start = its + i_end = MIN(ide-1,ite) + j_start = jts + j_end = jte + k_start = kts + k_end = ktf + + ELSE IF ( name .EQ. 'w' ) THEN + + i_start = its + i_end = MIN(ide-1,ite) + j_start = jts + j_end = MIN(jde-1,jte) + k_start = kts+1 + k_end = ktf + + ELSE + + i_start = its + i_end = MIN(ide-1,ite) + j_start = jts + j_end = MIN(jde-1,jte) + k_start = kts + k_end = ktf + + ENDIF + +! End: Assignment of limits of spatial loops. +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +! Begin: Loop across spatial dimensions. + + DO j = j_start, j_end + DO k = k_start, k_end + DO i = i_start, i_end + +!------------------------------------------------------------------------------ +! Begin: Diffusion in x (i index). + +! Calculate the diffusive flux in x direction (from Xue's eq. 3). + + dflux_x_p0 = ( 10.0 * ( field(i, k,j) - field(i-1,k,j) ) & + - 5.0 * ( field(i+1,k,j) - field(i-2,k,j) ) & + + ( field(i+2,k,j) - field(i-3,k,j) ) ) + + dflux_x_p1 = ( 10.0 * ( field(i+1,k,j) - field(i ,k,j) ) & + - 5.0 * ( field(i+2,k,j) - field(i-1,k,j) ) & + + ( field(i+3,k,j) - field(i-2,k,j) ) ) + +! If requested in the namelist (diff_6th_opt=2), prohibit up-gradient diffusion +! (variation on Xue's eq. 10). + + IF ( diff_6th_opt .EQ. 2 ) THEN + + IF ( dflux_x_p0 * ( field(i ,k,j)-field(i-1,k,j) ) .LE. 0.0 ) THEN + dflux_x_p0 = 0.0 + END IF + + IF ( dflux_x_p1 * ( field(i+1,k,j)-field(i ,k,j) ) .LE. 0.0 ) THEN + dflux_x_p1 = 0.0 + END IF + + END IF + +! Apply 6th-order diffusion in x direction. + + IF ( name .EQ. 'u' ) THEN + mu_avg_p0 = mu(i-1,j) + mu_avg_p1 = mu(i ,j) + ELSE IF ( name .EQ. 'v' ) THEN + mu_avg_p0 = 0.25 * ( & + mu(i-1,j-1) + & + mu(i ,j-1) + & + mu(i-1,j ) + & + mu(i ,j ) ) + mu_avg_p1 = 0.25 * ( & + mu(i ,j-1) + & + mu(i+1,j-1) + & + mu(i ,j ) + & + mu(i+1,j ) ) + ELSE + mu_avg_p0 = 0.5 * ( & + mu(i-1,j) + & + mu(i ,j) ) + mu_avg_p1 = 0.5 * ( & + mu(i ,j) + & + mu(i+1,j) ) + END IF + + tendency_x = diff_6th_coef * & + ( ( mu_avg_p1 * dflux_x_p1 ) - ( mu_avg_p0 * dflux_x_p0 ) ) + +! End: Diffusion in x. +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +! Begin: Diffusion in y (j index). + +! Calculate the diffusive flux in y direction (from Xue's eq. 3). + + dflux_y_p0 = ( 10.0 * ( field(i,k,j ) - field(i,k,j-1) ) & + - 5.0 * ( field(i,k,j+1) - field(i,k,j-2) ) & + + ( field(i,k,j+2) - field(i,k,j-3) ) ) + + dflux_y_p1 = ( 10.0 * ( field(i,k,j+1) - field(i,k,j ) ) & + - 5.0 * ( field(i,k,j+2) - field(i,k,j-1) ) & + + ( field(i,k,j+3) - field(i,k,j-2) ) ) + +! If requested in the namelist (diff_6th_opt=2), prohibit up-gradient diffusion +! (variation on Xue's eq. 10). + + IF ( diff_6th_opt .EQ. 2 ) THEN + + IF ( dflux_y_p0 * ( field(i,k,j )-field(i,k,j-1) ) .LE. 0.0 ) THEN + dflux_y_p0 = 0.0 + END IF + + IF ( dflux_y_p1 * ( field(i,k,j+1)-field(i,k,j ) ) .LE. 0.0 ) THEN + dflux_y_p1 = 0.0 + END IF + + END IF + +! Apply 6th-order diffusion in y direction. + + IF ( name .EQ. 'u' ) THEN + mu_avg_p0 = 0.25 * ( & + mu(i-1,j-1) + & + mu(i ,j-1) + & + mu(i-1,j ) + & + mu(i ,j ) ) + mu_avg_p1 = 0.25 * ( & + mu(i-1,j ) + & + mu(i ,j ) + & + mu(i-1,j+1) + & + mu(i ,j+1) ) + ELSE IF ( name .EQ. 'v' ) THEN + mu_avg_p0 = mu(i,j-1) + mu_avg_p1 = mu(i,j ) + ELSE + mu_avg_p0 = 0.5 * ( & + mu(i,j-1) + & + mu(i,j ) ) + mu_avg_p1 = 0.5 * ( & + mu(i,j ) + & + mu(i,j+1) ) + END IF + + tendency_y = diff_6th_coef * & + ( ( mu_avg_p1 * dflux_y_p1 ) - ( mu_avg_p0 * dflux_y_p0 ) ) + +! End: Diffusion in y. +!------------------------------------------------------------------------------ + +!------------------------------------------------------------------------------ +! Begin: Combine diffusion in x and y. + + tendency(i,k,j) = tendency(i,k,j) + tendency_x + tendency_y + +! End: Combine diffusion in x and y. +!------------------------------------------------------------------------------ + + ENDDO + ENDDO + ENDDO + +! End: Loop across spatial dimensions. +!------------------------------------------------------------------------------ + + END SUBROUTINE sixth_order_diffusion + +!============================================================================== +!============================================================================== + +END MODULE module_big_step_utilities_em Index: /trunk/WRF.COMMON/WRFV3/dyn_em/module_diffusion_em.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/dyn_em/module_diffusion_em.F (revision 2761) +++ /trunk/WRF.COMMON/WRFV3/dyn_em/module_diffusion_em.F (revision 2761) @@ -0,0 +1,5525 @@ +! WRF:MODEL_LAYER:PHYSICS + + MODULE module_diffusion_em + + USE module_configure + USE module_bc + USE module_state_description + USE module_big_step_utilities_em + USE module_model_constants + USE module_wrf_error + + CONTAINS + +!======================================================================= +!======================================================================= + + SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & + defor11, defor22, defor33, & + defor12, defor13, defor23, & + u_base, v_base, msfux, msfuy, & + msfvx, msfvy, msftx, msfty, & + rdx, rdy, dn, dnw, rdz, rdzw, & + fnm, fnp, cf1, cf2, cf3, zx, zy, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! History: Sep 2003 Changes by Jason Knievel and George Bryan, NCAR +! Oct 2001 Converted to mass core by Bill Skamarock, NCAR +! ... ... + +! Purpose: This routine calculates deformation and 3-d divergence. + +! References: Klemp and Wilhelmson (JAS 1978) +! Chen and Dudhia (NCAR WRF physics report 2000) + +!----------------------------------------------------------------------- +! Comments 10-MAR-05 +! Equations 13a-f, Chen and Dudhia 2000, Appendix A: +! Eqn 13a: D11=defor11= 2m^2 * (partial du^/dX + partial dpsi/dx * partial du^/dpsi) +! Eqn 13b: D22=defor22= 2m^2 * (partial dv^/dY + partial dpsi/dy * partial dv^/dpsi) +! Eqn 13c: D33=defor33= 2 * partial dw/dz [SIMPLER FORM] +! Eqn 13d: D12=defor12= m^2 * (partial dv^/dX + partial du^/dY + +! partial dpsi/dx * partial dv^/dpsi + +! partial dpsi/dy * partial du^/dpsi) +! Eqn 13e: D13=defor13= m^2 * (partial dw^/dX + partial dpsi/dx * partial dw^/dpsi) +! + partial du/dz [SIMPLER FORM] +! Eqn 13f: D23=defor23= m^2 * (partial dw^/dY + partial dpsi/dy * partial dw^/dpsi) +! + partial dv/dz [SIMPLER FORM] +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type ), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, INTENT( IN ) & + :: rdx, rdy, cf1, cf2, cf3 + + REAL, DIMENSION( kms:kme ), INTENT( IN ) & + :: fnm, fnp, dn, dnw, u_base, v_base + + REAL, DIMENSION( ims:ime , jms:jme ), INTENT( IN ) & + :: msfux, msfuy, msfvx, msfvy, msftx, msfty + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: u, v, w, zx, zy, rdz, rdzw + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: defor11, defor22, defor33, defor12, defor13, defor23, div + +! Local variables. + + INTEGER & + :: i, j, k, ktf, ktes1, ktes2, i_start, i_end, j_start, j_end + + REAL & + :: tmp, tmpzx, tmpzy, tmpzeta_z, cft1, cft2 + + REAL, DIMENSION( its:ite, jts:jte ) & + :: mm, zzavg, zeta_zd12 + + REAL, DIMENSION( its-2:ite+2, kts:kte, jts-2:jte+2 ) & + :: tmp1, hat, hatavg + +! End declarations. +!----------------------------------------------------------------------- + +! Comments 10-MAR-2005 +! Treat all differentials as 'div-style' [or 'curl-style'], +! i.e., du/dX becomes (in map coordinate space) mx*my * d(u/my)/dx, +! NB - all equations referred to here are from Chen and Dudhia 2002, from the +! WRF physics documents web pages: +! http://www.mmm.ucar.edu/wrf/users/docs/wrf-doc-physics.pdf + +!======================================================================= +! In the following section, calculate 3-d divergence and the first three +! (defor11, defor22, defor33) of six deformation terms. + + ktes1 = kte-1 + ktes2 = kte-2 + + cft2 = - 0.5 * dnw(ktes1) / dn(ktes1) + cft1 = 1.0 - cft2 + + ktf = MIN( kte, kde-1 ) + + i_start = its + i_end = MIN( ite, ide-1 ) + j_start = jts + j_end = MIN( jte, jde-1 ) + +! Square the map scale factor. + + DO j = j_start, j_end + DO i = i_start, i_end + mm(i,j) = msftx(i,j) * msfty(i,j) + END DO + END DO + +!----------------------------------------------------------------------- +! Calculate du/dx. + +! Apply a coordinate transformation to zonal velocity, u. + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end+1 + hat(i,k,j) = u(i,k,j) / msfuy(i,j) + END DO + END DO + END DO + +! Average in x and z. + + DO j=j_start,j_end + DO k=kts+1,ktf + DO i=i_start,i_end + hatavg(i,k,j) = 0.5 * & + ( fnm(k) * ( hat(i,k ,j) + hat(i+1, k,j) ) + & + fnp(k) * ( hat(i,k-1,j) + hat(i+1,k-1,j) ) ) + END DO + END DO + END DO + +! Extrapolate to top and bottom of domain (to w levels). + + DO j = j_start, j_end + DO i = i_start, i_end + hatavg(i,1,j) = 0.5 * ( & + cf1 * hat(i ,1,j) + & + cf2 * hat(i ,2,j) + & + cf3 * hat(i ,3,j) + & + cf1 * hat(i+1,1,j) + & + cf2 * hat(i+1,2,j) + & + cf3 * hat(i+1,3,j) ) + hatavg(i,kte,j) = 0.5 * ( & + cft1 * ( hat(i,ktes1,j) + hat(i+1,ktes1,j) ) + & + cft2 * ( hat(i,ktes2,j) + hat(i+1,ktes2,j) ) ) + END DO + END DO + + ! Comments 10-MAR-05 + ! Eqn 13a: D11=defor11= 2m^2 * (partial du^/dX + partial dpsi/dx * partial du^/dpsi) + ! Below, D11 is set = 2*tmp1 + ! => tmp1 = m^2 * (partial du^/dX + partial dpsi/dx * partial du^/dpsi) + ! tmpzx = averaged value of dpsi/dx (=zx) + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tmpzx = 0.25 * ( & + zx(i,k ,j) + zx(i+1,k ,j) + & + zx(i,k+1,j) + zx(i+1,k+1,j) ) + tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) *tmpzx * rdzw(i,k,j) + ! tmp1 to here = partial dpsi/dx * partial du^/dpsi: + END DO + END DO + END DO + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tmp1(i,k,j) = mm(i,j) * ( rdx * ( hat(i+1,k,j) - hat(i,k,j) ) - & + tmp1(i,k,j)) + END DO + END DO + END DO + +! End calculation of du/dx. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Calculate defor11 (2*du/dx). +! Comments 10-MAR-05 +! Eqn 13a: D11=defor11= 2 m^2 * (partial du^/dX + partial dpsi/dx * partial du^/dpsi) +! = 2*tmp1 + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + defor11(i,k,j) = 2.0 * tmp1(i,k,j) + END DO + END DO + END DO + +! End calculation of defor11. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Calculate zonal divergence (du/dx) and add it to the divergence array. + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + div(i,k,j) = tmp1(i,k,j) + END DO + END DO + END DO + +! End calculation of zonal divergence. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Calculate dv/dy. + +! Apply a coordinate transformation to meridional velocity, v. + + DO j = j_start, j_end+1 + DO k = kts, ktf + DO i = i_start, i_end + ! Because msfvx at the poles will be undefined (1./0.), we will have + ! trouble. But we are OK since v at the poles is 0., and that takes + ! precedence in this case. + IF ((config_flags%polar) .AND. ((j == jds) .OR. (j == jde))) THEN + hat(i,k,j) = 0. + ELSE ! normal code + hat(i,k,j) = v(i,k,j) / msfvx(i,j) + ENDIF + END DO + END DO + END DO + +! Account for the slope in y of eta surfaces. + + DO j=j_start,j_end + DO k=kts+1,ktf + DO i=i_start,i_end + hatavg(i,k,j) = 0.5 * ( & + fnm(k) * ( hat(i,k ,j) + hat(i,k ,j+1) ) + & + fnp(k) * ( hat(i,k-1,j) + hat(i,k-1,j+1) ) ) + END DO + END DO + END DO + +! Extrapolate to top and bottom of domain (to w levels). + + DO j = j_start, j_end + DO i = i_start, i_end + hatavg(i,1,j) = 0.5 * ( & + cf1 * hat(i,1,j ) + & + cf2 * hat(i,2,j ) + & + cf3 * hat(i,3,j ) + & + cf1 * hat(i,1,j+1) + & + cf2 * hat(i,2,j+1) + & + cf3 * hat(i,3,j+1) ) + hatavg(i,kte,j) = 0.5 * ( & + cft1 * ( hat(i,ktes1,j) + hat(i,ktes1,j+1) ) + & + cft2 * ( hat(i,ktes2,j) + hat(i,ktes2,j+1) ) ) + END DO + END DO + + ! Comments 10-MAR-05 + ! Eqn 13b: D22=defor22= 2m^2 * (partial dv^/dY + partial dpsi/dy * partial dv^/dpsi) + ! Below, D22 is set = 2*tmp1 + ! => tmp1 = m^2 * (partial dv^/dY + partial dpsi/dy * partial dv^/dpsi) + ! tmpzy = averaged value of dpsi/dy (=zy) + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tmpzy = 0.25 * ( & + zy(i,k ,j) + zy(i,k ,j+1) + & + zy(i,k+1,j) + zy(i,k+1,j+1) ) + tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) * tmpzy * rdzw(i,k,j) + ! tmp1 to here = partial dpsi/dy * partial dv^/dpsi: + END DO + END DO + END DO + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tmp1(i,k,j) = mm(i,j) * ( & + rdy * ( hat(i,k,j+1) - hat(i,k,j) ) - tmp1(i,k,j) ) + END DO + END DO + END DO + +! End calculation of dv/dy. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Calculate defor22 (2*dv/dy). +! Comments 10-MAR-05 +! Eqn 13b: D22=defor22= 2 m^2 * (partial dv^/dY + partial dpsi/dy * partial dv^/dpsi) +! = 2*tmp1 + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + defor22(i,k,j) = 2.0 * tmp1(i,k,j) + END DO + END DO + END DO + +! End calculation of defor22. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Calculate meridional divergence (dv/dy) and add it to the divergence +! array. + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + div(i,k,j) = div(i,k,j) + tmp1(i,k,j) + END DO + END DO + END DO + +! End calculation of meridional divergence. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Comments 10-MAR-05 +! Eqn 13c: D33=defor33= 2 * partial dw/dz +! Below, D33 is set = 2*tmp1 +! => tmp1 = partial dw/dz + +! Calculate dw/dz. + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tmp1(i,k,j) = ( w(i,k+1,j) - w(i,k,j) ) * rdzw(i,k,j) + END DO + END DO + END DO + +! End calculation of dw/dz. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Calculate defor33 (2*dw/dz). + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + defor33(i,k,j) = 2.0 * tmp1(i,k,j) + END DO + END DO + END DO + +! End calculation of defor33. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Calculate vertical divergence (dw/dz) and add it to the divergence +! array. + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + div(i,k,j) = div(i,k,j) + tmp1(i,k,j) + END DO + END DO + END DO + +! End calculation of vertical divergence. +!----------------------------------------------------------------------- + +! Three-dimensional divergence is now finished and values are in array +! "div." Also, the first three (defor11, defor22, defor33) of six +! deformation terms are now calculated at pressure points. +!======================================================================= + +! Comments 10-MAR-2005 +! Treat all differentials as 'div-style' [or 'curl-style'], +! i.e., du/dY becomes (in map coordinate space) mx*my * d(u/mx)/dy, +! dv/dX becomes (in map coordinate space) mx*my * d(v/my)/dx, +! (see e.g. Haltiner and Williams p. 441) + +!======================================================================= +! Calculate the final three deformations (defor12, defor13, defor23) at +! vorticity points. + + i_start = its + i_end = ite + j_start = jts + j_end = jte + + IF ( config_flags%open_xs .OR. config_flags%specified .OR. & + config_flags%nested) i_start = MAX( ids+1, its ) + IF ( config_flags%open_xe .OR. config_flags%specified .OR. & + config_flags%nested) i_end = MIN( ide-1, ite ) + IF ( config_flags%open_ys .OR. config_flags%specified .OR. & + config_flags%nested) j_start = MAX( jds+1, jts ) + IF ( config_flags%open_ye .OR. config_flags%specified .OR. & + config_flags%nested) j_end = MIN( jde-1, jte ) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = ite + + +!----------------------------------------------------------------------- +! Calculate du/dy. + +! First, calculate an average mapscale factor. + +! Comments 10-MAR-05 +! du/dy => need u map scale factor in x (which is defined at u points) +! averaged over j and j-1 +! dv/dx => need v map scale factor in y (which is defined at v points) +! averaged over i and i-1 + + DO j = j_start, j_end + DO i = i_start, i_end + mm(i,j) = 0.25 * ( msfux(i,j-1) + msfux(i,j) ) * ( msfvy(i-1,j) + msfvy(i,j) ) + END DO + END DO + +! Apply a coordinate transformation to zonal velocity, u. + + DO j =j_start-1, j_end + DO k =kts, ktf + DO i =i_start, i_end + ! Fixes to set_physical_bc2/3d for polar boundary conditions + ! remove issues with loop over j + hat(i,k,j) = u(i,k,j) / msfux(i,j) + END DO + END DO + END DO + +! Average in y and z. + + DO j=j_start,j_end + DO k=kts+1,ktf + DO i=i_start,i_end + hatavg(i,k,j) = 0.5 * ( & + fnm(k) * ( hat(i,k ,j-1) + hat(i,k ,j) ) + & + fnp(k) * ( hat(i,k-1,j-1) + hat(i,k-1,j) ) ) + END DO + END DO + END DO + +! Extrapolate to top and bottom of domain (to w levels). + + DO j = j_start, j_end + DO i = i_start, i_end + hatavg(i,1,j) = 0.5 * ( & + cf1 * hat(i,1,j-1) + & + cf2 * hat(i,2,j-1) + & + cf3 * hat(i,3,j-1) + & + cf1 * hat(i,1,j ) + & + cf2 * hat(i,2,j ) + & + cf3 * hat(i,3,j ) ) + hatavg(i,kte,j) = 0.5 * ( & + cft1 * ( hat(i,ktes1,j-1) + hat(i,ktes1,j) ) + & + cft2 * ( hat(i,ktes2,j-1) + hat(i,ktes2,j) ) ) + END DO + END DO + + ! tmpzy = averaged value of dpsi/dy (=zy) on vorticity grid + ! tmp1 = partial dpsi/dy * partial du^/dpsi + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tmpzy = 0.25 * ( & + zy(i-1,k ,j) + zy(i,k ,j) + & + zy(i-1,k+1,j) + zy(i,k+1,j) ) + tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) * & + 0.25 * tmpzy * ( rdzw(i,k,j) + rdzw(i-1,k,j) + & + rdzw(i-1,k,j-1) + rdzw(i,k,j-1) ) + END DO + END DO + END DO + +! End calculation of du/dy. +!---------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Add the first term to defor12 (du/dy+dv/dx) at vorticity points. + +! Comments 10-MAR-05 +! Eqn 13d: D12=defor12= m^2 * (partial dv^/dX + partial du^/dY + +! partial dpsi/dx * partial dv^/dpsi + +! partial dpsi/dy * partial du^/dpsi) +! Here deal with m^2 * (partial du^/dY + partial dpsi/dy * partial du^/dpsi) +! Still need to add v^ terms: +! m^2 * (partial dv^/dX + partial dpsi/dx * partial dv^/dpsi) + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + defor12(i,k,j) = mm(i,j) * ( & + rdy * ( hat(i,k,j) - hat(i,k,j-1) ) - tmp1(i,k,j) ) + END DO + END DO + END DO + +! End addition of the first term to defor12. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Calculate dv/dx. + +! Apply a coordinate transformation to meridional velocity, v. + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start-1, i_end + hat(i,k,j) = v(i,k,j) / msfvy(i,j) + END DO + END DO + END DO + +! Account for the slope in x of eta surfaces. + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + hatavg(i,k,j) = 0.5 * ( & + fnm(k) * ( hat(i-1,k ,j) + hat(i,k ,j) ) + & + fnp(k) * ( hat(i-1,k-1,j) + hat(i,k-1,j) ) ) + END DO + END DO + END DO + +! Extrapolate to top and bottom of domain (to w levels). + + DO j = j_start, j_end + DO i = i_start, i_end + hatavg(i,1,j) = 0.5 * ( & + cf1 * hat(i-1,1,j) + & + cf2 * hat(i-1,2,j) + & + cf3 * hat(i-1,3,j) + & + cf1 * hat(i ,1,j) + & + cf2 * hat(i ,2,j) + & + cf3 * hat(i ,3,j) ) + hatavg(i,kte,j) = 0.5 * ( & + cft1 * ( hat(i,ktes1,j) + hat(i-1,ktes1,j) ) + & + cft2 * ( hat(i,ktes2,j) + hat(i-1,ktes2,j) ) ) + END DO + END DO + + ! Fixes to set_physical_bc2/3d have made any check for polar B.C.'s + ! unnecessary in this place. zx, rdzw, and hatavg are all defined + ! in places they need to be and the values at the poles are replications + ! of the values one grid point in, so the averaging over j and j-1 works + ! to act as just using the value at j or j-1 (with out extra code). + ! + ! tmpzx = averaged value of dpsi/dx (=zx) on vorticity grid + ! tmp1 = partial dpsi/dx * partial dv^/dpsi + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tmpzx = 0.25 * ( & + zx(i,k ,j-1) + zx(i,k ,j) + & + zx(i,k+1,j-1) + zx(i,k+1,j) ) + tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) * & + 0.25 * tmpzx * ( rdzw(i,k,j) + rdzw(i,k,j-1) + & + rdzw(i-1,k,j-1) + rdzw(i-1,k,j) ) + END DO + END DO + END DO + +! End calculation of dv/dx. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Add the second term to defor12 (du/dy+dv/dx) at vorticity points. + +! Comments 10-MAR-05 +! Eqn 13d: D12=defor12= m^2 * (partial dv^/dX + partial du^/dY + +! partial dpsi/dx * partial dv^/dpsi + +! partial dpsi/dy * partial du^/dpsi) +! Here adding v^ terms: +! m^2 * (partial dv^/dX + partial dpsi/dx * partial dv^/dpsi) + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + defor12(i,k,j) = defor12(i,k,j) + & + mm(i,j) * ( & + rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) ) + END DO + END DO + END DO + +! End addition of the second term to defor12. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Update the boundary for defor12 (might need to change later). + + IF ( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1 ) THEN + DO j = jts, jte + DO k = kts, kte + defor12(ids,k,j) = defor12(ids+1,k,j) + END DO + END DO + END IF + + IF ( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN + DO k = kts, kte + DO i = its, ite + defor12(i,k,jds) = defor12(i,k,jds+1) + END DO + END DO + END IF + + IF ( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN + DO j = jts, jte + DO k = kts, kte + defor12(ide,k,j) = defor12(ide-1,k,j) + END DO + END DO + END IF + + IF ( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN + DO k = kts, kte + DO i = its, ite + defor12(i,k,jde) = defor12(i,k,jde-1) + END DO + END DO + END IF + +! End update of boundary for defor12. +!----------------------------------------------------------------------- + +! Comments 10-MAR-05 +! Further deformation terms not needed for 2-dimensional Smagorinsky diffusion, +! so those terms have not been dealt with yet. +! A "y" has simply been added to all map scale factors to allow the model to +! compile without errors. + +!----------------------------------------------------------------------- +! Calculate dw/dx. + + i_start = its + i_end = MIN( ite, ide-1 ) + j_start = jts + j_end = MIN( jte, jde-1 ) + + IF ( config_flags%open_xs .OR. config_flags%specified .OR. & + config_flags%nested) i_start = MAX( ids+1, its ) + IF ( config_flags%open_ys .OR. config_flags%specified .OR. & + config_flags%nested) j_start = MAX( jds+1, jts ) + + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN( ite, ide ) + IF ( config_flags%periodic_y ) j_end = MIN( jte, jde ) + +! Square the mapscale factor. + + DO j = jts, jte + DO i = its, ite + mm(i,j) = msfux(i,j) * msfuy(i,j) + END DO + END DO + +! Apply a coordinate transformation to vertical velocity, w. This is for both +! defor13 and defor23. + + DO j = j_start, j_end + DO k = kts, kte + DO i = i_start, i_end + hat(i,k,j) = w(i,k,j) / msfty(i,j) + END DO + END DO + END DO + + i = i_start-1 + DO j = j_start, MIN( jte, jde-1 ) + DO k = kts, kte + hat(i,k,j) = w(i,k,j) / msfty(i,j) + END DO + END DO + + j = j_start-1 + DO k = kts, kte + DO i = i_start, MIN( ite, ide-1 ) + hat(i,k,j) = w(i,k,j) / msfty(i,j) + END DO + END DO + +! QUESTION: What is this for? + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + hatavg(i,k,j) = 0.25 * ( & + hat(i ,k ,j) + & + hat(i ,k+1,j) + & + hat(i-1,k ,j) + & + hat(i-1,k+1,j) ) + END DO + END DO + END DO + +! Calculate dw/dx. + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + tmp1(i,k,j) = ( hatavg(i,k,j) - hatavg(i,k-1,j) ) * zx(i,k,j) * & + 0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) ) + END DO + END DO + END DO + +! End calculation of dw/dx. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Add the first term (dw/dx) to defor13 (dw/dx+du/dz) at vorticity +! points. + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + defor13(i,k,j) = mm(i,j) * ( & + rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) ) + END DO + END DO + END DO + + DO j = j_start, j_end + DO i = i_start, i_end + defor13(i,kts,j ) = 0.0 + defor13(i,ktf+1,j) = 0.0 + END DO + END DO + +! End addition of the first term to defor13. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Calculate du/dz. + + IF ( config_flags%mix_full_fields ) THEN + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + tmp1(i,k,j) = ( u(i,k,j) - u(i,k-1,j) ) * & + 0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) ) + END DO + END DO + END DO + + ELSE + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + tmp1(i,k,j) = ( u(i,k,j) - u_base(k) - u(i,k-1,j) + u_base(k-1) ) * & + 0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) ) + END DO + END DO + END DO + + END IF + +!----------------------------------------------------------------------- +! Add the second term (du/dz) to defor13 (dw/dx+du/dz) at vorticity +! points. + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + defor13(i,k,j) = defor13(i,k,j) + tmp1(i,k,j) + END DO + END DO + END DO + +! End addition of the second term to defor13. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Calculate dw/dy. + + i_start = its + i_end = MIN( ite, ide-1 ) + j_start = jts + j_end = MIN( jte, jde-1 ) + + IF ( config_flags%open_xs .OR. config_flags%specified .OR. & + config_flags%nested) i_start = MAX( ids+1, its ) + IF ( config_flags%open_ys .OR. config_flags%specified .OR. & + config_flags%nested) j_start = MAX( jds+1, jts ) + IF ( config_flags%periodic_y ) j_end = MIN( jte, jde ) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) + +! Square mapscale factor. + + DO j = jts, jte + DO i = its, ite + mm(i,j) = msfvx(i,j) * msfvy(i,j) + END DO + END DO + +! Apply a coordinate transformation to vertical velocity, w. Added by CW 7/19/07 + + DO j = j_start, j_end + DO k = kts, kte + DO i = i_start, i_end + hat(i,k,j) = w(i,k,j) / msftx(i,j) + END DO + END DO + END DO + + i = i_start-1 + DO j = j_start, MIN( jte, jde-1 ) + DO k = kts, kte + hat(i,k,j) = w(i,k,j) / msftx(i,j) + END DO + END DO + + j = j_start-1 + DO k = kts, kte + DO i = i_start, MIN( ite, ide-1 ) + hat(i,k,j) = w(i,k,j) / msftx(i,j) + END DO + END DO + +! QUESTION: What is this for? + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + hatavg(i,k,j) = 0.25 * ( & + hat(i,k ,j ) + & + hat(i,k+1,j ) + & + hat(i,k ,j-1) + & + hat(i,k+1,j-1) ) + END DO + END DO + END DO + +! Calculate dw/dy and store in tmp1. + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + tmp1(i,k,j) = ( hatavg(i,k,j) - hatavg(i,k-1,j) ) * zy(i,k,j) * & + 0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) ) + END DO + END DO + END DO + +! End calculation of dw/dy. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Add the first term (dw/dy) to defor23 (dw/dy+dv/dz) at vorticity +! points. + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + defor23(i,k,j) = mm(i,j) * ( & + rdy * ( hat(i,k,j) - hat(i,k,j-1) ) - tmp1(i,k,j) ) + END DO + END DO + END DO + + DO j = j_start, j_end + DO i = i_start, i_end + defor23(i,kts,j ) = 0.0 + defor23(i,ktf+1,j) = 0.0 + END DO + END DO + +! End addition of the first term to defor23. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Calculate dv/dz. + + IF ( config_flags%mix_full_fields ) THEN + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + tmp1(i,k,j) = ( v(i,k,j) - v(i,k-1,j) ) * & + 0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) ) + END DO + END DO + END DO + + ELSE + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + tmp1(i,k,j) = ( v(i,k,j) - v_base(k) - v(i,k-1,j) + v_base(k-1) ) * & + 0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) ) + END DO + END DO + END DO + + END IF + +! End calculation of dv/dz. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Add the second term (dv/dz) to defor23 (dw/dy+dv/dz) at vorticity +! points. + +! Add tmp1 to defor23. + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + defor23(i,k,j) = defor23(i,k,j) + tmp1(i,k,j) + END DO + END DO + END DO + +! End addition of the second term to defor23. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Update the boundary for defor13 and defor23 (might need to change +! later). + + IF ( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1) THEN + DO j = jts, jte + DO k = kts, kte + defor13(ids,k,j) = defor13(ids+1,k,j) + defor23(ids,k,j) = defor23(ids+1,k,j) + END DO + END DO + END IF + + IF ( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN + DO k = kts, kte + DO i = its, ite + defor13(i,k,jds) = defor13(i,k,jds+1) + defor23(i,k,jds) = defor23(i,k,jds+1) + END DO + END DO + END IF + + IF ( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN + DO j = jts, jte + DO k = kts, kte + defor13(ide,k,j) = defor13(ide-1,k,j) + defor23(ide,k,j) = defor23(ide-1,k,j) + END DO + END DO + END IF + + IF ( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN + DO k = kts, kte + DO i = its, ite + defor13(i,k,jde) = defor13(i,k,jde-1) + defor23(i,k,jde) = defor23(i,k,jde-1) + END DO + END DO + END IF + +! End update of boundary for defor13 and defor23. +!----------------------------------------------------------------------- + +! The second three (defor12, defor13, defor23) of six deformation terms +! are now calculated at vorticity points. +!======================================================================= + + END SUBROUTINE cal_deform_and_div + +!======================================================================= +!======================================================================= + + SUBROUTINE calculate_km_kh( config_flags, dt, & + dampcoef, zdamp, damp_opt, & + xkmh, xkmv, xkhh, xkhv, & + BN2, khdif, kvdif, div, & + defor11, defor22, defor33, & + defor12, defor13, defor23, & + tke, p8w, t8w, theta, t, p, moist, & + dn, dnw, dx, dy, rdz, rdzw, isotropic, & + n_moist, cf1, cf2, cf3, warm_rain, & + mix_upper_bound, & + msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! History: Sep 2003 Changes by George Bryan and Jason Knievel, NCAR +! Oct 2001 Converted to mass core by Bill Skamarock, NCAR +! ... ... + +! Purpose: This routine calculates exchange coefficients for the TKE +! scheme. + +! References: Klemp and Wilhelmson (JAS 1978) +! Deardorff (B-L Meteor 1980) +! Chen and Dudhia (NCAR WRF physics report 2000) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type ), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: n_moist, damp_opt, isotropic, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + LOGICAL, INTENT( IN ) & + :: warm_rain + + REAL, INTENT( IN ) & + :: dx, dy, zdamp, dt, dampcoef, cf1, cf2, cf3, khdif, kvdif + + REAL, DIMENSION( kms:kme ), INTENT( IN ) & + :: dnw, dn + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ), INTENT( INOUT ) & + :: moist + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: xkmv, xkmh, xkhv, xkhh, BN2 + + REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT( IN ) & + :: defor11, defor22, defor33, defor12, defor13, defor23, & + div, rdz, rdzw, p8w, t8w, theta, t, p + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: tke + + REAL, INTENT( IN ) & + :: mix_upper_bound + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & + :: msftx, msfty + +! Local variables. + + INTEGER & + :: i_start, i_end, j_start, j_end, ktf, i, j, k + +! End declarations. +!----------------------------------------------------------------------- + + ktf = MIN( kte, kde-1 ) + i_start = its + i_end = MIN( ite, ide-1 ) + j_start = jts + j_end = MIN( jte, jde-1 ) + + CALL calculate_N2( config_flags, BN2, moist, & + theta, t, p, p8w, t8w, & + dnw, dn, rdz, rdzw, & + n_moist, cf1, cf2, cf3, warm_rain, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! Select a scheme for calculating diffusion coefficients. + + km_coef: SELECT CASE( config_flags%km_opt ) + + CASE (1) + CALL isotropic_km( config_flags, xkmh, xkmv, & + xkhh, xkhv, khdif, kvdif, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + CASE (2) + CALL tke_km( config_flags, xkmh, xkmv, & + xkhh, xkhv, BN2, tke, p8w, t8w, theta, & + rdz, rdzw, dx, dy, dt, isotropic, & + mix_upper_bound, msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + CASE (3) + CALL smag_km( config_flags, xkmh, xkmv, & + xkhh, xkhv, BN2, div, & + defor11, defor22, defor33, & + defor12, defor13, defor23, & + rdzw, dx, dy, dt, isotropic, & + mix_upper_bound, msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + CASE (4) + CALL smag2d_km( config_flags, xkmh, xkmv, & + xkhh, xkhv, defor11, defor22, defor12, & + rdzw, dx, dy, msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + CASE DEFAULT + CALL wrf_error_fatal( 'Please choose diffusion coefficient scheme' ) + + END SELECT km_coef + + IF ( damp_opt .eq. 1 ) THEN + CALL cal_dampkm( config_flags, xkmh, xkhh, xkmv, xkhv, & + dx, dy, dt, dampcoef, rdz, rdzw, zdamp, & + msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + END IF + + END SUBROUTINE calculate_km_kh + +!======================================================================= + +SUBROUTINE cal_dampkm( config_flags,xkmh,xkhh,xkmv,xkhv, & + dx,dy,dt,dampcoef, & + rdz, rdzw ,zdamp, & + msftx, msfty, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , INTENT(IN ) :: zdamp,dx,dy,dt,dampcoef + + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: xkmh , & + xkhh , & + xkmv , & + xkhv + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: rdz, & + rdzw + + REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: msftx, & + msfty +! LOCAL VARS + + INTEGER :: i_start, i_end, j_start, j_end, ktf, ktfm1, i, j, k + REAL :: kmmax,kmmvmax,degrad90,dz,tmp + REAL :: ds + REAL , DIMENSION( its:ite ) :: deltaz + REAL , DIMENSION( its:ite, kts:kte, jts:jte) :: dampk,dampkv + +! End declarations. +!----------------------------------------------------------------------- + + ktf = min(kte,kde-1) + ktfm1 = ktf-1 + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + +! keep upper damping diffusion away from relaxation zones at boundaries if used + IF(config_flags%specified .OR. config_flags%nested)THEN + i_start = MAX(i_start,ids+config_flags%spec_bdy_width-1) + i_end = MIN(i_end,ide-config_flags%spec_bdy_width) + j_start = MAX(j_start,jds+config_flags%spec_bdy_width-1) + j_end = MIN(j_end,jde-config_flags%spec_bdy_width) + ENDIF + + kmmax=dx*dx/dt + degrad90=DEGRAD*90. + DO j = j_start, j_end + + k=ktf + DO i = i_start, i_end + ! Unmodified dx used above may produce very large diffusivities + ! when msftx is very large. And the above formula ignores the fact + ! that dy may now be different from dx as well. Let's fix that by + ! defining a "ds" as the minimum of the "real-space" (physical + ! distance) values of dx and dy, and then using that smallest value + ! to calculate a point-by-point kmmax + ds = MIN(dx/msftx(i,j),dy/msfty(i,j)) + kmmax=ds*ds/dt + +! deltaz(i)=0.5*dnw(k)/zeta_z(i,j) +! dz=dnw(k)/zeta_z(i,j) + dz = 1./rdzw(i,k,j) + deltaz(i) = 0.5*dz + + kmmvmax=dz*dz/dt + tmp=min(deltaz(i)/zdamp,1.) + dampk(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmax*dampcoef + dampkv(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmvmax*dampcoef +! set upper limit on vertical K (based on horizontal K) + dampkv(i,k,j)=min(dampkv(i,k,j),dampk(i,k,j)) + + ENDDO + + DO k = ktfm1,kts,-1 + DO i = i_start, i_end + ! Unmodified dx used above may produce very large diffusivities + ! when msftx is very large. And the above formula ignores the fact + ! that dy may now be different from dx as well. Let's fix that by + ! defining a "ds" as the minimum of the "real-space" (physical + ! distance) values of dx and dy, and then using that smallest value + ! to calculate a point-by-point kmmax + ds = MIN(dx/msftx(i,j),dy/msfty(i,j)) + kmmax=ds*ds/dt + +! deltaz(i)=deltaz(i)+dn(k)/zeta_z(i,j) +! dz=dnw(k)/zeta_z(i,j) + dz = 1./rdz(i,k,j) + deltaz(i) = deltaz(i) + dz + dz = 1./rdzw(i,k,j) + + kmmvmax=dz*dz/dt + tmp=min(deltaz(i)/zdamp,1.) + dampk(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmax*dampcoef + dampkv(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmvmax*dampcoef +! set upper limit on vertical K (based on horizontal K) + dampkv(i,k,j)=min(dampkv(i,k,j),dampk(i,k,j)) + ENDDO + ENDDO + + ENDDO + + DO j = j_start, j_end + DO k = kts,ktf + DO i = i_start, i_end + xkmh(i,k,j)=max(xkmh(i,k,j),dampk(i,k,j)) + xkhh(i,k,j)=max(xkhh(i,k,j),dampk(i,k,j)) + xkmv(i,k,j)=max(xkmv(i,k,j),dampkv(i,k,j)) + xkhv(i,k,j)=max(xkhv(i,k,j),dampkv(i,k,j)) + ENDDO + ENDDO + ENDDO + +END SUBROUTINE cal_dampkm + +!======================================================================= +!======================================================================= + + SUBROUTINE calculate_N2( config_flags, BN2, moist, & + theta, t, p, p8w, t8w, & + dnw, dn, rdz, rdzw, & + n_moist, cf1, cf2, cf3, warm_rain, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type ), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: n_moist, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + LOGICAL, INTENT( IN ) & + :: warm_rain + + REAL, INTENT( IN ) & + :: cf1, cf2, cf3 + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: BN2 + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: rdz, rdzw, theta, t, p, p8w, t8w + + REAL, DIMENSION( kms:kme ), INTENT( IN ) & + :: dnw, dn + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist), INTENT( INOUT ) & + :: moist + +! Local variables. + + INTEGER & + :: i, j, k, ktf, ispe, ktes1, ktes2, & + i_start, i_end, j_start, j_end + + REAL & + :: coefa, thetaep1, thetaem1, qc_cr, es, tc, qlpqi, qsw, qsi, & + tmpdz, xlvqv, thetaesfc, thetasfc, qvtop, qvsfc, thetatop, thetaetop + + REAL, DIMENSION( its:ite, jts:jte ) & + :: tmp1sfc, tmp1top + + REAL, DIMENSION( its:ite, kts:kte, jts:jte ) & + :: tmp1, qvs, qctmp + +! End declarations. +!----------------------------------------------------------------------- + + qc_cr = 0.00001 ! in Kg/Kg + + ktf = MIN( kte, kde-1 ) + ktes1 = kte-1 + ktes2 = kte-2 + + i_start = its + i_end = MIN( ite, ide-1 ) + j_start = jts + j_end = MIN( jte, jde-1 ) + + IF ( config_flags%open_xs .OR. config_flags%specified .OR. & + config_flags%nested) i_start = MAX( ids+1, its ) + IF ( config_flags%open_xe .OR. config_flags%specified .OR. & + config_flags%nested) i_end = MIN( ide-2, ite ) + IF ( config_flags%open_ys .OR. config_flags%specified .OR. & + config_flags%nested) j_start = MAX( jds+1, jts ) + IF ( config_flags%open_ye .OR. config_flags%specified .OR. & + config_flags%nested) j_end = MIN( jde-2 ,jte ) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) + + IF ( P_QC .GT. PARAM_FIRST_SCALAR) THEN + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + qctmp(i,k,j) = moist(i,k,j,P_QC) + END DO + END DO + END DO + ELSE + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + qctmp(i,k,j) = 0.0 + END DO + END DO + END DO + END IF + + DO j = jts, jte + DO k = kts, kte + DO i = its, ite + tmp1(i,k,j) = 0.0 + END DO + END DO + END DO + + DO j = jts,jte + DO i = its,ite + tmp1sfc(i,j) = 0.0 + tmp1top(i,j) = 0.0 + END DO + END DO + + DO ispe = PARAM_FIRST_SCALAR, n_moist + IF ( ispe .EQ. P_QV .OR. ispe .EQ. P_QC .OR. ispe .EQ. P_QI) THEN + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tmp1(i,k,j) = tmp1(i,k,j) + moist(i,k,j,ispe) + END DO + END DO + END DO + + DO j = j_start, j_end + DO i = i_start, i_end + tmp1sfc(i,j) = tmp1sfc(i,j) + & + cf1 * moist(i,1,j,ispe) + & + cf2 * moist(i,2,j,ispe) + & + cf3 * moist(i,3,j,ispe) + tmp1top(i,j) = tmp1top(i,j) + & + moist(i,ktes1,j,ispe) + & + ( moist(i,ktes1,j,ispe) - moist(i,ktes2,j,ispe) ) * & + 0.5 * dnw(ktes1) / dn(ktes1) + END DO + END DO + END IF + END DO + +! Calculate saturation mixing ratio. + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tc = t(i,k,j) - SVPT0 + es = 1000.0 * SVP1 * EXP( SVP2 * tc / ( t(i,k,j) - SVP3 ) ) + qvs(i,k,j) = EP_2 * es / ( p(i,k,j) - es ) + END DO + END DO + END DO + + DO j = j_start, j_end + DO k = kts+1, ktf-1 + DO i = i_start, i_end + tmpdz = 1.0 / rdz(i,k,j) + 1.0 / rdz(i,k+1,j) + IF ( moist(i,k,j,P_QV) .GE. qvs(i,k,j) .OR. qctmp(i,k,j) .GE. qc_cr) THEN + xlvqv = XLV * moist(i,k,j,P_QV) + coefa = ( 1.0 + xlvqv / R_d / t(i,k,j) ) / & + ( 1.0 + XLV * xlvqv / Cp / R_v / t(i,k,j) / t(i,k,j) ) / & + theta(i,k,j) + thetaep1 = theta(i,k+1,j) * & + ( 1.0 + XLV * qvs(i,k+1,j) / Cp / t(i,k+1,j) ) + thetaem1 = theta(i,k-1,j) * & + ( 1.0 + XLV * qvs(i,k-1,j) / Cp / t(i,k-1,j) ) + BN2(i,k,j) = g * ( coefa * ( thetaep1 - thetaem1 ) / tmpdz - & + ( tmp1(i,k+1,j) - tmp1(i,k-1,j) ) / tmpdz ) + ELSE + BN2(i,k,j) = g * ( (theta(i,k+1,j) - theta(i,k-1,j) ) / & + theta(i,k,j) / tmpdz + & + 1.61 * ( moist(i,k+1,j,P_QV) - moist(i,k-1,j,P_QV) ) / & + tmpdz - & + ( tmp1(i,k+1,j) - tmp1(i,k-1,j) ) / tmpdz ) + ENDIF + END DO + END DO + END DO + + k = kts + DO j = j_start, j_end + DO i = i_start, i_end + tmpdz = 1.0 / rdz(i,k+1,j) + 0.5 / rdzw(i,k,j) + thetasfc = T8w(i,kts,j) / ( p8w(i,k,j) / p1000mb )**( R_d / Cp ) + IF ( moist(i,k,j,P_QV) .GE. qvs(i,k,j) .OR. qctmp(i,k,j) .GE. qc_cr) THEN + qvsfc = cf1 * qvs(i,1,j) + & + cf2 * qvs(i,2,j) + & + cf3 * qvs(i,3,j) + xlvqv = XLV * moist(i,k,j,P_QV) + coefa = ( 1.0 + xlvqv / R_d / t(i,k,j) ) / & + ( 1.0 + XLV * xlvqv / Cp / R_v / t(i,k,j) / t(i,k,j) ) / & + theta(i,k,j) + thetaep1 = theta(i,k+1,j) * & + ( 1.0 + XLV * qvs(i,k+1,j) / Cp / t(i,k+1,j) ) + thetaesfc = thetasfc * & + ( 1.0 + XLV * qvsfc / Cp / t8w(i,kts,j) ) + BN2(i,k,j) = g * ( coefa * ( thetaep1 - thetaesfc ) / tmpdz - & + ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz ) + ELSE + qvsfc = cf1 * moist(i,1,j,P_QV) + & + cf2 * moist(i,2,j,P_QV) + & + cf3 * moist(i,3,j,P_QV) +! BN2(i,k,j) = g * ( ( theta(i,k+1,j) - thetasfc ) / & +! theta(i,k,j) / tmpdz + & +! 1.61 * ( moist(i,k+1,j,P_QV) - qvsfc ) / & +! tmpdz - & +! ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz ) +!...... MARTA: change in computation of BN2 at the surface, WCS 040331 + + tmpdz= 1./rdzw(i,k,j) ! controlare come calcola rdzw + BN2(i,k,j) = g * ( ( theta(i,k+1,j) - theta(i,k,j)) / & + theta(i,k,j) / tmpdz + & + 1.61 * ( moist(i,k+1,j,P_QV) - qvsfc ) / & + tmpdz - & + ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz ) +! end of MARTA/WCS change + + ENDIF + END DO + END DO + + +!...... MARTA: change in computation of BN2 at the top, WCS 040331 + DO j = j_start, j_end + DO i = i_start, i_end + BN2(i,ktf,j)=BN2(i,ktf-1,j) + END DO + END DO +! end of MARTA/WCS change + + END SUBROUTINE calculate_N2 + +!======================================================================= +!======================================================================= + +SUBROUTINE isotropic_km( config_flags, & + xkmh,xkmv,xkhh,xkhv,khdif,kvdif, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , INTENT(IN ) :: khdif,kvdif + + REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: xkmh, & + xkmv, & + xkhh, & + xkhv +! LOCAL VARS + + INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k + REAL :: khdif3,kvdif3 + +! End declarations. +!----------------------------------------------------------------------- + + ktf = kte + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + +! khdif3=khdif*3. +! kvdif3=kvdif*3. + khdif3=khdif/prandtl + kvdif3=kvdif/prandtl + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + xkmh(i,k,j)=khdif + xkmv(i,k,j)=kvdif + xkhh(i,k,j)=khdif3 + xkhv(i,k,j)=kvdif3 + ENDDO + ENDDO + ENDDO + +END SUBROUTINE isotropic_km + +!======================================================================= +!======================================================================= + +SUBROUTINE smag_km( config_flags,xkmh,xkmv,xkhh,xkhv,BN2, & + div,defor11,defor22,defor33,defor12, & + defor13,defor23, & + rdzw,dx,dy,dt,isotropic, & + mix_upper_bound, msftx, msfty, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER , INTENT(IN ) :: isotropic + REAL , INTENT(IN ) :: dx, dy, dt, mix_upper_bound + + + REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: BN2, & + rdzw + + REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: xkmh, & + xkmv, & + xkhh, & + xkhv + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN ) :: & + defor11, & + defor22, & + defor33, & + defor12, & + defor13, & + defor23, & + div + REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: msftx, & + msfty +! LOCAL VARS + + INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k + REAL :: deltas, tmp, pr, mlen_h, mlen_v, c_s + + REAL, DIMENSION( its:ite , kts:kte , jts:jte ) :: def2 + +! End declarations. +!----------------------------------------------------------------------- + + ktf = min(kte,kde-1) + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .or. config_flags%specified .or. & + config_flags%nested) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. config_flags%specified .or. & + config_flags%nested) i_end = MIN(ide-2,ite) + IF ( config_flags%open_ys .or. config_flags%specified .or. & + config_flags%nested) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. config_flags%specified .or. & + config_flags%nested) j_end = MIN(jde-2,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) + + pr = prandtl + c_s = config_flags%c_s + + do j=j_start,j_end + do k=kts,ktf + do i=i_start,i_end + def2(i,k,j)=0.5*(defor11(i,k,j)*defor11(i,k,j) + & + defor22(i,k,j)*defor22(i,k,j) + & + defor33(i,k,j)*defor33(i,k,j)) + enddo + enddo + enddo + + do j=j_start,j_end + do k=kts,ktf + do i=i_start,i_end + tmp=0.25*(defor12(i ,k,j)+defor12(i ,k,j+1)+ & + defor12(i+1,k,j)+defor12(i+1,k,j+1)) + def2(i,k,j)=def2(i,k,j)+tmp*tmp + enddo + enddo + enddo + + do j=j_start,j_end + do k=kts,ktf + do i=i_start,i_end + tmp=0.25*(defor13(i ,k+1,j)+defor13(i ,k,j)+ & + defor13(i+1,k+1,j)+defor13(i+1,k,j)) + def2(i,k,j)=def2(i,k,j)+tmp*tmp + enddo + enddo + enddo + + do j=j_start,j_end + do k=kts,ktf + do i=i_start,i_end + tmp=0.25*(defor23(i,k+1,j )+defor23(i,k,j )+ & + defor23(i,k+1,j+1)+defor23(i,k,j+1)) + def2(i,k,j)=def2(i,k,j)+tmp*tmp + enddo + enddo + enddo +! + IF (isotropic .EQ. 0) THEN + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + mlen_h=sqrt(dx/msftx(i,j) * dy/msfty(i,j)) + mlen_v= 1./rdzw(i,k,j) + tmp=max(0.,def2(i,k,j)-BN2(i,k,j)/pr) + tmp=tmp**0.5 + xkmh(i,k,j)=max(c_s*c_s*mlen_h*mlen_h*tmp, 1.0E-6*mlen_h*mlen_h ) + xkmh(i,k,j)=min(xkmh(i,k,j), mix_upper_bound * mlen_h * mlen_h / dt ) + xkmv(i,k,j)=max(c_s*c_s*mlen_v*mlen_v*tmp, 1.0E-6*mlen_v*mlen_v ) + xkmv(i,k,j)=min(xkmv(i,k,j), mix_upper_bound * mlen_v * mlen_v / dt ) + xkhh(i,k,j)=xkmh(i,k,j)/pr + xkhh(i,k,j)=min(xkhh(i,k,j), mix_upper_bound * mlen_h * mlen_h / dt ) + xkhv(i,k,j)=xkmv(i,k,j)/pr + xkhv(i,k,j)=min(xkhv(i,k,j), mix_upper_bound * mlen_v * mlen_v / dt ) + ENDDO + ENDDO + ENDDO + ELSE + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + deltas=(dx/msftx(i,j) * dy/msfty(i,j)/rdzw(i,k,j))**0.33333333 + tmp=max(0.,def2(i,k,j)-BN2(i,k,j)/pr) + tmp=tmp**0.5 + xkmh(i,k,j)=max(c_s*c_s*deltas*deltas*tmp, 1.0E-6*deltas*deltas ) + xkmh(i,k,j)=min(xkmh(i,k,j), mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt ) + xkmv(i,k,j)=xkmh(i,k,j) + xkmv(i,k,j)=min(xkmv(i,k,j), mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt ) + xkhh(i,k,j)=xkmh(i,k,j)/pr + xkhh(i,k,j)=min(xkhh(i,k,j), mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt ) + xkhv(i,k,j)=xkmv(i,k,j)/pr + xkhv(i,k,j)=min(xkhv(i,k,j), mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt ) + ENDDO + ENDDO + ENDDO + ENDIF + +END SUBROUTINE smag_km + +!======================================================================= +!======================================================================= + +SUBROUTINE smag2d_km( config_flags,xkmh,xkmv,xkhh,xkhv, & + defor11,defor22,defor12, & + rdzw,dx,dy,msftx, msfty, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , INTENT(IN ) :: dx, dy + + + REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: rdzw + + REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: xkmh, & + xkmv, & + xkhh, & + xkhv + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN ) :: & + defor11, & + defor22, & + defor12 + + REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: msftx, & + msfty +! LOCAL VARS + + INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k + REAL :: deltas, tmp, pr, mlen_h, c_s + + REAL, DIMENSION( its:ite , kts:kte , jts:jte ) :: def2 + +! End declarations. +!----------------------------------------------------------------------- + + ktf = min(kte,kde-1) + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .or. config_flags%specified .or. & + config_flags%nested) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. config_flags%specified .or. & + config_flags%nested) i_end = MIN(ide-2,ite) + IF ( config_flags%open_ys .or. config_flags%specified .or. & + config_flags%nested) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. config_flags%specified .or. & + config_flags%nested) j_end = MIN(jde-2,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) + + pr=prandtl + c_s = config_flags%c_s + + do j=j_start,j_end + do k=kts,ktf + do i=i_start,i_end + def2(i,k,j)=0.25*((defor11(i,k,j)-defor22(i,k,j))*(defor11(i,k,j)-defor22(i,k,j))) + tmp=0.25*(defor12(i ,k,j)+defor12(i ,k,j+1)+ & + defor12(i+1,k,j)+defor12(i+1,k,j+1)) + def2(i,k,j)=def2(i,k,j)+tmp*tmp + enddo + enddo + enddo +! + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + mlen_h=sqrt(dx/msftx(i,j) * dy/msfty(i,j)) + tmp=sqrt(def2(i,k,j)) +! xkmh(i,k,j)=max(c_s*c_s*mlen_h*mlen_h*tmp, 1.0E-6*mlen_h*mlen_h ) + xkmh(i,k,j)=c_s*c_s*mlen_h*mlen_h*tmp + xkmh(i,k,j)=min(xkmh(i,k,j), 10.*mlen_h ) + xkmv(i,k,j)=0. + xkhh(i,k,j)=xkmh(i,k,j)/pr + xkhv(i,k,j)=0. + ENDDO + ENDDO + ENDDO + +END SUBROUTINE smag2d_km + +!======================================================================= +!======================================================================= + + SUBROUTINE tke_km( config_flags, xkmh, xkmv, xkhh, xkhv, & + bn2, tke, p8w, t8w, theta, & + rdz, rdzw, dx,dy, dt, isotropic, & + mix_upper_bound, msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! History: Sep 2003 Changes by Jason Knievel and George Bryan, NCAR +! Oct 2001 Converted to mass core by Bill Skamarock, NCAR +! ... ... + +! Purpose: This routine calculates the exchange coefficients for the +! TKE turbulence parameterization. + +! References: Klemp and Wilhelmson (JAS 1978) +! Chen and Dudhia (NCAR WRF physics report 2000) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type ), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER, INTENT( IN ) :: isotropic + REAL, INTENT( IN ) & + :: dx, dy, dt + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: tke, p8w, t8w, theta, rdz, rdzw, bn2 + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: xkmh, xkmv, xkhh, xkhv + + REAL, INTENT( IN ) & + :: mix_upper_bound + + REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: msftx, & + msfty +! Local variables. + + REAL, DIMENSION( its:ite, kts:kte, jts:jte ) & + :: l_scale + + REAL, DIMENSION( its:ite, kts:kte, jts:jte ) & + :: dthrdn + + REAL & + :: deltas, tmp, mlen_s, mlen_h, mlen_v, tmpdz, & + thetasfc, thetatop, minkx, pr_inv, pr_inv_h, pr_inv_v, c_k + + INTEGER & + :: i_start, i_end, j_start, j_end, ktf, i, j, k + + REAL, PARAMETER :: tke_seed_value = 1.e-06 + REAL :: tke_seed + REAL, PARAMETER :: epsilon = 1.e-10 + +! End declarations. +!----------------------------------------------------------------------- + + ktf = MIN( kte, kde-1 ) + i_start = its + i_end = MIN( ite, ide-1 ) + j_start = jts + j_end = MIN( jte, jde-1 ) + + IF ( config_flags%open_xs .OR. config_flags%specified .OR. & + config_flags%nested) i_start = MAX( ids+1, its ) + IF ( config_flags%open_xe .OR. config_flags%specified .OR. & + config_flags%nested) i_end = MIN( ide-2, ite ) + IF ( config_flags%open_ys .OR. config_flags%specified .OR. & + config_flags%nested) j_start = MAX( jds+1, jts ) + IF ( config_flags%open_ye .OR. config_flags%specified .OR. & + config_flags%nested) j_end = MIN( jde-2, jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) + +! in the absence of surface drag or a surface heat flux, there +! is no way to generate tke without pre-existing tke. Use +! tke_seed if the drag and flux are off. + + c_k = config_flags%c_k + tke_seed = tke_seed_value + if( (config_flags%tke_drag_coefficient .gt. epsilon) .or. & + (config_flags%tke_heat_flux .gt. epsilon) ) tke_seed = 0. + + DO j = j_start, j_end + DO k = kts+1, ktf-1 + DO i = i_start, i_end + tmpdz = 1.0 / ( rdz(i,k+1,j) + rdz(i,k,j) ) + dthrdn(i,k,j) = ( theta(i,k+1,j) - theta(i,k-1,j) ) / tmpdz + END DO + END DO + END DO + + k = kts + DO j = j_start, j_end + DO i = i_start, i_end + tmpdz = 1.0 / ( rdzw(i,k+1,j) + rdzw(i,k,j) ) + thetasfc = T8w(i,kts,j) / ( p8w(i,k,j) / p1000mb )**( R_d / Cp ) + dthrdn(i,k,j) = ( theta(i,k+1,j) - thetasfc ) / tmpdz + END DO + END DO + + k = ktf + DO j = j_start, j_end + DO i = i_start, i_end + tmpdz = 1.0 / rdz(i,k,j) + 0.5 / rdzw(i,k,j) + thetatop = T8w(i,kde,j) / ( p8w(i,kde,j) / p1000mb )**( R_d / Cp ) + dthrdn(i,k,j) = ( thetatop - theta(i,k-1,j) ) / tmpdz + END DO + END DO + + IF ( isotropic .EQ. 0 ) THEN + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + mlen_h = SQRT( dx/msftx(i,j) * dy/msfty(i,j) ) + tmp = SQRT( MAX( tke(i,k,j), tke_seed ) ) + deltas = 1.0 / rdzw(i,k,j) + mlen_v = deltas + IF ( dthrdn(i,k,j) .GT. 0.) THEN + mlen_s = 0.76 * tmp / ( ABS( g / theta(i,k,j) * dthrdn(i,k,j) ) )**0.5 + mlen_v = MIN( mlen_v, mlen_s ) + END IF + xkmh(i,k,j) = MAX( c_k * tmp * mlen_h, 1.0E-6 * mlen_h * mlen_h ) + xkmh(i,k,j) = MIN( xkmh(i,k,j), mix_upper_bound * mlen_h *mlen_h / dt ) + xkmv(i,k,j) = MAX( c_k * tmp * mlen_v, 1.0E-6 * deltas * deltas ) + xkmv(i,k,j) = MIN( xkmv(i,k,j), mix_upper_bound * deltas *deltas / dt ) + pr_inv_h = 1./prandtl + pr_inv_v = 1.0 + 2.0 * mlen_v / deltas + xkhh(i,k,j) = xkmh(i,k,j) * pr_inv_h + xkhv(i,k,j) = xkmv(i,k,j) * pr_inv_v + END DO + END DO + END DO + ELSE + CALL calc_l_scale( config_flags, tke, BN2, l_scale, & + i_start, i_end, ktf, j_start, j_end, & + dx, dy, rdzw, msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tmp = SQRT( MAX( tke(i,k,j), tke_seed ) ) + deltas = ( dx/msftx(i,j) * dy/msfty(i,j) / rdzw(i,k,j) )**0.33333333 + xkmh(i,k,j) = c_k * tmp * l_scale(i,k,j) + xkmh(i,k,j) = MIN( mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt, xkmh(i,k,j) ) + xkmv(i,k,j) = c_k * tmp * l_scale(i,k,j) + xkmv(i,k,j) = MIN( mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt , xkmv(i,k,j) ) + pr_inv = 1.0 + 2.0 * l_scale(i,k,j) / deltas + xkhh(i,k,j) = MIN( mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt, xkmh(i,k,j) * pr_inv ) + xkhv(i,k,j) = MIN( mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt, xkmv(i,k,j) * pr_inv ) + END DO + END DO + END DO + END IF + + END SUBROUTINE tke_km + +!======================================================================= +!======================================================================= + + SUBROUTINE calc_l_scale( config_flags, tke, BN2, l_scale, & + i_start, i_end, ktf, j_start, j_end, & + dx, dy, rdzw, msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! History: Sep 2003 Written by Bryan and Knievel, NCAR + +! Purpose: This routine calculates the length scale, based on stability, +! for TKE parameterization of subgrid-scale turbulence. + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type ), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: i_start, i_end, ktf, j_start, j_end, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: BN2, tke, rdzw + + REAL, INTENT( IN ) & + :: dx, dy + + REAL, DIMENSION( its:ite, kts:kte, jts:jte ), INTENT( OUT ) & + :: l_scale + + REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: msftx, & + msfty +! Local variables. + + INTEGER & + :: i, j, k + + REAL & + :: deltas, tmp + +! End declarations. +!----------------------------------------------------------------------- + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + deltas = ( dx/msftx(i,j) * dy/msfty(i,j) / rdzw(i,k,j) )**0.33333333 + l_scale(i,k,j) = deltas + + IF ( BN2(i,k,j) .gt. 1.0e-6 ) THEN + tmp = SQRT( MAX( tke(i,k,j), 1.0e-6 ) ) + l_scale(i,k,j) = 0.76 * tmp / SQRT( BN2(i,k,j) ) + l_scale(i,k,j) = MIN( l_scale(i,k,j), deltas) + l_scale(i,k,j) = MAX( l_scale(i,k,j), 0.001 * deltas ) + END IF + + END DO + END DO + END DO + + END SUBROUTINE calc_l_scale + +!======================================================================= +!======================================================================= + +SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & + tke_tendf, & + moist_tendf, n_moist, & + chem_tendf, n_chem, & + scalar_tendf, n_scalar, & + thp, theta, mu, tke, config_flags, & + defor11, defor22, defor12, & + defor13, defor23, div, & + moist, chem, scalar, & + msfux, msfuy, msfvx, msfvy, & + msftx, msfty, xkmh, xkhh,km_opt, & + rdx, rdy, rdz, rdzw, fnm, fnp, & + cf1, cf2, cf3, zx, zy, dn, dnw, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER , INTENT(IN ) :: n_moist, n_chem, n_scalar, km_opt + + REAL , INTENT(IN ) :: cf1, cf2, cf3 + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dn + + REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfux, & + msfuy, & + msfvx, & + msfvy, & + msftx, & + msfty, & + mu + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::rt_tendf,& + ru_tendf,& + rv_tendf,& + rw_tendf,& + tke_tendf + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist), & + INTENT(INOUT) :: moist_tendf + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem), & + INTENT(INOUT) :: chem_tendf + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar), & + INTENT(INOUT) :: scalar_tendf + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist), & + INTENT(IN ) :: moist + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem), & + INTENT(IN ) :: chem + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar) , & + INTENT(IN ) :: scalar + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) ::defor11, & + defor22, & + defor12, & + defor13, & + defor23, & + div, & + xkmh, & + xkhh, & + zx, & + zy, & + theta, & + thp, & + tke, & + rdz, & + rdzw + + + REAL , INTENT(IN ) :: rdx, & + rdy + +! LOCAL VARS + + INTEGER :: im, ic, is + +! REAL , DIMENSION(its-1:ite+1, kts:kte, jts-1:jte+1) :: xkhh + +! End declarations. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Call diffusion subroutines. + + CALL horizontal_diffusion_u_2( ru_tendf, mu, config_flags, & + defor11, defor12, div, & + tke(ims,kms,jms), & + msfux, msfuy, xkmh, rdx, rdy, fnm, fnp, & + zx, zy, rdzw, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL horizontal_diffusion_v_2( rv_tendf, mu, config_flags, & + defor12, defor22, div, & + tke(ims,kms,jms), & + msfvx, msfvy, xkmh, rdx, rdy, fnm, fnp, & + zx, zy, rdzw, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL horizontal_diffusion_w_2( rw_tendf, mu, config_flags, & + defor13, defor23, div, & + tke(ims,kms,jms), & + msftx, msfty, xkmh, rdx, rdy, fnm, fnp, & + zx, zy, rdz, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL horizontal_diffusion_s ( rt_tendf, mu, config_flags, thp, & + msftx, msfty, msfux, msfuy, & + msfvx, msfvy, xkhh, rdx, rdy, & + fnm, fnp, cf1, cf2, cf3, & + zx, zy, rdz, rdzw, dnw, dn, & + .false., & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IF (km_opt .eq. 2) & + CALL horizontal_diffusion_s ( tke_tendf(ims,kms,jms), & + mu, config_flags, & + tke(ims,kms,jms), & + msftx, msfty, msfux, msfuy, & + msfvx, msfvy, xkhh, rdx, rdy, & + fnm, fnp, cf1, cf2, cf3, & + zx, zy, rdz, rdzw, dnw, dn, & + .true., & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IF (n_moist .ge. PARAM_FIRST_SCALAR) THEN + + moist_loop: do im = PARAM_FIRST_SCALAR, n_moist + + CALL horizontal_diffusion_s( moist_tendf(ims,kms,jms,im), & + mu, config_flags, & + moist(ims,kms,jms,im), & + msftx, msfty, msfux, msfuy, & + msfvx, msfvy, xkhh, rdx, rdy, & + fnm, fnp, cf1, cf2, cf3, & + zx, zy, rdz, rdzw, dnw, dn, & + .false., & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + ENDDO moist_loop + + ENDIF + + IF (n_chem .ge. PARAM_FIRST_SCALAR) THEN + + chem_loop: do ic = PARAM_FIRST_SCALAR, n_chem + + CALL horizontal_diffusion_s( chem_tendf(ims,kms,jms,ic), & + mu, config_flags, & + chem(ims,kms,jms,ic), & + msftx, msfty, msfux, msfuy, & + msfvx, msfvy, xkhh, rdx, rdy, & + fnm, fnp, cf1, cf2, cf3, & + zx, zy, rdz, rdzw, dnw, dn, & + .false., & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + ENDDO chem_loop + + ENDIF + IF (n_scalar .ge. PARAM_FIRST_SCALAR) THEN + + scalar_loop: do is = PARAM_FIRST_SCALAR, n_scalar + + CALL horizontal_diffusion_s( scalar_tendf(ims,kms,jms,is), & + mu, config_flags, & + scalar(ims,kms,jms,is), & + msftx, msfty, msfux, msfuy, & + msfvx, msfvy, xkhh, rdx, rdy, & + fnm, fnp, cf1, cf2, cf3, & + zx, zy, rdz, rdzw, dnw, dn, & + .false., & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + ENDDO scalar_loop + + ENDIF + + END SUBROUTINE horizontal_diffusion_2 + +!======================================================================= +!======================================================================= + +SUBROUTINE horizontal_diffusion_u_2( tendency, mu, config_flags, & + defor11, defor12, div, tke, & + msfux, msfuy, & + xkmh, rdx, rdy, fnm, fnp, & + zx, zy, rdzw, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp + + REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfux, & + msfuy, & + mu + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: rdzw + + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) ::defor11, & + defor12, & + div, & + tke, & + xkmh, & + zx, & + zy + + REAL , INTENT(IN ) :: rdx, & + rdy +! Local data + + INTEGER :: i, j, k, ktf + + INTEGER :: i_start, i_end, j_start, j_end + INTEGER :: is_ext,ie_ext,js_ext,je_ext + + REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau1avg, & + titau2avg, & + titau1, & + titau2, & + xkxavg, & + rravg +! new +! zxavg, & +! zyavg + REAL :: mrdx, mrdy, rcoup + + REAL :: tmpzy, tmpzeta_z + + REAL :: term1, term2, term3 + +! End declarations. +!----------------------------------------------------------------------- + + ktf=MIN(kte,kde-1) + +!----------------------------------------------------------------------- +! u : p (.), u(|), w(-) +! +! p u p u u u +! +! p | . | . | . | k+1 | . | . | . | k+1 +! +! w - 13 - - k+1 13 k+1 +! +! p | 11 O 11 | . | k | 12 O 12 | . | k +! +! w - 13 - - k 13 k +! +! p | . | . | . | k-1 | . | . | . | k-1 +! +! i-1 i i i+1 j-1 j j j+1 j+1 +! + + i_start = its + i_end = ite + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .or. config_flags%specified .or. & + config_flags%nested) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. config_flags%specified .or. & + config_flags%nested) i_end = MIN(ide-1,ite) + IF ( config_flags%open_ys .or. config_flags%specified .or. & + config_flags%nested) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. config_flags%specified .or. & + config_flags%nested) j_end = MIN(jde-2,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = ite + +! titau1 = titau11 + is_ext=1 + ie_ext=0 + js_ext=0 + je_ext=0 + CALL cal_titau_11_22_33( config_flags, titau1, & + mu, tke, xkmh, defor11, & + is_ext, ie_ext, js_ext, je_ext, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! titau2 = titau12 + is_ext=0 + ie_ext=0 + js_ext=0 + je_ext=1 + CALL cal_titau_12_21( config_flags, titau2, & + mu, xkmh, defor12, & + is_ext, ie_ext, js_ext, je_ext, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! titau1avg = titau11avg +! titau2avg = titau12avg + + DO j = j_start, j_end + DO k = kts+1,ktf + DO i = i_start, i_end + titau1avg(i,k,j)=0.5*(fnm(k)*(titau1(i-1,k ,j)+titau1(i,k ,j))+ & + fnp(k)*(titau1(i-1,k-1,j)+titau1(i,k-1,j))) + titau2avg(i,k,j)=0.5*(fnm(k)*(titau2(i,k ,j+1)+titau2(i,k ,j))+ & + fnp(k)*(titau2(i,k-1,j+1)+titau2(i,k-1,j))) + tmpzy = 0.25*( zy(i-1,k,j )+zy(i,k,j )+ & + zy(i-1,k,j+1)+zy(i,k,j+1) ) +! tmpzeta_z = 0.5*(zeta_z(i,j)+zeta_z(i-1,j)) +! titau1avg(i,k,j)=titau1avg(i,k,j)*zx(i,k,j)*tmpzeta_z +! titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy *tmpzeta_z + + titau1avg(i,k,j)=titau1avg(i,k,j)*zx(i,k,j) + titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy + + ENDDO + ENDDO + ENDDO +! + DO j = j_start, j_end + DO i = i_start, i_end + titau1avg(i,kts,j)=0. + titau1avg(i,ktf+1,j)=0. + titau2avg(i,kts,j)=0. + titau2avg(i,ktf+1,j)=0. + ENDDO + ENDDO +! + DO j = j_start, j_end + DO k = kts,ktf + DO i = i_start, i_end + + mrdx=msfux(i,j)*rdx + mrdy=msfuy(i,j)*rdy + tendency(i,k,j)=tendency(i,k,j)- & + (mrdx*(titau1(i,k,j )-titau1(i-1,k,j))+ & + mrdy*(titau2(i,k,j+1)-titau2(i,k,j ))- & + msfuy(i,j)*rdzw(i,k,j)*((titau1avg(i,k+1,j)-titau1avg(i,k,j))+ & + (titau2avg(i,k+1,j)-titau2avg(i,k,j)) & + ) ) + ENDDO + ENDDO + ENDDO + +END SUBROUTINE horizontal_diffusion_u_2 + +!======================================================================= +!======================================================================= + +SUBROUTINE horizontal_diffusion_v_2( tendency, mu, config_flags, & + defor12, defor22, div, tke, & + msfvx, msfvy, & + xkmh, rdx, rdy, fnm, fnp, & + zx, zy, rdzw, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp + + REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfvx, & + msfvy, & + mu + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) ::defor12, & + defor22, & + div, & + tke, & + xkmh, & + zx, & + zy, & + rdzw + + REAL , INTENT(IN ) :: rdx, & + rdy + +! Local data + + INTEGER :: i, j, k, ktf + + INTEGER :: i_start, i_end, j_start, j_end + INTEGER :: is_ext,ie_ext,js_ext,je_ext + + REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau1avg, & + titau2avg, & + titau1, & + titau2, & + xkxavg, & + rravg +! new +! zxavg, & +! zyavg + + REAL :: mrdx, mrdy, rcoup + + REAL :: tmpzx, tmpzeta_z + +! End declarations. +!----------------------------------------------------------------------- + + ktf=MIN(kte,kde-1) + +!----------------------------------------------------------------------- +! v : p (.), v(+), w(-) +! +! p v p v v v +! +! p + . + . + . + k+1 + . + . + . + k+1 +! +! w - 23 - - k+1 23 k+1 +! +! p + 22 O 22 + . + k + 21 O 21 + . + k +! +! w - 23 - - k 23 k +! +! p + . + . + . + k-1 + . + . + . + k-1 +! +! j-1 j j j+1 i-1 i i i+1 i+1 +! + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = jte + + IF ( config_flags%open_xs .or. config_flags%specified .or. & + config_flags%nested) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. config_flags%specified .or. & + config_flags%nested) i_end = MIN(ide-2,ite) + IF ( config_flags%open_ys .or. config_flags%specified .or. & + config_flags%nested) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. config_flags%specified .or. & + config_flags%nested) j_end = MIN(jde-1,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) + +! titau1 = titau21 + is_ext=0 + ie_ext=1 + js_ext=0 + je_ext=0 + CALL cal_titau_12_21( config_flags, titau1, & + mu, xkmh, defor12, & + is_ext,ie_ext,js_ext,je_ext, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! titau2 = titau22 + is_ext=0 + ie_ext=0 + js_ext=1 + je_ext=0 + CALL cal_titau_11_22_33( config_flags, titau2, & + mu, tke, xkmh, defor22, & + is_ext, ie_ext, js_ext, je_ext, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + DO j = j_start, j_end + DO k = kts+1,ktf + DO i = i_start, i_end + titau1avg(i,k,j)=0.5*(fnm(k)*(titau1(i+1,k ,j)+titau1(i,k ,j))+ & + fnp(k)*(titau1(i+1,k-1,j)+titau1(i,k-1,j))) + titau2avg(i,k,j)=0.5*(fnm(k)*(titau2(i,k ,j-1)+titau2(i,k ,j))+ & + fnp(k)*(titau2(i,k-1,j-1)+titau2(i,k-1,j))) + + tmpzx = 0.25*( zx(i,k,j )+zx(i+1,k,j )+ & + zx(i,k,j-1)+zx(i+1,k,j-1) ) + + + titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx + titau2avg(i,k,j)=titau2avg(i,k,j)*zy(i,k,j) + + + ENDDO + ENDDO + ENDDO + + DO j = j_start, j_end + DO i = i_start, i_end + titau1avg(i,kts,j)=0. + titau1avg(i,ktf+1,j)=0. + titau2avg(i,kts,j)=0. + titau2avg(i,ktf+1,j)=0. + ENDDO + ENDDO +! + DO j = j_start, j_end + DO k = kts,ktf + DO i = i_start, i_end + + mrdx=msfvx(i,j)*rdx + mrdy=msfvy(i,j)*rdy + tendency(i,k,j)=tendency(i,k,j)- & + (mrdy*(titau2(i ,k,j)-titau2(i,k,j-1))+ & + mrdx*(titau1(i+1,k,j)-titau1(i,k,j ))- & + msfvy(i,j)*rdzw(i,k,j)*((titau1avg(i,k+1,j)-titau1avg(i,k,j))+ & + (titau2avg(i,k+1,j)-titau2avg(i,k,j)) & + ) & + ) + + ENDDO + ENDDO + ENDDO + +END SUBROUTINE horizontal_diffusion_v_2 + +!======================================================================= +!======================================================================= + +SUBROUTINE horizontal_diffusion_w_2( tendency, mu, config_flags, & + defor13, defor23, div, tke, & + msftx, msfty, & + xkmh, rdx, rdy, fnm, fnp, & + zx, zy, rdz, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp + + REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msftx, & + msfty, & + mu + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) ::defor13, & + defor23, & + div, & + tke, & + xkmh, & + zx, & + zy, & + rdz + + REAL , INTENT(IN ) :: rdx, & + rdy + +! Local data + + INTEGER :: i, j, k, ktf + + INTEGER :: i_start, i_end, j_start, j_end + INTEGER :: is_ext,ie_ext,js_ext,je_ext + + REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau1avg, & + titau2avg, & + titau1, & + titau2, & + xkxavg, & + rravg +! new +! zxavg, & +! zyavg + + REAL :: mrdx, mrdy, rcoup + + REAL :: tmpzx, tmpzy, tmpzeta_z + +! End declarations. +!----------------------------------------------------------------------- + + ktf=MIN(kte,kde-1) + +!----------------------------------------------------------------------- +! w : p (.), u(|), v(+), w(-) +! +! p u p u p v p v +! +! w - - - k+1 w - - - k+1 +! +! p . | 33 | . k p . + 33 + . k +! +! w - 31 O 31 - k w - 32 O 32 - k +! +! p . | 33 | . k-1 p . | 33 | . k-1 +! +! w - - - k-1 w - - - k-1 +! +! i-1 i i i+1 j-1 j j j+1 +! + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .or. config_flags%specified .or. & + config_flags%nested) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. config_flags%specified .or. & + config_flags%nested) i_end = MIN(ide-2,ite) + IF ( config_flags%open_ys .or. config_flags%specified .or. & + config_flags%nested) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. config_flags%specified .or. & + config_flags%nested) j_end = MIN(jde-2,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) + +! titau1 = titau31 + is_ext=0 + ie_ext=1 + js_ext=0 + je_ext=0 + CALL cal_titau_13_31( config_flags, titau1, defor13, & + mu, xkmh, fnm, fnp, & + is_ext, ie_ext, js_ext, je_ext, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! titau2 = titau32 + is_ext=0 + ie_ext=0 + js_ext=0 + je_ext=1 + CALL cal_titau_23_32( config_flags, titau2, defor23, & + mu, xkmh, fnm, fnp, & + is_ext, ie_ext, js_ext, je_ext, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! titau1avg = titau31avg * zx * zeta_z = titau13avg * zx * zeta_z +! titau2avg = titau32avg * zy * zeta_z = titau23avg * zy * zeta_z + + DO j = j_start, j_end + DO k = kts,ktf + DO i = i_start, i_end + titau1avg(i,k,j)=0.25*(titau1(i+1,k+1,j)+titau1(i,k+1,j)+ & + titau1(i+1,k ,j)+titau1(i,k ,j)) + titau2avg(i,k,j)=0.25*(titau2(i,k+1,j+1)+titau2(i,k+1,j)+ & + titau2(i,k ,j+1)+titau2(i,k ,j)) +! new + tmpzx =0.25*( zx(i,k ,j)+zx(i+1,k ,j)+ & + zx(i,k+1,j)+zx(i+1,k+1,j) ) + tmpzy =0.25*( zy(i,k ,j)+zy(i,k ,j+1)+ & + zy(i,k+1,j)+zy(i,k+1,j+1) ) + + titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx + titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy +! titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx*zeta_z(i,j) +! titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy*zeta_z(i,j) + ENDDO + ENDDO + ENDDO + + DO j = j_start, j_end + DO i = i_start, i_end + titau1avg(i,ktf+1,j)=0. + titau2avg(i,ktf+1,j)=0. + ENDDO + ENDDO + + DO j = j_start, j_end + DO k = kts+1,ktf + DO i = i_start, i_end + + mrdx=msftx(i,j)*rdx + mrdy=msfty(i,j)*rdy + + tendency(i,k,j)=tendency(i,k,j)- & + (mrdx*(titau1(i+1,k,j)-titau1(i,k,j))+ & + mrdy*(titau2(i,k,j+1)-titau2(i,k,j))- & + msfty(i,j)*rdz(i,k,j)*(titau1avg(i,k,j)-titau1avg(i,k-1,j)+ & + titau2avg(i,k,j)-titau2avg(i,k-1,j) & + ) & + ) +! msft(i,j)/dn(k)*(titau1avg(i,k,j)-titau1avg(i,k-1,j)+ & +! titau2avg(i,k,j)-titau2avg(i,k-1,j) & +! ) & +! ) + ENDDO + ENDDO + ENDDO + +END SUBROUTINE horizontal_diffusion_w_2 + +!======================================================================= +!======================================================================= + +SUBROUTINE horizontal_diffusion_s (tendency, mu, config_flags, var, & + msftx, msfty, msfux, msfuy, & + msfvx, msfvy, xkhh, rdx, rdy, & + fnm, fnp, cf1, cf2, cf3, & + zx, zy, rdz, rdzw, dnw, dn, & + doing_tke, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + LOGICAL, INTENT(IN ) :: doing_tke + + REAL , INTENT(IN ) :: cf1, cf2, cf3 + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dn + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw + + REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfux + REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfuy + REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfvx + REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfvy + REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msftx + REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfty + + REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: mu + +! REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1), & +! INTENT(IN ) :: xkhh + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & + xkhh, & + rdz, & + rdzw + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: var, & + zx, & + zy + + REAL , INTENT(IN ) :: rdx, & + rdy + +! Local data + + INTEGER :: i, j, k, ktf + + INTEGER :: i_start, i_end, j_start, j_end + + REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: H1avg, & + H2avg, & + H1, & + H2, & + xkxavg +! new +! zxavg, & +! zyavg + + REAL , DIMENSION( its:ite, kts:kte, jts:jte) :: tmptendf + + REAL :: mrdx, mrdy, rcoup + REAL :: tmpzx, tmpzy, tmpzeta_z, rdzu, rdzv + INTEGER :: ktes1,ktes2 + +! End declarations. +!----------------------------------------------------------------------- + + ktf=MIN(kte,kde-1) + +!----------------------------------------------------------------------- +! scalars: t (.), u(|), v(+), w(-) +! +! t u t u t v t v +! +! w - 3 - k+1 w - 3 - k+1 +! +! t . 1 O 1 . k t . 2 O 2 . k +! +! w - 3 - k w - 3 - k +! +! t . | . | . k-1 t . + . + . k-1 +! +! w - - - k-1 w - - - k-1 +! +! t i-1 i i i+1 j-1 j j j+1 +! + + ktes1=kte-1 + ktes2=kte-2 + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .or. config_flags%specified .or. & + config_flags%nested) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. config_flags%specified .or. & + config_flags%nested) i_end = MIN(ide-2,ite) + IF ( config_flags%open_ys .or. config_flags%specified .or. & + config_flags%nested) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. config_flags%specified .or. & + config_flags%nested) j_end = MIN(jde-2,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) + +! diffusion of the TKE needs mutiple 2 + + IF ( doing_tke ) THEN + DO j = j_start, j_end + DO k = kts,ktf + DO i = i_start, i_end + tmptendf(i,k,j)=tendency(i,k,j) + ENDDO + ENDDO + ENDDO + ENDIF + +! H1 = partial var over partial x + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + 1 +! new +! zxavg(i,k,j) =0.5*( zx(i-1,k,j)+ zx(i,k,j)) + xkxavg(i,k,j)=0.5*(xkhh(i-1,k,j)+xkhh(i,k,j)) + ENDDO + ENDDO + ENDDO + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + 1 + H1avg(i,k,j)=0.5*(fnm(k)*(var(i-1,k ,j)+var(i,k ,j))+ & + fnp(k)*(var(i-1,k-1,j)+var(i,k-1,j))) + ENDDO + ENDDO + ENDDO + + DO j = j_start, j_end + DO i = i_start, i_end + 1 + H1avg(i,kts ,j)=0.5*(cf1*var(i ,1,j)+cf2*var(i ,2,j)+ & + cf3*var(i ,3,j)+cf1*var(i-1,1,j)+ & + cf2*var(i-1,2,j)+cf3*var(i-1,3,j)) + H1avg(i,ktf+1,j)=0.5*(var(i,ktes1,j)+(var(i,ktes1,j)- & + var(i,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)+ & + var(i-1,ktes1,j)+(var(i-1,ktes1,j)- & + var(i-1,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)) + ENDDO + ENDDO + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + 1 +! new + tmpzx = 0.5*( zx(i,k,j)+ zx(i,k+1,j)) + rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j)) + H1(i,k,j)=-msfuy(i,j)*xkxavg(i,k,j)*( & + rdx*(var(i,k,j)-var(i-1,k,j)) - tmpzx* & + (H1avg(i,k+1,j)-H1avg(i,k,j))*rdzu ) + +! tmpzeta_z = 0.5*(zeta_z(i,j)+zeta_z(i-1,j)) +! H1(i,k,j)=-msfuy(i,j)*xkxavg(i,k,j)*( & +! rdx*(var(i,k,j)-var(i-1,k,j)) - tmpzx*tmpzeta_z* & +! (H1avg(i,k+1,j)-H1avg(i,k,j))/dnw(k)) + ENDDO + ENDDO + ENDDO + +! H2 = partial var over partial y + + DO j = j_start, j_end + 1 + DO k = kts, ktf + DO i = i_start, i_end +! new +! zyavg(i,k,j) =0.5*( zy(i,k,j-1)+ zy(i,k,j)) + xkxavg(i,k,j)=0.5*(xkhh(i,k,j-1)+xkhh(i,k,j)) + ENDDO + ENDDO + ENDDO + + DO j = j_start, j_end + 1 + DO k = kts+1, ktf + DO i = i_start, i_end +! new + H2avg(i,k,j)=0.5*(fnm(k)*(var(i,k ,j-1)+var(i,k ,j))+ & + fnp(k)*(var(i,k-1,j-1)+var(i,k-1,j))) + ENDDO + ENDDO + ENDDO + + DO j = j_start, j_end + 1 + DO i = i_start, i_end + H2avg(i,kts ,j)=0.5*(cf1*var(i,1,j )+cf2*var(i ,2,j)+ & + cf3*var(i,3,j )+cf1*var(i,1,j-1)+ & + cf2*var(i,2,j-1)+cf3*var(i,3,j-1)) + H2avg(i,ktf+1,j)=0.5*(var(i,ktes1,j)+(var(i,ktes1,j)- & + var(i,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)+ & + var(i,ktes1,j-1)+(var(i,ktes1,j-1)- & + var(i,ktes2,j-1))*0.5*dnw(ktes1)/dn(ktes1)) + ENDDO + ENDDO + + DO j = j_start, j_end + 1 + DO k = kts, ktf + DO i = i_start, i_end +! new + tmpzy = 0.5*( zy(i,k,j)+ zy(i,k+1,j)) + rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1)) + H2(i,k,j)=-msfvy(i,j)*xkxavg(i,k,j)*( & + rdy*(var(i,k,j)-var(i,k,j-1)) - tmpzy* & + (H2avg(i ,k+1,j)-H2avg(i,k,j))*rdzv) + +! tmpzeta_z = 0.5*(zeta_z(i,j)+zeta_z(i,j-1)) +! H2(i,k,j)=-msfvy(i,j)*xkxavg(i,k,j)*( & +! rdy*(var(i,k,j)-var(i,k,j-1)) - tmpzy*tmpzeta_z* & +! (H2avg(i ,k+1,j)-H2avg(i,k,j))/dnw(k)) + ENDDO + ENDDO + ENDDO + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + H1avg(i,k,j)=0.5*(fnm(k)*(H1(i+1,k ,j)+H1(i,k ,j))+ & + fnp(k)*(H1(i+1,k-1,j)+H1(i,k-1,j))) + H2avg(i,k,j)=0.5*(fnm(k)*(H2(i,k ,j+1)+H2(i,k ,j))+ & + fnp(k)*(H2(i,k-1,j+1)+H2(i,k-1,j))) +! new +! zxavg(i,k,j)=fnm(k)*zx(i,k,j)+fnp(k)*zx(i,k-1,j) +! zyavg(i,k,j)=fnm(k)*zy(i,k,j)+fnp(k)*zy(i,k-1,j) + +! H1avg(i,k,j)=zx*H1avg*zeta_z +! H2avg(i,k,j)=zy*H2avg*zeta_z + + tmpzx = 0.5*( zx(i,k,j)+ zx(i+1,k,j )) + tmpzy = 0.5*( zy(i,k,j)+ zy(i ,k,j+1)) + + H1avg(i,k,j)=H1avg(i,k,j)*tmpzx + H2avg(i,k,j)=H2avg(i,k,j)*tmpzy + +! H1avg(i,k,j)=H1avg(i,k,j)*tmpzx*zeta_z(i,j) +! H2avg(i,k,j)=H2avg(i,k,j)*tmpzy*zeta_z(i,j) + ENDDO + ENDDO + ENDDO + + DO j = j_start, j_end + DO i = i_start, i_end + H1avg(i,kts ,j)=0. + H1avg(i,ktf+1,j)=0. + H2avg(i,kts ,j)=0. + H2avg(i,ktf+1,j)=0. + ENDDO + ENDDO + + DO j = j_start, j_end + DO k = kts,ktf + DO i = i_start, i_end + + mrdx=msftx(i,j)*rdx + mrdy=msfty(i,j)*rdy + + tendency(i,k,j)=tendency(i,k,j)- & + (mrdx*0.5*((mu(i+1,j)+mu(i,j))*H1(i+1,k,j)- & + (mu(i-1,j)+mu(i,j))*H1(i ,k,j))+ & + mrdy*0.5*((mu(i,j+1)+mu(i,j))*H2(i,k,j+1)- & + (mu(i,j-1)+mu(i,j))*H2(i,k,j ))- & + msfty(i,j)*mu(i,j)*(H1avg(i,k+1,j)-H1avg(i,k,j)+ & + H2avg(i,k+1,j)-H2avg(i,k,j) & + )*rdzw(i,k,j) & + ) + + ENDDO + ENDDO + ENDDO + + IF ( doing_tke ) THEN + DO j = j_start, j_end + DO k = kts,ktf + DO i = i_start, i_end + tendency(i,k,j)=tmptendf(i,k,j)+2.* & + (tendency(i,k,j)-tmptendf(i,k,j)) + ENDDO + ENDDO + ENDDO + ENDIF + +END SUBROUTINE horizontal_diffusion_s + +!======================================================================= +!======================================================================= + +SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & + tke_tendf, moist_tendf, n_moist, & + chem_tendf, n_chem, & + scalar_tendf, n_scalar, & + u_2, v_2, & + thp,u_base,v_base,t_base,qv_base,mu,tke, & + config_flags,defor13,defor23,defor33,div, & + moist, chem, scalar, xkmv, xkhv,km_opt, & + fnm, fnp, dn, dnw, rdz, rdzw, & + hfx, qfx, ust, rho, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER , INTENT(IN ) :: n_moist, n_chem, n_scalar, km_opt + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dn + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: qv_base + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: u_base + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: v_base + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: t_base + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::ru_tendf,& + rv_tendf,& + rw_tendf,& + tke_tendf,& + rt_tendf + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist), & + INTENT(INOUT) :: moist_tendf + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem), & + INTENT(INOUT) :: chem_tendf + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar) , & + INTENT(INOUT) :: scalar_tendf + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist), & + INTENT(INOUT) :: moist + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem), & + INTENT(INOUT) :: chem + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar) , & + INTENT(IN ) :: scalar + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) ::defor13, & + defor23, & + defor33, & + div, & + xkmv, & + xkhv, & + tke, & + rdz, & + u_2, & + v_2, & + rdzw + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: rho + REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: hfx, & + qfx + REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: ust + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: thp + +! LOCAL VAR + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme) :: var_mix + + INTEGER :: im, i,j,k + INTEGER :: i_start, i_end, j_start, j_end + +! REAL , DIMENSION( its:ite, kts:kte, jts:jte) :: xkhv + +!*************************************************************************** +!*************************************************************************** +!MODIFICA VARIABILI PER I FLUSSI +! + REAL :: V0_u,V0_v,tao_xz,tao_yz,ustar,cd0 + REAL :: xsfc,psi1,vk2,zrough,lnz + REAL :: heat_flux, moist_flux, heat_flux0 + REAL :: cpm +! +!FINE MODIFICA VARIABILI PER I FLUSSI +!*************************************************************************** +! + +! End declarations. +!----------------------------------------------------------------------- + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) +! +!----------------------------------------------------------------------- + + CALL vertical_diffusion_u_2( ru_tendf, config_flags, mu, & + defor13, xkmv, & + dnw, rdzw, fnm, fnp, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + + CALL vertical_diffusion_v_2( rv_tendf, config_flags, mu, & + defor23, xkmv, & + dnw, rdzw, fnm, fnp, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL vertical_diffusion_w_2( rw_tendf, config_flags, mu, & + defor33, tke(ims,kms,jms), & + div, xkmv, & + dn, rdz, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!***************************************** +!***************************************** +! MODIFICA al flusso di momento alla parete +! + vflux: SELECT CASE( config_flags%isfflx ) + CASE (0) ! Assume cd a constant, specified in namelist + cd0 = config_flags%tke_drag_coefficient ! constant drag coefficient + ! set in namelist.input +! +!calcolo del modulo della velocita + DO j = j_start, j_end + DO i = i_start, ite + V0_u=0. + tao_xz=0. + V0_u= sqrt((u_2(i,kts,j)**2) + & + (((v_2(i ,kts,j )+ & + v_2(i ,kts,j+1)+ & + v_2(i-1,kts,j )+ & + v_2(i-1,kts,j+1))/4)**2))+epsilon + tao_xz=cd0*V0_u*u_2(i,kts,j) + ru_tendf(i,kts,j)=ru_tendf(i,kts,j) & + -0.25*(mu(i,j)+mu(i-1,j))*tao_xz*(rdzw(i,kts,j)+rdzw(i-1,kts,j)) + ENDDO + ENDDO + +! + DO j = j_start, jte + DO i = i_start, i_end + V0_v=0. + tao_yz=0. + V0_v= sqrt((v_2(i,kts,j)**2) + & + (((u_2(i ,kts,j )+ & + u_2(i ,kts,j-1)+ & + u_2(i+1,kts,j )+ & + u_2(i+1,kts,j-1))/4)**2))+epsilon + tao_yz=cd0*V0_v*v_2(i,kts,j) + rv_tendf(i,kts,j)=rv_tendf(i,kts,j) & + -0.25*(mu(i,j)+mu(i,j-1))*tao_yz*(rdzw(i,kts,j)+rdzw(i,kts,j-1)) + ENDDO + ENDDO + + CASE (1,2) ! ustar computed from surface routine + DO j = j_start, j_end + DO i = i_start, ite + V0_u=0. + tao_xz=0. + V0_u= sqrt((u_2(i,kts,j)**2) + & + (((v_2(i ,kts,j )+ & + v_2(i ,kts,j+1)+ & + v_2(i-1,kts,j )+ & + v_2(i-1,kts,j+1))/4)**2))+epsilon + ustar=0.5*(ust(i,j)+ust(i-1,j)) + tao_xz=ustar*ustar*u_2(i,kts,j)/V0_u + ru_tendf(i,kts,j)=ru_tendf(i,kts,j) & + -0.25*(mu(i,j)+mu(i-1,j))*tao_xz*(rdzw(i,kts,j)+rdzw(i-1,kts,j)) + ENDDO + ENDDO + + DO j = j_start, jte + DO i = i_start, i_end + V0_v=0. + tao_yz=0. + V0_v= sqrt((v_2(i,kts,j)**2) + & + (((u_2(i ,kts,j )+ & + u_2(i ,kts,j-1)+ & + u_2(i+1,kts,j )+ & + u_2(i+1,kts,j-1))/4)**2))+epsilon + ustar=0.5*(ust(i,j)+ust(i,j-1)) + tao_yz=ustar*ustar*v_2(i,kts,j)/V0_v + rv_tendf(i,kts,j)=rv_tendf(i,kts,j) & + -0.25*(mu(i,j)+mu(i,j-1))*tao_yz*(rdzw(i,kts,j)+rdzw(i,kts,j-1)) + ENDDO + ENDDO + + CASE DEFAULT + CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' ) + END SELECT vflux + +! +! FINE MODIFICA al flusso di momento alla parete +!***************************************** +!***************************************** + + IF ( config_flags%mix_full_fields ) THEN + + DO j=jts,min(jte,jde-1) + DO k=kts,kte-1 + DO i=its,min(ite,ide-1) + var_mix(i,k,j) = thp(i,k,j) + ENDDO + ENDDO + ENDDO + + ELSE + + DO j=jts,min(jte,jde-1) + DO k=kts,kte-1 + DO i=its,min(ite,ide-1) + var_mix(i,k,j) = thp(i,k,j) - t_base(k) + ENDDO + ENDDO + ENDDO + + END IF + + CALL vertical_diffusion_s( rt_tendf, config_flags, var_mix, mu, xkhv, & + dn, dnw, rdz, rdzw, fnm, fnp, & + .false., & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + +!***************************************** +!***************************************** +!MODIFICA al flusso di calore +! +! + hflux: SELECT CASE( config_flags%isfflx ) + CASE (0,2) ! with fixed surface heat flux given in the namelist + heat_flux = config_flags%tke_heat_flux ! constant heat flux value + ! set in namelist.input + DO j = j_start, j_end + DO i = i_start, i_end + rt_tendf(i,kts,j)=rt_tendf(i,kts,j) & + +mu(i,j)*heat_flux*rdzw(i,kts,j) + ENDDO + ENDDO + + CASE (1) ! use surface heat flux computed from surface routine + DO j = j_start, j_end + DO i = i_start, i_end + + cpm = cp * (1. + 0.8 * moist(i,kts,j,P_QV)) + heat_flux = hfx(i,j)/cpm/rho(i,1,j) + rt_tendf(i,kts,j)=rt_tendf(i,kts,j) & + +mu(i,j)*heat_flux*rdzw(i,kts,j) + + ENDDO + ENDDO + + CASE DEFAULT + CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' ) + END SELECT hflux + +! +! FINE MODIFICA al flusso di calore +!***************************************** +!***************************************** + + If (km_opt .eq. 2) then + CALL vertical_diffusion_s( tke_tendf(ims,kms,jms), & + config_flags, tke(ims,kms,jms), & + mu, xkhv, & + dn, dnw, rdz, rdzw, fnm, fnp, & + .true., & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + endif + + IF (n_moist .ge. PARAM_FIRST_SCALAR) THEN + + moist_loop: do im = PARAM_FIRST_SCALAR, n_moist + + IF ( (.not. config_flags%mix_full_fields) .and. (im == P_QV) ) THEN + + DO j=jts,min(jte,jde-1) + DO k=kts,kte-1 + DO i=its,min(ite,ide-1) + var_mix(i,k,j) = moist(i,k,j,im) - qv_base(k) + ENDDO + ENDDO + ENDDO + + ELSE + + DO j=jts,min(jte,jde-1) + DO k=kts,kte-1 + DO i=its,min(ite,ide-1) + var_mix(i,k,j) = moist(i,k,j,im) + ENDDO + ENDDO + ENDDO + + END IF + + + CALL vertical_diffusion_s( moist_tendf(ims,kms,jms,im), & + config_flags, var_mix, & + mu, xkhv, & + dn, dnw, rdz, rdzw, fnm, fnp, & + .false., & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!***************************************** +!***************************************** +!MODIFICATIONS for water vapor flux +! +! + qflux: SELECT CASE( config_flags%isfflx ) + CASE (0) +! do nothing + CASE (1,2) ! with surface moisture flux + IF ( im == P_QV ) THEN + DO j = j_start, j_end + DO i = i_start, i_end + moist_flux = qfx(i,j)/rho(i,1,j) + moist_tendf(i,kts,j,im)=moist_tendf(i,kts,j,im) & + +mu(i,j)*moist_flux*rdzw(i,kts,j) + ENDDO + ENDDO + ENDIF + + CASE DEFAULT + CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' ) + END SELECT qflux +! +! END MODIFICATIONS for water vapor flux +!***************************************** +!***************************************** + ENDDO moist_loop + + ENDIF + + IF (n_chem .ge. PARAM_FIRST_SCALAR) THEN + + chem_loop: do im = PARAM_FIRST_SCALAR, n_chem + + CALL vertical_diffusion_s( chem_tendf(ims,kms,jms,im), & + config_flags, chem(ims,kms,jms,im), & + mu, xkhv, & + dn, dnw, rdz, rdzw, fnm, fnp, & + .false., & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + ENDDO chem_loop + + ENDIF + + + IF (n_scalar .ge. PARAM_FIRST_SCALAR) THEN + + scalar_loop: do im = PARAM_FIRST_SCALAR, n_scalar + + CALL vertical_diffusion_s( scalar_tendf(ims,kms,jms,im), & + config_flags, scalar(ims,kms,jms,im), & + mu, xkhv, & + dn, dnw, rdz, rdzw, fnm, fnp, & + .false., & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + ENDDO scalar_loop + + ENDIF + +END SUBROUTINE vertical_diffusion_2 + +!======================================================================= +!======================================================================= + +SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu, & + defor13, xkmv, & + dnw, rdzw, fnm, fnp, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw +! REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: zeta_z + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & + INTENT(IN ) ::defor13, & + xkmv, & + rdzw + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu + +! LOCAL VARS + + INTEGER :: i, j, k, ktf + + INTEGER :: i_start, i_end, j_start, j_end + INTEGER :: is_ext,ie_ext,js_ext,je_ext + + REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau3 + + REAL , DIMENSION( its:ite, jts:jte) :: zzavg + + REAL :: rdzu + +! End declarations. +!----------------------------------------------------------------------- + + ktf=MIN(kte,kde-1) + + i_start = its + i_end = ite + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .or. config_flags%specified .or. & + config_flags%nested) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. config_flags%specified .or. & + config_flags%nested) i_end = MIN(ide-1,ite) + IF ( config_flags%open_ys .or. config_flags%specified .or. & + config_flags%nested) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. config_flags%specified .or. & + config_flags%nested) j_end = MIN(jde-2,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = ite + +! titau3 = titau13 + is_ext=0 + ie_ext=0 + js_ext=0 + je_ext=0 + CALL cal_titau_13_31( config_flags, titau3, defor13, & + mu, xkmv, fnm, fnp, & + is_ext, ie_ext, js_ext, je_ext, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) +! + DO j = j_start, j_end + DO k=kts+1,ktf + DO i = i_start, i_end + + rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j)) + tendency(i,k,j)=tendency(i,k,j)-rdzu*(titau3(i,k+1,j)-titau3(i,k,j)) + + ENDDO + ENDDO + ENDDO + +! ******** MODIF... +! we will pick up the surface drag (titau3(i,kts,j)) later +! + DO j = j_start, j_end + k=kts + DO i = i_start, i_end + + rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j)) + tendency(i,k,j)=tendency(i,k,j)-rdzu*(titau3(i,k+1,j)) + ENDDO + ENDDO +! ******** MODIF... + +END SUBROUTINE vertical_diffusion_u_2 + +!======================================================================= +!======================================================================= + +SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu, & + defor23, xkmv, & + dnw, rdzw, fnm, fnp, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw +! REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: zeta_z + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & + INTENT(IN ) ::defor23, & + xkmv, & + rdzw + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu + +! LOCAL VARS + + INTEGER :: i, j, k, ktf + + INTEGER :: i_start, i_end, j_start, j_end + INTEGER :: is_ext,ie_ext,js_ext,je_ext + + REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau3 + + REAL , DIMENSION( its:ite, jts:jte) :: zzavg + + REAL :: rdzv + +! End declarations. +!----------------------------------------------------------------------- + + ktf=MIN(kte,kde-1) + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = jte + + IF ( config_flags%open_xs .or. config_flags%specified .or. & + config_flags%nested) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. config_flags%specified .or. & + config_flags%nested) i_end = MIN(ide-2,ite) + IF ( config_flags%open_ys .or. config_flags%specified .or. & + config_flags%nested) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. config_flags%specified .or. & + config_flags%nested) j_end = MIN(jde-1,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) + +! titau3 = titau23 + is_ext=0 + ie_ext=0 + js_ext=0 + je_ext=0 + CALL cal_titau_23_32( config_flags, titau3, defor23, & + mu, xkmv, fnm, fnp, & + is_ext, ie_ext, js_ext, je_ext, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + DO j = j_start, j_end + DO k = kts+1,ktf + DO i = i_start, i_end + + rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1)) + tendency(i,k,j)=tendency(i,k,j)-rdzv*(titau3(i,k+1,j)-titau3(i,k,j)) + + ENDDO + ENDDO + ENDDO + +! ******** MODIF... +! we will pick up the surface drag (titau3(i,kts,j)) later +! + DO j = j_start, j_end + k=kts + DO i = i_start, i_end + + rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1)) + tendency(i,k,j)=tendency(i,k,j)-rdzv*(titau3(i,k+1,j)) + + ENDDO + ENDDO +! ******** MODIF... + +END SUBROUTINE vertical_diffusion_v_2 + +!======================================================================= +!======================================================================= + +SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu, & + defor33, tke, div, xkmv, & + dn, rdz, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dn + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & + INTENT(IN ) ::defor33, & + tke, & + div, & + xkmv, & + rdz + + REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: mu + +! LOCAL VARS + + INTEGER :: i, j, k, ktf + + INTEGER :: i_start, i_end, j_start, j_end + INTEGER :: is_ext,ie_ext,js_ext,je_ext + + REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau3 + +! End declarations. +!----------------------------------------------------------------------- + + ktf=MIN(kte,kde-1) + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .or. config_flags%specified .or. & + config_flags%nested) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. config_flags%specified .or. & + config_flags%nested) i_end = MIN(ide-2,ite) + IF ( config_flags%open_ys .or. config_flags%specified .or. & + config_flags%nested) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. config_flags%specified .or. & + config_flags%nested) j_end = MIN(jde-2,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) + +! titau3 = titau33 + is_ext=0 + ie_ext=0 + js_ext=0 + je_ext=0 + CALL cal_titau_11_22_33( config_flags, titau3, & + mu, tke, xkmv, defor33, & + is_ext, ie_ext, js_ext, je_ext, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! DO j = j_start, j_end +! DO k = kts+1, ktf +! DO i = i_start, i_end +! titau3(i,k,j)=titau3(i,k,j)*zeta_z(i,j) +! ENDDO +! ENDDO +! ENDDO + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + tendency(i,k,j)=tendency(i,k,j)-rdz(i,k,j)*(titau3(i,k,j)-titau3(i,k-1,j)) + ENDDO + ENDDO + ENDDO + +END SUBROUTINE vertical_diffusion_w_2 + +!======================================================================= +!======================================================================= + +SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, mu, xkhv, & + dn, dnw, rdz, rdzw, fnm, fnp, & + doing_tke, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + LOGICAL, INTENT(IN ) :: doing_tke + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dn + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN) :: xkhv + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: mu + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & + INTENT(IN ) :: var, & + rdz, & + rdzw +! LOCAL VARS + + INTEGER :: i, j, k, ktf + + INTEGER :: i_start, i_end, j_start, j_end + + REAL , DIMENSION( its:ite, kts:kte, jts:jte) :: H3, & + xkxavg, & + rravg + + REAL , DIMENSION( its:ite, kts:kte, jts:jte) :: tmptendf + +! End declarations. +!----------------------------------------------------------------------- + + ktf=MIN(kte,kde-1) + + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .or. config_flags%specified .or. & + config_flags%nested) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. config_flags%specified .or. & + config_flags%nested) i_end = MIN(ide-2,ite) + IF ( config_flags%open_ys .or. config_flags%specified .or. & + config_flags%nested) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. config_flags%specified .or. & + config_flags%nested) j_end = MIN(jde-2,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) + + IF (doing_tke) THEN + DO j = j_start, j_end + DO k = kts,ktf + DO i = i_start, i_end + tmptendf(i,k,j)=tendency(i,k,j) + ENDDO + ENDDO + ENDDO + ENDIF + +! H3 + + xkxavg = 0. + + DO j = j_start, j_end + DO k = kts+1,ktf + DO i = i_start, i_end + xkxavg(i,k,j)=fnm(k)*xkhv(i,k,j)+fnp(k)*xkhv(i,k-1,j) + H3(i,k,j)=-xkxavg(i,k,j)*(var(i,k,j)-var(i,k-1,j))*rdz(i,k,j) +! H3(i,k,j)=-xkxavg(i,k,j)*zeta_z(i,j)* & +! (var(i,k,j)-var(i,k-1,j))/dn(k) + ENDDO + ENDDO + ENDDO + + DO j = j_start, j_end + DO i = i_start, i_end + H3(i,kts,j)=0. + H3(i,ktf+1,j)=0. +! H3(i,kts,j)=H3(i,kts+1,j) +! H3(i,ktf+1,j)=H3(i,ktf,j) + ENDDO + ENDDO + + DO j = j_start, j_end + DO k = kts,ktf + DO i = i_start, i_end + tendency(i,k,j)=tendency(i,k,j) & + -mu(i,j)*(H3(i,k+1,j)-H3(i,k,j))*rdzw(i,k,j) + ENDDO + ENDDO + ENDDO + + IF (doing_tke) THEN + DO j = j_start, j_end + DO k = kts,ktf + DO i = i_start, i_end + tendency(i,k,j)=tmptendf(i,k,j)+2.* & + (tendency(i,k,j)-tmptendf(i,k,j)) + ENDDO + ENDDO + ENDDO + ENDIF + +END SUBROUTINE vertical_diffusion_s + +!======================================================================= +!======================================================================= + + SUBROUTINE cal_titau_11_22_33( config_flags, titau, & + mu, tke, xkx, defor, & + is_ext, ie_ext, js_ext, je_ext, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! History: Sep 2003 Changes by George Bryan and Jason Knievel, NCAR +! Oct 2001 Converted to mass core by Bill Skamarock, NCAR +! Aug 2000 Original code by Shu-Hua Chen, UC-Davis + +! Purpose: This routine calculates stress terms (taus) for use in +! the calculation of production of TKE by sheared wind + +! References: Klemp and Wilhelmson (JAS 1978) +! Deardorff (B-L Meteor 1980) +! Chen and Dudhia (NCAR WRF physics report 2000) + +! Key: + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type ), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER, INTENT( IN ) & + :: is_ext, ie_ext, js_ext, je_ext + + REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT ) & + :: titau + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: defor, xkx, tke + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & + :: mu + +! Local variables. + + INTEGER & + :: i, j, k, ktf, i_start, i_end, j_start, j_end + +! End declarations. +!----------------------------------------------------------------------- + + ktf = MIN( kte, kde-1 ) + + i_start = its + i_end = ite + j_start = jts + j_end = jte + + IF ( config_flags%open_xs .OR. config_flags%specified .OR. & + config_flags%nested) i_start = MAX( ids+1, its ) + IF ( config_flags%open_xe .OR. config_flags%specified .OR. & + config_flags%nested) i_end = MIN( ide-1, ite ) + IF ( config_flags%open_ys .OR. config_flags%specified .OR. & + config_flags%nested) j_start = MAX( jds+1, jts ) + IF ( config_flags%open_ye .OR. config_flags%specified .OR. & + config_flags%nested) j_end = MIN( jde-1, jte ) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = ite + + i_start = i_start - is_ext + i_end = i_end + ie_ext + j_start = j_start - js_ext + j_end = j_end + je_ext + + IF ( config_flags%km_opt .EQ. 2) THEN + DO j = j_start,j_end + DO k = kts,ktf + DO i = i_start,i_end + titau(i,k,j) = mu(i,j) * ( - xkx(i,k,j) * ( defor(i,k,j) ) ) + END DO + END DO + END DO + ELSE + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + titau(i,k,j) = - mu(i,j) * xkx(i,k,j) * defor(i,k,j) + END DO + END DO + END DO + END IF + + END SUBROUTINE cal_titau_11_22_33 + +!======================================================================= +!======================================================================= + + SUBROUTINE cal_titau_12_21( config_flags, titau, & + mu, xkx, defor, & + is_ext, ie_ext, js_ext, je_ext, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! History: Sep 2003 Modifications by George Bryan and Jason Knievel, NCAR +! Oct 2001 Converted to mass core by Bill Skamarock, NCAR +! Aug 2000 Original code by Shu-Hua Chen, UC-Davis + +! Pusrpose This routine calculates the stress terms (taus) for use in +! the calculation of production of TKE by sheared wind + +! References: Klemp and Wilhelmson (JAS 1978) +! Deardorff (B-L Meteor 1980) +! Chen and Dudhia (NCAR WRF physics report 2000) + +! Key: + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER, INTENT( IN ) & + :: is_ext, ie_ext, js_ext, je_ext + + REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT ) & + :: titau + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: defor, xkx + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & + :: mu + +! Local variables. + + INTEGER & + :: i, j, k, ktf, i_start, i_end, j_start, j_end + + REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) & + :: xkxavg + + REAL, DIMENSION( its-1:ite+1, jts-1:jte+1 ) & + :: muavg + +! End declarations. +!----------------------------------------------------------------------- + + ktf = MIN( kte, kde-1 ) + +! Needs one more point in the x and y directions. + + i_start = its + i_end = ite + j_start = jts + j_end = jte + + IF ( config_flags%open_xs .OR. config_flags%specified .OR. & + config_flags%nested ) i_start = MAX( ids+1, its ) + IF ( config_flags%open_xe .OR. config_flags%specified .OR. & + config_flags%nested ) i_end = MIN( ide-1, ite ) + IF ( config_flags%open_ys .OR. config_flags%specified .OR. & + config_flags%nested ) j_start = MAX( jds+1, jts ) + IF ( config_flags%open_ye .OR. config_flags%specified .OR. & + config_flags%nested ) j_end = MIN( jde-1, jte ) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = ite + + i_start = i_start - is_ext + i_end = i_end + ie_ext + j_start = j_start - js_ext + j_end = j_end + je_ext + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + xkxavg(i,k,j) = 0.25 * ( xkx(i-1,k,j ) + xkx(i,k,j ) + & + xkx(i-1,k,j-1) + xkx(i,k,j-1) ) + END DO + END DO + END DO + + DO j = j_start, j_end + DO i = i_start, i_end + muavg(i,j) = 0.25 * ( mu(i-1,j ) + mu(i,j ) + & + mu(i-1,j-1) + mu(i,j-1) ) + END DO + END DO + +! titau12 or titau21 + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j) + END DO + END DO + END DO + + END SUBROUTINE cal_titau_12_21 + +!======================================================================= + + SUBROUTINE cal_titau_13_31( config_flags, titau, & + defor, mu, xkx, fnm, fnp, & + is_ext, ie_ext, js_ext, je_ext, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! History: Sep 2003 Modifications by George Bryan and Jason Knievel, NCAR +! Oct 2001 Converted to mass core by Bill Skamarock, NCAR +! Aug 2000 Original code by Shu-Hua Chen, UC-Davis + +! Purpose: This routine calculates the stress terms (taus) for use in +! the calculation of production of TKE by sheared wind + +! References: Klemp and Wilhelmson (JAS 1978) +! Deardorff (B-L Meteor 1980) +! Chen and Dudhia (NCAR WRF physics report 2000) + +! Key: + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER, INTENT( IN ) & + :: is_ext, ie_ext, js_ext, je_ext + + REAL, DIMENSION( kms:kme ), INTENT( IN ) & + :: fnm, fnp + + REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT ) & + :: titau + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme), INTENT( IN ) & + :: defor, xkx + + REAL, DIMENSION( ims:ime, jms:jme), INTENT( IN ) & + :: mu + +! Local variables. + + INTEGER & + :: i, j, k, ktf, i_start, i_end, j_start, j_end + + REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) & + :: xkxavg + + REAL, DIMENSION( its-1:ite+1, jts-1:jte+1 ) & + :: muavg + +! End declarations. +!----------------------------------------------------------------------- + + ktf = MIN( kte, kde-1 ) + +! Find ide-1 and jde-1 for averaging to p point. + + i_start = its + i_end = ite + j_start = jts + j_end = MIN( jte, jde-1 ) + + IF ( config_flags%open_xs .OR. config_flags%specified .OR. & + config_flags%nested) i_start = MAX( ids+1, its ) + IF ( config_flags%open_xe .OR. config_flags%specified .OR. & + config_flags%nested) i_end = MIN( ide-1, ite ) + IF ( config_flags%open_ys .OR. config_flags%specified .OR. & + config_flags%nested) j_start = MAX( jds+1, jts ) + IF ( config_flags%open_ye .OR. config_flags%specified .OR. & + config_flags%nested) j_end = MIN( jde-2, jte ) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = ite + + i_start = i_start - is_ext + i_end = i_end + ie_ext + j_start = j_start - js_ext + j_end = j_end + je_ext + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k ,j) + xkx(i-1,k ,j) ) + & + fnp(k) * ( xkx(i,k-1,j) + xkx(i-1,k-1,j) ) ) + END DO + END DO + END DO + + DO j = j_start, j_end + DO i = i_start, i_end + muavg(i,j) = 0.5 * ( mu(i,j) + mu(i-1,j) ) + END DO + END DO + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j) + ENDDO + ENDDO + ENDDO + + DO j = j_start, j_end + DO i = i_start, i_end + titau(i,kts ,j) = 0.0 + titau(i,ktf+1,j) = 0.0 + ENDDO + ENDDO + + END SUBROUTINE cal_titau_13_31 + +!======================================================================= +!======================================================================= + + SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & + mu, xkx, fnm, fnp, & + is_ext, ie_ext, js_ext, je_ext, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! History: Sep 2003 Changes by George Bryan and Jason Knievel, NCAR +! Oct 2001 Converted to mass core by Bill Skamarock, NCAR +! Aug 2000 Original code by Shu-Hua Chen, UC-Davis + +! Purpose: This routine calculates stress terms (taus) for use in +! the calculation of production of TKE by sheared wind + +! References: Klemp and Wilhelmson (JAS 1978) +! Deardorff (B-L Meteor 1980) +! Chen and Dudhia (NCAR WRF physics report 2000) + +! Key: + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type ), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER, INTENT( IN ) & + :: is_ext,ie_ext,js_ext,je_ext + + REAL, DIMENSION( kms:kme ), INTENT( IN ) & + :: fnm, fnp + + REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT ) & + :: titau + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: defor, xkx + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & + :: mu + +! Local variables. + + INTEGER & + :: i, j, k, ktf, i_start, i_end, j_start, j_end + + REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) & + :: xkxavg + + REAL, DIMENSION( its-1:ite+1, jts-1:jte+1 ) & + :: muavg + +! End declarations. +!----------------------------------------------------------------------- + + ktf = MIN( kte, kde-1 ) + +! Find ide-1 and jde-1 for averaging to p point. + + i_start = its + i_end = MIN( ite, ide-1 ) + j_start = jts + j_end = jte + + IF ( config_flags%open_xs .OR. config_flags%specified .OR. & + config_flags%nested) i_start = MAX( ids+1, its ) + IF ( config_flags%open_xe .OR. config_flags%specified .OR. & + config_flags%nested) i_end = MIN( ide-2, ite ) + IF ( config_flags%open_ys .OR. config_flags%specified .OR. & + config_flags%nested) j_start = MAX( jds+1, jts ) + IF ( config_flags%open_ye .OR. config_flags%specified .OR. & + config_flags%nested) j_end = MIN( jde-1, jte ) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) + + i_start = i_start - is_ext + i_end = i_end + ie_ext + j_start = j_start - js_ext + j_end = j_end + je_ext + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k ,j) + xkx(i,k ,j-1) ) + & + fnp(k) * ( xkx(i,k-1,j) + xkx(i,k-1,j-1) ) ) + END DO + END DO + END DO + + DO j = j_start, j_end + DO i = i_start, i_end + muavg(i,j) = 0.5 * ( mu(i,j) + mu(i,j-1) ) + END DO + END DO + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j) + END DO + END DO + END DO + + DO j = j_start, j_end + DO i = i_start, i_end + titau(i,kts ,j) = 0.0 + titau(i,ktf+1,j) = 0.0 + END DO + END DO + + END SUBROUTINE cal_titau_23_32 + +!======================================================================= +!======================================================================= + +SUBROUTINE phy_bc ( config_flags,div,defor11,defor22,defor33, & + defor12,defor13,defor23,xkmh,xkmv,xkhh,xkhv,tke, & + RUBLTEN, RVBLTEN, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + +!------------------------------------------------------------------------------ +! Begin declarations. + + IMPLICIT NONE + + TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::RUBLTEN, & + RVBLTEN, & + defor11, & + defor22, & + defor33, & + defor12, & + defor13, & + defor23, & + xkmh, & + xkmv, & + xkhh, & + xkhv, & + tke, & + div + +! End declarations. +!----------------------------------------------------------------------- + + IF( (config_flags%bl_pbl_physics .GT. 0) & + .OR. (config_flags%modif_wrf) ) THEN +!****MARS: Always do that ?? > yes, for periodic simu -- grep in share + + CALL set_physical_bc3d( RUBLTEN , 't', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + CALL set_physical_bc3d( RVBLTEN , 't', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + ENDIF + + ! move out of the conditional, below; horiz coeffs needed for + ! all diff_opt cases. JM + + CALL set_physical_bc3d( xkmh , 't', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + CALL set_physical_bc3d( xkhh , 't', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + IF(config_flags%diff_opt .eq. 2) THEN + + CALL set_physical_bc3d( xkmv , 't', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + CALL set_physical_bc3d( xkhv , 't', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + CALL set_physical_bc3d( tke , 't', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + CALL set_physical_bc3d( div , 't', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + CALL set_physical_bc3d( defor11 , 't', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + CALL set_physical_bc3d( defor22 , 't', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + CALL set_physical_bc3d( defor33 , 't', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + CALL set_physical_bc3d( defor12 , 'd', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + CALL set_physical_bc3d( defor13 , 'e', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + CALL set_physical_bc3d( defor23 , 'f', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte ) + + ENDIF + +END SUBROUTINE phy_bc + +!======================================================================= +!======================================================================= + + SUBROUTINE tke_rhs( tendency, BN2, config_flags, & + defor11, defor22, defor33, & + defor12, defor13, defor23, & + u, v, w, div, tke, mu, & + theta, p, p8w, t8w, z, fnm, fnp, & + cf1, cf2, cf3, msftx, msfty, & + xkmh, xkmv, xkhv, & + rdx, rdy, dx, dy, dt, zx, zy, & + rdz, rdzw, dn, dnw, isotropic, & + hfx, qfx, qv, ust, rho, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type ), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER, INTENT( IN ) :: isotropic + REAL, INTENT( IN ) & + :: cf1, cf2, cf3, dt, rdx, rdy, dx, dy + + REAL, DIMENSION( kms:kme ), INTENT( IN ) & + :: fnm, fnp, dnw, dn + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & + :: msftx, msfty + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: tendency + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: defor11, defor22, defor33, defor12, defor13, defor23, & + div, BN2, tke, xkmh, xkmv, xkhv, zx, zy, u, v, w, theta, & + p, p8w, t8w, z, rdz, rdzw + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & + :: mu + + REAL, DIMENSION ( ims:ime, jms:jme ), INTENT( IN ) & + :: hfx, ust, qfx + REAL, DIMENSION ( ims:ime, kms:kme, jms:jme ), INTENT ( IN ) & + :: qv, rho + +! Local variables. + + INTEGER & + :: i, j, k, ktf, i_start, i_end, j_start, j_end + +! End declarations. +!----------------------------------------------------------------------- + + CALL tke_shear( tendency, config_flags, & + defor11, defor22, defor33, & + defor12, defor13, defor23, & + u, v, w, tke, ust, mu, fnm, fnp, & + cf1, cf2, cf3, msftx, msfty, & + xkmh, xkmv, & + rdx, rdy, zx, zy, rdz, rdzw, dnw, dn, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL tke_buoyancy( tendency, config_flags, mu, & + tke, xkhv, BN2, theta, dt, & + hfx, qfx, qv, rho, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL tke_dissip( tendency, config_flags, & + mu, tke, bn2, theta, p8w, t8w, z, & + dx, dy,rdz, rdzw, isotropic, & + msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! Set a lower limit on TKE. + + ktf = MIN( kte, kde-1 ) + i_start = its + i_end = MIN( ite, ide-1 ) + j_start = jts + j_end = MIN( jte, jde-1 ) + + IF ( config_flags%open_xs .or. config_flags%specified .or. & + config_flags%nested) i_start = MAX(ids+1,its) + IF ( config_flags%open_xe .or. config_flags%specified .or. & + config_flags%nested) i_end = MIN(ide-2,ite) + IF ( config_flags%open_ys .or. config_flags%specified .or. & + config_flags%nested) j_start = MAX(jds+1,jts) + IF ( config_flags%open_ye .or. config_flags%specified .or. & + config_flags%nested) j_end = MIN(jde-2,jte) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tendency(i,k,j) = max( tendency(i,k,j), -mu(i,j) * max( 0.0 , tke(i,k,j) ) / dt ) + END DO + END DO + END DO + + END SUBROUTINE tke_rhs + +!======================================================================= +!======================================================================= + + SUBROUTINE tke_buoyancy( tendency, config_flags, mu, & + tke, xkhv, BN2, theta, dt, & + hfx, qfx, qv, rho, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type ), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, INTENT( IN ) & + :: dt + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: tendency + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: xkhv, tke, BN2, theta + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & + :: mu + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT ( IN ) & + :: qv, rho + + REAL, DIMENSION(ims:ime, jms:jme ), INTENT ( IN ) :: hfx, qfx + +! Local variables. + + INTEGER & + :: i, j, k, ktf + + INTEGER & + :: i_start, i_end, j_start, j_end + + REAL :: heat_flux, heat_flux0 + + REAL :: cpm + +! End declarations. +!----------------------------------------------------------------------- + +!----------------------------------------------------------------------- +! Add to the TKE tendency the term that accounts for production of TKE +! due to buoyant motions. + + ktf = MIN( kte, kde-1 ) + i_start = its + i_end = MIN( ite, ide-1 ) + j_start = jts + j_end = MIN( jte, jde-1 ) + + IF ( config_flags%open_xs .OR. config_flags%specified .OR. & + config_flags%nested ) i_start = MAX( ids+1, its ) + IF ( config_flags%open_xe .OR. config_flags%specified .OR. & + config_flags%nested ) i_end = MIN( ide-2, ite ) + IF ( config_flags%open_ys .OR. config_flags%specified .OR. & + config_flags%nested ) j_start = MAX( jds+1, jts ) + IF ( config_flags%open_ye .OR. config_flags%specified .OR. & + config_flags%nested ) j_end = MIN( jde-2, jte ) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end + tendency(i,k,j) = tendency(i,k,j) - mu(i,j) * xkhv(i,k,j) * BN2(i,k,j) + END DO + END DO + END DO + +! MARTA: change in the computation of the tke's tendency at the surface. +! the buoyancy flux is the average of the surface heat flux (0.06) and the +! flux at the first w level +! +! WCS 040331 + + hflux: SELECT CASE( config_flags%isfflx ) + CASE (0,2) ! with fixed surface heat flux given in the namelist + heat_flux0 = config_flags%tke_heat_flux ! constant heat flux value + ! set in namelist.input +! LES mods + K=KTS + PRINT *, 'USE constant H/rho/cp : e.g. value of Hs ', heat_flux0*cp*rho(i_start,k,j_start) + DO j = j_start, j_end + DO i = i_start, i_end + heat_flux = heat_flux0 + tendency(i,k,j)= tendency(i,k,j) - & + mu(i,j)*((xkhv(i,k,j)*BN2(i,k,j))- (g/theta(i,k,j))*heat_flux)/2. + + ENDDO + ENDDO + + CASE (1) ! use surface heat flux computed from surface routine + PRINT *, 'USE surface heat flux from PHYSICS', hfx(i_start,j_start) + K=KTS + DO j = j_start, j_end + DO i = i_start, i_end + cpm = cp * (1. + 0.8*qv(i,k,j)) + heat_flux = (hfx(i,j)/cpm)/rho(i,k,j) + + tendency(i,k,j)= tendency(i,k,j) - & + mu(i,j)*((xkhv(i,k,j)*BN2(i,k,j))- (g/theta(i,k,j))*heat_flux)/2. + + ENDDO + ENDDO + + CASE DEFAULT + CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' ) + END SELECT hflux + +! end of MARTA/WCS change + +! The tendency array now includes production of TKE from buoyant +! motions. +!----------------------------------------------------------------------- + + END SUBROUTINE tke_buoyancy + +!======================================================================= +!======================================================================= + + SUBROUTINE tke_dissip( tendency, config_flags, & + mu, tke, bn2, theta, p8w, t8w, z, & + dx, dy, rdz, rdzw, isotropic, & + msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! History: Sep 2003 Changes by George Bryan and Jason Knievel, NCAR +! Oct 2001 Converted to mass core by Bill Skamarock, NCAR +! Aug 2000 Original code by Shu-Hua Chen, UC-Davis + +! Purpose: This routine calculates dissipation of turbulent kinetic +! energy. + +! References: Klemp and Wilhelmson (JAS 1978) +! Deardorff (B-L Meteor 1980) +! Chen and Dudhia (NCAR WRF physics report 2000) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type ), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER, INTENT( IN ) :: isotropic + REAL, INTENT( IN ) & + :: dx, dy + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: tendency + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: tke, bn2, theta, p8w, t8w, z, rdz, rdzw + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & + :: mu + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & + :: msftx, msfty +! Local variables. + + REAL, DIMENSION( its:ite, kts:kte, jts:jte ) & + :: dthrdn + + REAL, DIMENSION( its:ite, kts:kte, jts:jte ) & + :: l_scale + + REAL, DIMENSION( its:ite ) & + :: sumtke, sumtkez + + INTEGER & + :: i, j, k, ktf, i_start, i_end, j_start, j_end + + REAL & + :: disp_len, deltas, coefc, tmpdz, len_s, thetasfc, & + thetatop, len_0, tketmp, tmp, ce1, ce2, c_k + +! End declarations. +!----------------------------------------------------------------------- + c_k = config_flags%c_k + + ce1 = ( c_k / 0.10 ) * 0.19 + ce2 = max( 0.0 , 0.93 - ce1 ) + + ktf = MIN( kte, kde-1 ) + i_start = its + i_end = MIN(ite,ide-1) + j_start = jts + j_end = MIN(jte,jde-1) + + IF ( config_flags%open_xs .OR. config_flags%specified .OR. & + config_flags%nested) i_start = MAX( ids+1, its ) + IF ( config_flags%open_xe .OR. config_flags%specified .OR. & + config_flags%nested) i_end = MIN( ide-2, ite ) + IF ( config_flags%open_ys .OR. config_flags%specified .OR. & + config_flags%nested) j_start = MAX( jds+1, jts ) + IF ( config_flags%open_ye .OR. config_flags%specified .OR. & + config_flags%nested) j_end = MIN( jde-2, jte ) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) + + CALL calc_l_scale( config_flags, tke, BN2, l_scale, & + i_start, i_end, ktf, j_start, j_end, & + dx, dy, rdzw, msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + deltas = ( dx/msftx(i,j) * dy/msfty(i,j) / rdzw(i,k,j) )**0.33333333 + tketmp = MAX( tke(i,k,j), 1.0e-6 ) + +! Apply Deardorff's (1980) "wall effect" at the bottom of the domain. +! For LES with fine grid, no need for this wall effect! + + IF ( k .eq. kts .or. k .eq. ktf ) then + coefc = 3.9 + ELSE + coefc = ce1 + ce2 * l_scale(i,k,j) / deltas + END IF + + tendency(i,k,j) = tendency(i,k,j) - & + mu(i,j) * coefc * tketmp**1.5 / l_scale(i,k,j) + END DO + END DO + END DO + + END SUBROUTINE tke_dissip + +!======================================================================= +!======================================================================= + + SUBROUTINE tke_shear( tendency, config_flags, & + defor11, defor22, defor33, & + defor12, defor13, defor23, & + u, v, w, tke, ust, mu, fnm, fnp, & + cf1, cf2, cf3, msftx, msfty, & + xkmh, xkmv, & + rdx, rdy, zx, zy, rdz, rdzw, dn, dnw, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! History: Sep 2003 Rewritten by George Bryan and Jason Knievel, +! NCAR +! Oct 2001 Converted to mass core by Bill Skamarock, NCAR +! Aug 2000 Original code by Shu-Hua Chen, UC-Davis + +! Purpose: This routine calculates the production of turbulent +! kinetic energy by stresses due to sheared wind. + +! References: Klemp and Wilhelmson (JAS 1978) +! Deardorff (B-L Meteor 1980) +! Chen and Dudhia (NCAR WRF physics report 2000) + +! Key: + +! avg temporary working array +! cf1 +! cf2 +! cf3 +! defor11 deformation term ( du/dx + du/dx ) +! defor12 deformation term ( dv/dx + du/dy ); same as defor21 +! defor13 deformation term ( dw/dx + du/dz ); same as defor31 +! defor22 deformation term ( dv/dy + dv/dy ) +! defor23 deformation term ( dw/dy + dv/dz ); same as defor32 +! defor33 deformation term ( dw/dz + dw/dz ) +! div 3-d divergence +! dn +! dnw +! fnm +! fnp +! msftx +! msfty +! rdx +! rdy +! tendency +! titau tau (stress tensor) with a tilde, indicating division by +! a map-scale factor and the fraction of the total modeled +! atmosphere beneath a given altitude (titau = tau/m/zeta) +! tke turbulent kinetic energy + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type ), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, INTENT( IN ) & + :: cf1, cf2, cf3, rdx, rdy + + REAL, DIMENSION( kms:kme ), INTENT( IN ) & + :: fnm, fnp, dn, dnw + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & + :: msftx, msfty + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: tendency + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: defor11, defor22, defor33, defor12, defor13, defor23, & + tke, xkmh, xkmv, zx, zy, u, v, w, rdz, rdzw + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & + :: mu + + REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & + :: ust + +! Local variables. + + INTEGER & + :: i, j, k, ktf, ktes1, ktes2, & + i_start, i_end, j_start, j_end, & + is_ext, ie_ext, js_ext, je_ext + + REAL & + :: mtau + + REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) & + :: avg, titau, tmp2 + + REAL, DIMENSION( its:ite, kts:kte, jts:jte ) & + :: titau12, tmp1, zxavg, zyavg + + REAL :: absU, cd0, Cd + +! End declarations. +!----------------------------------------------------------------------- + + ktf = MIN( kte, kde-1 ) + ktes1 = kte-1 + ktes2 = kte-2 + + i_start = its + i_end = MIN( ite, ide-1 ) + j_start = jts + j_end = MIN( jte, jde-1 ) + + IF ( config_flags%open_xs .OR. config_flags%specified .OR. & + config_flags%nested ) i_start = MAX( ids+1, its ) + IF ( config_flags%open_xe .OR. config_flags%specified .OR. & + config_flags%nested ) i_end = MIN( ide-2, ite ) + IF ( config_flags%open_ys .OR. config_flags%specified .OR. & + config_flags%nested ) j_start = MAX( jds+1, jts ) + IF ( config_flags%open_ye .OR. config_flags%specified .OR. & + config_flags%nested ) j_end = MIN( jde-2, jte ) + IF ( config_flags%periodic_x ) i_start = its + IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + zxavg(i,k,j) = 0.25 * ( zx(i,k ,j) + zx(i+1,k ,j) + & + zx(i,k+1,j) + zx(i+1,k+1,j) ) + zyavg(i,k,j) = 0.25 * ( zy(i,k ,j) + zy(i,k ,j+1) + & + zy(i,k+1,j) + zy(i,k+1,j+1) ) + END DO + END DO + END DO + +! Begin calculating production of turbulence due to shear. The approach +! is to add together contributions from six terms, each of which is the +! square of a deformation that is then multiplied by an exchange +! coefficiant. The same exchange coefficient is assumed for horizontal +! and vertical coefficients for some of the terms (the vertical value is +! the one used). + +! For defor11. + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tendency(i,k,j) = tendency(i,k,j) + 0.5 * & + mu(i,j) * xkmh(i,k,j) * ( ( defor11(i,k,j) )**2 ) + END DO + END DO + END DO + +! For defor22. + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tendency(i,k,j) = tendency(i,k,j) + 0.5 * & + mu(i,j) * xkmh(i,k,j) * ( ( defor22(i,k,j) )**2 ) + END DO + END DO + END DO + +! For defor33. + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tendency(i,k,j) = tendency(i,k,j) + 0.5 * & + mu(i,j) * xkmv(i,k,j) * ( ( defor33(i,k,j) )**2 ) + END DO + END DO + END DO + +! For defor12. + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + avg(i,k,j) = 0.25 * & + ( ( defor12(i ,k,j)**2 ) + ( defor12(i ,k,j+1)**2 ) + & + ( defor12(i+1,k,j)**2 ) + ( defor12(i+1,k,j+1)**2 ) ) + END DO + END DO + END DO + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmh(i,k,j) * avg(i,k,j) + END DO + END DO + END DO + +! For defor13. + + DO j = j_start, j_end + DO k = kts+1, ktf + DO i = i_start, i_end+1 + tmp2(i,k,j) = defor13(i,k,j) + END DO + END DO + END DO + + DO j = j_start, j_end + DO i = i_start, i_end+1 + tmp2(i,kts ,j) = 0.0 + tmp2(i,ktf+1,j) = 0.0 + END DO + END DO + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + avg(i,k,j) = 0.25 * & + ( ( tmp2(i ,k+1,j)**2 ) + ( tmp2(i ,k,j)**2 ) + & + ( tmp2(i+1,k+1,j)**2 ) + ( tmp2(i+1,k,j)**2 ) ) + END DO + END DO + END DO + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmv(i,k,j) * avg(i,k,j) + END DO + END DO + END DO + +!MARTA: add the drag at the surface; WCS 040331 + K=KTS + + uflux: SELECT CASE( config_flags%isfflx ) + CASE (0) ! Assume cd a constant, specified in namelist + + cd0 = config_flags%tke_drag_coefficient ! drag coefficient set + ! in namelist.input + DO j = j_start, j_end + DO i = i_start, i_end + + absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2) + Cd = cd0 + tendency(i,k,j) = tendency(i,k,j) + & + mu(i,j)*( (u(i,k,j)+u(i+1,k,j))*0.5* & + Cd*absU*(defor13(i,kts+1,j)+defor13(i+1,kts+1,j))*0.5 ) + + END DO + END DO + + CASE (1,2) ! ustar computed from surface routine + + PRINT *, 'USE u star (surf drag) from PHYSICS', ust(i_start,j_start) + DO j = j_start, j_end + DO i = i_start, i_end + + absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)+epsilon + Cd = (ust(i,j)**2)/(absU**2) + tendency(i,k,j) = tendency(i,k,j) + & + mu(i,j)*( (u(i,k,j)+u(i+1,k,j))*0.5* & + Cd*absU*(defor13(i,kts+1,j)+defor13(i+1,kts+1,j))*0.5 ) + + END DO + END DO + + CASE DEFAULT + CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' ) + END SELECT uflux +! end of MARTA/WCS change + +! For defor23. + + DO j = j_start, j_end+1 + DO k = kts+1, ktf + DO i = i_start, i_end + tmp2(i,k,j) = defor23(i,k,j) + END DO + END DO + END DO + + DO j = j_start, j_end+1 + DO i = i_start, i_end + tmp2(i,kts, j) = 0.0 + tmp2(i,ktf+1,j) = 0.0 + END DO + END DO + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + avg(i,k,j) = 0.25 * & + ( ( tmp2(i,k+1,j )**2 ) + ( tmp2(i,k,j )**2) + & + ( tmp2(i,k+1,j+1)**2 ) + ( tmp2(i,k,j+1)**2) ) + END DO + END DO + END DO + + DO j = j_start, j_end + DO k = kts, ktf + DO i = i_start, i_end + tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmv(i,k,j) * avg(i,k,j) + END DO + END DO + END DO + +!MARTA: add the drag at the surface; WCS 040331 + K=KTS + + vflux: SELECT CASE( config_flags%isfflx ) + CASE (0) ! Assume cd a constant, specified in namelist + + cd0 = config_flags%tke_drag_coefficient ! constant drag coefficient + ! set in namelist.input + DO j = j_start, j_end + DO i = i_start, i_end + + absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2) + Cd = cd0 + tendency(i,k,j) = tendency(i,k,j) + & + mu(i,j)*( (v(i,k,j)+v(i,k,j+1))*0.5* & + Cd*absU*(defor23(i,kts+1,j)+defor23(i,kts+1,j+1))*0.5 ) + + END DO + END DO + + CASE (1,2) ! ustar computed from surface routine + + DO j = j_start, j_end + DO i = i_start, i_end + + absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)+epsilon + Cd = (ust(i,j)**2)/(absU**2) + tendency(i,k,j) = tendency(i,k,j) + & + mu(i,j)*( (v(i,k,j)+v(i,k,j+1))*0.5* & + Cd*absU*(defor23(i,kts+1,j)+defor23(i,kts+1,j+1))*0.5 ) + + END DO + END DO + + CASE DEFAULT + CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' ) + END SELECT vflux +! end of MARTA/WCS change + + END SUBROUTINE tke_shear + +!======================================================================= +!======================================================================= + + SUBROUTINE compute_diff_metrics( config_flags, ph, phb, z, rdz, rdzw, & + zx, zy, rdx, rdy, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!----------------------------------------------------------------------- +! Begin declarations. + + IMPLICIT NONE + + TYPE( grid_config_rec_type ), INTENT( IN ) & + :: config_flags + + INTEGER, INTENT( IN ) & + :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: ph, phb + + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( OUT ) & + :: rdz, rdzw, zx, zy, z + + REAL, INTENT( IN ) & + :: rdx, rdy + +! Local variables. + + INTEGER & + :: i, j, k, i_start, i_end, j_start, j_end, ktf + +! End declarations. +!----------------------------------------------------------------------- + + ktf = MIN( kte, kde-1 ) + +! Bug fix, WCS, 22 april 2002. + +! We need rdzw in halo for average to u and v points. + + j_start = jts-1 + j_end = jte + +! Begin with dz computations. + + DO j = j_start, j_end + + IF ( ( j_start >= jts ) .AND. ( j_end <= MIN( jte, jde-1 ) ) ) THEN + i_start = its-1 + i_end = ite + ELSE + i_start = its + i_end = MIN( ite, ide-1 ) + END IF + +! Compute z at w points for rdz and rdzw computations. We'll switch z +! to z at p points before returning + + DO k = 1, kte + +! Bug fix, WCS, 22 april 2002 + + DO i = i_start, i_end + z(i,k,j) = ( ph(i,k,j) + phb(i,k,j) ) / g + END DO + END DO + + DO k = 1, ktf + DO i = i_start, i_end + rdzw(i,k,j) = 1.0 / ( z(i,k+1,j) - z(i,k,j) ) + END DO + END DO + + DO k = 2, ktf + DO i = i_start, i_end + rdz(i,k,j) = 2.0 / ( z(i,k+1,j) - z(i,k-1,j) ) + END DO + END DO + +! Bug fix, WCS, 22 april 2002; added the following code + + DO i = i_start, i_end + rdz(i,1,j) = 2./(z(i,2,j)-z(i,1,j)) + END DO + + END DO + +! End bug fix. + +! Now compute zx and zy; we'll assume that the halo for ph and phb is +! properly filled. + + i_start = its + i_end = MIN( ite, ide-1 ) + j_start = jts + j_end = MIN( jte, jde-1 ) + + DO j = j_start, j_end + DO k = 1, kte + DO i = MAX( ids+1, its ), i_end + zx(i,k,j) = rdx * ( phb(i,k,j) - phb(i-1,k,j) ) / g + END DO + END DO + END DO + + DO j = j_start, j_end + DO k = 1, kte + DO i = MAX( ids+1, its ), i_end + zx(i,k,j) = zx(i,k,j) + rdx * ( ph(i,k,j) - ph(i-1,k,j) ) / g + END DO + END DO + END DO + + DO j = MAX( jds+1, jts ), j_end + DO k = 1, kte + DO i = i_start, i_end + zy(i,k,j) = rdy * ( phb(i,k,j) - phb(i,k,j-1) ) / g + END DO + END DO + END DO + + DO j = MAX( jds+1, jts ), j_end + DO k = 1, kte + DO i = i_start, i_end + zy(i,k,j) = zy(i,k,j) + rdy * ( ph(i,k,j) - ph(i,k,j-1) ) / g + END DO + END DO + END DO + +! Some b.c. on zx and zy. + + IF ( .NOT. config_flags%periodic_x ) THEN + + IF ( ite == ide ) THEN + DO j = j_start, j_end + DO k = 1, ktf + zx(ide,k,j) = 0.0 + END DO + END DO + END IF + + IF ( its == ids ) THEN + DO j = j_start, j_end + DO k = 1, ktf + zx(ids,k,j) = 0.0 + END DO + END DO + END IF + + ELSE + + IF ( ite == ide ) THEN + DO j=j_start,j_end + DO k=1,ktf + zx(ide,k,j) = rdx * ( phb(ide,k,j) - phb(ide-1,k,j) ) / g + END DO + END DO + + DO j = j_start, j_end + DO k = 1, ktf + zx(ide,k,j) = zx(ide,k,j) + rdx * ( ph(ide,k,j) - ph(ide-1,k,j) ) / g + END DO + END DO + END IF + + IF ( its == ids ) THEN + DO j = j_start, j_end + DO k = 1, ktf + zx(ids,k,j) = rdx * ( phb(ids,k,j) - phb(ids-1,k,j) ) / g + END DO + END DO + + DO j =j_start,j_end + DO k =1,ktf + zx(ids,k,j) = zx(ids,k,j) + rdx * ( ph(ids,k,j) - ph(ids-1,k,j) ) / g + END DO + END DO + END IF + + END IF + + IF ( .NOT. config_flags%periodic_y ) THEN + + IF ( jte == jde ) THEN + DO k =1, ktf + DO i =i_start, i_end + zy(i,k,jde) = 0.0 + END DO + END DO + END IF + + IF ( jts == jds ) THEN + DO k =1, ktf + DO i =i_start, i_end + zy(i,k,jds) = 0.0 + END DO + END DO + END IF + + ELSE + + IF ( jte == jde ) THEN + DO j=j_start, j_end + DO k=1, ktf + zy(i,k,jde) = rdy * ( phb(i,k,jde) - phb(i,k,jde-1) ) / g + END DO + END DO + + DO j = j_start, j_end + DO k = 1, ktf + zy(i,k,jde) = zy(i,k,jde) + rdy * ( ph(i,k,jde) - ph(i,k,jde-1) ) / g + END DO + END DO + END IF + + IF ( jts == jds ) THEN + DO j = j_start, j_end + DO k = 1, ktf + zy(i,k,jds) = rdy * ( phb(i,k,jds) - phb(i,k,jds-1) ) / g + END DO + END DO + + DO j = j_start, j_end + DO k = 1, ktf + zy(i,k,jds) = zy(i,k,jds) + rdy * ( ph(i,k,jds) - ph(i,k,jds-1) ) / g + END DO + END DO + END IF + + END IF + +! Calculate z at p points. + + DO j = j_start, j_end + DO k = 1, ktf + DO i = i_start, i_end + z(i,k,j) = 0.5 * & + ( ph(i,k,j) + phb(i,k,j) + ph(i,k+1,j) + phb(i,k+1,j) ) / g + END DO + END DO + END DO + + END SUBROUTINE compute_diff_metrics + +!======================================================================= +!======================================================================= + + END MODULE module_diffusion_em + +!======================================================================= +!======================================================================= + + Index: /trunk/WRF.COMMON/WRFV3/dyn_em/module_em.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/dyn_em/module_em.F (revision 2761) +++ /trunk/WRF.COMMON/WRFV3/dyn_em/module_em.F (revision 2761) @@ -0,0 +1,1781 @@ +!WRF:MODEL_LAYER:DYNAMICS +! + +MODULE module_em + + USE module_model_constants + USE module_advect_em + USE module_big_step_utilities_em + USE module_state_description + USE module_damping_em + +CONTAINS + +!------------------------------------------------------------------------ + +SUBROUTINE rk_step_prep ( config_flags, rk_step, & + u, v, w, t, ph, mu, & + moist, & + ru, rv, rw, ww, php, alt, & + muu, muv, & + mub, mut, phb, pb, p, al, alb, & + cqu, cqv, cqw, & + msfux, msfuy, & + msfvx, msfvx_inv, msfvy, & + msftx, msfty, & + fnm, fnp, dnw, rdx, rdy, & + n_moist, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + + ! Input data. + + TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER , INTENT(IN ) :: n_moist, rk_step + + REAL , INTENT(IN ) :: rdx, rdy + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & + INTENT(IN ) :: u, & + v, & + w, & + t, & + ph, & + phb, & + pb, & + al, & + alb + + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & + INTENT( OUT) :: ru, & + rv, & + rw, & + ww, & + php, & + cqu, & + cqv, & + cqw, & + alt + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & + INTENT(IN ) :: p + + + + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ), INTENT( IN) :: & + moist + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msftx, & + msfty, & + msfux, & + msfuy, & + msfvx, & + msfvx_inv, & + msfvy, & + mu, & + mub + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT( OUT) :: muu, & + muv, & + mut + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm, fnp, dnw + + integer :: k + + +! +! +! rk_step_prep prepares a number of diagnostic quantities +! in preperation for a Runge-Kutta timestep. subroutines called +! by rk_step_prep calculate +! +! (1) total column dry air mass (mut, call to calculate_full) +! +! (2) total column dry air mass at u and v points +! (muu, muv, call to calculate_mu_uv) +! +! (3) mass-coupled velocities for advection +! (ru, rv, and rw, call to couple_momentum) +! +! (4) omega (call to calc_ww_cp) +! +! (5) moisture coefficients (cqu, cqv, cqw, call to calc_cq) +! +! (6) inverse density (alt, call to calc_alt) +! +! (7) geopotential at pressure points (php, call to calc_php) +! +! + + CALL calculate_full( mut, mub, mu, & + ids, ide, jds, jde, 1, 2, & + ims, ime, jms, jme, 1, 1, & + its, ite, jts, jte, 1, 1 ) + + CALL calc_mu_uv ( config_flags, & + mu, mub, muu, muv, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL couple_momentum( muu, ru, u, msfuy, & + muv, rv, v, msfvx, msfvx_inv, & + mut, rw, w, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! new call, couples V with mu, also has correct map factors. WCS, 3 june 2001 + CALL calc_ww_cp ( u, v, mu, mub, ww, & + rdx, rdy, msftx, msfty, & + msfux, msfuy, msfvx, msfvx_inv, & + msfvy, dnw, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL calc_cq ( moist, cqu, cqv, cqw, n_moist, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL calc_alt ( alt, al, alb, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL calc_php ( php, ph, phb, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +END SUBROUTINE rk_step_prep + +!------------------------------------------------------------------------------- + +SUBROUTINE rk_tendency ( config_flags, rk_step, & + ru_tend, rv_tend, rw_tend, ph_tend, t_tend, & + ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, & + mu_tend, u_save, v_save, w_save, ph_save, & + t_save, mu_save, RTHFTEN, & + ru, rv, rw, ww, & + u, v, w, t, ph, & + u_old, v_old, w_old, t_old, ph_old, & + h_diabatic, phb,t_init, & + mu, mut, muu, muv, mub, & + al, alt, p, pb, php, cqu, cqv, cqw, & + u_base, v_base, t_base, qv_base, z_base, & + msfux, msfuy, msfvx, msfvx_inv, & + msfvy, msftx, msfty, & + xlat, f, e, sina, cosa, & + fnm, fnp, rdn, rdnw, & + dt, rdx, rdy, khdif, kvdif, xkmhd, xkhh, & + diff_6th_opt, diff_6th_factor, & + dampcoef,zdamp,damp_opt, & + cf1, cf2, cf3, cfn, cfn1, n_moist, & + non_hydrostatic, top_lid, & + u_frame, v_frame, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte, & + max_vert_cfl, max_horiz_cfl) + + IMPLICIT NONE + + ! Input data. + + TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + LOGICAL , INTENT(IN ) :: non_hydrostatic, top_lid + + INTEGER , INTENT(IN ) :: n_moist, rk_step + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & + INTENT(IN ) :: ru, & + rv, & + rw, & + ww, & + u, & + v, & + w, & + t, & + ph, & + u_old, & + v_old, & + w_old, & + t_old, & + ph_old, & + phb, & + al, & + alt, & + p, & + pb, & + php, & + cqu, & + cqv, & + t_init, & + xkmhd, & + xkhh, & + h_diabatic + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & + INTENT(OUT ) :: ru_tend, & + rv_tend, & + rw_tend, & + t_tend, & + ph_tend, & + RTHFTEN, & + u_save, & + v_save, & + w_save, & + ph_save, & + t_save + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & + INTENT(INOUT) :: ru_tendf, & + rv_tendf, & + rw_tendf, & + t_tendf, & + ph_tendf, & + cqw + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT( OUT) :: mu_tend, & + mu_save + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & + msfuy, & + msfvx, & + msfvx_inv, & + msfvy, & + msftx, & + msfty, & + xlat, & + f, & + e, & + sina, & + cosa, & + mu, & + mut, & + mub, & + muu, & + muv + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm, & + fnp, & + rdn, & + rdnw, & + u_base, & + v_base, & + t_base, & + qv_base, & + z_base + + REAL , INTENT(IN ) :: rdx, & + rdy, & + dt, & + u_frame, & + v_frame, & + khdif, & + kvdif + INTEGER, INTENT( IN ) :: diff_6th_opt + REAL, INTENT( IN ) :: diff_6th_factor + + INTEGER, INTENT( IN ) :: damp_opt + + REAL, INTENT( IN ) :: zdamp, dampcoef + + REAL, INTENT( OUT ) :: max_horiz_cfl + REAL, INTENT( OUT ) :: max_vert_cfl + + REAL :: kdift, khdq, kvdq, cfn, cfn1, cf1, cf2, cf3 + INTEGER :: i,j,k + INTEGER :: time_step + +! +! +! rk_tendency computes the large-timestep tendency terms in the +! momentum, thermodynamic (theta), and geopotential equations. +! These terms include: +! +! (1) advection (for u, v, w, theta - calls to advect_u, advect_v, +! advect_w, and advact_scalar). +! +! (2) geopotential equation terms (advection and "gw" - call to rhs_ph). +! +! (3) buoyancy term in vertical momentum equation (call to pg_buoy_w). +! +! (4) Coriolis and curvature terms in u,v,w momentum equations +! (calls to subroutines coriolis, curvature) +! +! (5) 3D diffusion on coordinate surfaces. +! +! + + CALL zero_tend ( ru_tend, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( rv_tend, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( rw_tend, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( t_tend, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( ph_tend, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( u_save, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( v_save, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( w_save, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( ph_save, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( t_save, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( mu_tend, & + ids, ide, jds, jde, 1, 1, & + ims, ime, jms, jme, 1, 1, & + its, ite, jts, jte, 1, 1 ) + + CALL zero_tend ( mu_save, & + ids, ide, jds, jde, 1, 1, & + ims, ime, jms, jme, 1, 1, & + its, ite, jts, jte, 1, 1 ) + + ! advection tendencies + CALL nl_get_time_step ( 1, time_step ) + + CALL advect_u ( u, u , ru_tend, ru, rv, ww, & + mut, time_step, config_flags, & + msfux, msfuy, msfvx, msfvy, & + msftx, msfty, & + fnm, fnp, rdx, rdy, rdnw, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL advect_v ( v, v , rv_tend, ru, rv, ww, & + mut, time_step, config_flags, & + msfux, msfuy, msfvx, msfvy, & + msftx, msfty, & + fnm, fnp, rdx, rdy, rdnw, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IF (non_hydrostatic) & + CALL advect_w ( w, w, rw_tend, ru, rv, ww, & + mut, time_step, config_flags, & + msfux, msfuy, msfvx, msfvy, & + msftx, msfty, & + fnm, fnp, rdx, rdy, rdn, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! theta flux divergence + + CALL advect_scalar ( t, t, t_tend, ru, rv, ww, & + mut, time_step, config_flags, & + msfux, msfuy, msfvx, msfvy, & + msftx, msfty, fnm, fnp, & + rdx, rdy, rdnw, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IF ( config_flags%cu_physics == GDSCHEME .OR. & + config_flags%cu_physics == G3SCHEME ) THEN + + ! theta advection only: + + CALL set_tend( RTHFTEN, t_tend, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + END IF + + CALL rhs_ph( ph_tend, u, v, ww, ph, ph, phb, w, & + mut, muu, muv, & + fnm, fnp, & + rdnw, cfn, cfn1, rdx, rdy, & + msfux, msfuy, msfvx, & + msfvx_inv, msfvy, & + msftx, msfty, & + non_hydrostatic, & + config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL horizontal_pressure_gradient( ru_tend,rv_tend, & + ph,alt,p,pb,al,php,cqu,cqv, & + muu,muv,mu,fnm,fnp,rdnw, & + cf1,cf2,cf3,rdx,rdy,msfux,msfuy,& + msfvx,msfvy,msftx,msfty, & + config_flags, non_hydrostatic, & + top_lid, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IF (non_hydrostatic) & + CALL pg_buoy_w( rw_tend, p, cqw, mu, mub, & + rdnw, rdn, g, msftx, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL w_damp ( rw_tend, max_vert_cfl, & + max_horiz_cfl, & + u, v, ww, w, mut, rdnw, & + rdx, rdy, msfux, msfuy, msfvx, & + msfvy, dt, config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IF(config_flags%pert_coriolis) THEN + + CALL perturbation_coriolis ( ru, rv, rw, & + ru_tend, rv_tend, rw_tend, & + config_flags, & + u_base, v_base, z_base, & + muu, muv, phb, ph, & + msftx, msfty, msfux, msfuy, & + msfvx, msfvy, & + f, e, sina, cosa, fnm, fnp, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + ELSE + CALL coriolis ( ru, rv, rw, & + ru_tend, rv_tend, rw_tend, & + config_flags, & + msftx, msfty, msfux, msfuy, & + msfvx, msfvy, & + f, e, sina, cosa, fnm, fnp, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + END IF + + CALL curvature ( ru, rv, rw, u, v, w, & + ru_tend, rv_tend, rw_tend, & + config_flags, & + msfux, msfuy, msfvx, msfvy, & + msftx, msfty, & + xlat, fnm, fnp, rdx, rdy, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! Damping option added for Held-Suarez test (also uses lw option HELDSUAREZ) + IF (config_flags%ra_lw_physics == HELDSUAREZ) THEN + CALL held_suarez_damp ( ru_tend, rv_tend, & + ru,rv,p,pb, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + END IF + +!************************************************************** +! +! Next, the terms that we integrate only with forward-in-time +! (evaluate with time t variables). +! +!************************************************************** + + forward_step: IF( rk_step == 1 ) THEN + + diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN + + CALL horizontal_diffusion ('u', u, ru_tendf, mut, config_flags, & + msfux, msfuy, msfvx, msfvx_inv, & + msfvy,msftx, msfty, & + khdif, xkmhd, rdx, rdy, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL horizontal_diffusion ('v', v, rv_tendf, mut, config_flags, & + msfux, msfuy, msfvx, msfvx_inv, & + msfvy,msftx, msfty, & + khdif, xkmhd, rdx, rdy, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL horizontal_diffusion ('w', w, rw_tendf, mut, config_flags, & + msfux, msfuy, msfvx, msfvx_inv, & + msfvy,msftx, msfty, & + khdif, xkmhd, rdx, rdy, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + khdq = 3.*khdif + CALL horizontal_diffusion_3dmp ( 'm', t, t_tendf, mut, & + config_flags, t_init, & + msfux, msfuy, msfvx, msfvx_inv, & + msfvy, msftx, msfty, & + khdq , xkhh, rdx, rdy, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +! pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN +!!!****MARS: vertical diffusion is done in the physics (TODO: consider the nonhydrostatic case ?) + pbl_test : IF ( (config_flags%bl_pbl_physics .eq. 0) & + .AND. (.not. config_flags%modif_wrf) ) THEN + + CALL vertical_diffusion_u ( u, ru_tendf, config_flags, & + u_base, & + alt, muu, rdn, rdnw, kvdif, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL vertical_diffusion_v ( v, rv_tendf, config_flags, & + v_base, & + alt, muv, rdn, rdnw, kvdif, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IF (non_hydrostatic) & + CALL vertical_diffusion ( 'w', w, rw_tendf, config_flags, & + alt, mut, rdn, rdnw, kvdif, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + kvdq = 3.*kvdif + CALL vertical_diffusion_3dmp ( t, t_tendf, config_flags, t_init, & + alt, mut, rdn, rdnw, kvdq , & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + ENDIF pbl_test + + ! Theta tendency computations. + + END IF diff_opt1 + + IF ( diff_6th_opt .NE. 0 ) THEN + + CALL sixth_order_diffusion( 'u', u, ru_tendf, mut, dt, & + config_flags, & + diff_6th_opt, diff_6th_factor, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL sixth_order_diffusion( 'v', v, rv_tendf, mut, dt, & + config_flags, & + diff_6th_opt, diff_6th_factor, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IF (non_hydrostatic) & + CALL sixth_order_diffusion( 'w', w, rw_tendf, mut, dt, & + config_flags, & + diff_6th_opt, diff_6th_factor, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL sixth_order_diffusion( 'm', t, t_tendf, mut, dt, & + config_flags, & + diff_6th_opt, diff_6th_factor, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + ENDIF + + IF( damp_opt .eq. 2 ) & + CALL rk_rayleigh_damp( ru_tendf, rv_tendf, & + rw_tendf, t_tendf, & + u, v, w, t, t_init, & + mut, muu, muv, ph, phb, & + u_base, v_base, t_base, z_base, & + dampcoef, zdamp, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + END IF forward_step + +END SUBROUTINE rk_tendency + +!------------------------------------------------------------------------------- + +SUBROUTINE rk_addtend_dry ( ru_tend, rv_tend, rw_tend, ph_tend, t_tend, & + ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, & + u_save, v_save, w_save, ph_save, t_save, & + mu_tend, mu_tendf, rk_step, & + h_diabatic, mut, msftx, msfty, msfux, msfuy, & + msfvx, msfvx_inv, msfvy, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + ips,ipe, jps,jpe, kps,kpe, & + its,ite, jts,jte, kts,kte ) + + IMPLICIT NONE + + ! Input data. + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + its, ite, jts, jte, kts, kte + INTEGER , INTENT(IN ) :: rk_step + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: ru_tend, & + rv_tend, & + rw_tend, & + ph_tend, & + t_tend, & + ru_tendf, & + rv_tendf, & + rw_tendf, & + ph_tendf, & + t_tendf + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: mu_tend, & + mu_tendf + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: u_save, & + v_save, & + w_save, & + ph_save, & + t_save, & + h_diabatic + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut, & + msftx, & + msfty, & + msfux, & + msfuy, & + msfvx, & + msfvx_inv, & + msfvy + + +! Local + INTEGER :: i, j, k + +! +! +! rk_addtend_dry constructs the full large-timestep tendency terms for +! momentum (u,v,w), theta and geopotential equations. This is accomplished +! by combining the physics tendencies (in *tendf; these are computed +! the first RK substep, held fixed thereafter) with the RK tendencies +! (in *tend, these include advection, pressure gradient, etc; +! these change each rk substep). Output is in *tend. +! +! + +! Finally, add the forward-step tendency to the rk_tendency + +! u/v/w/save contain bc tendency that needs to be multiplied by msf +! (u by msfuy, v by msfvx) +! before adding it to physics tendency (*tendf) +! For momentum we need the final tendency to include an inverse msf +! physics/bc tendency needs to be divided, advection tendency already has it + +! For scalars we need the final tendency to include an inverse msf (msfty) +! advection tendency is OK, physics/bc tendency needs to be divided by msf + + DO j = jts,MIN(jte,jde-1) + DO k = kts,kte-1 + DO i = its,ite + ! multiply by my to uncouple u + IF(rk_step == 1)ru_tendf(i,k,j) = ru_tendf(i,k,j) + u_save(i,k,j)*msfuy(i,j) + ! divide by my to couple u + ru_tend(i,k,j) = ru_tend(i,k,j) + ru_tendf(i,k,j)/msfuy(i,j) + ENDDO + ENDDO + ENDDO + + DO j = jts,jte + DO k = kts,kte-1 + DO i = its,MIN(ite,ide-1) + ! multiply by mx to uncouple v + IF(rk_step == 1)rv_tendf(i,k,j) = rv_tendf(i,k,j) + v_save(i,k,j)*msfvx(i,j) + ! divide by mx to couple v + rv_tend(i,k,j) = rv_tend(i,k,j) + rv_tendf(i,k,j)*msfvx_inv(i,j) + ENDDO + ENDDO + ENDDO + + DO j = jts,MIN(jte,jde-1) + DO k = kts,kte + DO i = its,MIN(ite,ide-1) + ! multiply by my to uncouple w + IF(rk_step == 1)rw_tendf(i,k,j) = rw_tendf(i,k,j) + w_save(i,k,j)*msfty(i,j) + ! divide by my to couple w + rw_tend(i,k,j) = rw_tend(i,k,j) + rw_tendf(i,k,j)/msfty(i,j) + IF(rk_step == 1)ph_tendf(i,k,j) = ph_tendf(i,k,j) + ph_save(i,k,j) + ! divide by my to couple scalar + ph_tend(i,k,j) = ph_tend(i,k,j) + ph_tendf(i,k,j)/msfty(i,j) + ENDDO + ENDDO + ENDDO + + DO j = jts,MIN(jte,jde-1) + DO k = kts,kte-1 + DO i = its,MIN(ite,ide-1) + IF(rk_step == 1)t_tendf(i,k,j) = t_tendf(i,k,j) + t_save(i,k,j) + ! divide by my to couple theta + t_tend(i,k,j) = t_tend(i,k,j) + t_tendf(i,k,j)/msfty(i,j) & + + mut(i,j)*h_diabatic(i,k,j)/msfty(i,j) + ! divide by my to couple heating + ENDDO + ENDDO + ENDDO + + DO j = jts,MIN(jte,jde-1) + DO i = its,MIN(ite,ide-1) +! mu tendencies not coupled with 1/msf + mu_tend(i,j) = mu_tend(i,j) + mu_tendf(i,j) + ENDDO + ENDDO + +END SUBROUTINE rk_addtend_dry + +!------------------------------------------------------------------------------- + +SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & + rk_step, dt, & + ru, rv, ww, mut, mub, mu_old, & + alt, & + scalar_old, scalar, & + scalar_tends, advect_tend, & + RQVFTEN, & + base, moist_step, fnm, fnp, & + msfux, msfuy, msfvx, msfvx_inv, & + msfvy, msftx, msfty, & + rdx, rdy, rdn, rdnw, & + khdif, kvdif, xkmhd, & + diff_6th_opt, diff_6th_factor, & + pd_advection, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data. + + TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: rk_step, scs, sce + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + LOGICAL , INTENT(IN ) :: moist_step + + REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ), & + INTENT(IN ) :: scalar, scalar_old + + REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ), & + INTENT(INOUT) :: scalar_tends + + REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: advect_tend + + REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), INTENT(OUT ) :: RQVFTEN + + REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: ru, & + rv, & + ww, & + xkmhd, & + alt + + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm, & + fnp, & + rdn, & + rdnw, & + base + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & + msfuy, & + msfvx, & + msfvx_inv, & + msfvy, & + msftx, & + msfty, & + mub, & + mut, & + mu_old + + REAL , INTENT(IN ) :: rdx, & + rdy, & + khdif, & + kvdif + + INTEGER, INTENT( IN ) :: diff_6th_opt + REAL, INTENT( IN ) :: diff_6th_factor + + REAL , INTENT(IN ) :: dt + + LOGICAL, INTENT(IN ) :: pd_advection + + ! Local data + + INTEGER :: im, i,j,k + INTEGER :: time_step + + REAL :: khdq, kvdq, tendency + +! +! +! rk_scalar_tend calls routines that computes scalar tendency from advection +! and 3D mixing (TKE or fixed eddy viscosities). +! +! + + + khdq = khdif/prandtl + kvdq = kvdif/prandtl + + scalar_loop : DO im = scs, sce + + CALL zero_tend ( advect_tend(ims,kms,jms), & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL nl_get_time_step ( 1, time_step ) + + IF( (rk_step == 3) .and. pd_advection ) THEN + + CALL advect_scalar_pd ( scalar(ims,kms,jms,im), & + scalar_old(ims,kms,jms,im), & + advect_tend(ims,kms,jms), & + ru, rv, ww, mut, mub, mu_old, & + config_flags, & + msfux, msfuy, msfvx, msfvy, & + msftx, msfty, fnm, fnp, & + rdx, rdy, rdnw,dt, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + ELSE + + CALL advect_scalar ( scalar(ims,kms,jms,im), & + scalar(ims,kms,jms,im), & + advect_tend(ims,kms,jms), & + ru, rv, ww, mut, time_step, & + config_flags, & + msfux, msfuy, msfvx, msfvy, & + msftx, msfty, fnm, fnp, & + rdx, rdy, rdnw, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + END IF + + IF((config_flags%cu_physics == GDSCHEME .OR. config_flags%cu_physics == G3SCHEME) & + .and. moist_step .and. ( im == P_QV) ) THEN + + CALL set_tend( RQVFTEN, advect_tend, msfty, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + ENDIF + + rk_step_1: IF( rk_step == 1 ) THEN + + diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN + + CALL horizontal_diffusion ( 'm', scalar(ims,kms,jms,im), & + scalar_tends(ims,kms,jms,im), mut, & + config_flags, & + msfux, msfuy, msfvx, msfvx_inv, & + msfvy, msftx, msfty, & + khdq , xkmhd, rdx, rdy, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + +!!!****MARS: done in the physics + pbl_test : IF ( (config_flags%bl_pbl_physics .eq. 0) & + .AND. (.not. config_flags%modif_wrf) ) THEN +! pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN + + IF( (moist_step) .and. ( im == P_QV)) THEN + + CALL vertical_diffusion_mp ( scalar(ims,kms,jms,im), & + scalar_tends(ims,kms,jms,im), & + config_flags, base, & + alt, mut, rdn, rdnw, kvdq , & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + ELSE + + CALL vertical_diffusion ( 'm', scalar(ims,kms,jms,im), & + scalar_tends(ims,kms,jms,im), & + config_flags, & + alt, mut, rdn, rdnw, kvdq, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + END IF + + ENDIF pbl_test + + ENDIF diff_opt1 + + IF ( diff_6th_opt .NE. 0 ) & + CALL sixth_order_diffusion( 'm', scalar(ims,kms,jms,im), & + scalar_tends(ims,kms,jms,im), & + mut, dt, config_flags, & + diff_6th_opt, diff_6th_factor, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + ENDIF rk_step_1 + + END DO scalar_loop + +END SUBROUTINE rk_scalar_tend + +!------------------------------------------------------------------------------- + +SUBROUTINE rk_update_scalar( scs, sce, & + scalar_1, scalar_2, sc_tend, & + advect_tend, msftx, msfty, & + mu_old, mu_new, mu_base, & + rk_step, dt, spec_zone, & + config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data. + + TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: scs, sce, rk_step, spec_zone + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, INTENT(IN ) :: dt + + REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce), & + INTENT(INOUT) :: scalar_1, & + scalar_2, & + sc_tend + + REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), & + INTENT(IN) :: advect_tend + + REAL, DIMENSION(ims:ime, jms:jme ), INTENT(IN ) :: mu_old, & + mu_new, & + mu_base, & + msftx, & + msfty + + INTEGER :: i,j,k,im + REAL :: sc_middle, msfsq + REAL, DIMENSION(its:ite) :: muold, r_munew + + REAL, DIMENSION(its:ite, kts:kte, jts:jte ) :: tendency + + INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end + INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc + +! +! +! rk_scalar_update advances the scalar equation given the time t value +! of the scalar and the scalar tendency. +! +! + + +! +! set loop limits. + + i_start = its + i_end = ite + j_start = jts + j_end = jte + k_start = kts + k_end = kte-1 + IF(j_end == jde) j_end = j_end - 1 + IF(i_end == ide) i_end = i_end - 1 + + i_start_spc = i_start + i_end_spc = i_end + j_start_spc = j_start + j_end_spc = j_end + k_start_spc = k_start + k_end_spc = k_end + + IF( config_flags%nested .or. config_flags%specified ) THEN + IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone ) + IF( .NOT. config_flags%periodic_x)i_end = min( ite,ide-spec_zone-1 ) + j_start = max( jts,jds+spec_zone ) + j_end = min( jte,jde-spec_zone-1 ) + k_start = kts + k_end = min( kte, kde-1 ) + ENDIF + + IF ( rk_step == 1 ) THEN + + ! replace t-dt values (in scalar_1) with t values scalar_2, + ! then compute new values by adding tendency to values at t + + DO im = scs,sce + + DO j = jts, min(jte,jde-1) + DO k = kts, min(kte,kde-1) + DO i = its, min(ite,ide-1) + tendency(i,k,j) = 0. + ENDDO + ENDDO + ENDDO + + DO j = j_start,j_end + DO k = k_start,k_end + DO i = i_start,i_end + ! scalar was coupled with my + tendency(i,k,j) = advect_tend(i,k,j) * msfty(i,j) + ENDDO + ENDDO + ENDDO + + DO j = j_start_spc,j_end_spc + DO k = k_start_spc,k_end_spc + DO i = i_start_spc,i_end_spc + tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im) + ENDDO + ENDDO + ENDDO + + DO j = jts, min(jte,jde-1) + + DO i = its, min(ite,ide-1) + muold(i) = mu_old(i,j) + mu_base(i,j) + r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j)) + ENDDO + + DO k = kts, min(kte,kde-1) + DO i = its, min(ite,ide-1) + + scalar_1(i,k,j,im) = scalar_2(i,k,j,im) + scalar_2(i,k,j,im) = (muold(i)*scalar_1(i,k,j,im) & + + dt*tendency(i,k,j))*r_munew(i) + + ENDDO + ENDDO + ENDDO + + ENDDO + + ELSE + + ! just compute new values, scalar_1 already at time t. + + DO im = scs, sce + + DO j = jts, min(jte,jde-1) + DO k = kts, min(kte,kde-1) + DO i = its, min(ite,ide-1) + tendency(i,k,j) = 0. + ENDDO + ENDDO + ENDDO + + DO j = j_start,j_end + DO k = k_start,k_end + DO i = i_start,i_end + ! scalar was coupled with my + tendency(i,k,j) = advect_tend(i,k,j) * msfty(i,j) + ENDDO + ENDDO + ENDDO + + DO j = j_start_spc,j_end_spc + DO k = k_start_spc,k_end_spc + DO i = i_start_spc,i_end_spc + tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im) + ENDDO + ENDDO + ENDDO + + DO j = jts, min(jte,jde-1) + + DO i = its, min(ite,ide-1) + muold(i) = mu_old(i,j) + mu_base(i,j) + r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j)) + ENDDO + + DO k = kts, min(kte,kde-1) + DO i = its, min(ite,ide-1) + + scalar_2(i,k,j,im) = (muold(i)*scalar_1(i,k,j,im) & + + dt*tendency(i,k,j))*r_munew(i) + + ENDDO + ENDDO + ENDDO + + ENDDO + + END IF + +END SUBROUTINE rk_update_scalar + +!------------------------------------------------------------------------------- + +SUBROUTINE rk_update_scalar_pd( scs, sce, & + scalar, sc_tend, & + mu_old, mu_new, mu_base, & + rk_step, dt, spec_zone, & + config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + IMPLICIT NONE + + ! Input data. + + TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags + + INTEGER , INTENT(IN ) :: scs, sce, rk_step, spec_zone + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + REAL, INTENT(IN ) :: dt + + REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce), & + INTENT(INOUT) :: scalar, & + sc_tend + + REAL, DIMENSION(ims:ime, jms:jme ), INTENT(IN ) :: mu_old, & + mu_new, & + mu_base + + INTEGER :: i,j,k,im + REAL :: sc_middle, msfsq + REAL, DIMENSION(its:ite) :: muold, r_munew + + REAL, DIMENSION(its:ite, kts:kte, jts:jte ) :: tendency + + INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end + INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc + +! +! +! rk_scalar_update advances the scalar equation given the time t value +! of the scalar and the scalar tendency. +! +! + + +! +! set loop limits. + + i_start = its + i_end = ite + j_start = jts + j_end = jte + k_start = kts + k_end = kte-1 + IF(j_end == jde) j_end = j_end - 1 + IF(i_end == ide) i_end = i_end - 1 + + i_start_spc = i_start + i_end_spc = i_end + j_start_spc = j_start + j_end_spc = j_end + k_start_spc = k_start + k_end_spc = k_end + + IF( config_flags%nested .or. config_flags%specified ) THEN + IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone ) + IF( .NOT. config_flags%periodic_x)i_end = min( ite,ide-spec_zone-1 ) + j_start = max( jts,jds+spec_zone ) + j_end = min( jte,jde-spec_zone-1 ) + k_start = kts + k_end = min( kte, kde-1 ) + ENDIF + + DO im = scs, sce + + DO j = jts, min(jte,jde-1) + DO k = kts, min(kte,kde-1) + DO i = its, min(ite,ide-1) + tendency(i,k,j) = 0. + ENDDO + ENDDO + ENDDO + + DO j = j_start_spc,j_end_spc + DO k = k_start_spc,k_end_spc + DO i = i_start_spc,i_end_spc + tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im) + sc_tend(i,k,j,im) = 0. + ENDDO + ENDDO + ENDDO + + DO j = jts, min(jte,jde-1) + + DO i = its, min(ite,ide-1) + muold(i) = mu_old(i,j) + mu_base(i,j) + r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j)) + ENDDO + + DO k = kts, min(kte,kde-1) + DO i = its, min(ite,ide-1) + + scalar(i,k,j,im) = (muold(i)*scalar(i,k,j,im) & + + dt*tendency(i,k,j))*r_munew(i) + ENDDO + ENDDO + ENDDO + + ENDDO + +END SUBROUTINE rk_update_scalar_pd + +!------------------------------------------------------------ + +SUBROUTINE init_zero_tendency(ru_tendf, rv_tendf, rw_tendf, ph_tendf, & + t_tendf, tke_tendf, mu_tendf, & + moist_tendf,chem_tendf,scalar_tendf, & + n_moist,n_chem,n_scalar,rk_step, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) +!----------------------------------------------------------------------- + IMPLICIT NONE +!----------------------------------------------------------------------- + + INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte + + INTEGER , INTENT(IN ) :: n_moist,n_chem,n_scalar,rk_step + + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: & + ru_tendf, & + rv_tendf, & + rw_tendf, & + ph_tendf, & + t_tendf, & + tke_tendf + + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: mu_tendf + + REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),INTENT(INOUT)::& + moist_tendf + + REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_chem ),INTENT(INOUT)::& + chem_tendf + + REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar ),INTENT(INOUT)::& + scalar_tendf + +! LOCAL VARS + + INTEGER :: im, ic, is + +! +! +! init_zero_tendency +! sets tendency arrays to zero for all prognostic variables. +! +! + + + CALL zero_tend ( ru_tendf, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( rv_tendf, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( rw_tendf, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( ph_tendf, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( t_tendf, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( tke_tendf, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + + CALL zero_tend ( mu_tendf, & + ids, ide, jds, jde, kds, kds, & + ims, ime, jms, jme, kms, kms, & + its, ite, jts, jte, kts, kts ) + +! DO im=PARAM_FIRST_SCALAR,n_moist + DO im=1,n_moist ! make sure first one is zero too + CALL zero_tend ( moist_tendf(ims,kms,jms,im), & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + ENDDO + +! DO ic=PARAM_FIRST_SCALAR,n_chem + DO ic=1,n_chem ! make sure first one is zero too + CALL zero_tend ( chem_tendf(ims,kms,jms,ic), & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + ENDDO + +! DO ic=PARAM_FIRST_SCALAR,n_scalar + DO ic=1,n_scalar ! make sure first one is zero too + CALL zero_tend ( scalar_tendf(ims,kms,jms,ic), & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte ) + ENDDO + +END SUBROUTINE init_zero_tendency + +!=================================================================== + + +SUBROUTINE dump_data( a, field, io_unit, & + ims, ime, jms, jme, kms, kme, & + ids, ide, jds, jde, kds, kde ) +implicit none +integer :: ims, ime, jms, jme, kms, kme, & + ids, ide, jds, jde, kds, kde +real, dimension(ims:ime, kms:kme, jds:jde) :: a +character :: field +integer :: io_unit + +integer :: is,ie,js,je,ks,ke + +! +! +! calculate_phy_tend couples the physics tendencies to the column mass (mu), +! because prognostic equations are in flux form, but physics tendencies are +! computed for uncoupled variables. +! +! + + itf=MIN(ite,ide-1) + jtf=MIN(jte,jde-1) + ktf=MIN(kte,kde-1) + itsu=MAX(its,ids+1) + jtsv=MAX(jts,jds+1) + +! radiation + + IF (config_flags%ra_lw_physics .gt. 0 .or. config_flags%ra_sw_physics .gt. 0) THEN + + DO J=jts,jtf + DO K=kts,ktf + DO I=its,itf + RTHRATEN(I,K,J)=mu(I,J)*RTHRATEN(I,K,J) + ENDDO + ENDDO + ENDDO + + ENDIF + +! cumulus + + IF (config_flags%cu_physics .gt. 0) THEN + + DO J=jts,jtf + DO I=its,itf + DO K=kts,ktf + RTHCUTEN(I,K,J)=mu(I,J)*RTHCUTEN(I,K,J) + RQVCUTEN(I,K,J)=mu(I,J)*RQVCUTEN(I,K,J) + ENDDO + ENDDO + ENDDO + + IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN + DO J=jts,jtf + DO I=its,itf + DO K=kts,ktf + RQCCUTEN(I,K,J)=mu(I,J)*RQCCUTEN(I,K,J) + ENDDO + ENDDO + ENDDO + ENDIF + + IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN + DO J=jts,jtf + DO I=its,itf + DO K=kts,ktf + RQRCUTEN(I,K,J)=mu(I,J)*RQRCUTEN(I,K,J) + ENDDO + ENDDO + ENDDO + ENDIF + + IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN + DO J=jts,jtf + DO I=its,itf + DO K=kts,ktf + RQICUTEN(I,K,J)=mu(I,J)*RQICUTEN(I,K,J) + ENDDO + ENDDO + ENDDO + ENDIF + + IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN + DO J=jts,jtf + DO I=its,itf + DO K=kts,ktf + RQSCUTEN(I,K,J)=mu(I,J)*RQSCUTEN(I,K,J) + ENDDO + ENDDO + ENDDO + ENDIF + + ENDIF + +! pbl + +! IF (config_flags%bl_pbl_physics .gt. 0) THEN +!!****MARS + IF ( (config_flags%bl_pbl_physics .gt. 0) .OR. (config_flags%modif_wrf) ) THEN + + DO J=jts,jtf + DO K=kts,ktf + DO I=its,itf + RUBLTEN(I,K,J) =mu(I,J)*RUBLTEN(I,K,J) + RVBLTEN(I,K,J) =mu(I,J)*RVBLTEN(I,K,J) + RTHBLTEN(I,K,J)=mu(I,J)*RTHBLTEN(I,K,J) + ENDDO + ENDDO + ENDDO + + IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN + DO J=jts,jtf + DO K=kts,ktf + DO I=its,itf + RQVBLTEN(I,K,J)=mu(I,J)*RQVBLTEN(I,K,J) + ENDDO + ENDDO + ENDDO + ENDIF + + IF (P_QC .ge. PARAM_FIRST_SCALAR) THEN + DO J=jts,jtf + DO K=kts,ktf + DO I=its,itf + RQCBLTEN(I,K,J)=mu(I,J)*RQCBLTEN(I,K,J) + ENDDO + ENDDO + ENDDO + ENDIF + + IF (P_QI .ge. PARAM_FIRST_SCALAR) THEN + DO J=jts,jtf + DO K=kts,ktf + DO I=its,itf + RQIBLTEN(I,K,J)=mu(I,J)*RQIBLTEN(I,K,J) + ENDDO + ENDDO + ENDDO + ENDIF + + ENDIF + +! fdda +! note fdda u and v tendencies are staggered, also only interior points have muu/muv, +! so only couple those + + IF (config_flags%grid_fdda .gt. 0) THEN + + DO J=jts,jtf + DO K=kts,ktf + DO I=itsu,itf +! if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) & +! write(*,'(a,3i6,e15.5)') 'u_ten before=',i,k,j, RUNDGDTEN(i,k,j) + RUNDGDTEN(I,K,J) =muu(I,J)*RUNDGDTEN(I,K,J) +! if( i == itf/2 .AND. j == jtf/2 .AND. k==ktf/2 ) & +! write(*,'(a,2f15.5)') 'mu, muu=',mu(i,j), muu(i,j) +! if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) & +! write(*,'(a,3i6,e15.5)') 'u_ten after=',i,k,j, RUNDGDTEN(i,k,j) +! if( RUNDGDTEN(i,k,j) > 30.0 ) write(*,*) 'IKJ=',i,k,j + ENDDO + ENDDO + ENDDO +! write(*,'(a,e15.5)') 'u_ten MAXIMUM after=', maxval(RUNDGDTEN) + DO J=jtsv,jtf + DO K=kts,ktf + DO I=its,itf + RVNDGDTEN(I,K,J) =muv(I,J)*RVNDGDTEN(I,K,J) + ENDDO + ENDDO + ENDDO + DO J=jts,jtf + DO K=kts,ktf + DO I=its,itf +! if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) & +! write(*,'(a,3i6,e15.5)') 'th before=',i,k,j, RTHNDGDTEN(I,K,J) + RTHNDGDTEN(I,K,J)=mu(I,J)*RTHNDGDTEN(I,K,J) +! RMUNDGDTEN(I,J) - no coupling +! if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) & +! write(*,'(a,3i6,e15.5)') 'th after=',i,k,j, RTHNDGDTEN(I,K,J) + ENDDO + ENDDO + ENDDO + + IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN + DO J=jts,jtf + DO K=kts,ktf + DO I=its,itf + RQVNDGDTEN(I,K,J)=mu(I,J)*RQVNDGDTEN(I,K,J) + ENDDO + ENDDO + ENDDO + ENDIF + + ENDIF + +END SUBROUTINE calculate_phy_tend + +!----------------------------------------------------------------------- + +SUBROUTINE positive_definite_filter ( a, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + + IMPLICIT NONE + + INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte + + REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: a + + INTEGER :: i,k,j + +! +! +! debug and testing code for bounding a variable +! +! + + DO j=jts,min(jte,jde-1) + DO k=kts,kte-1 + DO i=its,min(ite,ide-1) +! a(i,k,j) = max(a(i,k,j),0.) + a(i,k,j) = min(1000.,max(a(i,k,j),0.)) + ENDDO + ENDDO + ENDDO + + END SUBROUTINE positive_definite_filter + +!----------------------------------------------------------------------- + +SUBROUTINE bound_tke ( tke, tke_upper_bound, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + + IMPLICIT NONE + + INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte + + REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: tke + REAL, INTENT( IN) :: tke_upper_bound + + INTEGER :: i,k,j + +! +! +! bounds tke between zero and tke_upper_bound. +! +! + + DO j=jts,min(jte,jde-1) + DO k=kts,kte-1 + DO i=its,min(ite,ide-1) + tke(i,k,j) = min(tke_upper_bound,max(tke(i,k,j),0.)) + ENDDO + ENDDO + ENDDO + + END SUBROUTINE bound_tke + + + +END MODULE module_em Index: /trunk/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part1.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part1.F (revision 2761) +++ /trunk/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part1.F (revision 2761) @@ -0,0 +1,701 @@ +!WRF:MEDIATION_LAYER:SOLVER + +#define BENCH_START(A) +#define BENCH_END(A) + +MODULE module_first_rk_step_part1 + +CONTAINS + + SUBROUTINE first_rk_step_part1 ( grid , config_flags & + , moist , moist_tend & + , chem , chem_tend & + , scalar , scalar_tend & + , fdda3d, fdda2d & + , ru_tendf, rv_tendf & + , rw_tendf, t_tendf & + , ph_tendf, mu_tendf & + , tke_tend & + , adapt_step_flag , curr_secs & + , psim , psih , wspd , gz1oz0 , br , chklowq & + , cu_act_flag , hol , th_phy & + , pi_phy , p_phy , t_phy , u_phy , v_phy & + , dz8w , p8w , t8w , rho_phy , rho & + , z_at_w , mu_3d & + , ids, ide, jds, jde, kds, kde & + , ims, ime, jms, jme, kms, kme & + , ips, ipe, jps, jpe, kps, kpe & + , k_start , k_end & + ) + USE module_state_description + USE module_model_constants + USE module_domain, ONLY : domain + USE module_configure, ONLY : grid_config_rec_type, model_config_rec +!!!!****MARS MARS +!!!!****MARS MARS +! USE module_radiation_driver, ONLY : pre_radiation_driver, radiation_driver +! USE module_surface_driver, ONLY : surface_driver +! USE module_cumulus_driver, ONLY : cumulus_driver +! USE module_pbl_driver, ONLY : pbl_driver +! USE module_fddagd_driver, ONLY : fddagd_driver + USE module_em, ONLY : init_zero_tendency +!!MARS + USE module_lmd_driver +!!MARS + USE module_big_step_utilities_em, ONLY : phy_prep + USE module_dm + IMPLICIT NONE + + TYPE ( domain ), INTENT(INOUT) :: grid + TYPE ( grid_config_rec_type ), INTENT(IN) :: config_flags + + INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe + + LOGICAL ,INTENT(IN) :: adapt_step_flag + REAL, INTENT(IN) :: curr_secs + + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist_tend + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: chem + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: chem_tend + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: scalar + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: scalar_tend + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_fdda3d),INTENT(INOUT) :: fdda3d + REAL ,DIMENSION(ims:ime,1:1,jms:jme,num_fdda2d),INTENT(INOUT) :: fdda2d + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: psim + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: psih + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: wspd + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: gz1oz0 + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: br + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: chklowq + LOGICAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: cu_act_flag + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: hol + + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: th_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: pi_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: u_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: v_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme) :: w_phy !!MARS aymeric var loc + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: dz8w + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p8w + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t8w + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: z_at_w + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: mu_3d + + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ru_tendf + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rv_tendf + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rw_tendf + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ph_tendf + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_tendf + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: tke_tend + + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: mu_tendf + + INTEGER , INTENT(IN) :: k_start, k_end + +! Local + + REAL, DIMENSION( ims:ime, jms:jme ) :: ht_loc + INTEGER, DIMENSION( ims:ime, jms:jme ) :: shadowmask + INTEGER :: ij + INTEGER num_roof_layers + INTEGER num_wall_layers + INTEGER num_road_layers + INTEGER iswater + INTEGER rk_step + + ! initialize all tendencies to zero in order to update physics + ! tendencies first (separate from dry dynamics). + + rk_step = 1 + +BENCH_START(init_zero_tend_tim) + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + + DO ij = 1 , grid%num_tiles + + CALL wrf_debug ( 200 , ' call init_zero_tendency' ) + CALL init_zero_tendency ( ru_tendf, rv_tendf, rw_tendf, & + ph_tendf, t_tendf, tke_tend, & + mu_tendf, & + moist_tend,chem_tend,scalar_tend, & + num_moist,num_chem,num_scalar, & + rk_step, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start, k_end ) + + END DO + !$OMP END PARALLEL DO +BENCH_END(init_zero_tend_tim) + +#ifdef DM_PARALLEL +# include "HALO_EM_PHYS_A.inc" +#endif + + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + DO ij = 1 , grid%num_tiles + + CALL wrf_debug ( 200 , ' call phy_prep' ) + CALL phy_prep ( config_flags, & + grid%mut, grid%muu, grid%muv, grid%u_2, & + grid%v_2, grid%w_2, grid%p, grid%pb, grid%alt, & + grid%ph_2, grid%phb, grid%t_2, grid%tsk, moist, num_moist, & + mu_3d, rho, & + th_phy, p_phy, pi_phy, u_phy, v_phy, w_phy, & + p8w, t_phy, t8w, grid%z, z_at_w, & + dz8w, grid%fnm, grid%fnp, & + grid%rthraten, & + grid%rthblten, grid%rublten, grid%rvblten, & + grid%rqvblten, grid%rqcblten, grid%rqiblten, & + grid%rthcuten, grid%rqvcuten, grid%rqccuten, & + grid%rqrcuten, grid%rqicuten, grid%rqscuten, & + grid%rthften, grid%rqvften, & + grid%RUNDGDTEN, grid%RVNDGDTEN, grid%RTHNDGDTEN, & + grid%RQVNDGDTEN, grid%RMUNDGDTEN, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start, k_end ) + ENDDO + !$OMP END PARALLEL DO + +BENCH_END(phy_prep_tim) + +!!!!****MARS MARS +!!!!****MARS MARS + +!! radiation +! +!! this driver is only needed to handle non-local shadowing effects +! CALL pre_radiation_driver ( grid, config_flags & +! & ,itimestep=grid%itimestep, ra_call_offset=grid%ra_call_offset & +! & ,XLAT=grid%xlat, XLONG=grid%xlong, GMT=grid%gmt & +! & ,julian=grid%julian, xtime=grid%xtime, RADT=grid%radt & +! & ,STEPRA=grid%stepra & +! & ,ht=grid%ht,dx=grid%dx,dy=grid%dy,sina=grid%sina,cosa=grid%cosa & +! & ,shadowmask=shadowmask,slope_rad=config_flags%slope_rad & +! & ,topo_shading=config_flags%topo_shading & +! & ,shadlen=config_flags%shadlen,ht_shad=grid%ht_shad,ht_loc=ht_loc & +! & ,ht_shad_bxs=grid%ht_shad_bxs, ht_shad_bxe=grid%ht_shad_bxe & +! & ,ht_shad_bys=grid%ht_shad_bys, ht_shad_bye=grid%ht_shad_bye & +! & ,nested=config_flags%nested, min_ptchsz=grid%min_ptchsz & +! & ,spec_bdy_width=config_flags%spec_bdy_width & +! ! indexes +! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & +! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & +! & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe & +! & ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1) & +! & ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1) & +! & ,kts=k_start, kte=min(k_end,kde-1) & +! & ,num_tiles=grid%num_tiles ) +! +! CALL wrf_debug ( 200 , ' call radiation_driver' ) +!BENCH_START(rad_driver_tim) +! +! CALL radiation_driver( & +! & ACFRCV=grid%acfrcv ,ACFRST=grid%acfrst ,ALBEDO=grid%albedo & +! & ,CFRACH=grid%cfrach ,CFRACL=grid%cfracl ,CFRACM=grid%cfracm & +! & ,CUPPT=grid%cuppt ,CZMEAN=grid%czmean ,DT=grid%dt & +! & ,DZ8W=dz8w ,EMISS=grid%emiss ,GLW=grid%glw & +! & ,GMT=grid%gmt ,GSW=grid%gsw ,HBOT=grid%hbot & +! & ,HTOP=grid%htop ,HBOTR=grid%hbotr ,HTOPR=grid%htopr & +! & ,ICLOUD=config_flags%icloud & +! & ,ITIMESTEP=grid%itimestep,JULDAY=grid%julday , JULIAN=grid%julian & +! & ,JULYR=grid%julyr ,LW_PHYSICS=config_flags%ra_lw_physics & +! & ,NCFRCV=grid%ncfrcv ,NCFRST=grid%ncfrst ,NPHS=1 & +! & ,P8W=p8w ,P=p_phy ,PI=pi_phy & +! & ,RADT=grid%radt ,RA_CALL_OFFSET=grid%ra_call_offset & +! & ,RHO=rho ,RLWTOA=grid%rlwtoa & +! & ,RSWTOA=grid%rswtoa ,RTHRATEN=grid%rthraten & +! & ,RTHRATENLW=grid%rthratenlw ,RTHRATENSW=grid%rthratensw & +! & ,SNOW=grid%snow ,STEPRA=grid%stepra ,SWDOWN=grid%swdown & +! & ,SWDOWNC=grid%swdownc ,SW_PHYSICS=config_flags%ra_sw_physics & +! & ,T8W=t8w ,T=t_phy ,TAUCLDC=grid%taucldc & +! & ,TAUCLDI=grid%taucldi ,TSK=grid%tsk ,VEGFRA=grid%vegfra & +! & ,WARM_RAIN=grid%warm_rain ,XICE=grid%xice ,XLAND=grid%xland & +! & ,XLAT=grid%xlat ,XLONG=grid%xlong & +!!Optional urban +! & ,DECLIN_URB=grid%declin_urb ,COSZ_URB2D=grid%cosz_urb2d & +! & ,OMG_URB2D=grid%omg_urb2d & +!! +! & ,Z=grid%z & +! & ,LEVSIZ=grid%levsiz, N_OZMIXM=num_ozmixm & +! & ,N_AEROSOLC=num_aerosolc & +! & ,PAERLEV=grid%paerlev & +! & ,CAM_ABS_DIM1=grid%cam_abs_dim1, CAM_ABS_DIM2=grid%cam_abs_dim2 & +! & ,CAM_ABS_FREQ_S=grid%cam_abs_freq_s & +! & ,XTIME=grid%xtime & +! ,CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag & +! ! indexes +! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & +! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & +! & ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1) & +! & ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1) & +! & ,kts=k_start, kte=min(k_end,kde-1) & +! & ,num_tiles=grid%num_tiles & +! ! Optional +! & , CLDFRA=grid%cldfra & +! & , PB=grid%pb & +! & , F_ICE_PHY=grid%f_ice_phy,F_RAIN_PHY=grid%f_rain_phy & +! & , QV=moist(ims,kms,jms,P_QV), F_QV=F_QV & +! & , QC=moist(ims,kms,jms,P_QC), F_QC=F_QC & +! & , QR=moist(ims,kms,jms,P_QR), F_QR=F_QR & +! & , QI=moist(ims,kms,jms,P_QI), F_QI=F_QI & +! & , QS=moist(ims,kms,jms,P_QS), F_QS=F_QS & +! & , QG=moist(ims,kms,jms,P_QG), F_QG=F_QG & +! & , QNDROP=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP & +!#ifdef ACFLUX +! & ,ACSWUPT=acswupt ,ACSWUPTC=acswuptc & +! & ,ACSWDNT=acswdnt ,ACSWDNTC=acswdntc & +! & ,ACSWUPB=acswupb ,ACSWUPBC=acswupbc & +! & ,ACSWDNB=acswdnb ,ACSWDNBC=acswdnbc & +! & ,ACLWUPT=aclwupt ,ACLWUPTC=aclwuptc & +! & ,ACLWDNT=aclwdnt ,ACLWDNTC=aclwdntc & +! & ,ACLWUPB=aclwupb ,ACLWUPBC=aclwupbc & +! & ,ACLWDNB=aclwdnb ,ACLWDNBC=aclwdnbc & +! & ,SWUPT=swupt ,SWUPTC=swuptc & +! & ,SWDNT=swdnt ,SWDNTC=swdntc & +! & ,SWUPB=swupb ,SWUPBC=swupbc & +! & ,SWDNB=swdnb ,SWDNBC=swdnbc & +! & ,LWUPT=lwupt ,LWUPTC=lwuptc & +! & ,LWDNT=lwdnt ,LWDNTC=lwdntc & +! & ,LWUPB=lwupb ,LWUPBC=lwupbc & +! & ,LWDNB=lwdnb ,LWDNBC=lwdnbc & +!#endif +! & ,LWCF=grid%lwcf & +! & ,SWCF=grid%swcf & +! & ,OLR=grid%olr & +! & ,OZMIXM=grid%ozmixm, PIN=grid%pin & +! & ,M_PS_1=grid%m_ps_1, M_PS_2=grid%m_ps_2, AEROSOLC_1=grid%aerosolc_1 & +! & ,AEROSOLC_2=grid%aerosolc_2, M_HYBI0=grid%m_hybi & +! & ,ABSTOT=grid%abstot, ABSNXT=grid%absnxt, EMSTOT=grid%emstot & +!#ifdef WRF_CHEM +! & ,CU_RAD_FEEDBACK=config_flags%cu_rad_feedback & +! & ,AER_RA_FEEDBACK=config_flags%aer_ra_feedback & +! & ,QC_ADJUST=grid%GD_CLOUD_B , QI_ADJUST=grid%GD_CLOUD2_B & +! & ,PM2_5_DRY=grid%pm2_5_dry, PM2_5_WATER=grid%pm2_5_water & +! & ,PM2_5_DRY_EC=grid%pm2_5_dry_ec & +! & ,TAUAER300=grid%tauaer1, TAUAER400=grid%tauaer2 & ! jcb +! & ,TAUAER600=grid%tauaer3, TAUAER999=grid%tauaer4 & ! jcb +! & ,GAER300=grid%gaer1, GAER400=grid%gaer2, GAER600=grid%gaer3, GAER999=grid%gaer4 & ! jcb +! & ,WAER300=grid%waer1, WAER400=grid%waer2, WAER600=grid%waer3, WAER999=grid%waer4 & ! jcb +!#endif +! & ,slope_rad=config_flags%slope_rad,topo_shading=config_flags%topo_shading & +! & ,shadowmask=shadowmask,ht=grid%ht,dx=grid%dx,dy=grid%dy,sina=grid%sina,cosa=grid%cosa ) +! +!BENCH_END(rad_driver_tim) +! +!!********* Surface driver +!! surface +! +!BENCH_START(surf_driver_tim) +! +!!----------------------------------------------------------------- +!! urban related variable are added to arguments of surface_driver +!!----------------------------------------------------------------- +! num_roof_layers = grid%num_soil_layers !urban +! num_wall_layers = grid%num_soil_layers !urban +! num_road_layers = grid%num_soil_layers !urban +! CALL nl_get_iswater(grid%id, iswater) +! +! CALL wrf_debug ( 200 , ' call surface_driver' ) +! +! CALL surface_driver( & +! & ACSNOM=grid%acsnom ,ACSNOW=grid%acsnow ,AKHS=grid%akhs & +! & ,AKMS=grid%akms ,ALBBCK=grid%albbck ,ALBEDO=grid%albedo & +! & ,EMBCK=grid%embck & +! & ,BR=br ,CANWAT=grid%canwat ,CHKLOWQ=chklowq & +! & ,CT=grid%ct ,DT=grid%dt ,DX=grid%dx & +! & ,DZ8W=dz8w ,DZS=grid%dzs ,FLHC=grid%flhc & +! & ,FLQC=grid%flqc ,GLW=grid%glw ,GRDFLX=grid%grdflx & +! & ,GSW=grid%gsw ,SWDOWN=grid%swdown ,GZ1OZ0=gz1oz0 ,HFX=grid%hfx & +! & ,HT=grid%ht ,IFSNOW=config_flags%ifsnow ,ISFFLX=config_flags%isfflx & +! & ,ISLTYP=grid%isltyp ,ITIMESTEP=grid%itimestep & +! & ,IVGTYP=grid%ivgtyp ,LH=grid%lh ,LOWLYR=grid%lowlyr & +! & ,MAVAIL=grid%mavail ,NUM_SOIL_LAYERS=config_flags%num_soil_layers & +! & ,P8W=p8w ,PBLH=grid%pblh ,PI_PHY=pi_phy & +! & ,PSFC=grid%psfc ,PSHLTR=grid%pshltr ,PSIH=psih & +! & ,BLDT=grid%bldt ,CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag & +! & ,PSIM=psim ,P_PHY=p_phy ,Q10=grid%q10 & +! & ,Q2=grid%q2 ,QFX=grid%qfx ,QSFC=grid%qsfc & +! & ,QSHLTR=grid%qshltr ,QZ0=grid%qz0 ,RAINCV=grid%raincv & +! & ,RA_LW_PHYSICS=config_flags%ra_lw_physics ,RHO=rho & +! & ,RMOL=grid%rmol ,SFCEVP=grid%sfcevp ,SFCEXC=grid%sfcexc & +! & ,SFCRUNOFF=grid%sfcrunoff & +! & ,SF_SFCLAY_PHYSICS=config_flags%sf_sfclay_physics & +! & ,SF_SURFACE_PHYSICS=config_flags%sf_surface_physics ,SH2O=grid%sh2o & +! & ,SHDMAX=grid%shdmax ,SHDMIN=grid%shdmin ,SMOIS=grid%smois & +! & ,SMSTAV=grid%smstav ,SMSTOT=grid%smstot ,SNOALB=grid%snoalb & +! & ,SNOW=grid%snow ,SNOWC=grid%snowc ,SNOWH=grid%snowh & +! & ,SST=grid%sst ,SST_UPDATE=grid%sst_update & +! & ,STEPBL=grid%stepbl ,TH10=grid%th10 ,TH2=grid%th2 & +! & ,THZ0=grid%thz0 ,TH_PHY=th_phy ,TKE_MYJ=grid%tke_myj & +! & ,TMN=grid%tmn ,TSHLTR=grid%tshltr ,TSK=grid%tsk & +! & ,TSLB=grid%tslb ,T_PHY=t_phy ,U10=grid%u10 & +! & ,URATX=grid%uratx ,VRATX=grid%vratx ,TRATX=grid%tratx & +! & ,UDRUNOFF=grid%udrunoff ,UST=grid%ust ,UZ0=grid%uz0 & +! & ,U_FRAME=grid%u_frame ,U_PHY=u_phy ,V10=grid%v10 & +! & ,VEGFRA=grid%vegfra ,VZ0=grid%vz0 ,V_FRAME=grid%v_frame & +! & ,V_PHY=v_phy ,WARM_RAIN=grid%warm_rain & +! & ,WSPD=wspd ,XICE=grid%xice ,XLAND=grid%xland & +! & ,Z0=grid%z0 ,Z=grid%z ,ZNT=grid%znt & +! & ,ZS=grid%zs ,XICEM=grid%xicem ,ISICE=grid%landuse_isice& +! & ,USTM=grid%ustm ,CK=grid%ck ,CKA=grid%cka & +! & ,CD=grid%cd ,CDA=grid%cda & +! & ,ISFTCFLX=config_flags%isftcflx & +! & ,OMLCALL=config_flags%omlcall ,OML_HML0=config_flags%oml_hml0 ,OML_GAMMA=config_flags%oml_gamma & +! & ,TML=grid%tml, T0ML=grid%t0ml, HML=grid%hml, H0ML=grid%h0ml, HUML=grid%huml, HVML=grid%hvml, F=grid%f & +! & ,ISWATER=iswater & +! & ,DECLIN_URB=grid%declin_urb ,COSZ_URB2D=grid%cosz_urb2d & !I urban +! & ,OMG_URB2D=grid%omg_urb2d ,xlat_urb2d=grid%XLAT & !I urban +! & ,NUM_ROOF_LAYERS=num_roof_layers & !I urban +! & ,NUM_WALL_LAYERS=num_wall_layers & !I urban +! & ,NUM_ROAD_LAYERS=num_road_layers & +! & ,DZR=grid%dzr ,DZB=grid%dzb ,DZG=grid%dzg & !I urban +! & ,TR_URB2D=grid%tr_urb2d ,TB_URB2D=grid%tb_urb2d & +! & ,TG_URB2D=grid%tg_urb2d & !H urban +! & ,TC_URB2D=grid%tc_urb2d ,QC_URB2D=grid%qc_urb2d & !H urban +! & ,UC_URB2D=grid%uc_urb2d & !H urban +! & ,XXXR_URB2D=grid%xxxr_urb2d & +! & ,XXXB_URB2D=grid%xxxb_urb2d & !H urban +! & ,XXXG_URB2D=grid%xxxg_urb2d & +! & ,XXXC_URB2D=grid%xxxc_urb2d & !H urban +! & ,TRL_URB3D=grid%trl_urb3d ,TBL_URB3D=grid%tbl_urb3d & !H urban +! & ,TGL_URB3D=grid%tgl_urb3d & !H urban +! & ,SH_URB2D=grid%sh_urb2d ,LH_URB2D=grid%lh_urb2d & +! & ,G_URB2D=grid%g_urb2d & !H urban +! & ,RN_URB2D=grid%rn_urb2d , TS_URB2D=grid%ts_urb2d & !H urban +! & ,FRC_URB2D=grid%frc_urb2d & !H urban +! & ,UTYPE_URB2D=grid%utype_urb2d & !H urban +! & ,ucmcall=grid%ucmcall & !H urban +! ! P-X LSM Variables +! & ,LANDUSEF=grid%landusef, SOILCTOP=grid%soilctop & ! P-X LSM +! & ,SOILCBOT=grid%soilcbot & ! P-X LSM +! & ,RA=grid%ra, RS=grid%rs, LAI=grid%lai & ! P-X LSM +! & ,NLCAT=grid%num_land_cat, NSCAT=grid%num_soil_cat & ! P-X LSM +! & ,VEGF_PX=grid%vegf_px, SNOWNCV=grid%snowncv & ! P-X LSM +! & ,ANAL_INTERVAL=config_flags%interval_seconds & ! P-X LSM +! & ,PXLSM_SMOIS_INIT=config_flags%pxlsm_smois_init & ! P-X LSM +! & ,PXLSM_SOIL_NUDGE=config_flags%grid_fdda & ! P-X LSM +! ! Optional PX LSM nudging +! & ,t2_ndg_old=fdda2d(ims,1,jms,P_t2_ndg_old) & +! & ,q2_ndg_old=fdda2d(ims,1,jms,P_q2_ndg_old) & +! & ,t2_ndg_new=fdda2d(ims,1,jms,P_t2_ndg_new) & +! & ,q2_ndg_new=fdda2d(ims,1,jms,P_q2_ndg_new) & +! & ,sn_ndg_old=fdda2d(ims,1,jms,P_sn_ndg_old) & +! & ,sn_ndg_new=fdda2d(ims,1,jms,P_sn_ndg_new) & +! ! Indexes +! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & +! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & +! & , I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & +! & , J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & +! & , KTS=k_start, KTE=min(k_end,kde-1) & +! & , NUM_TILES=grid%num_tiles & +! ! Optional +! & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & +! & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & +! & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & +! & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & +! & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & +! & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & +! & ,CAPG=grid%capg, EMISS=grid%emiss, HOL=hol,MOL=grid%mol & +! & ,T2OBS=grid%t2obs, Q2OBS=grid%q2obs & +! & ,RAINBL=grid%rainbl,SR=grid%sr & +! & ,RAINNCV=grid%rainncv,REGIME=grid%regime,T2=grid%t2,THC=grid%thc & +! & ,QSG=grid%qsg,QVG=grid%qvg,QCG=grid%qcg,SOILT1=grid%soilt1,TSNAV=grid%tsnav & ! ruc lsm +! & ,SMFR3D=grid%smfr3d,KEEPFR3DFLAG=grid%keepfr3dflag & ! ruc lsm +! & ,POTEVP=grid%POTEVP, SNOPCX=grid%SNOPCX, SOILTB=grid%SOILTB & ! ruc lsm +! & ) +!BENCH_END(surf_driver_tim) +! +!!********* +!! pbl +! +! CALL wrf_debug ( 200 , ' call pbl_driver' ) +!BENCH_START(pbl_driver_tim) +! CALL pbl_driver( & +! & AKHS=grid%akhs ,AKMS=grid%akms & +! & ,BL_PBL_PHYSICS=config_flags%bl_pbl_physics & +! & ,BLDT=grid%bldt, CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag & +! & ,BR=br ,CHKLOWQ=chklowq ,CT=grid%ct & +! & ,DT=grid%dt ,DX=grid%dx ,DZ8W=dz8w & +! & ,EL_MYJ=grid%el_myj ,EXCH_H=grid%exch_h ,GRDFLX=grid%grdflx & +! & ,GZ1OZ0=gz1oz0 ,HFX=grid%hfx ,HT=grid%ht & +! & ,ITIMESTEP=grid%itimestep ,KPBL=grid%kpbl & +! & ,LH=grid%lh ,LOWLYR=grid%lowlyr ,P8W=p8w & +! & ,PBLH=grid%pblh ,PI_PHY=pi_phy ,PSIH=psih & +! & ,PSIM=psim ,P_PHY=p_phy ,QFX=grid%qfx & +! & ,QSFC=grid%qsfc ,QZ0=grid%qz0 & +! & ,RA_LW_PHYSICS=config_flags%ra_lw_physics & +! & ,RHO=rho ,RQCBLTEN=grid%rqcblten ,RQIBLTEN=grid%rqiblten & +! & ,RQVBLTEN=grid%rqvblten ,RTHBLTEN=grid%rthblten ,RUBLTEN=grid%rublten & +! & ,RVBLTEN=grid%rvblten ,SNOW=grid%snow ,STEPBL=grid%stepbl & +! & ,THZ0=grid%thz0 ,TH_PHY=th_phy ,TKE_MYJ=grid%tke_myj & +! & ,TSK=grid%tsk ,T_PHY=t_phy ,UST=grid%ust & +! & ,U10=grid%u10 ,UZ0=grid%uz0 ,U_FRAME=grid%u_frame ,U_PHY=u_phy & +! & ,V10=grid%v10 ,VZ0=grid%vz0 ,V_FRAME=grid%v_frame ,V_PHY=v_phy & +! & ,WARM_RAIN=grid%warm_rain ,WSPD=wspd & +! & ,XICE=grid%xice ,XLAND=grid%xland ,Z=grid%z & +! & ,ZNT=grid%znt & +! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & +! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & +! & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & +! & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & +! & ,KTS=k_start, KTE=min(k_end,kde-1) & +! & ,NUM_TILES=grid%num_tiles & +! ! Variables Required by ACM PBL - jp +! & ,ZNU=grid%znu,ZNW=grid%znw,MUT=grid%mut,P_TOP=grid%p_top & +! ! optional +! & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & +! & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & +! & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & +! & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & +! & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & +! & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & +! & ,HOL=HOL, MOL=grid%mol, REGIME=grid%REGIME & +! & ) +! +!BENCH_END(pbl_driver_tim) +! +!! cumulus para. +! +! CALL wrf_debug ( 200 , ' call cumulus_driver' ) +! +! +!BENCH_START(cu_driver_tim) +! CALL cumulus_driver(grid & +! ! Prognostic variables +! & ,U=u_phy ,V=v_phy ,TH=th_phy ,T=t_phy & +! & ,W=grid%w_2 ,P=p_phy ,PI=pi_phy ,RHO=rho & +! ! Other arguments +! & ,ITIMESTEP=grid%itimestep ,DT=grid%dt ,DX=grid%dx & +! & ,CUDT=grid%cudt,CURR_SECS=curr_secs,ADAPT_STEP_FLAG=adapt_step_flag & +! & ,RAINC=grid%rainc ,RAINCV=grid%raincv ,PRATEC=grid%pratec & +! & , NCA=grid%nca & +! & ,HTOP=grid%cutop ,HBOT=grid%cubot ,KPBL=grid%kpbl & +! & ,DZ8W=dz8w ,P8W=p8w & +! & ,W0AVG=grid%w0avg ,STEPCU=grid%stepcu & +! & ,CLDEFI=grid%cldefi ,LOWLYR=grid%lowlyr ,XLAND=grid%xland & +! & ,APR_GR=grid%apr_gr ,APR_W=grid%apr_w ,APR_MC=grid%apr_mc & +! & ,APR_ST=grid%apr_st ,APR_AS=grid%apr_as ,APR_CAPMA=grid%apr_capma & +! & ,APR_CAPME=grid%apr_capme ,APR_CAPMI=grid%apr_capmi & +! & ,MASS_FLUX=grid%mass_flux ,XF_ENS=grid%xf_ens & +! & ,PR_ENS=grid%pr_ens ,HT=grid%ht,EDT_OUT=grid%edt_out & +! & ,imomentum=grid%imomentum,clos_choice=grid%clos_choice & +! & ,cugd_tten=grid%cugd_tten,cugd_qvten=grid%cugd_qvten,cugd_qcten=grid%cugd_qcten & +! & ,cugd_ttens=grid%cugd_ttens,cugd_qvtens=grid%cugd_qvtens & +! & ,ENSDIM=config_flags%ensdim ,MAXIENS=config_flags%maxiens ,MAXENS=config_flags%maxens & +! & ,MAXENS2=config_flags%maxens2 ,MAXENS3=config_flags%maxens3 & +! & ,CU_ACT_FLAG=cu_act_flag ,WARM_RAIN=grid%warm_rain & +! & ,GSW=grid%gsw,cugd_avedx=config_flags%cugd_avedx & +! & ,PERIODIC_X=(config_flags%polar .OR. config_flags%periodic_x) & +! & ,PERIODIC_Y=config_flags%periodic_y & +! ! Selection flag +! & ,CU_PHYSICS=config_flags%cu_physics & +! ! Dimension arguments +! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & +! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & +! & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe & +! & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & +! & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & +! & ,KTS=k_start, KTE=min(k_end,kde-1) & +! & ,NUM_TILES=grid%num_tiles & +! ! Moisture tendency arguments +! & ,RQVCUTEN=grid%rqvcuten , RQCCUTEN=grid%rqccuten & +! & ,RQSCUTEN=grid%rqscuten , RQICUTEN=grid%rqicuten & +! & ,RQRCUTEN=grid%rqrcuten , RQVBLTEN=grid%rqvblten & +! & ,RQVFTEN=grid%rqvften & +! ! Other tendency arguments +! & ,RTHRATEN=grid%rthraten , RTHBLTEN=grid%rthblten & +! & ,RTHCUTEN=grid%rthcuten , RTHFTEN=grid%rthften & +! ! Moisture tracer arguments +! & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & +! & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & +! & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & +! & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & +! & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & +! & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & +!#ifdef WRF_CHEM +! & ,GD_CLOUD=grid%GD_CLOUD,GD_CLOUD2=grid%GD_CLOUD2 & +!#endif +! & ) +!BENCH_END(cu_driver_tim) +! +! CALL wrf_debug ( 200 , ' call fddagd_driver' ) +! +!BENCH_START(fdda_driver_tim) +! CALL fddagd_driver(itimestep=grid%itimestep,dt=grid%dt,xtime=grid%XTIME, & +! id=grid%id, & +! RUNDGDTEN=grid%rundgdten,RVNDGDTEN=grid%rvndgdten, & +! RTHNDGDTEN=grid%rthndgdten,RQVNDGDTEN=grid%rqvndgdten, & +! RMUNDGDTEN=grid%rmundgdten, & +! u_ndg_old=fdda3d(ims,kms,jms,P_u_ndg_old), & +! v_ndg_old=fdda3d(ims,kms,jms,P_v_ndg_old), & +! t_ndg_old=fdda3d(ims,kms,jms,P_t_ndg_old), & +! q_ndg_old=fdda3d(ims,kms,jms,P_q_ndg_old), & +! mu_ndg_old=fdda2d(ims,1,jms,P_mu_ndg_old), & +! u_ndg_new=fdda3d(ims,kms,jms,P_u_ndg_new), & +! v_ndg_new=fdda3d(ims,kms,jms,P_v_ndg_new), & +! t_ndg_new=fdda3d(ims,kms,jms,P_t_ndg_new), & +! q_ndg_new=fdda3d(ims,kms,jms,P_q_ndg_new), & +! mu_ndg_new=fdda2d(ims,1,jms,P_mu_ndg_new), & +! u3d=grid%u_2,v3d=grid%v_2,th_phy=th_phy,rho=rho,moist=moist, & +! p_phy=p_phy,pi_phy=pi_phy,p8w=p8w,t_phy=t_phy, & +! dz8w=dz8w,z=grid%z,z_at_w=z_at_w, & +! config_flags=config_flags,dx=grid%DX,n_moist=num_moist, & +! STEPFG=grid%STEPFG, & +! pblh=grid%pblh,ht=grid%ht, & +! IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & +! ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & +! ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & +! ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & +! ,KTS=k_start, KTE=min(k_end,kde-1) & +! , num_tiles=grid%num_tiles ) +!BENCH_END(fdda_driver_tim) + +!!****MARS +IF (config_flags%modif_wrf) THEN +!!!!!!!!!!!!!!!!!!!!!!! +! call to LMD physics ! +!!!!!!!!!!!!!!!!!!!!!!! + CALL wrf_debug ( 200 , ' call lmd_driver' ) + CALL lmd_driver( & + ! structure + & id=grid%id,max_dom=grid%max_dom & + & ,DT=grid%dt & + & ,ITIMESTEP=grid%itimestep & + ! position + & ,XLAT=grid%xlat,XLONG=grid%xlong & + & ,DX=grid%dx ,DY=grid%dy & + & ,MSFT=grid%msftx,MSFU=grid%msfux,MSFV=grid%msfvx & +! & ,MSFT=grid%msft,MSFU=grid%msfu,MSFV=grid%msfv & + ! indexes + & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & + & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & + & ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1) & + & ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1) & + & ,kts=k_start, kte=min(k_end,kde-1) & + & ,num_tiles=grid%num_tiles & + ! time variables + & ,GMT=grid%gmt ,JULYR=grid%julyr ,JULDAY=grid%julday & + ! output from phy_prep + & ,P8W=p8w ,DZ8W=dz8w ,T8W=t8w & + ! Prognostic variables at p points +! & ,Z=grid%em_z & + & ,Z=grid%z & + ! z is the geopotential height at p points + ! ... (cf phy_prep in module_big_step_utilities_em) + & ,HT=grid%ht & + & ,U=u_phy ,V=v_phy ,W=w_phy & + & ,TH=th_phy ,T=t_phy & + & ,P=p_phy ,EXNER=pi_phy ,RHO=rho & +!!!!!ADDITION CAS IDEALISES + & ,PTOP=grid%p_top & + ! physics calls + & ,RADT=grid%radt & + & ,CUDT=grid%cudt & + ! surface temperature and surface pressure + & ,TSK=grid%tsk,PSFC=grid%psfc & + ! tendencies for the dynamics + & ,RTHBLTEN=grid%rthblten ,RUBLTEN=grid%rublten,RVBLTEN=grid%rvblten & + ! scalars +! & ,NUM_3D_S=num_3d_s,SCALAR=grid%scalar & + & ,NUM_3D_S=num_scalar,SCALAR=grid%scalar & + & ,NUM_3D_M=num_moist,MOIST=grid%moist & + ! mode + & ,MARS_MODE=config_flags%mars & +#ifdef NEWPHYS + ! planet + & ,planet_type=config_flags%planet & +#endif + ! added variables + & ,M_ALBEDO=grid%m_albedo,M_TI=grid%m_ti & + & ,M_CO2ICE=grid%m_co2ice,M_EMISS=grid%m_emiss & + & ,M_H2OICE=grid%m_h2oice & + & ,M_TSOIL=grid%m_tsoil & + & ,M_Q2=grid%m_q2 & + & ,M_TSURF=grid%m_tsurf & +#ifdef NEWPHYS + & ,M_FLUXRAD=grid%m_fluxrad & + & ,M_WSTAR=grid%m_wstar & + & ,M_ISOIL=grid%m_isoil & + & ,M_DSOIL=grid%m_dsoil & + & ,M_Z0=grid%m_z0 & + & ,CST_Z0=config_flags%init_Z0 & +#endif + & ,M_GW=grid%m_gw & + & ,NUM_SOIL_LAYERS=config_flags%num_soil_layers & + ! cst fields + & ,CST_AL=config_flags%init_AL & + & ,CST_TI=config_flags%init_TI & + & ,ISFFLX=config_flags%isfflx & + & ,DIFF_OPT=config_flags%diff_opt & + & ,KM_OPT=config_flags%km_opt & + & ,HISTORY_INTERVAL=model_config_rec%history_interval(1) & + !------------------! + ! OUTPUT VARIABLES ! + !------------------! +#ifdef NEWPHYS + & ,HR_SW=grid%HR_SW & + & ,HR_LW=grid%HR_LW & + & ,HR_DYN=grid%HR_DYN & + & ,DDT=grid%DDT & + & ,DT_RAD=grid%DT_RAD & + & ,DT_VDF=grid%DT_VDF & + & ,DT_AJS=grid%DT_AJS & + & ,CLOUDFRAC=grid%CLOUDFRAC & + & ,TOTCLOUDFRAC=grid%TOTCLOUDFRAC & + & ,GRAIN=grid%GRAIN & + & ,GSNOW=grid%GSNOW & + & ,REEVAP=grid%REEVAP & + & ,SURFRAIN=grid%SURFRAIN & + & ,ALBEQ=grid%ALBEQ & + & ,FLUXTOP_DN=grid%FLUXTOP_DN & + & ,FLUXABS_SW=grid%FLUXABS_SW & + & ,FLUXTOP_LW=grid%FLUXTOP_LW & + & ,FLUXSURF_SW=grid%FLUXSURF_SW & + & ,FLUXSURF_LW=grid%FLUXSURF_LW & + & ,FLXGRD=grid%FLXGRD & + & ,LSCEZ=grid%LSCEZ & + & ,H2OICE_REFF=grid%H2OICE_REFF & + & ,LATENT_HF=grid%LATENT_HF & + & ,SWDOWNZ=grid%SWDOWNZ & + & ,TAU_DUST=grid%TAU_DUST & + & ,RDUST=grid%RDUST & + & ,QSURFDUST=grid%QSURFDUST & + & ,MTOT=grid%MTOT & + & ,ICETOT=grid%ICETOT & + & ,VMR_ICE=grid%VMR_ICE & + & ,TAU_ICE=grid%TAU_ICE & + & ,RICE=grid%RICE & + & ,ZMAX=grid%ZMAX & + & ,HFMAX=grid%HFMAX & + & ,USTM=grid%USTM & + & ,HFX=grid%HFX & +#else +#include "module_lmd_driver_output4.inc" +#endif + & ,SLPX=grid%slpx,SLPY=grid%slpy,RESTART=config_flags%restart) +ENDIF + +!!!!!!!!!!!!!!!!!!!!!!! +! call to LMD physics ! +!!!!!!!!!!!!!!!!!!!!!!! +!****MARS + + END SUBROUTINE first_rk_step_part1 + +END MODULE module_first_rk_step_part1 + Index: /trunk/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part2.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part2.F (revision 2761) +++ /trunk/WRF.COMMON/WRFV3/dyn_em/module_first_rk_step_part2.F (revision 2761) @@ -0,0 +1,618 @@ +!WRF:MEDIATION_LAYER:SOLVER + +#define BENCH_START(A) +#define BENCH_END(A) + +MODULE module_first_rk_step_part2 + +CONTAINS + + SUBROUTINE first_rk_step_part2 ( grid , config_flags & + , moist , moist_tend & + , chem , chem_tend & + , scalar , scalar_tend & + , fdda3d, fdda2d & + , ru_tendf, rv_tendf & + , rw_tendf, t_tendf & + , ph_tendf, mu_tendf & + , tke_tend & + , adapt_step_flag , curr_secs & + , psim , psih , wspd , gz1oz0 , br , chklowq & + , cu_act_flag , hol , th_phy & + , pi_phy , p_phy , t_phy , u_phy , v_phy & + , dz8w , p8w , t8w , rho_phy , rho & + , z_at_w , mu_3d & + , ids, ide, jds, jde, kds, kde & + , ims, ime, jms, jme, kms, kme & + , ips, ipe, jps, jpe, kps, kpe & + , k_start , k_end & + ) + USE module_state_description + USE module_model_constants + USE module_domain, ONLY : domain + USE module_configure, ONLY : grid_config_rec_type, model_config_rec + USE module_dm + USE module_diffusion_em, ONLY : phy_bc, cal_deform_and_div, compute_diff_metrics, & + vertical_diffusion_2, horizontal_diffusion_2, calculate_km_kh, & + tke_rhs + USE module_em, ONLY : calculate_phy_tend +!!!!****MARS MARS +! USE module_fddaobs_driver, ONLY : fddaobs_driver + USE module_bc, ONLY : set_physical_bc3d, set_physical_bc2d + USE module_physics_addtendc, ONLY : update_phy_ten + + IMPLICIT NONE + + TYPE ( domain ), INTENT(INOUT) :: grid + TYPE ( grid_config_rec_type ), INTENT(IN) :: config_flags + + INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe + + LOGICAL ,INTENT(IN) :: adapt_step_flag + REAL, INTENT(IN) :: curr_secs + + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist_tend + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: chem + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: chem_tend + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: scalar + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: scalar_tend + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_fdda3d),INTENT(INOUT) :: fdda3d + REAL ,DIMENSION(ims:ime,1:1,jms:jme,num_fdda2d),INTENT(INOUT) :: fdda2d + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: psim + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: psih + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: wspd + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: gz1oz0 + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: br + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: chklowq + LOGICAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: cu_act_flag + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: hol + + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: th_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: pi_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: u_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: v_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: dz8w + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p8w + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t8w + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho_phy + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: z_at_w + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: mu_3d + + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ru_tendf + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rv_tendf + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rw_tendf + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ph_tendf + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_tendf + REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: tke_tend + + REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: mu_tendf + + INTEGER , INTENT(IN) :: k_start, k_end + +! Local + + REAL, DIMENSION( ims:ime, jms:jme ) :: ht_loc + INTEGER, DIMENSION( ims:ime, jms:jme ) :: shadowmask + INTEGER :: ij + INTEGER num_roof_layers + INTEGER num_wall_layers + INTEGER num_road_layers + INTEGER iswater + INTEGER rk_step + + ! initialize all tendencies to zero in order to update physics + ! tendencies first (separate from dry dynamics). + + rk_step = 1 + +! calculate_phy_tend + +BENCH_START(cal_phy_tend) + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + + DO ij = 1 , grid%num_tiles + + CALL wrf_debug ( 200 , ' call calculate_phy_tend' ) + CALL calculate_phy_tend (config_flags,grid%mut,grid%muu,grid%muv,pi_phy, & + grid%rthraten, & + grid%rublten,grid%rvblten,grid%rthblten, & + grid%rqvblten,grid%rqcblten,grid%rqiblten, & + grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten, & + grid%rqicuten,grid%rqscuten, & + grid%RUNDGDTEN,grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RQVNDGDTEN, & + grid%RMUNDGDTEN, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + grid%i_start(ij), min(grid%i_end(ij),ide-1), & + grid%j_start(ij), min(grid%j_end(ij),jde-1), & + k_start , min(k_end,kde-1) ) + + ENDDO + !$OMP END PARALLEL DO +BENCH_END(cal_phy_tend) + +! tke diffusion + + IF(config_flags%diff_opt .eq. 2 .OR. config_flags%diff_opt .eq. 1) THEN + +BENCH_START(comp_diff_metrics_tim) + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + DO ij = 1 , grid%num_tiles + CALL wrf_debug ( 200 , ' call compute_diff_metrics ' ) + CALL compute_diff_metrics ( config_flags, grid%ph_2, grid%phb, grid%z, grid%rdz, grid%rdzw, & + grid%zx, grid%zy, grid%rdx, grid%rdy, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start , k_end ) + ENDDO + !$OMP END PARALLEL DO +BENCH_END(comp_diff_metrics_tim) + +#ifdef DM_PARALLEL +# include "HALO_EM_TKE_C.inc" +# include "PERIOD_BDY_EM_A1.inc" +#endif + +BENCH_START(tke_diff_bc_tim) + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + + DO ij = 1 , grid%num_tiles + + CALL wrf_debug ( 200 , ' call bc for diffusion_metrics ' ) + CALL set_physical_bc3d( grid%rdzw , 'w', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start , k_end ) + CALL set_physical_bc3d( grid%rdz , 'w', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start , k_end ) + CALL set_physical_bc3d( grid%z , 'w', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start , k_end ) + CALL set_physical_bc3d( grid%zx , 'w', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start , k_end ) + CALL set_physical_bc3d( grid%zy , 'w', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start , k_end ) + CALL set_physical_bc2d( grid%ustm, 't', config_flags, & + ids, ide, jds, jde, & + ims, ime, jms, jme, & + ips, ipe, jps, jpe, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij) ) + + ENDDO + !$OMP END PARALLEL DO +BENCH_END(tke_diff_bc_tim) + +BENCH_START(deform_div_tim) + + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + + DO ij = 1 , grid%num_tiles + + CALL wrf_debug ( 200 , ' call cal_deform_and_div' ) + CALL cal_deform_and_div ( config_flags,grid%u_2,grid%v_2,grid%w_2,grid%div, & + grid%defor11,grid%defor22,grid%defor33, & + grid%defor12,grid%defor13,grid%defor23, & + grid%u_base, grid%v_base,grid%msfux,grid%msfuy, & + grid%msfvx,grid%msfvy,grid%msftx,grid%msfty, & + grid%rdx, grid%rdy, grid%dn, grid%dnw, grid%rdz, & + grid%rdzw,grid%fnm,grid%fnp,grid%cf1,grid%cf2, & + grid%cf3,grid%zx,grid%zy, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start , k_end ) + ENDDO + !$OMP END PARALLEL DO +BENCH_END(deform_div_tim) + +#ifdef DM_PARALLEL +# include "HALO_EM_TKE_D.inc" +#endif + +! calculate tke, kmh, and kmv + +BENCH_START(calc_tke_tim) + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + DO ij = 1 , grid%num_tiles + + CALL wrf_debug ( 200 , ' call calculate_km_kh' ) + CALL calculate_km_kh( config_flags,grid%dt,grid%dampcoef,grid%zdamp, & + config_flags%damp_opt, & + grid%xkmh,grid%xkmv,grid%xkhh,grid%xkhv,grid%bn2, & + grid%khdif,grid%kvdif,grid%div, & + grid%defor11,grid%defor22,grid%defor33,grid%defor12, & + grid%defor13,grid%defor23, & + grid%tke_2,p8w,t8w,th_phy, & + t_phy,p_phy,moist,grid%dn,grid%dnw, & + grid%dx,grid%dy,grid%rdz,grid%rdzw, & + config_flags%mix_isotropic,num_moist, & + grid%cf1, grid%cf2, grid%cf3, grid%warm_rain, & + grid%mix_upper_bound, & + grid%msftx, grid%msfty, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start , k_end ) + ENDDO + !$OMP END PARALLEL DO +BENCH_END(calc_tke_tim) + +#ifdef DM_PARALLEL +# include "HALO_EM_TKE_E.inc" +#endif + + ENDIF + +#ifdef DM_PARALLEL +# include "PERIOD_BDY_EM_PHY_BC.inc" + IF ( config_flags%grid_fdda .eq. 1) THEN +# include "PERIOD_BDY_EM_FDDA_BC.inc" + ENDIF +# include "PERIOD_BDY_EM_CHEM.inc" +#endif + +BENCH_START(phy_bc_tim) + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + + DO ij = 1 , grid%num_tiles + + CALL wrf_debug ( 200 , ' call phy_bc' ) + CALL phy_bc (config_flags,grid%div,grid%defor11,grid%defor22,grid%defor33, & + grid%defor12,grid%defor13,grid%defor23, & + grid%xkmh,grid%xkmv,grid%xkhh,grid%xkhv, & + grid%tke_2, & + grid%rublten, grid%rvblten, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start , k_end ) + ENDDO + !$OMP END PARALLEL DO +BENCH_END(phy_bc_tim) + +#ifdef DM_PARALLEL +!----------------------------------------------------------------------- +! +! MPP for some physics tendency, km, kh, deformation, and divergence +! +! * * * * * * * +! * * * * * * * * * * * * +! * * * * * * * * * * * * * * +! * + * * + * + * * + * * * * * + * * * +! * * * * * * * * * * * * * * +! * * * * * * * * * * * * +! * * * * * * * +! +! (for PBL) +! rublten x +! rvblten x +! +! (for FDDA) +! rundgdten x +! rvndgdten x +! +! (for TKE3) +! tke_2 x +! (for TKE5) +! tke_2 x +! +! (for diff_opt >= 1) +! defor11 x +! defor22 x +! defor12 x +! defor13 x +! defor23 x +! div x +! xkmv x +! xkmh x +! xkhv x +! xkhh x +! tke x +! +!----------------------------------------------------------------------- + +!!****MARS: always include this HALO for Mars version ... + IF ( ( config_flags%bl_pbl_physics .ge. 1 ) & + .OR. ( config_flags%modif_wrf ) ) THEN +! IF ( config_flags%bl_pbl_physics .ge. 1 ) THEN +# include "HALO_EM_PHYS_PBL.inc" + ENDIF + IF ( config_flags%grid_fdda .eq. 1) THEN +# include "HALO_EM_FDDA.inc" + ENDIF + IF ( config_flags%diff_opt .ge. 1 ) THEN +# include "HALO_EM_PHYS_DIFFUSION.inc" + ENDIF + + IF ( config_flags%h_mom_adv_order <= 4 ) THEN +# include "HALO_EM_TKE_3.inc" + ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN +# include "HALO_EM_TKE_5.inc" + ELSE + WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + CALL wrf_error_fatal(TRIM(wrf_err_message)) + ENDIF +#endif + +BENCH_START(update_phy_ten_tim) + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + + DO ij = 1 , grid%num_tiles + + CALL wrf_debug ( 200 , ' call update_phy_ten' ) + CALL update_phy_ten(t_tendf, ru_tendf, rv_tendf,moist_tend, & + scalar_tend, mu_tendf, & + grid%rthraten,grid%rthblten,grid%rthcuten, & + grid%rublten,grid%rvblten, & + grid%rqvblten,grid%rqcblten,grid%rqiblten, & + grid%rqvcuten,grid%rqccuten,grid%rqrcuten, & + grid%rqicuten,grid%rqscuten,grid%RUNDGDTEN, & + grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RQVNDGDTEN, & + grid%RMUNDGDTEN, & + num_moist,num_scalar,config_flags,rk_step, & + grid%adv_moist_cond, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start, k_end ) + + END DO + !$OMP END PARALLEL DO +BENCH_END(update_phy_ten_tim) + +#ifdef PLANET + ! do rayleigh (and zonal-average newtonian) damping during + ! first iteration of RK loop only + + IF ( (config_flags%damp_opt == 101) .OR. & + (config_flags%damp_opt == 103) ) THEN + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + DO ij = 1 , grid%num_tiles + CALL damptop( grid%u_2, grid%v_2, grid%t_2, & + grid%mut, grid%muu, grid%muv, & + pi_phy, & + t_tendf, ru_tendf, rv_tendf, P2SI, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start, k_end ) + END DO + !$OMP END PARALLEL DO + END IF +#endif + + IF( config_flags%diff_opt .eq. 2 .and. config_flags%km_opt .eq. 2 ) THEN + +BENCH_START(tke_rhs_tim) + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + DO ij = 1 , grid%num_tiles + + CALL tke_rhs ( tke_tend,grid%bn2, & + config_flags,grid%defor11,grid%defor22, & + grid%defor33, & + grid%defor12,grid%defor13,grid%defor23, & + grid%u_2,grid%v_2,grid%w_2,grid%div, & + grid%tke_2,grid%mut, & + th_phy,p_phy,p8w,t8w,grid%z,grid%fnm, & + grid%fnp,grid%cf1,grid%cf2,grid%cf3, & + grid%msftx,grid%msfty,grid%xkmh, & + grid%xkmv,grid%xkhv,grid%rdx,grid%rdy, & + grid%dx,grid%dy,grid%dt,grid%zx,grid%zy, & + grid%rdz,grid%rdzw,grid%dn, & + grid%dnw,config_flags%mix_isotropic, & + grid%hfx, grid%qfx, moist(ims,kms,jms,P_QV), & + grid%ustm, rho, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start , k_end ) + + ENDDO + !$OMP END PARALLEL DO +BENCH_END(tke_rhs_tim) + + ENDIF + +! calculate vertical diffusion first and then horizontal +! (keep this order) + + IF(config_flags%diff_opt .eq. 2) THEN + +!!!!****MARS: vertical diffusion is done by the physics +!!!!****MARS: a part si isfflx=1 (SGS completement fait par WRF) +!!!!****MARS: ou si TKE_heat precisee dans la namelist +! IF ( (config_flags%bl_pbl_physics .eq. 0) & +! .AND. (.not. config_flags%modif_wrf ) ) THEN +!! IF (config_flags%bl_pbl_physics .eq. 0) THEN +!! +!! + IF ( ( config_flags%bl_pbl_physics .eq. 0 ) & + .AND. ( ( config_flags%isfflx .ge. 1 ) & + .OR. ( config_flags%tke_heat_flux .ne. 0.) ) ) THEN +!! +!! +BENCH_START(vert_diff_tim) + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + DO ij = 1 , grid%num_tiles + + CALL wrf_debug ( 200 , ' call vertical_diffusion_2 ' ) + CALL vertical_diffusion_2( ru_tendf, rv_tendf, rw_tendf, & + t_tendf, tke_tend, & + moist_tend, num_moist, & + chem_tend, num_chem, & + scalar_tend, num_scalar, & + grid%u_2, grid%v_2, & + grid%t_2,grid%u_base,grid%v_base,grid%t_base,grid%qv_base, & + grid%mut,grid%tke_2,config_flags, & + grid%defor13,grid%defor23,grid%defor33, & + grid%div, moist, chem, scalar, & + grid%xkmv, grid%xkhv, config_flags%km_opt, & + grid%fnm, grid%fnp, grid%dn, grid%dnw, grid%rdz, grid%rdzw, & + grid%hfx, grid%qfx, grid%ustm, rho, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start, k_end ) + + ENDDO + !$OMP END PARALLEL DO +BENCH_END(vert_diff_tim) + + ENDIF +! +BENCH_START(hor_diff_tim) + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + DO ij = 1 , grid%num_tiles + + CALL wrf_debug ( 200 , ' call horizontal_diffusion_2' ) + CALL horizontal_diffusion_2( t_tendf, ru_tendf, rv_tendf, rw_tendf, & + tke_tend, & + moist_tend, num_moist, & + chem_tend, num_chem, & + scalar_tend, num_scalar, & + grid%t_2, th_phy, & + grid%mut, grid%tke_2, config_flags, & + grid%defor11, grid%defor22, grid%defor12, & + grid%defor13, grid%defor23, grid%div, & + moist, chem, scalar, & + grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx, & + grid%msfty, grid%xkmh, grid%xkhh, config_flags%km_opt, & + grid%rdx, grid%rdy, grid%rdz, grid%rdzw, & + grid%fnm, grid%fnp, grid%cf1, grid%cf2, grid%cf3, & + grid%zx, grid%zy, grid%dn, grid%dnw, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start , k_end ) + ENDDO + !$OMP END PARALLEL DO +BENCH_END(hor_diff_tim) + ENDIF + +!!!!****MARS MARS +!!!!****MARS MARS + +! IF ( grid%obs_nudge_opt .EQ. 1 ) THEN +!# ifdef DM_PARALLEL +!# include "HALO_OBS_NUDGE.inc" +!#endif +!!*********************************************************************** +!! This section for obs nudging +! !$OMP PARALLEL DO & +! !$OMP PRIVATE ( ij ) +! +! DO ij = 1 , grid%num_tiles +! +! CALL fddaobs_driver (grid%grid_id, model_config_rec%grid_id, & +! model_config_rec%parent_id, config_flags%restart, & +! grid%obs_nudge_opt, & +! grid%obs_ipf_errob, & +! grid%obs_ipf_nudob, & +! grid%fdda_start, & +! grid%fdda_end, & +! grid%obs_nudge_wind, & +! grid%obs_nudge_temp, & +! grid%obs_nudge_mois, & +! grid%obs_nudge_pstr, & +! grid%obs_coef_wind, & +! grid%obs_coef_temp, & +! grid%obs_coef_mois, & +! grid%obs_coef_pstr, & +! grid%obs_rinxy, & +! grid%obs_rinsig, & +! grid%obs_npfi, & +! grid%obs_ionf, & +! grid%obs_nobs_prt, & +! grid%obs_idynin, & +! grid%obs_dtramp, & +! model_config_rec%cen_lat(1), & +! model_config_rec%cen_lon(1), & +! config_flags%truelat1, & +! config_flags%truelat2, & +! config_flags%map_proj, & +! model_config_rec%i_parent_start, & +! model_config_rec%j_parent_start, & +! grid%parent_grid_ratio, & +! grid%max_dom, grid%itimestep, & +! grid%dt, grid%gmt, grid%julday, grid%fdob, & +! grid%max_obs, & +! model_config_rec%nobs_ndg_vars, & +! model_config_rec%nobs_err_flds, & +! grid%fdob%nstat, grid%fdob%varobs, grid%fdob%errf, & +! grid%dx, grid%KPBL,grid%HT, & +! grid%mut, grid%muu, grid%muv, & +! grid%msftx, grid%msfty, grid%msfux, grid%msfuy, grid%msfvx, grid%msfvy, & +! p_phy, t_tendf, t0, & +! grid%u_2, grid%v_2, grid%t_2, & +! moist(ims,kms,jms,P_QV), & +! grid%pb, grid%p_top, grid%p, & +! grid%uratx, grid%vratx, grid%tratx, & +! ru_tendf, rv_tendf, & +! moist_tend(ims,kms,jms,P_QV), grid%obs_savwt, & +! ids,ide, jds,jde, kds,kde, & +! ims,ime, jms,jme, kms,kme, & +! grid%i_start(ij), min(grid%i_end(ij),ide-1), & +! grid%j_start(ij), min(grid%j_end(ij),jde-1), & +! k_start , min(k_end,kde-1) ) +! +! ENDDO +! !$OMP END PARALLEL DO +! ENDIF ! obs_nudge_opt .eq. 1 +!! +!!*********************************************************************** + + END SUBROUTINE first_rk_step_part2 + +END MODULE module_first_rk_step_part2 + Index: /trunk/WRF.COMMON/WRFV3/dyn_em/module_initialize_les.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/dyn_em/module_initialize_les.F (revision 2761) +++ /trunk/WRF.COMMON/WRFV3/dyn_em/module_initialize_les.F (revision 2761) @@ -0,0 +1,1406 @@ +!IDEAL:MODEL_LAYER:INITIALIZATION +! + +! This MODULE holds the routines which are used to perform various initializations +! for the individual domains. + +! This MODULE CONTAINS the following routines: + +! initialize_field_test - 1. Set different fields to different constant +! values. This is only a test. If the correct +! domain is not found (based upon the "id") +! then a fatal error is issued. + +!----------------------------------------------------------------------- + +MODULE module_initialize_ideal + + USE module_domain + USE module_io_domain + USE module_state_description + USE module_model_constants + USE module_bc + USE module_timing + USE module_configure + USE module_init_utilities +#ifdef DM_PARALLEL + USE module_dm +#endif + + +CONTAINS + + +!------------------------------------------------------------------- +! this is a wrapper for the solver-specific init_domain routines. +! Also dereferences the grid variables and passes them down as arguments. +! This is crucial, since the lower level routines may do message passing +! and this will get fouled up on machines that insist on passing down +! copies of assumed-shape arrays (by passing down as arguments, the +! data are treated as assumed-size -- ie. f77 -- arrays and the copying +! business is avoided). Fie on the F90 designers. Fie and a pox. + + SUBROUTINE init_domain ( grid ) + + IMPLICIT NONE + + ! Input data. + TYPE (domain), POINTER :: grid + ! Local data. + INTEGER :: idum1, idum2 + + CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 ) + + CALL init_domain_rk( grid & +! +#include +! + ) + + END SUBROUTINE init_domain + +!------------------------------------------------------------------- + + SUBROUTINE init_domain_rk ( grid & +! +# include +! +) + IMPLICIT NONE + + ! Input data. + TYPE (domain), POINTER :: grid + +# include + + TYPE (grid_config_rec_type) :: config_flags + + ! Local data + INTEGER :: & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + its, ite, jts, jte, kts, kte, & + i, j, k + + ! Local data + + INTEGER, PARAMETER :: nl_max = 1000 + REAL, DIMENSION(nl_max) :: zk, p_in, theta, rho, u, v, qv, pd_in + REAL*8, DIMENSION(nl_max) :: pd_in8 + INTEGER :: nl_in + + INTEGER :: icm,jcm, ii, im1, jj, jm1, loop, error, fid, nxc, nyc + REAL :: u_mean,v_mean, f0, p_surf, p_level, qvf, z_at_v, z_at_u + REAL*8 :: p_level8 + REAL :: xrad, yrad, zrad, rad, delt, cof1, cof2 +! REAL, EXTERNAL :: interp_0 + REAL :: hm + REAL :: pi + +! stuff from original initialization that has been dropped from the Registry + REAL :: vnu, xnu, xnus, dinit0, cbh, p0_temp, t0_temp, zd, zt + REAL :: qvf1, qvf2, pd_surf + INTEGER :: it + real :: thtmp, ptmp, temp(3) + + LOGICAL :: moisture_init + LOGICAL :: stretch_grid, dry_sounding + + INTEGER :: xs , xe , ys , ye + REAL :: mtn_ht + LOGICAL, EXTERNAL :: wrf_dm_on_monitor +! For LES, add randx + real :: randx + +!!MARS + REAL :: lon_input, lat_input, alt_input, tsurf_input + ! for mode 3 + REAL, DIMENSION(nl_max) :: profdustq,profdustn + REAL, DIMENSION(nl_max) :: prescribed_sw,prescribed_lw,prescribed_dyn + REAL, DIMENSION(nl_max) :: hrsw,hrlw,hrdyn + REAL, DIMENSION(nl_max) :: lsf_dt,lsf_dq,lsfdt,lsfdq + REAL, DIMENSION(nl_max) :: venus_hrdyn + REAL, DIMENSION(nl_max) :: altitude + REAL*8, DIMENSION(nl_max) :: trac +!!MARS + + REAL :: pfu, pfd, phm + INTEGER :: hypsometric_opt = 1 ! classic + !INTEGER :: hypsometric_opt = 2 ! Wee et al. 2012 correction + + LOGICAL :: logp = .true. ! use logp to interpolate (and not p) + +#ifdef DM_PARALLEL +# include +#endif + + + SELECT CASE ( model_data_order ) + CASE ( DATA_ORDER_ZXY ) + kds = grid%sd31 ; kde = grid%ed31 ; + ids = grid%sd32 ; ide = grid%ed32 ; + jds = grid%sd33 ; jde = grid%ed33 ; + + kms = grid%sm31 ; kme = grid%em31 ; + ims = grid%sm32 ; ime = grid%em32 ; + jms = grid%sm33 ; jme = grid%em33 ; + + kts = grid%sp31 ; kte = grid%ep31 ; ! note that tile is entire patch + its = grid%sp32 ; ite = grid%ep32 ; ! note that tile is entire patch + jts = grid%sp33 ; jte = grid%ep33 ; ! note that tile is entire patch + CASE ( DATA_ORDER_XYZ ) + ids = grid%sd31 ; ide = grid%ed31 ; + jds = grid%sd32 ; jde = grid%ed32 ; + kds = grid%sd33 ; kde = grid%ed33 ; + + ims = grid%sm31 ; ime = grid%em31 ; + jms = grid%sm32 ; jme = grid%em32 ; + kms = grid%sm33 ; kme = grid%em33 ; + + its = grid%sp31 ; ite = grid%ep31 ; ! note that tile is entire patch + jts = grid%sp32 ; jte = grid%ep32 ; ! note that tile is entire patch + kts = grid%sp33 ; kte = grid%ep33 ; ! note that tile is entire patch + CASE ( DATA_ORDER_XZY ) + ids = grid%sd31 ; ide = grid%ed31 ; + kds = grid%sd32 ; kde = grid%ed32 ; + jds = grid%sd33 ; jde = grid%ed33 ; + + ims = grid%sm31 ; ime = grid%em31 ; + kms = grid%sm32 ; kme = grid%em32 ; + jms = grid%sm33 ; jme = grid%em33 ; + + its = grid%sp31 ; ite = grid%ep31 ; ! note that tile is entire patch + kts = grid%sp32 ; kte = grid%ep32 ; ! note that tile is entire patch + jts = grid%sp33 ; jte = grid%ep33 ; ! note that tile is entire patch + + END SELECT + + IF (planet == "mars" .or. planet == "titan") THEN + stretch_grid = .false. + !! FOR LES, set stretch to false + ELSE + stretch_grid = .true. !! VENUS + ENDIF + delt = 3. +! z_scale = .50 +! z_scale = .10 +! z_scale = .25 +! z_scale = .15 + pi = 2.*asin(1.0) + write(6,*) ' pi is ',pi + nxc = (ide-ids)/2 + nyc = (jde-jds)/2 + + CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags ) + +! here we check to see if the boundary conditions are set properly + + CALL boundary_condition_check( config_flags, bdyzone, error, grid%id ) + + moisture_init = .true. + + grid%itimestep=0 + +#ifdef DM_PARALLEL + CALL wrf_dm_bcast_bytes( icm , IWORDSIZE ) + CALL wrf_dm_bcast_bytes( jcm , IWORDSIZE ) +#endif + + CALL nl_set_mminlu(1, ' ') + CALL nl_set_iswater(1,0) + CALL nl_set_cen_lat(1,40.) + CALL nl_set_cen_lon(1,-105.) + CALL nl_set_truelat1(1,0.) + CALL nl_set_truelat2(1,0.) + CALL nl_set_moad_cen_lat (1,0.) + CALL nl_set_stand_lon (1,0.) + CALL nl_set_map_proj(1,0) + + +! here we initialize data we currently is not initialized +! in the input data + + DO j = jts, jte + DO i = its, ite + grid%msftx(i,j) = 1. + grid%msfty(i,j) = 1. + grid%msfux(i,j) = 1. + grid%msfuy(i,j) = 1. + grid%msfvx(i,j) = 1. + grid%msfvx_inv(i,j)= 1. + grid%msfvy(i,j) = 1. + grid%sina(i,j) = 0. + grid%cosa(i,j) = 1. + grid%e(i,j) = 0. +! for LES, include Coriolis force + grid%f(i,j) = 0. !!MARS MARS 1.e-4 +!! grid%f(i,j) = 2*EOMEG*SIN(grid%xlat(i,j)*degrad) + END DO + END DO + + DO j = jts, jte + DO k = kts, kte + DO i = its, ite + grid%ww(i,k,j) = 0. + END DO + END DO + END DO + + grid%step_number = 0 + +! set up the grid + + IF (stretch_grid) THEN ! exponential stretch for eta (nearly constant dz) + DO k=1, kde + grid%znw(k) = (exp(-(k-1)/float(kde-1)/z_scale) - exp(-1./z_scale))/ & + (1.-exp(-1./z_scale)) + ENDDO + ELSE + !!MARS + !!MARS + IF (planet .ne. "mars" .and. planet .ne. "titan") THEN + open(unit=12,file='levels',form='formatted',status='old') + rewind(12) + DO k=1, kde + read(12,*) grid%znw(k) + write(6,*) 'read level ', k,grid%znw(k) + ENDDO + close(12) + ENDIF + !!MARS + !!MARS + ! !DO k=1, kde + ! ! grid%znw(k) = 1. - float(k-1)/float(kde-1) + ! !ENDDO + ENDIF + + !! SPECIFIC FOR LES PBL MARS + IF (planet == "mars" .or. planet == "titan") THEN + !!!MARS + grid%znw(1)=1.000 + grid%znw(2)=0.9995 !5m + grid%znw(3)=0.9980 !20m + grid%znw(4)=0.9950 !55m + DO k=5, kde + grid%znw(k) = grid%znw(4) * ( 1. - float(k-4)/float(kde-4) ) + ENDDO + ENDIF + + open(unit=12,file='levels',form='formatted',status='old') + rewind(12) + DO k=1, kde + write(12,*) grid%znw(k) + write(6,*) 'for update_inputs_physiq_mod (e.g. Titan, generic)',k,grid%znw(k) + ENDDO + close(12) + + + + DO k=1, kde-1 + grid%dnw(k) = grid%znw(k+1) - grid%znw(k) + grid%rdnw(k) = 1./grid%dnw(k) + grid%znu(k) = 0.5*(grid%znw(k+1)+grid%znw(k)) + ENDDO + DO k=2, kde-1 + grid%dn(k) = 0.5*(grid%dnw(k)+grid%dnw(k-1)) + grid%rdn(k) = 1./grid%dn(k) + grid%fnp(k) = .5* grid%dnw(k )/grid%dn(k) + grid%fnm(k) = .5* grid%dnw(k-1)/grid%dn(k) + ENDDO + + cof1 = (2.*grid%dn(2)+grid%dn(3))/(grid%dn(2)+grid%dn(3))*grid%dnw(1)/grid%dn(2) + cof2 = grid%dn(2) /(grid%dn(2)+grid%dn(3))*grid%dnw(1)/grid%dn(3) + grid%cf1 = grid%fnp(2) + cof1 + grid%cf2 = grid%fnm(2) - cof1 - cof2 + grid%cf3 = cof2 + + grid%cfn = (.5*grid%dnw(kde-1)+grid%dn(kde-1))/grid%dn(kde-1) + grid%cfn1 = -.5*grid%dnw(kde-1)/grid%dn(kde-1) + grid%rdx = 1./config_flags%dx + grid%rdy = 1./config_flags%dy + +! get the sounding from the ascii sounding file, first get dry sounding and +! calculate base state + + dry_sounding = .true. + IF ( wrf_dm_on_monitor() ) THEN + write(6,*) ' getting dry sounding for base state ' + + CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in ) + ENDIF + CALL wrf_dm_bcast_real( zk , nl_max ) + CALL wrf_dm_bcast_real( p_in , nl_max ) + CALL wrf_dm_bcast_real( pd_in , nl_max ) + CALL wrf_dm_bcast_real( theta , nl_max ) + CALL wrf_dm_bcast_real( rho , nl_max ) + CALL wrf_dm_bcast_real( u , nl_max ) + CALL wrf_dm_bcast_real( v , nl_max ) + CALL wrf_dm_bcast_real( qv , nl_max ) + CALL wrf_dm_bcast_integer ( nl_in , 1 ) + + write(6,*) ' returned from reading sounding, nl_in is ',nl_in + +!!MARS +!!MARS + open(unit=14,file='input_coord',form='formatted',status='old') + rewind(14) + read(14,*) lon_input + read(14,*) lat_input + close(14) + write(6,*) ' lon is ',lon_input + write(6,*) ' lat is ',lat_input +!!MARS +!!MARS + +!!MARS +!!MARS + open(unit=18,file='input_more',form='formatted',status='old') + rewind(18) + read(18,*) alt_input, tsurf_input + close(18) + write(6,*) ' alt is ',alt_input + write(6,*) ' tsurf is ',tsurf_input +!!MARS +!!MARS + +! find ptop for the desired ztop (ztop is input from the namelist), +! and find surface pressure + + write(6,*) ' ztop above ground is ',config_flags%ztop + write(6,*) ' real ztop is ',config_flags%ztop + alt_input + grid%p_top = interp_0( p_in, zk, config_flags%ztop + alt_input, nl_in ) + + DO j=jts,jte + DO i=its,ite +!!MARS + grid%ht(i,j) = alt_input + grid%m_tsurf(i,j) = tsurf_input +!!MARS + grid%xlat(i,j) = lat_input !+ float(j)*config_flags%dy/59000. + grid%xlong(i,j) = lon_input !+ float(i)*config_flags%dx/59000. + grid%m_emiss(i,j)=0.95 + grid%m_co2ice(i,j)=0. + grid%m_h2oice(i,j)=0. +!! >> Used for restarts only: + grid%m_q2(i,:,j)=0. + grid%m_fluxrad(i,j)=0. + grid%m_wstar(i,j)=0. +!! << + grid%slpx(i,j) = 0. + grid%slpy(i,j) = 0. + DO k=1,config_flags%num_soil_layers + grid%m_tsoil(i,k,j) = 0. + ENDDO + grid%m_gw(i,1,j) = 0. + grid%m_gw(i,2,j) = 0. + grid%m_gw(i,3,j) = 0. + grid%m_gw(i,4,j) = 0. + grid%m_gw(i,5,j) = 0. +!!MARS + ENDDO + ENDDO + + xs=ide/2 -3 + xs=ids -3 + xe=xs + 6 + ys=jde/2 -3 + ye=ys + 6 + mtn_ht = 500 +#ifdef MTN + DO j=max(ys,jds),min(ye,jde-1) + DO i=max(xs,ids),min(xe,ide-1) + grid%ht(i,j) = alt_input + mtn_ht * 0.25 * & + ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) ) * & + ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) ) + ENDDO + ENDDO +#endif +#ifdef EW_RIDGE + DO j=max(ys,jds),min(ye,jde-1) + DO i=ids,ide + grid%ht(i,j) = mtn_ht * 0.50 * & + ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) ) + ENDDO + ENDDO +#endif +#ifdef NS_RIDGE + DO j=jds,jde + DO i=max(xs,ids),min(xe,ide-1) + grid%ht(i,j) = mtn_ht * 0.50 * & + ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) ) + ENDDO + ENDDO +#endif + DO j=jts,jte + DO i=its,ite + grid%phb(i,1,j) = g * grid%ht(i,j) + grid%ph0(i,1,j) = g * grid%ht(i,j) + ENDDO + ENDDO + + IF (.not.logp) THEN + write(6,*) 'interpolate in p' + ELSE + write(6,*) 'interpolate in logp' + ENDIF + + DO J = jts, jte + DO I = its, ite + + p_surf = interp_0( p_in, zk, grid%phb(i,1,j)/g, nl_in ) + grid%mub(i,j) = p_surf-grid%p_top + +! this is dry hydrostatic sounding (base state), so given grid%p (coordinate), +! interp theta (from interp) and compute 1/rho from eqn. of state + + DO K = 1, kte-1 + p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top + grid%pb(i,k,j) = p_level + IF (.not.logp) THEN + grid%t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0 + ELSE + grid%t_init(i,k,j) = interp_0_log( theta, p_in, p_level, nl_in ) - t0 + ENDIF + grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm + ENDDO + +! calc hydrostatic balance (alternatively we could interp the geopotential from the +! sounding, but this assures that the base state is in exact hydrostatic balance with +! respect to the model eqns. + + IF (hypsometric_opt == 1) THEN + DO k = 2,kte + grid%phb(i,k,j) = grid%phb(i,k-1,j) - grid%dnw(k-1)*grid%mub(i,j)*grid%alb(i,k-1,j) + ENDDO + ELSE IF (hypsometric_opt == 2) THEN + DO k = 2,kte + pfu = grid%mub(i,j)*grid%znw(k) + grid%p_top + pfd = grid%mub(i,j)*grid%znw(k-1) + grid%p_top + phm = grid%mub(i,j)*grid%znu(k-1) + grid%p_top + grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu) + END DO + END IF + + + ENDDO + ENDDO + IF ( wrf_dm_on_monitor() ) THEN + write(6,*) ' ptop is ',grid%p_top + write(6,*) ' base state grid%mub(1,1), p_surf is ',grid%mub(1,1),grid%mub(1,1)+grid%p_top + ENDIF + +! calculate full state for each column - this includes moisture. + + write(6,*) ' getting moist sounding for full state ' + dry_sounding = .false. + CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in ) + + DO J = jts, min(jde-1,jte) + DO I = its, min(ide-1,ite) + +! At this point grid%p_top is already set. find the DRY mass in the column +! by interpolating the DRY pressure. + + pd_surf = interp_0( pd_in, zk, grid%phb(i,1,j)/g, nl_in ) + +! compute the perturbation mass and the full mass + + grid%mu_1(i,j) = pd_surf-grid%p_top - grid%mub(i,j) + grid%mu_2(i,j) = grid%mu_1(i,j) + grid%mu0(i,j) = grid%mu_1(i,j) + grid%mub(i,j) + +! given the dry pressure and coordinate system, interp the potential +! temperature and qv + + do k=1,kde-1 + + p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top + IF (.not.logp) THEN + moist(i,k,j,P_QV) = interp_0( qv, pd_in, p_level, nl_in ) + grid%t_1(i,k,j) = interp_0( theta, pd_in, p_level, nl_in ) - t0 + ELSE + moist(i,k,j,P_QV) = interp_0_log( qv, pd_in, p_level, nl_in ) + grid%t_1(i,k,j) = interp_0_log( theta, pd_in, p_level, nl_in ) - t0 + ENDIF + grid%t_2(i,k,j) = grid%t_1(i,k,j) + + + enddo + +! integrate the hydrostatic equation (from the RHS of the bigstep +! vertical momentum equation) down from the top to get grid%p. +! first from the top of the model to the top pressure + + k = kte-1 ! top level + + qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV)) + qvf2 = 1./(1.+qvf1) + qvf1 = qvf1*qvf2 + +! grid%p(i,k,j) = - 0.5*grid%mu_1(i,j)/grid%rdnw(k) + grid%p(i,k,j) = - 0.5*(grid%mu_1(i,j)+qvf1*grid%mub(i,j))/grid%rdnw(k)/qvf2 + qvf = 1. + rvovrd*moist(i,k,j,P_QV) + grid%alt(i,k,j) = (r_d/p1000mb)*(grid%t_1(i,k,j)+t0)*qvf* & + (((grid%p(i,k,j)+grid%pb(i,k,j))/p1000mb)**cvpm) + grid%al(i,k,j) = grid%alt(i,k,j) - grid%alb(i,k,j) + +! down the column + + do k=kte-2,1,-1 + qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV)) + qvf2 = 1./(1.+qvf1) + qvf1 = qvf1*qvf2 + grid%p(i,k,j) = grid%p(i,k+1,j) - (grid%mu_1(i,j) + qvf1*grid%mub(i,j))/qvf2/grid%rdn(k+1) + qvf = 1. + rvovrd*moist(i,k,j,P_QV) + grid%alt(i,k,j) = (r_d/p1000mb)*(grid%t_1(i,k,j)+t0)*qvf* & + (((grid%p(i,k,j)+grid%pb(i,k,j))/p1000mb)**cvpm) + grid%al(i,k,j) = grid%alt(i,k,j) - grid%alb(i,k,j) + enddo + +! this is the hydrostatic equation used in the model after the +! small timesteps. In the model, grid%al (inverse density) +! is computed from the geopotential. + + + grid%ph_1(i,1,j) = 0. + IF (hypsometric_opt == 1) THEN + DO k = 2,kte + grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (1./grid%rdnw(k-1))*( & + (grid%mub(i,j)+grid%mu_1(i,j))*grid%al(i,k-1,j)+ & + grid%mu_1(i,j)*grid%alb(i,k-1,j) ) + + grid%ph_2(i,k,j) = grid%ph_1(i,k,j) + grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j) + ENDDO + ELSE IF (hypsometric_opt == 2) THEN + + ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure. + ! Note that al*p approximates Rd*T and dLOG(p) does z. + ! Here T varies mostly linear with z, the first-order integration produces better result. + + grid%ph_2(i,1,j) = grid%phb(i,1,j) + DO k = 2,kte + pfu = grid%mu0(i,j)*grid%znw(k) + grid%p_top + pfd = grid%mu0(i,j)*grid%znw(k-1) + grid%p_top + phm = grid%mu0(i,j)*grid%znu(k-1) + grid%p_top + grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu) + END DO + + DO k = 1,kte + grid%ph_2(i,k,j) = grid%ph_2(i,k,j) - grid%phb(i,k,j) + grid%ph_1(i,k,j) = grid%ph_2(i,k,j) + END DO + + END IF + + + + IF ( wrf_dm_on_monitor() ) THEN + if((i==2) .and. (j==2)) then + write(6,*) ' grid%ph_1 calc ',grid%ph_1(2,1,2),grid%ph_1(2,2,2),& + grid%mu_1(2,2)+grid%mub(2,2),grid%mu_1(2,2), & + grid%alb(2,1,2),grid%al(1,2,1),grid%rdnw(1) + endif + ENDIF + + ENDDO + ENDDO + +!#if 0 + +! thermal perturbation to kick off convection + + write(6,*) ' nxc, nyc for perturbation ',nxc,nyc + write(6,*) ' delt for perturbation ',delt + +! For LES, change the initial random perturbations +! For 2D test, call randx outside I-loop +! For 3D runs, call randx inside both I-J loops + + DO J = jts, min(jde-1,jte) +! yrad = config_flags%dy*float(j-nyc)/10000. + yrad = 0. + DO I = its, min(ide-1,ite) +! xrad = config_flags%dx*float(i-nxc)/10000. + xrad = 0. + call random_number (randx) + randx = randx - 0.5 +! DO K = 1, kte-1 + DO K = 1, 4 + +! No bubbles for LES! +! put in preturbation theta (bubble) and recalc density. note, +! the mass in the column is not changing, so when theta changes, +! we recompute density and geopotential + +! zrad = 0.5*(grid%ph_1(i,k,j)+grid%ph_1(i,k+1,j) & +! +grid%phb(i,k,j)+grid%phb(i,k+1,j))/g +! zrad = (zrad-1500.)/1500. + zrad = 0. + RAD=SQRT(xrad*xrad+yrad*yrad+zrad*zrad) + IF(RAD <= 1.) THEN +! grid%t_1(i,k,j)=grid%t_1(i,k,j)+delt*COS(.5*PI*RAD)**2 + grid%t_1(i,k,j)=grid%t_1(i,k,j)+ 0.1 *randx + grid%t_2(i,k,j)=grid%t_1(i,k,j) + qvf = 1. + rvovrd*moist(i,k,j,P_QV) + grid%alt(i,k,j) = (r_d/p1000mb)*(grid%t_1(i,k,j)+t0)*qvf* & + (((grid%p(i,k,j)+grid%pb(i,k,j))/p1000mb)**cvpm) + grid%al(i,k,j) = grid%alt(i,k,j) - grid%alb(i,k,j) + ENDIF + ENDDO + +! rebalance hydrostatically + + IF (hypsometric_opt == 1) THEN + + DO k = 2,kte + grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (1./grid%rdnw(k-1))*( & + (grid%mub(i,j)+grid%mu_1(i,j))*grid%al(i,k-1,j)+ & + grid%mu_1(i,j)*grid%alb(i,k-1,j) ) + + grid%ph_2(i,k,j) = grid%ph_1(i,k,j) + grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j) + ENDDO + + ELSE IF (hypsometric_opt == 2) THEN + + ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure. + ! Note that al*p approximates Rd*T and dLOG(p) does z. + ! Here T varies mostly linear with z, the first-order integration produces better result. + + grid%ph_2(i,1,j) = grid%phb(i,1,j) + DO k = 2,kte + pfu = grid%mu0(i,j)*grid%znw(k) + grid%p_top + pfd = grid%mu0(i,j)*grid%znw(k-1) + grid%p_top + phm = grid%mu0(i,j)*grid%znu(k-1) + grid%p_top + grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu) + END DO + + DO k = 1,kte + grid%ph_2(i,k,j) = grid%ph_2(i,k,j) - grid%phb(i,k,j) + grid%ph_1(i,k,j) = grid%ph_2(i,k,j) + END DO + + END IF + + + ENDDO + ENDDO + +!#endif + + IF ( wrf_dm_on_monitor() ) THEN + write(6,*) ' grid%mu_1 from comp ', grid%mu_1(1,1) + write(6,*) ' full state sounding from comp, ph/g, grid%p, grid%al, grid%t_1, qv ' + do k=1,kde-1 + write(6,'(i3,1x,5(1x,1pe10.3))') k, (grid%ph_1(1,k,1)+grid%phb(1,k,1))/g, & + grid%p(1,k,1)+grid%pb(1,k,1), grid%alt(1,k,1), & + grid%t_1(1,k,1)+t0, moist(1,k,1,P_QV) + enddo + + write(6,*) ' pert state sounding from comp, grid%ph_1, pp, alp, grid%t_1, qv ' + do k=1,kde-1 + write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%ph_1(1,k,1), & + grid%p(1,k,1), grid%al(1,k,1), & + grid%t_1(1,k,1), moist(1,k,1,P_QV) + enddo + ENDIF + +! interp v + + DO J = jts, jte + DO I = its, min(ide-1,ite) + + IF (j == jds) THEN + z_at_v = grid%phb(i,1,j)/g + ELSE IF (j == jde) THEN + z_at_v = grid%phb(i,1,j-1)/g + ELSE + z_at_v = 0.5*(grid%phb(i,1,j)+grid%phb(i,1,j-1))/g + END IF + + p_surf = interp_0( p_in, zk, z_at_v, nl_in ) + + DO K = 1, kte-1 + p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top + IF (.not.logp) THEN + grid%v_1(i,k,j) = interp_0( v, p_in, p_level, nl_in ) + ELSE + grid%v_1(i,k,j) = interp_0_log( v, p_in, p_level, nl_in ) + ENDIF + grid%v_2(i,k,j) = grid%v_1(i,k,j) + ENDDO + + ENDDO + ENDDO + +! interp u + + DO J = jts, min(jde-1,jte) + DO I = its, ite + + IF (i == ids) THEN + z_at_u = grid%phb(i,1,j)/g + ELSE IF (i == ide) THEN + z_at_u = grid%phb(i-1,1,j)/g + ELSE + z_at_u = 0.5*(grid%phb(i,1,j)+grid%phb(i-1,1,j))/g + END IF + + p_surf = interp_0( p_in, zk, z_at_u, nl_in ) + + DO K = 1, kte-1 + p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top + IF (.not.logp) THEN + grid%u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in ) + ELSE + grid%u_1(i,k,j) = interp_0_log( u, p_in, p_level, nl_in ) + ENDIF + grid%u_2(i,k,j) = grid%u_1(i,k,j) + ENDDO + + ENDDO + ENDDO + +! set w + + DO J = jts, min(jde-1,jte) + DO K = kts, kte + DO I = its, min(ide-1,ite) + grid%w_1(i,k,j) = 0. + grid%w_2(i,k,j) = 0. + ENDDO + ENDDO + ENDDO + +!!!MARS MARS +IF (config_flags%init_MU .ne. 0.) THEN + grid%u_1 = grid%u_1*config_flags%init_MU + grid%u_2 = grid%u_2*config_flags%init_MU + print *, 'multiply zonal wind ', config_flags%init_MU +ENDIF +IF (config_flags%init_MV .ne. 0.) THEN + grid%v_1 = grid%v_1*config_flags%init_MV + grid%v_2 = grid%v_2*config_flags%init_MV + print *, 'multiply meridional wind ', config_flags%init_MV +ENDIF +IF (config_flags%init_U .ne. 0.) THEN + DO J = jts, min(jde-1,jte) + DO K = kts, kte-1 + DO I = its, min(ide-1,ite) + grid%u_1(i,k,j) = config_flags%init_U + grid%u_2(i,k,j) = config_flags%init_U + ENDDO + ENDDO + ENDDO + print *, 'constant zonal wind ', config_flags%init_U + !!! ****** ou autre possibilité + !!! > grid%u_1 = grid%u_1*0. + config_flags%init_U + !!! > grid%u_2 = grid%u_2*0. + config_flags%init_U +ENDIF +IF (config_flags%init_V .ne. 0.) THEN + DO J = jts, min(jde-1,jte) + DO K = kts, kte-1 + DO I = its, min(ide-1,ite) + grid%v_1(i,k,j) = config_flags%init_V + grid%v_2(i,k,j) = config_flags%init_V + ENDDO + ENDDO + ENDDO + print *, 'constant meridional wind ', config_flags%init_V +ENDIF + +!!!MARS MARS + + +! set a few more things + + DO J = jts, min(jde-1,jte) + DO K = kts, kte-1 + DO I = its, min(ide-1,ite) + grid%h_diabatic(i,k,j) = 0. + !!!!! MARS NO WIND CASE + !grid%u_1(i,k,j) = 0. + !grid%u_2(i,k,j) = 0. + !grid%v_1(i,k,j) = 0. + !grid%v_2(i,k,j) = 0. + !!!!! MARS NO WIND CASE + ENDDO + ENDDO + ENDDO + + IF ( wrf_dm_on_monitor() ) THEN + DO k=1,kte-1 + grid%t_base(k) = grid%t_1(1,k,1) + grid%qv_base(k) = moist(1,k,1,P_QV) + grid%u_base(k) = grid%u_1(1,k,1) + grid%v_base(k) = grid%v_1(1,k,1) + grid%z_base(k) = 0.5*(grid%phb(1,k,1)+grid%phb(1,k+1,1)+grid%ph_1(1,k,1)+grid%ph_1(1,k+1,1))/g + +!!!!! MARS SIMPLE LES (PURE BUOYANCY) +!! grid%t_base(k) = grid%t_init(its,k,jts) +! grid%t_base(k) = 0. +! grid%qv_base(k) = 0. +! grid%u_base(k) = 0. +! grid%v_base(k) = 0. +! grid%z_base(k) = 0. +!!!!! MARS SIMPLE LES + + ENDDO + ENDIF + CALL wrf_dm_bcast_real( grid%t_base , kte ) + CALL wrf_dm_bcast_real( grid%qv_base , kte ) + CALL wrf_dm_bcast_real( grid%u_base , kte ) + CALL wrf_dm_bcast_real( grid%v_base , kte ) + CALL wrf_dm_bcast_real( grid%z_base , kte ) + + DO J = jts, min(jde-1,jte) + DO I = its, min(ide-1,ite) + thtmp = grid%t_2(i,1,j)+t0 + ptmp = grid%p(i,1,j)+grid%pb(i,1,j) + temp(1) = thtmp * (ptmp/p1000mb)**rcp + thtmp = grid%t_2(i,2,j)+t0 + ptmp = grid%p(i,2,j)+grid%pb(i,2,j) + temp(2) = thtmp * (ptmp/p1000mb)**rcp + thtmp = grid%t_2(i,3,j)+t0 + ptmp = grid%p(i,3,j)+grid%pb(i,3,j) + temp(3) = thtmp * (ptmp/p1000mb)**rcp + +!! For LES-CBL, add 5 degrees to the surface temperature! +!! +! grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3) +!! grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)+5. + grid%tmn(I,J)=grid%tsk(I,J)-0.5 + + ENDDO + ENDDO + +!!!!! MARS + + ! interpolate water vapor + if ( ( config_flags%mars == 1 ) & + .OR. ( config_flags%mars == 11 ) & + .OR. ( config_flags%mars == 12 ) ) then + print *, '**** INTERPOLATE HV **** RANK 2 in SCALAR' + DO k=1,kte-1 + p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top + IF (.not.logp) THEN + scalar(its:ite,k,jts:jte,2) = interp_0( qv, pd_in, p_level, nl_in ) + ELSE + scalar(its:ite,k,jts:jte,2) = interp_0_log( qv, pd_in, p_level, nl_in ) + ENDIF + scalar(its:ite,k,jts:jte,3) = 0. + !! water ice is set to 0 (was put into water vapor when building prof from MCD) + ENDDO + print *, "WATER VAPOR",scalar(its,:,jts,2) + endif + + ! interpolate qdust + if ( ( config_flags%mars == 11 ) & + .OR. ( config_flags%mars == 12 ) ) then + call read_dust(profdustq,profdustn,nl_in) + print *, '**** INTERPOLATE DUSTQ **** RANK 4 in SCALAR' + print *, '**** INTERPOLATE DUSTN **** RANK 5 in SCALAR' + DO k=1,kte-1 + p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top + IF (.not.logp) THEN + scalar(its:ite,k,jts:jte,4) = interp_0( profdustq, pd_in, p_level,nl_in ) + scalar(its:ite,k,jts:jte,5) = interp_0( profdustn, pd_in, p_level,nl_in ) + ELSE + scalar(its:ite,k,jts:jte,4) = interp_0_log( profdustq, pd_in, p_level, nl_in ) + scalar(its:ite,k,jts:jte,5) = interp_0_log( profdustn, pd_in, p_level, nl_in ) + ENDIF + ENDDO + print *, "DUST Q", scalar(its,:,jts,4) + print *, "DUST N", scalar(its,:,jts,5) + endif + + if ( config_flags%mars == 12 ) then + scalar(its:ite,1:kte-1,jts:jte,6) = 0. + scalar(its:ite,1:kte-1,jts:jte,7) = 0. + endif + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + IF (planet .ne. "mars") THEN + call read_dust(profdustq,profdustn,nl_in) + DO k=1,kte!-1 + p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top + DO j = jts, jte + DO i = its, ite + !!! we use Q2 as a vehicle for heating rates! sick! + grid%m_q2(i,k,j) = interp_0_log( profdustq, pd_in, p_level, nl_in ) & + + interp_0_log( profdustn, pd_in, p_level, nl_in ) + ENDDO + ENDDO + !print*,'grid%m_q2' + !print*,k,grid%m_q2(1,k,1) + ENDDO + ENDIF + + IF (planet.eq."prescribed") Then + call read_hr(hrsw,hrlw,hrdyn,nl_in) + open(unit=17,file="prescribed_sw.txt",action="write") + open(unit=18,file="prescribed_lw.txt",action="write") + open(unit=19,file="prescribed_dyn.txt",action="write") + DO k=1,kte!-1 + p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top + prescribed_sw(k) = interp_0_log( hrsw, pd_in, p_level, nl_in ) + prescribed_lw(k) = interp_0_log( hrlw, pd_in, p_level, nl_in ) + prescribed_dyn(k) = interp_0_log( hrdyn, pd_in, p_level, nl_in ) + write (17,*) prescribed_sw(k) + write (18,*) prescribed_lw(k) + write (19,*) prescribed_dyn(k) + ENDDO + close(unit=19) + close(unit=18) + close(unit=17) + ENDIF + + IF (planet.eq."venus") Then + call read_hr(hrsw,hrlw,hrdyn,nl_in) + open(unit=20,file="venus_hrdyn.txt",action="write") + DO k=1,kte!-1 + p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top + venus_hrdyn(k) = interp_0_log( hrdyn, pd_in, p_level, nl_in ) + write (20,*) venus_hrdyn(k) + ENDDO + close(unit=20) + ENDIF + + IF (planet.eq."generic") THEN + call read_lsf(lsfdt,lsfdq,nl_in) + open(unit=17,file="lsf.txt",action="write") + DO k=1,kte!-1 + p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top + lsf_dt = interp_0_log( lsfdt, pd_in, p_level, nl_in ) + lsf_dq = interp_0_log( lsfdq, pd_in, p_level, nl_in ) + write (17,*) lsf_dt(k),lsf_dq(k) + ENDDO + ENDIF + + IF ((planet.eq."venus") .AND. ( config_flags%mars == 34 )) Then + pd_in8(:)=pd_in(:) + do i = 1,34 + call read_tracer(trac,num_scalar,i,nl_in) + DO k=1,kte-1 + p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top + p_level8=p_level + scalar(its:ite,k,jts:jte,i+1) = interp_0_log2( trac, pd_in8, p_level8, nl_in ) + ENDDO + ENDDO + !close(unit=22) + ENDIF + + open(unit=21,file="altitude.txt",action="write") + DO k=1,kte!-1 + p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top + altitude(k) = interp_0_log( zk, pd_in, p_level, nl_in ) + write (21,*) altitude(k) + ENDDO + close(unit=21) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +!!!!! MARS + + + END SUBROUTINE init_domain_rk + + SUBROUTINE init_module_initialize + END SUBROUTINE init_module_initialize + +!--------------------------------------------------------------------- + +! test driver for get_sounding +! +! implicit none +! integer n +! parameter(n = 1000) +! real zk(n),p(n),theta(n),rho(n),u(n),v(n),qv(n),pd(n) +! logical dry +! integer nl,k +! +! dry = .false. +! dry = .true. +! call get_sounding( zk, p, pd, theta, rho, u, v, qv, dry, n, nl ) +! write(6,*) ' input levels ',nl +! write(6,*) ' sounding ' +! write(6,*) ' k height(m) press (Pa) pd(Pa) theta (K) den(kg/m^3) u(m/s) v(m/s) qv(g/g) ' +! do k=1,nl +! write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), pd(k), theta(k), rho(k), u(k), v(k), qv(k) +! enddo +! end +! +!--------------------------------------------------------------------------- + + subroutine get_sounding( zk, p, p_dry, theta, rho, & + u, v, qv, dry, nl_max, nl_in ) + implicit none + + integer nl_max, nl_in + real zk(nl_max), p(nl_max), theta(nl_max), rho(nl_max), & + u(nl_max), v(nl_max), qv(nl_max), p_dry(nl_max) + logical dry + + integer n + parameter(n=1000) + logical debug + parameter( debug = .true.) + +! input sounding data + + real p_surf, th_surf, qv_surf + real pi_surf, pi(n) + real h_input(n), th_input(n), qv_input(n), u_input(n), v_input(n) + +! input therm data (element 0 is the ground so it's n+1 but n is 1000 anyway so...) + + real r_therm(n),cp_therm(n),p_therm(n),rho_therm(n),t_therm(n) + +! diagnostics + + real rho_surf, p_input(n), rho_input(n) + real pm_input(n) ! this are for full moist sounding + +! local data + +! real p1000mb,cv,cp,r,cvpm,g +! parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 ) +! parameter (p1000mb = 610., r = 192., cp = 844.6, cv = cp-r, cvpm = -cv/cp, g=3.72) +! parameter (p1000mb = 610., r = 191., cp = 744.5, cv = cp-r, cvpm = -cv/cp, g=3.72) + !parameter (p1000mb = 92.e+05, r = 192., cp = 900.0, cv = cp-r, cvpm = -cv/cp, g=8.87) + integer k, it, nl + real qvf, qvf1, dz + + LOGICAL :: direct_from_file + + IF (planet == "mars") THEN + direct_from_file = .false. + ELSE + direct_from_file = .true. + ENDIF + +! first, read the sounding + + call read_sounding( p_surf, th_surf, qv_surf, & + h_input, th_input, qv_input, & + u_input, v_input,n, nl, debug ) + +! and the therm : + + call read_therm(r_therm,cp_therm,p_therm,rho_therm,t_therm,n) + + if(debug) write(6,*) ' number of input levels = ',nl + nl_in = nl + if(nl_in .gt. nl_max ) then + write(6,*) ' too many levels for input arrays ',nl_in,nl_max + call wrf_error_fatal ( ' too many levels for input arrays ' ) + end if + + IF (.NOT. direct_from_file) THEN + +! To use r/cp as defined above, one has to recompute teta from T (default MCD computes +! teta for a variable r/cp) + + do k=1,nl + th_input(k) = t_therm(k)*(p1000mb/p_therm(k))**(rcp) + enddo + th_surf = t_therm(1)*(p1000mb/p_therm(1))**(rcp) +! ----- + + !if(dry) then + ! do k=1,nl + ! qv_input(k) = 0. + ! enddo + !endif + +! compute diagnostics, +! first, convert qv(g/kg) to qv(g/g) + + do k=1,nl + !!!!!!!!!!!!!! MARS + !! from mol/mol to kg/kg + qv_input(k) = qv_input(k)*18./mwdry + qv_input(k) = 0.001*qv_input(k) + enddo + + p_surf = 100.*p_surf ! convert to pascals + qvf = 1. + rvovrd*qv_input(1) +!!MARS + qvf = 1. + rho_surf = 1./((r_d/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm)) + pi_surf = (p_surf/p1000mb)**(rcp) + + if(debug) then + write(6,*) ' surface density is ',rho_surf + write(6,*) ' surface pi is ',pi_surf + end if + + +! integrate moist sounding hydrostatically, starting from the +! specified surface pressure +! -> first, integrate from surface to lowest level + + qvf = 1. + rvovrd*qv_input(1) + qvf1 = 1. + qv_input(1) +!!MARS + qvf = 1. + qvf1 = 1. + rho_input(1) = rho_surf + dz = h_input(1) + do it=1,10 +! pm_input(1) = p_surf & +! - 0.5*dz*(rho_surf+rho_input(1))*g*qvf1 +!!!MARS MARS MARS + pm_input(1) = p_surf + rho_input(1) = 1./((r_d/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm)) + enddo + +! integrate up the column + + do k=2,nl + rho_input(k) = rho_input(k-1) + dz = h_input(k)-h_input(k-1) + qvf1 = 0.5*(2.+(qv_input(k-1)+qv_input(k))) + qvf = 1. + rvovrd*qv_input(k) ! qv is in g/kg here +!!MARS + qvf = 1. + qvf1 = 1. +!!MARS + + do it=1,10 + pm_input(k) = pm_input(k-1) & + - 0.5*dz*(rho_input(k)+rho_input(k-1))*g*qvf1 + rho_input(k) = 1./((r_d/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm)) + enddo + enddo + +! we have the moist sounding + +! next, compute the dry sounding using p at the highest level from the +! moist sounding and integrating down. + + p_input(nl) = pm_input(nl) + + do k=nl-1,1,-1 + dz = h_input(k+1)-h_input(k) + p_input(k) = p_input(k+1) + 0.5*dz*(rho_input(k)+rho_input(k+1))*g + enddo + + ELSE !IF (.NOT. direct_from_file) THEN + + do k=1,nl + !!!! direct input from file + write(6,*) '*** DIRECT INPUT FROM FILE ***' + pm_input(k) = p_therm(k) + p_input(k) = p_therm(k) + rho_input(k) = rho_therm(k) + enddo + + ENDIF + + + do k=1,nl + + zk(k) = h_input(k) + p(k) = pm_input(k) + p_dry(k) = p_input(k) + theta(k) = th_input(k) + rho(k) = rho_input(k) + u(k) = u_input(k) + v(k) = v_input(k) + qv(k) = qv_input(k) + + enddo + + if(debug) then + write(6,*) ' sounding ' + write(6,*) ' k height(m) press (Pa) pd(Pa) theta (K) den(kg/m^3) u(m/s) v(m/s) qv(g/g) ' + do k=1,nl + write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), p_dry(k), theta(k), rho(k), u(k), v(k), qv(k) + enddo + + end if + + end subroutine get_sounding + +!------------------------------------------------------- + + subroutine read_sounding( ps,ts,qvs,h,th,qv,u,v,n,nl,debug ) + implicit none + integer n,nl + real ps,ts,qvs,h(n),th(n),qv(n),u(n),v(n) + logical end_of_file + logical debug + + integer k + + open(unit=10,file='input_sounding',form='formatted',status='old') + rewind(10) + read(10,*) ps, ts, qvs + if(debug) then + write(6,*) ' input sounding surface parameters ' + write(6,*) ' surface pressure (mb) ',ps + write(6,*) ' surface pot. temp (K) ',ts + write(6,*) ' surface mixing ratio (g/kg) ',qvs + end if + + end_of_file = .false. + k = 0 + + do while (.not. end_of_file) + + read(10,*,end=100) h(k+1), th(k+1), qv(k+1), u(k+1), v(k+1) + k = k+1 + if(debug) write(6,'(1x,i3,5(1x,e10.3))') k, h(k), th(k), qv(k), u(k), v(k) + go to 110 + 100 end_of_file = .true. + 110 continue + enddo + + nl = k + + close(unit=10,status = 'keep') + + end subroutine read_sounding + + subroutine read_therm(r,cp,p,rho,t,n) + implicit none + integer n + real r(n),cp(n),p(n),rho(n),t(n) + logical end_of_file + + integer k + +! first element is the surface + + open(unit=11,file='input_therm',form='formatted',status='old') + rewind(11) + end_of_file = .false. + k = 0 + do while (.not. end_of_file) + + read(11,*,end=101) r(k+1), cp(k+1), p(k+1), rho(k+1), t(k+1) + write(*,*) k, r(k+1), cp(k+1), p(k+1), rho(k+1), t(k+1) + k = k+1 + go to 112 + 101 end_of_file = .true. + 112 continue + enddo + + close(unit=11,status = 'keep') + + end subroutine read_therm + +!!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + subroutine read_dust(pdustq,pdustn,n) + implicit none + integer n + real pdustq(n+1),pdustn(n+1) + logical end_of_file + + integer k + +! first element is the surface + + open(unit=11,file='input_dust',form='formatted',status='old') + rewind(11) + end_of_file = .false. + k = 0 + do while (.not. end_of_file) + + read(11,*,end=102) pdustq(k+1),pdustn(k+1) + write(*,*) k,pdustq(k+1),pdustn(k+1) + k = k+1 + go to 113 + 102 end_of_file = .true. + 113 continue + enddo + + close(unit=11,status = 'keep') + + end subroutine read_dust +!!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + subroutine read_hr(hr_sw,hr_lw,hr_dyn,n) + implicit none + integer n + real hr_sw(n+1),hr_lw(n+1),hr_dyn(n+1) + logical end_of_file + + integer k + +! first element is the surface + + open(unit=11,file='input_hr',form='formatted',status='old') + rewind(11) + end_of_file = .false. + k = 0 + do while (.not. end_of_file) + + read(11,*,end=103) hr_sw(k+1),hr_lw(k+1),hr_dyn(k+1) + write(*,*) k,hr_sw(k+1),hr_lw(k+1),hr_dyn(k+1) + k = k+1 + go to 114 + 103 end_of_file = .true. + 114 continue + enddo + + close(unit=11,status = 'keep') + + end subroutine read_hr + + subroutine read_lsf(dt,dq,n) + implicit none + integer n + real dt(n+1),dq(n+1) + logical end_of_file + + integer k + +! first element is the surface + + open(unit=12,file='input_lsf',form='formatted',status='old') + rewind(12) + end_of_file = .false. + k = 0 + do while (.not. end_of_file) + + read(12,*,end=103) dt(k+1),dq(k+1) + write(*,*) k,dt(k+1),dq(k+1) + k = k+1 + go to 114 + 103 end_of_file = .true. + 114 continue + enddo + + close(unit=12,status = 'keep') + + end subroutine read_lsf + + subroutine read_tracer(trace,nq,qn,n) + implicit none + integer n,qn,nq ! qn : number of the tracer + real*8 tra(nq-1,n+1) + real*8 trace(n+1) !output + logical end_of_file + + integer k,j + +! first element is the surface + open(unit=14,file='input_tracer',form='formatted',status='old') + rewind(14) + end_of_file = .false. + DO k=1,n + read(14,*) tra(:,k) + write(*,*) k,tra(qn,k) + ENDDO + + close(14) + trace(:)=tra(qn,:) + end subroutine read_tracer + + +END MODULE module_initialize_ideal Index: /trunk/WRF.COMMON/WRFV3/dyn_em/solve_em.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/dyn_em/solve_em.F (revision 2761) +++ /trunk/WRF.COMMON/WRFV3/dyn_em/solve_em.F (revision 2761) @@ -0,0 +1,3258 @@ +!WRF:MEDIATION_LAYER:SOLVER + +SUBROUTINE solve_em ( grid , config_flags & +! Arguments generated from Registry +#include "dummy_new_args.inc" +! + ) +! Driver layer modules + USE module_state_description + USE module_domain, ONLY : domain, get_ijk_from_grid, get_ijk_from_subgrid, domain_get_current_time, domain_get_start_time + USE module_configure, ONLY : grid_config_rec_type + USE module_driver_constants + USE module_machine + USE module_tiles, ONLY : set_tiles +#ifdef DM_PARALLEL + USE module_dm, ONLY : local_communicator, mytask, ntasks, ntasks_x, ntasks_y, local_communicator_periodic, wrf_dm_maxval +#else + USE module_dm +#endif + USE module_comm_dm + USE module_utility +! Mediation layer modules +! Model layer modules + USE module_model_constants + USE module_small_step_em + USE module_em + USE module_big_step_utilities_em + USE module_bc + USE module_bc_em + USE module_solvedebug_em + USE module_physics_addtendc + USE module_diffusion_em + USE module_polarfft +!!!!****MARS MARS +!!!!****MARS MARS +! USE module_microphysics_driver +! USE module_microphysics_zero_out +! USE module_fddaobs_driver +! USE module_diagnostics +#ifdef WRF_CHEM + USE module_input_chem_data + USE module_chem_utilities +#endif + USE module_first_rk_step_part1 + USE module_first_rk_step_part2 + USE module_llxy, ONLY : proj_cassini + + IMPLICIT NONE + + ! Input data. + + TYPE(domain) , TARGET :: grid + + ! Definitions of dummy arguments to this routine (generated from Registry). +#include "dummy_new_decl.inc" + + ! Structure that contains run-time configuration (namelist) data for domain + TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags + + ! Local data + + INTEGER :: k_start , k_end, its, ite, jts, jte + INTEGER :: ids , ide , jds , jde , kds , kde , & + ims , ime , jms , jme , kms , kme , & + ips , ipe , jps , jpe , kps , kpe + + INTEGER :: sids , side , sjds , sjde , skds , skde , & + sims , sime , sjms , sjme , skms , skme , & + sips , sipe , sjps , sjpe , skps , skpe + + + INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, & + ipsx, ipex, jpsx, jpex, kpsx, kpex, & + imsy, imey, jmsy, jmey, kmsy, kmey, & + ipsy, ipey, jpsy, jpey, kpsy, kpey + + INTEGER :: ij , iteration + INTEGER :: im , num_3d_m , ic , num_3d_c , is , num_3d_s + INTEGER :: loop + INTEGER :: sz + INTEGER :: iswater + + LOGICAL :: specified_bdy, channel_bdy + + REAL :: t_new + +! storage for tendencies and decoupled state (generated from Registry) + +#include +! Previous time level of tracer arrays now defined as i1 variables; +! the state 4d arrays now redefined as 1-time level arrays in Registry. +! Benefit: save memory in nested runs, since only 1 domain is active at a +! time. Potential problem on stack-limited architectures: increases +! amount of data on program stack by making these automatic arrays. + + INTEGER :: rc + INTEGER :: number_of_small_timesteps, rk_step + INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2 ! for prints/plots only + INTEGER :: idum1, idum2, dynamics_option + + INTEGER :: rk_order, iwmax, jwmax, kwmax + REAL :: dt_rk, dts_rk, dts, dtm, wmax + REAL , ALLOCATABLE , DIMENSION(:) :: max_vert_cfl_tmp, max_horiz_cfl_tmp + LOGICAL :: leapfrog + INTEGER :: l,kte,kk + REAL :: curr_secs + INTEGER :: num_sound_steps + INTEGER :: idex, jdex + REAL :: max_msft + REAL :: spacing + + INTEGER :: ii, jj !kk is above after l,kte + REAL :: dclat + INTEGER :: debug_level + +! urban related variables + INTEGER :: NUM_ROOF_LAYERS, NUM_WALL_LAYERS, NUM_ROAD_LAYERS ! urban + + TYPE(WRFU_TimeInterval) :: tmpTimeInterval + REAL :: real_time + LOGICAL :: adapt_step_flag + +! Define benchmarking timers if -DBENCH is compiled +#include + +!---------------------- +! Executable statements +!---------------------- + +! +!
+! solve_em is the main driver for advancing a grid a single timestep.
+! It is a mediation-layer routine -> DM and SM calls are made where 
+! needed for parallel processing.  
+!
+! solve_em can integrate the equations using 3 time-integration methods
+!      
+!    - 3rd order Runge-Kutta time integration (recommended)
+!      
+!    - 2nd order Runge-Kutta time integration
+!      
+! The main sections of solve_em are
+!     
+! (1) Runge-Kutta (RK) loop
+!     
+! (2) Non-timesplit physics (i.e., tendencies computed for updating
+!     model state variables during the first RK sub-step (loop)
+!     
+! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
+!     
+! (4) scalar advance for moist and chem scalar variables (and TKE)
+!     within the RK sub-steps.
+!     
+! (5) time-split physics (after the RK step), currently this includes
+!     only microphyics
+!
+! A more detailed description of these sections follows.
+!
+! + +! Initialize timers if compiled with -DBENCH +#include + +! set runge-kutta solver (2nd or 3rd order) + + dynamics_option = config_flags%rk_ord + +! Obtain dimension information stored in the grid data structure. + + CALL get_ijk_from_grid ( grid , & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + imsx, imex, jmsx, jmex, kmsx, kmex, & + ipsx, ipex, jpsx, jpex, kpsx, kpex, & + imsy, imey, jmsy, jmey, kmsy, kmey, & + ipsy, ipey, jpsy, jpey, kpsy, kpey ) + + CALL get_ijk_from_subgrid ( grid , & + sids, side, sjds, sjde, skds, skde, & + sims, sime, sjms, sjme, skms, skme, & + sips, sipe, sjps, sjpe, skps, skpe ) + k_start = kps + k_end = kpe + + num_3d_m = num_moist + num_3d_c = num_chem + num_3d_s = num_scalar + + +! Compute these starting and stopping locations for each tile and number of tiles. +! See: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles + CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe ) + +! Max values of CFL for adaptive time step scheme + + ALLOCATE (max_vert_cfl_tmp(grid%num_tiles)) + ALLOCATE (max_horiz_cfl_tmp(grid%num_tiles)) + + grid%itimestep = grid%itimestep + 1 + + IF (config_flags%polar) dclat = 90./REAL(jde-jds) !(0.5 * 180/ny) + +!********************************************************************** +! +! LET US BEGIN....... +! +! +!
+! (1) RK integration loop is named the "Runge_Kutta_loop:"
+!
+!   Predictor-corrector type time integration.
+!   Advection terms are evaluated at time t for the predictor step,
+!   and advection is re-evaluated with the latest predicted value for
+!   each succeeding time corrector step
+!
+!   2nd order Runge Kutta (rk_order = 2):
+!   Step 1 is taken to the midpoint predictor, step 2 is the full step.
+!
+!   3rd order Runge Kutta (rk_order = 3):
+!   Step 1 is taken to from t to dt/3, step 2 is from t to dt/2,
+!   and step 3 is from t to dt.
+!
+!   non-timesplit physics are evaluated during first RK step and
+!   these physics tendencies are stored for use in each RK pass.
+!
+! +!********************************************************************** + +#ifdef WRF_CHEM +! +! prepare chem aerosols for advection before communication +! + + kte=min(k_end,kde-1) +# ifdef DM_PARALLEL + if ( num_chem >= PARAM_FIRST_SCALAR ) then +!----------------------------------------------------------------------- +! see matching halo calls below for stencils +!-------------------------------------------------------------- + CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' ) + IF ( config_flags%h_mom_adv_order <= 4 ) THEN +# include "HALO_EM_CHEM_E_3.inc" + IF( config_flags%progn > 0 ) THEN +# include "HALO_EM_SCALAR_E_3.inc" + ENDIF + ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN +# include "HALO_EM_CHEM_E_5.inc" + IF( config_flags%progn > 0 ) THEN +# include "HALO_EM_SCALAR_E_5.inc" + ENDIF + ELSE + WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order + CALL wrf_error_fatal(TRIM(wrf_err_message)) + ENDIF + ENDIF +# endif +!-------------------------------------------------------------- +#endif + + rk_order = config_flags%rk_ord + + + ! + ! Calculate current time in seconds since beginning of model run. + ! Unfortunately, ESMF does not seem to have a way to return + ! floating point seconds based on a TimeInterval. So, we will + ! calculate it here--but, this is not clean!! + ! + tmpTimeInterval = domain_get_current_time ( grid ) - domain_get_start_time ( grid ) + curr_secs = real_time(tmpTimeInterval) + +!----------------------------------------------------------------------------- +! Adaptive time step: Added by T. Hutchinson, WSI 3/5/07 +! In this call, we do the time-step adaptation and set time-dependent lateral +! boundary condition nudging weights. +! + IF (config_flags%use_adaptive_time_step) THEN + CALL adapt_timestep(grid, config_flags) + adapt_step_flag = .TRUE. + ELSE + adapt_step_flag = .FALSE. + ENDIF +! End of adaptive time step modifications +!----------------------------------------------------------------------------- + + IF ( grid%time_step_sound == 0 ) THEN +! This function will give 4 for 6*dx and 6 for 10*dx and returns even numbers only + spacing = min(grid%dx, grid%dy) + IF ( ( config_flags%use_adaptive_time_step ) .AND. ( config_flags%map_proj == PROJ_CASSINI ) ) THEN + max_msft=MIN ( MAX(grid%max_msftx, grid%max_msfty) , & + 1.0/COS(config_flags%fft_filter_lat*degrad) ) + num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 ) + ELSE IF ( config_flags%use_adaptive_time_step ) THEN + max_msft= MAX(grid%max_msftx, grid%max_msfty) + num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 ) + ELSE + num_sound_steps = max ( 2 * ( INT (300. * grid%dt / spacing - 0.01 ) + 1 ), 4 ) + END IF + WRITE(wrf_err_message,*)'grid spacing, dt, time_step_sound=',spacing,grid%dt,num_sound_steps + CALL wrf_debug ( 50 , wrf_err_message ) + ELSE + num_sound_steps = grid%time_step_sound + ENDIF + + IF (config_flags%use_adaptive_time_step) THEN + + CALL get_wrf_debug_level( debug_level ) + IF ((config_flags%time_step < 0) .AND. (debug_level.GE.50)) THEN +#ifdef DM_PARALLEL + CALL wrf_dm_maxval(grid%max_vert_cfl, idex, jdex) +#endif + WRITE(wrf_err_message,*)'variable dt, max horiz cfl, max vert cfl: ',& + grid%dt, grid%max_horiz_cfl, grid%max_vert_cfl + CALL wrf_debug ( 0 , wrf_err_message ) + ENDIF + + grid%max_cfl_val = 0 + grid%max_horiz_cfl = 0 + grid%max_vert_cfl = 0 + ENDIF + + dts = grid%dt/float(num_sound_steps) + + Runge_Kutta_loop: DO rk_step = 1, rk_order + + ! Set the step size and number of small timesteps for + ! each part of the timestep + + dtm = grid%dt + IF ( rk_order == 1 ) THEN + + write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option + CALL wrf_error_fatal( wrf_err_message ) + + ELSE IF ( rk_order == 2 ) THEN ! 2nd order Runge-Kutta timestep + + IF ( rk_step == 1) THEN + dt_rk = 0.5*grid%dt + dts_rk = dts + number_of_small_timesteps = num_sound_steps/2 + ELSE + dt_rk = grid%dt + dts_rk = dts + number_of_small_timesteps = num_sound_steps + ENDIF + + ELSE IF ( rk_order == 3 ) THEN ! third order Runge-Kutta + + IF ( rk_step == 1) THEN + dt_rk = grid%dt/3. + dts_rk = dt_rk + number_of_small_timesteps = 1 + ELSE IF (rk_step == 2) THEN + dt_rk = 0.5*grid%dt + dts_rk = dts + number_of_small_timesteps = num_sound_steps/2 + ELSE + dt_rk = grid%dt + dts_rk = dts + number_of_small_timesteps = num_sound_steps + ENDIF + + ELSE + + write(wrf_err_message,*)' unknown solver, error exit for dynamics_option = ',dynamics_option + CALL wrf_error_fatal( wrf_err_message ) + + END IF + +! Ensure that polar meridional velocity is zero + IF (config_flags%polar) THEN + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + DO ij = 1 , grid%num_tiles + CALL zero_pole ( grid%v_1, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start, k_end ) + CALL zero_pole ( grid%v_2, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start, k_end ) + END DO + !$OMP END PARALLEL DO + END IF +! +! Time level t is in the *_2 variable in the first part +! of the step, and in the *_1 variable after the predictor. +! the latest predicted values are stored in the *_2 variables. +! + CALL wrf_debug ( 200 , ' call rk_step_prep ' ) + +BENCH_START(step_prep_tim) + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij ) + + DO ij = 1 , grid%num_tiles + + CALL rk_step_prep ( config_flags, rk_step, & + grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2, grid%mu_2, & + moist, & + grid%ru, grid%rv, grid%rw, grid%ww, grid%php, grid%alt, grid%muu, grid%muv, & + grid%mub, grid%mut, grid%phb, grid%pb, grid%p, grid%al, grid%alb, & + cqu, cqv, cqw, & + grid%msfux, grid%msfuy, grid%msfvx, grid%msfvx_inv, & + grid%msfvy, grid%msftx, grid%msfty, & + grid%fnm, grid%fnp, grid%dnw, grid%rdx, grid%rdy, & + num_3d_m, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start, k_end ) + + END DO + !$OMP END PARALLEL DO +BENCH_END(step_prep_tim) + +#ifdef DM_PARALLEL +!----------------------------------------------------------------------- +! Stencils for patch communications (WCS, 29 June 2001) +! Note: the small size of this halo exchange reflects the +! fact that we are carrying the uncoupled variables +! as state variables in the mass coordinate model, as +! opposed to the coupled variables as in the height +! coordinate model. +! +! * * * * * +! * * * * * * * * * +! * + * * + * * * + * * +! * * * * * * * * * +! * * * * * +! +! 3D variables - note staggering! ru(X), rv(Y), ww(Z), php(Z) +! +! ru x +! rv x +! ww x +! php x +! alt x +! ph_2 x +! phb x +! +! the following are 2D (xy) variables +! +! muu x +! muv x +! mut x +!-------------------------------------------------------------- +# include "HALO_EM_A.inc" +#endif + +! set boundary conditions on variables +! from big_step_prep for use in big_step_proc + +#ifdef DM_PARALLEL +# include "PERIOD_BDY_EM_A.inc" +#endif + +BENCH_START(set_phys_bc_tim) + !$OMP PARALLEL DO & + !$OMP PRIVATE ( ij, ii, jj, kk ) + + DO ij = 1 , grid%num_tiles + + CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' ) + + CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww, & + grid%muu, grid%muv, grid%mut, grid%php, grid%alt, grid%p, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start, k_end ) + CALL set_physical_bc3d( grid%al, 'p', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start , k_end ) + CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start, k_end ) + + IF (config_flags%polar) THEN + +!------------------------------------------------------- +! lat-lon grid pole-point (v) specification (extrapolate v, rv to the pole) +!------------------------------------------------------- + + CALL pole_point_bc ( grid%v_1, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start, k_end ) + + CALL pole_point_bc ( grid%v_2, & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + grid%i_start(ij), grid%i_end(ij), & + grid%j_start(ij), grid%j_end(ij), & + k_start, k_end ) + +!------------------------------------------------------- +! end lat-lon grid pole-point (v) specification +!------------------------------------------------------- + + ENDIF + END DO + !$OMP END PARALLEL DO +BENCH_END(set_phys_bc_tim) + + rk_step_is_one : IF (rk_step == 1) THEN ! only need to initialize diffusion tendencies + +! +!
+!(2) The non-timesplit physics begins with a call to "phy_prep"
+!    (which computes some diagnostic variables such as temperature,
+!    pressure, u and v at p points, etc).  This is followed by
+!    calls to the physics drivers:
+!
+!              radiation,
+!              surface,
+!              pbl,
+!              cumulus,
+!              fddagd,
+!              3D TKE and mixing.
+!
+!
+
+       CALL first_rk_step_part1 (    grid, config_flags         &
+                             , moist , moist_tend               &
+                             , chem  , chem_tend                &
+                             , scalar , scalar_tend             &
+                             , fdda3d, fdda2d                   &
+                             , ru_tendf, rv_tendf               &
+                             , rw_tendf, t_tendf                &
+                             , ph_tendf, mu_tendf               &
+                             , tke_tend                         &
+                             , adapt_step_flag , curr_secs      &
+                             , psim , psih , wspd , gz1oz0      &
+                             , br , chklowq                     &
+                             , cu_act_flag , hol , th_phy       &
+                             , pi_phy , p_phy , t_phy           &
+                             , u_phy , v_phy                    &
+                             , dz8w , p8w , t8w , rho_phy , rho &
+                             , z_at_w , mu_3d                   &
+                             , ids, ide, jds, jde, kds, kde     &
+                             , ims, ime, jms, jme, kms, kme     &
+                             , ips, ipe, jps, jpe, kps, kpe     &
+                             , k_start , k_end                  &
+                            )
+
+       CALL first_rk_step_part2 (    grid, config_flags         &
+                             , moist , moist_tend               &
+                             , chem  , chem_tend                &
+                             , scalar , scalar_tend             &
+                             , fdda3d, fdda2d                   &
+                             , ru_tendf, rv_tendf               &
+                             , rw_tendf, t_tendf                &
+                             , ph_tendf, mu_tendf               &
+                             , tke_tend                         &
+                             , adapt_step_flag , curr_secs      &
+                             , psim , psih , wspd , gz1oz0      &
+                             , br , chklowq                     &
+                             , cu_act_flag , hol , th_phy       &
+                             , pi_phy , p_phy , t_phy           &
+                             , u_phy , v_phy                    &
+                             , dz8w , p8w , t8w , rho_phy , rho &
+                             , z_at_w , mu_3d                   &
+                             , ids, ide, jds, jde, kds, kde     &
+                             , ims, ime, jms, jme, kms, kme     &
+                             , ips, ipe, jps, jpe, kps, kpe     &
+                             , k_start , k_end                  &
+                            )
+
+     END IF rk_step_is_one
+
+BENCH_START(rk_tend_tim)
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+
+       CALL wrf_debug ( 200 , ' call rk_tendency' )
+       CALL rk_tendency ( config_flags, rk_step                                                                &
+                         ,grid%ru_tend, grid%rv_tend, rw_tend, ph_tend, t_tend                                 &
+                         ,ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf                                      &
+                         ,mu_tend, grid%u_save, grid%v_save, w_save, ph_save                                   &
+                         ,grid%t_save, mu_save, grid%rthften                                                   &
+                         ,grid%ru, grid%rv, grid%rw, grid%ww                                                   &
+                         ,grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2                                    &
+                         ,grid%u_1, grid%v_1, grid%w_1, grid%t_1, grid%ph_1                                    &
+                         ,grid%h_diabatic, grid%phb, grid%t_init                                               &
+                         ,grid%mu_2, grid%mut, grid%muu, grid%muv, grid%mub                                    &
+                         ,grid%al, grid%alt, grid%p, grid%pb, grid%php, cqu, cqv, cqw                          &
+                         ,grid%u_base, grid%v_base, grid%t_base, grid%qv_base, grid%z_base                     &
+                         ,grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv                                    &
+                         ,grid%msfvy, grid%msftx,grid%msfty, grid%xlat, grid%f, grid%e, grid%sina, grid%cosa   &
+                         ,grid%fnm, grid%fnp, grid%rdn, grid%rdnw                                              &
+                         ,grid%dt, grid%rdx, grid%rdy, grid%khdif, grid%kvdif, grid%xkmh, grid%xkhh            &
+                         ,grid%diff_6th_opt, grid%diff_6th_factor                                              &
+                         ,grid%dampcoef,grid%zdamp,config_flags%damp_opt                                       &
+                         ,grid%cf1, grid%cf2, grid%cf3, grid%cfn, grid%cfn1, num_3d_m                          &
+                         ,config_flags%non_hydrostatic, config_flags%top_lid                                   &
+                         ,grid%u_frame, grid%v_frame                                                           &
+                         ,ids, ide, jds, jde, kds, kde                                                         &
+                         ,ims, ime, jms, jme, kms, kme                                                         &
+                         ,grid%i_start(ij), grid%i_end(ij)                                                     &
+                         ,grid%j_start(ij), grid%j_end(ij)                                                     &
+                         ,k_start, k_end                                                                       &
+                         ,max_vert_cfl_tmp(ij), max_horiz_cfl_tmp(ij)                                         )
+     END DO
+     !$OMP END PARALLEL DO
+BENCH_END(rk_tend_tim)
+
+     IF (config_flags%use_adaptive_time_step) THEN
+       DO ij = 1 , grid%num_tiles
+         IF (max_horiz_cfl_tmp(ij) .GT. grid%max_horiz_cfl) THEN
+           grid%max_horiz_cfl = max_horiz_cfl_tmp(ij)
+         ENDIF
+         IF (max_vert_cfl_tmp(ij) .GT. grid%max_vert_cfl) THEN
+           grid%max_vert_cfl = max_vert_cfl_tmp(ij)
+         ENDIF
+       END DO
+     
+       IF (grid%max_horiz_cfl .GT. grid%max_cfl_val) THEN
+         grid%max_cfl_val = grid%max_horiz_cfl
+       ENDIF
+       IF (grid%max_vert_cfl .GT. grid%max_cfl_val) THEN
+         grid%max_cfl_val = grid%max_vert_cfl
+       ENDIF
+     ENDIF
+
+BENCH_START(relax_bdy_dry_tim)
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+
+       IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN 
+
+         CALL relax_bdy_dry ( config_flags,                                &
+                              grid%u_save, grid%v_save, ph_save, grid%t_save,             &
+                              w_save, mu_tend,                             & 
+                              grid%ru, grid%rv, grid%ph_2, grid%t_2,                           &
+                              grid%w_2, grid%mu_2, grid%mut,                              &
+                              grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
+                              grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
+                              grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
+                              grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
+                              grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
+                              grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
+                              grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
+                              grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
+                              grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
+                              grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
+                              grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
+                              grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
+                              config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone,       &
+                              grid%dtbc, grid%fcx, grid%gcx,                              &
+                              ids,ide, jds,jde, kds,kde,                   &
+                              ims,ime, jms,jme, kms,kme,                   &
+                              ips,ipe, jps,jpe, kps,kpe,                   &
+                              grid%i_start(ij), grid%i_end(ij),            &
+                              grid%j_start(ij), grid%j_end(ij),            &
+                              k_start, k_end                              )
+
+       ENDIF
+
+       CALL rk_addtend_dry( grid%ru_tend,  grid%rv_tend,  rw_tend,  ph_tend,  t_tend,  &
+                            ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
+                            grid%u_save, grid%v_save, w_save, ph_save, grid%t_save, &
+                            mu_tend, mu_tendf, rk_step,                      &
+                            grid%h_diabatic, grid%mut, grid%msftx,        &
+                            grid%msfty, grid%msfux,grid%msfuy,               &
+                            grid%msfvx, grid%msfvx_inv, grid%msfvy,          &
+                            ids,ide, jds,jde, kds,kde,                       &
+                            ims,ime, jms,jme, kms,kme,                       &
+                            ips,ipe, jps,jpe, kps,kpe,                       &
+                            grid%i_start(ij), grid%i_end(ij),                &
+                            grid%j_start(ij), grid%j_end(ij),                &
+                            k_start, k_end                                  )
+
+       IF( config_flags%specified .or. config_flags%nested ) THEN 
+         CALL spec_bdy_dry ( config_flags,                                    &
+                             grid%ru_tend, grid%rv_tend, ph_tend, t_tend,               &
+                             rw_tend, mu_tend,                                &
+                             grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
+                             grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
+                             grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
+                             grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
+                             grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
+                             grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
+                             grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
+                             grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
+                             grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
+                             grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
+                             grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
+                             grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
+                             config_flags%spec_bdy_width, grid%spec_zone,                       &
+                             ids,ide, jds,jde, kds,kde,  & ! domain dims
+                             ims,ime, jms,jme, kms,kme,  & ! memory dims
+                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                             grid%i_start(ij), grid%i_end(ij),                &
+                             grid%j_start(ij), grid%j_end(ij),                &
+                             k_start, k_end                                  )
+     
+       ENDIF
+
+     END DO
+     !$OMP END PARALLEL DO
+BENCH_END(relax_bdy_dry_tim)
+
+!
+!
+! (3) Small (acoustic,sound) steps.
+!
+!    Several acoustic steps are taken each RK pass.  A small step 
+!    sequence begins with calculating perturbation variables 
+!    and coupling them to the column dry-air-mass mu 
+!    (call to small_step_prep).  This is followed by computing
+!    coefficients for the vertically implicit part of the
+!    small timestep (call to calc_coef_w).  
+!
+!    The small steps are taken
+!    in the named loop "small_steps:".  In the small_steps loop, first 
+!    the horizontal momentum (u and v) are advanced (call to advance_uv),
+!    next mu and theta are advanced (call to advance_mu_t) followed by
+!    advancing w and the geopotential (call to advance_w).  Diagnostic
+!    values for pressure and inverse density are updated at the end of
+!    each small_step.
+!
+!    The small-step section ends with the change of the perturbation variables
+!    back to full variables (call to small_step_finish).
+!

+!
+
+BENCH_START(small_step_prep_tim)
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+
+    ! Calculate coefficients for the vertically implicit acoustic/gravity wave
+    ! integration.  We only need calculate these for the first pass through -
+    ! the predictor step.  They are reused as is for the corrector step.
+    ! For third-order RK, we need to recompute these after the first 
+    ! predictor because we may have changed the small timestep -> grid%dts.
+
+       CALL wrf_debug ( 200 , ' call small_step_prep ' )
+
+       CALL small_step_prep( grid%u_1,grid%u_2,grid%v_1,grid%v_2,grid%w_1,grid%w_2,   &
+                             grid%t_1,grid%t_2,grid%ph_1,grid%ph_2,                   &
+                             grid%mub, grid%mu_1, grid%mu_2,                          &
+                             grid%muu, muus, grid%muv, muvs,                          &
+                             grid%mut, grid%muts, grid%mudf,                          &
+                             grid%u_save, grid%v_save, w_save,                        &
+                             grid%t_save, ph_save, mu_save,                           &
+                             grid%ww, ww1,                                            &
+                             grid%dnw, c2a, grid%pb, grid%p, grid%alt,                &
+                             grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,       &
+                             grid%msfvy, grid%msftx,grid%msfty,                       &
+                             grid%rdx, grid%rdy, rk_step,                             &
+                             ids, ide, jds, jde, kds, kde,                            &
+                             ims, ime, jms, jme, kms, kme,                            &
+                             grid%i_start(ij), grid%i_end(ij),                        &
+                             grid%j_start(ij), grid%j_end(ij),                        &
+                             k_start    , k_end                                       )
+ 
+       CALL calc_p_rho( grid%al, grid%p, grid%ph_2,                 &
+                        grid%alt, grid%t_2, grid%t_save, c2a, pm1,  &
+                        grid%mu_2, grid%muts, grid%znu, t0,         &
+                        grid%rdnw, grid%dnw, grid%smdiv,            &
+                        config_flags%non_hydrostatic, 0,            &
+                        ids, ide, jds, jde, kds, kde,               &
+                        ims, ime, jms, jme, kms, kme,               &
+                        grid%i_start(ij), grid%i_end(ij),           &
+                        grid%j_start(ij), grid%j_end(ij),           &
+                        k_start    , k_end                          )
+
+       IF (config_flags%non_hydrostatic) THEN
+         CALL calc_coef_w( a,alpha,gamma,                    &
+                           grid%mut, cqw,                    &
+                           grid%rdn, grid%rdnw, c2a,         &
+                           dts_rk, g, grid%epssm,            &
+                           config_flags%top_lid,             &
+                           ids, ide, jds, jde, kds, kde,     &
+                           ims, ime, jms, jme, kms, kme,     &
+                           grid%i_start(ij), grid%i_end(ij), &
+                           grid%j_start(ij), grid%j_end(ij), &
+                           k_start    , k_end               )
+       ENDIF
+
+     ENDDO
+     !$OMP END PARALLEL DO
+BENCH_END(small_step_prep_tim)
+
+#ifdef DM_PARALLEL
+!-----------------------------------------------------------------------
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!  Note:  the small size of this halo exchange reflects the 
+!         fact that we are carrying the uncoupled variables 
+!         as state variables in the mass coordinate model, as
+!         opposed to the coupled variables as in the height
+!         coordinate model.
+!
+!                              * * * * *
+!            *        * * *    * * * * *
+!          * + *      * + *    * * + * * 
+!            *        * * *    * * * * *
+!                              * * * * *
+!
+!  3D variables - note staggering!  ph_2(Z), u_save(X), v_save(Y)
+!
+!  ph_2      x
+!  al        x
+!  p         x
+!  t_1       x
+!  t_save    x
+!  u_save    x
+!  v_save    x
+!
+!  the following are 2D (xy) variables
+!
+!  mu_1      x
+!  mu_2      x
+!  mudf      x
+!  php       x
+!  alt       x
+!  pb        x
+!--------------------------------------------------------------
+#      include "HALO_EM_B.inc"
+#      include "PERIOD_BDY_EM_B.inc"
+#endif
+
+BENCH_START(set_phys_bc2_tim)
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+
+     DO ij = 1 , grid%num_tiles
+
+       CALL set_physical_bc3d( grid%ru_tend, 'u', config_flags,      &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc3d( grid%rv_tend, 'v', config_flags,      &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc3d( grid%ph_2, 'w', config_flags,         &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc3d( grid%al, 'p', config_flags,           &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc3d( grid%p, 'p', config_flags,            &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc3d( grid%t_1, 'p', config_flags,          &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc3d( grid%t_save, 't', config_flags,       &
+                               ids, ide, jds, jde, kds, kde,         &
+                               ims, ime, jms, jme, kms, kme,         &
+                               ips, ipe, jps, jpe, kps, kpe,         &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij),     &
+                               k_start    , k_end                    )
+
+       CALL set_physical_bc2d( grid%mu_1, 't', config_flags,         &
+                               ids, ide, jds, jde,                   &
+                               ims, ime, jms, jme,                   &
+                               ips, ipe, jps, jpe,                   &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij)      )
+
+       CALL set_physical_bc2d( grid%mu_2, 't', config_flags,         &
+                               ids, ide, jds, jde,                   &
+                               ims, ime, jms, jme,                   &
+                               ips, ipe, jps, jpe,                   &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij)      )
+
+       CALL set_physical_bc2d( grid%mudf, 't', config_flags,         &
+                               ids, ide, jds, jde,                   &
+                               ims, ime, jms, jme,                   &
+                               ips, ipe, jps, jpe,                   &
+                               grid%i_start(ij), grid%i_end(ij),     &
+                               grid%j_start(ij), grid%j_end(ij)      )
+
+     END DO
+     !$OMP END PARALLEL DO
+BENCH_END(set_phys_bc2_tim)
+     small_steps : DO iteration = 1 , number_of_small_timesteps
+
+       ! Boundary condition time (or communication time).  
+#ifdef DM_PARALLEL
+#      include "PERIOD_BDY_EM_B.inc"
+#endif
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+
+       DO ij = 1 , grid%num_tiles
+
+BENCH_START(advance_uv_tim)
+         CALL advance_uv ( grid%u_2, grid%ru_tend, grid%v_2, grid%rv_tend,        &
+                           grid%p, grid%pb,                                       &
+                           grid%ph_2, grid%php, grid%alt,  grid%al,               &
+                           grid%mu_2,                                             &
+                           grid%muu, cqu, grid%muv, cqv, grid%mudf,               &
+                           grid%msfux, grid%msfuy, grid%msfvx,                    &
+                           grid%msfvx_inv, grid%msfvy,                            &
+                           grid%rdx, grid%rdy, dts_rk,                            &
+                           grid%cf1, grid%cf2, grid%cf3, grid%fnm, grid%fnp,      &
+                           grid%emdiv,                                            &
+                           grid%rdnw, config_flags,grid%spec_zone,                &
+                           config_flags%non_hydrostatic, config_flags%top_lid,    &
+                           ids, ide, jds, jde, kds, kde,                          &
+                           ims, ime, jms, jme, kms, kme,                          &
+                           grid%i_start(ij), grid%i_end(ij),                      &
+                           grid%j_start(ij), grid%j_end(ij),                      &
+                           k_start    , k_end                                     )
+BENCH_END(advance_uv_tim)
+
+       END DO
+       !$OMP END PARALLEL DO
+
+!-----------------------------------------------------------
+!  acoustic integration polar filter for smallstep u, v
+!-----------------------------------------------------------
+
+       IF (config_flags%polar) THEN
+
+         CALL pxft ( grid=grid                                              &
+               ,lineno=__LINE__                                             &
+               ,flag_uv            = 1                                      &
+               ,flag_rurv          = 0                                      &
+               ,flag_wph           = 0                                      &
+               ,flag_ww            = 0                                      &
+               ,flag_t             = 0                                      &
+               ,flag_mu            = 0                                      &
+               ,flag_mut           = 0                                      &
+               ,flag_moist         = 0                                      &
+               ,flag_chem          = 0                                      &
+               ,flag_scalar        = 0                                      &
+               ,positive_definite  = .FALSE.                                &
+               ,moist=moist,chem=chem,scalar=scalar                         &
+               ,fft_filter_lat = config_flags%fft_filter_lat                &
+               ,dclat = dclat                                               &
+               ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+               ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+               ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+               ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+               ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+
+       END IF
+
+!-----------------------------------------------------------
+!  end acoustic integration polar filter for smallstep u, v
+!-----------------------------------------------------------
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+
+BENCH_START(spec_bdy_uv_tim)
+         IF( config_flags%specified .or. config_flags%nested ) THEN
+           CALL spec_bdyupdate(grid%u_2, grid%ru_tend, dts_rk,      &
+                               'u'         , config_flags, &
+                                grid%spec_zone,                  &
+                                ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                grid%i_start(ij), grid%i_end(ij),         &
+                                grid%j_start(ij), grid%j_end(ij),         &
+                                k_start    , k_end             )
+
+           CALL spec_bdyupdate(grid%v_2, grid%rv_tend, dts_rk,      &
+                                'v'         , config_flags, &
+                                grid%spec_zone,                  &
+                                ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                grid%i_start(ij), grid%i_end(ij),         &
+                                grid%j_start(ij), grid%j_end(ij),         &
+                                k_start    , k_end             )
+
+         ENDIF
+BENCH_END(spec_bdy_uv_tim)
+
+       END DO
+       !$OMP END PARALLEL DO
+
+#ifdef DM_PARALLEL
+!
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!         *                     *
+!       * + *      * + *        +
+!         *                     *
+!
+!  u_2               x
+!  v_2                          x
+!
+#     include "HALO_EM_C.inc"
+#endif
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+
+        !  advance the mass in the column, theta, and calculate ww
+
+BENCH_START(advance_mu_t_tim)
+         CALL advance_mu_t( grid%ww, ww1, grid%u_2, grid%u_save, grid%v_2, grid%v_save, &
+                          grid%mu_2, grid%mut, muave, grid%muts, grid%muu, grid%muv,    &
+                          grid%mudf, grid%ru_m, grid%rv_m, grid%ww_m,                   &
+                          grid%t_2, grid%t_save, t_2save, t_tend,                       &
+                          mu_tend,                                                      &
+                          grid%rdx, grid%rdy, dts_rk, grid%epssm,                       &
+                          grid%dnw, grid%fnm, grid%fnp, grid%rdnw,                      &
+                          grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,            &
+                          grid%msfvy, grid%msftx,grid%msfty,                            &
+                          iteration, config_flags,                                      &
+                          ids, ide, jds, jde, kds, kde,      &
+                          ims, ime, jms, jme, kms, kme,      &
+                          grid%i_start(ij), grid%i_end(ij),  &
+                          grid%j_start(ij), grid%j_end(ij),  &
+                          k_start    , k_end                )
+BENCH_END(advance_mu_t_tim)
+       ENDDO
+       !$OMP END PARALLEL DO
+
+!-----------------------------------------------------------
+!  acoustic integration polar filter for smallstep mu, t
+!-----------------------------------------------------------
+
+       IF ( (config_flags%polar) ) THEN
+
+         CALL pxft ( grid=grid                                               &
+                ,lineno=__LINE__                                             &
+                ,flag_uv            = 0                                      &
+                ,flag_rurv          = 0                                      &
+                ,flag_wph           = 0                                      &
+                ,flag_ww            = 0                                      &
+                ,flag_t             = 1                                      &
+                ,flag_mu            = 1                                      &
+                ,flag_mut           = 0                                      &
+                ,flag_moist         = 0                                      &
+                ,flag_chem          = 0                                      &
+                ,flag_scalar        = 0                                      &
+                ,positive_definite  = .FALSE.                                &
+                ,moist=moist,chem=chem,scalar=scalar                         &
+                ,fft_filter_lat = config_flags%fft_filter_lat                &
+                ,dclat = dclat                                               &
+                ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+
+         grid%muts = grid%mut + grid%mu_2  ! reset muts using filtered mu_2
+ 
+       END IF
+
+!-----------------------------------------------------------
+!  end acoustic integration polar filter for smallstep mu, t
+!-----------------------------------------------------------
+
+BENCH_START(spec_bdy_t_tim)
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+
+         IF( config_flags%specified .or. config_flags%nested ) THEN
+
+           CALL spec_bdyupdate(grid%t_2, t_tend, dts_rk,        &
+                               't'         , config_flags,      &
+                               grid%spec_zone,                  &
+                               ids,ide, jds,jde, kds,kde,       &
+                               ims,ime, jms,jme, kms,kme,       &
+                               ips,ipe, jps,jpe, kps,kpe,       &
+                               grid%i_start(ij), grid%i_end(ij),&
+                               grid%j_start(ij), grid%j_end(ij),&
+                               k_start    , k_end              )
+
+           CALL spec_bdyupdate(grid%mu_2, mu_tend, dts_rk,       &
+                               'm'         , config_flags,      &
+                               grid%spec_zone,                  &
+                               ids,ide, jds,jde, 1  ,1  ,       &
+                               ims,ime, jms,jme, 1  ,1  ,       &
+                               ips,ipe, jps,jpe, 1  ,1  ,       &
+                               grid%i_start(ij), grid%i_end(ij),&
+                               grid%j_start(ij), grid%j_end(ij),&
+                               1    , 1             )
+
+           CALL spec_bdyupdate(grid%muts, mu_tend, dts_rk,      &
+                              'm'         , config_flags, &
+                              grid%spec_zone,                  &
+                              ids,ide, jds,jde, 1  ,1  ,  & ! domain dims
+                              ims,ime, jms,jme, 1  ,1  ,  & ! memory dims
+                              ips,ipe, jps,jpe, 1  ,1  ,  & ! patch  dims
+                              grid%i_start(ij), grid%i_end(ij),         &
+                              grid%j_start(ij), grid%j_end(ij),         &
+                              1    , 1             )
+         ENDIF
+BENCH_END(spec_bdy_t_tim)
+
+         ! small (acoustic) step for the vertical momentum,
+         ! density and coupled potential temperature.
+
+
+BENCH_START(advance_w_tim)
+         IF ( config_flags%non_hydrostatic ) THEN
+           CALL advance_w( grid%w_2, rw_tend, grid%ww, w_save,         &
+                           grid%u_2, grid%v_2,                         &
+                           grid%mu_2, grid%mut, muave, grid%muts,      &
+                           t_2save, grid%t_2, grid%t_save,             &
+                           grid%ph_2, ph_save, grid%phb, ph_tend,      &
+                           grid%ht, c2a, cqw, grid%alt, grid%alb,      &
+                           a, alpha, gamma,                            &
+                           grid%rdx, grid%rdy, dts_rk, t0, grid%epssm, &
+                           grid%dnw, grid%fnm, grid%fnp, grid%rdnw,    &
+                           grid%rdn, grid%cf1, grid%cf2, grid%cf3,     &
+                           grid%msftx, grid%msfty,                     &
+                           config_flags,  config_flags%top_lid,        &
+                           ids,ide, jds,jde, kds,kde,                  &
+                           ims,ime, jms,jme, kms,kme,                  &
+                           grid%i_start(ij), grid%i_end(ij),           &
+                           grid%j_start(ij), grid%j_end(ij),           &
+                           k_start    , k_end                          )
+         ENDIF
+BENCH_END(advance_w_tim)
+
+       ENDDO
+       !$OMP END PARALLEL DO
+
+!-----------------------------------------------------------
+!  acoustic integration polar filter for smallstep w, geopotential
+!-----------------------------------------------------------
+
+       IF ( (config_flags%polar) .AND. (config_flags%non_hydrostatic) ) THEN
+
+         CALL pxft ( grid=grid                                               &
+                ,lineno=__LINE__                                             &
+                ,flag_uv            = 0                                      &
+                ,flag_rurv          = 0                                      &
+                ,flag_wph           = 1                                      &
+                ,flag_ww            = 0                                      &
+                ,flag_t             = 0                                      &
+                ,flag_mu            = 0                                      &
+                ,flag_mut           = 0                                      &
+                ,flag_moist         = 0                                      &
+                ,flag_chem          = 0                                      &
+                ,flag_scalar        = 0                                      &
+                ,positive_definite  = .FALSE.                                &
+                ,moist=moist,chem=chem,scalar=scalar                         &
+                ,fft_filter_lat = config_flags%fft_filter_lat                &
+                ,dclat = dclat                                               &
+                ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+
+       END IF
+
+!-----------------------------------------------------------
+!  end acoustic integration polar filter for smallstep w, geopotential
+!-----------------------------------------------------------
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+
+BENCH_START(sumflux_tim)
+         CALL sumflux ( grid%u_2, grid%v_2, grid%ww,          &
+                        grid%u_save, grid%v_save, ww1,        &
+                        grid%muu, grid%muv,                   &
+                        grid%ru_m, grid%rv_m, grid%ww_m, grid%epssm,  &
+                        grid%msfux, grid% msfuy, grid%msfvx,  &
+                        grid%msfvx_inv, grid%msfvy,           &
+                        iteration, number_of_small_timesteps, &
+                        ids, ide, jds, jde, kds, kde,         &
+                        ims, ime, jms, jme, kms, kme,         &
+                        grid%i_start(ij), grid%i_end(ij),     &
+                        grid%j_start(ij), grid%j_end(ij),     &
+                        k_start    , k_end                   )
+BENCH_END(sumflux_tim)
+
+         IF( config_flags%specified .or. config_flags%nested ) THEN
+
+BENCH_START(spec_bdynhyd_tim)
+           IF (config_flags%non_hydrostatic)  THEN
+             CALL spec_bdyupdate_ph( ph_save, grid%ph_2, ph_tend,     &
+                                     mu_tend, grid%muts, dts_rk,      &
+                                     'h'         , config_flags,      &
+                                     grid%spec_zone,                  &
+                                     ids,ide, jds,jde, kds,kde,       &
+                                     ims,ime, jms,jme, kms,kme,       &
+                                     ips,ipe, jps,jpe, kps,kpe,       &
+                                     grid%i_start(ij), grid%i_end(ij),&
+                                     grid%j_start(ij), grid%j_end(ij),&
+                                     k_start    , k_end               )
+             IF( config_flags%specified ) THEN
+               CALL zero_grad_bdy ( grid%w_2,                         &
+                                    'w'         , config_flags,       &
+                                    grid%spec_zone,                   &
+                                    ids,ide, jds,jde, kds,kde,        &
+                                    ims,ime, jms,jme, kms,kme,        &
+                                    ips,ipe, jps,jpe, kps,kpe,        &
+                                    grid%i_start(ij), grid%i_end(ij), &
+                                    grid%j_start(ij), grid%j_end(ij), &
+                                    k_start    , k_end                )
+             ELSE
+               CALL spec_bdyupdate ( grid%w_2, rw_tend, dts_rk,       &
+                                     'h'         , config_flags,      &
+                                     grid%spec_zone,                  &
+                                     ids,ide, jds,jde, kds,kde,       &
+                                     ims,ime, jms,jme, kms,kme,       &
+                                     ips,ipe, jps,jpe, kps,kpe,       &
+                                     grid%i_start(ij), grid%i_end(ij),&
+                                     grid%j_start(ij), grid%j_end(ij),&
+                                     k_start    , k_end               )
+             ENDIF
+           ENDIF
+BENCH_END(spec_bdynhyd_tim)
+         ENDIF
+
+BENCH_START(cald_p_rho_tim)
+         CALL calc_p_rho( grid%al, grid%p, grid%ph_2,                 &
+                          grid%alt, grid%t_2, grid%t_save, c2a, pm1,  &
+                          grid%mu_2, grid%muts, grid%znu, t0,         &
+                          grid%rdnw, grid%dnw, grid%smdiv,            &
+                          config_flags%non_hydrostatic, iteration,    &
+                          ids, ide, jds, jde, kds, kde,     &
+                          ims, ime, jms, jme, kms, kme,     &
+                          grid%i_start(ij), grid%i_end(ij), &
+                          grid%j_start(ij), grid%j_end(ij), &
+                          k_start    , k_end               )
+BENCH_END(cald_p_rho_tim)
+
+       ENDDO
+       !$OMP END PARALLEL DO
+
+#ifdef DM_PARALLEL
+!
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!         *                     *
+!       * + *      * + *        +
+!         *                     *
+!
+!  ph_2   x
+!  al     x
+!  p      x
+!
+!  2D variables (x,y)
+!
+!  mu_2   x
+!  muts   x
+!  mudf   x
+
+#      include "HALO_EM_C2.inc"
+#      include "PERIOD_BDY_EM_B3.inc"
+#endif
+
+BENCH_START(phys_bc_tim)
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+
+       ! boundary condition set for next small timestep
+
+         CALL set_physical_bc3d( grid%ph_2, 'w', config_flags,          &
+                                 ids, ide, jds, jde, kds, kde,     &
+                                 ims, ime, jms, jme, kms, kme,     &
+                                 ips, ipe, jps, jpe, kps, kpe,     &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij), &
+                                 k_start    , k_end               )
+
+         CALL set_physical_bc3d( grid%al, 'p', config_flags,            &
+                                 ids, ide, jds, jde, kds, kde,     &
+                                 ims, ime, jms, jme, kms, kme,     &
+                                 ips, ipe, jps, jpe, kps, kpe,     &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij), &
+                                 k_start    , k_end               )
+
+         CALL set_physical_bc3d( grid%p, 'p', config_flags,             &
+                                 ids, ide, jds, jde, kds, kde,     &
+                                 ims, ime, jms, jme, kms, kme,     &
+                                 ips, ipe, jps, jpe, kps, kpe,     &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij), &
+                                 k_start    , k_end               )
+
+         CALL set_physical_bc2d( grid%muts, 't', config_flags,          &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,               &
+                                 ips, ipe, jps, jpe,               &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij) )
+
+         CALL set_physical_bc2d( grid%mu_2, 't', config_flags,          &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,               &
+                                 ips, ipe, jps, jpe,               &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij) )
+
+         CALL set_physical_bc2d( grid%mudf, 't', config_flags,          &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,               &
+                                 ips, ipe, jps, jpe,               &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij) )
+
+       END DO
+       !$OMP END PARALLEL DO
+BENCH_END(phys_bc_tim)
+
+     END DO small_steps
+
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+
+       CALL wrf_debug ( 200 , ' call rk_small_finish' )
+
+      ! change time-perturbation variables back to 
+      ! full perturbation variables.
+      ! first get updated mu at u and v points
+
+BENCH_START(calc_mu_uv_tim)
+       CALL calc_mu_uv_1 ( config_flags,                     &
+                           grid%muts, muus, muvs,                 &
+                           ids, ide, jds, jde, kds, kde,     &
+                           ims, ime, jms, jme, kms, kme,     &
+                           grid%i_start(ij), grid%i_end(ij), &
+                           grid%j_start(ij), grid%j_end(ij), &
+                           k_start    , k_end               )
+BENCH_END(calc_mu_uv_tim)
+BENCH_START(small_step_finish_tim)
+       CALL small_step_finish( grid%u_2, grid%u_1, grid%v_2, grid%v_1, grid%w_2, grid%w_1,     &
+                               grid%t_2, grid%t_1, grid%ph_2, grid%ph_1, grid%ww, ww1,    &
+                               grid%mu_2, grid%mu_1,                       &
+                               grid%mut, grid%muts, grid%muu, muus, grid%muv, muvs,  & 
+                               grid%u_save, grid%v_save, w_save,           &
+                               grid%t_save, ph_save, mu_save,         &
+                               grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx,grid%msfty, &
+                               grid%h_diabatic,                       &
+                               number_of_small_timesteps,dts_rk, &
+                               rk_step, rk_order,                &
+                               ids, ide, jds, jde, kds, kde,     &
+                               ims, ime, jms, jme, kms, kme,     &
+                               grid%i_start(ij), grid%i_end(ij), &
+                               grid%j_start(ij), grid%j_end(ij), &
+                               k_start    , k_end               )
+!  call  to set ru_m, rv_m and ww_m b.c's for PD advection
+
+       IF (rk_step == rk_order) THEN
+
+         CALL set_physical_bc3d( grid%ru_m, 'u', config_flags,   &
+                                 ids, ide, jds, jde, kds, kde,      &
+                                 ims, ime, jms, jme, kms, kme,      &
+                                 ips, ipe, jps, jpe, kps, kpe,      &
+                                 grid%i_start(ij), grid%i_end(ij),  &
+                                 grid%j_start(ij), grid%j_end(ij),  &
+                                 k_start    , k_end                )
+
+         CALL set_physical_bc3d( grid%rv_m, 'v', config_flags,   &
+                                 ids, ide, jds, jde, kds, kde,      &
+                                 ims, ime, jms, jme, kms, kme,      &
+                                 ips, ipe, jps, jpe, kps, kpe,      &
+                                 grid%i_start(ij), grid%i_end(ij),  &
+                                 grid%j_start(ij), grid%j_end(ij),  &
+                                 k_start    , k_end                )
+
+         CALL set_physical_bc3d( grid%ww_m, 'w', config_flags,   &
+                                 ids, ide, jds, jde, kds, kde,      &
+                                 ims, ime, jms, jme, kms, kme,      &
+                                 ips, ipe, jps, jpe, kps, kpe,      &
+                                 grid%i_start(ij), grid%i_end(ij),  &
+                                 grid%j_start(ij), grid%j_end(ij),  &
+                                 k_start    , k_end                )
+
+         CALL set_physical_bc2d( grid%mut, 't', config_flags,   &
+                                 ids, ide, jds, jde,               &
+                                 ims, ime, jms, jme,                &
+                                 ips, ipe, jps, jpe,                &
+                                 grid%i_start(ij), grid%i_end(ij),  &
+                                 grid%j_start(ij), grid%j_end(ij) )
+ 
+       END IF
+
+BENCH_END(small_step_finish_tim)
+
+     END DO
+     !$OMP END PARALLEL DO
+
+!-----------------------------------------------------------
+!  polar filter for full dynamics variables and time-averaged mass fluxes 
+!-----------------------------------------------------------
+
+     IF (config_flags%polar) THEN
+
+       CALL pxft ( grid=grid                                                   &
+                  ,lineno=__LINE__                                             &
+                  ,flag_uv            = 1                                      &
+                  ,flag_rurv          = 1                                      &
+                  ,flag_wph           = 1                                      &
+                  ,flag_ww            = 1                                      &
+                  ,flag_t             = 1                                      &
+                  ,flag_mu            = 1                                      &
+                  ,flag_mut           = 1                                      &
+                  ,flag_moist         = 0                                      &
+                  ,flag_chem          = 0                                      &
+                  ,flag_scalar        = 0                                      &
+                  ,positive_definite  = .FALSE.                                &
+                  ,moist=moist,chem=chem,scalar=scalar                         &
+                  ,fft_filter_lat = config_flags%fft_filter_lat                &
+                  ,dclat = dclat                                               &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+
+     END IF
+
+!-----------------------------------------------------------
+!  end polar filter for full dynamics variables and time-averaged mass fluxes 
+!-----------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!  add in physics tendency first if positive definite advection is used.
+!  pd advection applies advective flux limiter on last runge-kutta step
+!-----------------------------------------------------------------------
+! first moisture
+
+     IF (config_flags%pd_moist .and. (rk_step == rk_order)) THEN
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+         CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
+         DO im = PARAM_FIRST_SCALAR, num_3d_m
+           CALL rk_update_scalar_pd( im, im,                                   &
+                                     moist_old(ims,kms,jms,im),                &
+                                     moist_tend(ims,kms,jms,im),               &
+                                     grid%mu_1, grid%mu_1, grid%mub,  &
+                                     rk_step, dt_rk, grid%spec_zone,           &
+                                     config_flags,                             &
+                                     ids, ide, jds, jde, kds, kde,             &
+                                     ims, ime, jms, jme, kms, kme,             &
+                                     grid%i_start(ij), grid%i_end(ij),         &
+                                     grid%j_start(ij), grid%j_end(ij),         &
+                                     k_start    , k_end                       )
+         ENDDO
+       END DO
+       !$OMP END PARALLEL DO
+
+!---------------------- positive definite bc call
+#ifdef DM_PARALLEL
+       IF (config_flags%pd_moist) THEN
+         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+#     include "HALO_EM_MOIST_OLD_E_5.inc"
+         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+#     include "HALO_EM_MOIST_OLD_E_7.inc"
+         ELSE
+           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+           CALL wrf_error_fatal(TRIM(wrf_err_message))
+         ENDIF
+       ENDIF
+#endif
+
+#ifdef DM_PARALLEL
+#  include "PERIOD_BDY_EM_MOIST_OLD.inc"
+#endif
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+         IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
+           DO im = PARAM_FIRST_SCALAR , num_3d_m
+             CALL set_physical_bc3d( moist_old(ims,kms,jms,im), 'p', config_flags,   &
+                                     ids, ide, jds, jde, kds, kde,                  &
+                                     ims, ime, jms, jme, kms, kme,                  &
+                                     ips, ipe, jps, jpe, kps, kpe,                  &
+                                     grid%i_start(ij), grid%i_end(ij),              &
+                                     grid%j_start(ij), grid%j_end(ij),              &
+                                     k_start    , k_end                            )
+           END DO
+         ENDIF
+       END DO
+       !$OMP END PARALLEL DO
+
+     END IF  ! end if for pd_moist
+
+! scalars
+
+     IF (config_flags%pd_scalar .and. (rk_step == rk_order)) THEN
+
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       DO ij = 1 , grid%num_tiles
+         CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
+         DO im = PARAM_FIRST_SCALAR, num_3d_s
+           CALL rk_update_scalar_pd( im, im,                                  &
+                                     scalar_old(ims,kms,jms,im),              &
+                                     scalar_tend(ims,kms,jms,im),             &
+                                     grid%mu_1, grid%mu_1, grid%mub, &
+                                     rk_step, dt_rk, grid%spec_zone,          &
+                                     config_flags,                            &
+                                     ids, ide, jds, jde, kds, kde,            &
+                                     ims, ime, jms, jme, kms, kme,            &
+                                     grid%i_start(ij), grid%i_end(ij),        &
+                                     grid%j_start(ij), grid%j_end(ij),        &
+                                     k_start    , k_end                      )
+         ENDDO
+       ENDDO
+       !$OMP END PARALLEL DO
+
+!---------------------- positive definite bc call
+#ifdef DM_PARALLEL
+       IF (config_flags%pd_scalar) THEN
+#ifndef RSL
+         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+#     include "HALO_EM_SCALAR_OLD_E_5.inc"
+         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+#     include "HALO_EM_SCALAR_OLD_E_7.inc"
+         ELSE
+           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+           CALL wrf_error_fatal(TRIM(wrf_err_message))
+         ENDIF
+#else
+         WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
+         CALL wrf_error_fatal(TRIM(wrf_err_message))
+#endif   
+  endif
+#endif
+
+#ifdef DM_PARALLEL
+#  include "PERIOD_BDY_EM_SCALAR_OLD.inc"
+#endif
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+
+         DO ij = 1 , grid%num_tiles
+           IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
+             DO im = PARAM_FIRST_SCALAR , num_3d_s
+               CALL set_physical_bc3d(  scalar_old(ims,kms,jms,im), 'p', config_flags, &
+                                        ids, ide, jds, jde, kds, kde,                    &
+                                        ims, ime, jms, jme, kms, kme,                    &
+                                        ips, ipe, jps, jpe, kps, kpe,                    &
+                                        grid%i_start(ij), grid%i_end(ij),                &
+                                        grid%j_start(ij), grid%j_end(ij),                &
+                                        k_start    , k_end                              )
+             END DO
+           ENDIF
+         END DO
+         !$OMP END PARALLEL DO
+
+       END IF  ! end if for pd_scalar
+
+! chem
+
+       IF (config_flags%pd_chem .and. (rk_step == rk_order)) THEN
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+           CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
+           DO im = PARAM_FIRST_SCALAR, num_3d_c
+             CALL rk_update_scalar_pd( im, im,                                  &
+                                       chem_old(ims,kms,jms,im),                &
+                                       chem_tend(ims,kms,jms,im),               &
+                                       grid%mu_1, grid%mu_1, grid%mub, &
+                                       rk_step, dt_rk, grid%spec_zone,          &
+                                       config_flags,                            &
+                                       ids, ide, jds, jde, kds, kde,            &
+                                       ims, ime, jms, jme, kms, kme,            &
+                                       grid%i_start(ij), grid%i_end(ij),        &
+                                       grid%j_start(ij), grid%j_end(ij),        &
+                                       k_start    , k_end                      )
+           ENDDO
+         END DO
+         !$OMP END PARALLEL DO
+
+!---------------------- positive definite bc call
+#ifdef DM_PARALLEL
+         IF (config_flags%pd_chem) THEN
+           IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+#     include "HALO_EM_CHEM_OLD_E_5.inc"
+           ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+#     include "HALO_EM_CHEM_OLD_E_7.inc"
+           ELSE
+             WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+             CALL wrf_error_fatal(TRIM(wrf_err_message))
+           ENDIF
+         ENDIF
+#endif
+
+#ifdef DM_PARALLEL
+#  include "PERIOD_BDY_EM_CHEM_OLD.inc"
+#endif
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+           IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
+             DO im = PARAM_FIRST_SCALAR , num_3d_c
+               CALL set_physical_bc3d(  chem_old(ims,kms,jms,im), 'p', config_flags,     &
+                                        ids, ide, jds, jde, kds, kde,                    &
+                                        ims, ime, jms, jme, kms, kme,                    &
+                                        ips, ipe, jps, jpe, kps, kpe,                    &
+                                        grid%i_start(ij), grid%i_end(ij),                &
+                                        grid%j_start(ij), grid%j_end(ij),                &
+                                        k_start    , k_end                              )
+             END DO 
+           ENDIF
+         END DO
+         !$OMP END PARALLEL DO
+
+       ENDIF  ! end if for pd_chem
+
+! tke
+
+       IF (config_flags%pd_tke .and. (rk_step == rk_order) &
+           .and. (config_flags%km_opt .eq. 2)                ) THEN
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+           CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
+           CALL rk_update_scalar_pd( 1, 1,                                    &
+                                     grid%tke_1,                              &
+                                     tke_tend(ims,kms,jms),                   &
+                                     grid%mu_1, grid%mu_1, grid%mub,          &
+                                     rk_step, dt_rk, grid%spec_zone,          &
+                                     config_flags,                            &
+                                     ids, ide, jds, jde, kds, kde,            &
+                                     ims, ime, jms, jme, kms, kme,            &
+                                     grid%i_start(ij), grid%i_end(ij),        &
+                                     grid%j_start(ij), grid%j_end(ij),        &
+                                     k_start    , k_end                       )
+         ENDDO
+         !$OMP END PARALLEL DO
+
+!---------------------- positive definite bc call
+#ifdef DM_PARALLEL
+         IF (config_flags%pd_tke) THEN
+           IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+#     include "HALO_EM_TKE_OLD_E_5.inc"
+           ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+#     include "HALO_EM_TKE_OLD_E_7.inc"
+           ELSE
+             WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+             CALL wrf_error_fatal(TRIM(wrf_err_message))
+           ENDIF
+         ENDIF
+#endif
+
+#ifdef DM_PARALLEL
+#  include "PERIOD_BDY_EM_TKE_OLD.inc"
+#endif
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         DO ij = 1 , grid%num_tiles
+           CALL set_physical_bc3d(  grid%tke_1, 'p', config_flags,  &
+                                    ids, ide, jds, jde, kds, kde,      &
+                                    ims, ime, jms, jme, kms, kme,      &
+                                    ips, ipe, jps, jpe, kps, kpe,      &
+                                    grid%i_start(ij), grid%i_end(ij),  &
+                                    grid%j_start(ij), grid%j_end(ij),  &
+                                    k_start    , k_end                )
+         END DO
+         !$OMP END PARALLEL DO
+
+!---  end of positive definite physics tendency update
+
+       END IF  ! end if for pd_tke
+
+#ifdef DM_PARALLEL
+!
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!          * * * * *            
+!          * * * * *            
+!          * * + * *            
+!          * * * * *            
+!          * * * * *            
+!
+! ru_m         x
+! rv_m         x
+! ww_m         x
+! mut          x
+!
+!--------------------------------------------------------------
+
+#  include "HALO_EM_D.inc"
+#endif
+
+!
+!
+! (4) Still within the RK loop, the scalar variables are advanced.
+!
+!    For the moist and chem variables, each one is advanced
+!    individually, using named loops "moist_variable_loop:"
+!    and "chem_variable_loop:".  Each RK substep begins by
+!    calculating the advective tendency, and, for the first RK step, 
+!    3D mixing (calling rk_scalar_tend) followed by an update
+!    of the scalar (calling rk_scalar_update).
+!

+!
+
+
+       moist_scalar_advance: IF (num_3d_m >= PARAM_FIRST_SCALAR )  THEN
+
+         moist_variable_loop: DO im = PARAM_FIRST_SCALAR, num_3d_m
+
+! adv_moist_cond is set in module_physics_init based on mp_physics choice
+!       true except for Ferrier scheme
+
+           IF (grid%adv_moist_cond .or. im==p_qv ) THEN
+
+             !$OMP PARALLEL DO   &
+             !$OMP PRIVATE ( ij )
+             moist_tile_loop_1: DO ij = 1 , grid%num_tiles
+
+               CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
+
+BENCH_START(rk_scalar_tend_tim)
+               CALL rk_scalar_tend (  im, im, config_flags,                  &
+                           rk_step, dt_rk,                                   &
+                           grid%ru_m, grid%rv_m, grid%ww_m,                  &
+                           grid%mut, grid%mub, grid%mu_1,                    &
+                           grid%alt,                                         &
+                           moist_old(ims,kms,jms,im),                        &
+                           moist(ims,kms,jms,im),                            &
+                           moist_tend(ims,kms,jms,im),                       &
+                           advect_tend,grid%rqvften,                         &
+                           grid%qv_base, .true., grid%fnm, grid%fnp,         &
+                           grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
+                           grid%msfvy, grid%msftx,grid%msfty,                & 
+                           grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
+                           grid%kvdif, grid%xkhh,                            &
+                           grid%diff_6th_opt, grid%diff_6th_factor,          &
+                           config_flags%pd_moist,            &
+                           ids, ide, jds, jde, kds, kde,     &
+                           ims, ime, jms, jme, kms, kme,     &
+                           grid%i_start(ij), grid%i_end(ij), &
+                           grid%j_start(ij), grid%j_end(ij), &
+                           k_start    , k_end               )
+
+BENCH_END(rk_scalar_tend_tim)
+
+BENCH_START(rlx_bdy_scalar_tim)
+               IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN 
+                 IF ( im .EQ. P_QV .OR. config_flags%nested ) THEN
+                   CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im),            & 
+                                     moist(ims,kms,jms,im),  grid%mut,         &
+                                     moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
+                                     moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
+                                     moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
+                                     moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
+                                     config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
+                                     grid%dtbc, grid%fcx, grid%gcx,             &
+                                     config_flags,               &
+                                     ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                     ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                     ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                     grid%i_start(ij), grid%i_end(ij),      &
+                                     grid%j_start(ij), grid%j_end(ij),      &
+                                     k_start, k_end                        )
+
+                   CALL spec_bdy_scalar  ( moist_tend(ims,kms,jms,im),                &
+                                     moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
+                                     moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
+                                     moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
+                                     moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
+                                     config_flags%spec_bdy_width, grid%spec_zone,                 &
+                                     config_flags,               &
+                                     ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                     ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                     ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                     grid%i_start(ij), grid%i_end(ij),          &
+                                     grid%j_start(ij), grid%j_end(ij),          &
+                                     k_start, k_end                               )
+                 ENDIF
+               ENDIF
+BENCH_END(rlx_bdy_scalar_tim)
+
+             ENDDO moist_tile_loop_1
+             !$OMP END PARALLEL DO
+
+             !$OMP PARALLEL DO   &
+             !$OMP PRIVATE ( ij )
+             moist_tile_loop_2: DO ij = 1 , grid%num_tiles
+
+               CALL wrf_debug ( 200 , ' call rk_update_scalar' )
+
+BENCH_START(update_scal_tim)
+               CALL rk_update_scalar( im, im,                     &
+                               moist_old(ims,kms,jms,im),         &
+                               moist(ims,kms,jms,im),             &
+                               moist_tend(ims,kms,jms,im),        &
+                               advect_tend, grid%msftx,grid%msfty, &
+                               grid%mu_1, grid%mu_2, grid%mub,    &
+                               rk_step, dt_rk, grid%spec_zone,    &
+                               config_flags,                      &
+                               ids, ide, jds, jde, kds, kde,     &
+                               ims, ime, jms, jme, kms, kme,     &
+                               grid%i_start(ij), grid%i_end(ij), &
+                               grid%j_start(ij), grid%j_end(ij), &
+                               k_start    , k_end                )
+BENCH_END(update_scal_tim)
+
+BENCH_START(flow_depbdy_tim)
+               IF( config_flags%specified ) THEN
+                 IF(im .ne. P_QV)THEN
+                   CALL flow_dep_bdy  (  moist(ims,kms,jms,im),                 &
+                                grid%ru_m, grid%rv_m, config_flags,             &
+                                grid%spec_zone,                                 &
+                                ids,ide, jds,jde, kds,kde,                      &
+                                ims,ime, jms,jme, kms,kme,                      &
+                                ips,ipe, jps,jpe, kps,kpe,                      &
+                                grid%i_start(ij), grid%i_end(ij),               &
+                                grid%j_start(ij), grid%j_end(ij),               &
+                                k_start, k_end                               )
+                 ENDIF
+               ENDIF
+BENCH_END(flow_depbdy_tim)
+
+             ENDDO moist_tile_loop_2
+             !$OMP END PARALLEL DO
+
+           ENDIF  !-- if (grid%adv_moist_cond .or. im==p_qv ) then
+
+         ENDDO moist_variable_loop
+
+       ENDIF moist_scalar_advance
+
+BENCH_START(tke_adv_tim)
+       TKE_advance: IF (config_flags%km_opt .eq. 2) then
+#ifdef DM_PARALLEL
+         IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#       include "HALO_EM_TKE_ADVECT_3.inc"
+         ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#       include "HALO_EM_TKE_ADVECT_5.inc"
+         ELSE
+          WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+          CALL wrf_error_fatal(TRIM(wrf_err_message))
+         ENDIF
+#endif
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         tke_tile_loop_1: DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
+           CALL rk_scalar_tend ( 1, 1, config_flags,                               &
+                            rk_step, dt_rk,                                        &
+                            grid%ru_m, grid%rv_m, grid%ww_m,                       &
+                            grid%mut, grid%mub, grid%mu_1,                         &
+                            grid%alt,                                              &
+                            grid%tke_1,                                            &
+                            grid%tke_2,                                            &
+                            tke_tend(ims,kms,jms),                                 &
+                            advect_tend,grid%rqvften,                              &
+                            grid%qv_base, .false., grid%fnm, grid%fnp,             &
+                            grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,     &
+                            grid%msfvy, grid%msftx,grid%msfty,                     &
+                            grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif,   &
+                            grid%kvdif, grid%xkhh,                                 &
+                            grid%diff_6th_opt, grid%diff_6th_factor,               &
+                            config_flags%pd_tke,              &
+                            ids, ide, jds, jde, kds, kde,     &
+                            ims, ime, jms, jme, kms, kme,     &
+                            grid%i_start(ij), grid%i_end(ij), &
+                            grid%j_start(ij), grid%j_end(ij), &
+                            k_start    , k_end               )
+
+         ENDDO tke_tile_loop_1
+         !$OMP END PARALLEL DO
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         tke_tile_loop_2: DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call rk_update_scalar' )
+           CALL rk_update_scalar( 1, 1,                             &
+                             grid%tke_1,                            &
+                             grid%tke_2,                            &
+                             tke_tend(ims,kms,jms),                 &
+                             advect_tend,grid%msftx,grid%msfty,     &
+                             grid%mu_1, grid%mu_2, grid%mub,        &
+                             rk_step, dt_rk, grid%spec_zone,        &
+                             config_flags,                          &
+                             ids, ide, jds, jde, kds, kde,     &
+                             ims, ime, jms, jme, kms, kme,     &
+                             grid%i_start(ij), grid%i_end(ij), &
+                             grid%j_start(ij), grid%j_end(ij), &
+                             k_start    , k_end               ) 
+
+! bound the tke (greater than 0, less than tke_upper_bound)
+
+           CALL bound_tke( grid%tke_2, grid%tke_upper_bound,    &
+                           ids, ide, jds, jde, kds, kde,        &
+                           ims, ime, jms, jme, kms, kme,        &
+                           grid%i_start(ij), grid%i_end(ij),    &
+                           grid%j_start(ij), grid%j_end(ij),    &
+                           k_start    , k_end                  )
+
+           IF( config_flags%specified .or. config_flags%nested ) THEN
+              CALL flow_dep_bdy (  grid%tke_2,                     &
+                                   grid%ru_m, grid%rv_m, config_flags,               &
+                                   grid%spec_zone,                              &
+                                   ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                   ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                   ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                   grid%i_start(ij), grid%i_end(ij),       &
+                                   grid%j_start(ij), grid%j_end(ij),       &
+                                   k_start, k_end                               )
+           ENDIF
+         ENDDO tke_tile_loop_2
+         !$OMP END PARALLEL DO
+
+       ENDIF TKE_advance
+BENCH_END(tke_adv_tim)
+
+#ifdef WRF_CHEM
+!  next the chemical species
+BENCH_START(chem_adv_tim)
+       chem_scalar_advance: IF (num_3d_c >= PARAM_FIRST_SCALAR)  THEN
+
+         chem_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_3d_c
+
+           !$OMP PARALLEL DO   &
+           !$OMP PRIVATE ( ij )
+           chem_tile_loop_1: DO ij = 1 , grid%num_tiles
+
+             CALL wrf_debug ( 200 , ' call rk_scalar_tend in chem_tile_loop_1' )
+             CALL rk_scalar_tend ( ic, ic, config_flags,                         &
+                              rk_step, dt_rk,                                    &
+                              grid%ru_m, grid%rv_m, grid%ww_m,                   &
+                              grid%mut, grid%mub, grid%mu_1,                     &
+                              grid%alt,                                          &
+                              chem_old(ims,kms,jms,ic),                          &
+                              chem(ims,kms,jms,ic),                              &
+                              chem_tend(ims,kms,jms,ic),                         &
+                              advect_tend,grid%rqvften,                          &
+                              grid%qv_base, .false., grid%fnm, grid%fnp,         &
+                              grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
+                              grid%msfvy, grid%msftx,grid%msfty,                 &
+                              grid%rdx, grid%rdy, grid%rdn, grid%rdnw,     &
+                              grid%khdif, grid%kvdif, grid%xkhh,                 &
+                              grid%diff_6th_opt, grid%diff_6th_factor,           &
+                              config_flags%pd_chem,                              &
+                              ids, ide, jds, jde, kds, kde,                      &
+                              ims, ime, jms, jme, kms, kme,                      &
+                              grid%i_start(ij), grid%i_end(ij),                  &
+                              grid%j_start(ij), grid%j_end(ij),                  &
+                              k_start    , k_end                                )
+!
+! Currently, chemistry species with specified boundaries (i.e. the mother
+! domain)  are being over written by flow_dep_bdy_chem. So, relax_bdy and
+! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
+! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.) 
+!
+           IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
+             IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
+             CALL relax_bdy_scalar ( chem_tend(ims,kms,jms,ic),                                    &
+                                     chem(ims,kms,jms,ic),  grid%mut,                              &
+                                     chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic),                &
+                                     chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic),                &
+                                     chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic),              &
+                                     chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic),              &
+                                     config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
+                                     grid%dtbc, grid%fcx, grid%gcx,                                &
+                                     config_flags,                                                 &
+                                     ids,ide, jds,jde, kds,kde,                                    &
+                                     ims,ime, jms,jme, kms,kme,                                    &
+                                     ips,ipe, jps,jpe, kps,kpe,                                    &
+                                     grid%i_start(ij), grid%i_end(ij),                             &
+                                     grid%j_start(ij), grid%j_end(ij),                             &
+                                     k_start, k_end                                                )
+             CALL spec_bdy_scalar  ( chem_tend(ims,kms,jms,ic),                 &
+                                     chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic),                &
+                                     chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic),                &
+                                     chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic),              &
+                                     chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic),              &
+                                     config_flags%spec_bdy_width, grid%spec_zone,                  &
+                                     config_flags,                                                 &
+                                     ids,ide, jds,jde, kds,kde,                                    &
+                                     ims,ime, jms,jme, kms,kme,                                    &
+                                     ips,ipe, jps,jpe, kps,kpe,                                    &
+                                     grid%i_start(ij), grid%i_end(ij),                             &
+                                     grid%j_start(ij), grid%j_end(ij),                             &
+                                     k_start, k_end                                                )
+           ENDIF
+
+         ENDDO chem_tile_loop_1
+         !$OMP END PARALLEL DO
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+
+         chem_tile_loop_2: DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call rk_update_scalar' )
+           CALL rk_update_scalar( ic, ic,                           &
+                                  chem_old(ims,kms,jms,ic),         &  ! was chem_1
+                                  chem(ims,kms,jms,ic),             &
+                                  chem_tend(ims,kms,jms,ic),        &
+                                  advect_tend, grid%msftx, grid%msfty, &
+                                  grid%mu_1, grid%mu_2, grid%mub,      &
+                                  rk_step, dt_rk, grid%spec_zone,      &
+                                  config_flags,                     &
+                                  ids, ide, jds, jde, kds, kde,     &
+                                  ims, ime, jms, jme, kms, kme,     &
+                                  grid%i_start(ij), grid%i_end(ij), &
+                                  grid%j_start(ij), grid%j_end(ij), &
+                                  k_start    , k_end               )
+
+           IF( config_flags%specified  ) THEN
+             CALL flow_dep_bdy_chem( chem(ims,kms,jms,ic),                          &
+                                     chem_bxs(jms,kms,1,ic), chem_btxs(jms,kms,1,ic),  &
+                                     chem_bxe(jms,kms,1,ic), chem_btxe(jms,kms,1,ic),  &
+                                     chem_bys(ims,kms,1,ic), chem_btys(ims,kms,1,ic),  &
+                                     chem_bye(ims,kms,1,ic), chem_btye(ims,kms,1,ic),  &
+                                     dt_rk+grid%dtbc,                                  &
+                                     config_flags%spec_bdy_width,grid%z,      &
+                                     grid%have_bcs_chem,      &
+                                     grid%ru_m, grid%rv_m, config_flags,grid%alt,       &
+                                     grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
+                                     grid%spec_zone,ic,                  &
+                                     ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                     ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                     ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                     grid%i_start(ij), grid%i_end(ij),   &
+                                     grid%j_start(ij), grid%j_end(ij),   &
+                                     k_start, k_end                      )
+           ENDIF
+         ENDDO chem_tile_loop_2
+         !$OMP END PARALLEL DO
+
+       ENDDO chem_variable_loop
+     ENDIF chem_scalar_advance
+BENCH_END(chem_adv_tim)
+#endif
+
+!  next the other scalar species
+     other_scalar_advance: IF (num_3d_s >= PARAM_FIRST_SCALAR)  THEN
+
+       scalar_variable_loop: do is = PARAM_FIRST_SCALAR, num_3d_s
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         scalar_tile_loop_1: DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
+           CALL rk_scalar_tend ( is, is, config_flags,                            &
+                                 rk_step, dt_rk,                                  &
+                                 grid%ru_m, grid%rv_m, grid%ww_m,                 &
+                                 grid%mut, grid%mub, grid%mu_1,                   &
+                                 grid%alt,                                        &
+                                 scalar_old(ims,kms,jms,is),                      &
+                                 scalar(ims,kms,jms,is),                          &
+                                 scalar_tend(ims,kms,jms,is),                     &
+                                 advect_tend,grid%rqvften,                        &
+                                 grid%qv_base, .false., grid%fnm, grid%fnp,       &
+                                 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
+                                 grid%msfvy, grid%msftx,grid%msfty,               &
+                                 grid%rdx, grid%rdy, grid%rdn, grid%rdnw,         &
+                                 grid%khdif, grid%kvdif, grid%xkhh,               &
+                                 grid%diff_6th_opt, grid%diff_6th_factor,         &
+                                 config_flags%pd_scalar,           &
+                                 ids, ide, jds, jde, kds, kde,     &
+                                 ims, ime, jms, jme, kms, kme,     &
+                                 grid%i_start(ij), grid%i_end(ij), &
+                                 grid%j_start(ij), grid%j_end(ij), &
+                                 k_start    , k_end               )
+
+           IF( config_flags%nested .and. (rk_step == 1) ) THEN
+
+             IF (is .EQ. P_QNDROP .OR. is .EQ. P_QNI          & 
+                                  .OR. is .EQ. P_QNS          &
+                                  .OR. is .EQ. P_QNR          &
+                                  .OR. is .EQ. P_QNG) THEN             
+
+               CALL relax_bdy_scalar ( scalar_tend(ims,kms,jms,is),                            &
+                                       scalar(ims,kms,jms,is),  grid%mut,                      &
+                                       scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is),      &
+                                       scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is),      &
+                                       scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is),    &
+                                       scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is),    &
+                                       config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
+                                       grid%dtbc, grid%fcx, grid%gcx,                          &
+                                       config_flags,                                           &
+                                       ids,ide, jds,jde, kds,kde,                              &
+                                       ims,ime, jms,jme, kms,kme,                              &
+                                       ips,ipe, jps,jpe, kps,kpe,                              &
+                                       grid%i_start(ij), grid%i_end(ij),                       &
+                                       grid%j_start(ij), grid%j_end(ij),                       &
+                                       k_start, k_end                                          )
+
+               CALL spec_bdy_scalar  ( scalar_tend(ims,kms,jms,is),                            &
+                                       scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is),      &
+                                       scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is),      &
+                                       scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is),    &
+                                       scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is),    &
+                                       config_flags%spec_bdy_width, grid%spec_zone,            &
+                                       config_flags,                                           &
+                                       ids,ide, jds,jde, kds,kde,                              &
+                                       ims,ime, jms,jme, kms,kme,                              &
+                                       ips,ipe, jps,jpe, kps,kpe,                              &
+                                       grid%i_start(ij), grid%i_end(ij),                       &
+                                       grid%j_start(ij), grid%j_end(ij),                       &
+                                       k_start, k_end                                          )
+
+             ENDIF
+
+           ENDIF ! b.c test for chem nested boundary condition
+
+         ENDDO scalar_tile_loop_1
+         !$OMP END PARALLEL DO
+
+         !$OMP PARALLEL DO   &
+         !$OMP PRIVATE ( ij )
+         scalar_tile_loop_2: DO ij = 1 , grid%num_tiles
+
+           CALL wrf_debug ( 200 , ' call rk_update_scalar' )
+           CALL rk_update_scalar( is, is,                           &
+                                  scalar_old(ims,kms,jms,is),       &  ! was scalar_1
+                                  scalar(ims,kms,jms,is),           &
+                                  scalar_tend(ims,kms,jms,is),      &
+                                  advect_tend, grid%msftx, grid%msfty, &
+                                  grid%mu_1, grid%mu_2, grid%mub,                  &
+                                  rk_step, dt_rk, grid%spec_zone,        &
+                                  config_flags,     &
+                                  ids, ide, jds, jde, kds, kde,     &
+                                  ims, ime, jms, jme, kms, kme,     &
+                                  grid%i_start(ij), grid%i_end(ij), &
+                                  grid%j_start(ij), grid%j_end(ij), &
+                                  k_start    , k_end               )
+
+
+           IF( config_flags%specified ) THEN
+             CALL flow_dep_bdy  ( scalar(ims,kms,jms,is),     &
+                                  grid%ru_m, grid%rv_m, config_flags,   &
+                                  grid%spec_zone,                  &
+                                  ids,ide, jds,jde, kds,kde,  & ! domain dims
+                                  ims,ime, jms,jme, kms,kme,  & ! memory dims
+                                  ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
+                                  grid%i_start(ij), grid%i_end(ij),  &
+                                  grid%j_start(ij), grid%j_end(ij),  &
+                                  k_start, k_end                    )
+           ENDIF
+
+         ENDDO scalar_tile_loop_2
+         !$OMP END PARALLEL DO
+
+       ENDDO scalar_variable_loop
+
+     ENDIF other_scalar_advance
+
+ !  update the pressure and density at the new time level
+
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+
+BENCH_START(calc_p_rho_tim)
+
+       CALL calc_p_rho_phi( moist, num_3d_m,                &
+                            grid%al, grid%alb, grid%mu_2, grid%muts,              &
+                            grid%ph_2, grid%p, grid%pb, grid%t_2,                 &
+                            p0, t0, grid%znu, grid%dnw, grid%rdnw,           &
+                            grid%rdn, config_flags%non_hydrostatic,             &
+                            ids, ide, jds, jde, kds, kde,     &
+                            ims, ime, jms, jme, kms, kme,     &
+                            grid%i_start(ij), grid%i_end(ij), &
+                            grid%j_start(ij), grid%j_end(ij), &
+                            k_start    , k_end               )
+
+BENCH_END(calc_p_rho_tim)
+
+     ENDDO
+     !$OMP END PARALLEL DO
+
+!  Reset the boundary conditions if there is another corrector step.
+!  (rk_step < rk_order), else we'll handle it at the end of everything
+!  (after the split physics, before exiting the timestep).
+
+     rk_step_1_check: IF ( rk_step < rk_order ) THEN
+
+!-----------------------------------------------------------
+!  rk3 substep polar filter for scalars (moist,chem,scalar)
+!-----------------------------------------------------------
+
+       IF (config_flags%polar) THEN 
+         IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
+           CALL wrf_debug ( 200 , ' call filter moist ' )
+           DO im = PARAM_FIRST_SCALAR, num_3d_m
+             CALL couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im)              &
+                    ,MU=grid%mu_2 , MUB=grid%mub                                 &
+                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
+             CALL pxft ( grid=grid                                               &
+                    ,lineno=__LINE__                                             &
+                    ,flag_uv            = 0                                      &
+                    ,flag_rurv          = 0                                      &
+                    ,flag_wph           = 0                                      &
+                    ,flag_ww            = 0                                      &
+                    ,flag_t             = 0                                      &
+                    ,flag_mu            = 0                                      &
+                    ,flag_mut           = 0                                      &
+                    ,flag_moist         = im                                     &
+                    ,flag_chem          = 0                                      &
+                    ,flag_scalar        = 0                                      &
+                    ,positive_definite=.FALSE.                                   &
+                    ,moist=moist,chem=chem,scalar=scalar                         &
+                    ,fft_filter_lat = config_flags%fft_filter_lat                &
+                    ,dclat = dclat                                               &
+                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                    ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                    ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+             CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im)            &
+                    ,MU=grid%mu_2 , MUB=grid%mub                                 &
+                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
+           END DO
+         END IF
+   
+         IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
+           CALL wrf_debug ( 200 , ' call filter chem ' )
+           DO im = PARAM_FIRST_SCALAR, num_3d_c
+             CALL couple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im)               &
+                    ,MU=grid%mu_2 , MUB=grid%mub                                 &
+                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe           )
+             CALL pxft ( grid=grid                                               &
+                    ,lineno=__LINE__                                             &
+                    ,flag_uv            = 0                                      &
+                    ,flag_rurv          = 0                                      &
+                    ,flag_wph           = 0                                      &
+                    ,flag_ww            = 0                                      &
+                    ,flag_t             = 0                                      &
+                    ,flag_mu            = 0                                      &
+                    ,flag_mut           = 0                                      &
+                    ,flag_moist         = 0                                      &
+                    ,flag_chem          = im                                     &
+                    ,flag_scalar        = 0                                      &
+                    ,positive_definite=.FALSE.                                   &
+                    ,moist=moist,chem=chem,scalar=scalar                         &
+                    ,fft_filter_lat = config_flags%fft_filter_lat                &
+                    ,dclat = dclat                                               &
+                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                    ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                    ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+             CALL uncouple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im)             &
+                    ,MU=grid%mu_2 , MUB=grid%mub                                 &
+                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
+           END DO
+         END IF
+   
+         IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
+           CALL wrf_debug ( 200 , ' call filter scalar ' )
+           DO im = PARAM_FIRST_SCALAR, num_3d_s
+             CALL couple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im)           &
+                  ,MU=grid%mu_2 , MUB=grid%mub                                 &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
+             CALL pxft ( grid=grid                                             &
+                  ,lineno=__LINE__                                             &
+                  ,flag_uv            = 0                                      &
+                  ,flag_rurv          = 0                                      &
+                  ,flag_wph           = 0                                      &
+                  ,flag_ww            = 0                                      &
+                  ,flag_t             = 0                                      &
+                  ,flag_mu            = 0                                      &
+                  ,flag_mut           = 0                                      &
+                  ,flag_moist         = 0                                      &
+                  ,flag_chem          = 0                                      &
+                  ,flag_scalar        = im                                     &
+                  ,positive_definite=.FALSE.                                   &
+                  ,moist=moist,chem=chem,scalar=scalar                         &
+                  ,fft_filter_lat = config_flags%fft_filter_lat                &
+                  ,dclat = dclat                                               &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+             CALL uncouple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im)   &
+                  ,MU=grid%mu_2 , MUB=grid%mub                                 &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
+           END DO
+         END IF
+       END IF ! polar filter test
+
+!-----------------------------------------------------------
+!  END rk3 substep polar filter for scalars (moist,chem,scalar)
+!-----------------------------------------------------------
+
+!-----------------------------------------------------------
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!  here's where we need a wide comm stencil - these are the 
+!  uncoupled variables so are used for high order calc in
+!  advection and mixong routines.
+!
+!
+!                                  * * * * * * *
+!                     * * * * *    * * * * * * *
+!            *        * * * * *    * * * * * * *
+!          * + *      * * + * *    * * * + * * *
+!            *        * * * * *    * * * * * * *
+!                     * * * * *    * * * * * * *
+!                                  * * * * * * *
+!
+! al        x
+!
+!  2D variable
+! mu_2      x
+!
+! (adv order <=4)
+! u_2                     x
+! v_2                     x
+! w_2                     x
+! t_2                     x
+! ph_2                    x
+!
+! (adv order <=6)
+! u_2                                    x
+! v_2                                    x
+! w_2                                    x
+! t_2                                    x
+! ph_2                                   x
+!
+!  4D variable
+! moist                   x
+! chem                    x
+! scalar                  x
+
+#ifdef DM_PARALLEL
+       IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#    include "HALO_EM_D2_3.inc"
+       ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#    include "HALO_EM_D2_5.inc"
+       ELSE 
+         WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+         CALL wrf_error_fatal(TRIM(wrf_err_message))
+       ENDIF
+#  include "PERIOD_BDY_EM_D.inc"
+#  include "PERIOD_BDY_EM_MOIST2.inc"
+#  include "PERIOD_BDY_EM_CHEM2.inc"
+#  include "PERIOD_BDY_EM_SCALAR2.inc"
+#endif
+
+BENCH_START(bc_end_tim)
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij )
+       tile_bc_loop_1: DO ij = 1 , grid%num_tiles
+         CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_2' )
+
+         CALL rk_phys_bc_dry_2( config_flags,                     &
+                                grid%u_2, grid%v_2, grid%w_2,     &
+                                grid%t_2, grid%ph_2, grid%mu_2,   &
+                                ids, ide, jds, jde, kds, kde,     &
+                                ims, ime, jms, jme, kms, kme,     &
+                                ips, ipe, jps, jpe, kps, kpe,     &
+                                grid%i_start(ij), grid%i_end(ij), &
+                                grid%j_start(ij), grid%j_end(ij), &
+                                k_start    , k_end               )
+
+BENCH_START(diag_w_tim)
+         IF (.not. config_flags%non_hydrostatic) THEN
+           CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, dt_rk,  &
+                            grid%u_2, grid%v_2, grid%ht,                           &
+                            grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
+                            ids, ide, jds, jde, kds, kde,           &
+                            ims, ime, jms, jme, kms, kme,           &
+                            grid%i_start(ij), grid%i_end(ij),       &
+                            grid%j_start(ij), grid%j_end(ij),       &
+                            k_start    , k_end                     )
+         ENDIF
+BENCH_END(diag_w_tim)
+
+         IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
+
+           moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
+  
+             CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags,   &
+                                     ids, ide, jds, jde, kds, kde,             &
+                                     ims, ime, jms, jme, kms, kme,             &
+                                     ips, ipe, jps, jpe, kps, kpe,             &
+                                     grid%i_start(ij), grid%i_end(ij),                   &
+                                     grid%j_start(ij), grid%j_end(ij),                   &
+                                     k_start    , k_end                       )
+           END DO moisture_loop_bdy_1
+
+         ENDIF
+
+         IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
+
+           chem_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
+
+             CALL set_physical_bc3d( chem(ims,kms,jms,ic), 'p', config_flags,   &
+                                     ids, ide, jds, jde, kds, kde,            &
+                                     ims, ime, jms, jme, kms, kme,            &
+                                     ips, ipe, jps, jpe, kps, kpe,            &
+                                     grid%i_start(ij), grid%i_end(ij),                  &
+                                     grid%j_start(ij), grid%j_end(ij),                  &
+                                     k_start    , k_end-1                    )
+
+           END DO chem_species_bdy_loop_1
+
+         END IF
+
+         IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
+
+           scalar_species_bdy_loop_1 : DO is = PARAM_FIRST_SCALAR , num_3d_s
+
+             CALL set_physical_bc3d( scalar(ims,kms,jms,is), 'p', config_flags,   &
+                                     ids, ide, jds, jde, kds, kde,            &
+                                     ims, ime, jms, jme, kms, kme,            &
+                                     ips, ipe, jps, jpe, kps, kpe,            &
+                                     grid%i_start(ij), grid%i_end(ij),                  &
+                                     grid%j_start(ij), grid%j_end(ij),                  &
+                                     k_start    , k_end-1                    )
+
+           END DO scalar_species_bdy_loop_1
+
+         END IF
+
+         IF (config_flags%km_opt .eq. 2) THEN
+
+           CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags,  &
+                                   ids, ide, jds, jde, kds, kde,            &
+                                   ims, ime, jms, jme, kms, kme,            &
+                                   ips, ipe, jps, jpe, kps, kpe,            &
+                                   grid%i_start(ij), grid%i_end(ij),        &
+                                   grid%j_start(ij), grid%j_end(ij),        &
+                                   k_start    , k_end                      )
+         END IF
+
+       END DO tile_bc_loop_1
+       !$OMP END PARALLEL DO
+BENCH_END(bc_end_tim)
+
+
+#ifdef DM_PARALLEL
+
+!                           * * * * *
+!         *        * * *    * * * * *
+!       * + *      * + *    * * + * *
+!         *        * * *    * * * * *
+!                           * * * * *
+
+! moist, chem, scalar, tke      x
+
+
+       IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+         IF ( (config_flags%pd_tke) .and. (rk_step == rk_order-1) ) THEN
+#         include "HALO_EM_TKE_5.inc"
+         ELSE
+#         include "HALO_EM_TKE_3.inc"
+         ENDIF
+       ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+         IF ( (config_flags%pd_tke) .and. (rk_step == rk_order-1) ) THEN
+#         include "HALO_EM_TKE_7.inc"
+         ELSE
+#         include "HALO_EM_TKE_5.inc"
+         ENDIF
+       ELSE
+         WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+         CALL wrf_error_fatal(TRIM(wrf_err_message))
+       ENDIF
+
+       IF ( num_moist .GE. PARAM_FIRST_SCALAR ) THEN
+         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+           IF ( (config_flags%pd_moist) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_MOIST_E_5.inc"
+           ELSE
+#        include "HALO_EM_MOIST_E_3.inc"
+           END IF
+         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+           IF ( (config_flags%pd_moist) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_MOIST_E_7.inc"
+           ELSE
+#        include "HALO_EM_MOIST_E_5.inc"
+           END IF
+         ELSE
+           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+           CALL wrf_error_fatal(TRIM(wrf_err_message))
+         ENDIF
+       ENDIF
+       IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
+         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+           IF ( (config_flags%pd_chem) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_CHEM_E_5.inc"
+           ELSE
+#        include "HALO_EM_CHEM_E_3.inc"
+           ENDIF
+         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+           IF ( (config_flags%pd_chem) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_CHEM_E_7.inc"
+           ELSE
+#        include "HALO_EM_CHEM_E_5.inc"
+           ENDIF
+         ELSE
+           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+           CALL wrf_error_fatal(TRIM(wrf_err_message))
+         ENDIF
+       ENDIF
+       IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
+         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
+           IF ( (config_flags%pd_scalar) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_SCALAR_E_5.inc"
+           ELSE
+#        include "HALO_EM_SCALAR_E_3.inc"
+           ENDIF
+         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
+           IF ( (config_flags%pd_scalar) .and. (rk_step == rk_order-1) ) THEN
+#        include "HALO_EM_SCALAR_E_7.inc"
+           ELSE
+#        include "HALO_EM_SCALAR_E_5.inc"
+           ENDIF
+         ELSE
+           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
+           CALL wrf_error_fatal(TRIM(wrf_err_message))
+         ENDIF
+       ENDIF
+#endif
+
+     ENDIF rk_step_1_check
+
+
+!**********************************************************
+!
+!  end of RK predictor-corrector loop
+!
+!**********************************************************
+
+   END DO Runge_Kutta_loop
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+   DO ij = 1 , grid%num_tiles
+
+BENCH_START(advance_ppt_tim)
+     CALL wrf_debug ( 200 , ' call advance_ppt' )
+     CALL advance_ppt(grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
+                      grid%rqicuten,grid%rqscuten,grid%rainc,grid%raincv,grid%pratec, grid%nca,    &
+                      grid%htop,grid%hbot,grid%cutop,grid%cubot,                 &
+                      grid%cuppt, grid%dt, config_flags,                   &
+                      ids,ide, jds,jde, kds,kde,             &
+                      ims,ime, jms,jme, kms,kme,             &
+                      grid%i_start(ij), grid%i_end(ij),      &
+                      grid%j_start(ij), grid%j_end(ij),      &
+                      k_start    , k_end                    )
+BENCH_END(advance_ppt_tim)
+
+   ENDDO
+  !$OMP END PARALLEL DO
+
+!
+!
+! (5) time-split physics.
+!
+!     Microphysics are the only time  split physics in the WRF model 
+!     at this time.  Split-physics begins with the calculation of
+!     needed diagnostic quantities (pressure, temperature, etc.)
+!     followed by a call to the microphysics driver, 
+!     and finishes with a clean-up, storing off of a diabatic tendency
+!     from the moist physics, and a re-calulation of the  diagnostic
+!     quantities pressure and density.
+!

+!
+
+   IF( config_flags%specified .or. config_flags%nested ) THEN
+     sz = grid%spec_zone
+   ELSE
+     sz = 0
+   ENDIF
+
+!!!!****MARS MARS
+!!!!****MARS MARS
+
+!   IF (config_flags%mp_physics /= 0)  then
+!
+!     !$OMP PARALLEL DO   &
+!     !$OMP PRIVATE ( ij, its, ite, jts, jte )
+!
+!     scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles
+!
+!       IF ( config_flags%periodic_x ) THEN
+!         its = max(grid%i_start(ij),ids)
+!         ite = min(grid%i_end(ij),ide-1)
+!       ELSE
+!         its = max(grid%i_start(ij),ids+sz)
+!         ite = min(grid%i_end(ij),ide-1-sz)
+!       ENDIF
+!       jts = max(grid%j_start(ij),jds+sz)
+!       jte = min(grid%j_end(ij),jde-1-sz)
+!
+!       CALL wrf_debug ( 200 , ' call moist_physics_prep' )
+!BENCH_START(moist_physics_prep_tim)
+!       CALL moist_physics_prep_em( grid%t_2, grid%t_1, t0, rho,                &
+!                                   grid%al, grid%alb, grid%p, p8w, p0, grid%pb,          &
+!                                   grid%ph_2, grid%phb, th_phy, pi_phy, p_phy, &
+!                                   grid%z, z_at_w, dz8w,                  &
+!                                   dtm, grid%h_diabatic,                  &
+!                                   config_flags,grid%fnm, grid%fnp,            &
+!                                   ids, ide, jds, jde, kds, kde,     &
+!                                   ims, ime, jms, jme, kms, kme,     &
+!                                   its, ite, jts, jte,               &
+!                                   k_start    , k_end               )
+!BENCH_END(moist_physics_prep_tim)
+!     END DO scalar_tile_loop_1a
+!     !$OMP END PARALLEL DO
+!
+!     CALL wrf_debug ( 200 , ' call microphysics_driver' )
+!
+!     grid%sr = 0.
+!     specified_bdy = config_flags%specified .OR. config_flags%nested
+!     channel_bdy = config_flags%specified .AND. config_flags%periodic_x
+!
+!BENCH_START(micro_driver_tim)
+!
+!     CALL microphysics_driver(                                            &
+!      &         DT=dtm             ,DX=grid%dx              ,DY=grid%dy   &
+!      &        ,DZ8W=dz8w          ,F_ICE_PHY=grid%f_ice_phy              &
+!      &        ,ITIMESTEP=grid%itimestep                    ,LOWLYR=grid%lowlyr  &
+!      &        ,P8W=p8w            ,P=p_phy            ,PI_PHY=pi_phy     &
+!      &        ,RHO=rho            ,SPEC_ZONE=grid%spec_zone              &
+!      &        ,SR=grid%sr              ,TH=th_phy                        &
+!      &        ,WARM_RAIN=grid%warm_rain                                  &
+!      &        ,T8W=t8w                                                   &
+!      &        ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h &
+!      &        ,NSOURCE=grid%qndropsource                                 &
+!#ifdef WRF_CHEM
+!      &        ,QLSINK=grid%qlsink,CLDFRA_OLD=grid%cldfra_old             &
+!      &        ,PRECR=grid%precr, PRECI=grid%preci, PRECS=grid%precs, PRECG=grid%precg &
+!      &        ,CHEM_OPT=config_flags%chem_opt, PROGN=config_flags%progn  &
+!#endif
+!      &        ,XLAND=grid%xland                                          &
+!      &        ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy       &
+!      &        ,F_RAIN_PHY=grid%f_rain_phy                                &
+!      &        ,F_RIMEF_PHY=grid%f_rimef_phy                              &
+!      &        ,MP_PHYSICS=config_flags%mp_physics                        &
+!      &        ,ID=grid%id                                                &
+!      &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde         &
+!      &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme         &
+!#ifdef RUN_ON_GPU
+!      &        ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe         &
+!#endif
+!      &        ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)         &
+!      &        ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)         &
+!      &        ,KTS=k_start, KTE=min(k_end,kde-1)                         &
+!      &        ,NUM_TILES=grid%num_tiles                                  &
+!      &        ,NAER=grid%naer                                            &
+!                 ! Optional
+!      &        , RAINNC=grid%rainnc, RAINNCV=grid%rainncv                 &
+!      &        , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv                 &
+!      &        , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv     &
+!      &        , W=grid%w_2, Z=grid%z, HT=grid%ht                         &
+!      &        , MP_RESTART_STATE=grid%mp_restart_state                   &
+!      &        , TBPVS_STATE=grid%tbpvs_state                             & ! etampnew
+!      &        , TBPVS0_STATE=grid%tbpvs0_state                           & ! etampnew
+!      &        , QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV               &
+!      &        , QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC               &
+!      &        , QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR               &
+!      &        , QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI               &
+!      &        , QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS               &
+!      &        , QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG               &
+!      &        , QNDROP_CURR=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP &
+!      &        , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI          &
+!      &        , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT              &
+!      &        , QNS_CURR=scalar(ims,kms,jms,P_QNS), F_QNS=F_QNS          &  
+!      &        , QNR_CURR=scalar(ims,kms,jms,P_QNR), F_QNR=F_QNR          &  
+!      &        , QNG_CURR=scalar(ims,kms,jms,P_QNG), F_QNG=F_QNG          &  
+!      &        , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten             &  
+!      &        , qicuten=grid%rqicuten,mu=grid%mut                        &  
+!      &        , HAIL=config_flags%gsfcgce_hail                           & ! for gsfcgce
+!      &        , ICE2=config_flags%gsfcgce_2ice                           & ! for gsfcgce
+!                                                                          )
+!BENCH_END(micro_driver_tim)
+!
+!#if 0
+!BENCH_START(microswap_2)
+!! for load balancing; communication to redistribute the points
+!     IF ( config_flags%mp_physics .EQ. ETAMPNEW ) THEN
+!#include "SWAP_ETAMP_NEW.inc"
+!     ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN
+!#include "SWAP_WSM3.inc"
+!     ENDIF
+!BENCH_END(microswap_2)
+!#endif
+!
+!     CALL wrf_debug ( 200 , ' call moist_physics_finish' )
+!BENCH_START(moist_phys_end_tim)
+!
+!     !$OMP PARALLEL DO   &
+!     !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
+!
+!     DO ij = 1 , grid%num_tiles
+!
+!       IF ( config_flags%periodic_x ) THEN
+!         its = max(grid%i_start(ij),ids)
+!         ite = min(grid%i_end(ij),ide-1)
+!       ELSE
+!         its = max(grid%i_start(ij),ids+sz)
+!         ite = min(grid%i_end(ij),ide-1-sz)
+!       ENDIF
+!       jts = max(grid%j_start(ij),jds+sz)
+!       jte = min(grid%j_end(ij),jde-1-sz)
+!
+!       CALL microphysics_zero_out (                                    &
+!                      moist , num_moist , config_flags ,                &
+!                      ids, ide, jds, jde, kds, kde,                     &
+!                      ims, ime, jms, jme, kms, kme,                     &
+!                      its, ite, jts, jte,                               &
+!                      k_start    , k_end                                )
+!
+!
+!       CALL moist_physics_finish_em( grid%t_2, grid%t_1, t0, grid%muts, th_phy,       &
+!                                      grid%h_diabatic, dtm, config_flags,    &
+!                                      ids, ide, jds, jde, kds, kde,     &
+!                                      ims, ime, jms, jme, kms, kme,     &
+!                                      its, ite, jts, jte,               &
+!                                      k_start    , k_end               )
+!
+!     END DO
+!     !$OMP END PARALLEL DO
+!
+!   ENDIF  ! microphysics test
+
+!-----------------------------------------------------------
+!  filter for moist variables post-microphysics and end of timestep
+!-----------------------------------------------------------
+
+   IF (config_flags%polar) THEN
+     IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
+       CALL wrf_debug ( 200 , ' call filter moist' )
+       DO im = PARAM_FIRST_SCALAR, num_3d_m
+         DO jj = jps, MIN(jpe,jde-1)
+           DO kk = kps, MIN(kpe,kde-1)
+             DO ii = ips, MIN(ipe,ide-1)
+               moist(ii,kk,jj,im)=moist(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
+             ENDDO
+           ENDDO
+         ENDDO
+ 
+         CALL pxft ( grid=grid                                                 &
+                  ,lineno=__LINE__                                             &
+                  ,flag_uv            = 0                                      &
+                  ,flag_rurv          = 0                                      &
+                  ,flag_wph           = 0                                      &
+                  ,flag_ww            = 0                                      &
+                  ,flag_t             = 0                                      &
+                  ,flag_mu            = 0                                      &
+                  ,flag_mut           = 0                                      &
+                  ,flag_moist         = im                                     &
+                  ,flag_chem          = 0                                      &
+                  ,flag_scalar        = 0                                      &
+                  ,positive_definite=.FALSE.                                   &
+                  ,moist=moist,chem=chem,scalar=scalar                         &
+                  ,fft_filter_lat = config_flags%fft_filter_lat                &
+                  ,dclat = dclat                                               &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+ 
+         DO jj = jps, MIN(jpe,jde-1)
+           DO kk = kps, MIN(kpe,kde-1)
+             DO ii = ips, MIN(ipe,ide-1)
+               moist(ii,kk,jj,im)=moist(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
+             ENDDO
+           ENDDO
+         ENDDO
+       ENDDO
+     ENDIF
+   ENDIF
+
+!-----------------------------------------------------------
+!  end filter for moist variables post-microphysics and end of timestep
+!-----------------------------------------------------------
+
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
+   scalar_tile_loop_1ba: DO ij = 1 , grid%num_tiles
+
+     IF ( config_flags%periodic_x ) THEN
+       its = max(grid%i_start(ij),ids)
+       ite = min(grid%i_end(ij),ide-1)
+     ELSE
+       its = max(grid%i_start(ij),ids+sz)
+       ite = min(grid%i_end(ij),ide-1-sz)
+     ENDIF
+     jts = max(grid%j_start(ij),jds+sz)
+     jte = min(grid%j_end(ij),jde-1-sz)
+
+     CALL calc_p_rho_phi( moist, num_3d_m,                &
+                          grid%al, grid%alb, grid%mu_2, grid%muts,              &
+                          grid%ph_2, grid%p, grid%pb, grid%t_2,                 &
+                          p0, t0, grid%znu, grid%dnw, grid%rdnw,           &
+                          grid%rdn, config_flags%non_hydrostatic,             &
+                          ids, ide, jds, jde, kds, kde,     &
+                          ims, ime, jms, jme, kms, kme,     &
+                          its, ite, jts, jte,               &
+                          k_start    , k_end               )
+
+   END DO scalar_tile_loop_1ba
+   !$OMP END PARALLEL DO
+BENCH_END(moist_phys_end_tim)
+
+   IF (.not. config_flags%non_hydrostatic) THEN
+#ifdef DM_PARALLEL
+#    include "HALO_EM_HYDRO_UV.inc"
+#    include "PERIOD_EM_HYDRO_UV.inc"
+#endif
+     !$OMP PARALLEL DO   &
+     !$OMP PRIVATE ( ij )
+     DO ij = 1 , grid%num_tiles
+       CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, dt_rk,  &
+                       grid%u_2, grid%v_2, grid%ht,                           &
+                       grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
+                       ids, ide, jds, jde, kds, kde,           &
+                       ims, ime, jms, jme, kms, kme,           &
+                       grid%i_start(ij), grid%i_end(ij),       &
+                       grid%j_start(ij), grid%j_end(ij),       &
+                       k_start    , k_end                     )
+
+     END DO
+     !$OMP END PARALLEL DO
+
+   END IF
+
+   CALL wrf_debug ( 200 , ' call chem polar filter ' )
+
+!-----------------------------------------------------------
+!  filter for chem and scalar variables at end of timestep
+!-----------------------------------------------------------
+
+   IF (config_flags%polar) THEN
+
+     IF ( num_3d_c >= PARAM_FIRST_SCALAR ) then
+       chem_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_c
+         DO jj = jps, MIN(jpe,jde-1)
+           DO kk = kps, MIN(kpe,kde-1)
+             DO ii = ips, MIN(ipe,ide-1)
+               chem(ii,kk,jj,im)=chem(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
+             ENDDO
+           ENDDO
+         ENDDO
+
+         CALL pxft ( grid=grid                                                 &
+                  ,lineno=__LINE__                                             &
+                  ,flag_uv            = 0                                      &
+                  ,flag_rurv          = 0                                      &
+                  ,flag_wph           = 0                                      &
+                  ,flag_ww            = 0                                      &
+                  ,flag_t             = 0                                      &
+                  ,flag_mu            = 0                                      &
+                  ,flag_mut           = 0                                      &
+                  ,flag_moist         = 0                                      &
+                  ,flag_chem          = im                                     &
+                  ,flag_scalar        = 0                                      &
+                  ,positive_definite=.FALSE.                                   &
+                  ,moist=moist,chem=chem,scalar=scalar                         &
+                  ,fft_filter_lat = config_flags%fft_filter_lat                &
+                  ,dclat = dclat                                               &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+
+         DO jj = jps, MIN(jpe,jde-1)
+           DO kk = kps, MIN(kpe,kde-1)
+             DO ii = ips, MIN(ipe,ide-1)
+               chem(ii,kk,jj,im)=chem(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
+             ENDDO
+           ENDDO
+         ENDDO
+       ENDDO chem_filter_loop
+     ENDIF
+
+     IF ( num_3d_s >= PARAM_FIRST_SCALAR ) then
+       scalar_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_s
+         DO jj = jps, MIN(jpe,jde-1)
+           DO kk = kps, MIN(kpe,kde-1)
+             DO ii = ips, MIN(ipe,ide-1)
+               scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
+             ENDDO
+           ENDDO
+         ENDDO
+
+         CALL pxft ( grid=grid                                                 &
+                  ,lineno=__LINE__                                             &
+                  ,flag_uv            = 0                                      &
+                  ,flag_rurv          = 0                                      &
+                  ,flag_wph           = 0                                      &
+                  ,flag_ww            = 0                                      &
+                  ,flag_t             = 0                                      &
+                  ,flag_mu            = 0                                      &
+                  ,flag_mut           = 0                                      &
+                  ,flag_moist         = 0                                      &
+                  ,flag_chem          = 0                                      &
+                  ,flag_scalar        = im                                     &
+                  ,positive_definite=.FALSE.                                   &
+                  ,moist=moist,chem=chem,scalar=scalar                         &
+                  ,fft_filter_lat = config_flags%fft_filter_lat                &
+                  ,dclat = dclat                                               &
+                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
+                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
+                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
+                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
+                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
+
+         DO jj = jps, MIN(jpe,jde-1)
+           DO kk = kps, MIN(kpe,kde-1)
+             DO ii = ips, MIN(ipe,ide-1)
+               scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
+             ENDDO
+           ENDDO
+         ENDDO
+       ENDDO scalar_filter_loop
+     ENDIF
+   ENDIF
+
+!-----------------------------------------------------------
+!  end filter for chem and scalar variables at end of timestep
+!-----------------------------------------------------------
+
+   !  We're finished except for boundary condition (and patch) update
+
+   ! Boundary condition time (or communication time).  At this time, we have
+   ! implemented periodic and symmetric physical boundary conditions.
+
+   ! b.c. routine for data within patch.
+
+   ! we need to do both time levels of 
+   ! data because the time filter only works in the physical solution space.
+
+   ! First, do patch communications for boundary conditions (periodicity)
+
+!-----------------------------------------------------------
+!  Stencils for patch communications  (WCS, 29 June 2001)
+!
+!  here's where we need a wide comm stencil - these are the 
+!  uncoupled variables so are used for high order calc in
+!  advection and mixong routines.
+!
+!                              * * * * *
+!            *        * * *    * * * * *
+!          * + *      * + *    * * + * * 
+!            *        * * *    * * * * *
+!                              * * * * *
+!
+!   grid%u_1                            x
+!   grid%u_2                            x
+!   grid%v_1                            x
+!   grid%v_2                            x
+!   grid%w_1                            x
+!   grid%w_2                            x
+!   grid%t_1                            x
+!   grid%t_2                            x
+!  grid%ph_1                            x
+!  grid%ph_2                            x
+!  grid%tke_1                           x
+!  grid%tke_2                           x
+!
+!    2D variables
+!  grid%mu_1     x
+!  grid%mu_2     x
+!
+!    4D variables
+!  moist                         x
+!   chem                         x
+! scalar                         x
+!----------------------------------------------------------
+
+
+#ifdef DM_PARALLEL
+   IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#    include "HALO_EM_D3_3.inc"
+   ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#    include "HALO_EM_D3_5.inc"
+   ELSE 
+      WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+      CALL wrf_error_fatal(TRIM(wrf_err_message))
+   ENDIF
+#  include "PERIOD_BDY_EM_D3.inc"
+#  include "PERIOD_BDY_EM_MOIST.inc"
+#  include "PERIOD_BDY_EM_CHEM.inc"
+#  include "PERIOD_BDY_EM_SCALAR.inc"
+#endif
+
+!  now set physical b.c on a patch
+
+BENCH_START(bc_2d_tim)
+   !$OMP PARALLEL DO   &
+   !$OMP PRIVATE ( ij )
+   tile_bc_loop_2: DO ij = 1 , grid%num_tiles
+
+     CALL wrf_debug ( 200 , ' call set_phys_bc_dry_2' )
+
+     CALL set_phys_bc_dry_2( config_flags,                           &
+                             grid%u_1, grid%u_2, grid%v_1, grid%v_2, grid%w_1, grid%w_2,           &
+                             grid%t_1, grid%t_2, grid%ph_1, grid%ph_2, grid%mu_1, grid%mu_2,       &
+                             ids, ide, jds, jde, kds, kde,           &
+                             ims, ime, jms, jme, kms, kme,           &
+                             ips, ipe, jps, jpe, kps, kpe,           &
+                             grid%i_start(ij), grid%i_end(ij),       &
+                             grid%j_start(ij), grid%j_end(ij),       &
+                             k_start    , k_end                     )
+
+     CALL set_physical_bc3d( grid%tke_1, 'p', config_flags,   &
+                             ids, ide, jds, jde, kds, kde,            &
+                             ims, ime, jms, jme, kms, kme,            &
+                             ips, ipe, jps, jpe, kps, kpe,            &
+                             grid%i_start(ij), grid%i_end(ij),        &
+                             grid%j_start(ij), grid%j_end(ij),        &
+                             k_start    , k_end-1                    )
+
+     CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags,  &
+                             ids, ide, jds, jde, kds, kde,            &
+                             ims, ime, jms, jme, kms, kme,            &
+                             ips, ipe, jps, jpe, kps, kpe,            &
+                             grid%i_start(ij), grid%i_end(ij),        &
+                             grid%j_start(ij), grid%j_end(ij),        &
+                             k_start    , k_end                      )
+
+     moisture_loop_bdy_2 : DO im = PARAM_FIRST_SCALAR , num_3d_m
+
+       CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p',           &
+                               config_flags,                           &
+                               ids, ide, jds, jde, kds, kde,           &
+                               ims, ime, jms, jme, kms, kme,           &
+                               ips, ipe, jps, jpe, kps, kpe,           &
+                               grid%i_start(ij), grid%i_end(ij),       &
+                               grid%j_start(ij), grid%j_end(ij),       &
+                               k_start    , k_end                     )
+
+     END DO moisture_loop_bdy_2
+
+     chem_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
+
+       CALL set_physical_bc3d( chem(ims,kms,jms,ic) , 'p', config_flags,  &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               ips, ipe, jps, jpe, kps, kpe,            &
+                               grid%i_start(ij), grid%i_end(ij),                  &
+                               grid%j_start(ij), grid%j_end(ij),                  &
+                               k_start    , k_end                      )
+
+     END DO chem_species_bdy_loop_2
+
+     scalar_species_bdy_loop_2 : DO is = PARAM_FIRST_SCALAR , num_3d_s
+
+       CALL set_physical_bc3d( scalar(ims,kms,jms,is) , 'p', config_flags,  &
+                               ids, ide, jds, jde, kds, kde,            &
+                               ims, ime, jms, jme, kms, kme,            &
+                               ips, ipe, jps, jpe, kps, kpe,            &
+                               grid%i_start(ij), grid%i_end(ij),                  &
+                               grid%j_start(ij), grid%j_end(ij),                  &
+                               k_start    , k_end                      )
+
+     END DO scalar_species_bdy_loop_2
+
+   END DO tile_bc_loop_2
+   !$OMP END PARALLEL DO
+BENCH_END(bc_2d_tim)
+
+   IF( config_flags%specified .or. config_flags%nested ) THEN 
+     grid%dtbc = grid%dtbc + grid%dt
+   ENDIF
+
+!!!!****MARS MARS
+!!!!****MARS MARS
+
+!! calculate some model diagnostics.
+!
+!   CALL wrf_debug ( 200 , ' call diagnostic_driver' )
+!   
+!   CALL diagnostic_output_calc(                                            &
+!      &              DPSDT=grid%dpsdt   ,DMUDT=grid%dmudt                  &
+!      &             ,P8W=p8w   ,PK1M=grid%pk1m                             &
+!      &             ,MU_2=grid%mu_2  ,MU_2M=grid%mu_2m                     &
+!      &             ,U=grid%u_2    ,V=grid%v_2                             &
+!      &             ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv           &
+!      &             ,RAINC=grid%rainc    ,RAINNC=grid%rainnc               &
+!      &             ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh     &
+!      &             ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width      &
+!      &             ,XTIME=grid%xtime                                      &
+!                  ! Selection flag
+!      &             ,DIAG_PRINT=config_flags%diag_print                    &
+!                  ! Dimension arguments
+!      &             ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde     &
+!      &             ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme     &
+!      &             ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe     &
+!      &             ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)     &
+!      &             ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)     &
+!      &             ,KTS=k_start, KTE=min(k_end,kde-1)                     &
+!      &             ,NUM_TILES=grid%num_tiles                              &
+!      &                                                          )
+
+#ifdef DM_PARALLEL
+!-----------------------------------------------------------------------
+! see above
+!--------------------------------------------------------------
+   CALL wrf_debug ( 200 , ' call HALO_RK_E' )
+   IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#    include "HALO_EM_E_3.inc"
+   ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#    include "HALO_EM_E_5.inc"
+   ELSE
+     WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+     CALL wrf_error_fatal(TRIM(wrf_err_message))
+   ENDIF
+#endif
+
+#ifdef DM_PARALLEL
+   IF ( num_moist >= PARAM_FIRST_SCALAR  ) THEN
+!-----------------------------------------------------------------------
+! see above
+!--------------------------------------------------------------
+     CALL wrf_debug ( 200 , ' call HALO_RK_MOIST' )
+     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#      include "HALO_EM_MOIST_E_3.inc"
+     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#      include "HALO_EM_MOIST_E_5.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   ENDIF
+   IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
+!-----------------------------------------------------------------------
+! see above
+!--------------------------------------------------------------
+     CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
+     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#      include "HALO_EM_CHEM_E_3.inc"
+     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#      include "HALO_EM_CHEM_E_5.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   ENDIF
+   IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
+!-----------------------------------------------------------------------
+! see above
+!--------------------------------------------------------------
+     CALL wrf_debug ( 200 , ' call HALO_RK_SCALAR' )
+     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
+#      include "HALO_EM_SCALAR_E_3.inc"
+     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
+#      include "HALO_EM_SCALAR_E_5.inc"
+     ELSE
+       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
+       CALL wrf_error_fatal(TRIM(wrf_err_message))
+     ENDIF
+   ENDIF
+#endif
+
+!  Max values of CFL for adaptive time step scheme
+
+   DEALLOCATE(max_vert_cfl_tmp)
+   DEALLOCATE(max_horiz_cfl_tmp)
+
+
+!!!!!!!!!!!!!MARS
+!!!!!!!!!!!!!MARS
+!!
+!! to get lighter output files, output the sum of the constant value phb (pb)
+!with ph (p)
+!! --- these variables were added to the Registry
+!!
+!!pressure
+     grid%ptot  = grid%p + grid%pb
+!!geopotential: already in php
+     grid%phtot = grid%php
+!!mass
+     !grid%em_mutot = grid%em_mub + grid%em_mu_2
+!!
+!!!!!!!!!!!!!MARS
+!!!!!!!!!!!!!MARS
+
+
+   CALL wrf_debug ( 200 , ' call end of solve_em' )
+
+! Finish timers if compiled with -DBENCH.
+#include 
+
+   RETURN
+
+END SUBROUTINE solve_em
Index: /trunk/WRF.COMMON/WRFV3/frame/module_driver_constants.F
===================================================================
--- /trunk/WRF.COMMON/WRFV3/frame/module_driver_constants.F	(revision 2761)
+++ /trunk/WRF.COMMON/WRFV3/frame/module_driver_constants.F	(revision 2761)
@@ -0,0 +1,108 @@
+!WRF:DRIVER_LAYER:CONSTANTS
+!
+!  This MODULE contains all of the constants used in the model.  These
+!  are separated by uage within the code.
+
+MODULE module_driver_constants
+
+   !  0. The following tells the rest of the model what data ordering we are
+   !     using
+
+   INTEGER , PARAMETER :: DATA_ORDER_XYZ = 1
+   INTEGER , PARAMETER :: DATA_ORDER_YXZ = 2
+   INTEGER , PARAMETER :: DATA_ORDER_ZXY = 3
+   INTEGER , PARAMETER :: DATA_ORDER_ZYX = 4
+   INTEGER , PARAMETER :: DATA_ORDER_XZY = 5
+   INTEGER , PARAMETER :: DATA_ORDER_YZX = 6
+   INTEGER , PARAMETER :: DATA_ORDER_XY = DATA_ORDER_XYZ
+   INTEGER , PARAMETER :: DATA_ORDER_YX = DATA_ORDER_YXZ
+
+
+#include 
+
+   !  1. Following are constants for use in defining maximal values for array
+   !     definitions.  
+   !
+
+   !  The maximum number of levels in the model is how deeply the domains may
+   !  be nested.
+
+   INTEGER , PARAMETER :: max_levels      =  20
+
+   !  The maximum number of nests that can depend on a single parent and other way round
+
+   INTEGER , PARAMETER :: max_nests        =  20
+
+   !  The maximum number of parents that a nest can have (simplified assumption -> one only)
+
+   INTEGER , PARAMETER :: max_parents      =  1
+
+   !  The maximum number of domains is how many grids the model will be running.
+
+   INTEGER , PARAMETER :: max_domains     =   ( MAX_DOMAINS_F - 1 ) / 2 + 1
+
+   !  The maximum number of nest move specifications allowed in a namelist
+
+   INTEGER , PARAMETER :: max_moves       =   50
+
+   !  The maximum number of eta levels
+
+   INTEGER , PARAMETER :: max_eta         =   501
+
+   !  The maximum number of outer iterations (for DA minimisation)
+
+   INTEGER , PARAMETER :: max_outer_iterations = 10
+
+   !  The maximum number of instruments (for radiance DA)
+
+   INTEGER , PARAMETER :: max_instruments =   30
+
+   !  2. Following related to driver leve data structures for DM_PARALLEL communications
+
+#ifdef DM_PARALLEL
+   INTEGER , PARAMETER :: max_comms       =   1024
+#else
+   INTEGER , PARAMETER :: max_comms       =   1
+#endif
+
+   !  3. Following is information related to the file I/O.
+
+   !  These are the bounds of the available FORTRAN logical unit numbers for the file I/O.
+   !  Only logical unti numbers within these bounds will be chosen for I/O unit numbers.
+
+   INTEGER , PARAMETER :: min_file_unit = 10
+   INTEGER , PARAMETER :: max_file_unit = 99
+
+   !  4. Unfortunately, the following definition is needed here (rather
+   !     than the more logical place in share/module_model_constants.F)
+   !     for the namelist reads in frame/module_configure.F, and for some
+   !     conversions in share/set_timekeeping.F
+   !     Actually, using it here will mean that we don't need to set it
+   !     in share/module_model_constants.F, since this file will be
+   !     included (USEd) in:
+   !        frame/module_configure.F
+   !     which will be USEd in:
+   !        share/module_bc.F
+   !     which will be USEd in:
+   !        phys/module_radiation_driver.F
+   !     which is the other important place for it to be, and where
+   !     it is passed as a subroutine parameter to any physics subroutine.
+   !
+   !     P2SI is the number of SI seconds in an planetary solar day
+   !     divided by the number of SI seconds in an earth solar day
+!#if defined MARS
+!   !     For Mars, P2SI = 88775.2/86400.
+!   REAL , PARAMETER :: P2SI = 1.0274907
+!#elif defined TITAN
+!   !     For Titan, P2SI = 1378080.0/86400.
+!   REAL , PARAMETER :: P2SI = 15.95
+!#else
+   !     Default for Earth
+   REAL , PARAMETER :: P2SI = 1.0
+!!!!MARS
+!   REAL , PARAMETER :: P2SI = 1.0274907
+!#endif
+ CONTAINS
+   SUBROUTINE init_module_driver_constants
+   END SUBROUTINE init_module_driver_constants
+ END MODULE module_driver_constants
Index: unk/WRF.COMMON/WRFV3/modif_mars/Makefile
===================================================================
--- /trunk/WRF.COMMON/WRFV3/modif_mars/Makefile	(revision 2760)
+++ 	(revision )
@@ -1,64 +1,0 @@
-#
-
-LN      =       ln -sf
-MAKE    =       make -i -r
-RM      =       rm -f
-
-
-MODULES = \
-	module_physics_addtendc.o \
-	module_physics_init.o \
-	variables_mod.o \
-	update_inputs_physiq_mod.o \
-	update_outputs_physiq_mod.o \
-	iniphysiq_mod.o \
-	callphysiq_mod.o \
-	module_lmd_driver.o
-  
-OBJS    =
-
-NMM_MODULES =  
-
-LIBTARGET    =  physics
-TARGETDIR    =  ./
-
-$(LIBTARGET) :
-		if [ $(WRF_NMM_CORE) -eq 1 ] ; then \
-                  $(MAKE) nmm_contrib                                      ; \
-                  $(AR) $(ARFLAGS) ../main/$(LIBWRFLIB) $(MODULES) $(OBJS) $(NMM_OBJS) $(NMM_MODULES) ; \
-                else                                                         \
-                  $(MAKE) non_nmm                                          ; \
-                  $(AR) $(ARFLAGS) ../main/$(LIBWRFLIB) $(MODULES) $(OBJS)             ; \
-                fi
-
-include ../configure.wrf
-
-nmm_contrib : $(NMM_OBJS) $(NMM_MODULES) $(MODULES) $(OBJS)
-
-non_nmm : $(MODULES) $(OBJS)
-
-clean:
-	@ echo 'use the clean script'
-
-# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES)
-
-module_physics_addtendc.o: \
-		../frame/module_state_description.o \
-		../frame/module_configure.o
-
-module_physics_init.o : \
-		../frame/module_state_description.o \
-		../frame/module_configure.o \
-		../frame/module_wrf_error.o \
-		../frame/module_dm.o \
-		../share/module_model_constants.o 
-
-module_lmd_driver.o: \
-		../frame/module_state_description.o \
-		../frame/module_wrf_error.o \
-		../frame/module_configure.o \
-		../share/module_model_constants.o \
-#../frame/module_wrf_error.o \
-#../share/module_model_constants.o
-
-# DO NOT DELETE
Index: unk/WRF.COMMON/WRFV3/modif_mars/Makefile_dyn_em
===================================================================
--- /trunk/WRF.COMMON/WRFV3/modif_mars/Makefile_dyn_em	(revision 2760)
+++ 	(revision )
@@ -1,270 +1,0 @@
-#
-
-LN      =       ln -sf
-MAKE    =       make -i -r
-RM      =       rm -f
-
-
-MODULES =                 		\
-        module_advect_em.o   		\
-	module_diffusion_em.o  		\
-	module_small_step_em.o 		\
-        module_big_step_utilities_em.o  \
-        module_em.o         		\
-        module_solvedebug_em.o    	\
-        module_bc_em.o                  \
-        module_init_utilities.o         \
-	module_damping_em.o		\
-	module_polarfft.o		\
-        module_first_rk_step_part1.o    \
-        module_first_rk_step_part2.o    \
-	$(CASE_MODULE)
-
-# possible CASE_MODULE settings
-#	module_initialize_b_wave.o      \
-#	module_initialize_grav2d_x.o    \
-#	module_initialize_heldsuarez.o  \
-#	module_initialize_hill2d_x.o    \
-#	module_initialize_quarter_ss.o  \
-#	module_initialize_real.o        \
-#	module_initialize_lsm_x.o       \
-#	module_initialize_les.o         \
-#	module_initialize_squall2d_x.o  \
-#	module_initialize_squall2d_y.o 
-
-OBJS    = 		        \
-	init_modules_em.o       \
-	solve_em.o              \
-        start_em.o              \
-        shift_domain_em.o       \
-        couple_or_uncouple_em.o \
-        nest_init_utils.o	\
-        adapt_timestep_em.o     \
-        interp_domain_em.o
- 
-
-LIBTARGET    =  dyn_em
-TARGETDIR    =  ./
-$(LIBTARGET) :  $(MODULES) $(OBJS)
-		$(AR) $(ARFLAGS) ../main/$(LIBWRFLIB) $(MODULES) $(OBJS)
-
-include ../configure.wrf
-
-cio.o :
-	$(CC) -c $(CFLAGS) cio.c
-
-clean:
-	@ echo 'use the clean script'
-
-# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES)
-
-couple_or_uncouple_em.o: ../frame/module_domain.o \
-		../frame/module_configure.o \
-		../frame/module_driver_constants.o \
-		../frame/module_machine.o \
-		../frame/module_tiles.o \
-		../frame/module_dm.o \
-		../frame/module_state_description.o
-
-init_modules_em.o: module_big_step_utilities_em.o
-
-interp_domain_em.o: ../frame/module_domain.o \
-		../frame/module_configure.o 
-
-module_advect_em.o: ../share/module_bc.o \
-		../share/module_model_constants.o \
-		../frame/module_wrf_error.o
-
-module_bc_em.o: ../share/module_bc.o ../frame/module_configure.o \
-		../frame/module_wrf_error.o
-
-module_big_step_utilities_em.o: \
-		../share/module_llxy.o	\
-		../frame/module_domain.o \
-		../frame/module_configure.o  \
-		../frame/module_state_description.o \
-		../share/module_model_constants.o 
-
-module_damping_em.o: ../frame/module_wrf_error.o
-
-module_diffusion_em.o:  module_big_step_utilities_em.o \
-		../frame/module_configure.o  \
-		../frame/module_state_description.o \
-		../share/module_model_constants.o \
-		../share/module_bc.o \
-		../frame/module_wrf_error.o
-
-module_em.o:    module_big_step_utilities_em.o module_advect_em.o \
-		module_damping_em.o \
-		../frame/module_state_description.o \
-		../share/module_model_constants.o 
-
-module_polarfft.o: ../share/module_model_constants.o \
-		../frame/module_wrf_error.o
-
-module_small_step_em.o: \
-		../frame/module_configure.o  \
-		../share/module_model_constants.o 
-
-module_initialize_b_wave.o : \
-		../frame/module_domain.o \
-		../frame/module_configure.o  \
-		../frame/module_state_description.o \
-		../frame/module_timing.o \
-		../frame/module_dm.o \
-		../share/module_io_domain.o \
-		../share/module_model_constants.o \
-		../share/module_bc.o \
-		module_init_utilities.o
-
-module_initialize_grav2d_x.o: \
-		../frame/module_domain.o \
-		../frame/module_configure.o  \
-		../frame/module_state_description.o \
-		../frame/module_timing.o \
-		../frame/module_dm.o \
-		../share/module_io_domain.o \
-		../share/module_model_constants.o \
-		../share/module_bc.o \
-		module_init_utilities.o
-
-module_initialize_heldsuarez.o : \
-		../frame/module_domain.o \
-		../frame/module_configure.o  \
-		../frame/module_state_description.o \
-		../frame/module_timing.o \
-		../frame/module_dm.o \
-		../share/module_io_domain.o \
-		../share/module_model_constants.o \
-		../share/module_bc.o \
-		module_init_utilities.o
-
-module_initialize_hill2d_x.o: \
-		../frame/module_domain.o \
-		../frame/module_configure.o  \
-		../frame/module_state_description.o \
-		../frame/module_timing.o \
-		../frame/module_dm.o \
-		../share/module_io_domain.o \
-		../share/module_model_constants.o \
-		../share/module_bc.o \
-		module_init_utilities.o
-
-module_initialize_quarter_ss.o : \
-		../frame/module_domain.o \
-		../frame/module_configure.o  \
-		../frame/module_state_description.o \
-		../frame/module_timing.o \
-		../frame/module_dm.o \
-		../share/module_io_domain.o \
-		../share/module_model_constants.o \
-		../share/module_bc.o \
-		module_init_utilities.o
-
-module_initialize_les.o : \
-		../frame/module_domain.o \
-		../frame/module_configure.o  \
-		../frame/module_state_description.o \
-		../frame/module_timing.o \
-		../frame/module_dm.o \
-		../share/module_io_domain.o \
-		../share/module_model_constants.o \
-		../share/module_bc.o \
-		module_init_utilities.o
-
-module_initialize_real.o :  \
-		nest_init_utils.o	\
-		../share/module_llxy.o	\
-		../frame/module_domain.o \
-		../frame/module_configure.o  \
-		../frame/module_state_description.o \
-		../frame/module_timing.o \
-		../frame/module_dm.o \
-		../share/module_io_domain.o \
-		../share/module_model_constants.o \
-		../share/module_bc.o \
-		../share/module_soil_pre.o \
-		../share/module_optional_input.o
-
-module_initialize_squall2d_x.o : \
-		../frame/module_domain.o \
-		../frame/module_configure.o  \
-		../frame/module_state_description.o \
-		../frame/module_timing.o \
-		../frame/module_dm.o \
-		../share/module_io_domain.o \
-		../share/module_model_constants.o \
-		../share/module_bc.o \
-		module_init_utilities.o
-
-module_initialize_squall2d_y.o : \
-		../frame/module_domain.o \
-		../frame/module_configure.o  \
-		../frame/module_state_description.o \
-		../frame/module_timing.o \
-		../frame/module_dm.o \
-		../share/module_io_domain.o \
-		../share/module_model_constants.o \
-		../share/module_bc.o \
-		module_init_utilities.o
-
-nest_init_utils.o: \
-		../frame/module_domain.o \
-		../frame/module_configure.o
-
-start_em.o: module_bc_em.o \
-		../frame/module_domain.o \
-		../frame/module_configure.o  \
-		../frame/module_state_description.o \
-		../frame/module_timing.o \
-		../frame/module_dm.o \
-		../share/module_io_domain.o \
-		../share/module_model_constants.o \
-		../share/module_bc.o \
-		../share/module_date_time.o \
-		../phys/module_physics_init.o 
-
-solve_em.o:     module_small_step_em.o \
-		module_em.o            \
-		module_solvedebug_em.o \
-                module_bc_em.o         \
-		module_diffusion_em.o  \
-		module_big_step_utilities_em.o \
-                module_first_rk_step_part1.o \
-                module_first_rk_step_part2.o \
-		../frame/module_domain.o \
-		../frame/module_configure.o  \
-		../frame/module_driver_constants.o \
-		../frame/module_state_description.o \
-		../frame/module_machine.o \
-		../frame/module_tiles.o \
-		../frame/module_dm.o \
-		../share/module_llxy.o	\
-		../share/module_model_constants.o \
-		../share/module_bc.o \
-		../phys/module_physics_addtendc.o
-
-### pas sur
-module_first_rk_step_part1.o : \
-		../phys/module_lmd_driver.o 
-
-module_first_rk_step_part2.o : \
-		module_diffusion_em.o  \
-                module_bc_em.o         \
-		../frame/module_domain.o \
-		../frame/module_state_description.o \
-		../frame/module_driver_constants.o \
-		../frame/module_configure.o \
-		../frame/module_dm.o \
-		../share/module_bc.o 
-
-adapt_timestep_em.o: \
-                module_bc_em.o         \
-		../frame/module_domain.o \
-		../frame/module_configure.o  \
-		../frame/module_dm.o
-
-#		../chem/module_chem_utilities.o \
-# 		../chem/module_input_chem_data.o
-
-# DO NOT DELETE
Index: unk/WRF.COMMON/WRFV3/modif_mars/Registry.EM.newphys
===================================================================
--- /trunk/WRF.COMMON/WRFV3/modif_mars/Registry.EM.newphys	(revision 2760)
+++ 	(revision )
@@ -1,1841 +1,0 @@
-# Registry file, EM
-#                                               
-# At the present time this file is managed manually and edited by hand.                                         
-#                                               
-################################################################################
-# Dimension specifications
-#
-# This section of the Registry file is used to specify the dimensions
-# that will be used to define arrays. Dim is the one-letter name of the
-# dimension.  How defined can either be "standard_domain", which means
-# that the dimension (1) is one of the three spatial dimensions and (2)
-# it will be set using the standard namelist mechanism and domain data
-# structure dimension fields (e.g. sd31,ed31,sd32...).
-#
-# Order refers to which of the three sets of just-mentioned internal
-# dimension variables the dimension is referred to by in the driver.
-# That is, is it the first, second, or third dimension.  The registry
-# infers the mapping of its internal dimensions according to the
-# combination of Order and Coord-axis that are specified in this table.
-# Note that it is all right to more than one dimension name for, say, the
-# x dimension.  However, the Order and Coord-axis relationship must be
-# consistent throughout.
-# 
-# Note: these entries do not enforce storage order on a particular field.
-# That is determined by the dimension strings for each field. But it does
-# relate the dimspec to the internal data structures that the driver uses
-# to maintain the three physical domain dimensions.
-# 
-# "How defined" can also specify the name of a namelist variable from which
-# the definition for the dimension will come; this is specified as
-# "namelist=".  The namelist variable must have been
-# defined as an integer and with only one entry in the rconfig table. Or
-# a constant can be specified.  The coordinate axis for the dimension is
-# either X, Y, Z, or C (for "not a spatial dimension").  The Dimname is
-# the descriptive name of the dimension that will be included in the
-# metadata in data sets.  Note that the b, f, and t modifiers that appear
-# as the last characters of dimension strings used # in state and # i1
-# registry definitions are not dimensions and do not need to be declared
-# here.
-#
-
-# Available characters for dimspec: 0123456789@%+=|?.!&[{}]
-
-#
-dimspec i 1 standard_domain x west_east -dimspec j 3 standard_domain y south_north -dimspec k 2 standard_domain z bottom_top -dimspec l 2 namelist=num_soil_layers z soil_layers -dimspec u 2 namelist=num_land_cat z land_cat -dimspec s 2 namelist=num_soil_cat z soil_cat -dimspec p - constant=7501 c microphysics_rstrt_state -dimspec w - namelist=spec_bdy_width c spec_bdy_width -dimspec e 3 namelist=ensdim z ensemble dimension -dimspec n 1 namelist=dfi_time_dim c dfi time dimension -dimspec z - namelist=max_obs c max_obs -dimspec h - namelist=nobs_err_flds c nobs_err_flds -dimspec r - namelist=nobs_ndg_vars c nobs_ndg_vars -dimspec g 2 namelist=num_metgrid_levels z num_metgrid_levels -dimspec m 2 constant=12 z months_per_year -dimspec a - namelist=cam_abs_dim1 c cam_abs_dim1 -dimspec c - namelist=cam_abs_dim2 z cam_abs_dim2 -dimspec q 2 namelist=levsiz z levsiz -dimspec d 2 namelist=paerlev z paerlev -dimspec ? - namelist=ts_buf_size c ts_buf_size -dimspec ! - namelist=max_ts_locs c max_ts_locs -dimspec v - constant=1 z one - - -################################################################################ -################################################################################ -################################################################################ - - -####MARS MARS MARS MARS MARS -####MARS MARS MARS MARS MARS -#### -#### variables physiques ecrites dans les fichiers WRF -#### - h indique l'ecriture -#### -#### -#### RADIATIVE TRANSFER -state real HR_SW ikj misc 1 - - "HR_SW" "HEATING RATE SW" "K/s" -state real HR_LW ikj misc 1 - - "HR_LW" "HEATING RATE LW" "K/s" -state real HR_DYN ikj misc 1 - - "HR_DYN" "HEATING RATE DYN" "K/s" -state real DDT ikj misc 1 - - "DDT" "TEMPERATURE TENDENCY" "K/s" -state real DT_RAD ikj misc 1 - - "DT_RAD" "RADIATIVE TEMPERATURE TENDENCY" "K/s" -state real DT_VDF ikj misc 1 - - "DT_VDF" "PBL CLMAIN TEMPERATURE TENDENCY" "K/s" -state real DT_AJS ikj misc 1 - - "DT_AJS" "AJUSTEMENT SEC TEMPERATURE TENDENCY" "K/s" - -state real SWDOWNZ ij misc 1 - - "SWDOWNZ" "DOWNWARD SW FLUX AT SURFACE" "W m-2" -#### DUST CYCLE -state real TAU_DUST ij misc 1 - - "TAU_DUST" "REFERENCE VISIBLE DUST OPACITY" "" -state real RDUST ikj misc 1 - - "RDUST" "DUST RADIUS" "m" -state real QSURFDUST ij misc 1 - - "QSURFDUST" "DUST MASS AT SURFACE" "kg m-2" -#### CLOUDS -state real MTOT ij misc 1 - - "MTOT" "TOTAL MASS WATER VAPOR in pmic" "pmic" -state real ICETOT ij misc 1 - - "ICETOT" "TOTAL MASS WATER ICE" "kg m-2" -state real VMR_ICE ikj misc 1 - - "VMR_ICE" "VOL. MIXING RATIO ICE" "ppm" -state real TAU_ICE ij misc 1 - - "TAU_ICE" "CLOUD OD at 825 cm-1 TES" "" -state real RICE ikj misc 1 - - "RICE" "ICE RADIUS" "m" -#### THERMALS -state real ZMAX ij misc 1 - - "ZMAX" "MAXIMUM LEVEL THERMALS" "m" -state real HFMAX ij misc 1 - - "HFMAX" "MAXIMUM PBL HEAT FLUX" "m.K/s" -#### GENERIC OUTPUTS -state real CLOUDFRAC ikj misc 1 - - "CLOUDFRAC" "CLOUD FRACTION" "" -state real TOTCLOUDFRAC ij misc 1 - - "TOTCLOUDFRAC" "COLUMN CLOUD FRACTION" "" -state real GRAIN ikj misc 1 - - "RAIN" "RAIN kg/kg.s-1" "" -state real GSNOW ikj misc 1 - - "SNOW" "SNOW kg/kg.s-1" "" -state real ALBEQ ij misc 1 - - "ALBEQ" "ALBEDO EQUIVALENT" "" -state real FLUXTOP_DN ij misc 1 - h "FLUXTOP_DN" "Incoming SW radiation at the TOA" "W.m-2" -state real FLUXABS_SW ij misc 1 - h "FLUXABS_SW" "Absorbed SW flux" "W.m-2" -state real FLUXTOP_LW ij misc 1 - h "FLUXTOP_LW" "Outgoing LW flux TOA" "W.m-2" -state real FLUXSURF_SW ij misc 1 - h "FLUXSURF_SW" "SW Surface flux" "W.m-2" -state real FLUXSURF_LW ij misc 1 - h "FLUXSURF_LW" "LW Surface flux" "W.m-2" -state real FLXGRD ij misc 1 - h "FLXGRD" "heat flux from ground" "W.m-2" -state real LSCEZ ikj misc 1 - - "LSCEZ" "heat from largescale" "W.m-2" -state real H2OICE_REFF ikj misc 1 - - "H2OICE_REFF" "Radii of H2O ice" "m" -state real LATENT_HF ij misc 1 - - "LATENT_HF" "Latent heat flux" "W.m-2" -state real REEVAP ij misc 1 - - "REEVAP" "Re-evaporation flux of precipitation (integrated over the atmospheric column)" -state real SURFRAIN ij misc 1 - - "SURFRAIN" "Rainfall" "kg m-2 s-1" - -#### -#### -####MARS MARS MARS MARS MARS -####MARS MARS MARS MARS MARS - -####MARS MARS MARS MARS MARS -####MARS MARS MARS MARS MARS -#### -#### -#### TRACEURS: POUR L'INSTANT NE PAS CHANGER L'ORDRE (>> mais l'ordre n'est-il pas defini plus bas ? dans les options mars ?) -#### - effacer le h si l'on veut eviter les sorties -#### -state real - ikjftb scalar 1 - - - -state real QH2O ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2O" "Water vapor mixing ratio" "kg kg-1" -state real QH2O_ICE ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2O_ICE" "Water ice mixing ratio" "kg kg-1" -state real qdust ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QDUST" "Dust mixing ratio" "kg kg-1" -state real qdustn ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QDUSTN" "Dust number density" " m-3 " -state real qtrac1 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "qtrac1" "Decaying tracer 1" "kg kg-1" -state real qccn ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCCN" "CCN mixing ratio" "kg kg-1" -state real qccnn ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCCNN" "CCN number mixing ratio" "kg kg-1" -#### -#### -####MARS MARS MARS MARS MARS -####MARS MARS MARS MARS MARS -###VENUS TRACER -state real qco2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCO2" "CO2 number mixing ratio" "kg kg-1" -state real qco ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCO" "CO number mixing ratio" "kg kg-1" -state real qh2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2" "H2 number mixing ratio" "kg kg-1" -state real qo1d ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO1D" "O1d number mixing ratio" "kg kg-1" -state real qo ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO" "O number mixing ratio" "kg kg-1" -state real qo2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO2" "O2 number mixing ratio" "kg kg-1" -state real qo2dg ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO2dg" "O2dg number mixing ratio" "kg kg-1" -state real qo3 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QO3" "O3 number mixing ratio" "kg kg-1" -state real qh ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH" "H number mixing ratio" "kg kg-1" -state real qoh ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QOH" "OH number mixing ratio" "kg kg-1" -state real qho2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QHO2" "HO2 number mixing ratio" "kg kg-1" -state real qh2o2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2O2" "H2O2 number mixing ratio" "kg kg-1" -state real qcl ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCL" "Cl number mixing ratio" "kg kg-1" -state real qclo ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCLO" "ClO number mixing ratio" "kg kg-1" -state real qcl2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCL2" "Cl2 number mixing ratio" "kg kg-1" -state real qhcl ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QHCL" "HCl number mixing ratio" "kg kg-1" -state real qhocl ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QHOCL" "HOCl number mixing ratio" "kg kg-1" -state real qclco ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCLCO" "ClCO number mixing ratio" "kg kg-1" -state real qclco3 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCLCO3" "ClCO3 number mixing ratio" "kg kg-1" -state real qcocl2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCOCL2" "COCl2 number mixing ratio" "kg kg-1" -state real qss ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QS" "S number mixing ratio" "kg kg-1" -state real qso ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QSO" "SO number mixing ratio" "kg kg-1" -state real qso2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QSO2" "SO2 number mixing ratio" "kg kg-1" -state real qso3 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QSO3" "SO3 number mixing ratio" "kg kg-1" -state real qs2o2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QS2O2" "S2O2 number mixing ratio" "kg kg-1" -state real qocs ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QOCS" "OCS number mixing ratio" "kg kg-1" -state real qhso3 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QHSO3" "HSO3 number mixing ratio" "kg kg-1" -state real qh2so4 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2SO4" "H2SO4 number mixing ratio" "kg kg-1" -state real qs2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QS2" "S2 number mixing ratio" "kg kg-1" -state real qclso2 ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QCLSO2" "ClSO2 number mixing ratio" "kg kg-1" -state real qoscl ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QOSCL" "OSCl number mixing ratio" "kg kg-1" -state real qh2oliq ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2OLIQ" "H2O liq number mixing ratio" "kg kg-1" -state real qh2so4liq ikjftb scalar 1 - i01rhusdf=(bdy_interp:dt) "QH2SO4LIQ" "H2SO4 liq number mixing ratio" "kg kg-1" - - - - - - - - -#state real floob ikjb dyn_em 1 - -#state real floob_x ikjx dyn_em 1 - -#state real floob_y ikjy dyn_em 1 - -#xpose FLOOB dyn_em floob,floob_x,floob_y - -#state real xxx ijk misc 2 - h6ud -#halo HALO_FLOOB dyn_em 4:xxx_2 - -# Lines that start with the word 'state' form a table that is -# used by the script use_registry to generate module_state_descript.F -# and other files. Also see documentation in use_registry. -# -# table entries are of the form -#
-# - -# It is required that LU_INDEX appears before any variable that is -# interpolated with a mask, as lu_index supplies that mask. -# this next 1 is for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling -# with wave model, only if compiled with -DMCELIO, JM 2003/05/29 -state real LU_INDEX ij misc 1 - i02r01d=(interp_fcnm)u=(copy_fcnm) "LU_INDEX" "LAND USE CATEGORY" "" -state real LU_MASK ij misc 1 - i3h1 "LU_MASK" "0 land 1 water" "" - -# znw, znu, dzs, and zs must be listed before any 3-d fields -# in order for the grib output module to work correctly. The grib output -# module retrieves the vertical levels from these parameters. If znw, znu -# dzs, and zs are not listed first, vertical level will not be encoded at -# time 0. - -state real znu k dyn_em 1 - irh "znu" "eta values on half (mass) levels" "" -state real znw k dyn_em 1 Z i01rh "znw" "eta values on full (w) levels" "" -state real ZS l misc - Z ir "ZS" "DEPTHS OF CENTERS OF SOIL LAYERS" "m" -state real DZS l misc - Z ir "DZS" "THICKNESSES OF SOIL LAYERS" "m" - -# -# Variables from WPS -# -state real u_gc igj dyn_em 1 XZ i1 "UU" "x-wind component" "m s-1" -state real v_gc igj dyn_em 1 YZ i1 "VV" "y-wind component" "m s-1" -state real t_gc igj dyn_em 1 Z i1 "TT" "temperature" "K" -state real rh_gc igj dyn_em 1 Z i1 "RH" "relative humidity" "%" -state real ght_gc igj dyn_em 1 Z i1 "GHT" "geopotential height" "m" -state real p_gc igj dyn_em 1 Z i1 "PRES" "pressure" "Pa" -state real xlat_gc ij dyn_em 1 - i1 "XLAT_M" "latitude, positive north" "degrees" -state real xlong_gc ij dyn_em 1 - i1 "XLONG_M" "longitude, positive east" "degrees" -state real ht_gc ij dyn_em 1 - i1 "HGT_M" "topography elevation" "m" -state real tsk_gc ij dyn_em 1 - i1 "SKINTEMP" "skin temperature" "K" -state real tavgsfc ij dyn_em 1 - i1 "TAVGSFC" "daily mean of surface air temperature" "K" -state real tmn_gc ij dyn_em 1 - i1 "SOILTEMP" "annual mean deep soil temperature" "K" -state real pslv_gc ij dyn_em 1 - i1 "PMSL" "sea level pressure" "Pa" -state real greenfrac imj dyn_em 1 Z i1 "GREENFRAC" "monthly greenness fraction" "0 - 1 fraction" -state real albedo12m imj dyn_em 1 Z i1 "ALBEDO12M" "background albedo" "0 - 1 fraction" -state real pd_gc igj dyn_em 1 Z - "PD" "dry pressure" "Pa" -state real psfc_gc ij dyn_em 1 - - "PSFC_GC" "surface pressure" "Pa" -state real intq_gc ij dyn_em 1 - - "INTQ" "integrated mixing ratio" "Pa" -state real pdhs ij dyn_em 1 - - "PDHS" "hydrostatic dry surface pressure" "Pa" -state real qv_gc igj dyn_em 1 Z i1 "QV" "mixing ratio" "kg kg-1" -ifdef RUC_CLOUD -state real qr_gc igj dyn_em 1 Z i1 "QR" "rain water mixing ratio" "kg kg-1" -state real qc_gc igj dyn_em 1 Z i1 "QC" "cloud water mixing ratio" "kg kg-1" -state real qs_gc igj dyn_em 1 Z i1 "QS" "snow mixing ratio" "kg kg-1" -state real qi_gc igj dyn_em 1 Z i1 "QI" "cloud ice mixing ratio" "kg kg-1" -state real qg_gc igj dyn_em 1 Z i1 "QG" "graupel mixing ratio" "kg kg-1" -state real qni_gc igj dyn_em 1 Z i1 "QNI" "ice no concentration" "m-3" -endif - -####MARS MARS MARS MARS MARS -####MARS MARS MARS MARS MARS -#### -#### INITIALISATION -#### -#### variables dans real -#### - -state real albedo_gcm_gc ij dyn_em 1 - i1 "ALBEDO_GCM" "albedo of naked ground" "0 - 1 fraction" -state real therm_inert_gc ij dyn_em 1 - i1 "THERMAL_INERTIA" "thermal inertia" "J/m2/K/s0.5" -state real z0_gc ij dyn_em 1 - i1 "SURF_ROUGHNESS" "surface roughness" "cm" -state real slpx_gc ij dyn_em 1 - i1 "SLPX" "slope x direction" "rad" -state real slpy_gc ij dyn_em 1 - i1 "SLPY" "slope y direction" "rad" -state real hv_gc igj dyn_em 1 Z i1 "HV" "water vapor" "kg/kg" -state real hi_gc igj dyn_em 1 Z i1 "HI" "water ice" "kg/kg" -state real tsoil_gc igj dyn_em 1 Z i1 "TSOIL" "soil temperatures" "K" -state real isoil_gc igj dyn_em 1 Z i1 "ISOIL" "soil thermal inertia" "tiu" -state real dsoil_gc igj dyn_em 1 Z i1 "DSOIL" "soil depths" "m" -#### -#### variables dans wrf -#### -#### 'm_' prefix is to avoid redundancies with possible existing terrestrial variables -#### -#### vvvv nom pour module_initialize, solve_em, lmd_driver (interne fortran) -#### vvvv nom fichier netCDF (important initialisation -################################################################################################################ -state real m_albedo ij misc 1 - i012rd "MARS_ALB" "albedo of naked ground" "0 - 1 fraction" -state real m_ti ij misc 1 - i012rd "MARS_TI" "thermal inertia" "J/m2/K/s0.5" -state real m_z0 ij misc 1 - i012rd "MARS_Z0" "surface roughness" "m" -state real slpx ij misc 1 - i012rd "SLOPEX" "slope x direction" "rad" -state real slpy ij misc 1 - i012rd "SLOPEY" "slope y direction" "rad" -state real m_emiss ij misc 1 - i012rd "MARS_EMISS" "emissivity" "0 - 1 fraction" -state real m_co2ice ij misc 1 - i012rd "MARS_CICE" "co2 ground ice" "kg/m2" -state real m_h2oice ij misc 1 - i012rd "MARS_WICE" "h2o ground ice" "kg/m2" -state real m_fluxrad ij misc 1 - i012rd "MARS_FLUXRAD" "net rad flux at surf" "W.m-2" -state real m_wstar ij misc 1 - i012rd "MARS_WSTAR" "free convection velocity" "m.s-1" -state real m_tsurf ij misc 1 - i012rhd "MARS_TSURF" "surface temperature" "K" -state real m_tsoil ilj misc 1 - i012rd "MARS_TSOIL" "soil temperatures" "K" -state real m_q2 ikj misc 1 Z i012rd "MARS_Q2" "parameterized TKE" "kg.m-3" -state real m_isoil ilj misc 1 - i012rd "MARS_ISOIL" "soil thermal inertia" "tiu" -state real m_dsoil ilj misc 1 - i012rd "MARS_DSOIL" "soil depths" "m" -state real m_gw ilj misc 1 - i012rd "MARS_GW" "gwparam" " " -#### -#### -####MARS MARS MARS MARS MARS -####MARS MARS MARS MARS MARS - -#----------------------------------------------------------------------------------------------------------------------------------------------------------------- -# -# Variables for Eulerian mass coordinate dynamics -# - -# Velocities -# -# U Vel -state real u ikjb dyn_em 2 X \ - i01rhusdf=(bdy_interp:dt) "U" "x-wind component" "m s-1" -state real ru ikj dyn_em 1 X - "MU_U" "mu-coupled u" "Pa m s-1" -state real ru_m ikj dyn_em 1 X - "ru_m" "" "" -state real ru_tend ikj dyn_em 1 X - "ru_tend" "" "" -i1 real ru_tendf ikj dyn_em 1 X -state real u_save ikj dyn_em 1 X - "u_save" -# -# V Vel -state real v ikjb dyn_em 2 Y \ - i01rhusdf=(bdy_interp:dt) "V" "y-wind component" "m s-1" -state real rv ikj dyn_em 1 Y - "MU_V" "mu-coupled v" "Pa m s-1" -state real rv_m ikj dyn_em 1 Y - "rv_m" -state real rv_tend ikj dyn_em 1 Y - "rv_tend" -i1 real rv_tendf ikj dyn_em 1 Y -state real v_save ikj dyn_em 1 Y - "v_save" -# -# Vertical Vel -state real w ikjb dyn_em 2 Z \ - irhusdf=(bdy_interp:dt) "w" "z-wind component" "m s-1" -state real ww ikj dyn_em 1 Z r "ww" "mu-coupled eta-dot" "Pa s-1" -state real rw ikj dyn_em 1 Z - "rw" "mu-coupled w" "Pa m s-1" -i1 real ww1 ikj dyn_em 1 Z -state real ww_m ikj dyn_em 1 Z r "ww_m" "time-avg mu-coupled eta-dot" "Pa s-1" -i1 real wwp ikj dyn_em 1 Z -i1 real rw_tend ikj dyn_em 1 Z -i1 real rw_tendf ikj dyn_em 1 Z -i1 real w_save ikj dyn_em 1 Z - -# Geopotential -state real ph ikjb dyn_em 2 Z \ - irusdf=(bdy_interp:dt) "ph" "perturbation geopotential" "m2 s-2" -state real phb ikj dyn_em 1 Z irdus "phb" "base-state geopotential" "m2 s-2" -state real phb_fine ikj dyn_em 1 Z - "phb_fine" "for nesting, temp holding interpolated coarse grid phb" "m2 s-2" -state real ph0 ikj dyn_em 1 Z r "ph0" "initial geopotential" "m2 s-2" -state real php ikj dyn_em 1 Z r "php" "geopotential" "m2 s-2" -i1 real ph_tend ikj dyn_em 1 Z -i1 real ph_tendf ikj dyn_em 1 Z -i1 real ph_save ikj dyn_em 1 Z -## -## MARS: TO GET LIGHTER HISTORY FILES -## -state real phtot ikj dyn_em 1 Z irh "PHTOT" "total geopotential" "m2 s-2" - -# Potential Temperature -state real t ikjb dyn_em 2 - \ - i01rhusdf=(bdy_interp:dt) "t" "perturbation potential temperature (theta-t0)" "K" - -state real t_init ikj dyn_em 1 - ir "t_init" "initial potential temperature" "K" -i1 real t_tend ikj dyn_em 1 - -i1 real t_tendf ikj dyn_em 1 - -state real tp ikj dyn_em 2 - -i1 real t_2save ikj dyn_em 1 - -state real t_save ikj dyn_em 1 - "t_save" -# -state real tz_init ikj dyn_em 1 - ir "tz_init" "initial potential temperature" "K" - -# Mass -state real mu ijb dyn_em 2 - \ - irusdf=(bdy_interp:dt) "mu" "perturbation dry air mass in column" "Pa" -state real mub ij dyn_em 1 - irdus "mub" "base state dry air mass in column" "Pa" -state real mub_fine ij dyn_em 1 - - "mub_fine" "nest temp, holds interpolated coarse grid mub" "Pa" -state real mub_save ij dyn_em 1 - - "mub_save" "nest temp, holds orig fine grid mub" "Pa" -state real mu0 ij dyn_em 1 - i01rdu "mu0" "initial dry mass in column" "Pa" -state real mudf ij dyn_em 1 - - "mudf" "" "" -state real muu ij dyn_em 1 - "muu" -i1 real muus ij dyn_em 1 - -state real muv ij dyn_em 1 - "muv" -i1 real muvs ij dyn_em 1 - -state real mut ij dyn_em 1 - "mut" -state real muts ij dyn_em 1 - "muts" -i1 real muave ij dyn_em 1 - -i1 real mu_save ij dyn_em 1 - -i1 real mu_tend ij dyn_em 1 - -i1 real mu_tendf ij dyn_em 1 - - -#diagnostic for looking at nest position in output. A mungy version of terrain height. -state real nest_pos ij misc 1 - ru=(mark_domain) "NEST_POS" -state real nest_mask ij misc 1 - ru=(mark_domain) "NEST_MASK" "LOCATION OF NEST IF ANY" -state real ht_coarse ij misc 1 - r - "STORAGE FOR LOW-RES TERRAIN" - - -# TKE -state real tke ikj dyn_em 2 - r "tke" "TURBULENCE KINETIC ENERGY" "m2 s-2" -i1 real tke_tend ikj dyn_em 1 - - -# Pressure and Density -state real p ikj dyn_em 1 - r "p" "perturbation pressure" "Pa" -state real al ikj dyn_em 1 - r "al" "inverse perturbation density" "m3 kg-1" -state real alt ikj dyn_em 1 - r "alt" "inverse density" "m3 kg-1" -state real alb ikj dyn_em 1 - rdus "alb" "inverse base density" "m3 kg-1" -state real zx ikj dyn_em 1 X - " " " " " " -state real zy ikj dyn_em 1 Y - " " " " " " -state real rdz ikj dyn_em 1 Z - " " " " " " -state real rdzw ikj dyn_em 1 Z - " " " " " " -state real pb ikj dyn_em 1 - rdus "pb" "BASE STATE PRESSURE " "Pa" -## -## MARS: TO GET LIGHTER HISTORY FILES -## -state real ptot ikj dyn_em 1 - irh "PTOT" "total pressure" "Pa" - -# -# Other dyn -# -i1 real advect_tend ikj dyn_em 1 - -i1 real alpha ikj dyn_em 1 - -i1 real a ikj dyn_em 1 - -i1 real gamma ikj dyn_em 1 - -i1 real c2a ikj dyn_em 1 - - -i1 real rho ikj dyn_em 1 - - -i1 real phm ikj dyn_em 1 - - -i1 real cqu ikj dyn_em 1 - - -i1 real cqv ikj dyn_em 1 - - -i1 real cqw ikj dyn_em 1 - - -i1 real pm1 ikj dyn_em 1 - - -state real sr ij dyn_em 1 - ir "sr" "fraction of frozen precipitation" -state real potevp ij dyn_em 1 - r "potevp" "accumulated potential evaporation" "W m-2" -state real snopcx ij dyn_em 1 - r "snopcx" "snow phase change heat flux" "W m-2" -state real soiltb ij dyn_em 1 - - "soiltb" "bottom soil temperature" "K" -state real fnm k dyn_em 1 - ir "fnm" "upper weight for vertical stretching" "" -state real fnp k dyn_em 1 - ir "fnp" "lower weight for vertical stretching" "" -state real rdnw k dyn_em 1 - ir "rdnw" "inverse d(eta) values between full (w) levels" "" -state real rdn k dyn_em 1 - ir "rdn" "inverse d(eta) values between half (mass) levels" "" -state real dnw k dyn_em 1 - ir "dnw" "d(eta) values between full (w) levels" "" -state real dn k dyn_em 1 - ir "dn " "d(eta) values between half (mass) levels" "" -state real t_base k dyn_em 1 - ir "t_base" "BASE STATE T IN IDEALIZED CASES" "K" -state real z ikj dyn_em 1 - - " " " " " " -i1 real mu_3d ikj dyn_em 1 - -i1 real z_at_w ikj dyn_em 1 Z -state real cfn - misc - - ir "cfn" "extrapolation constant" "" -state real cfn1 - misc - - ir "cfn1" "extrapolation constant" "" -state integer step_number - misc - - ir "step_number" "" - -# 2m and 10m output diagnostics -state real Q2 ij misc 1 - ird "Q2" "QV at 2 M" "kg kg-1" -state real T2 ij misc 1 - ird "T2" "TEMP at 2 M" "K" -state real TH2 ij misc 1 - ird "TH2" "POT TEMP at 2 M" "K" -state real PSFC ij misc 1 - i01rhd "PSFC" "SFC PRESSURE" "Pa" - -# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling -# with wave model, only if compiled with -DMCELIO, JM 2003/05/29 -state real U10 ij misc 1 - ir01d "U10" "U at 10 M" "m s-1" -state real V10 ij misc 1 - ir01d "V10" "V at 10 M" "m s-1" - -# these next 4 are for observational nudging -state real uratx ij misc 1 - r "URATX" "Ratio of U over U10 on mass points " "dimensionless" -state real vratx ij misc 1 - r "VRATX" "Ratio of V over V10 on mass points " "dimensionless" -state real tratx ij misc 1 - r "TRATX" "Ratio of T over TH2 on mass points " "dimensionless" -state real obs_savwt hikj dyn_em 1 X - "OBS_SAVWT" - -# Other -state real rdx - misc - - ir "rdx" "INVERSE X GRID LENGTH" "" -state real rdy - misc - - ir "rdy" "INVERSE Y GRID LENGTH" "" -state real dts - misc - - ir "dts" "SMALL TIMESTEP" "" -state real dtseps - misc - - ir "dtseps" "TIME WEIGHT CONSTANT FOR SMALL STEPS" "" -state real resm - misc - - ir "resm" "TIME WEIGHT CONSTANT FOR SMALL STEPS" "" -state real zetatop - misc - - ir "zetatop" "ZETA AT MODEL TOP" "" -state real cf1 - misc - - ir "cf1" "2nd order extrapolation constant" "" -state real cf2 - misc - - ir "cf2" "2nd order extrapolation constant" "" -state real cf3 - misc - - ir "cf3" "2nd order extrapolation constant" "" -state integer number_at_same_level - - - - - "number_at_same_level" "" "" - -# State for derived time quantities. -state integer itimestep - - - - r "itimestep" "" "" -state real xtime - - - - r "xtime" "minutes since simulation start" "" -state real julian - - - - - "julian" "day of year, 0.0 at 0Z on 1 Jan." "days" - - -# input file descriptor for lbcs on parent domain -state integer lbc_fid - - - - - "lbc_fid" "" "" -# indicates if tiling has been computed -state logical tiled - - - - - "tiled" "" "" -# indicates if patches have been computed -state logical patched - - - - - "patched" "" "" -# indicates whether to read input from file or generate -#state logical input_from_file - - - - - "input_from_file" "" "" -# indicates whether to recompute mu -state logical press_adj - - - - - "press_adj" "T/F flag adjust mu" "" - -# Mask for moving nest interpolations -state integer imask_nostag ij misc 1 - -state integer imask_xstag ij misc 1 X -state integer imask_ystag ij misc 1 Y -state integer imask_xystag ij misc 1 XY -# vortex center indices; need for restarts of moving nests -state real xi - misc - - r -state real xj - misc - - r -state real vc_i - misc - - r -state real vc_j - misc - - r - -#----------------------------------------------------------------------------------------------------------------------------------------------------------------- -# Scalar (4D) arrays - -# Moist Scalars -# -# The first line ensures that there will be identifiers named moist and -# moist_tend even if there are not any moist scalars (so the essentially -# dry code will will still link properly) -# -state real - ikjftb moist 1 - - - -state real qv ikjftb moist 1 - \ - i01rusdf=(bdy_interp:dt) "QVAPOR" "Water vapor mixing ratio" "kg kg-1" -state real qc ikjftb moist 1 - \ - i01rusdf=(bdy_interp:dt) "QCLOUD" "Cloud water mixing ratio" "kg kg-1" -state real qr ikjftb moist 1 - \ - i01rusdf=(bdy_interp:dt) "QRAIN" "Rain water mixing ratio" "kg kg-1" -state real qi ikjftb moist 1 - \ - i01rusdf=(bdy_interp:dt) "QICE" "Ice mixing ratio" "kg kg-1" -state real qs ikjftb moist 1 - \ - i01rusdf=(bdy_interp:dt) "QSNOW" "Snow mixing ratio" "kg kg-1" -state real qg ikjftb moist 1 - \ - i01rusdf=(bdy_interp:dt) "QGRAUP" "Graupel mixing ratio" "kg kg-1" -state real - ikjftb dfi_moist 1 - - - -state real dfi_qv ikjftb dfi_moist 1 - \ - rusdf=(bdy_interp:dt) "DFI_QVAPOR" "Water vapor mixing ratio" "kg kg-1" -state real dfi_qc ikjftb dfi_moist 1 - \ - rusdf=(bdy_interp:dt) "DFI_QCLOUD" "Cloud water mixing ratio" "kg kg-1" -state real dfi_qr ikjftb dfi_moist 1 - \ - rusdf=(bdy_interp:dt) "DFI_QRAIN" "Rain water mixing ratio" "kg kg-1" -state real dfi_qi ikjftb dfi_moist 1 - \ - rusdf=(bdy_interp:dt) "DFI_QICE" "Ice mixing ratio" "kg kg-1" -state real dfi_qs ikjftb dfi_moist 1 - \ - rusdf=(bdy_interp:dt) "DFI_QSNOW" "Snow mixing ratio" "kg kg-1" -state real dfi_qg ikjftb dfi_moist 1 - \ - rusdf=(bdy_interp:dt) "DFI_QGRAUP" "Graupel mixing ratio" "kg kg-1" - - -# Chem Scalars -state real - ikjftb chem 1 - - - - -# Other Scalars -state real - ikjftb scalar 1 - - - -state real qndrop ikjftb scalar 1 - \ - i01rusdf=(bdy_interp:dt) "QNDROP" "Droplet number mixing ratio" "# kg-1" -state real qni ikjftb scalar 1 - \ - i01rusdf=(bdy_interp:dt) "QNICE" "Ice Number concentration" "# kg-1" -state real qt ikjftb scalar 1 - \ - i01rusdf=(bdy_interp:dt) "CWM" "Total condensate mixing ratio" "kg kg-1" -state real qns ikjftb scalar 1 - \ - i01rusdf=(bdy_interp:dt) "QNSNOW" "Snow Number concentration" "# kg(-1)" -state real qnr ikjftb scalar 1 - \ - i01rusdf=(bdy_interp:dt) "QNRAIN" "Rain Number concentration" "# kg(-1)" -state real qng ikjftb scalar 1 - \ - i01rusdf=(bdy_interp:dt) "QNGRAUPEL" "Graupel Number concentration" "# kg(-1)" -state real - ikjftb dfi_scalar 1 - - - -state real dfi_qndrop ikjftb dfi_scalar 1 - \ - rusdf=(bdy_interp:dt) "DFI_QNDROP" "Droplet number mixing ratio" "# kg-1" -state real dfi_qni ikjftb dfi_scalar 1 - \ - rusdf=(bdy_interp:dt) "DFI_QNICE" "Ice Number concentration" "# kg-1" -state real dfi_qt ikjftb dfi_scalar 1 - \ - rusdf=(bdy_interp:dt) "DFI_CWM" "Total condensate mixing ratio" "kg kg-1" -state real dfi_qns ikjftb dfi_scalar 1 - \ - rusdf=(bdy_interp:dt) "DFI_QNSNOW" "Snow Number concentration" "# kg(-1)" -state real dfi_qnr ikjftb dfi_scalar 1 - \ - rusdf=(bdy_interp:dt) "DFI_QNRAIN" "Rain Number concentration" "# kg(-1)" -state real dfi_qng ikjftb dfi_scalar 1 - \ - rusdf=(bdy_interp:dt) "DFI_QNGRAUPEL" "Graupel Number concentration" "# kg(-1)" - -#----------------------------------------------------------------------------------------------------------------------------------------------------------------- - -# Arrays for Specified LBCs (lbc arrays REMOVED; Boundary arrays are now specified with the state array; see above, 20050413 JM ) - -state real fcx w misc - - ir "fcx" "RELAXATION TERM FOR BOUNDARY ZONE" "" -state real gcx w misc - - ir "gcx" "2ND RELAXATION TERM FOR BOUNDARY ZONE" "" -state real dtbc - misc - - ir "dtbc" "TIME SINCE BOUNDARY READ" "" - -#------------------------------------------------------------------------------------------------------------------------------------------- -#------------------------------------------------------------------------------------------------------------------------------------------- -# Physics Related State Varibles - -#------------------------------------------------------------------------------------------------------------------------------------------- -# SI - start variables from netCDF format from Standard Initialization, most eventually for use in LSM schemes -#------------------------------------------------------------------------------------------------------------------------------------------- - -state real sm000007 ij misc 1 - i1 "SM000007" "LAYER SOIL MOISTURE" "m3 m-3" -state real sm007028 ij misc 1 - i1 "SM007028" "LAYER SOIL MOISTURE" "m3 m-3" -state real sm028100 ij misc 1 - i1 "SM028100" "LAYER SOIL MOISTURE" "m3 m-3" -state real sm100255 ij misc 1 - i1 "SM100255" "LAYER SOIL MOISTURE" "m3 m-3" -state real st000007 ij misc 1 - i1 "ST000007" "LAYER SOIL TEMPERATURE" "K" -state real st007028 ij misc 1 - i1 "ST007028" "LAYER SOIL TEMPERATURE" "K" -state real st028100 ij misc 1 - i1 "ST028100" "LAYER SOIL TEMPERATURE" "K" -state real st100255 ij misc 1 - i1 "ST100255" "LAYER SOIL TEMPERATURE" "K" -state real sm000010 ij misc 1 - i1 "SM000010" "LAYER SOIL MOISTURE" "m3 m-3" -state real sm010040 ij misc 1 - i1 "SM010040 " "LAYER SOIL MOISTURE" "m3 m-3" -state real sm040100 ij misc 1 - i1 "SM040100 " "LAYER SOIL MOISTURE" "m3 m-3" -state real sm100200 ij misc 1 - i1 "SM100200 " "LAYER SOIL MOISTURE" "m3 m-3" -state real sm010200 ij misc 1 - i1 "SM010200" "LAYER SOIL MOISTURE" "m3 m-3" -state real soilm000 ij misc 1 - i1 "SOILM000" "LAYER SOIL MOISTURE" "m3 m-3" -state real soilm005 ij misc 1 - i1 "SOILM005" "LAYER SOIL MOISTURE" "m3 m-3" -state real soilm020 ij misc 1 - i1 "SOILM020" "LAYER SOIL MOISTURE" "m3 m-3" -state real soilm040 ij misc 1 - i1 "SOILM040" "LAYER SOIL MOISTURE" "m3 m-3" -state real soilm160 ij misc 1 - i1 "SOILM160" "LAYER SOIL MOISTURE" "m3 m-3" -state real soilm300 ij misc 1 - i1 "SOILM300" "LAYER SOIL MOISTURE" "m3 m-3" -state real sw000010 ij misc 1 - i1 "SW000010" "LAYER SOIL LIQUID" "m3 m-3" -state real sw010040 ij misc 1 - i1 "SW010040" "LAYER SOIL LIQUID" "m3 m-3" -state real sw040100 ij misc 1 - i1 "SW040100" "LAYER SOIL LIQUID" "m3 m-3" -state real sw100200 ij misc 1 - i1 "SW100200" "LAYER SOIL LIQUID" "m3 m-3" -state real sw010200 ij misc 1 - i1 "SW010200" "LAYER SOIL LIQUID" "m3 m-3" -state real soilw000 ij misc 1 - i1 "SOILW000" "LAYER SOIL LIQUID" "m3 m-3" -state real soilw005 ij misc 1 - i1 "SOILW005" "LAYER SOIL LIQUID" "m3 m-3" -state real soilw020 ij misc 1 - i1 "SOILW020" "LAYER SOIL LIQUID" "m3 m-3" -state real soilw040 ij misc 1 - i1 "SOILW040" "LAYER SOIL LIQUID" "m3 m-3" -state real soilw160 ij misc 1 - i1 "SOILW160" "LAYER SOIL LIQUID" "m3 m-3" -state real soilw300 ij misc 1 - i1 "SOILW300" "LAYER SOIL LIQUID" "m3 m-3" -state real st000010 ij misc 1 - i1 "ST000010" "LAYER SOIL TEMPERATURE" "K" -state real st010040 ij misc 1 - i1 "ST010040" "LAYER SOIL TEMPERATURE" "K" -state real st040100 ij misc 1 - i1 "ST040100" "LAYER SOIL TEMPERATURE" "K" -state real st100200 ij misc 1 - i1 "ST100200" "LAYER SOIL TEMPERATURE" "K" -state real st010200 ij misc 1 - i1 "ST010200" "LAYER SOIL TEMPERATURE" "K" -state real soilt000 ij misc 1 - i1 "SOILT000" "LAYER SOIL TEMPERATURE" "K" -state real soilt005 ij misc 1 - i1 "SOILT005" "LAYER SOIL TEMPERATURE" "K" -state real soilt020 ij misc 1 - i1 "SOILT020" "LAYER SOIL TEMPERATURE" "K" -state real soilt040 ij misc 1 - i1 "SOILT040" "LAYER SOIL TEMPERATURE" "K" -state real soilt160 ij misc 1 - i1 "SOILT160" "LAYER SOIL TEMPERATURE" "K" -state real soilt300 ij misc 1 - i1 "SOILT300" "LAYER SOIL TEMPERATURE" "K" -state real landmask ij misc 1 - i012rd=(interp_fcnm)u=(copy_fcnm) "LANDMASK" "LAND MASK (1 FOR LAND, 0 FOR WATER)" "" -state real topostdv ij misc 1 - i12 "TOPOSTDV" "ELEVATION STD DEV" "m" -state real toposlpx ij misc 1 - i12 "TOPOSLPX" "ELEVATION X SLOPE" "" -state real toposlpy ij misc 1 - i12 "TOPOSLPY" "ELEVATION Y SLOPE" "" -state real shdmax ij misc 1 - i012r "SHDMAX" "ANNUAL MAX VEG FRACTION" "" -state real shdmin ij misc 1 - i012r "SHDMIN" "ANNUAL MIN VEG FRACTION" "" -state real snoalb ij misc 1 - i012r "SNOALB" "ANNUAL MAX SNOW ALBEDO IN FRACTION" "" -state real slopecat ij misc 1 - i12 "SLOPECAT" "SLOPE CATEGORY" "" -state real toposoil ij misc 1 - i12 "SOILHGT" "ELEVATION OF LSM DATA" "m" -state real landusef iuj misc 1 Z i012r "LANDUSEF" "LANDUSE FRACTION BY CATEGORY" "" -state real soilctop isj misc 1 Z i012 "SOILCTOP" "SOIL CAT FRACTION (TOP)" "" -state real soilcbot isj misc 1 Z i012 "SOILCBOT" "SOIL CAT FRACTION (BOTTOM)" "" -state real soilcat ij misc 1 - i12 "SOILCAT" "SOIL CAT DOMINANT TYPE" "" -state real vegcat ij misc 1 - i12 "VEGCAT" "VEGETATION CAT DOMINANT TYPE" "" - -#--------------------------------------------------------------------------------------------------------------------------------------- -# SI - end variables from netCDF format from Standard Initialization -#--------------------------------------------------------------------------------------------------------------------------------------- - -# soil model variables (Note that they are marked as staggered in the vertical dimension -# because they are "fully dimensioned" -- they use every element in that dim -state real TSLB ilj misc 1 Z i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TSLB" "SOIL TEMPERATURE" "K" - -# Time series variables -state real ts_hour ?! misc - - r "TS_HOUR" "Model integration time, hours" -state real ts_u ?! misc - - r "TS_U" "Surface wind U-component, earth-relative" -state real ts_v ?! misc - - r "TS_V" "Surface wind V-component, earth-relative" -state real ts_q ?! misc - - r "TS_Q" "Surface mixing ratio" -state real ts_t ?! misc - - r "TS_T" "Surface temperature" -state real ts_psfc ?! misc - - r "TS_PSFC" "Surface pressure" -state real ts_glw ?! misc - - r "TS_GLW" "Downward long wave flux at surface" -state real ts_gsw ?! misc - - r "TS_GSW" "Net short wave flux at surface" -state real ts_hfx ?! misc - - r "TS_HFX" "Upward heat flux at surface" -state real ts_lh ?! misc - - r "TS_LH" "Upward moisture flux at surface" -state real ts_tsk ?! misc - - r "TS_TSK" "Skin temperature" -state real ts_tslb ?! misc - - r "TS_TSLB" "Soil temperature" -state real ts_clw ?! misc - - r "TS_CLW" "Column integrated cloud water" -state real ts_rainc ?! misc - - r "TS_RAINC" "Cumulus precip" -state real ts_rainnc ?! misc - - r "TS_RAINNC" "Grid-scale precip" - -# urban model variables -state real DZR l em - Z r "DZR" "THICKNESSES OF ROOF LAYERS" "m" -state real DZB l em - Z r "DZB" "THICKNESSES OF WALL LAYERS" "m" -state real DZG l em - Z r "DZG" "THICKNESSES OF ROAD LAYERS" "m" - -# lsm State Variables - -state real SMOIS ilj - 1 Z i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SMOIS" "SOIL MOISTURE" "m3 m-3" -state real SH2O ilj - 1 Z i02rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SH2O" "SOIL LIQUID WATER" "m3 m-3" -state real XICE ij misc 1 - i0124rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "SEAICE" "SEA ICE FLAG" "" -state real XICEM ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "XICEM" "SEA ICE FLAG (PREVIOUS STEP)" "" -state real SMSTAV ij misc 1 - rd=(interp_mask_land_field:lu_index) "SMSTAV" "MOISTURE AVAILABILITY" "" -state real SMSTOT ij misc 1 - r "SMSTOT" "TOTAL SOIL MOISTURE" "m3 m-3" - -state real SFCRUNOFF ij misc 1 - rd=(interp_mask_land_field:lu_index) "SFROFF" "SURFACE RUNOFF" "mm" -state real UDRUNOFF ij misc 1 - rd=(interp_mask_land_field:lu_index) "UDROFF" "UNDERGROUND RUNOFF" "mm" -state integer IVGTYP ij misc 1 - i02rd=(interp_fcni)u=(copy_fcni) "IVGTYP" "DOMINANT VEGETATION CATEGORY" "" -state integer ISLTYP ij misc 1 - i02rd=(interp_fcni)u=(copy_fcni) "ISLTYP" "DOMINANT SOIL CATEGORY" "" -state real VEGFRA ij misc 1 - i0124rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "VEGFRA" "VEGETATION FRACTION" "" -state real SFCEVP ij misc 1 - r "SFCEVP" "SURFACE EVAPORATION" "kg m-2" -state real GRDFLX ij misc 1 - r "GRDFLX" "GROUND HEAT FLUX" "W m-2" -state real SFCEXC ij misc 1 - r "SFCEXC " "SURFACE EXCHANGE COEFFICIENT" "m s-1" - -state real ACSNOW ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "ACSNOW" "ACCUMULATED SNOW" "kg m-2" -state real ACSNOM ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "ACSNOM" "ACCUMULATED MELTED SNOW" "kg m-2" -state real SNOW ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SNOW" "SNOW WATER EQUIVALENT" "kg m-2" -state real SNOWH ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SNOWH" "PHYSICAL SNOW DEPTH" "m" -state real RHOSN ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "RHOSN" " SNOW DENSITY" "kg m-3" -state real CANWAT ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "CANWAT" "CANOPY WATER" "kg m-2" -state real SST ij misc 1 - i0124rd=(interp_mask_water_field:lu_index) "SST" "SEA SURFACE TEMPERATURE" "K" -state integer IFNDSNOWH - misc 1 - i "FNDSNOWH" "SNOWH_LOGICAL" -state integer IFNDSOILW - misc 1 - i "FNDSOILW" "SOILW_LOGICAL" - -# DFI variables -state real hcoeff n misc 1 - - "HCOEFF" "initialization weights" -state real hcoeff_tot - misc 1 - - "HCOEFF_TOT" "initialization weights" -state real dfi_p ikj misc 1 - r "P_DFI" "perturbation pressure" "Pa" -state real dfi_al ikj misc 1 - r "AL_DFI" "inverse perturbation density" "m3 kg-1" -state real dfi_mu ij misc 1 - r "MU_DFI" "perturbation dry air mass in column" "Pa" -state real dfi_phb ikj misc 1 Z r "PHB_DFI" "base-state geopotential" "m2 s-2" -state real dfi_ph0 ikj misc 1 Z r "PH0_DFI" "initial geopotential" "m2 s-2" -state real dfi_php ikj misc 1 Z r "PHP_DFI" "geopotential" "m2 s-2" -state real dfi_u ikj misc 1 - r "U_DFI" "u accumulation array" " " -state real dfi_v ikj misc 1 - r "V_DFI" "v accumulation array" " " -state real dfi_w ikj misc 1 - r "W_DFI" "w accumulation array" " " -state real dfi_ww ikj misc 1 Z r "WW_DFI" "mu-coupled eta-dot" "Pa s-1" -state real dfi_t ikj misc 1 - r "TT_DFI" "t accumulation array" " " -state real dfi_ph ikj misc 1 - r "PH_DFI" "p accumulation array" " " -state real dfi_pb ikj misc 1 - r "PB_DFI" "pb accumulation array" " " -state real dfi_alt ikj misc 1 - r "ALT_DFI" "1/rho accumulation array" " " -state real dfi_tke ikj misc 1 - r "TKE_DFI" "TURBULENCE KINETIC ENERGY" "m2 s-2" - -state real dfi_TSLB ilj misc 1 Z r "TSLB_dfi" "SOIL TEMPERATURE" "K" -state real dfi_SMOIS ilj - 1 Z r "SMOIS_dfi" "SOIL MOISTURE" "m3 m-3" -state real dfi_SNOW ij misc 1 - r "SNOW_dfi" "SNOW WATER EQUIVALENT" "kg m-2" -state real dfi_SNOWH ij misc 1 - r "SNOWH_dfi" "PHYSICAL SNOW DEPTH" "m" -state real dfi_CANWAT ij misc 1 - r "CANWAT_dfi" "CANOPY WATER" "kg m-2" -state real dfi_SMFR3D ilj misc 1 Z r "SMFR3D_dfi" "SOIL ICE" "" -state real dfi_KEEPFR3DFLAG ilj misc 1 Z r "KEEPFR3DFLAG_dfi" "FLAG - 1. FROZEN SOIL YES, 0 - NO" "" - -# urban state variables -state real TR_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TR_URB" "URBAN ROOF SKIN TEMPERATURE" "K" -state real TB_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TB_URB" "URBAN WALL SKIN TEMPERATURE" "K" -state real TG_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TG_URB" "URBAN ROAD SKIN TEMPERATURE" "K" -state real TC_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TC_URB" "URBAN CANOPY TEMPERATURE" "K" -state real QC_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "QC_URB" "URBAN CANOPY HUMIDITY" "kg kg{-1}" -state real UC_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "UC_URB" "URBAN CANOPY WIND" "m s{-1}" -state real XXXR_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "XXXR_URB" "M-O LENGTH ABOVE URBAN ROOF" "dimensionless" -state real XXXB_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "XXXB_URB" "M-O LENGTH ABOVE URBAN WALL" "dimensionless" -state real XXXG_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "XXXG_URB" "M-O LENGTH ABOVE URBAN ROAD" "dimensionless" -state real XXXC_URB2D ij misc 1 - rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "XXXC_URB" "M-O LENGTH ABOVE URBAN CANOPY" "dimensionless" -state real TRL_URB3D ilj misc 1 Z rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TRL_URB" "ROOF LAYER TEMPERATURE" "K" -state real TBL_URB3D ilj misc 1 Z rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TBL_URB" "WALL LAYER TEMPERATURE" "K" -state real TGL_URB3D ilj misc 1 Z rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TGL_URB" "ROAD LAYER TEMPERATURE" "K" -state real SH_URB2D ij misc 1 - r "SH_URB" "SENSIBLE HEAT FLUX FROM URBAN SFC" "W m{-2}" -state real LH_URB2D ij misc 1 - r "LH_URB" "LATENT HEAT FLUX FROM URBAN SFC" "W m{-2}" -state real G_URB2D ij misc 1 - r "G_URB" "GROUND HEAT FLUX INTO URBAN" "W m{-2}" -state real RN_URB2D ij misc 1 - r "RN_URB" "NET RADIATION ON URBAN SFC" "W m{-2}" -state real TS_URB2D ij misc 1 - r "TS_URB" "SKIN TEMPERATURE" "K" -state real FRC_URB2D ij misc 1 - rd=(interp_fcnm)u=(copy_fcnm) "FRC_URB" "URBAN FRACTION" "dimensionless" -state integer UTYPE_URB2D ij misc 1 - rd=(interp_fcnm)u=(copy_fcnm) "UTYPE_URB" "URBAN TYPE" "dimensionless" - - -# urban variables from radiation model -state real COSZ_URB2D ij misc 1 - r "COSZ_URB" "COS of SOLAR ZENITH ANGLE" "dimensionless" -state real OMG_URB2D ij misc 1 - r "OMG_URB" "SOLAR HOUR ANGLE" "dimensionless" -state real DECLIN_URB - misc 1 - r "DECLIN_URB" "SOLAR DECLINATION" "dimensionless" - - -# RUC LSM -state real SMFR3D ilj misc 1 Z r "SMFR3D" "SOIL ICE" "" -state real KEEPFR3DFLAG ilj misc 1 Z r "KEEPFR3DFLAG" "FLAG - 1. FROZEN SOIL YES, 0 - NO" "" - -# Additional for P-X PBL and LSM -state real RA ij misc 1 - r "RA" "AERODYNAMIC RESISTANCE" "s m-1" -state real RS ij misc 1 - r "RS" "SURFACE RESISTANCE" "s m-1" -state real LAI ij misc 1 - r "LAI" "Leaf area index" "area/area" -state real VEGF_PX ij misc 1 - r "VEGF_PX" "Vegetation Fraction for PX LSM" "area/area" -state real T2OBS ij misc 1 - r "T2OBS" "2-m temperature from analysis " "K" -state real Q2OBS ij misc 1 - r "Q2OBS" "2-m mixing ratio from analysis " "kg/kg" - -# MRF PBL variables -i1 real PSIM ij misc 1 - - "PSIM" "SIMILARITY FUNCTION FOR MOMENTUM" "" -i1 real PSIH ij misc 1 - - "PSIH" "SIMILARITY FUNCTION FOR HEAT" "" -i1 real WSPD ij misc 1 - - "WSPD" "Wind speed" "m s-1" -i1 real GZ1OZ0 ij misc 1 - - "GZ1OZ0" "LOG OF Z1 over Z0" "" -i1 real BR ij misc 1 - - "BR" "Bulk Richardson" "" - -# MYJ PBL variables -state real tke_myj ikj misc 1 - r "tke_myj" "TKE FROM MELLOR-YAMADA-JANJIC" "m2 s-2" -state real EL_MYJ ikj misc 1 - - "el_myj" "MIXING LENGTH FROM MELLOR-YAMADA-JANJIC" "m" -state real EXCH_H ikj misc 1 - r "EXCH_H" "EXCHANGE COEFFICIENTS " -state real CT ij misc 1 - r "CT" "COUNTERGRADIENT TERM" "K" -state real THZ0 ij misc 1 - r "THZ0" "POTENTIAL TEMPERATURE AT ZNT" "K" -state real Z0 ij misc 1 - r "Z0" "Background ROUGHNESS LENGTH" "m" -state real QZ0 ij misc 1 - r "QZ0" "SPECIFIC HUMIDITY AT ZNT" "kg kg-1" -state real UZ0 ij misc 1 - r "UZ0" "U WIND COMPONENT AT ZNT" "m s-1" -state real VZ0 ij misc 1 - r "VZ0" "V WIND COMPONENT AT ZNT" "m s-1" -state real QSFC ij misc 1 - r "QSFC" "SPECIFIC HUMIDITY AT LOWER BOUNDARY" "kg kg-1" -state real AKHS ij misc 1 - r "AKHS" "SFC EXCH COEFF FOR HEAT" "m s-1" -state real AKMS ij misc 1 - r "AKMS" "SFC EXCH COEFF FOR MOMENTUM" "m s-1" -state integer KPBL ij misc 1 - r "KPBL" "LEVEL OF PBL TOP" "" -state real TSHLTR ij misc 1 - ir "TSHLTR" "SHELTER THETA FROM MYJ" "K" -state real QSHLTR ij misc 1 - ir "QSHLTR" "SHELTER SPECIFIC HUMIDITY FROM MYJ" "kg kg-1" -state real PSHLTR ij misc 1 - ir "PSHLTR" "SHELTER PRESSURE FROM MYJ" "Pa" -state real TH10 ij misc 1 - ir "TH10" "10-M THETA FROM MYJ" "K" -state real Q10 ij misc 1 - ir "Q10" "10-M SPECIFIC HUMIDITY FROM MYJ" "kg kg-1" -i1 real CHKLOWQ ij misc 1 - - "CHKLOWQ" "SURFACE SATURATION FLAG" "" - -# gfdl (eta) radiation State Variables -state real HTOP ij misc 1 - r "HTOP" "TOP OF CONVECTION LEVEL" "" -state real HBOT ij misc 1 - r "HBOT" "BOT OF CONVECTION LEVEL" "" -state real HTOPR ij misc 1 - r "HTOPR" "TOP OF CONVECTION LEVEL FOR RADIATION" "" -state real HBOTR ij misc 1 - r "HBOTR" "BOT OF CONVECTION LEVEL FOR RADIATION" "" -state real CUTOP ij misc 1 - r "CUTOP" "TOP OF CONVECTION LEVEL FROM CUMULUS PAR" "" -state real CUBOT ij misc 1 - r "CUBOT" "BOT OF CONVECTION LEVEL FROM CUMULUS PAR" "" -state REAL CUPPT ij misc 1 - r "CUPPT" "ACCUMULATED CONVECTIVE RAIN SINC LAST CALL TO THE RADIATION" "" -state real rswtoa ij misc 1 - i -state real rlwtoa ij misc 1 - i -state real czmean ij misc 1 - i -state real cfracl ij misc 1 - i -state real cfracm ij misc 1 - i -state real cfrach ij misc 1 - i -state real acfrst ij misc 1 - i -state integer ncfrst ij misc 1 - i -state real acfrcv ij misc 1 - i -state integer ncfrcv ij misc 1 - i - -# cam radiation variables -state real - iqjf ozmixm 1 - - - -state real mth01 iqjf ozmixm 1 - - - -state real mth02 iqjf ozmixm 1 - - - -state real mth03 iqjf ozmixm 1 - - - -state real mth04 iqjf ozmixm 1 - - - -state real mth05 iqjf ozmixm 1 - - - -state real mth06 iqjf ozmixm 1 - - - -state real mth07 iqjf ozmixm 1 - - - -state real mth08 iqjf ozmixm 1 - - - -state real mth09 iqjf ozmixm 1 - - - -state real mth10 iqjf ozmixm 1 - - - -state real mth11 iqjf ozmixm 1 - - - -state real mth12 iqjf ozmixm 1 - - - -state real pin q misc 1 - - "PIN" "PRESSURE LEVEL OF OZONE MIXING RATIO" "millibar" -state real m_ps ij misc 2 - - "m_ps" "PS from MATCH on WRF grids" -state real - idjf aerosolc 2 - - - -state real SUL idjf aerosolc 2 - - "SUL" "SUL aerosol concentration" -state real SSLT idjf aerosolc 2 - - "SSLT" "SSLT aerosol concentration" -state real DUST1 idjf aerosolc 2 - - "DUST1" "DUST1 aerosol concentration" -state real DUST2 idjf aerosolc 2 - - "DUST2" "DUST2 aerosol concentration" -state real DUST3 idjf aerosolc 2 - - "DUST3" "DUST3 aerosol concentration" -state real DUST4 idjf aerosolc 2 - - "DUST4" "DUST4 aerosol concentration" -state real OCPHO idjf aerosolc 2 - - "OCPHO" "OCPHO aerosol concentration" -state real BCPHO idjf aerosolc 2 - - "BCPHO" "BCPHO aerosol concentration" -state real OCPHI idjf aerosolc 2 - - "OCPHI" "OCPHI aerosol concentration" -state real BCPHI idjf aerosolc 2 - - "BCPHI" "BCPHI aerosol concentration" -state real BG idjf aerosolc 2 - - "BG" "BG aerosol concentration" -state real VOLC idjf aerosolc 2 - - "VOLC" "VOLC aerosol concentration" -state real m_hybi d misc 1 - - "m_hybi" "MATCH hybi" - -# new eta microphpysics State Variables -state real F_ICE_PHY ikj misc 1 - rdu "F_ICE_PHY" "FRACTION OF ICE" "" -state real F_RAIN_PHY ikj misc 1 - rdu "F_RAIN_PHY" "FRACTION OF RAIN " "" -state real F_RIMEF_PHY ikj misc 1 - rdu "F_RIMEF_PHY" "MASS RATIO OF RIMED ICE " "" -state real qndropsource ikj misc 1 - - "qndropsource" "Droplet number source" "#/kg/s" - -# Other Misc State Variables -state real h_diabatic ikj misc 1 - rdu "h_diabatic" "PREVIOUS TIMESTEP CONDENSATIONAL HEATING" "K s-1" -state real msft ij misc 1 - i012rdu=(copy_fcnm) "MAPFAC_M" "Map scale factor on mass grid" "" -state real msfu ij misc 1 X i012rdu=(copy_fcnm) "MAPFAC_U" "Map scale factor on u-grid" "" -state real msfv ij misc 1 Y i012rdu=(copy_fcnm) "MAPFAC_V" "Map scale factor on v-grid" "" -state real msftx ij misc 1 - i012rdu=(copy_fcnm) "MAPFAC_MX" "Map scale factor on mass grid, x direction" "" -state real msfty ij misc 1 - i012rdu=(copy_fcnm) "MAPFAC_MY" "Map scale factor on mass grid, y direction" "" -state real msfux ij misc 1 X i012rdu=(copy_fcnm) "MAPFAC_UX" "Map scale factor on u-grid, x direction" "" -state real msfuy ij misc 1 X i012rdu=(copy_fcnm) "MAPFAC_UY" "Map scale factor on u-grid, y direction" "" -state real msfvx ij misc 1 Y i012rdu=(copy_fcnm) "MAPFAC_VX" "Map scale factor on v-grid, x direction" "" -state real msfvx_inv ij misc 1 Y i012rdu=(copy_fcnm) "MF_VX_INV" "Inverse map scale factor on v-grid, x direction" "" -state real msfvy ij misc 1 Y i012rdu=(copy_fcnm) "MAPFAC_VY" "Map scale factor on v-grid, y direction" "" - -state real f ij misc 1 - i012rdu=(copy_fcnm) "f" "Coriolis sine latitude term" "s-1" -state real e ij misc 1 - i012rdu=(copy_fcnm) "e" "Coriolis cosine latitude term" "s-1" -state real sina ij misc 1 - i012rdu=(copy_fcnm) "SINALPHA" "Local sine of map rotation" "" -state real cosa ij misc 1 - i012rdu=(copy_fcnm) "COSALPHA" "Local cosine of map rotation" "" -state real ht ij misc 1 - i012rdus "HGT" "Terrain Height" "m" -state real ht_fine ij misc 1 - - "HGT_FINE" "Fine Terrain Height" "m" -state real ht_int ij misc 1 - - "HGT_INT" "Terrain Height Horizontally Interpolated" "m" -state real ht_input ij misc 1 - - "HGT_INPUT" "Terrain Height from FG Input File" "m" -state real ht_shad ijb misc 1 - df=(bdy_interp:dt) "HGT_SHAD" "Height of orographic shadow" "m" -i1 real ht_loc ij misc 1 - - -i1 integer shadowmask ij misc 1 - - -state integer min_ptchsz - misc 1 - r - -state real TSK ij misc 1 - i012rdu=(copy_fcnm) "TSK" "SURFACE SKIN TEMPERATURE" "K" -state real dfi_TSK ij misc 1 - r "TSK_dfi" "saved SURFACE SKIN TEMPERATURE" -state real TSK_SAVE ij misc 1 - - "TSK_SAVE" "SURFACE SKIN TEMPERATURE, EXTRA COPY FOR SEA ICE TESTS in REAL" "K" -state real u_base k misc 1 - ir "u_base" "BASE STATE X WIND IN IDEALIZED CASES" "" -state real v_base k misc 1 - ir "v_base" "BASE STATE Y WIND IN IDEALIZED CASES" "" -state real qv_base k misc 1 - ir "qv_base" "BASE STATE QV IN IDEALIZED CASES" "" -state real z_base k misc 1 - ir "z_base" "BASE STATE HEIGHT IN IDEALIZED CASES" "" -state real u_frame - misc 1 - ir "u_frame" "FRAME X WIND" "m s-1" -state real v_frame - misc 1 - ir "v_frame" "FRAME Y WIND" "m s-1" -# p_top appears as metadata between SI and real but as a state variable in real and WRF -# since it is a scalar and a constant, it makes sense to have it as metadata -- there -# are, however, probably post-processing programs that expect to see it as an I/O record -# another problem: share/input_wrf tries to read this as metadata (fine for real reading -# SI, but with model reading real output, it generates a warning when debug is > 0 in -# namelist and causes repeated questions from users. A third problem is the potential -# collision between a metadata name and a field record in the I/O data -# resolve this how? Have the real program throw a switch to tell the code to get it -# from the metadata? Otherwise it's a field? -state real p_top - misc - - ir "p_top" "PRESSURE TOP OF THE MODEL" "Pa" -state real max_msftx - misc - - r "max_mstfx" "Max map factor in domain" "" -state real max_msfty - misc - - r "max_mstfy" "Max map factor in domain" "" - -# Other physics variables - -state real RTHCUTEN ikj misc 1 - r "RTHCUTEN" "COUPLED THETA TENDENCY DUE TO CUMULUS SCHEME" "Pa K s-1" -state real RQVCUTEN ikj misc 1 - r "RQVCUTEN" "COUPLED Q_V TENDENCY DUE TO CUMULUS SCHEME" "Pa kg kg-1 s-1" -state real RQRCUTEN ikj misc 1 - r "RQRCUTEN" "COUPLED Q_R TENDENCY DUE TO CUMULUS SCHEME" "Pa kg kg-1 s-1" -state real RQCCUTEN ikj misc 1 - r "RQCCUTEN" "COUPLED Q_C TENDENCY DUE TO CUMULUS SCHEME" "Pa kg kg-1 s-1" -state real RQSCUTEN ikj misc 1 - r "RQSCUTEN" "COUPLED Q_S TENDENCY DUE TO CUMULUS SCHEME" "Pa kg kg-1 s-1" -state real RQICUTEN ikj misc 1 - r "RQICUTEN" "COUPLED Q_I TENDENCY DUE TO CUMULUS SCHEME" "Pa kg kg-1 s-1" -state real W0AVG ikj misc 1 - r "W0AVG" "AVERAGE VERTICAL VELOCITY FOR KF CUMULUS SCHEME" "m s-1" - -state real RAINC ij misc 1 - rdu "RAINC" "ACCUMULATED TOTAL CUMULUS PRECIPITATION" "mm" -state real RAINNC ij misc 1 - rdu "RAINNC" "ACCUMULATED TOTAL GRID SCALE PRECIPITATION" "mm" -state real PRATEC ij misc 1 - r "PRATEC" "PRECIP RATE FROM CUMULUS SCHEME" "mm s-1" -state real RAINCV ij misc 1 - r "RAINCV" "TIME-STEP CUMULUS PRECIPITATION" "mm" -state real RAINNCV ij misc 1 - r "RAINNCV" "TIME-STEP NONCONVECTIVE PRECIPITATION" "mm" -state real RAINBL ij misc 1 - r "RAINBL" "PBL TIME-STEP TOTAL PRECIPITATION" "mm" -state real SNOWNC ij misc 1 - rdu "SNOWNC" "ACCUMULATED TOTAL GRID SCALE SNOW AND ICE" "mm" -state real GRAUPELNC ij misc 1 - rdu "GRAUPELNC" "ACCUMULATED TOTAL GRID SCALE GRAUPEL" "mm" -state real SNOWNCV ij misc 1 - r "SNOWNCV" "TIME-STEP NONCONVECTIVE SNOW AND ICE" "mm" -state real GRAUPELNCV ij misc 1 - r "GRAUPELNCV" "TIME-STEP NONCONVECTIVE GRAUPEL" "mm" -state real NCA ij misc 1 - r "NCA" "COUNTER OF THE CLOUD RELAXATION TIME IN KF CUMULUS SCHEME" "" -state integer LOWLYR ij misc 1 - - "LOWLYR" "INDEX OF LOWEST MODEL LAYER ABOVE THE GROUND IN BMJ SCHEME" "" -state real MASS_FLUX ij misc 1 - r "MASS_FLUX" "DOWNDRAFT MASS FLUX FOR IN GRELL CUMULUS SCHEME" "mb hour-1" -state real apr_gr ij misc 1 - r "APR_GR" "PRECIP FROM CLOSURE OLD_GRELL" "mm hour-1" -state real apr_w ij misc 1 - r "APR_W" "PRECIP FROM CLOSURE W" "mm hour-1" -state real apr_mc ij misc 1 - r "APR_MC" "PRECIP FROM CLOSURE KRISH MV" "mm hour-1" -state real apr_st ij misc 1 - r "APR_ST" "PRECIP FROM CLOSURE STABILITY" "mm hour-1" -state real apr_as ij misc 1 - r "APR_AS" "PRECIP FROM CLOSURE AS-TYPE" "mm hour-1" -state real apr_capma ij misc 1 - r "APR_CAPMA" "PRECIP FROM MAX CAP" "mm hour-1" -state real apr_capme ij misc 1 - r "APR_CAPME" "PRECIP FROM MEAN CAP" "mm hour-1" -state real apr_capmi ij misc 1 - r "APR_CAPMI" "PRECIP FROM MIN CAP" "mm hour-1" -state real edt_out ij misc 1 - - "EDT_OUT" "EDT FROM GD SCHEME" "" -state real xf_ens ije misc 1 Z r "XF_ENS" "MASS FLUX PDF IN GRELL CUMULUS SCHEME" "mb hour-1" -state real pr_ens ije misc 1 Z r "PR_ENS" "PRECIP RATE PDF IN GRELL CUMULUS SCHEME" "mb hour-1" -state real cugd_tten ikj misc 1 - h "CUGD_TTEN" "INITIAL TTENDENCY OUT OFF GRELL CUMULUS SCHEME" "K s-1" -state real cugd_qvten ikj misc 1 - h "CUGD_QVTEN" "INITIAL QTENDENCY OUT OFF GRELL CUMULUS SCHEME" "K s-1" -state real cugd_ttens ikj misc 1 - h "CUGD_TTENS" "INITIAL SUBSIDENCE TTENDENCY OUT OFF GRELL CUMULUS SCHEME" "K s-1" -state real cugd_qvtens ikj misc 1 - h "CUGD_QVTENS" "INITIAL SUBSIDNCE QTENDENCY OUT OFF GRELL CUMULUS SCHEME" "K s-1" -state real cugd_qcten ikj misc 1 - h "CUGD_QCTEN" "INITIAL TEMPERATURE TENDENCY OUT OFF GRELL CUMULUS SCHEME" "K s-1" -#state real ACLWUPTC ij misc 1 - rhdu "ACLWUPTC" "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2" -state real RTHFTEN ikj misc 1 - r "RTHFTEN" "TEMPERATURE TENDENCY USED IN GRELL CUMULUS SCHEME" "K s-1" -state real RQVFTEN ikj misc 1 - r "RQVFTEN" "MOISTURE TENDENCY USED IN GRELL CUMULUS SCHEME" "kg s-1" - -state integer STEPCU - misc 1 - r "STEPCU" "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN CONVECTION CALLS" "" - -state real RTHRATEN ikj misc 1 - rd "RTHRATEN" "COUPLED THETA TENDENCY DUE TO RADIATION" "Pa K s-1" -state real RTHRATENLW ikj misc 1 - r "RTHRATLW" "UNCOUPLED THETA TENDENCY DUE TO LONG WAVE RADIATION" "K s-1" -state real RTHRATENSW ikj misc 1 - r "RTHRATSW" "UNCOUPLED THETA TENDENCY DUE TO SHORT WAVE RADIATION" "K s-1" -state real CLDFRA ikj misc 1 - r "CLDFRA" "CLOUD FRACTION" "" - -state real SWDOWN ij misc 1 - rd "SWDOWN" "DOWNWARD SHORT WAVE FLUX AT GROUND SURFACE" "W m-2" -state real SWDOWNC ij misc 1 - - "SWDOWNC" "DOWNWARD CLEAR-SKY SHORT WAVE FLUX AT GROUND SURFACE" "W m-2" -state real GSW ij misc 1 - rd "GSW" "NET SHORT WAVE FLUX AT GROUND SURFACE" "W m-2" -state real GLW ij misc 1 - rd "GLW" "DOWNWARD LONG WAVE FLUX AT GROUND SURFACE" "W m-2" - -# upward and downward clearsky and total diagnostic fluxes for CAM radiation -#state real ACSWUPT ij misc 1 - rhdu "ACSWUPT" "ACCUMULATED UPWELLING SHORTWAVE FLUX AT TOP" "J m-2" -#state real ACSWUPTC ij misc 1 - rhdu "ACSWUPTC" "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2" -#state real ACSWDNT ij misc 1 - rhdu "ACSWDNT" "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT TOP" "J m-2" -#state real ACSWDNTC ij misc 1 - rhdu "ACSWDNTC" "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2" -#state real ACSWUPB ij misc 1 - rhdu "ACSWUPB" "ACCUMULATED UPWELLING SHORTWAVE FLUX AT BOTTOM" "J m-2" -#state real ACSWUPBC ij misc 1 - rhdu "ACSWUPBC" "ACCUMULATED UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2" -#state real ACSWDNB ij misc 1 - rhdu "ACSWDNB" "ACCUMULATED DOWNWELLING SHORTWAVE FLUX AT BOTTOM" "J m-2" -#state real ACSWDNBC ij misc 1 - rhdu "ACSWDNBC" "ACCUMULATED DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2" -#state real ACLWUPT ij misc 1 - rhdu "ACLWUPT" "ACCUMULATED UPWELLING LONGWAVE FLUX AT TOP" "J m-2" -#state real ACLWUPTC ij misc 1 - rhdu "ACLWUPTC" "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2" -#state real ACLWDNT ij misc 1 - rhdu "ACLWDNT" "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT TOP" "J m-2" -#state real ACLWDNTC ij misc 1 - rhdu "ACLWDNTC" "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2" -#state real ACLWUPB ij misc 1 - rhdu "ACLWUPB" "ACCUMULATED UPWELLING LONGWAVE FLUX AT BOTTOM" "J m-2" -#state real ACLWUPBC ij misc 1 - rhdu "ACLWUPBC" "ACCUMULATED UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2" -#state real ACLWDNB ij misc 1 - rhdu "ACLWDNB" "ACCUMULATED DOWNWELLING LONGWAVE FLUX AT BOTTOM" "J m-2" -#state real ACLWDNBC ij misc 1 - rhdu "ACLWDNBC" "ACCUMULATED DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2" -#state real SWUPT ij misc 1 - rhdu "SWUPT" "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT TOP" "J m-2" -#state real SWUPTC ij misc 1 - rhdu "SWUPTC" "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2" -#state real SWDNT ij misc 1 - rhdu "SWDNT" "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT TOP" "J m-2" -#state real SWDNTC ij misc 1 - rhdu "SWDNTC" "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT TOP" "J m-2" -#state real SWUPB ij misc 1 - rhdu "SWUPB" "INSTANTANEOUS UPWELLING SHORTWAVE FLUX AT BOTTOM" "J m-2" -#state real SWUPBC ij misc 1 - rhdu "SWUPBC" "INSTANTANEOUS UPWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2" -#state real SWDNB ij misc 1 - rhdu "SWDNB" "INSTANTANEOUS DOWNWELLING SHORTWAVE FLUX AT BOTTOM" "J m-2" -#state real SWDNBC ij misc 1 - rhdu "SWDNBC" "INSTANTANEOUS DOWNWELLING CLEAR SKY SHORTWAVE FLUX AT BOTTOM" "J m-2" -#state real LWUPT ij misc 1 - rhdu "LWUPT" "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT TOP" "J m-2" -#state real LWUPTC ij misc 1 - rhdu "LWUPTC" "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2" -#state real LWDNT ij misc 1 - rhdu "LWDNT" "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT TOP" "J m-2" -#state real LWDNTC ij misc 1 - rhdu "LWDNTC" "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT TOP" "J m-2" -#state real LWUPB ij misc 1 - rhdu "LWUPB" "INSTANTANEOUS UPWELLING LONGWAVE FLUX AT BOTTOM" "J m-2" -#state real LWUPBC ij misc 1 - rhdu "LWUPBC" "INSTANTANEOUS UPWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2" -#state real LWDNB ij misc 1 - rhdu "LWDNB" "INSTANTANEOUS DOWNWELLING LONGWAVE FLUX AT BOTTOM" "J m-2" -#state real LWDNBC ij misc 1 - rhdu "LWDNBC" "INSTANTANEOUS DOWNWELLING CLEAR SKY LONGWAVE FLUX AT BOTTOM" "J m-2" - -state real SWCF ij misc 1 - r "SWCF" "SHORT WAVE CLOUD FORCING AT TOA" "W m-2" -state real LWCF ij misc 1 - r "LWCF" "LONG WAVE CLOUD FORCING AT TOA" "W m-2" -state real OLR ij misc 1 - r "OLR" "TOA OUTGOING LONG WAVE" "W m-2" - -# these next 2 are for the HFSoLE/PET demo; writing these to auxhist1 output over MCEL for coupling -# with wave model, only if compiled with -DMCELIO, JM 2003/05/29 -state real XLAT ij misc 1 - i0123r01du=(copy_fcnm) "XLAT" "LATITUDE, SOUTH IS NEGATIVE" "degree_north" -state real XLONG ij misc 1 - i0123r01du=(copy_fcnm) "XLONG" "LONGITUDE, WEST IS NEGATIVE" "degree_east" -state real XLAT_U ij dyn_em 1 X i012r01du=(copy_fcnm) "XLAT_U" "LATITUDE, SOUTH IS NEGATIVE" "degree_north" -state real XLONG_U ij dyn_em 1 X i012r01du=(copy_fcnm) "XLONG_U" "LONGITUDE, WEST IS NEGATIVE" "degree_east" -state real XLAT_V ij dyn_em 1 Y i012r01du=(copy_fcnm) "XLAT_V" "LATITUDE, SOUTH IS NEGATIVE" "degree_north" -state real XLONG_V ij dyn_em 1 Y i012r01du=(copy_fcnm) "XLONG_V" "LONGITUDE, WEST IS NEGATIVE" "degree_east" -state real ALBEDO ij misc 1 - r "ALBEDO" "ALBEDO" -state real CLAT ij misc 1 - i012rdu=(copy_fcnm) "CLAT" "COMPUTATIONAL GRID LATITUDE, SOUTH IS NEGATIVE" "degree_north" -state real CLONG ij misc 1 - i012rdu=(copy_fcnm) "CLONG" "COMPUTATIONAL GRID LONGITUDE, WEST IS NEGATIVE" "degree_east" -state real ALBBCK ij misc 1 - i0124r "ALBBCK" "BACKGROUND ALBEDO" "" -state real EMBCK ij misc 1 - r "EMBCK" "BACKGROUND EMISSIVITY" "" -state real EMISS ij misc 1 - r "EMISS" "SURFACE EMISSIVITY" "" - -state real CLDEFI ij misc 1 - r "CLDEFI" "precipitation efficiency in BMJ SCHEME" "" -state integer STEPRA - misc 1 - r "STEPRA" "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN RADIATION CALLS" "" - -state real RUBLTEN ikj misc 1 - r "RUBLTEN" "COUPLED X WIND TENDENCY DUE TO PBL PARAMETERIZATION" "Pa m s-2" -state real RVBLTEN ikj misc 1 - r "RVBLTEN" "COUPLED Y WIND TENDENCY DUE TO PBL PARAMETERIZATION" "Pa m s-2" -state real RTHBLTEN ikj misc 1 - r "RTHBLTEN" "COUPLED THETA TENDENCY DUE TO PBL PARAMETERIZATION" "Pa K s-1" -state real RQVBLTEN ikj misc 1 - r "RQVBLTEN" "COUPLED Q_V TENDENCY DUE TO PBL PARAMETERIZATION" "Pa kg kg-1 s-1" -state real RQCBLTEN ikj misc 1 - r "RQCBLTEN" "COUPLED Q_C TENDENCY DUE TO PBL PARAMETERIZATION" "Pa kg kg-1 s-1" -state real RQIBLTEN ikj misc 1 - r "RQIBLTEN" "COUPLED Q_I TENDENCY DUE TO PBL PARAMETERIZATION" "Pa kg kg-1 s-1" - -# State vector for etampnew microphysics. Must be declared state because it is not read-once and is needed for restarting. -state real mp_restart_state p misc 1 - r "MP_RESTART_STATE" "STATE VECTOR FOR MICROPHYSICS RESTARTS" -state real tbpvs_state p misc 1 - r "TBPVS_STATE" "STATE FOR ETAMPNEW MICROPHYSICS" -state real tbpvs0_state p misc 1 - r "TBPVS0_STATE" "STATE FOR ETAMPNEW MICROPHYSICS" - -# State variables for landuse_init, Must be declared state because they are read in and needed for restarts. Had been SAVE vars in -# landuse_init (phys/module_physics_init.F) -state integer landuse_isice - misc - - r -state integer landuse_lucats - misc - - r -state integer landuse_luseas - misc - - r -state integer landuse_isn - misc - - r -state real lu_state p misc - - r - -i1 real th_phy ikj misc 1 - -i1 real pi_phy ikj misc 1 - -i1 real p_phy ikj misc 1 - -i1 real t_phy ikj misc 1 - -i1 real u_phy ikj misc 1 - -i1 real v_phy ikj misc 1 - -i1 real dz8w ikj misc 1 Z -i1 real p8w ikj misc 1 Z -i1 real t8w ikj misc 1 Z -i1 real rho_phy ikj misc 1 - -i1 logical CU_ACT_FLAG ij misc 1 - - - -state real TMN ij misc 1 - i012rd=(interp_mask_land_field:lu_index)u=(copy_fcnm) "TMN" "SOIL TEMPERATURE AT LOWER BOUNDARY" "K" -state real XLAND ij misc 1 - i02rd=(interp_fcnm)u=(copy_fcnm) "XLAND" "LAND MASK (1 FOR LAND, 2 FOR WATER)" "" -state real ZNT ij misc 1 - i3r "ZNT" "TIME-VARYING ROUGHNESS LENGTH" "m" -state real CK ij misc 1 - r "CK" "ENTHALPY EXCHANGE COEFF AT 10 m" "" -state real CKA ij misc 1 - r "CKA" "ENTHALPY EXCHANGE COEFF AT LOWEST MODEL LVL" "" -state real CD ij misc 1 - r "CD" "DRAG COEFF AT 10m" "" -state real CDA ij misc 1 - r "CDA" "DRAG COEFF AT LOWEST MODEL LVL" "" -state real UST ij misc 1 - r "UST" "U* IN SIMILARITY THEORY" "m s-1" -state real USTM ij misc 1 - rh "USTM" "U* IN SIMILARITY THEORY WITHOUT VCONV" "m s-1" #SAVEMARS2 ustar -i1 real HOL ij misc 1 - - "HOL" "PBL HEIGHT OVER MONIN-OBUKHOV LENGTH" "" -state real RMOL ij misc 1 - r "RMOL" "1./Monin Ob. Length" "" -state real MOL ij misc 1 - r "MOL" "T* IN SIMILARITY THEORY" "K" -state real PBLH ij misc 1 - r "PBLH" "PBL HEIGHT" "m" -state real CAPG ij misc 1 - r "CAPG" "HEAT CAPACITY FOR SOIL" "J K-1 m-3" -state real THC ij misc 1 - r "THC" "THERMAL INERTIA" "Cal cm-1 K-1 s-0.5" -state real HFX ij misc 1 - rh "HFX" "UPWARD HEAT FLUX AT THE SURFACE" "W m-2" #SAVEMARS2 sensheat -state real QFX ij misc 1 - r "QFX" "UPWARD MOISTURE FLUX AT THE SURFACE" "kg m-2 s-1" -state real LH ij misc 1 - r "LH" "LATENT HEAT FLUX AT THE SURFACE" "W m-2" -state real FLHC ij misc 1 - r "FLHC" "SURFACE EXCHANGE COEFFICIENT FOR HEAT" "" -state real FLQC ij misc 1 - r "FLQC" "SURFACE EXCHANGE COEFFICIENT FOR MOISTURE" "" -state real QSG ij misc 1 - r "QSG" "SURFACE SATURATION WATER VAPOR MIXING RATIO" "kg kg-1" -state real QVG ij misc 1 - r "QVG" "WATER VAPOR MIXING RATIO AT THE SURFACE" "kg kg-1" -state real dfi_QVG ij misc 1 - r "QVG_dfi" "WATER VAPOR MIXING RATIO AT THE SURFACE" "kg kg-1" -state real QCG ij misc 1 - r "QCG" "CLOUD WATER MIXING RATIO AT THE SURFACE" "kg kg-1" -state real SOILT1 ij misc 1 - r "SOILT1" "TEMPERATURE INSIDE SNOW " "K" -state real dfi_SOILT1 ij misc 1 - r "SOILT1_dfi" "TEMPERATURE INSIDE SNOW " "K" -state real TSNAV ij misc 1 - r "TSNAV" "AVERAGE SNOW TEMPERATURE " "C" -state real dfi_TSNAV ij misc 1 - r "TSNAV_dfi" "AVERAGE SNOW TEMPERATURE " "C" -state real REGIME ij misc 1 - r "REGIME" "FLAGS: 1=Night/Stable, 2=Mechanical Turbulent, 3=Forced Conv, 4=Free Conv" "" -state real SNOWC ij misc 1 - ird=(interp_mask_land_field:lu_index)u=(copy_fcnm) "SNOWC" "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)" "" -state real dfi_SNOWC ij misc 1 - r "SNOWC_dfi" "FLAG INDICATING SNOW COVERAGE (1 FOR SNOW COVER)" "" -state real MAVAIL ij misc 1 - r "MAVAIL" "SURFACE MOISTURE AVAILABILITY" "" - -state real tkesfcf ij misc 1 - r "tkesfcf" "TKE AT THE SURFACE" "m2 s-2" - -state integer STEPBL - misc 1 - r "STEPBL" "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN PBL CALLS" "" -state real taucldi ikj misc 1 - r "TAUCLDI" "CLOUD OPTICAL THICKNESS FOR ICE" "" -state real taucldc ikj misc 1 - r "TAUCLDC" "CLOUD OPTICAL THICKNESS FOR WATER" "" - -state real defor11 ikj misc 1 - r "defor11" "DEFORMATION 11" "s-1" -state real defor22 ikj misc 1 - r "defor22" "DEFORMATION 22" "s-1" -state real defor12 ikj misc 1 - r "defor12" "DEFORMATION 12" "s-1" -state real defor33 ikj misc 1 z r "defor33" "DEFORMATION 33" "s-1" -state real defor13 ikj misc 1 z r "defor13" "DEFORMATION 13" "s-1" -state real defor23 ikj misc 1 z r "defor23" "DEFORMATION 23" "s-1" -state real xkmv ikj misc 1 - r "xkmv" "VERTICAL EDDY VISCOSITY" "m2 s-1" -state real xkmh ikj misc 1 - r "xkmh" "HORIZONTAL EDDY VISCOSITY" "m2 s-1" -state real xkhv ikj misc 1 - r "xkhv" "VERTICAL EDDY DIFFUSIVITY OF HEAT" "m2 s-1" -state real xkhh ikj misc 1 - r "xkhh" "HORIZONTAL EDDY DIFFUSIVITY OF HEAT" "m2 s-1" -state real div ikj misc 1 - r "div" "DIVERGENCE" "s-1" -state real BN2 ikj misc 1 - r "BN2" "BRUNT-VAISALA FREQUENCY" "s-2" -state logical warm_rain - misc 1 - - "warm_rain" "WARM_RAIN_LOGICAL" -state logical adv_moist_cond - misc 1 - - "adv_moist_cond" "ADVECT MOIST CONDENSATES LOGICAL" - -## FDDA variables - -state integer STEPFG - misc 1 - r "STEPFG" "NUMBER OF FUNDAMENTAL TIMESTEPS BETWEEN FDDA GRID CALLS" "" -state real RUNDGDTEN ikj misc 1 X r "RUNDGDTEN" "COUPLED X WIND TENDENCY DUE TO FDDA GRID NUDGING" "Pa m s-2" -state real RVNDGDTEN ikj misc 1 Y r "RVNDGDTEN" "COUPLED Y WIND TENDENCY DUE TO FDDA GRID NUDGING" "Pa m s-2" -state real RTHNDGDTEN ikj misc 1 - r "RTHNDGDTEN" "COUPLED THETA TENDENCY DUE TO FDDA GRID NUDGING" "Pa K s-1" -state real RQVNDGDTEN ikj misc 1 - r "RQVNDGDTEN" "COUPLED Q_V TENDENCY DUE TO FDDA GRID NUDGING" "Pa kg kg-1 s-1" -state real RMUNDGDTEN ij misc 1 - r "RMUNDGDTEN" "MU TENDENCY DUE TO FDDA GRID NUDGING" "Pa s-1" -state real - ikjf fdda3d 1 - - - -state real U_NDG_NEW ikjf fdda3d 1 X igr "U_NDG_NEW" "NEW X WIND FOR FDDA GRID NUDGING" "m s-1" -state real V_NDG_NEW ikjf fdda3d 1 Y igr "V_NDG_NEW" "NEW Y WIND FOR FDDA GRID NUDGING" "m s-1" -state real T_NDG_NEW ikjf fdda3d 1 - igr "T_NDG_NEW" "NEW PERT POT TEMP FOR FDDA GRID NUDGING" "K" -state real Q_NDG_NEW ikjf fdda3d 1 - igr "Q_NDG_NEW" "NEW WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING" "kg/kg" -state real PH_NDG_NEW ikjf fdda3d 1 Z igr "PH_NDG_NEW" "NEW PERT GEOPOTENTIAL FOR FDDA GRID NUDGING" "kg/kg" -state real U_NDG_OLD ikjf fdda3d 1 X igr "U_NDG_OLD" "OLD X WIND FOR FDDA GRID NUDGING" "m s-1" -state real V_NDG_OLD ikjf fdda3d 1 Y igr "V_NDG_OLD" "OLD Y WIND FOR FDDA GRID NUDGING" "m s-1" -state real T_NDG_OLD ikjf fdda3d 1 - igr "T_NDG_OLD" "OLD PERT POT TEMP FOR FDDA GRID NUDGING" "K" -state real Q_NDG_OLD ikjf fdda3d 1 - igr "Q_NDG_OLD" "OLD WATER VAPOR MIX RATIO FOR FDDA GRID NUDGING" "kg/kg" -state real PH_NDG_OLD ikjf fdda3d 1 Z igr "PH_NDG_OLD" "OLD PERT GEOPOTENTIAL FOR FDDA GRID NUDGING" "kg/kg" -state real - ivjf fdda2d 1 Z - - -state real MU_NDG_NEW ivjf fdda2d 1 Z igr "MU_NDG_NEW" "NEW PERT COLUMN DRY MASS FOR FDDA GRID NUDGING" "Pa" -state real T2_NDG_NEW ivjf fdda2d 1 - igr "T2_NDG_NEW" "NEW 2m TEMP FOR PX LSM " "K" -state real Q2_NDG_NEW ivjf fdda2d 1 - igr "Q2_NDG_NEW" "NEW 2m WATER VAPOR MIX RATIO FOR PX LSM " "kg/kg" -state real MU_NDG_OLD ivjf fdda2d 1 Z igr "MU_NDG_OLD" "OLD PERT COLUMN DRY MASS FOR FDDA GRID NUDGING" "Pa" -state real T2_NDG_OLD ivjf fdda2d 1 - igr "T2_NDG_OLD" "OLD 2m TEMP F FOR PX LSM" "K" -state real Q2_NDG_OLD ivjf fdda2d 1 - igr "Q2_NDG_OLD" "OLD 2m WATER VAPOR MIX RATIO FOR PX LSM" "kg/kg" -state real SN_NDG_NEW ivjf fdda2d 1 - igr "SN_NDG_NEW" "NEW Snow Depth " "m" -state real SN_NDG_OLD ivjf fdda2d 1 - igr "SN_NDG_OLD" "OLD Snow Depth" "m" - - -# flag for nest movement -state logical moved - misc 1 - - - -# special cam radiation restart arrays -state real abstot ikcj misc 1 Z - "" "" " " -state real absnxt ikaj misc 1 - - "" "" " " -state real emstot ikj misc 1 Z - "" "" " " - -# model diagnostics -state real dpsdt ij misc 1 - - "dpsdt" "surface pressure tendency" "Pa/sec" -state real dmudt ij misc 1 - - "dmudt" "mu tendency" "Pa/sec" -state real pk1m ij misc 1 - - "pk1m" "surface pressure at previous step" "Pa" -state real mu_2m ij misc 1 - - "mu_2m" "mu_2 at previous step" "Pa" - -state real max_cfl - misc 1 - - "max_cfl" "maximum CFL value in grid at a time" "-" - -# Ocean Mixed-Layer State Variables -state real TML ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "TML" "OCEAN MIXED-LAYER TEMPERATURE" "K" -state real T0ML ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "T0ML" "INITIAL OCEAN MIXED-LAYER TEMPERATURE" "K" -state real HML ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "HML" "OCEAN MIXED-LAYER DEPTH" "m" -state real H0ML ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "H0ML" "INITIAL OCEAN MIXED-LAYER DEPTH" "m" -state real HUML ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "HUML" "OCEAN MIXED-LAYER DEPTH * U-CURRENT" " m2s-1 " -state real HVML ij misc 1 - rd=(interp_mask_water_field:lu_index)u=(copy_fcnm) "HVML" "OCEAN MIXED-LAYER DEPTH * V-CURRENT" " m2s-1 " -# -#--------------------------------------------------------------------------------------------------------------------------------------- -# - -###### -# -# Variables that are set at run-time to control configuration (namelist-settable) -# -#
- - -# Time Control -rconfig integer run_days namelist,time_control 1 0 irh "run_days" "NUMBER OF DAYS TO RUN" -rconfig integer run_hours namelist,time_control 1 0 irh "run_hours" "NUMBER OF HOURS TO RUN" -rconfig integer run_minutes namelist,time_control 1 0 irh "run_minutes" "NUMBER OF MINUTES TO RUN" -rconfig integer run_seconds namelist,time_control 1 0 irh "run_seconds" "NUMBER OF SECONDS TO RUN" -rconfig integer start_year namelist,time_control max_domains 2024 irh "start_year" "4 DIGIT YEAR OF START OF MODEL" "YEARS" -rconfig integer start_month namelist,time_control max_domains 01 irh "start_month" "2 DIGIT MONTH OF THE YEAR OF START OF MODEL, 1-12" "MONTHS" -rconfig integer start_day namelist,time_control max_domains 01 irh "start_day" "2 DIGIT DAY OF THE MONTH OF START OF MODEL, 1-31" "DAYS" -rconfig integer start_hour namelist,time_control max_domains 00 irh "start_hour" "2 DIGIT HOUR OF THE DAY OF START OF MODEL, 0-23" "HOURS" -rconfig integer start_minute namelist,time_control max_domains 00 irh "start_minute" "2 DIGIT MINUTE OF THE HOUR OF START OF MODEL, 0-59" "MINUTES" -rconfig integer start_second namelist,time_control max_domains 00 irh "start_second" "2 DIGIT SECOND OF THE MINUTE OF START OF MODEL, 0-59" "SECONDS" -rconfig integer end_year namelist,time_control max_domains 2024 irh "end_year" "4 DIGIT YEAR OF END OF MODEL" "YEARS" -rconfig integer end_month namelist,time_control max_domains 01 irh "end_month" "2 DIGIT MONTH OF THE YEAR OF END OF MODEL, 1-12" "MONTHS" -rconfig integer end_day namelist,time_control max_domains 02 irh "end_day" "2 DIGIT DAY OF THE MONTH OF END OF MODEL, 1-31" "DAYS" -rconfig integer end_hour namelist,time_control max_domains 00 irh "end_hour" "2 DIGIT HOUR OF THE DAY OF END OF MODEL, 0-23" "HOURS" -rconfig integer end_minute namelist,time_control max_domains 00 irh "end_minute" "2 DIGIT MINUTE OF THE HOUR OF END OF MODEL, 0-59" "MINUTES" -rconfig integer end_second namelist,time_control max_domains 00 irh "end_second" "2 DIGIT SECOND OF THE MINUTE OF END OF MODEL, 0-59" "SECONDS" -rconfig integer interval_seconds namelist,time_control 1 43200 irh "interval_seconds" "SECONDS BETWEEN ANALYSIS AND BOUNDARY PERIODS" "SECONDS" -rconfig logical input_from_file namelist,time_control max_domains .false. irh "input_from_file" "T/F INPUT FOR THIS DOMAIN FROM A SEPARATE INPUT FILE" "" -rconfig integer fine_input_stream namelist,time_control max_domains 0 irh "fine_input_stream" "0 THROUGH 11, WHAT INPUT STREAM IS FINE GRID IC FROM" "" -rconfig logical input_from_hires namelist,time_control max_domains .false. irh "input_from_hires" "T/F INPUT FOR THIS DOMAIN FROM USGS HI RES TERRAIN" "" -rconfig character rsmas_data_path namelist,time_control 1 "." - "rsmas_data_path" "" "" -rconfig logical all_ic_times namelist,time_control 1 .false. irh "all_ic_times" "T/F WRITE ALL IC TIME PERIODS" "" - -include registry.io_boilerplate - -rconfig integer JULYR namelist,time_control max_domains 0 h "JULYR" "" "" -rconfig integer JULDAY namelist,time_control max_domains 1 h "JULDAY" "" "" -rconfig real GMT namelist,time_control max_domains 0. h "GMT" "" "" -rconfig character input_inname namelist,time_control 1 "wrfinput_d" - "name of input infile" "" "" -rconfig character input_outname namelist,time_control 1 "wrfinput_d" - "name of input outfile" "" "" -rconfig character bdy_inname namelist,time_control 1 "wrfbdy_d" - "name of boundary infile" "" "" -rconfig character bdy_outname namelist,time_control 1 "wrfbdy_d" - "name of boundary outfile" "" "" -rconfig character rst_inname namelist,time_control 1 "wrfrst_d_" - "name of restrt infile" "" "" -rconfig character rst_outname namelist,time_control 1 "wrfrst_d_" - "name of restrt outfile" "" "" -rconfig logical write_input namelist,time_control 1 .false. - "write input data for 3dvar etc." "" "" -rconfig logical write_restart_at_0h namelist,time_control 1 .false. h "write_restart_at_0h" "" "" -rconfig logical adjust_output_times namelist,time_control 1 .false. - "adjust_output_times" -rconfig logical adjust_input_times namelist,time_control 1 .false. - "adjust_input_times" - -rconfig integer diag_print namelist,time_control 1 0 - "print out time series of model diagnostics" -rconfig logical nocolons namelist,time_control 1 .false. - "nocolons" - -# DFI namelist -rconfig integer dfi_opt namelist,dfi_control 1 0 rh "dfi_opt" "" "" -rconfig integer dfi_nfilter namelist,dfi_control 1 7 rh "dfi_nfilter" "Digital filter type" "" -rconfig logical dfi_write_filtered_input namelist,dfi_control 1 .true. rh "dfi_write_filtered_input" "Write a wrfinput_filtered_d0n file?" "" -rconfig logical dfi_write_dfi_history namelist,dfi_control 1 .false. rh "dfi_write_dfi_history" "Write history files during filtering?" "" -rconfig integer dfi_cutoff_seconds namelist,dfi_control 1 3600 rh "dfi_cutoff_seconds" "Digital filter cutoff time" "" -rconfig integer dfi_time_dim namelist,dfi_control 1 1000 rh "dfi_time_dim" "MAX DIMENSION FOR HCOEFF" -rconfig integer dfi_fwdstop_year namelist,dfi_control 1 2004 rh "dfi_fwdstop_year" "4 DIGIT YEAR OF START OF DFI" "YEARS" -rconfig integer dfi_fwdstop_month namelist,dfi_control 1 03 rh "dfi_fwdstop_month" "2 DIGIT MONTH OF THE YEAR OF START OF DFI" "MONTHS" -rconfig integer dfi_fwdstop_day namelist,dfi_control 1 13 rh "dfi_fwdstop_day" "2 DIGIT DAY OF THE MONTH OF START OF DFI" "DAYS" -rconfig integer dfi_fwdstop_hour namelist,dfi_control 1 12 rh "dfi_fwdstop_hour" "2 DIGIT HOUR OF THE DAY OF START OF DFI" "HOURS" -rconfig integer dfi_fwdstop_minute namelist,dfi_control 1 00 rh "dfi_fwdstop_minute" "2 DIGIT MINUTE OF THE HOUR OF START OF DFI" "MINUTES" -rconfig integer dfi_fwdstop_second namelist,dfi_control 1 00 rh "dfi_fwdstop_second" "2 DIGIT SECOND OF THE MINUTE OF START OF DFI" "SECONDS" -rconfig integer dfi_bckstop_year namelist,dfi_control 1 2004 rh "dfi_bckstop_year" "4 DIGIT YEAR OF END OF DFI" "YEARS" -rconfig integer dfi_bckstop_month namelist,dfi_control 1 03 rh "dfi_bckstop_month" "2 DIGIT MONTH OF THE YEAR OF END OF DFI" "MONTHS" -rconfig integer dfi_bckstop_day namelist,dfi_control 1 14 rh "dfi_bckstop_day" "2 DIGIT DAY OF THE MONTH OF END OF DFI" "DAYS" -rconfig integer dfi_bckstop_hour namelist,dfi_control 1 12 rh "dfi_bckstop_hour" "2 DIGIT HOUR OF THE DAY OF END OF DFI" "HOURS" -rconfig integer dfi_bckstop_minute namelist,dfi_control 1 00 rh "dfi_bckstop_minute" "2 DIGIT MINUTE OF THE HOUR OF END OF DFI" "MINUTES" -rconfig integer dfi_bckstop_second namelist,dfi_control 1 00 rh "dfi_bckstop_second" "2 DIGIT SECOND OF THE MINUTE OF END OF DFI" "SECONDS" - -# Domains -rconfig integer time_step namelist,domains 1 - ih "time_step" -rconfig integer time_step_fract_num namelist,domains 1 0 ih "time_step_fract_num" -rconfig integer time_step_fract_den namelist,domains 1 1 ih "time_step_fract_den" - -rconfig integer min_time_step namelist,domains max_domains -1 h "min_time_step" -rconfig integer max_time_step namelist,domains max_domains -1 h "max_time_step" -rconfig real target_cfl namelist,domains max_domains 1.2 h "target_cfl" -rconfig integer max_step_increase_pct namelist,domains max_domains 5 h "max_step_increase_pct" -rconfig integer starting_time_step namelist,domains max_domains -1 h "starting_time_step" -rconfig logical step_to_output_time namelist,domains 1 .true. h "step_to_output_time" -rconfig logical use_adaptive_time_step namelist,domains 1 .false. h "use_adaptive_time_step" - -rconfig integer max_dom namelist,domains 1 1 irh "max_dom" "" "" -rconfig integer s_we namelist,domains max_domains 1 irh "s_we" "" "" -rconfig integer e_we namelist,domains max_domains 32 irh "e_we" "" "" -rconfig integer s_sn namelist,domains max_domains 1 irh "s_sn" "" "" -rconfig integer e_sn namelist,domains max_domains 32 irh "e_sn" "" "" -rconfig integer s_vert namelist,domains max_domains 1 irh "s_vert" "" "" -rconfig integer e_vert namelist,domains max_domains 31 irh "e_vert" "" "" -rconfig integer num_metgrid_levels namelist,domains 1 27 irh "num_metgrid_levels" "" "" -rconfig real p_top_requested namelist,domains 1 5000 irh "p_top_requested" "Pa" "" -rconfig integer interp_type namelist,domains 1 2 irh "interp_type" "1=interp in pressure, 2=interp in LOG pressure" "" -rconfig integer extrap_type namelist,domains 1 2 irh "extrap_type" "1= use 2 lowest levels, 2=constant" "" -rconfig integer t_extrap_type namelist,domains 1 2 irh "t_extrap_type" "1=isothermal, 2=6.5 K/km, 3=adiabatic" "" -rconfig logical lowest_lev_from_sfc namelist,domains 1 .false. irh "lowest_lev_from_sfc" "" "" -rconfig logical use_levels_below_ground namelist,domains 1 .true. irh "use_levels_below_ground" "T/F: use input data levels below input sfc pres" "" -rconfig logical use_surface namelist,domains 1 .true. irh "use_surface" "T/F: use input surface level in interpolation" "" -rconfig integer lagrange_order namelist,domains 1 1 irh "lagrange_order" "1=linear, 2=quadratic vertical interpolation" "" -rconfig integer force_sfc_in_vinterp namelist,domains 1 1 irh "force_sfc_in_vinterp" "number of eta levels forced to use sfc in vert interp" "" -rconfig real zap_close_levels namelist,domains 1 500 irh "zap_close_levels" "delta p where level is removed in vert interp" "Pa" -rconfig logical sfcp_to_sfcp namelist,domains 1 .false. irh "sfcp_to_sfcp" "T/F use incoming sfc pres to compute new sfc pres" "flag" -rconfig logical adjust_heights namelist,domains 1 .false. irh "adjust_heights" "T/F adjust pressure level input to match 500 mb height" "flag" -rconfig logical smooth_cg_topo namelist,domains 1 .false. irh "smooth_cg_topo" "T/F smooth CG topo on boundarries" "flag" -rconfig real dx namelist,domains max_domains 200 h "dx" "X HORIZONTAL RESOLUTION" "METERS" -rconfig real dy namelist,domains max_domains 200 h "dy" "Y HORIZONTAL RESOLUTION" "METERS" -rconfig integer grid_id namelist,domains max_domains 1 irh "id" "" "" -rconfig logical grid_allowed namelist,domains max_domains .true. irh "allowed" "" "" -rconfig integer parent_id namelist,domains max_domains 0 h "parent_id" "" "" -rconfig integer i_parent_start namelist,domains max_domains 1 rh "i_parent_start" "" "" -rconfig integer j_parent_start namelist,domains max_domains 1 rh "j_parent_start" "" "" -rconfig integer parent_grid_ratio namelist,domains max_domains 1 h "parent_grid_ratio" "" "" -rconfig integer parent_time_step_ratio namelist,domains max_domains 1 h "parent_time_step_ratio" "" "" -rconfig integer feedback namelist,domains 1 1 h "feedback" "" "" -rconfig integer smooth_option namelist,domains 1 2 h "smooth_option" "" "" -rconfig integer blend_width namelist,domains 1 5 h "blend_width" "width of cg fg terrain blended zone" "" -rconfig real ztop namelist,domains max_domains 15000. h "ztop" "" "" -rconfig integer moad_grid_ratio namelist,domains max_domains 1 h "moad_grid_ratio" "" "" -rconfig integer moad_time_step_ratio namelist,domains max_domains 1 h "moad_time_step_ratio" "" "" -rconfig integer shw namelist,domains max_domains 2 h "stencil_half_width" "HORIZONTAL INTERPOLATION STENCIL HALF-WIDTH" "GRID POINTS" -rconfig integer tile_sz_x namelist,domains 1 0 - "tile_sz_x" "" "" -rconfig integer tile_sz_y namelist,domains 1 0 - "tile_sz_y" "" "" -rconfig integer numtiles namelist,domains 1 1 - "numtiles" "" "" -rconfig integer nproc_x namelist,domains 1 -1 - "nproc_x" "-1 means not set" "" -rconfig integer nproc_y namelist,domains 1 -1 - "nproc_y" "-1 means not set" "" -rconfig integer irand namelist,domains 1 0 - "irand" "" "" -rconfig real dt derived max_domains 2. h "dt" "TEMPORAL RESOLUTION" "SECONDS" -rconfig integer num_moves namelist,domains 1 0 -rconfig integer ts_buf_size namelist,domains 1 200 - "ts_buf_size" "Size of time series buffer" -rconfig integer max_ts_locs namelist,domains 1 5 - "max_ts_locs" "Maximum number of time series locations" -rconfig integer vortex_interval namelist,domains max_domains 15 - "" "" "minutes" -rconfig integer max_vortex_speed namelist,domains max_domains 40 - "" "" "meters per second" -rconfig integer corral_dist namelist,domains max_domains 8 -rconfig integer track_level namelist,domains 1 50000 -rconfig integer move_id namelist,domains max_moves 0 -rconfig integer move_interval namelist,domains max_moves 999999999 -rconfig integer move_cd_x namelist,domains max_moves 0 -rconfig integer move_cd_y namelist,domains max_moves 0 -rconfig logical swap_x namelist,domains max_domains .false. rh "swap_x" "" "" -rconfig logical swap_y namelist,domains max_domains .false. rh "swap_y" "" "" -rconfig logical cycle_x namelist,domains max_domains .false. rh "cycle_x" "" "" -rconfig logical cycle_y namelist,domains max_domains .false. rh "cycle_y" "" "" -rconfig logical reorder_mesh namelist,domains 1 .false. rh "reorder_mesh" "" "" -rconfig logical perturb_input namelist,domains 1 .false. h "" "" "" -rconfig real eta_levels namelist,domains max_eta -1. -rconfig real max_dz namelist,domains 1 1000. - -# Physics -###### -###### MARS SPECIFIC NAMELIST ENTRIES -###### -rconfig character planet namelist,physics 1 "mars" - "planet" "selection of the planet" "" -rconfig integer mars namelist,physics max_domains 0 rh "mars" "model mode" "" -rconfig real init_TI namelist,physics max_domains 0 irh "init_TI" "thermal inertia" "" -rconfig real init_AL namelist,physics max_domains 0 irh "init_AL" "albedo" "" -rconfig real init_Z0 namelist,physics max_domains 0 irh "init_Z0" "surface roughness" "" -rconfig real init_U namelist,physics max_domains 0 irh "init_U" "zonal wind" "" -rconfig real init_V namelist,physics max_domains 0 irh "init_V" "meridional wind" "" -rconfig integer init_WX namelist,physics max_domains 0 irh "init_WX" "x coord" "" -rconfig integer init_WY namelist,physics max_domains 0 irh "init_WY" "y coord" "" -rconfig real init_MU namelist,physics max_domains 0 irh "init_MU" "zonal wind mult." "" -rconfig real init_MV namelist,physics max_domains 0 irh "init_MV" "meridional wind mult." "" -rconfig logical init_LES namelist,physics max_domains .false. irh "init_LES" "LES mode" "" -rconfig logical modif_wrf namelist,physics max_domains .true. ir "modif_wrf" "true if tweaked WRF" "" -####### -####### MARS SPECIFIC NAMELIST ENTRIES -####### -rconfig integer mp_physics namelist,physics max_domains 0 rh "mp_physics" "" "" -rconfig integer gsfcgce_hail namelist,physics 1 0 rh "gsfcgce select hail/graupel" "" "" -rconfig integer gsfcgce_2ice namelist,physics 1 0 rh "gsfcgce select 2ice/3ice" "" "" -rconfig integer progn namelist,physics max_domains 0 rh "progn" "" "" -rconfig integer ra_lw_physics namelist,physics max_domains 0 rh "ra_lw_physics" "" "" -rconfig integer ra_sw_physics namelist,physics max_domains 0 rh "ra_sw_physics" "" "" -rconfig real radt namelist,physics max_domains 1 h "RADT" "" "" -rconfig real naer namelist,physics max_domains 1e9 rh "NAER" "" "" -rconfig integer sf_sfclay_physics namelist,physics max_domains 0 rh "sf_sfclay_physics" "" "" -rconfig integer sf_surface_physics namelist,physics max_domains 0 rh "sf_surface_physics" "" "" -rconfig integer bl_pbl_physics namelist,physics max_domains 0 rh "bl_pbl_physics" "" "" -rconfig real BLDT namelist,physics max_domains 0 h "BLDT" "" "" -rconfig integer cu_physics namelist,physics max_domains 0 rh "cu_physics" "" "" -rconfig real CUDT namelist,physics max_domains 0 h "CUDT" "" "" -rconfig real GSMDT namelist,physics max_domains 0 h "GSMDT" "" "" -rconfig integer ISFFLX namelist,physics 1 1 irh "ISFFLX" "" "" -rconfig integer IFSNOW namelist,physics 1 0 irh "IFSNOW" "" "" -rconfig integer ICLOUD namelist,physics 1 1 irh "ICLOUD" "" "" -rconfig real swrad_scat namelist,physics 1 1 irh "SWRAD_SCAT" "SCATTERING FACTOR IN SWRAD" "" -rconfig integer surface_input_source namelist,physics 1 1 irh "surface_input_source" "1=static (fractional), 2=time dependent (dominant), 3=hybrid (not yet implemented)" "" -rconfig integer num_soil_layers namelist,physics 1 10 irh "num_soil_layers" "" "" -rconfig integer num_months namelist,physics 1 12 irh "num_months" "" "" -rconfig integer maxiens namelist,physics 1 1 irh "maxiens" "" "" -rconfig integer maxens namelist,physics 1 3 irh "maxens" "" "" -rconfig integer maxens2 namelist,physics 1 3 irh "maxens2" "" "" -rconfig integer maxens3 namelist,physics 1 16 irh "maxens3" "" "" -rconfig integer ensdim namelist,physics 1 144 irh "ensdim" "" "" -rconfig integer cugd_avedx namelist,physics 1 1 irh "cugd_avedx" "" "" -rconfig integer clos_choice namelist,physics 1 0 rh "clos_choice" "" "" -rconfig integer imomentum namelist,physics 1 0 rh "imomentum" "momentum transport in G3 scheme" "" -rconfig integer chem_opt namelist,physics max_domains 0 rh "chem_opt" "" "" -rconfig integer num_land_cat namelist,physics 1 24 - "num_land_cat" "" "" -rconfig integer num_soil_cat namelist,physics 1 16 - "num_soil_cat" "" "" -rconfig integer mp_zero_out namelist,physics 1 0 - "mp_zero_out" "microphysics fields set to zero 0=no action taken, 1=all fields but Qv, 2=all fields including Qv" "flag" -rconfig real mp_zero_out_thresh namelist,physics 1 1.e-8 - "mp_zero_out_thresh" "minimum threshold for non-Qv moist fields, below are set to zero" "kg/kg" -rconfig real seaice_threshold namelist,physics 1 271 h "seaice_threshold" "tsk below which which water points are set to sea ice for slab scheme" "K" -rconfig integer sst_update namelist,physics 1 0 h "sst_update" "update sst from wrflowinp file 0=no, 1=yes" "" -rconfig integer ucmcall namelist,physics max_domains 0 h "ucmcall" "activate urban model 0=no, 1=yes" "" -rconfig logical usemonalb namelist,physics 1 .false. h "usemonalb" "use 2d field vs table values false=table, True=2d" "" -rconfig integer co2tf namelist,physics 1 1 - "co2tf" "GFDL radiation co2 flag" "" -rconfig integer ra_call_offset namelist,physics 1 0 - "ra_call_offset" "radiation call offset in timesteps (-1=old, 0=new offset)" "" -rconfig real cam_abs_freq_s namelist,physics 1 21600. - "cam_abs_freq_s" "CAM radiation frequency for clear-sky longwave calculations" "s" -rconfig integer levsiz namelist,physics 1 1 - "levsiz" "Number of ozone data levels for CAM radiation (59)" "" -rconfig integer paerlev namelist,physics 1 1 - "paerlev" "Number of aerosol data levels for CAM radiation (29)" "" -rconfig integer cam_abs_dim1 namelist,physics 1 1 - "cam_abs_dim1" "dimension for absnxt in CAM radiation" "" -rconfig integer cam_abs_dim2 namelist,physics 1 1 - "cam_abs_dim2" "dimension for abstot in CAM radiation" "" -rconfig logical cu_rad_feedback namelist,physics max_domains .false. - "feedback cumulus to radiation" "" -rconfig integer pxlsm_smois_init namelist,physics max_domains 1 irh "PXLSM_SMOIS_INIT" "Soil moisture initialization option 0-From analysis 1-From MAVAIL" "" -rconfig integer omlcall namelist,physics 1 0 h "omlcall" "activate simple ocean mixed layer model 0=no, 1=yes" "" -rconfig real oml_hml0 namelist,physics 1 50 h "oml_hml0" "oml initial mixed layer depth value" "m" -rconfig real oml_gamma namelist,physics 1 0.14 h "oml_gamma" "oml deep water lapse rate" "K m-1" -rconfig integer isftcflx namelist,physics 1 0 h "isftcflx" "switch to control sfc fluxes" "" -rconfig real shadlen namelist,physics 1 25000. - "shadow_length" "maximum length of orographic shadow" "m" -rconfig integer slope_rad namelist,physics max_domains 0 - "slope_rad" "1: use slope-dependent radiation, 0:not" "" -rconfig integer topo_shading namelist,physics max_domains 0 - "topo_shading" "1: apply topographic shading to radiation, 0:not" "" -rconfig integer no_mp_heating namelist,physics 1 0 - "no_mp_heating" "switch to turn of latent heating in mp schemes" "" - -#FDDA namelist parameters -rconfig real FGDT namelist,fdda max_domains 0 h "FGDT" "" "" -rconfig integer grid_fdda namelist,fdda max_domains 0 rh "grid_fdda" "" "" -rconfig integer if_no_pbl_nudging_uv namelist,fdda max_domains 0 rh "grid_fdda" "" "" -rconfig integer if_no_pbl_nudging_t namelist,fdda max_domains 0 rh "grid_fdda" "" "" -rconfig integer if_no_pbl_nudging_q namelist,fdda max_domains 0 rh "grid_fdda" "" "" -rconfig integer if_zfac_uv namelist,fdda max_domains 0 rh "grid_fdda" "" "" -rconfig integer k_zfac_uv namelist,fdda max_domains 0 rh "grid_fdda" "" "" -rconfig integer if_zfac_t namelist,fdda max_domains 0 rh "grid_fdda" "" "" -rconfig integer k_zfac_t namelist,fdda max_domains 0 rh "grid_fdda" "" "" -rconfig integer if_zfac_q namelist,fdda max_domains 0 rh "grid_fdda" "" "" -rconfig integer k_zfac_q namelist,fdda max_domains 0 rh "grid_fdda" "" "" -rconfig real guv namelist,fdda max_domains 0 rh "grid_fdda" "" "" -rconfig real gt namelist,fdda max_domains 0 rh "grid_fdda" "" "" -rconfig real gq namelist,fdda max_domains 0 rh "grid_fdda" "" "" -rconfig real dtramp_min namelist,fdda 1 0 h "grid_fdda" "" "" -rconfig integer if_ramping namelist,fdda 1 0 h "grid_fdda" "" "" - -#Observational Nudging -rconfig integer obs_nudge_opt namelist,fdda max_domains 0 rh "obs_nudge_opt" "Obs-nudging flag for domain" "" -rconfig integer max_obs namelist,fdda 1 0 h "max_obs" "Maximum number of observations" "" -rconfig real fdda_start namelist,fdda max_domains 0 rh "fdda_start" "Nudging start time for domain" "min" -rconfig real fdda_end namelist,fdda max_domains 0 rh "fdda_end" "Nudging end time for domain" "min" -rconfig integer obs_nudge_wind namelist,fdda max_domains 0 rh "obs_nudge_wind" "Wind-nudging flag for domain" "" -rconfig real obs_coef_wind namelist,fdda max_domains 0 rh "obs_coef_wind" "Wind-nudging coeficient for domain" "s-1" -rconfig integer obs_nudge_temp namelist,fdda max_domains 0 rh "obs_nudge_temp" "Temperature-nudging flag for domain" "" -rconfig real obs_coef_temp namelist,fdda max_domains 0 rh "obs_coef_temp" "Temperature-nudging coef for domain" "s-1" -rconfig integer obs_nudge_mois namelist,fdda max_domains 0 rh "obs_nudge_mois" "Moisture-nudging flag for domain" "" -rconfig real obs_coef_mois namelist,fdda max_domains 0 rh "obs_coef_mois" "Moisture-nudging coef for domain" "s-1" -rconfig integer obs_nudge_pstr namelist,fdda max_domains 0 rh "obs_nudge_pstr" "Not used" "" -rconfig real obs_coef_pstr namelist,fdda max_domains 0 rh "obs_coef_pstr" "Not used" "" -rconfig real obs_rinxy namelist,fdda max_domains 0 rh "obs_rinxy" "Horizontal radius of influence" "km" -rconfig real obs_rinsig namelist,fdda 1 0 h "obs_rinsig" "Vertical radius of influence" "sigma" -rconfig real obs_twindo namelist,fdda max_domains 0 rh "obs_twindo" "Half-period time window for nudging" "hrs" -rconfig integer obs_npfi namelist,fdda 1 0 h "obs_npfi" "Freq in cg timesteps for diag print" "" -rconfig integer obs_ionf namelist,fdda max_domains 1 rh "obs_ionf" "Freq in cg timesteps for obs input and error calc" "" -rconfig integer obs_idynin namelist,fdda 1 0 h "obs_idynin" "Flag for dynamic initialization" "" -rconfig real obs_dtramp namelist,fdda 1 0 h "obs_dtramp" "Time period for ramping (idynin)" "min" -rconfig integer obs_nobs_prt namelist,fdda max_domains 0 rh "obs_nobs_prt" "Number of current obs to print grid coord. info." "" -rconfig logical obs_ipf_in4dob namelist,fdda 1 .false. h "obs_ipf_in4dob" "Print obs input diagnostics" "" -rconfig logical obs_ipf_errob namelist,fdda 1 .false. h "obs_ipf_errob" "Print obs error diagnostics" "" -rconfig logical obs_ipf_nudob namelist,fdda 1 .false. h "obs_ipf_nudob" "Print obs nudge diagnostics" "" -rconfig logical obs_ipf_init namelist,fdda 1 .true. h "obs_ipf_init" "Enable obs init warning messages" "" - - -# Dynamics -# dynamics option (see package definitions, below) -rconfig integer rk_ord namelist,dynamics 1 3 irh "rk_order" "" "" -rconfig integer w_damping namelist,dynamics 1 0 irh "w_damping" "" "" -# diff_opt 1=old diffusion, 2=new -rconfig integer diff_opt namelist,dynamics 1 1 irh "diff_opt" "" "" -# km_opt 1=old coefs, 2=tke, 3=Smagorinksy -rconfig integer km_opt namelist,dynamics 1 1 irh "km_opt" "" "" -# km_opt_dfi is needed for backward integration in dfi -rconfig integer km_opt_dfi namelist,dynamics 1 1 irh "km_opt_dfi" "" "" -rconfig integer damp_opt namelist,dynamics 1 0 irh "damp_opt" "" "" -rconfig real zdamp namelist,dynamics max_domains 5000. h "zdamp" "" "" -rconfig real dampcoef namelist,dynamics max_domains 0. h "dampcoef" "" "" -rconfig real khdif namelist,dynamics max_domains 0 h "khdif" "" "" -rconfig real kvdif namelist,dynamics max_domains 0 h "kvdif" "" "" -rconfig real diff_6th_factor namelist,dynamics max_domains 0.2 h "diff_6th_factor" "factor that controls rate of 6th-order numerical diffusion" -rconfig integer diff_6th_opt namelist,dynamics max_domains 2 irh "diff_6th_opt" "switch for 6th-order numerical diffusion" -rconfig real c_s namelist,dynamics max_domains 0.25 h "c_s" "Smagorinsky coeff" "" -rconfig real c_k namelist,dynamics max_domains 0.15 h "c_k" "TKE coeff" "" -rconfig real smdiv namelist,dynamics max_domains 0.1 h "smdiv" "" "" -rconfig real emdiv namelist,dynamics max_domains 0.01 h "emdiv" "" "" -rconfig real epssm namelist,dynamics max_domains 0.1 h "epssm" "" "" -rconfig logical non_hydrostatic namelist,dynamics max_domains .true. irh "non_hydrostatic" "" "" -rconfig integer time_step_sound namelist,dynamics max_domains 6 h "time_step_sound" "" "" -rconfig integer h_mom_adv_order namelist,dynamics max_domains 5 rh "h_mom_adv_order" "" "" -rconfig integer v_mom_adv_order namelist,dynamics max_domains 3 rh "v_mom_adv_order" "" "" -rconfig integer h_sca_adv_order namelist,dynamics max_domains 5 rh "h_sca_adv_order" "" "" -rconfig integer v_sca_adv_order namelist,dynamics max_domains 3 rh "v_sca_adv_order" "" "" -rconfig logical pd_moist namelist,dynamics max_domains .false. rh "pd_moist" "positive-definite RK3 transport switch" "" -rconfig logical pd_moist_dfi namelist,dynamics max_domains .false. rh "pd_moist_dfi" "positive-definite RK3 transport switch" "" -rconfig logical pd_chem namelist,dynamics max_domains .false. rh "pd_chem" "positive-definite RK3 transport switch" "" -rconfig logical pd_scalar namelist,dynamics max_domains .true. rh "pd_scalar" "positive-definite RK3 transport switch" "" -rconfig logical pd_tke namelist,dynamics max_domains .false. rh "pd_tke" "positive-definite RK3 transport switch" "" -rconfig logical top_radiation namelist,dynamics max_domains .false. rh "top_radiation" "" "" -rconfig integer mix_isotropic namelist,dynamics max_domains 0 h "mix_isotropic" "0=anistropic, 1=isotropic" "" -rconfig real mix_upper_bound namelist,dynamics max_domains 0.1 h "mix_upper_bound" "non-dimensional limit" "" -rconfig logical top_lid namelist,dynamics max_domains .false. rh "top_lid" "" "" -rconfig real tke_upper_bound namelist,dynamics max_domains 1000. h "tke_upper_bound" "" "" -rconfig real tke_drag_coefficient namelist,dynamics max_domains 0. h "tke_drag_coefficient" "" "dimensionless" -rconfig real tke_heat_flux namelist,dynamics max_domains 0. h "tke_heat_flux" "" "K m s-1" -rconfig logical pert_coriolis namelist,dynamics max_domains .false. irh "pert_coriolis" "" "" -rconfig logical coriolis2d namelist,dynamics max_domains .false. irh "coriolis2d" "" "" -rconfig logical mix_full_fields namelist,dynamics max_domains .false. irh "mix_full_field" "" "" -rconfig real base_pres namelist,dynamics 1 100000. h "base_pres" "Base state pressure - do not change (10^5 Pa), real only" "Pa" -rconfig real base_temp namelist,dynamics 1 290. h "base_temp" "Base state sea level temperature, real only" "K" -rconfig real base_lapse namelist,dynamics 1 50. h "base_lapse" "Base state temperature difference between base pres and 1/e of atm depth - do not change, real only" "K" -rconfig real fft_filter_lat namelist,dynamics 1 45. h "fft_filter_lat" "" "grid latitude to start polar filter" -rconfig logical rotated_pole namelist,dynamics 1 .false. irh "rotated_pole" "" "" -rconfig logical do_coriolis namelist,dynamics max_domains .true. irh "do_coriolis" "" "" -rconfig logical do_curvature namelist,dynamics max_domains .true. irh "do_curvature" "" "" -rconfig logical do_gradp namelist,dynamics max_domains .true. irh "do_gradp" "" "" - - -# Bdy_control -rconfig integer spec_bdy_width namelist,bdy_control 1 5 irh "spec_bdy_width" "" "" -rconfig integer spec_zone namelist,bdy_control 1 1 irh "spec_zone" "" "" -rconfig integer relax_zone namelist,bdy_control 1 4 irh "relax_zone" "" "" -rconfig logical specified namelist,bdy_control max_domains .false. rh "specified" "" "" -rconfig logical periodic_x namelist,bdy_control max_domains .false. rh "periodic_x" "" "" -rconfig logical symmetric_xs namelist,bdy_control max_domains .false. rh "symmetric_xs" "" "" -rconfig logical symmetric_xe namelist,bdy_control max_domains .false. rh "symmetric_xe" "" "" -rconfig logical open_xs namelist,bdy_control max_domains .false. rh "open_xs" "" "" -rconfig logical open_xe namelist,bdy_control max_domains .false. rh "open_xe" "" "" -rconfig logical periodic_y namelist,bdy_control max_domains .false. rh "periodic_y" "" "" -rconfig logical symmetric_ys namelist,bdy_control max_domains .false. rh "symmetric_ys" "" "" -rconfig logical symmetric_ye namelist,bdy_control max_domains .false. rh "symmetric_ye" "" "" -rconfig logical open_ys namelist,bdy_control max_domains .false. rh "open_ys" "" "" -rconfig logical open_ye namelist,bdy_control max_domains .false. rh "open_ye" "" "" -rconfig logical polar namelist,bdy_control max_domains .false. rh "polar" "" "" -rconfig logical nested namelist,bdy_control max_domains .false. rh "nested" "" "" -rconfig real spec_exp namelist,bdy_control 1 0. irh "spec_exp" "" "" -rconfig integer real_data_init_type namelist,bdy_control 1 1 irh "real_data_init_type" "REAL DATA INITIALIZATION OPTIONS: 1=SI, 2=MM5, 3=GENERIC" "PRE-PROCESSOR TYPES" - -rconfig integer background_proc_id namelist,grib2 1 255 rh "background_proc_id" "Background processing id for grib2" "" -rconfig integer forecast_proc_id namelist,grib2 1 255 rh "forecast_proc_id" "Analysis and forecast processing id for grib2" "" -rconfig integer production_status namelist,grib2 1 255 rh "production_status" "Background processing id for grib2" "" -rconfig integer compression namelist,grib2 1 40 rh "compression" "grib2 compression, 40 for JPEG2000 or 41 for PNG" "" - -# NAMELIST DERIVED -rconfig integer nobs_ndg_vars derived 1 5 - "num_ndg_vars" "Number of nudging variables" "" -rconfig integer nobs_err_flds derived 1 9 - "num_err_flds" "Number of error fields" "" -rconfig real cen_lat derived max_domains 0 - "cen_lat" "center latitude" "degrees, negative is south" -rconfig real cen_lon derived max_domains 0 - "cen_lon" "central longitude" "degrees, negative is west" -rconfig real truelat1 derived max_domains 0 - "true_lat1" "first standard parallel" "degrees, negative is south" -rconfig real truelat2 derived max_domains 0 - "true_lat2" "second standard parallel" "degrees, negative is south" -rconfig real moad_cen_lat derived max_domains 0 - "moad_cen_lat" "center latitude of the most coarse grid" "degrees, negative is south" -rconfig real stand_lon derived max_domains 0 - "stand_lon" "standard longitude, parallel to j-direction, perpendicular to i-direction " "degrees, negative is west" -rconfig real bdyfrq derived max_domains 0 - "bdyfrq" "lateral boundary input frequency" "seconds" -rconfig integer iswater derived max_domains 0 - "iswater" "land use index of water" "index category" -rconfig integer isice derived max_domains 0 - "isice" "land use index of ice" "index category" -rconfig integer isurban derived max_domains 0 - "isurban" "land use index for 'urban and built-up" "index category" -rconfig integer isoilwater derived max_domains 0 - "isoilwater" "land use index of water for soil" "index category" -rconfig integer map_proj derived max_domains 0 - "map_proj" "domain map projection" "0=none (Cylindrical), 1=Lambert, 2=polar, 3=Mercator" -rconfig integer use_wps_input derived 1 0 - "use_wps_input" "0/1 flag, using wps input" "0=no, 1=yes" -rconfig integer dfi_stage derived 1 3 - "dfi_stage" "current stage of DFI processing" "0=DFI setup, 1=DFI backward integration, 2=DFI forward integration, 3=WRF forecast" -rconfig integer mp_physics_dfi derived max_domains -1 - "mp_physics_dfi" "" "-1 = no DFI and so no need to allocate DFI moist and scalar variables, >0 = running with DFI, so allocate DFI moist and scalar variables appropriate for selected microphysics package" - -# -# Single dummy declaration to define a nodyn dyn option -state integer nodyn_dummy - dyn_nodyn - - - "" "" "" - -# -#--------------------------------------------------------------------------------------------------------------------------------------- -# Package Declarations -# - -#key package associated package associated 4d scalars -# name namelist choice state vars - - -##### MARS OPTIONS -##### MARS OPTIONS -##### MARS OPTIONS -## -## CHANGING THE OPTION CHANGE THE NUMBER OF TRACERS WITHOUT ANY NEED TO RECOMPILE ENTIRELY WRF -## HOWEVER, YOU STILL NEED TO RECOMPILE THE PHYSICS BEFORE CHANGING THE OPTION -## JUST USE THE COMPILE_ALL SCRIPT FOR A FAST RECOMPILATION -## ------- -## ONE REMAINING PROBLEM IS THE FACT THAT YOU NEED TO RECOMPILE -## ENTIRELY IF YOU DO NOT WANT TO OUTPUT THE TRACERS -## (FOR EXAMPLE, IF THEY ARE TURNED OFF ...) -## ------- -## -## -package default mars==0 - - -package water mars==1 - scalar:qh2o,qh2o_ice -package dust1 mars==2 - scalar:qdust -package dust2eq mars==3 - scalar:qdust,qdustn -package newbasis mars==10 - scalar:qco2 -package newwater mars==11 - scalar:qh2o,qh2o_ice,qdust,qdustn -package newwatersca mars==12 - scalar:qh2o,qh2o_ice,qdust,qdustn,qccn,qccnn -package radioac mars==20 - scalar:qtrac1 -package VenusPC mars==34 - scalar:qco2,qco,qh2,qh2o,qo1d,qo,qo2,qo2dg,qo3,qh,qoh,qho2,qh2o2,qcl,qclo,qcl2,qhcl,qhocl,qclco,qclco3,qcocl2,qss,qso,qso2,qso3,qs2o2,qocs,qhso3,qh2so4,qs2,qclso2,qoscl,qh2oliq,qh2so4liq -package waterdyn mars==42 - scalar:qh2o,qh2o_ice;moist:qv,qc -##### MARS OPTIONS -##### MARS OPTIONS -##### MARS OPTIONS - - - - -#package passivec1 chem_opt==0 - -package passiveqv mp_physics==0 - moist:qv -package kesslerscheme mp_physics==1 - moist:qv,qc,qr -package linscheme mp_physics==2 - moist:qv,qc,qr,qi,qs,qg -package wsm3scheme mp_physics==3 - moist:qv,qc,qr -package wsm5scheme mp_physics==4 - moist:qv,qc,qr,qi,qs -package etampnew mp_physics==5 - moist:qv,qc,qr,qi,qs,qg;scalar:qt -package wsm6scheme mp_physics==6 - moist:qv,qc,qr,qi,qs,qg -package gsfcgcescheme mp_physics==7 - moist:qv,qc,qr,qi,qs,qg -package thompson mp_physics==8 - moist:qv,qc,qr,qi,qs,qg;scalar:qni -package morr_two_moment mp_physics==10 - moist:qv,qc,qr,qi,qs,qg;scalar:qni,qns,qnr,qng - -package nodfimoist mp_physics_dfi==-1 - - -package passiveqv_dfi mp_physics_dfi==0 - dfi_moist:dfi_qv -package kesslerscheme_dfi mp_physics_dfi==1 - dfi_moist:dfi_qv,dfi_qc,dfi_qr -package linscheme_dfi mp_physics_dfi==2 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg -package wsm3scheme_dfi mp_physics_dfi==3 - dfi_moist:dfi_qv,dfi_qc,dfi_qr -package wsm5scheme_dfi mp_physics_dfi==4 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs -package etampnew_dfi mp_physics_dfi==5 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qt -package wsm6scheme_dfi mp_physics_dfi==6 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg -package gsfcgcescheme_dfi mp_physics_dfi==7 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg -package thompson_dfi mp_physics_dfi==8 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qni -package morr_two_moment_dfi mp_physics_dfi==10 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qni,dfi_qns,dfi_qnr,dfi_qng - -package noprogn progn==0 - - -package progndrop progn==1 - scalar:qndrop;dfi_scalar:dfi_qndrop - -package rrtmscheme ra_lw_physics==1 - - -package camlwscheme ra_lw_physics==3 - ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc -package gfdllwscheme ra_lw_physics==99 - - -package heldsuarez ra_lw_physics==31 - - - -package swradscheme ra_sw_physics==1 - - -package gsfcswscheme ra_sw_physics==2 - - -package camswscheme ra_sw_physics==3 - ozmixm:mth01,mth02,mth03,mth04,mth05,mth06,mth07,mth08,mth09,mth10,mth11,mth12;aerosolc:sul,sslt,dust1,dust2,dust3,dust4,ocpho,bcpho,ocphi,bcphi,bg,volc -package gfdlswscheme ra_sw_physics==99 - - - -package sfclayscheme sf_sfclay_physics==1 - state:regime -package myjsfcscheme sf_sfclay_physics==2 - - -package gfssfcscheme sf_sfclay_physics==3 - - -package pxsfcscheme sf_sfclay_physics==7 - state:regime - -package slabscheme sf_surface_physics==1 - - -package lsmscheme sf_surface_physics==2 - - -package ruclsmscheme sf_surface_physics==3 - - -package pxlsmscheme sf_surface_physics==7 - fdda2d:t2_ndg_new,q2_ndg_new,t2_ndg_old,q2_ndg_old - -package ysuscheme bl_pbl_physics==1 - state:regime -package myjpblscheme bl_pbl_physics==2 - - -package gfsscheme bl_pbl_physics==3 - - -package acmpblscheme bl_pbl_physics==7 - state:regime -package mrfscheme bl_pbl_physics==99 - state:regime - -package kfetascheme cu_physics==1 - - -package bmjscheme cu_physics==2 - - -package gdscheme cu_physics==3 - - -package sasscheme cu_physics==4 - - -package g3scheme cu_physics==5 - state:cugd_qvten,cugd_tten,cugd_qvtens,cugd_ttens,cugd_qcten -package kfscheme cu_physics==99 - - - -package psufddagd grid_fdda==1 - fdda3d:u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,ph_ndg_old,u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,ph_ndg_new;fdda2d:mu_ndg_old,mu_ndg_new,t2_ndg_new,q2_ndg_new,t2_ndg_old,q2_ndg_old,sn_ndg_new,sn_ndg_old;state:rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten - -package restofwrf use_wps_input==0 - - - -package dfi_setup dfi_stage==0 - - -package dfi_bck dfi_stage==1 - - -package dfi_fwd dfi_stage==2 - - -package dfi_fst dfi_stage==3 - - - -#package digifilter dfi_opt==1 - dfi_moist:dfi_qv,dfi_qc,dfi_qr,dfi_qi,dfi_qs,dfi_qg;dfi_scalar:dfi_qndrop,dfi_qni,dfi_qt,dfi_qns,dfi_qnr,dfi_qng;state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt -package dfi_nodfi dfi_opt==0 - - -package dfi_dfl dfi_opt==1 - state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG -package dfi_ddfi dfi_opt==2 - state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG -package dfi_tdfi dfi_opt==3 - state:dfi_u,dfi_v,dfi_w,dfi_ph,dfi_phb,dfi_ph0,dfi_php,dfi_t,dfi_p,dfi_ww,dfi_mu,dfi_tke,dfi_pb,dfi_al,dfi_alt,dfi_TSLB,dfi_SMOIS,dfi_SNOW,dfi_SNOWH,dfi_CANWAT,dfi_SMFR3D,dfi_KEEPFR3DFLAG,dfi_TSK,dfi_SOILT1,dfi_TSNAV,dfi_SNOWC,dfi_QVG -ifdef RUC_CLOUD -package realonly use_wps_input==1 - state:u_gc,v_gc,t_gc,rh_gc,ght_gc,p_gc,xlat_gc,xlong_gc,ht_gc,tsk_gc,tavgsfc,tmn_gc,pslv_gc,greenfrac,albedo12m,pd_gc,psfc_gc,intq_gc,pdhs,qv_gc,qr_gc,qc_gc,qs_gc,qi_gc,qg_gc,qni_gc -endif -ifndef RUC_CLOUD -package realonly use_wps_input==1 - state:u_gc,v_gc,t_gc,rh_gc,ght_gc,p_gc,xlat_gc,xlong_gc,ht_gc,tsk_gc,tavgsfc,tmn_gc,pslv_gc,greenfrac,albedo12m,pd_gc,psfc_gc,intq_gc,pdhs,qv_gc -endif - - -# only need to specify these once; not for every io_form* variable -package io_intio io_form_restart==1 - - -package io_netcdf io_form_restart==2 - - -# Placeholders for additional packages (we can go beyond zzz -# but that will entail modifying frame/module_io.F and frame/md_calls.m4) -# Please note these are placeholders; HDF has not been implemented yet. -package io_hdf io_form_restart==3 - - -package io_phdf5 io_form_restart==4 - - -package io_grib1 io_form_restart==5 - - -package io_mcel io_form_restart==6 - - -package io_esmf io_form_restart==7 - - -package io_yyy io_form_restart==8 - - -package io_zzz io_form_restart==9 - - -package io_grib2 io_form_restart==10 - - -package io_pnetcdf io_form_restart==11 - - - -#--------------------------------------------------------------------------------------------------------------------------------------- -## communications - -### 8. Edit the Registry file and create a halo-exchange for x_1. - -# Halo Update Communications - -halo HALO_EM_INIT_1 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,ph_1,ph_2 -halo HALO_EM_INIT_2 dyn_em 48:t_1,t_2,mu_1,mu_2,tke_1,tke_2,ww,phb -halo HALO_EM_INIT_3 dyn_em 48:ph0,php,t_init,mub,mu0,p,al,alt,alb -halo HALO_EM_INIT_4 dyn_em 48:pb,h_diabatic,msftx,msfty,msfux,msfuy,msfvx,msfvy,msfvx_inv,f,e,sina,cosa,ht,potevp,snopcx,soiltb,xlat,xlong,xlat_u,xlat_v,xlong_u,xlong_v,clat,clong -halo HALO_EM_INIT_5 dyn_em 48:moist,chem,scalar -halo HALO_EM_VINTERP_UV_1 dyn_em 8:pd_gc,pb -halo HALO_EM_A dyn_em 8:ru,rv,rw,ww,php,alt,al,p,muu,muv,mut -halo HALO_EM_PHYS_A dyn_em 4:u_2,v_2 -halo HALO_EM_PHYS_PBL dyn_em 4:rublten,rvblten -halo HALO_EM_FDDA dyn_em 4:rundgdten,rvndgdten -halo HALO_EM_PHYS_DIFFUSION dyn_em 4:defor11,defor22,defor12,defor13,defor23,div,xkmv,xkmh,xkhv,xkhh,tke_1,tke_2 -halo HALO_EM_TKE_ADVECT_3 dyn_em 24:tke_2 -halo HALO_EM_TKE_ADVECT_5 dyn_em 48:tke_2 -halo HALO_EM_TKE_A dyn_em 4:ph_2,phb -halo HALO_EM_TKE_B dyn_em 4:z,rdz,rdzw,zx,zy -halo HALO_EM_TKE_C dyn_em 8:u_2,v_2,z,zx,zy,rdz,rdzw,ustm -halo HALO_EM_TKE_D dyn_em 8:defor11,defor22,defor33,defor12,defor13,defor23,div -halo HALO_EM_TKE_E dyn_em 8:xkmv,xkmh,xkhv,xkhh,BN2,moist -halo HALO_EM_TKE_3 dyn_em 24:tke_1,tke_2 -halo HALO_EM_TKE_5 dyn_em 48:tke_1,tke_2 -halo HALO_EM_TKE_7 dyn_em 80:tke_1,tke_2 -halo HALO_EM_TKE_F dyn_em 48:tke_1,tke_2 -halo HALO_EM_TKE_OLD_E_5 dyn_em 48:tke_1 -halo HALO_EM_TKE_OLD_E_7 dyn_em 80:tke_1 -halo HALO_EM_B dyn_em 4:ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb -halo HALO_EM_B2 dyn_em 4:ru_tend,rv_tend -halo HALO_EM_C dyn_em 4:u_2,v_2 -halo HALO_EM_C2 dyn_em 4:ph_2,al,p,mu_2,muts,mudf -halo HALO_EM_D dyn_em 24:ru_m,rv_m,ww_m,mut -halo HALO_EM_D2_3 dyn_em 24:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al -halo HALO_EM_D2_5 dyn_em 48:u_2,v_2,w_2,t_2,ph_2;24:moist,chem,scalar;4:mu_2,al -halo HALO_EM_D3_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2 -halo HALO_EM_D3_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,moist,chem,scalar;4:mu_1,mu_2 -halo HALO_EM_E_3 dyn_em 24:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2 -halo HALO_EM_E_5 dyn_em 48:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,;4:mu_1,mu_2 -halo HALO_EM_MOIST_E_3 dyn_em 24:moist -halo HALO_EM_MOIST_E_5 dyn_em 48:moist -halo HALO_EM_MOIST_E_7 dyn_em 80:moist -halo HALO_CUP_G3_IN dyn_em 24:RTHFTEN,RQVFTEN,w_2 -halo HALO_CUP_G3_OUT dyn_em 48:cugd_tten,cugd_qvten,cugd_ttens,cugd_qvtens,raincv -halo HALO_EM_CHEM_E_3 dyn_em 24:chem -halo HALO_EM_CHEM_E_5 dyn_em 48:chem -halo HALO_EM_CHEM_E_7 dyn_em 80:chem -halo HALO_EM_SCALAR_E_3 dyn_em 24:scalar -halo HALO_EM_SCALAR_E_5 dyn_em 48:scalar -halo HALO_EM_SCALAR_E_7 dyn_em 80:scalar -halo HALO_TOPOSHAD phys 24:ht_shad - -halo HALO_EM_MOIST_OLD_E_3 dyn_em 24:moist_old -halo HALO_EM_MOIST_OLD_E_5 dyn_em 48:moist_old -halo HALO_EM_MOIST_OLD_E_7 dyn_em 80:moist_old -halo HALO_EM_CHEM_OLD_E_3 dyn_em 24:chem_old -halo HALO_EM_CHEM_OLD_E_5 dyn_em 48:chem_old -halo HALO_EM_CHEM_OLD_E_7 dyn_em 80:chem_old -halo HALO_EM_SCALAR_OLD_E_3 dyn_em 24:scalar_old -halo HALO_EM_SCALAR_OLD_E_5 dyn_em 48:scalar_old -halo HALO_EM_SCALAR_OLD_E_7 dyn_em 80:scalar_old - -halo HALO_EM_FEEDBACK dyn_em 48:ht -halo HALO_EM_HYDRO_UV dyn_em 8:u_2,v_2 - -halo HALO_EM_COUPLE_A dyn_em 24:mub,mu_1,mu_2 -period PERIOD_EM_COUPLE_A dyn_em 2:mub,mu_1,mu_2 -halo HALO_EM_COUPLE_B dyn_em 48:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\ - moist,chem,scalar -period PERIOD_EM_COUPLE_B dyn_em 3:ph_1,ph_2,w_1,w_2,t_1,t_2,u_1,u_2,v_1,v_2,\ - moist,chem,scalar - -# For moving nests -halo em_shift_halo_y dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2 -halo em_shift_halo_x dyn_em 48:imask_nostag,imask_xstag,imask_ystag,imask_xystag,u_2,v_2,t_2 - -# For observational nudging -halo HALO_OBS_NUDGE dyn_em 24:pb,p,uratx,vratx,tratx - -# Periodic Boundary Communications - -period PERIOD_BDY_EM_INIT dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,t_init,phb,ph0,php,pb,al,alt,alb,mu_1,mu_2,mub,mu0,ht,msftx,msfty,msfux,msfuy,msfvx,msfvy,msfvx_inv,sina,cosa,e,f -period PERIOD_BDY_EM_MOIST dyn_em 3:moist -period PERIOD_BDY_EM_CHEM dyn_em 3:chem -period PERIOD_BDY_EM_SCALAR dyn_em 3:scalar -period PERIOD_BDY_EM_MOIST2 dyn_em 3:moist -period PERIOD_BDY_EM_CHEM2 dyn_em 3:chem -period PERIOD_BDY_EM_SCALAR2 dyn_em 3:scalar -period PERIOD_BDY_EM_MOIST_OLD dyn_em 3:moist_old -period PERIOD_BDY_EM_CHEM_OLD dyn_em 3:chem_old -period PERIOD_BDY_EM_SCALAR_OLD dyn_em 3:scalar_old -period PERIOD_BDY_EM_TKE_OLD dyn_em 3:tke_1 -period PERIOD_EM_HYDRO_UV dyn_em 1:u_2,v_2 -period PERIOD_BDY_EM_A dyn_em 2:ru,rv,rw,ww,php,alt,p,muu,muv,mut,ph_2,al -period PERIOD_BDY_EM_A1 dyn_em 3:rdzw,rdz,z,zx,zy,ustm -period PERIOD_BDY_EM_PHY_BC dyn_em 2:rublten,rvblten,xkmh,xkmv,xkhh,xkhv,div,defor11,defor22,defor12,defor13,defor23,defor33,tke_2 -period PERIOD_BDY_EM_FDDA_BC dyn_em 2:rundgdten,rvndgdten -period PERIOD_BDY_EM_B dyn_em 2:ru_tend,rv_tend,ph_2,al,p,t_1,t_save,u_save,v_save,mu_1,mu_2,mudf,php,alt,pb -period PERIOD_BDY_EM_B3 dyn_em 2:ph_2,al,p,mu_2,muts,mudf -period PERIOD_BDY_EM_B2 dyn_em 2:ru_tend,rv_tend -period PERIOD_BDY_EM_C dyn_em 2:u_2,u_save,v_2,v_save,t_2,t_save,muv,msfvx,msfvy,muu,msfux,msfuy,msfvx_inv -period PERIOD_BDY_EM_D dyn_em 3:u_2,v_2,w_2,t_2,ph_2,mu_2,tke_2 -period PERIOD_BDY_EM_D3 dyn_em 3:u_1,u_2,v_1,v_2,w_1,w_2,t_1,t_2,ph_1,ph_2,tke_1,tke_2,mu_1,mu_2 - -# -#swap SWAP_ETAMP_NEW dyn_em 1:dz8w,p_phy,pi_phy,rho,th_phy,moist,F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,RAINNC,RAINNCV,SR,LOWLYR -#swap SWAP_WSM3 dyn_em 1:th_phy,moist,w_2,rho,pi_phy,p_phy,dz8w,rainnc,rainncv -#cycle CYCLE_TEST dyn_em 1:xlong - -## - -# FDDA (Observational-nudging) Variables -typedef fdob_type integer domain_tot # total number of domains to apply obs-nudging -typedef fdob_type integer IEODI # end of obs data flag for current model step -typedef fdob_type integer IWTSIG # flag for nudging on pressure surfaces -typedef fdob_type integer NSTAT # number of obs stations used to nudge current model step -typedef fdob_type integer NSTAW # number of obs stations within current time window -typedef fdob_type integer KTAUR # restart model step -typedef fdob_type integer SN_MAXCG # coarse domain grid dimension in south-north coordinate -typedef fdob_type integer WE_MAXCG # coarse domain grid dimension in west-east coordinate -typedef fdob_type integer SN_END # ending north-south grid index -typedef fdob_type integer LEVIDN(max_domains) # level of nest -typedef fdob_type real WINDOW # time window half-period for nudging (in minutes) -typedef fdob_type real RTLAST # time in hours of last obs used in current model step -typedef fdob_type real DATEND # time in minutes after which data are asuumed to have ended -typedef fdob_type real RINFMN # minimum radius of influence -typedef fdob_type real RINFMX # maximum radius of influence -typedef fdob_type real PFREE # pressure level (cb) where terrain effect becomes small -typedef fdob_type real DCON # 1/DPSMX -typedef fdob_type real DPSMX # max pres change (cb) allowed within infl range of surf obs -typedef fdob_type real TFACI # scale factor used for ramp-down in dynamic initialization -typedef fdob_type real KNOWN_LAT # Latitude of origin point (i,j)=(1,1) -typedef fdob_type real KNOWN_LON # Longitude of origin point (i,j)=(1,1) - -# table entries are of the form -#
-#Grid variables -typedef fdob_type real varobs rz - 1 - - "varobs" "observational values in each variable" -typedef fdob_type real errf hz - 1 - - "errf" "errors between model and obs values" -typedef fdob_type real timeob z - 1 - - "timeob" "model times for each observation" "hours" -typedef fdob_type real nlevs_ob z - 1 - - "nlevs_ob" "numbers of levels in sounding obs" -typedef fdob_type real lev_in_ob z - 1 - - "lev_in_ob" "level in sounding-type obs" -typedef fdob_type real plfo z - 1 - - "plfo" "index for type of obs-platform" -typedef fdob_type real elevob z - 1 - - "elevob" "elevation of observation" "meters" -typedef fdob_type real rio z - 1 - - "rio" "west-east grid coordinate" -typedef fdob_type real rjo z - 1 - - "rjo" "south-north grid coordinate" -typedef fdob_type real rko z - 1 - - "rko" "vertical grid coordinate" - -state fdob_type fdob - - - -# xpose variables for polar fft -state real t_xxx ikjx - 1 - -state real u_xxx ikjx - 1 X -state real ru_xxx ikjx - 1 X -state real v_xxx ikjx - 1 Y -state real rv_xxx ikjx - 1 Y -state real w_xxx ikjx - 1 Z -state real ww_xxx ikjx - 1 Z -state real ph_xxx ikjx - 1 Z -state real dum_yyy ikjy - 1 - -state real fourd_xxx ikjx - 1 - -state real clat_xxx ijx - 1 - -state real ht_xxx ijx - 1 - -state real mf_xxx ijx - 1 - - -xpose XPOSE_POLAR_FILTER_TOPO dyn_em t_init,t_xxx,dum_yyy -xpose XPOSE_POLAR_FILTER_T dyn_em t_2,t_xxx,dum_yyy -xpose XPOSE_POLAR_FILTER_U dyn_em u_2,u_xxx,dum_yyy -xpose XPOSE_POLAR_FILTER_RU dyn_em ru_m,ru_xxx,dum_yyy -xpose XPOSE_POLAR_FILTER_V dyn_em v_2,v_xxx,dum_yyy -xpose XPOSE_POLAR_FILTER_RV dyn_em rv_m,rv_xxx,dum_yyy -xpose XPOSE_POLAR_FILTER_W dyn_em w_2,w_xxx,dum_yyy -xpose XPOSE_POLAR_FILTER_WW dyn_em ww_m,ww_xxx,dum_yyy -xpose XPOSE_POLAR_FILTER_PH dyn_em ph_2,ph_xxx,dum_yyy -xpose XPOSE_POLAR_FILTER_MOIST dyn_em moist,fourd_xxx,dum_yyy -xpose XPOSE_POLAR_FILTER_CHEM dyn_em chem,fourd_xxx,dum_yyy -xpose XPOSE_POLAR_FILTER_SCALAR dyn_em scalar,fourd_xxx,dum_yyy - -## Index: unk/WRF.COMMON/WRFV3/modif_mars/Registry.bash =================================================================== --- /trunk/WRF.COMMON/WRFV3/modif_mars/Registry.bash (revision 2760) +++ (revision ) @@ -1,1 +1,0 @@ -link ../../WRFV2/Registry/Registry.bash Index: unk/WRF.COMMON/WRFV3/modif_mars/configure_new.defaults =================================================================== --- /trunk/WRF.COMMON/WRFV3/modif_mars/configure_new.defaults (revision 2760) +++ (revision ) @@ -1,862 +1,0 @@ - -########################################################### -#ARCH Linux i486 i586 i686, gfortran compiler with gcc #serial smpar dmpar dm+sm -# -DMPARALLEL = # 1 -OMPCPP = # -D_OPENMP -OMP = # -fopenmp -SFC = gfortran -SCC = gcc -DM_FC = mpif90 -f90=$(SFC) -DM_CC = mpicc -cc=$(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = # -fdefault-real-8 # uncomment manually -ARCH_LOCAL = -DNONSTANDARD_SYSTEM_SUBR -CFLAGS_LOCAL = -w -O3 -c -DLANDREAD_STUB -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O3 -ftree-vectorize -ftree-loop-linear -funroll-loops -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -FORMAT_FIXED = -ffixed-form -FORMAT_FREE = -ffree-form -ffree-line-length-none -FCSUFFIX = -BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 -FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -C -P -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH Linux i486 i586 i686, g95 compiler with gcc #serial dmpar -# -DMPARALLEL = # 1 -OMPCPP = # not supported -OMP = # not supported -SFC = g95 -SCC = gcc -DM_FC = mpif90 -f90=$(SFC) -DM_CC = mpicc -cc=$(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -r$(RWORDSIZE) -i4 -ARCH_LOCAL = -DF2CSTYLE -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR -CFLAGS_LOCAL = -DF2CSTYLE -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O2 #-fast -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -FORMAT_FIXED = -ffixed-form -FORMAT_FREE = -ffree-form -ffree-line-length-huge -FCSUFFIX = -BYTESWAPIO = -fendian=big -FCBASEOPTS = -Wno=101,139,155,158 $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -MODULE_SRCH_FLAG = -fmod=$(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = /lib/cpp -C -P -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH Linux x86_64, PGI compiler with gcc # serial smpar dmpar dm+sm -# -DMPARALLEL = # 1 -OMPCPP = # -D_OPENMP -OMP = # -mp -Minfo=mp -SFC = pgf90 -SCC = gcc -DM_FC = mpif90 -f90=$(SFC) -DM_CC = mpicc -cc=$(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -r$(RWORDSIZE) -i4 -ARCH_LOCAL = -DNONSTANDARD_SYSTEM_SUBR -CFLAGS_LOCAL = -w -O3 -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -fastsse -Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed # -Minfo=all =Mneginfo=all -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -FORMAT_FIXED = -Mfixed -FORMAT_FREE = -Mfree -FCSUFFIX = -BYTESWAPIO = -byteswapio -FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = /lib/cpp -C -P -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH Linux i486 i586 i686, PGI compiler with gcc #serial smpar dmpar dm+sm -# -DMPARALLEL = # 1 -OMPCPP = # -D_OPENMP -OMP = # -mp -SFC = pgf90 -SCC = gcc -DM_FC = mpif90 -f90=$(SFC) -DM_CC = mpicc -cc=$(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -r$(RWORDSIZE) -i4 -ARCH_LOCAL = -DNONSTANDARD_SYSTEM_SUBR -CFLAGS_LOCAL = -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O2 -fast -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -FORMAT_FIXED = -Mfixed -FORMAT_FREE = -Mfree -FCSUFFIX = -BYTESWAPIO = -byteswapio -FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = /lib/cpp -C -P -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH Linux x86_64 i486 i586 i686, ifort compiler with icc #serial smpar dmpar dm+sm -# -# By default, some files are compiled without optimizations to speed up compilation. Removing -# respective makefile rules in the end of this file will result in longer compilation time, and, possibly -# Out Of Memory messages, but might produce binaries which are substantially faster. -# -# Please visit http://www.intel.com/support/performancetools/sb/cs-028607.htm -# for latest info on how to build WRF with Intel compilers. -# -# If you got Out Of Memory message, there are several options: -# 1. Check your memory limits (ulimit -a), possibly increasing swap partitions size. -# 2. Remove any debugging flags (-g, -check, -traceback). -# 3. Force the problematic file to be compiled with less optimizations (see examples at the -# end of this file), try -no-ip compiler flag. -# -# This configuration is aimed at accuracy. To improve performance (at the expence of accuracy) you might -# consider removing '-fp-model precise' flag from FCBASEOPTS. This enables non value-safe optimizations. -# Another option is to add '-ftz' flag, which flushes denormal results to zero when the application is in -# the gradual underflow mode. It may improve performance if the denormal values are not critical to the -# behavior of your workload. To further improve performance, add suitable vectorization options for your -# processor to FCOPTIM (see ifort manpage). -# -# If you have Intel MPI installed and wish to use instead, make the -# following changes to settings below: -# DM_FC = mpiifort -# DM_CC = mpiicc -# and source bin64/mpivars.sh file from your Intel MPI installation -# before the build. - -DMPARALLEL = # 1 -OMPCPP = # -D_OPENMP -OMP = # -openmp -fpp -auto -SFC = ifort -SCC = icc -DM_FC = mpif90 -f90=$(SFC) -DM_CC = mpicc -cc=$(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -i4 -ARCH_LOCAL = -DNONSTANDARD_SYSTEM_FUNC -CFLAGS_LOCAL = -w -O3 -ip -LDFLAGS_LOCAL = -ip -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O3 -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -traceback -FORMAT_FIXED = -FI -FORMAT_FREE = -FR -FCSUFFIX = -BYTESWAPIO = -convert big_endian -FCBASEOPTS = -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -C -P -AR = ar -ARFLAGS = ru -M4 = m4 -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH ia64 Linux ifort compiler with icc 9.x,10.x #serial smpar dmpar dm+sm -# -# By default, some files are compiled without optimizations to -# speed up compilation. Removing respective makefile rules in the -# end of this file will result in longer compilation time, and, -# possibly Out Of Memory messages, but might produce binaries -# which are substantially faster. -# -# Please visit http://www.intel.com/support/performancetools/sb/cs-028607.htm -# for latest info on how to build WRF with Intel compilers. -# -# If you get Out Of Memory messages, there are several options: -# 1. Check your memory limits (ulimit -a), possibly increasing -# swap partitions size. -# 2. Remove any debugging flags (-g, -check, -traceback). -# 3. Force the problematic file to be compiled with lower -# optimization (see examples at the end of this file), -# try the -no-ip compiler flag. -# -# The default configuration is aimed at accuracy. To improve speed -# with only negligible effect on floating point accuracy, -# consider removing "-fp-model precise" from FCBASEOPTS. If -# you are using ifort 9.1.x compiler or earlier, consider -# uncommenting the version of the FCBASEOPTS settings that uses -# the -IPF-fp-relaxed option. -# -# If you can tolerate a longer build, change the setting of -# FCNOOPT to -O1, for slightly faster performance. -# -# If you have Intel MPI installed and wish to use instead, make the -# following changes to settings below: -# DM_FC = mpiifort -# DM_CC = mpiicc -# and source bin/mpivars.sh file from your Intel MPI installation -# before the build. -# - -DMPARALLEL = # 1 -OMPCPP = # -D_OPENMP -OMP = # -openmp -fpp -auto -SFC = ifort -SCC = icc -DM_FC = mpif90 -f90=$(SFC) -DM_CC = mpicc -cc=$(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -i4 -ARCH_LOCAL = -DNONSTANDARD_SYSTEM_FUNC -CFLAGS_LOCAL = -w -O3 -ip -LDFLAGS_LOCAL = -ip -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O3 -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -traceback -FORMAT_FIXED = -FI -FORMAT_FREE = -FR -FCSUFFIX = -BYTESWAPIO = -convert big_endian -FCBASEOPTS = -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -#FCBASEOPTS = -w -ftz -align all -fno-alias -IPF-fp-relaxed $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -LIB_LOCAL = -L/usr/lib -lmpi -MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -C -P -AR = ar -ARFLAGS = ru -M4 = m4 -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH Linux SGI Altix, ifort compiler with icc 9.x,10.x #serial smpar dmpar dm+sm -# -# By default, some files are compiled without optimizations to -# speed up compilation. Removing respective makefile rules in the -# end of this file will result in longer compilation time, and, -# possibly Out Of Memory messages, but might produce binaries -# which are substantially faster. -# -# If you get Out Of Memory messages, there are several options: -# 1. Check your memory limits (ulimit -a), possibly increasing -# swap partitions size. -# 2. Remove any debugging flags (-g, -check, -traceback). -# 3. Force the problematic file to be compiled with lower -# optimization (see examples at the end of this file), -# try the -no-ip compiler flag. -# -# Please visit http://www.intel.com/support/performancetools/sb/cs-028607.htm -# for latest info on how to build WRF with Intel compilers. -# -# The default configuration is aimed at accuracy. To improve speed -# with only negligible effect on floating point accuracy, -# consider removing "-fp-model precise" from FCBASEOPTS. If -# you are using an ifort 9.1.x compiler or earlier, consider -# uncommenting the version of the FCBASEOPTS settings that uses -# the -IPF-fp-relaxed option. To further improve performance, -# add processor-specific options to FCOPTIM (see ifort manpage). -# -# If you can tolerate a longer build, change the setting of -# FCNOOPT to -O1, for slightly faster performance. -# -# If your SGI MPI library is not installed in the default -# locations (/usr/bin, /usr/include, /usr/lib), set MPI_HOME -# to be the path to the directory where the SGI MPI bin, -# include and lib directories are, and change the DM_FC, -# DM_CC and LIB_LOCAL settings as follows: -# DM_FC = $(SFC) -I$(MPI_HOME)/include -# DM_CC = $(SFC) -I$(MPI_HOME)/include -# LIB_LOCAL = -L$(MPI_HOME)/lib -lmpi - -DMPARALLEL = # 1 -OMPCPP = # -D_OPENMP -OMP = # -openmp -fpp -auto -SFC = ifort -SCC = icc -DM_FC = $(SFC) -DM_CC = $(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -i4 -ARCH_LOCAL = -DNONSTANDARD_SYSTEM_FUNC -CFLAGS_LOCAL = -w -O3 -ip -LDFLAGS_LOCAL = -ip -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O3 -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -traceback -FORMAT_FIXED = -FI -FORMAT_FREE = -FR -FCSUFFIX = -BYTESWAPIO = -convert big_endian -FCBASEOPTS = -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -#FCBASEOPTS = -w -ftz -align all -fno-alias -IPF-fp-relaxed $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -LIB_LOCAL = -L/usr/lib -lmpi -MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -C -P -AR = ar -ARFLAGS = ru -M4 = m4 -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH Linux i486 i586 i686 x86_64, PathScale compiler with pathcc #serial dmpar -# -DMPARALLEL = # 1 -OMPCPP = # not supported -OMP = # not supported -SFC = pathf90 -SCC = pathcc -DM_FC = mpif90 -f90=$(SFC) -DM_CC = mpicc -cc=$(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -r$(RWORDSIZE) -i4 -ARCH_LOCAL = -DF2CSTYLE -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR -CFLAGS_LOCAL = -DF2CSTYLE -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O3 -OPT:Ofast:Olimit=5000 -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -FORMAT_FIXED = -fixed-form -FORMAT_FREE = -free-form -FCSUFFIX = -BYTESWAPIO = -byteswapio -FCBASEOPTS = -w -fno-second-underscore $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -MODULE_SRCH_FLAG = -fmod=$(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = /lib/cpp -C -P -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH x86_64 Linux, gfortran compiler with gcc #serial smpar dmpar dm+sm -# -DMPARALLEL = # 1 -OMPCPP = # -D_OPENMP -OMP = # -fopenmp -SFC = gfortran -SCC = gcc -DM_FC = mpif90 -DM_CC = mpicc -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = # -fdefault-real-8 # uncomment manually -ARCH_LOCAL = -DNONSTANDARD_SYSTEM_SUBR -CFLAGS_LOCAL = -w -O3 -c -DLANDREAD_STUB -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O3 -ftree-vectorize -ftree-loop-linear -funroll-loops -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -FORMAT_FIXED = -ffixed-form -FORMAT_FREE = -ffree-form -ffree-line-length-none -FCSUFFIX = -BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 -FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -C -P -AR = ar -ARFLAGS = ru -M4 = m4 -G -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH Darwin (MACOS) PGI compiler with pgcc #serial smpar dmpar dm+sm -# -DMPARALLEL = # 1 -OMPCPP = # -D_OPENMP -OMP = # -mp -SFC = pgf90 -SCC = pgcc -DM_FC = mpif90 -f90=$(SFC) -DM_CC = mpicc -cc=$(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -r$(RWORDSIZE) -i4 -ARCH_LOCAL = -DMACOS -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR -CFLAGS_LOCAL = -DMACOS -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O2 -fast -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -FORMAT_FIXED = -Mfixed -FORMAT_FREE = -Mfree -FCSUFFIX = -BYTESWAPIO = -byteswapio -FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = cpp -C -P -xassembler-with-cpp -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = cc - -########################################################### -#ARCH Darwin (MACOS) intel compiler with icc #serial smpar dmpar dm+sm -# -DMPARALLEL = # 1 -OMPCPP = # -D_OPENMP -OMP = # -openmp -fpp -auto -SFC = ifort -SCC = icc -DM_FC = mpif90 -f90=$(SFC) -DM_CC = mpicc -cc=$(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -i4 -ARCH_LOCAL = -DMACOS -DNONSTANDARD_SYSTEM_FUNC -CFLAGS_LOCAL = -w -O3 -ip -DMACOS -LDFLAGS_LOCAL = -ip -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O3 -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -traceback -FORMAT_FIXED = -FI -FORMAT_FREE = -FR -FCSUFFIX = -BYTESWAPIO = -convert big_endian -FCBASEOPTS = -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = cpp -C -P -xassembler-with-cpp -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = cc - -########################################################### -#ARCH Darwin (MACOS) intel compiler with cc #serial smpar dmpar dm+sm -# -DMPARALLEL = # 1 -OMPCPP = # -D_OPENMP -OMP = # -openmp -fpp -auto -SFC = ifort -SCC = cc -DM_FC = mpif90 -f90=$(SFC) -DM_CC = mpicc -cc=$(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -i4 -ARCH_LOCAL = -DMACOS -DNONSTANDARD_SYSTEM_FUNC -CFLAGS_LOCAL = -w -O3 -DMACOS -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O3 -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -traceback -FORMAT_FIXED = -FI -FORMAT_FREE = -FR -FCSUFFIX = -BYTESWAPIO = -convert big_endian -FCBASEOPTS = -w -ftz -align all -fno-alias -fp-model precise $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = cpp -C -P -xassembler-with-cpp -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = cc - -########################################################### -#ARCH Darwin (MACOS) g95 with gcc #serial dmpar -# -DMPARALLEL = # 1 -OMPCPP = # not supported -OMP = # not supported -SFC = g95 -SCC = gcc -DM_FC = mpif90 -f90=$(SFC) -DM_CC = mpicc -cc=$(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -r$(RWORDSIZE) -i4 -ARCH_LOCAL = -DG95 -DMACOS -DF2CSTYLE -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR -CFLAGS_LOCAL = -DMACOS -DF2CSTYLE -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O2 # -fast -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -FORMAT_FIXED = -ffixed-form -FORMAT_FREE = -ffree-form -ffree-line-length-huge -FCSUFFIX = -BYTESWAPIO = -fendian=big -FCBASEOPTS = -Wno=101,139,155,158 $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -MODULE_SRCH_FLAG = -fmod=$(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = cpp -C -P -xassembler-with-cpp -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH Darwin (MACOS) xlf #serial dmpar -# -DMPARALLEL = # 1 -OMPCPP = # not supported -OMP = # not supported -SFC = xlf90_r -SCC = cc -DM_FC = mpif90 -f90=$(SFC) -DM_CC = mpicc -cc=$(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -qrealsize=$(RWORDSIZE) -qintsize=4 -ARCH_LOCAL = -DMAC_KLUDGE -DF2CSTYLE -DNO_RRTM_PHYSICS -DNONSTANDARD_SYSTEM_SUBR -CFLAGS_LOCAL = -DMACOS -DF2CSTYLE -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O3 -qarch=auto -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -qnoopt -FCDEBUG = # -g $(FCNOOPT) -qfullpath -FORMAT_FIXED = -qfixed -FORMAT_FREE = -qfree=f90 -FCSUFFIX = -qsuffix=f=f90 -BYTESWAPIO = -FCBASEOPTS = -qsave $(FCDEBUG) -qmaxmem=32767 -qspillsize=32767 -w -MODULE_SRCH_FLAG = -fmod=$(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -CPP = cpp -C -P -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH AIX xlf compiler with xlc #serial smpar dmpar dm+sm -# -DMPARALLEL = # 1 -OMPCPP = # -D_OPENMP -OMP = # -qsmp=noauto -SFC = xlf90_r -SCC = cc_r -DM_FC = mpxlf90_r -DM_CC = mpcc_r -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -qrealsize=$(RWORDSIZE) -qintsize=4 -ARCH_LOCAL = -DNONSTANDARD_SYSTEM_SUBR -CFLAGS_LOCAL = -DNOUNDERSCORE -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -lC -ESMF_LDFLAG = $(CPLUSPLUSLIB) -# -qhot commented out in 3.0.1.1 release because of reported problems with -# model results under certain configurations. Use at your own risk. -FCOPTIM = -O3 # -qhot -FCREDUCEDOPT = -O2 -FCNOOPT = -qnoopt -FCDEBUG = # -g $(FCNOOPT) -qfullpath -FORMAT_FIXED = -qfixed -FORMAT_FREE = -qfree=f90 -FCSUFFIX = -qsuffix=f=f90 -BYTESWAPIO = -FCBASEOPTS = -w -qspill=20000 -qmaxmem=32767 $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) #-qflttrap=zerodivide:invalid:enable -qsigtrap -MODULE_SRCH_FLAG = -TRADFLAG = -CPP = /lib/cpp -C -P -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = cc - -########################################################### -#ARCH Cray XT Catamount/Linux x86_64, PGI compiler with gcc # serial dmpar -# -DMPARALLEL = # 1 -OMPCPP = # not supported -OMP = # not supported -SFC = ftn -SCC = gcc -DM_FC = ftn -DM_CC = gcc -I$(MPICH_DIR)/include -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -r$(RWORDSIZE) -i4 -ARCH_LOCAL = -DLANDREAD_STUB -DXT3_Catamount -CFLAGS_LOCAL = -w -O3 -DLANDREAD_STUB -DXT3_Catamount -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -# Use this to add XT iobuf library after loading iobuf module, also requires -# properly built netCDF library that includes iobuf (Catamount OS only) -#LDFLAGS_LOCAL = $(IOBUF_POST_LINK_OPTS) -# PGI recommended -#FCOPTIM = -fastsse -Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed -FCOPTIM = -O3 -fastsse -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -FCDEBUG = # -g $(FCNOOPT) -FORMAT_FIXED = -Mfixed -FORMAT_FREE = -Mfree -FCSUFFIX = -BYTESWAPIO = -byteswapio -FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) -MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -C -P $(TRADFLAG) -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH Cray XT CNL/Linux x86_64, PGI compiler with gcc # serial dmpar smpar dm+sm -# -# Recommended CNL/Linux memory allocation settings at run time: -# export MALLOC_MMAP_MAX_=0 -# export MALLOC_TRIM_THRESHOLD_=536870912 -# -DMPARALLEL = # 1 -OMPCPP = # -D_OPENMP -OMP = # -mp=nonuma -SFC = ftn -SCC = gcc -DM_FC = ftn -DM_CC = gcc -I$(MPICH_DIR)/include -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -r$(RWORDSIZE) -i4 -ARCH_LOCAL = -DLANDREAD_STUB -CFLAGS_LOCAL = -w -O3 -DLANDREAD_STUB -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -# PGI recommended -#FCOPTIM = -O3 -fastsse -Mvect=noaltcode -Msmartalloc -Mprefetch=distance:8 -Mfprelaxed -FCOPTIM = -O3 -fastsse -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O0 -OPTERON_TYPE = -# Use this for AMD Opteron quad-core -#OPTERON_TYPE = -tp barcelona-64 -FCDEBUG = # -g $(FCNOOPT) -FORMAT_FIXED = -Mfixed -FORMAT_FREE = -Mfree -FCSUFFIX = -BYTESWAPIO = -byteswapio -FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) $(OPTERON_TYPE) -MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -C -P $(TRADFLAG) -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH Cray XT CNL/Linux x86_64, Pathscale compiler with gcc # serial dmpar smpar dm+sm -# -# Recommended CNL/Linux memory allocation settings at run time: -# export MALLOC_MMAP_MAX_=0 -# export MALLOC_TRIM_THRESHOLD_=536870912 -# -DMPARALLEL = # 1 -OMPCPP = # -D_OPENMP -OMP = # -mp -SFC = ftn -SCC = gcc -DM_FC = ftn -DM_CC = gcc -I$(MPICH_DIR)/include -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -r$(RWORDSIZE) -i4 -ARCH_LOCAL = -DLANDREAD_STUB -CFLAGS_LOCAL = -w -O3 -DLANDREAD_STUB -LDFLAGS_LOCAL = -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O3 -OPT:Ofast -FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O1 -OPTERON_TYPE = -# Use this for AMD Opteron quad-core -#OPTERON_TYPE = -march=barcelona -mcpu=barcelona -mtune=barcelona -msse4a -FCDEBUG = # -g $(FCNOOPT) -FORMAT_FIXED = -fixedform -FORMAT_FREE = -freeform -FCSUFFIX = -BYTESWAPIO = -byteswapio -FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) $(OPTERON_TYPE) -MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -C -P $(TRADFLAG) -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = $(SCC) - -########################################################### -#ARCH Linux ppc64 BG blxlf compiler with blxlc # dmpar -# -DMPARALLEL = # 1 -OMPCPP = # not supported -OMP = # not supported -BGL_SYS = /bgl/BlueLight/ppcfloor/bglsys -MPI_INC = -I$(BGL_SYS)/include -MPI_LIB = -L$(BGL_SYS)/lib -lmpich.rts -lmsglayer.rts -lrts.rts -ldevices.rts -SFC = blrts_xlf90 -SCC = blrts_xlc -DM_FC = $(SFC) -DM_CC = $(SCC) -FC = CONFIGURE_FC -CC = CONFIGURE_CC -LD = $(FC) -RWORDSIZE = CONFIGURE_RWORDSIZE -PROMOTION = -qrealsize=$(RWORDSIZE) -qintsize=4 -# If system has even more processors, set VERY_LARGE_MAXPROC to that number -ARCH_LOCAL = -DMOVE_NL_OUTSIDE_MODULE_CONFIGURE -DNONSTANDARD_SYSTEM_SUBR -DLANDREAD_STUB -DVERY_LARGE_MAXPROC=36768 -CFLAGS_LOCAL = -DNOUNDERSCORE -DNCARIBM_NOC99 $(MPI_INC) -DLANDREAD_STUB -LIB_LOCAL = $(MPI_LIB) -LDFLAGS_LOCAL = -Wl,--allow-multiple-definition -qstatic -CPLUSPLUSLIB = -ESMF_LDFLAG = $(CPLUSPLUSLIB) -FCOPTIM = -O2 -qarch=440 -FCNOOPT = -qnoopt -FCDEBUG = # $(FCNOOPT) -qfullpath -FORMAT_FIXED = -qfixed -FORMAT_FREE = -qfree=f90 -FCSUFFIX = -qsuffix=f=f90 -BYTESWAPIO = -FCBASEOPTS = -w -qspill=20000 -qmaxmem=64000 $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) $(MPI_INC) #-qflttrap=zerodivide:invalid:enable -qsigtrap -MODULE_SRCH_FLAG = -TRADFLAG = -# this might be different on different systems but we want the xlf version of cpp, not Linux's -# NYBlue -CPP = /opt/ibmcmp/xlf/bg/10.1/exe/cpp -C -P -# frost.ucar.edu -CPP = /opt/ibmcmp/xlf/9.1/exe/cpp -C -P -AR = ar -ARFLAGS = ru -M4 = m4 -B 14000 -RANLIB = ranlib -CC_TOOLS = cc - -########################################################### -#ARCH NULL - Index: unk/WRF.COMMON/WRFV3/modif_mars/module_big_step_utilities_em.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/modif_mars/module_big_step_utilities_em.F (revision 2760) +++ (revision ) @@ -1,5606 +1,0 @@ -!wrf:MODEL_LAYER:DYNAMICS -! - -#if (RWORDSIZE == 4) -# define VPOWX vspowx -# define VPOW vspow -#else -# define VPOWX vpowx -# define VPOW vpow -#endif - - -MODULE module_big_step_utilities_em - - USE module_domain, ONLY : domain - USE module_model_constants - USE module_state_description - USE module_configure, ONLY : grid_config_rec_type - USE module_wrf_error - -CONTAINS - -!------------------------------------------------------------------------------- - -SUBROUTINE calc_mu_uv ( config_flags, & - mu, mub, muu, muv, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION( ims:ime , jms:jme ) , INTENT( OUT) :: muu, muv - REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu, mub - - ! local stuff - - INTEGER :: i, j, itf, jtf, im, jm - -! -! -! calc_mu_uv calculates the full column dry-air mass at the staggered -! horizontal velocity points (u,v) and places the results in muu and muv. -! This routine uses the reference state (mub) and perturbation state (mu) -! -! - - - itf=ite - jtf=MIN(jte,jde-1) - - IF ( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN - DO j=jts,jtf - DO i=its,itf - muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) - ENDDO - ENDDO - ELSE IF ( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN - DO j=jts,jtf - DO i=its+1,itf - muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) - ENDDO - ENDDO - i=its - im = its - if(config_flags%periodic_x) im = its-1 - DO j=jts,jtf -! muu(i,j) = mu(i,j) +mub(i,j) -! fix for periodic b.c., 13 march 2004, wcs - muu(i,j) = 0.5*(mu(i,j)+mu(im,j)+mub(i,j)+mub(im,j)) - ENDDO - ELSE IF ( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN - DO j=jts,jtf - DO i=its,itf-1 - muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) - ENDDO - ENDDO - i=ite - im = ite-1 - if(config_flags%periodic_x) im = ite - DO j=jts,jtf -! muu(i,j) = mu(i-1,j) +mub(i-1,j) -! fix for periodic b.c., 13 march 2004, wcs - muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)+mub(i-1,j)+mub(im,j)) - ENDDO - ELSE IF ( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN - DO j=jts,jtf - DO i=its+1,itf-1 - muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) - ENDDO - ENDDO - i=its - im = its - if(config_flags%periodic_x) im = its-1 - DO j=jts,jtf -! muu(i,j) = mu(i,j) +mub(i,j) -! fix for periodic b.c., 13 march 2004, wcs - muu(i,j) = 0.5*(mu(i,j)+mu(im,j)+mub(i,j)+mub(im,j)) - ENDDO - i=ite - im = ite-1 - if(config_flags%periodic_x) im = ite - DO j=jts,jtf -! muu(i,j) = mu(i-1,j) +mub(i-1,j) -! fix for periodic b.c., 13 march 2004, wcs - muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)+mub(i-1,j)+mub(im,j)) - ENDDO - END IF - - itf=MIN(ite,ide-1) - jtf=jte - - IF ( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN - DO j=jts,jtf - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) - ENDDO - ENDDO - ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN - DO j=jts+1,jtf - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) - ENDDO - ENDDO - j=jts - jm = jts - if(config_flags%periodic_y) jm = jts-1 - DO i=its,itf -! muv(i,j) = mu(i,j) +mub(i,j) -! fix for periodic b.c., 13 march 2004, wcs - muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)+mub(i,j)+mub(i,jm)) - ENDDO - ELSE IF ( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN - DO j=jts,jtf-1 - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) - ENDDO - ENDDO - j=jte - jm = jte-1 - if(config_flags%periodic_y) jm = jte - DO i=its,itf - muv(i,j) = mu(i,j-1) +mub(i,j-1) -! fix for periodic b.c., 13 march 2004, wcs - muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)+mub(i,j-1)+mub(i,jm)) - ENDDO - ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN - DO j=jts+1,jtf-1 - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) - ENDDO - ENDDO - j=jts - jm = jts - if(config_flags%periodic_y) jm = jts-1 - DO i=its,itf -! muv(i,j) = mu(i,j) +mub(i,j) -! fix for periodic b.c., 13 march 2004, wcs - muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)+mub(i,j)+mub(i,jm)) - ENDDO - j=jte - jm = jte-1 - if(config_flags%periodic_y) jm = jte - DO i=its,itf -! muv(i,j) = mu(i,j-1) +mub(i,j-1) -! fix for periodic b.c., 13 march 2004, wcs - muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)+mub(i,j-1)+mub(i,jm)) - ENDDO - END IF - -END SUBROUTINE calc_mu_uv - -!------------------------------------------------------------------------------- - -SUBROUTINE calc_mu_uv_1 ( config_flags, & - mu, muu, muv, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION( ims:ime , jms:jme ) , INTENT( OUT) :: muu, muv - REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu - - ! local stuff - - INTEGER :: i, j, itf, jtf, im, jm - -! -! -! calc_mu_uv calculates the full column dry-air mass at the staggered -! horizontal velocity points (u,v) and places the results in muu and muv. -! This routine uses the full state (mu) -! -! - - itf=ite - jtf=MIN(jte,jde-1) - - IF ( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN - DO j=jts,jtf - DO i=its,itf - muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)) - ENDDO - ENDDO - ELSE IF ( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN - DO j=jts,jtf - DO i=its+1,itf - muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)) - ENDDO - ENDDO - i=its - im = its - if(config_flags%periodic_x) im = its-1 - DO j=jts,jtf - muu(i,j) = 0.5*(mu(i,j)+mu(im,j)) - ENDDO - ELSE IF ( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN - DO j=jts,jtf - DO i=its,itf-1 - muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)) - ENDDO - ENDDO - i=ite - im = ite-1 - if(config_flags%periodic_x) im = ite - DO j=jts,jtf - muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)) - ENDDO - ELSE IF ( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN - DO j=jts,jtf - DO i=its+1,itf-1 - muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)) - ENDDO - ENDDO - i=its - im = its - if(config_flags%periodic_x) im = its-1 - DO j=jts,jtf - muu(i,j) = 0.5*(mu(i,j)+mu(im,j)) - ENDDO - i=ite - im = ite-1 - if(config_flags%periodic_x) im = ite - DO j=jts,jtf - muu(i,j) = 0.5*(mu(i-1,j)+mu(im,j)) - ENDDO - END IF - - itf=MIN(ite,ide-1) - jtf=jte - - IF ( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN - DO j=jts,jtf - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)) - ENDDO - ENDDO - ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN - DO j=jts+1,jtf - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)) - ENDDO - ENDDO - j=jts - jm = jts - if(config_flags%periodic_y) jm = jts-1 - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)) - ENDDO - ELSE IF ( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN - DO j=jts,jtf-1 - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)) - ENDDO - ENDDO - j=jte - jm = jte-1 - if(config_flags%periodic_y) jm = jte - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)) - ENDDO - ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN - DO j=jts+1,jtf-1 - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)) - ENDDO - ENDDO - j=jts - jm = jts - if(config_flags%periodic_y) jm = jts-1 - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,jm)) - ENDDO - j=jte - jm = jte-1 - if(config_flags%periodic_y) jm = jte - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j-1)+mu(i,jm)) - ENDDO - END IF - -END SUBROUTINE calc_mu_uv_1 - -!------------------------------------------------------------------------------- - -! Map scale factor comments for this routine: -! Locally not changed, but sent the correct map scale factors -! from module_em (msfuy, msfvx, msfty) - -SUBROUTINE couple_momentum ( muu, ru, u, msfu, & - muv, rv, v, msfv, msfv_inv, & - mut, rw, w, msft, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT( OUT) :: ru, rv, rw - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: muu, muv, mut - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfu, msfv, msft, msfv_inv - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: u, v, w - - ! Local data - - INTEGER :: i, j, k, itf, jtf, ktf - -! -! -! couple_momentum couples the velocities to the full column mass and -! the map factors. -! -! - - ktf=MIN(kte,kde-1) - - itf=ite - jtf=MIN(jte,jde-1) - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - ru(i,k,j)=u(i,k,j)*muu(i,j)/msfu(i,j) - ENDDO - ENDDO - ENDDO - - itf=MIN(ite,ide-1) - jtf=jte - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - rv(i,k,j)=v(i,k,j)*muv(i,j)*msfv_inv(i,j) -! rv(i,k,j)=v(i,k,j)*muv(i,j)/msfv(i,j) - ENDDO - ENDDO - ENDDO - - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - - DO j=jts,jtf - DO k=kts,kte - DO i=its,itf - rw(i,k,j)=w(i,k,j)*mut(i,j)/msft(i,j) - ENDDO - ENDDO - ENDDO - -END SUBROUTINE couple_momentum - -!------------------------------------------------------------------- - -SUBROUTINE calc_mu_staggered ( mu, mub, muu, muv, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION( ims:ime , jms:jme ) , INTENT( OUT) :: muu, muv - REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu, mub - - ! local stuff - - INTEGER :: i, j, itf, jtf - -! -! -! calc_mu_staggered calculates the full dry air mass at the staggered -! velocity points (u,v). -! -! - - itf=ite - jtf=MIN(jte,jde-1) - - IF ( ( its .NE. ids ) .AND. ( ite .NE. ide ) ) THEN - DO j=jts,jtf - DO i=its,itf - muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) - ENDDO - ENDDO - ELSE IF ( ( its .EQ. ids ) .AND. ( ite .NE. ide ) ) THEN - DO j=jts,jtf - DO i=its+1,itf - muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) - ENDDO - ENDDO - i=its - DO j=jts,jtf - muu(i,j) = mu(i,j) +mub(i,j) - ENDDO - ELSE IF ( ( its .NE. ids ) .AND. ( ite .EQ. ide ) ) THEN - DO j=jts,jtf - DO i=its,itf-1 - muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) - ENDDO - ENDDO - i=ite - DO j=jts,jtf - muu(i,j) = mu(i-1,j) +mub(i-1,j) - ENDDO - ELSE IF ( ( its .EQ. ids ) .AND. ( ite .EQ. ide ) ) THEN - DO j=jts,jtf - DO i=its+1,itf-1 - muu(i,j) = 0.5*(mu(i,j)+mu(i-1,j)+mub(i,j)+mub(i-1,j)) - ENDDO - ENDDO - i=its - DO j=jts,jtf - muu(i,j) = mu(i,j) +mub(i,j) - ENDDO - i=ite - DO j=jts,jtf - muu(i,j) = mu(i-1,j) +mub(i-1,j) - ENDDO - END IF - - itf=MIN(ite,ide-1) - jtf=jte - - IF ( ( jts .NE. jds ) .AND. ( jte .NE. jde ) ) THEN - DO j=jts,jtf - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) - ENDDO - ENDDO - ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .NE. jde ) ) THEN - DO j=jts+1,jtf - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) - ENDDO - ENDDO - j=jts - DO i=its,itf - muv(i,j) = mu(i,j) +mub(i,j) - ENDDO - ELSE IF ( ( jts .NE. jds ) .AND. ( jte .EQ. jde ) ) THEN - DO j=jts,jtf-1 - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) - ENDDO - ENDDO - j=jte - DO i=its,itf - muv(i,j) = mu(i,j-1) +mub(i,j-1) - ENDDO - ELSE IF ( ( jts .EQ. jds ) .AND. ( jte .EQ. jde ) ) THEN - DO j=jts+1,jtf-1 - DO i=its,itf - muv(i,j) = 0.5*(mu(i,j)+mu(i,j-1)+mub(i,j)+mub(i,j-1)) - ENDDO - ENDDO - j=jts - DO i=its,itf - muv(i,j) = mu(i,j) +mub(i,j) - ENDDO - j=jte - DO i=its,itf - muv(i,j) = mu(i,j-1) +mub(i,j-1) - ENDDO - END IF - -END SUBROUTINE calc_mu_staggered - -!------------------------------------------------------------------------------- - -SUBROUTINE couple ( mu, mub, rfield, field, name, & - msf, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - CHARACTER(LEN=1) , INTENT(IN ) :: name - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT( OUT) :: rfield - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu, mub, msf - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: field - - ! Local data - - INTEGER :: i, j, k, itf, jtf, ktf - REAL , DIMENSION(ims:ime,jms:jme) :: muu , muv - -! -! -! subroutine couple couples the input variable with the dry-air -! column mass (mu). -! -! - - - ktf=MIN(kte,kde-1) - - IF (name .EQ. 'u')THEN - - CALL calc_mu_staggered ( mu, mub, muu, muv, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - itf=ite - jtf=MIN(jte,jde-1) - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - rfield(i,k,j)=field(i,k,j)*muu(i,j)/msf(i,j) - ENDDO - ENDDO - ENDDO - - ELSE IF (name .EQ. 'v')THEN - - CALL calc_mu_staggered ( mu, mub, muu, muv, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - itf=ite - itf=MIN(ite,ide-1) - jtf=jte - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - rfield(i,k,j)=field(i,k,j)*muv(i,j)/msf(i,j) - ENDDO - ENDDO - ENDDO - - ELSE IF (name .EQ. 'w')THEN - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - DO j=jts,jtf - DO k=kts,kte - DO i=its,itf - rfield(i,k,j)=field(i,k,j)*(mu(i,j)+mub(i,j))/msf(i,j) - ENDDO - ENDDO - ENDDO - - ELSE IF (name .EQ. 'h')THEN - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - DO j=jts,jtf - DO k=kts,kte - DO i=its,itf - rfield(i,k,j)=field(i,k,j)*(mu(i,j)+mub(i,j)) - ENDDO - ENDDO - ENDDO - - ELSE - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - rfield(i,k,j)=field(i,k,j)*(mu(i,j)+mub(i,j)) - ENDDO - ENDDO - ENDDO - - ENDIF - -END SUBROUTINE couple - - -!------------------------------------------------------------------------------- - -SUBROUTINE calc_ww_cp ( u, v, mup, mub, ww, & - rdx, rdy, msftx, msfty, & - msfux, msfuy, msfvx, msfvx_inv, & - msfvy, dnw, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: u, v - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mup, mub, & - msftx, msfty, & - msfux, msfuy, & - msfvx, msfvy, & - msfvx_inv - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT ) :: ww - REAL , INTENT(IN ) :: rdx, rdy - - ! Local data - - INTEGER :: i, j, k, itf, jtf, ktf - REAL , DIMENSION( its:ite ) :: dmdt - REAL , DIMENSION( its:ite, kts:kte ) :: divv - REAL , DIMENSION( its:ite+1, jts:jte+1 ) :: muu, muv - -! -! -! calc_ww calculates omega using the velocities (u,v) and the dry-air -! column mass (mup+mub). -! The algorithm integrates the continuity equation through the column -! followed by a diagnosis of omega. -! -! - -! -! -! calc_ww_cp calculates omega using the velocities (u,v) and the -! column mass mu. -! -! - - jtf=MIN(jte,jde-1) - ktf=MIN(kte,kde-1) - itf=MIN(ite,ide-1) - -! mu coupled with the appropriate map factor - - DO j=jts,jtf - DO i=its,min(ite+1,ide) - ! u is always coupled with my - muu(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i-1,j)+mub(i-1,j))/msfuy(i,j) - ENDDO - ENDDO - - DO j=jts,min(jte+1,jde) - DO i=its,itf - ! v is always coupled with mx -! muv(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i,j-1)+mub(i,j-1))/msfvx(i,j) - muv(i,j) = 0.5*(mup(i,j)+mub(i,j)+mup(i,j-1)+mub(i,j-1))*msfvx_inv(i,j) - ENDDO - ENDDO - - DO j=jts,jtf - - DO i=its,ite - dmdt(i) = 0. - ww(i,1,j) = 0. - ww(i,kte,j) = 0. - ENDDO - -! Comments on the modifications for map scale factors -! ADT eqn 47 / my (putting rho -> 'mu') is: -! (1/my) partial d mu/dt = -mx partial d/dx(mu u/my) -! -mx partial d/dy(mu v/mx) -! -partial d/dz(mu w/my) -! -! Using nu instead of z the last term becomes: -! -partial d/dnu(mu (dnu/dt)/my) -! -! Integrating with respect to nu over ALL levels, with dnu/dt=0 at top -! and bottom, the last term becomes = 0 -! -! Integral|bot->top[(1/my) partial d mu/dt]dnu = -! Integral|bot->top[-mx partial d/dx(mu u/my) -! -mx partial d/dy(mu v/mx)]dnu -! -! muu='mu'[on u]/my, muv='mu'[on v]/mx -! (1/my) partial d mu/dt is independent of nu -! => LHS = Integral|bot->top[con]dnu = conservation*(-1) = -dmdt -! -! => dmdt = mx*Integral|bot->top[partial d/dx(mu u/my) + -! partial d/dy(mu v/mx)]dnu -! => dmdt = sum_bot->top[divv] -! where -! divv=mx*[partial d/dx(mu u/my) + partial d/dy(mu v/mx)]*delta nu - - DO k=kts,ktf - DO i=its,itf - - divv(i,k) = msftx(i,j)*dnw(k)*( rdx*(muu(i+1,j)*u(i+1,k,j)-muu(i,j)*u(i,k,j)) & - +rdy*(muv(i,j+1)*v(i,k,j+1)-muv(i,j)*v(i,k,j)) ) - -! dmdt(i) = dmdt(i) + dnw(k)* ( rdx*(ru(i+1,k,j)-ru(i,k,j)) & -! +rdy*(rv(i,k,j+1)-rv(i,k,j)) ) - - dmdt(i) = dmdt(i) + divv(i,k) - - - ENDDO - ENDDO - -! Further map scale factor notes: -! Now integrate from bottom to top, level by level: -! mu dnu/dt/my [k+1] = mu dnu/dt/my [k] + [-(1/my) partial d mu/dt -! -mx partial d/dx(mu u/my) -! -mx partial d/dy(mu v/mx)]*dnu[k->k+1] -! ww [k+1] = ww [k] -(1/my) partial d mu/dt * dnu[k->k+1] - divv[k] -! = ww [k] -dmdt * dnw[k] - divv[k] - - DO k=2,ktf - DO i=its,itf - -! ww(i,k,j)=ww(i,k-1,j) & -! - dnw(k-1)* ( dmdt(i) & -! +rdx*(ru(i+1,k-1,j)-ru(i,k-1,j)) & -! +rdy*(rv(i,k-1,j+1)-rv(i,k-1,j)) ) - - ww(i,k,j)=ww(i,k-1,j) - dnw(k-1)*dmdt(i) - divv(i,k-1) - - ENDDO - ENDDO - ENDDO - - -END SUBROUTINE calc_ww_cp - - -!------------------------------------------------------------------------------- - -SUBROUTINE calc_cq ( moist, cqu, cqv, cqw, n_moist, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER , INTENT(IN ) :: n_moist - - - REAL, DIMENSION( ims:ime, kms:kme , jms:jme , n_moist ), INTENT(IN ) :: moist - - REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT( OUT) :: cqu, cqv, cqw - - ! Local stuff - - REAL :: qtot - - INTEGER :: i, j, k, itf, jtf, ktf, ispe - -! -! -! calc_cq calculates moist coefficients for the momentum equations. -! -! - - itf=ite - jtf=MIN(jte,jde-1) - ktf=MIN(kte,kde-1) - - IF( n_moist >= PARAM_FIRST_SCALAR ) THEN - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - qtot = 0. -!DEC$ loop count(3) - DO ispe=PARAM_FIRST_SCALAR,n_moist - qtot = qtot + moist(i,k,j,ispe) + moist(i-1,k,j,ispe) - ENDDO -! qtot = 0.5*( moist(i ,k,j,1)+moist(i ,k,j,2)+moist(i ,k,j,3)+ & -! & moist(i-1,k,j,1)+moist(i-1,k,j,2)+moist(i-1,k,j,3) ) -! cqu(i,k,j) = 1./(1.+qtot) - cqu(i,k,j) = 1./(1.+0.5*qtot) - ENDDO - ENDDO - ENDDO - - itf=MIN(ite,ide-1) - jtf=jte - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - qtot = 0. -!DEC$ loop count(3) - DO ispe=PARAM_FIRST_SCALAR,n_moist - qtot = qtot + moist(i,k,j,ispe) + moist(i,k,j-1,ispe) - ENDDO -! qtot = 0.5*( moist(i,k,j ,1)+moist(i,k,j ,2)+moist(i,k,j ,3)+ & -! & moist(i,k,j-1,1)+moist(i,k,j-1,2)+moist(i,k,j-1,3) ) -! cqv(i,k,j) = 1./(1.+qtot) - cqv(i,k,j) = 1./(1.+0.5*qtot) - ENDDO - ENDDO - ENDDO - - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - DO j=jts,jtf - DO k=kts+1,ktf - DO i=its,itf - qtot = 0. -!DEC$ loop count(3) - DO ispe=PARAM_FIRST_SCALAR,n_moist - qtot = qtot + moist(i,k,j,ispe) + moist(i,k-1,j,ispe) - ENDDO -! qtot = 0.5*( moist(i,k ,j,1)+moist(i,k ,j,2)+moist(i,k-1,j,3)+ & -! & moist(i,k-1,j,1)+moist(i,k-1,j,2)+moist(i,k ,j,3) ) -! cqw(i,k,j) = qtot - cqw(i,k,j) = 0.5*qtot - ENDDO - ENDDO - ENDDO - - ELSE - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - cqu(i,k,j) = 1. - ENDDO - ENDDO - ENDDO - - itf=MIN(ite,ide-1) - jtf=jte - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - cqv(i,k,j) = 1. - ENDDO - ENDDO - ENDDO - - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - DO j=jts,jtf - DO k=kts+1,ktf - DO i=its,itf - cqw(i,k,j) = 0. - ENDDO - ENDDO - ENDDO - - END IF - -END SUBROUTINE calc_cq - -!---------------------------------------------------------------------- - -SUBROUTINE calc_alt ( alt, al, alb, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: alb, al - REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT( OUT) :: alt - - ! Local stuff - - INTEGER :: i, j, k, itf, jtf, ktf - -! -! -! calc_alt computes the full inverse density -! -! - - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - ktf=MIN(kte,kde-1) - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - alt(i,k,j) = al(i,k,j)+alb(i,k,j) - ENDDO - ENDDO - ENDDO - - -END SUBROUTINE calc_alt - -!---------------------------------------------------------------------- - -SUBROUTINE calc_p_rho_phi ( moist, n_moist, & - al, alb, mu, muts, ph, p, pb, & - t, p0, t0, znu, dnw, rdnw, & - rdn, non_hydrostatic, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - LOGICAL , INTENT(IN ) :: non_hydrostatic - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER , INTENT(IN ) :: n_moist - - REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: alb, & - pb, & - t - - REAL, DIMENSION( ims:ime , kms:kme , jms:jme, n_moist ), INTENT(IN ) :: moist - - REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT( OUT) :: al, p - - REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: ph - - REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: mu, muts - - REAL, DIMENSION( kms:kme ), INTENT(IN ) :: znu, dnw, rdnw, rdn - - REAL, INTENT(IN ) :: t0, p0 - - ! Local stuff - - INTEGER :: i, j, k, itf, jtf, ktf, ispe - REAL :: qvf, qtot, qf1, qf2 - REAL, DIMENSION( its:ite) :: temp,cpovcv_v - - -! -! -! For the nonhydrostatic option, calc_p_rho_phi calculates the -! diagnostic quantities pressure and (inverse) density from the -! prognostic variables using the equation of state. -! -! For the hydrostatic option, calc_p_rho_phi calculates the -! diagnostic quantities (inverse) density and geopotential from the -! prognostic variables using the equation of state and the hydrostatic -! equation. -! -! - - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - ktf=MIN(kte,kde-1) - -#ifndef INTELMKL - cpovcv_v = cpovcv -#endif - - IF (non_hydrostatic) THEN - - IF (n_moist >= PARAM_FIRST_SCALAR ) THEN - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - qvf = 1.+rvovrd*moist(i,k,j,P_QV) - al(i,k,j)=-1./muts(i,j)*(alb(i,k,j)*mu(i,j) & - +rdnw(k)*(ph(i,k+1,j)-ph(i,k,j))) - temp(i)=(r_d*(t0+t(i,k,j))*qvf)/ & - (p0*(al(i,k,j)+alb(i,k,j))) - ENDDO -#ifdef INTELMKL - CALL VPOWX ( itf-its+1, temp(its), cpovcv, p(its,k,j) ) -#else -! use vector version from libmassv or from compat lib in frame/libmassv.F - CALL VPOW ( p(its,k,j), temp(its), cpovcv_v(its), itf-its+1 ) -#endif - DO i=its,itf - p(i,k,j)= p(i,k,j)*p0-pb(i,k,j) - ENDDO - ENDDO - ENDDO - - ELSE - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - al(i,k,j)=-1./muts(i,j)*(alb(i,k,j)*mu(i,j) & - +rdnw(k)*(ph(i,k+1,j)-ph(i,k,j))) - p(i,k,j)=p0*( (r_d*(t0+t(i,k,j)))/ & - (p0*(al(i,k,j)+alb(i,k,j))) )**cpovcv & - -pb(i,k,j) - ENDDO - ENDDO - ENDDO - - END IF - - ELSE - -! hydrostatic pressure, al, and ph1 calc; WCS, 5 sept 2001 - - - IF (n_moist >= PARAM_FIRST_SCALAR ) THEN - - DO j=jts,jtf - - k=ktf ! top layer - DO i=its,itf - - qtot = 0. - DO ispe=PARAM_FIRST_SCALAR,n_moist - qtot = qtot + moist(i,k,j,ispe) - ENDDO - qf2 = 1./(1.+qtot) - qf1 = qtot*qf2 - - p(i,k,j) = - 0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2 - qvf = 1.+rvovrd*moist(i,k,j,P_QV) - al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* & - (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j) - - ENDDO - - DO k=ktf-1,kts,-1 ! remaining layers, integrate down - DO i=its,itf - - qtot = 0. - DO ispe=PARAM_FIRST_SCALAR,n_moist - qtot = qtot + 0.5*( moist(i,k ,j,ispe) + moist(i,k+1,j,ispe) ) - ENDDO - qf2 = 1./(1.+qtot) - qf1 = qtot*qf2 - - p(i,k,j) = p(i,k+1,j) - (mu(i,j) + qf1*muts(i,j))/qf2/rdn(k+1) - qvf = 1.+rvovrd*moist(i,k,j,P_QV) - al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* & - (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j) - ENDDO - ENDDO - - DO k=2,ktf+1 ! integrate hydrostatic equation for geopotential - DO i=its,itf - -! ph(i,k,j) = ph(i,k-1,j) - (1./rdnw(k-1))*( & -! (muts(i,j)+mu(i,j))*al(i,k-1,j)+ & -! mu(i,j)*alb(i,k-1,j) ) - ph(i,k,j) = ph(i,k-1,j) - (dnw(k-1))*( & - (muts(i,j))*al(i,k-1,j)+ & - mu(i,j)*alb(i,k-1,j) ) - - - ENDDO - ENDDO - - ENDDO - - ELSE - - DO j=jts,jtf - - k=ktf ! top layer - DO i=its,itf - - qtot = 0. - qf2 = 1./(1.+qtot) - qf1 = qtot*qf2 - - p(i,k,j) = - 0.5*(mu(i,j)+qf1*muts(i,j))/rdnw(k)/qf2 - qvf = 1. - al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* & - (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j) - - ENDDO - - DO k=ktf-1,kts,-1 ! remaining layers, integrate down - DO i=its,itf - - qtot = 0. - qf2 = 1./(1.+qtot) - qf1 = qtot*qf2 - - p(i,k,j) = p(i,k+1,j) - (mu(i,j) + qf1*muts(i,j))/qf2/rdn(k+1) - qvf = 1. - al(i,k,j) = (r_d/p1000mb)*(t(i,k,j)+t0)*qvf* & - (((p(i,k,j)+pb(i,k,j))/p1000mb)**cvpm) - alb(i,k,j) - ENDDO - ENDDO - - DO k=2,ktf+1 ! integrate hydrostatic equation for geopotential - DO i=its,itf - -! ph(i,k,j) = ph(i,k-1,j) - (1./rdnw(k-1))*( & -! (muts(i,j)+mu(i,j))*al(i,k-1,j)+ & -! mu(i,j)*alb(i,k-1,j) ) - ph(i,k,j) = ph(i,k-1,j) - (dnw(k-1))*( & - (muts(i,j))*al(i,k-1,j)+ & - mu(i,j)*alb(i,k-1,j) ) - - - ENDDO - ENDDO - - ENDDO - - END IF - - END IF - -END SUBROUTINE calc_p_rho_phi - -!---------------------------------------------------------------------- - -SUBROUTINE calc_php ( php, ph, phb, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN ) :: phb, ph - REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT( OUT) :: php - - ! Local stuff - - INTEGER :: i, j, k, itf, jtf, ktf - -! -! -! calc_php calculates the full geopotential from the reference state -! geopotential and the perturbation geopotential (phb_ph). -! -! - - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - ktf=MIN(kte,kde-1) - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - php(i,k,j) = 0.5*(phb(i,k,j)+phb(i,k+1,j)+ph(i,k,j)+ph(i,k+1,j)) - ENDDO - ENDDO - ENDDO - -END SUBROUTINE calc_php - -!------------------------------------------------------------------------------- - -SUBROUTINE diagnose_w( ph_tend, ph_new, ph_old, w, mu, dt, & - u, v, ht, & - cf1, cf2, cf3, rdx, rdy, & - msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN ) :: ph_tend, & - ph_new, & - ph_old, & - u, & - v - - - REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT( OUT) :: w - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: mu, ht, msftx, msfty - - REAL, INTENT(IN ) :: dt, cf1, cf2, cf3, rdx, rdy - - INTEGER :: i, j, k, itf, jtf - - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - -! -! -! diagnose_w diagnoses the vertical velocity from the geopoential equation. -! Used with the hydrostatic option. -! -! - - DO j = jts, jtf - -! lower b.c. on w - -! Notes on map scale factors: -! Chain rule: if Z=Z(X,Y) [true at the surface] then -! dZ/dt = dZ/dX * dX/dt + dZ/dY * dY/dt, U=dX/dt, V=dY/dt -! Using capitals to denote actual values -! In mapped values, u=U, v=V, z=Z, 1/dX=mx/dx, 1/dY=my/dy -! => w = dz/dt = mx u dz/dx + my v dz/dy -! [where dz/dx is just the surface height change between x -! gridpoints, and dz/dy is the change between y gridpoints] -! [NB: cf1, cf2 and cf3 do vertical weighting of u or v values -! nearest the surface] - -! Previously msft multiplied by rdy and rdx terms. -! Now msfty multiplies rdy term, and msftx multiplies msftx term - DO i = its, itf - w(i,1,j)= msfty(i,j)*.5*rdy*( & - (ht(i,j+1)-ht(i,j )) & - *(cf1*v(i,1,j+1)+cf2*v(i,2,j+1)+cf3*v(i,3,j+1)) & - +(ht(i,j )-ht(i,j-1)) & - *(cf1*v(i,1,j )+cf2*v(i,2,j )+cf3*v(i,3,j )) ) & - +msftx(i,j)*.5*rdx*( & - (ht(i+1,j)-ht(i,j )) & - *(cf1*u(i+1,1,j)+cf2*u(i+1,2,j)+cf3*u(i+1,3,j)) & - +(ht(i,j )-ht(i-1,j)) & - *(cf1*u(i ,1,j)+cf2*u(i ,2,j)+cf3*u(i ,3,j)) ) - ENDDO - -! use geopotential equation to diagnose w - -! Further notes on map scale factors -! If ph_tend contains: -mx partial d/dx(mu rho u/my) -! -mx partial d/dy(phi mu v/mx) -! -partial d/dz(phi mu w/my) -! then phi eqn is: partial d/dt(mu phi/my) = ph_tend + mu g w/my -! => w = [my/(mu*g)]*[partial d/dt(mu phi/my) - ph_tend] - - DO k = 2, kte - DO i = its, itf - w(i,k,j) = msfty(i,j)*( (ph_new(i,k,j)-ph_old(i,k,j))/dt & - - ph_tend(i,k,j)/mu(i,j) )/g - - ENDDO - ENDDO - - ENDDO - -END SUBROUTINE diagnose_w - -!------------------------------------------------------------------------------- - -SUBROUTINE rhs_ph( ph_tend, u, v, ww, & - ph, ph_old, phb, w, & - mut, muu, muv, & - fnm, fnp, & - rdnw, cfn, cfn1, rdx, rdy, & - msfux, msfuy, msfvx, & - msfvx_inv, msfvy, & - msftx, msfty, & - non_hydrostatic, & - config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - IMPLICIT NONE - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN ) :: & - u, & - v, & - ww, & - ph, & - ph_old, & - phb, & - w - - REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) :: ph_tend - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: muu, muv, mut, & - msfux, msfuy, & - msfvx, msfvy, & - msftx, msfty, & - msfvx_inv - - REAL, DIMENSION( kms:kme ), INTENT(IN ) :: rdnw, fnm, fnp - - REAL, INTENT(IN ) :: cfn, cfn1, rdx, rdy - - LOGICAL, INTENT(IN ) :: non_hydrostatic - - ! Local stuff - - INTEGER :: i, j, k, itf, jtf, ktf, kz, i_start, j_start - REAL :: ur, ul, ub, vr, vl, vb - REAL, DIMENSION(its:ite,kts:kte) :: wdwn - - INTEGER :: advective_order - - LOGICAL :: specified - -! -! -! rhs_ph calculates the large-timestep tendency terms for the geopotential -! equation. These terms include the advection and "gw". The geopotential -! equation is cast in advective form, so we don't use the flux form advection -! algorithms here. -! -! - - specified = .false. - if(config_flags%specified .or. config_flags%nested) specified = .true. - - advective_order = config_flags%h_sca_adv_order -! advective_order = 2 ! original configuration (pre Oct 2001) - - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - ktf=MIN(kte,kde-1) - -! Notes on map scale factors (WCS, 2 march 2008) -! phi equation is: mu/my d/dt(phi) = -(1/my) mx mu u d/dx(phi) -! -(1/my) my mu v d/dy(phi) -! - omega d/d_eta(phi) -! +mu g w/my -! -! A little further explanation... -! The tendency term we are computing here is for mu/my d/dt(phi). It is advective form -! but it is multiplied be mu/my. It will be decoupled from (mu/my) when the implicit w-phi -! solution is computed in subourine advance_w. The formulation dates from the early -! days of the mass coordinate model when we were testing both a flux and an advective formulation -! for the geopotential equation and different forms of the vertical momentum equation and the -! vertically implicit solver. - -! advective form for the geopotential equation - - DO j = jts, jtf - - DO k = 2, kte - DO i = its, itf - wdwn(i,k) = .5*(ww(i,k,j)+ww(i,k-1,j))*rdnw(k-1) & - *(ph(i,k,j)-ph(i,k-1,j)+phb(i,k,j)-phb(i,k-1,j)) - ENDDO - ENDDO - -! RHS term 3 is: - omega partial d/dnu(phi) - - DO k = 2, kte-1 - DO i = its, itf - ph_tend(i,k,j) = ph_tend(i,k,j) & - - (fnm(k)*wdwn(i,k+1)+fnp(k)*wdwn(i,k)) - ENDDO - ENDDO - - ENDDO - - IF (non_hydrostatic) THEN ! add in "gw" term. - DO j = jts, jtf ! in hydrostatic mode, "gw" will be diagnosed - ! after the timestep to give us "w" - DO i = its, itf - ph_tend(i,kde,j) = 0. - ENDDO - - DO k = 2, kte - DO i = its, itf - ! phi equation RHS term 4 - ph_tend(i,k,j) = ph_tend(i,k,j) + mut(i,j)*g*w(i,k,j)/msfty(i,j) - ENDDO - ENDDO - - ENDDO - - END IF - -! Notes on map scale factors: -! RHS terms 1 and 2 are: -(1/my) mx u mu partial d/dx(phi) -! -(1/my) my v mu partial d/dy(phi) - - IF (advective_order <= 2) THEN - -! y (v) advection - - i_start = its - j_start = jts - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - - IF ( (config_flags%open_ys) .and. jts == jds ) j_start = jts+1 - IF ( (config_flags%open_ye) .and. jte == jde ) jtf = jtf-1 - - DO j = j_start, jtf - - DO k = 2, kte-1 - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* & - ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1)* & - (phb(i,k,j+1)-phb(i,k,j )+ph(i,k,j+1)-ph(i,k,j )) & - +muv(i,j )*(v(i,k,j )+v(i,k-1,j ))*msfvy(i,j )* & - (phb(i,k,j )-phb(i,k,j-1)+ph(i,k,j )-ph(i,k,j-1)) ) - ENDDO - ENDDO - - k = kte - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* & - ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1)* & - (phb(i,k,j+1)-phb(i,k,j )+ph(i,k,j+1)-ph(i,k,j )) & - +muv(i,j )*(cfn*v(i,k-1,j )+cfn1*v(i,k-2,j ))*msfvy(i,j )* & - (phb(i,k,j )-phb(i,k,j-1)+ph(i,k,j )-ph(i,k,j-1)) ) - ENDDO - - ENDDO - -! x (u) advection - - i_start = its - j_start = jts - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - - IF ( (config_flags%open_xs) .and. its == ids ) i_start = its+1 - IF ( (config_flags%open_xe) .and. ite == ide ) itf = itf-1 - - DO j = j_start, jtf - - DO k = 2, kte-1 - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))* & - ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j)* & - (phb(i+1,k,j)-phb(i ,k,j)+ph(i+1,k,j)-ph(i ,k,j)) & - +muu(i ,j)*(u(i ,k,j)+u(i ,k-1,j))*msfux(i ,j)* & - (phb(i ,k,j)-phb(i-1,k,j)+ph(i ,k,j)-ph(i-1,k,j)) ) - ENDDO - ENDDO - - k = kte - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))* & - ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j)* & - (phb(i+1,k,j)-phb(i ,k,j)+ph(i+1,k,j)-ph(i ,k,j)) & - +muu(i ,j)*(cfn*u(i ,k-1,j)+cfn1*u(i ,k-2,j))*msfux( i,j)* & - (phb(i ,k,j)-phb(i-1,k,j)+ph(i ,k,j)-ph(i-1,k,j)) ) - ENDDO - - ENDDO - - ELSE IF (advective_order <= 4) THEN - -! y (v) advection - - i_start = its - j_start = jts - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - - IF ( (config_flags%open_ys) .and. jts == jds ) j_start = jts+1 - IF ( (config_flags%open_ye) .and. jte == jde ) jtf = jtf-1 - - DO j = j_start, jtf - - DO k = 2, kte-1 - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))*( & - ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1) & - +muv(i,j )*(v(i,k,j )+v(i,k-1,j ))*msfvy(i,j ))* (1./12.)*( & - 8.*(ph(i,k,j+1)-ph(i,k,j-1)) & - -(ph(i,k,j+2)-ph(i,k,j-2)) & - +8.*(phb(i,k,j+1)-phb(i,k,j-1)) & - -(phb(i,k,j+2)-phb(i,k,j-2)) ) ) - - - ENDDO - ENDDO - - k = kte - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))*( & - ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) & - +muv(i,j )*(cfn*v(i,k-1,j )+cfn1*v(i,k-2,j ))*msfvy(i,j ))* (1./12.)*( & - 8.*(ph(i,k,j+1)-ph(i,k,j-1)) & - -(ph(i,k,j+2)-ph(i,k,j-2)) & - +8.*(phb(i,k,j+1)-phb(i,k,j-1)) & - -(phb(i,k,j+2)-phb(i,k,j-2)) ) ) - - ENDDO - - ENDDO - - -! x (u) advection - - i_start = its - j_start = jts - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - - IF ( (config_flags%open_xs) .and. its == ids ) i_start = its+1 - IF ( (config_flags%open_xe) .and. ite == ide ) itf = itf-1 - - DO j = j_start, jtf - - DO k = 2, kte-1 - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*( & - ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j) & - +muu(i,j )*(u(i ,k,j)+u(i ,k-1,j))*msfux(i ,j) )* (1./12.)*( & - 8.*(ph(i+1,k,j)-ph(i-1,k,j)) & - -(ph(i+2,k,j)-ph(i-2,k,j)) & - +8.*(phb(i+1,k,j)-phb(i-1,k,j)) & - -(phb(i+2,k,j)-phb(i-2,k,j)) ) ) - ENDDO - ENDDO - - k = kte - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*( & - ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) & - +muu(i,j )*(cfn*u(i ,k-1,j)+cfn1*u(i ,k-2,j))*msfux(i ,j) )* (1./12.)*( & - 8.*(ph(i+1,k,j)-ph(i-1,k,j)) & - -(ph(i+2,k,j)-ph(i-2,k,j)) & - +8.*(phb(i+1,k,j)-phb(i-1,k,j)) & - -(phb(i+2,k,j)-phb(i-2,k,j)) ) ) - ENDDO - - ENDDO - - ELSE IF (advective_order <= 6) THEN - -! y (v) advection - - i_start = its - j_start = jts - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - -! IF ( (config_flags%open_ys) .and. jts == jds ) j_start = jts+1 -! IF ( (config_flags%open_ye) .and. jte == jde ) jtf = jtf-1 - - IF (config_flags%open_ys .or. specified ) j_start = max(jts,jds+2) - IF (config_flags%open_ye .or. specified ) jtf = min(jtf,jde-3) - - DO j = j_start, jtf - - DO k = 2, kte-1 - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* ( & - ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1) & - +muv(i,j )*(v(i,k,j )+v(i,k-1,j ))*msfvy(i,j ) )* (1./60.)*( & - 45.*(ph(i,k,j+1)-ph(i,k,j-1)) & - -9.*(ph(i,k,j+2)-ph(i,k,j-2)) & - +(ph(i,k,j+3)-ph(i,k,j-3)) & - +45.*(phb(i,k,j+1)-phb(i,k,j-1)) & - -9.*(phb(i,k,j+2)-phb(i,k,j-2)) & - +(phb(i,k,j+3)-phb(i,k,j-3)) ) ) - - - ENDDO - ENDDO - - k = kte - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* ( & - ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) & - +muv(i,j )*(cfn*v(i,k-1,j )+cfn1*v(i,k-2,j ))*msfvy(i,j ) )* (1./60.)*( & - 45.*(ph(i,k,j+1)-ph(i,k,j-1)) & - -9.*(ph(i,k,j+2)-ph(i,k,j-2)) & - +(ph(i,k,j+3)-ph(i,k,j-3)) & - +45.*(phb(i,k,j+1)-phb(i,k,j-1)) & - -9.*(phb(i,k,j+2)-phb(i,k,j-2)) & - +(phb(i,k,j+3)-phb(i,k,j-3)) ) ) - - ENDDO - - ENDDO - - -! pick up near boundary rows using 4th order stencil -! (open bc copy only goes out to jds-1 and jde, hence 4rth is ok but 6th is too big) - - IF ( (config_flags%open_ys) .and. jts <= jds+1 ) THEN - - j = jds+1 - DO k = 2, kte-1 - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* ( & - ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1) & - +muv(i,j )*(v(i,k,j )+v(i,k-1,j ))*msfvy(i,j ) )* (1./12.)*( & - 8.*(ph(i,k,j+1)-ph(i,k,j-1)) & - -(ph(i,k,j+2)-ph(i,k,j-2)) & - +8.*(phb(i,k,j+1)-phb(i,k,j-1)) & - -(phb(i,k,j+2)-phb(i,k,j-2)) ) ) - - - ENDDO - ENDDO - - k = kte - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* ( & - ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) & - +muv(i,j )*(cfn*v(i,k-1,j )+cfn1*v(i,k-2,j ))*msfvy(i,j) )* (1./12.)*( & - 8.*(ph(i,k,j+1)-ph(i,k,j-1)) & - -(ph(i,k,j+2)-ph(i,k,j-2)) & - +8.*(phb(i,k,j+1)-phb(i,k,j-1)) & - -(phb(i,k,j+2)-phb(i,k,j-2)) ) ) - - ENDDO - - END IF - - IF ( (config_flags%open_ye) .and. jte >= jde-2 ) THEN - - j = jde-2 - DO k = 2, kte-1 - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdy/msfty(i,j))* ( & - ( muv(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1) & - +muv(i,j )*(v(i,k,j )+v(i,k-1,j ))*msfvy(i,j) )* (1./12.)*( & - 8.*(ph(i,k,j+1)-ph(i,k,j-1)) & - -(ph(i,k,j+2)-ph(i,k,j-2)) & - +8.*(phb(i,k,j+1)-phb(i,k,j-1)) & - -(phb(i,k,j+2)-phb(i,k,j-2)) ) ) - - - ENDDO - ENDDO - - k = kte - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdy/msfty(i,j))* ( & - ( muv(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) & - +muv(i,j )*(cfn*v(i,k-1,j )+cfn1*v(i,k-2,j ))*msfvy(i,j) )* (1./12.)*( & - 8.*(ph(i,k,j+1)-ph(i,k,j-1)) & - -(ph(i,k,j+2)-ph(i,k,j-2)) & - +8.*(phb(i,k,j+1)-phb(i,k,j-1)) & - -(phb(i,k,j+2)-phb(i,k,j-2)) ) ) - - ENDDO - - END IF - -! x (u) advection - - i_start = its - j_start = jts - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - - IF (config_flags%open_xs .or. specified ) i_start = max(its,ids+2) - IF (config_flags%open_xe .or. specified ) itf = min(itf,ide-3) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) itf=MIN(ite,ide-1) - - DO j = j_start, jtf - - DO k = 2, kte-1 - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*( & - ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j) & - +muu(i,j )*(u(i,k,j )+u(i,k-1,j ))*msfux(i,j) )* (1./60.)*( & - 45.*(ph(i+1,k,j)-ph(i-1,k,j)) & - -9.*(ph(i+2,k,j)-ph(i-2,k,j)) & - +(ph(i+3,k,j)-ph(i-3,k,j)) & - +45.*(phb(i+1,k,j)-phb(i-1,k,j)) & - -9.*(phb(i+2,k,j)-phb(i-2,k,j)) & - +(phb(i+3,k,j)-phb(i-3,k,j)) ) ) - ENDDO - ENDDO - - k = kte - DO i = i_start, itf - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*( & - ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) & - +muu(i,j )*(cfn*u(i ,k-1,j)+cfn1*u(i,k-2,j))*msfux(i,j) )* (1./60.)*( & - 45.*(ph(i+1,k,j)-ph(i-1,k,j)) & - -9.*(ph(i+2,k,j)-ph(i-2,k,j)) & - +(ph(i+3,k,j)-ph(i-3,k,j)) & - +45.*(phb(i+1,k,j)-phb(i-1,k,j)) & - -9.*(phb(i+2,k,j)-phb(i-2,k,j)) & - +(phb(i+3,k,j)-phb(i-3,k,j)) ) ) - ENDDO - - ENDDO - - IF ( (config_flags%open_xs) .and. its <= ids+1 ) THEN - i = ids + 1 - DO j = j_start, jtf - DO k = 2, kte-1 - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*( & - ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j) & - +muu(i,j )*(u(i,k,j )+u(i,k-1,j ))*msfux(i,j) )* (1./12.)*( & - 8.*(ph(i+1,k,j)-ph(i-1,k,j)) & - -(ph(i+2,k,j)-ph(i-2,k,j)) & - +8.*(phb(i+1,k,j)-phb(i-1,k,j)) & - -(phb(i+2,k,j)-phb(i-2,k,j)) ) ) - ENDDO - k = kte - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*( & - ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) & - +muu(i,j )*(cfn*u(i ,k-1,j)+cfn1*u(i,k-2,j))*msfux(i,j) )* (1./12.)*( & - 8.*(ph(i+1,k,j)-ph(i-1,k,j)) & - -(ph(i+2,k,j)-ph(i-2,k,j)) & - +8.*(phb(i+1,k,j)-phb(i-1,k,j)) & - -(phb(i+2,k,j)-phb(i-2,k,j)) ) ) - - ENDDO - END IF - - IF ( (config_flags%open_xe) .and. ite >= ide-2 ) THEN - i = ide-2 - DO j = j_start, jtf - DO k = 2, kte-1 - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.25*rdx/msfty(i,j))*( & - ( muu(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j) & - +muu(i,j )*(u(i,k,j )+u(i,k-1,j ))*msfux(i,j) )* (1./12.)*( & - 8.*(ph(i+1,k,j)-ph(i-1,k,j)) & - -(ph(i+2,k,j)-ph(i-2,k,j)) & - +8.*(phb(i+1,k,j)-phb(i-1,k,j)) & - -(phb(i+2,k,j)-phb(i-2,k,j)) ) ) - ENDDO - k = kte - ph_tend(i,k,j)=ph_tend(i,k,j) - (0.5*rdx/msfty(i,j))*( & - ( muu(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) & - +muu(i,j )*(cfn*u(i ,k-1,j)+cfn1*u(i,k-2,j))*msfux(i,j) )* (1./12.)*( & - 8.*(ph(i+1,k,j)-ph(i-1,k,j)) & - -(ph(i+2,k,j)-ph(i-2,k,j)) & - +8.*(phb(i+1,k,j)-phb(i-1,k,j)) & - -(phb(i+2,k,j)-phb(i-2,k,j)) ) ) - - ENDDO - END IF - - END IF - -! lateral open boundary conditions, -! start with north and south (y) boundaries - - i_start = its - itf=MIN(ite,ide-1) - - ! south - - IF ( (config_flags%open_ys) .and. jts == jds ) THEN - - j=jts - - DO k=2,kde - kz = min(k,kde-1) - DO i = its,itf - vb =.5*( fnm(kz)*(v(i,kz ,j+1)+v(i,kz ,j )) & - +fnp(kz)*(v(i,kz-1,j+1)+v(i,kz-1,j )) ) - vl=amin1(vb,0.) - ph_tend(i,k,j)=ph_tend(i,k,j)-rdy*mut(i,j)*( & - +vl*(ph_old(i,k,j+1)-ph_old(i,k,j))) - ENDDO - ENDDO - - END IF - - ! north - - IF ( (config_flags%open_ye) .and. jte == jde ) THEN - - j=jte-1 - - DO k=2,kde - kz = min(k,kde-1) - DO i = its,itf - vb=.5*( fnm(kz)*(v(i,kz ,j+1)+v(i,kz ,j)) & - +fnp(kz)*(v(i,kz-1,j+1)+v(i,kz-1,j)) ) - vr=amax1(vb,0.) - ph_tend(i,k,j)=ph_tend(i,k,j)-rdy*mut(i,j)*( & - +vr*(ph_old(i,k,j)-ph_old(i,k,j-1))) - ENDDO - ENDDO - - END IF - - ! now the east and west (y) boundaries - - j_start = its - jtf=MIN(jte,jde-1) - - ! west - - IF ( (config_flags%open_xs) .and. its == ids ) THEN - - i=its - - DO j = jts,jtf - DO k=2,kde-1 - kz = k - ub =.5*( fnm(kz)*(u(i+1,kz ,j)+u(i ,kz ,j)) & - +fnp(kz)*(u(i+1,kz-1,j)+u(i ,kz-1,j)) ) - ul=amin1(ub,0.) - ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*( & - +ul*(ph_old(i+1,k,j)-ph_old(i,k,j))) - ENDDO - - k = kde - kz = k - ub =.5*( fnm(kz)*(u(i+1,kz ,j)+u(i ,kz ,j)) & - +fnp(kz)*(u(i+1,kz-1,j)+u(i ,kz-1,j)) ) - ul=amin1(ub,0.) - ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*( & - +ul*(ph_old(i+1,k,j)-ph_old(i,k,j))) - ENDDO - - END IF - - ! east - - IF ( (config_flags%open_xe) .and. ite == ide ) THEN - - i = ite-1 - - DO j = jts,jtf - DO k=2,kde-1 - kz = k - ub=.5*( fnm(kz)*(u(i+1,kz ,j)+u(i,kz ,j)) & - +fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)) ) - ur=amax1(ub,0.) - ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*( & - +ur*(ph_old(i,k,j)-ph_old(i-1,k,j))) - ENDDO - - k = kde - kz = k-1 - ub=.5*( fnm(kz)*(u(i+1,kz ,j)+u(i,kz ,j)) & - +fnp(kz)*(u(i+1,kz-1,j)+u(i,kz-1,j)) ) - ur=amax1(ub,0.) - ph_tend(i,k,j)=ph_tend(i,k,j)-(msftx(i,j)/msfty(i,j))*rdx*mut(i,j)*( & - +ur*(ph_old(i,k,j)-ph_old(i-1,k,j))) - - ENDDO - - END IF - - END SUBROUTINE rhs_ph - - -!------------------------------------------------------------------------------- - -SUBROUTINE horizontal_pressure_gradient( ru_tend,rv_tend, & - ph,alt,p,pb,al,php,cqu,cqv, & - muu,muv,mu,fnm,fnp,rdnw, & - cf1,cf2,cf3,rdx,rdy,msfux,msfuy,& - msfvx,msfvy,msftx,msfty, & - config_flags, non_hydrostatic, & - top_lid, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - LOGICAL, INTENT (IN ) :: non_hydrostatic, top_lid - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN ) :: & - ph, & - alt, & - al, & - p, & - pb, & - php, & - cqu, & - cqv - - - REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) :: & - ru_tend, & - rv_tend - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: muu, muv, mu, & - msfux, msfuy, & - msfvx, msfvy, & - msftx, msfty - - REAL, DIMENSION( kms:kme ), INTENT(IN ) :: rdnw, fnm, fnp - - REAL, INTENT(IN ) :: rdx, rdy, cf1, cf2, cf3 - - INTEGER :: i,j,k, itf, jtf, ktf, i_start, j_start - REAL, DIMENSION( ims:ime, kms:kme ) :: dpn - REAL :: dpx, dpy - - LOGICAL :: specified - -! -! -! horizontal_pressure_gradient calculates the -! horizontal pressure gradient terms for the large-timestep tendency -! in the horizontal momentum equations (u,v). -! -! - - specified = .false. - if(config_flags%specified .or. config_flags%nested) specified = .true. - -! Notes on map scale factors: -! Calculates the pressure gradient terms in ADT eqns 44 and 45 -! With upper rho -> 'mu', these are: -! Eqn 30: -mu*(mx/my)*(1/rho)*partial dp/dx -! Eqn 31: -mu*(my/mx)*(1/rho)*partial dp/dy -! -! As we are on nu, rather than height, surfaces: -! -! mu dp/dx = mu alpha partial dp'/dx + (nu mu partial dmubar/dx) alpha' -! + mu partial dphi'/dx + (partial dphi/dx)*(partial dp'/dnu - mu') -! -! mu dp/dy = mu alpha partial dp'/dy + (nu mu partial dmubar/dy) alpha' -! + mu partial dphi'/dy + (partial dphi/dy)*(partial dp'/dnu - mu') - -! start with the north-south (y) pressure gradient - - itf=MIN(ite,ide-1) - jtf=jte - ktf=MIN(kte,kde-1) - i_start = its - j_start = jts - IF ( (config_flags%open_ys .or. specified .or. & - config_flags%nested .or. config_flags%polar ) .and. jts == jds ) j_start = jts+1 - IF ( (config_flags%open_ye .or. specified .or. & - config_flags%nested .or. config_flags%polar ) .and. jte == jde ) jtf = jtf-1 - - DO j = j_start, jtf - - IF ( non_hydrostatic ) THEN - - k=1 - - DO i = i_start, itf - dpn(i,k) = .5*( cf1*(p(i,k ,j-1)+p(i,k ,j)) & - +cf2*(p(i,k+1,j-1)+p(i,k+1,j)) & - +cf3*(p(i,k+2,j-1)+p(i,k+2,j)) ) - dpn(i,kde) = 0. - ENDDO - IF (top_lid) THEN - DO i = i_start, itf - dpn(i,kde) = .5*( cf1*(p(i,kde-1,j-1)+p(i,kde-1,j)) & - +cf2*(p(i,kde-2,j-1)+p(i,kde-2,j)) & - +cf3*(p(i,kde-3,j-1)+p(i,kde-3,j)) ) - ENDDO - ENDIF - - DO k=2,ktf - DO i = i_start, itf - dpn(i,k) = .5*( fnm(k)*(p(i,k ,j-1)+p(i,k ,j)) & - +fnp(k)*(p(i,k-1,j-1)+p(i,k-1,j)) ) - END DO - END DO - -! ADT eqn 45: -mu*(my/mx)*(1/rho)*partial dp/dy -! [alt, al are 1/rho terms; muv, mu are NOT coupled] - DO K=1,ktf - DO i = i_start, itf - ! Here are mu dp/dy terms 1-3 - dpy = (msfvy(i,j)/msfvx(i,j))*.5*rdy*muv(i,j)*( & - (ph (i,k+1,j)-ph (i,k+1,j-1) + ph(i,k,j)-ph(i,k,j-1)) & - +(alt(i,k ,j)+alt(i,k ,j-1))*(p (i,k,j)-p (i,k,j-1)) & - +(al (i,k ,j)+al (i,k ,j-1))*(pb(i,k,j)-pb(i,k,j-1)) ) - ! Here is mu dp/dy term 4 - dpy = dpy + (msfvy(i,j)/msfvx(i,j))*rdy*(php(i,k,j)-php(i,k,j-1))* & - (rdnw(k)*(dpn(i,k+1)-dpn(i,k))-.5*(mu(i,j-1)+mu(i,j))) - rv_tend(i,k,j) = rv_tend(i,k,j)-cqv(i,k,j)*dpy - END DO - END DO - - ELSE - -! ADT eqn 45: -mu*(my/mx)*(1/rho)*partial dp/dy -! [alt, al are 1/rho terms; muv, mu are NOT coupled] - DO K=1,ktf - DO i = i_start, itf - ! Here are mu dp/dy terms 1-3; term 4 not needed if hydrostatic - dpy = (msfvy(i,j)/msfvx(i,j))*.5*rdy*muv(i,j)*( & - (ph (i,k+1,j)-ph (i,k+1,j-1) + ph(i,k,j)-ph(i,k,j-1)) & - +(alt(i,k ,j)+alt(i,k ,j-1))*(p (i,k,j)-p (i,k,j-1)) & - +(al (i,k ,j)+al (i,k ,j-1))*(pb(i,k,j)-pb(i,k,j-1)) ) - rv_tend(i,k,j) = rv_tend(i,k,j)-cqv(i,k,j)*dpy - END DO - END DO - - END IF - - ENDDO - -! now the east-west (x) pressure gradient - - itf=ite - jtf=MIN(jte,jde-1) - ktf=MIN(kte,kde-1) - i_start = its - j_start = jts - IF ( (config_flags%open_xs .or. specified .or. & - config_flags%nested ) .and. its == ids ) i_start = its+1 - IF ( (config_flags%open_xe .or. specified .or. & - config_flags%nested ) .and. ite == ide ) itf = itf-1 - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) itf=ite - - DO j = j_start, jtf - - IF ( non_hydrostatic ) THEN - - k=1 - - DO i = i_start, itf - dpn(i,k) = .5*( cf1*(p(i-1,k ,j)+p(i,k ,j)) & - +cf2*(p(i-1,k+1,j)+p(i,k+1,j)) & - +cf3*(p(i-1,k+2,j)+p(i,k+2,j)) ) - dpn(i,kde) = 0. - ENDDO - IF (top_lid) THEN - DO i = i_start, itf - dpn(i,kde) = .5*( cf1*(p(i-1,kde-1,j)+p(i,kde-1,j)) & - +cf2*(p(i-1,kde-2,j)+p(i,kde-2,j)) & - +cf3*(p(i-1,kde-3,j)+p(i,kde-3,j)) ) - ENDDO - ENDIF - - DO k=2,ktf - DO i = i_start, itf - dpn(i,k) = .5*( fnm(k)*(p(i-1,k ,j)+p(i,k ,j)) & - +fnp(k)*(p(i-1,k-1,j)+p(i,k-1,j)) ) - END DO - END DO - -! ADT eqn 44: -mu*(mx/my)*(1/rho)*partial dp/dx -! [alt, al are 1/rho terms; muu, mu are NOT coupled] - DO K=1,ktf - DO i = i_start, itf - ! Here are mu dp/dy terms 1-3 - dpx = (msfux(i,j)/msfuy(i,j))*.5*rdx*muu(i,j)*( & - (ph (i,k+1,j)-ph (i-1,k+1,j) + ph(i,k,j)-ph(i-1,k,j)) & - +(alt(i,k ,j)+alt(i-1,k ,j))*(p (i,k,j)-p (i-1,k,j)) & - +(al (i,k ,j)+al (i-1,k ,j))*(pb(i,k,j)-pb(i-1,k,j)) ) - ! Here is mu dp/dy term 4 - dpx = dpx + (msfux(i,j)/msfuy(i,j))*rdx*(php(i,k,j)-php(i-1,k,j))* & - (rdnw(k)*(dpn(i,k+1)-dpn(i,k))-.5*(mu(i-1,j)+mu(i,j))) - ru_tend(i,k,j) = ru_tend(i,k,j)-cqu(i,k,j)*dpx - END DO - END DO - - ELSE - -! ADT eqn 44: -mu*(mx/my)*(1/rho)*partial dp/dx -! [alt, al are 1/rho terms; muu, mu are NOT coupled] - DO K=1,ktf - DO i = i_start, itf - ! Here are mu dp/dy terms 1-3; term 4 not needed if hydrostatic - dpx = (msfux(i,j)/msfuy(i,j))*.5*rdx*muu(i,j)*( & - (ph (i,k+1,j)-ph (i-1,k+1,j) + ph(i,k,j)-ph(i-1,k,j)) & - +(alt(i,k ,j)+alt(i-1,k ,j))*(p (i,k,j)-p (i-1,k,j)) & - +(al (i,k ,j)+al (i-1,k ,j))*(pb(i,k,j)-pb(i-1,k,j)) ) - ru_tend(i,k,j) = ru_tend(i,k,j)-cqu(i,k,j)*dpx - END DO - END DO - - END IF - - ENDDO - -END SUBROUTINE horizontal_pressure_gradient - -!------------------------------------------------------------------------------- - -SUBROUTINE pg_buoy_w( rw_tend, p, cqw, mu, mub, & - rdnw, rdn, g, msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN ) :: p - REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) :: cqw - - - REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) :: rw_tend - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: mub, mu, msftx, msfty - - REAL, DIMENSION( kms:kme ), INTENT(IN ) :: rdnw, rdn - - REAL, INTENT(IN ) :: g - - INTEGER :: itf, jtf, i, j, k - REAL :: cq1, cq2 - - -! -! -! pg_buoy_w calculates the -! vertical pressure gradient and buoyancy terms for the large-timestep -! tendency in the vertical momentum equation. -! -! - -! BUOYANCY AND PRESSURE GRADIENT TERM IN W EQUATION AT TIME T - -! Map scale factor notes -! ADT eqn 46 RHS terms 6 and 7 (where 7 is "-rho g") -! Dividing by my, and using mu and nu (see Klemp et al. eqns 32, 40) -! term 6: +(g/my) partial dp'/dnu -! term 7: -(g/my) mu' -! -! For moisture-free atmosphere, cq1=1, cq2=0 -! => (1./msft(i,j)) * g * [rdn(k)*{p(i,k,j)-p(i,k-1,j)}-mu(i,j)] - - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - - DO j = jts,jtf - - k=kde - DO i=its,itf - cq1 = 1./(1.+cqw(i,k-1,j)) - cq2 = cqw(i,k-1,j)*cq1 - rw_tend(i,k,j) = rw_tend(i,k,j)+(1./msfty(i,j))*g*( & - cq1*2.*rdnw(k-1)*( -p(i,k-1,j)) & - -mu(i,j)-cq2*mub(i,j) ) - END DO - - DO k = 2, kde-1 - DO i = its,itf - cq1 = 1./(1.+cqw(i,k,j)) - cq2 = cqw(i,k,j)*cq1 - cqw(i,k,j) = cq1 - rw_tend(i,k,j) = rw_tend(i,k,j)+(1./msfty(i,j))*g*( & - cq1*rdn(k)*(p(i,k,j)-p(i,k-1,j)) & - -mu(i,j)-cq2*mub(i,j) ) - END DO - ENDDO - - - ENDDO - -END SUBROUTINE pg_buoy_w - -!------------------------------------------------------------------------------- - -SUBROUTINE w_damp( rw_tend, max_vert_cfl,max_horiz_cfl, & - u, v, ww, w, mut, rdnw, & - rdx, rdy, msfux, msfuy, & - msfvx, msfvy, dt, & - config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - USE module_llxy - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(IN ) :: u, v, ww, w - - REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) :: rw_tend - - REAL, INTENT(OUT) :: max_vert_cfl - REAL, INTENT(OUT) :: max_horiz_cfl - REAL :: horiz_cfl - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: mut - - REAL, DIMENSION( kms:kme ), INTENT(IN ) :: rdnw - - REAL, INTENT(IN) :: dt - REAL, INTENT(IN) :: rdx, rdy - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, msfuy - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfvx, msfvy - - REAL :: vert_cfl, cf_n, cf_d, maxdub, maxdeta - - INTEGER :: itf, jtf, i, j, k, maxi, maxj, maxk - INTEGER :: some - CHARACTER*512 :: temp - - CHARACTER (LEN=256) :: time_str - CHARACTER (LEN=256) :: grid_str - - integer :: total - REAL :: msfuxt , msfxffl - -! -! -! w_damp computes a damping term for the vertical velocity when the -! vertical Courant number is too large. This was found to be preferable to -! decreasing the timestep or increasing the diffusion in real-data applications -! that produced potentially-unstable large vertical velocities because of -! unphysically large heating rates coming from the cumulus parameterization -! schemes run at moderately high resolutions (dx ~ O(10) km). -! -! Additionally, w_damp returns the maximum cfl values due to vertical motion and -! horizontal motion. These values are returned via the max_vert_cfl and -! max_horiz_cfl variables. (Added by T. Hutchinson, WSI, 3/5/2007) -! -! - - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - - some = 0 - max_vert_cfl = 0. - max_horiz_cfl = 0. - total = 0 - - IF(config_flags%map_proj == PROJ_CASSINI ) then - msfxffl = 1.0/COS(config_flags%fft_filter_lat*degrad) - END IF - - IF ( config_flags%w_damping == 1 ) THEN - DO j = jts,jtf - - DO k = 2, kde-1 - DO i = its,itf -#if 1 - IF(config_flags%map_proj == PROJ_CASSINI ) then - msfuxt = MIN(msfux(i,j), msfxffl) - ELSE - msfuxt = msfux(i,j) - END IF - vert_cfl = abs(ww(i,k,j)/mut(i,j)*rdnw(k)*dt) - - IF ( vert_cfl > max_vert_cfl ) THEN - max_vert_cfl = vert_cfl ; maxi = i ; maxj = j ; maxk = k - maxdub = w(i,k,j) ; maxdeta = -1./rdnw(k) - ENDIF - - horiz_cfl = max( abs(u(i,k,j) * rdx * msfuxt * dt), & - abs(v(i,k,j) * rdy * msfvy(i,j) * dt) ) - if (horiz_cfl > max_horiz_cfl) then - max_horiz_cfl = horiz_cfl - endif - - if(vert_cfl .gt. w_beta)then -#else -! restructure to get rid of divide -! -! This had been used for efficiency, but with the addition of returning the cfl values, -! the old version (above) was reinstated. (T. Hutchinson, 3/5/2007) -! - cf_n = abs(ww(i,k,j)*rdnw(k)*dt) - cf_d = abs(mut(i,j)) - if(cf_n .gt. cf_d*w_beta )then -#endif - - WRITE(temp,*)i,j,k,' vert_cfl,w,d(eta)=',vert_cfl,w(i,k,j),-1./rdnw(k) - CALL wrf_debug ( 100 , TRIM(temp) ) - if ( vert_cfl > 2. ) some = some + 1 - rw_tend(i,k,j) = rw_tend(i,k,j)-sign(1.,w(i,k,j))*w_alpha*(vert_cfl-w_beta)*mut(i,j) - endif - END DO - ENDDO - ENDDO - ELSE -! just print - DO j = jts,jtf - - DO k = 2, kde-1 - DO i = its,itf - -#if 1 - IF(config_flags%map_proj == PROJ_CASSINI ) then - msfuxt = MIN(msfux(i,j), msfxffl) - ELSE - msfuxt = msfux(i,j) - END IF - vert_cfl = abs(ww(i,k,j)/mut(i,j)*rdnw(k)*dt) - - IF ( vert_cfl > max_vert_cfl ) THEN - max_vert_cfl = vert_cfl ; maxi = i ; maxj = j ; maxk = k - maxdub = w(i,k,j) ; maxdeta = -1./rdnw(k) - ENDIF - - horiz_cfl = max( abs(u(i,k,j) * rdx * msfuxt * dt), & - abs(v(i,k,j) * rdy * msfvy(i,j) * dt) ) - - if (horiz_cfl > max_horiz_cfl) then - max_horiz_cfl = horiz_cfl - endif - - if(vert_cfl .gt. w_beta)then -#else -! restructure to get rid of divide -! -! This had been used for efficiency, but with the addition of returning the cfl values, -! the old version (above) was reinstated. (T. Hutchinson, 3/5/2007) -! - cf_n = abs(ww(i,k,j)*rdnw(k)*dt) - cf_d = abs(mut(i,j)) - if(cf_n .gt. cf_d*w_beta )then -#endif - WRITE(temp,*)i,j,k,' vert_cfl,w,d(eta)=',vert_cfl,w(i,k,j),-1./rdnw(k) - CALL wrf_debug ( 100 , TRIM(temp) ) - if ( vert_cfl > 2. ) some = some + 1 - endif - END DO - ENDDO - ENDDO - ENDIF - IF ( some .GT. 0 ) THEN - CALL get_current_time_string( time_str ) - CALL get_current_grid_name( grid_str ) - WRITE(wrf_err_message,*)some, & - ' points exceeded cfl=2 in domain '//TRIM(grid_str)//' at time '//TRIM(time_str)//' hours' - CALL wrf_debug ( 0 , TRIM(wrf_err_message) ) - WRITE(wrf_err_message,*)'MAX AT i,j,k: ',maxi,maxj,maxk,' vert_cfl,w,d(eta)=',max_vert_cfl, & - maxdub,maxdeta - CALL wrf_debug ( 0 , TRIM(wrf_err_message) ) - ENDIF - -END SUBROUTINE w_damp - -!------------------------------------------------------------------------------- - -SUBROUTINE horizontal_diffusion ( name, field, tendency, mu, & - config_flags, & - msfux, msfuy, msfvx, msfvx_inv, & - msfvy, msftx, msfty, & - khdif, xkmhd, rdx, rdy, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - CHARACTER(LEN=1) , INTENT(IN ) :: name - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: field, xkmhd - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & - msfuy, & - msfvx, & - msfvx_inv, & - msfvy, & - msftx, & - msfty - - REAL , INTENT(IN ) :: rdx, & - rdy, & - khdif - - ! Local data - - INTEGER :: i, j, k, itf, jtf, ktf - - INTEGER :: i_start, i_end, j_start, j_end - - REAL :: mrdx, mkrdxm, mkrdxp, & - mrdy, mkrdym, mkrdyp - - LOGICAL :: specified - -! -! -! horizontal_diffusion computes the horizontal diffusion tendency -! on model horizontal coordinate surfaces. -! -! - - specified = .false. - if(config_flags%specified .or. config_flags%nested) specified = .true. - - ktf=MIN(kte,kde-1) - - IF (name .EQ. 'u') THEN - - i_start = its - i_end = ite - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-1,ite) - IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. specified ) j_end = MIN(jde-2,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = ite - - - DO j = j_start, j_end - DO k=kts,ktf - DO i = i_start, i_end - - ! The interior is grad: (m_x*d/dx), the exterior is div: (m_x*m_y*d/dx(/m_y)) - ! setting up different averagings of m^2 partial d/dX and m^2 partial d/dY - - mkrdxm=(msftx(i-1,j)/msfty(i-1,j))*mu(i-1,j)*xkmhd(i-1,k,j)*rdx - mkrdxp=(msftx(i,j)/msfty(i,j))*mu(i,j)*xkmhd(i,k,j)*rdx - mrdx=msfux(i,j)*msfuy(i,j)*rdx - mkrdym=( (msfuy(i,j)+msfuy(i,j-1))/(msfux(i,j)+msfux(i,j-1)) )* & - 0.25*(mu(i,j)+mu(i,j-1)+mu(i-1,j-1)+mu(i-1,j))* & - 0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i-1,k,j-1)+xkmhd(i-1,k,j))*rdy - mkrdyp=( (msfuy(i,j)+msfuy(i,j+1))/(msfux(i,j)+msfux(i,j+1)) )* & - 0.25*(mu(i,j)+mu(i,j+1)+mu(i-1,j+1)+mu(i-1,j))* & - 0.25*(xkmhd(i,k,j)+xkmhd(i,k,j+1)+xkmhd(i-1,k,j+1)+xkmhd(i-1,k,j))*rdy - ! need to do four-corners (t) for diffusion coefficient as there are - ! no values at u,v points - ! msfuy - has to be y as part of d/dY - ! has to be u as we're at a u point - mrdy=msfux(i,j)*msfuy(i,j)*rdy - - ! correctly averaged version of rho~ * m^2 * - ! [partial d/dX(partial du^/dX) + partial d/dY(partial du^/dY)] - tendency(i,k,j)=tendency(i,k,j)+( & - mrdx*(mkrdxp*(field(i+1,k,j)-field(i ,k,j)) & - -mkrdxm*(field(i ,k,j)-field(i-1,k,j))) & - +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j )) & - -mkrdym*(field(i,k,j )-field(i,k,j-1)))) - ENDDO - ENDDO - ENDDO - - ELSE IF (name .EQ. 'v')THEN - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = jte - - IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-2,ite) - IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. specified ) j_end = MIN(jde-1,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) - IF ( config_flags%polar ) j_start = MAX(jds+1,jts) - IF ( config_flags%polar ) j_end = MIN(jde-1,jte) - - DO j = j_start, j_end - DO k=kts,ktf - DO i = i_start, i_end - - mkrdxm=( (msfvx(i,j)+msfvx(i-1,j))/(msfvy(i,j)+msfvy(i-1,j)) )* & - 0.25*(mu(i,j)+mu(i,j-1)+mu(i-1,j-1)+mu(i-1,j))* & - 0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i-1,k,j-1)+xkmhd(i-1,k,j))*rdx - mkrdxp=( (msfvx(i,j)+msfvx(i+1,j))/(msfvy(i,j)+msfvy(i+1,j)) )* & - 0.25*(mu(i,j)+mu(i,j-1)+mu(i+1,j-1)+mu(i+1,j))* & - 0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i+1,k,j-1)+xkmhd(i+1,k,j))*rdx - mrdx=msfvx(i,j)*msfvy(i,j)*rdx - mkrdym=(msfty(i,j-1)/msftx(i,j-1))*xkmhd(i,k,j-1)*rdy - mkrdyp=(msfty(i,j)/msftx(i,j))*xkmhd(i,k,j)*rdy - mrdy=msfvx(i,j)*msfvy(i,j)*rdy - - tendency(i,k,j)=tendency(i,k,j)+( & - mrdx*(mkrdxp*(field(i+1,k,j)-field(i ,k,j)) & - -mkrdxm*(field(i ,k,j)-field(i-1,k,j))) & - +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j )) & - -mkrdym*(field(i,k,j )-field(i,k,j-1)))) - ENDDO - ENDDO - ENDDO - - ELSE IF (name .EQ. 'w')THEN - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-2,ite) - IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. specified ) j_end = MIN(jde-2,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) - - DO j = j_start, j_end - DO k=kts+1,ktf - DO i = i_start, i_end - - mkrdxm=(msfux(i,j)/msfuy(i,j))* & - 0.25*(mu(i,j)+mu(i-1,j)+mu(i,j)+mu(i-1,j))* & - 0.25*(xkmhd(i,k,j)+xkmhd(i-1,k,j)+xkmhd(i,k-1,j)+xkmhd(i-1,k-1,j))*rdx - mkrdxp=(msfux(i+1,j)/msfuy(i+1,j))* & - 0.25*(mu(i+1,j)+mu(i,j)+mu(i+1,j)+mu(i,j))* & - 0.25*(xkmhd(i+1,k,j)+xkmhd(i,k,j)+xkmhd(i+1,k-1,j)+xkmhd(i,k-1,j))*rdx - mrdx=msftx(i,j)*msfty(i,j)*rdx -! mkrdym=(msfvy(i,j)/msfvx(i,j))* & - mkrdym=(msfvy(i,j)*msfvx_inv(i,j))* & - 0.25*(mu(i,j)+mu(i,j-1)+mu(i,j)+mu(i,j-1))* & - 0.25*(xkmhd(i,k,j)+xkmhd(i,k,j-1)+xkmhd(i,k-1,j)+xkmhd(i,k-1,j-1))*rdy -! mkrdyp=(msfvy(i,j+1)/msfvx(i,j+1))* & - mkrdyp=(msfvy(i,j+1)*msfvx_inv(i,j+1))* & - 0.25*(mu(i,j+1)+mu(i,j)+mu(i,j+1)+mu(i,j))* & - 0.25*(xkmhd(i,k,j+1)+xkmhd(i,k,j)+xkmhd(i,k-1,j+1)+xkmhd(i,k-1,j))*rdy - mrdy=msftx(i,j)*msfty(i,j)*rdy - - tendency(i,k,j)=tendency(i,k,j)+( & - mrdx*(mkrdxp*(field(i+1,k,j)-field(i ,k,j)) & - -mkrdxm*(field(i ,k,j)-field(i-1,k,j))) & - +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j )) & - -mkrdym*(field(i,k,j )-field(i,k,j-1)))) - ENDDO - ENDDO - ENDDO - - ELSE - - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-2,ite) - IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. specified ) j_end = MIN(jde-2,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) - - DO j = j_start, j_end - DO k=kts,ktf - DO i = i_start, i_end - - mkrdxm=(msfux(i,j)/msfuy(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*0.5*(mu(i,j)+mu(i-1,j))*rdx - mkrdxp=(msfux(i+1,j)/msfuy(i+1,j))*0.5*(xkmhd(i+1,k,j)+xkmhd(i,k,j))*0.5*(mu(i+1,j)+mu(i,j))*rdx - mrdx=msftx(i,j)*msfty(i,j)*rdx -! mkrdym=(msfvy(i,j)/msfvx(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy - mkrdym=(msfvy(i,j)*msfvx_inv(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy -! mkrdyp=(msfvy(i,j+1)/msfvx(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy - mkrdyp=(msfvy(i,j+1)*msfvx_inv(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy - mrdy=msftx(i,j)*msfty(i,j)*rdy - - tendency(i,k,j)=tendency(i,k,j)+( & - mrdx*(mkrdxp*(field(i+1,k,j)-field(i ,k,j)) & - -mkrdxm*(field(i ,k,j)-field(i-1,k,j))) & - +mrdy*(mkrdyp*(field(i,k,j+1)-field(i,k,j )) & - -mkrdym*(field(i,k,j )-field(i,k,j-1)))) - ENDDO - ENDDO - ENDDO - - ENDIF - -END SUBROUTINE horizontal_diffusion - -!----------------------------------------------------------------------------------------- - -SUBROUTINE horizontal_diffusion_3dmp ( name, field, tendency, mu, & - config_flags, base_3d, & - msfux, msfuy, msfvx, msfvx_inv, & - msfvy, msftx, msfty, & - khdif, xkmhd, rdx, rdy, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - CHARACTER(LEN=1) , INTENT(IN ) :: name - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: field, & - xkmhd, & - base_3d - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & - msfuy, & - msfvx, & - msfvx_inv, & - msfvy, & - msftx, & - msfty - - REAL , INTENT(IN ) :: rdx, & - rdy, & - khdif - - ! Local data - - INTEGER :: i, j, k, itf, jtf, ktf - - INTEGER :: i_start, i_end, j_start, j_end - - REAL :: mrdx, mkrdxm, mkrdxp, & - mrdy, mkrdym, mkrdyp - - LOGICAL :: specified - -! -! -! horizontal_diffusion_3dmp computes the horizontal diffusion tendency -! on model horizontal coordinate surfaces. This routine computes diffusion -! a perturbation scalar (field-base_3d). -! -! - - specified = .false. - if(config_flags%specified .or. config_flags%nested) specified = .true. - - ktf=MIN(kte,kde-1) - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-2,ite) - IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. specified ) j_end = MIN(jde-2,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) - - DO j = j_start, j_end - DO k=kts,ktf - DO i = i_start, i_end - - mkrdxm=(msfux(i,j)/msfuy(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*0.5*(mu(i,j)+mu(i-1,j))*rdx - mkrdxp=(msfux(i+1,j)/msfuy(i+1,j))*0.5*(xkmhd(i+1,k,j)+xkmhd(i,k,j))*0.5*(mu(i+1,j)+mu(i,j))*rdx - mrdx=msftx(i,j)*msfty(i,j)*rdx -! mkrdym=(msfvy(i,j)/msfvx(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy -! mkrdyp=(msfvy(i,j+1)/msfvx(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy - mkrdym=(msfvy(i,j)*msfvx_inv(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(mu(i,j)+mu(i,j-1))*rdy - mkrdyp=(msfvy(i,j+1)*msfvx_inv(i,j+1))*0.5*(xkmhd(i,k,j+1)+xkmhd(i,k,j))*0.5*(mu(i,j+1)+mu(i,j))*rdy - mrdy=msftx(i,j)*msfty(i,j)*rdy - - tendency(i,k,j)=tendency(i,k,j)+( & - mrdx*( mkrdxp*( field(i+1,k,j) -field(i ,k,j) & - -base_3d(i+1,k,j)+base_3d(i ,k,j) ) & - -mkrdxm*( field(i ,k,j) -field(i-1,k,j) & - -base_3d(i ,k,j)+base_3d(i-1,k,j) ) ) & - +mrdy*( mkrdyp*( field(i,k,j+1) -field(i,k,j ) & - -base_3d(i,k,j+1)+base_3d(i,k,j ) ) & - -mkrdym*( field(i,k,j ) -field(i,k,j-1) & - -base_3d(i,k,j )+base_3d(i,k,j-1) ) ) & - ) - ENDDO - ENDDO - ENDDO - -END SUBROUTINE horizontal_diffusion_3dmp - -!----------------------------------------------------------------------------------------- - -SUBROUTINE vertical_diffusion ( name, field, tendency, & - config_flags, & - alt, mut, rdn, rdnw, kvdif, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - CHARACTER(LEN=1) , INTENT(IN ) :: name - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & - INTENT(IN ) :: field, & - alt - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, rdnw - - REAL , INTENT(IN ) :: kvdif - - ! Local data - - INTEGER :: i, j, k, itf, jtf, ktf - INTEGER :: i_start, i_end, j_start, j_end - - REAL , DIMENSION(its:ite, jts:jte) :: vfluxm, vfluxp, zz - REAL , DIMENSION(its:ite, 0:kte+1) :: vflux - - REAL :: rdz - - LOGICAL :: specified - -! -! -! vertical_diffusion -! computes vertical diffusion tendency. -! -! - - specified = .false. - if(config_flags%specified .or. config_flags%nested) specified = .true. - - ktf=MIN(kte,kde-1) - - IF (name .EQ. 'w')THEN - - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - -j_loop_w : DO j = j_start, j_end - - DO k=kts,ktf-1 - DO i = i_start, i_end - vflux(i,k)= (kvdif/alt(i,k,j))*rdnw(k)*(field(i,k+1,j)-field(i,k,j)) - ENDDO - ENDDO - - DO i = i_start, i_end - vflux(i,ktf)=0. - ENDDO - - DO k=kts+1,ktf - DO i = i_start, i_end - tendency(i,k,j)=tendency(i,k,j) & - +rdn(k)*g*g/mut(i,j)/(0.5*(alt(i,k,j)+alt(i,k-1,j))) & - *(vflux(i,k)-vflux(i,k-1)) - ENDDO - ENDDO - - ENDDO j_loop_w - - ELSE IF(name .EQ. 'm')THEN - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - -j_loop_s : DO j = j_start, j_end - - DO k=kts,ktf-1 - DO i = i_start, i_end - vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))) & - *(field(i,k+1,j)-field(i,k,j)) - ENDDO - ENDDO - - DO i = i_start, i_end - vflux(i,0)=vflux(i,1) - ENDDO - - DO i = i_start, i_end - vflux(i,ktf)=0. - ENDDO - - DO k=kts,ktf - DO i = i_start, i_end - tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j) & - *rdnw(k)*(vflux(i,k)-vflux(i,k-1)) - ENDDO - ENDDO - - ENDDO j_loop_s - - ENDIF - -END SUBROUTINE vertical_diffusion - - -!------------------------------------------------------------------------------- - -SUBROUTINE vertical_diffusion_mp ( field, tendency, config_flags, & - base, & - alt, mut, rdn, rdnw, kvdif, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & - INTENT(IN ) :: field, & - alt - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, & - rdnw, & - base - - REAL , INTENT(IN ) :: kvdif - - ! Local data - - INTEGER :: i, j, k, itf, jtf, ktf - INTEGER :: i_start, i_end, j_start, j_end - - REAL , DIMENSION(its:ite, 0:kte+1) :: vflux - - REAL :: rdz - - LOGICAL :: specified - -! -! -! vertical_diffusion_mp -! computes vertical diffusion tendency of a perturbation variable -! (field-base). Note that base as a 1D (k) field. -! -! - - specified = .false. - if(config_flags%specified .or. config_flags%nested) specified = .true. - - ktf=MIN(kte,kde-1) - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - -j_loop_s : DO j = j_start, j_end - - DO k=kts,ktf-1 - DO i = i_start, i_end - vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))) & - *(field(i,k+1,j)-field(i,k,j)-base(k+1)+base(k)) - ENDDO - ENDDO - - DO i = i_start, i_end - vflux(i,0)=vflux(i,1) - ENDDO - - DO i = i_start, i_end - vflux(i,ktf)=0. - ENDDO - - DO k=kts,ktf - DO i = i_start, i_end - tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j) & - *rdnw(k)*(vflux(i,k)-vflux(i,k-1)) - ENDDO - ENDDO - - ENDDO j_loop_s - -END SUBROUTINE vertical_diffusion_mp - - -!------------------------------------------------------------------------------- - -SUBROUTINE vertical_diffusion_3dmp ( field, tendency, config_flags, & - base_3d, & - alt, mut, rdn, rdnw, kvdif, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & - INTENT(IN ) :: field, & - alt, & - base_3d - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, & - rdnw - - REAL , INTENT(IN ) :: kvdif - - ! Local data - - INTEGER :: i, j, k, itf, jtf, ktf - INTEGER :: i_start, i_end, j_start, j_end - - REAL , DIMENSION(its:ite, 0:kte+1) :: vflux - - REAL :: rdz - - LOGICAL :: specified - -! -! -! vertical_diffusion_3dmp -! computes vertical diffusion tendency of a perturbation variable -! (field-base_3d). -! -! - - specified = .false. - if(config_flags%specified .or. config_flags%nested) specified = .true. - - ktf=MIN(kte,kde-1) - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - -j_loop_s : DO j = j_start, j_end - - DO k=kts,ktf-1 - DO i = i_start, i_end - vflux(i,k)=kvdif*rdn(k+1)/(0.5*(alt(i,k,j)+alt(i,k+1,j))) & - *( field(i,k+1,j) -field(i,k,j) & - -base_3d(i,k+1,j)+base_3d(i,k,j) ) - ENDDO - ENDDO - - DO i = i_start, i_end - vflux(i,0)=vflux(i,1) - ENDDO - - DO i = i_start, i_end - vflux(i,ktf)=0. - ENDDO - - DO k=kts,ktf - DO i = i_start, i_end - tendency(i,k,j)=tendency(i,k,j)+g*g/mut(i,j)/alt(i,k,j) & - *rdnw(k)*(vflux(i,k)-vflux(i,k-1)) - ENDDO - ENDDO - - ENDDO j_loop_s - -END SUBROUTINE vertical_diffusion_3dmp - - -!------------------------------------------------------------------------------- - - -SUBROUTINE vertical_diffusion_u ( field, tendency, & - config_flags, u_base, & - alt, muu, rdn, rdnw, kvdif, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & - INTENT(IN ) :: field, & - alt - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: muu - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, rdnw, u_base - - REAL , INTENT(IN ) :: kvdif - - ! Local data - - INTEGER :: i, j, k, itf, jtf, ktf - INTEGER :: i_start, i_end, j_start, j_end - - REAL , DIMENSION(its:ite, 0:kte+1) :: vflux - - REAL :: rdz, zz - - LOGICAL :: specified - -! -! -! vertical_diffusion_u computes vertical diffusion tendency for -! the u momentum equation. This routine assumes a constant eddy -! viscosity kvdif. -! -! - - specified = .false. - if(config_flags%specified .or. config_flags%nested) specified = .true. - - ktf=MIN(kte,kde-1) - - i_start = its - i_end = ite - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .or. specified ) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. specified ) i_end = MIN(ide-1,ite) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = ite - - -j_loop_u : DO j = j_start, j_end - - DO k=kts,ktf-1 - DO i = i_start, i_end - vflux(i,k)=kvdif*rdn(k+1)/(0.25*( alt(i ,k ,j) & - +alt(i-1,k ,j) & - +alt(i ,k+1,j) & - +alt(i-1,k+1,j) ) ) & - *(field(i,k+1,j)-field(i,k,j) & - -u_base(k+1) +u_base(k) ) - ENDDO - ENDDO - - DO i = i_start, i_end - vflux(i,0)=vflux(i,1) - ENDDO - - DO i = i_start, i_end - vflux(i,ktf)=0. - ENDDO - - DO k=kts,ktf-1 - DO i = i_start, i_end - tendency(i,k,j)=tendency(i,k,j)+ & - g*g*rdnw(k)/muu(i,j)/(0.5*(alt(i-1,k,j)+alt(i,k,j)))* & - (vflux(i,k)-vflux(i,k-1)) - ENDDO - ENDDO - - ENDDO j_loop_u - -END SUBROUTINE vertical_diffusion_u - -!------------------------------------------------------------------------------- - - -SUBROUTINE vertical_diffusion_v ( field, tendency, & - config_flags, v_base, & - alt, muv, rdn, rdnw, kvdif, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & - INTENT(IN ) :: field, & - alt - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, rdnw, v_base - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: muv - - REAL , INTENT(IN ) :: kvdif - - ! Local data - - INTEGER :: i, j, k, itf, jtf, ktf, jm1 - INTEGER :: i_start, i_end, j_start, j_end - - REAL , DIMENSION(its:ite, 0:kte+1) :: vflux - - REAL :: rdz, zz - - LOGICAL :: specified - -! -! -! vertical_diffusion_v computes vertical diffusion tendency for -! the v momentum equation. This routine assumes a constant eddy -! viscosity kvdif. -! -! - - specified = .false. - if(config_flags%specified .or. config_flags%nested) specified = .true. - - ktf=MIN(kte,kde-1) - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_ys .or. specified ) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. specified ) j_end = MIN(jde-1,jte) - -j_loop_v : DO j = j_start, j_end -! jm1 = max(j-1,1) - jm1 = j-1 - - DO k=kts,ktf-1 - DO i = i_start, i_end - vflux(i,k)=kvdif*rdn(k+1)/(0.25*( alt(i,k ,j ) & - +alt(i,k ,jm1) & - +alt(i,k+1,j ) & - +alt(i,k+1,jm1) ) ) & - *(field(i,k+1,j)-field(i,k,j) & - -v_base(k+1) +v_base(k) ) - ENDDO - ENDDO - - DO i = i_start, i_end - vflux(i,0)=vflux(i,1) - ENDDO - - DO i = i_start, i_end - vflux(i,ktf)=0. - ENDDO - - DO k=kts,ktf-1 - DO i = i_start, i_end - tendency(i,k,j)=tendency(i,k,j)+ & - g*g*rdnw(k)/muv(i,j)/(0.5*(alt(i,k,jm1)+alt(i,k,j)))* & - (vflux(i,k)-vflux(i,k-1)) - ENDDO - ENDDO - - ENDDO j_loop_v - -END SUBROUTINE vertical_diffusion_v - -!*************** end new mass coordinate routines - -!------------------------------------------------------------------------------- - -SUBROUTINE calculate_full ( rfield, rfieldb, rfieldp, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: rfieldb, & - rfieldp - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT ) :: rfield - - ! Local indices. - - INTEGER :: i, j, k, itf, jtf, ktf - -! -! -! calculate_full -! calculates full 3D field from pertubation and base field. -! -! - - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - ktf=MIN(kte,kde-1) - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - rfield(i,k,j)=rfieldb(i,k,j)+rfieldp(i,k,j) - ENDDO - ENDDO - ENDDO - -END SUBROUTINE calculate_full - -!------------------------------------------------------------------------------ - -SUBROUTINE coriolis ( ru, rv, rw, ru_tend, rv_tend, rw_tend, & - config_flags, & - msftx, msfty, msfux, msfuy, & - msfvx, msfvy, & - f, e, sina, cosa, fzm, fzp, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: ru_tend, & - rv_tend, & - rw_tend - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: ru, & - rv, & - rw - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & - msfuy, & - msfvx, & - msfvy, & - msftx, & - msfty - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: f, & - e, & - sina, & - cosa - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & - fzp - - ! Local indices. - - INTEGER :: i, j , k, ktf - INTEGER :: i_start, i_end, j_start, j_end - - LOGICAL :: specified - -! -! -! coriolis calculates the large timestep tendency terms in the -! u, v, and w momentum equations arise from the coriolis force. -! -! - - specified = .false. - if(config_flags%specified .or. config_flags%nested) specified = .true. - - ktf=MIN(kte,kde-1) - -! coriolis for u-momentum equation - -! Notes on map scale factor -! cosa, sina are related to rotating the coordinate frame if desired -! generally sina=0, cosa=1 -! ADT eqn 44, RHS terms 6 and 7: -2 mu w omega cos(lat)/my -! + 2 mu v omega sin(lat)/my -! Define f=2 omega sin(lat), e=2 omega cos(lat) -! => terms are: -e mu w / my + f mu v / my -! rv = mu v / mx ; rw = mu w / my -! => terms are: -e rw + f rv *mx / my - - i_start = its - i_end = ite - IF ( config_flags%open_xs .or. specified .or. & - config_flags%nested) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. specified .or. & - config_flags%nested) i_end = MIN(ide-1,ite) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = ite - - DO j = jts, MIN(jte,jde-1) - - DO k=kts,ktf - DO i = i_start, i_end - - ru_tend(i,k,j)=ru_tend(i,k,j) + (msfux(i,j)/msfuy(i,j))*0.5*(f(i,j)+f(i-1,j)) & - *0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j)) & - - 0.5*(e(i,j)+e(i-1,j))*0.5*(cosa(i,j)+cosa(i-1,j)) & - *0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j)) - - ENDDO - ENDDO - - IF ( (config_flags%open_xs) .and. (its == ids) ) THEN - - DO k=kts,ktf - - ru_tend(its,k,j)=ru_tend(its,k,j) + (msfux(its,j)/msfuy(its,j))*0.5*(f(its,j)+f(its,j)) & - *0.25*(rv(its,k,j+1)+rv(its,k,j+1)+rv(its,k,j)+rv(its,k,j)) & - - 0.5*(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j)) & - *0.25*(rw(its,k+1,j)+rw(its,k,j)+rw(its,k+1,j)+rw(its,k,j)) - - ENDDO - - ENDIF - - IF ( (config_flags%open_xe) .and. (ite == ide) ) THEN - - DO k=kts,ktf - - ru_tend(ite,k,j)=ru_tend(ite,k,j) + (msfux(ite,j)/msfuy(ite,j))*0.5*(f(ite-1,j)+f(ite-1,j)) & - *0.25*(rv(ite-1,k,j+1)+rv(ite-1,k,j+1)+rv(ite-1,k,j)+rv(ite-1,k,j)) & - - 0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j)) & - *0.25*(rw(ite-1,k+1,j)+rw(ite-1,k,j)+rw(ite-1,k+1,j)+rw(ite-1,k,j)) - - ENDDO - - ENDIF - - ENDDO - -! coriolis term for v-momentum equation - -! Notes on map scale factors -! ADT eqn 45, RHS terms 6 and 6b [0 for sina=0]: -2 mu u omega sin(lat)/mx + ? -! Define f=2 omega sin(lat), e=2 omega cos(lat) -! => terms are: -f mu u / mx -! ru = mu u / my ; rw = mu w / my -! => terms are: -f ru *my / mx + ? - - j_start = jts - j_end = jte - - IF ( config_flags%open_ys .or. specified .or. & - config_flags%nested .or. config_flags%polar) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. specified .or. & - config_flags%nested .or. config_flags%polar) j_end = MIN(jde-1,jte) - - IF ( (config_flags%open_ys) .and. (jts == jds) ) THEN - - DO k=kts,ktf - DO i=its,MIN(ide-1,ite) - - rv_tend(i,k,jts)=rv_tend(i,k,jts) - (msfvy(i,jts)/msfvx(i,jts))*0.5*(f(i,jts)+f(i,jts)) & - *0.25*(ru(i,k,jts)+ru(i+1,k,jts)+ru(i,k,jts)+ru(i+1,k,jts)) & - + (msfvy(i,jts)/msfvx(i,jts))*0.5*(e(i,jts)+e(i,jts))*0.5*(sina(i,jts)+sina(i,jts)) & - *0.25*(rw(i,k+1,jts)+rw(i,k,jts)+rw(i,k+1,jts)+rw(i,k,jts)) - - ENDDO - ENDDO - - ENDIF - - DO j=j_start, j_end - DO k=kts,ktf - DO i=its,MIN(ide-1,ite) - - rv_tend(i,k,j)=rv_tend(i,k,j) - (msfvy(i,j)/msfvx(i,j))*0.5*(f(i,j)+f(i,j-1)) & - *0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) & - + (msfvy(i,j)/msfvx(i,j))*0.5*(e(i,j)+e(i,j-1))*0.5*(sina(i,j)+sina(i,j-1)) & - *0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j)) - - ENDDO - ENDDO - ENDDO - - - IF ( (config_flags%open_ye) .and. (jte == jde) ) THEN - - DO k=kts,ktf - DO i=its,MIN(ide-1,ite) - - rv_tend(i,k,jte)=rv_tend(i,k,jte) - (msfvy(i,jte)/msfvx(i,jte))*0.5*(f(i,jte-1)+f(i,jte-1)) & - *0.25*(ru(i,k,jte-1)+ru(i+1,k,jte-1)+ru(i,k,jte-1)+ru(i+1,k,jte-1)) & - + (msfvy(i,jte)/msfvx(i,jte))*0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i,jte-1)+sina(i,jte-1)) & - *0.25*(rw(i,k+1,jte-1)+rw(i,k,jte-1)+rw(i,k+1,jte-1)+rw(i,k,jte-1)) - - ENDDO - ENDDO - - ENDIF - -! coriolis term for w-mometum - -! Notes on map scale factors -! ADT eqn 46/my, RHS terms 5 and 5b [0 for sina=0]: 2 mu u omega cos(lat)/my +? -! Define e=2 omega cos(lat) -! => terms are: e mu u / my + ??? -! ru = mu u / my ; ru = mu v / mx -! => terms are: e ru + ??? - - DO j=jts,MIN(jte, jde-1) - DO k=kts+1,ktf - DO i=its,MIN(ite, ide-1) - - rw_tend(i,k,j)=rw_tend(i,k,j) + e(i,j)* & - (cosa(i,j)*0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j)) & - +fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j))) & - -(msftx(i,j)/msfty(i,j))* & - sina(i,j)*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1)) & - +fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1)))) - - ENDDO - ENDDO - ENDDO - -END SUBROUTINE coriolis - -!------------------------------------------------------------------------------ - -SUBROUTINE perturbation_coriolis ( ru_in, rv_in, rw, ru_tend, rv_tend, rw_tend, & - config_flags, & - u_base, v_base, z_base, & - muu, muv, phb, ph, & - msftx, msfty, msfux, msfuy, msfvx, msfvy, & - f, e, sina, cosa, fzm, fzp, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: ru_tend, & - rv_tend, & - rw_tend - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: ru_in, & - rv_in, & - rw, & - ph, & - phb - - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & - msfuy, & - msfvx, & - msfvy, & - msftx, & - msfty - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: f, & - e, & - sina, & - cosa - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: muu, & - muv - - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & - fzp - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: u_base, & - v_base, & - z_base - - ! Local storage - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: ru, & - rv - - REAL :: z_at_u, z_at_v, wkp1, wk, wkm1 - - ! Local indices. - - INTEGER :: i, j , k, ktf - INTEGER :: i_start, i_end, j_start, j_end - - LOGICAL :: specified - -! -! -! perturbation_coriolis calculates the large timestep tendency terms in the -! u, v, and w momentum equations arise from the coriolis force. This version -! subtracts off the horizontal velocities from the initial sounding when -! computing the forcing terms, hence "perturbation" coriolis. -! -! - - specified = .false. - if(config_flags%specified .or. config_flags%nested) specified = .true. - - ktf=MIN(kte,kde-1) - -! coriolis for u-momentum equation - - i_start = its - i_end = ite - IF ( config_flags%open_xs .or. specified .or. & - config_flags%nested) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. specified .or. & - config_flags%nested) i_end = MIN(ide-1,ite) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = ite - -! compute perturbation mu*v for use in u momentum equation - - DO j = jts, MIN(jte,jde-1)+1 - DO k=kts+1,ktf-1 - DO i = i_start-1, i_end - z_at_v = 0.25*( phb(i,k,j )+phb(i,k+1,j ) & - +phb(i,k,j-1)+phb(i,k+1,j-1) & - +ph(i,k,j )+ph(i,k+1,j ) & - +ph(i,k,j-1)+ph(i,k+1,j-1))/g - wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k))) - wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1))) - wk = 1.-wkp1-wkm1 - rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*( & - wkm1*v_base(k-1) & - +wk *v_base(k ) & - +wkp1*v_base(k+1) ) - ENDDO - ENDDO - ENDDO - - -! pick up top and bottom v - - DO j = jts, MIN(jte,jde-1)+1 - DO i = i_start-1, i_end - - k = kts - z_at_v = 0.25*( phb(i,k,j )+phb(i,k+1,j ) & - +phb(i,k,j-1)+phb(i,k+1,j-1) & - +ph(i,k,j )+ph(i,k+1,j ) & - +ph(i,k,j-1)+ph(i,k+1,j-1))/g - wkp1 = min(1.,max(0.,z_at_v-z_base(k))/(z_base(k+1)-z_base(k))) - wk = 1.-wkp1 - rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*( & - +wk *v_base(k ) & - +wkp1*v_base(k+1) ) - - k = ktf - z_at_v = 0.25*( phb(i,k,j )+phb(i,k+1,j ) & - +phb(i,k,j-1)+phb(i,k+1,j-1) & - +ph(i,k,j )+ph(i,k+1,j ) & - +ph(i,k,j-1)+ph(i,k+1,j-1))/g - wkm1 = min(1.,max(0.,z_base(k)-z_at_v)/(z_base(k)-z_base(k-1))) - wk = 1.-wkm1 - rv(i,k,j) = rv_in(i,k,j) - muv(i,j)*( & - wkm1*v_base(k-1) & - +wk *v_base(k ) ) - - ENDDO - ENDDO - -! compute coriolis forcing for u - -! Map scale factors: see comments above for Coriolis - - DO j = jts, MIN(jte,jde-1) - - DO k=kts,ktf - DO i = i_start, i_end - ru_tend(i,k,j)=ru_tend(i,k,j) + (msfux(i,j)/msfuy(i,j))*0.5*(f(i,j)+f(i-1,j)) & - *0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j)) & - - 0.5*(e(i,j)+e(i-1,j))*0.5*(cosa(i,j)+cosa(i-1,j)) & - *0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j)) - ENDDO - ENDDO - - IF ( (config_flags%open_xs) .and. (its == ids) ) THEN - - DO k=kts,ktf - - ru_tend(its,k,j)=ru_tend(its,k,j) + (msfux(its,j)/msfuy(its,j))*0.5*(f(its,j)+f(its,j)) & - *0.25*(rv(its,k,j+1)+rv(its,k,j+1)+rv(its,k,j)+rv(its,k,j)) & - - 0.5*(e(its,j)+e(its,j))*0.5*(cosa(its,j)+cosa(its,j)) & - *0.25*(rw(its,k+1,j)+rw(its,k,j)+rw(its,k+1,j)+rw(its,k,j)) - - ENDDO - - ENDIF - - IF ( (config_flags%open_xe) .and. (ite == ide) ) THEN - - DO k=kts,ktf - - ru_tend(ite,k,j)=ru_tend(ite,k,j) + (msfux(ite,j)/msfuy(ite,j))*0.5*(f(ite-1,j)+f(ite-1,j)) & - *0.25*(rv(ite-1,k,j+1)+rv(ite-1,k,j+1)+rv(ite-1,k,j)+rv(ite-1,k,j)) & - - 0.5*(e(ite-1,j)+e(ite-1,j))*0.5*(cosa(ite-1,j)+cosa(ite-1,j)) & - *0.25*(rw(ite-1,k+1,j)+rw(ite-1,k,j)+rw(ite-1,k+1,j)+rw(ite-1,k,j)) - - ENDDO - - ENDIF - - ENDDO - -! coriolis term for v-momentum equation -! Map scale factors: see comments above for Coriolis - - j_start = jts - j_end = jte - - IF ( config_flags%open_ys .or. specified .or. & - config_flags%nested .or. config_flags%polar) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. specified .or. & - config_flags%nested .or. config_flags%polar) j_end = MIN(jde-1,jte) - -! compute perturbation mu*u for use in v momentum equation - - DO j = j_start-1,j_end - DO k=kts+1,ktf-1 - DO i = its, MIN(ite,ide-1)+1 - z_at_u = 0.25*( phb(i ,k,j)+phb(i ,k+1,j) & - +phb(i-1,k,j)+phb(i-1,k+1,j) & - +ph(i ,k,j)+ph(i ,k+1,j) & - +ph(i-1,k,j)+ph(i-1,k+1,j))/g - wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k))) - wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1))) - wk = 1.-wkp1-wkm1 - ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*( & - wkm1*u_base(k-1) & - +wk *u_base(k ) & - +wkp1*u_base(k+1) ) - ENDDO - ENDDO - ENDDO - -! pick up top and bottom u - - DO j = j_start-1,j_end - DO i = its, MIN(ite,ide-1)+1 - - k = kts - z_at_u = 0.25*( phb(i ,k,j)+phb(i ,k+1,j) & - +phb(i-1,k,j)+phb(i-1,k+1,j) & - +ph(i ,k,j)+ph(i ,k+1,j) & - +ph(i-1,k,j)+ph(i-1,k+1,j))/g - wkp1 = min(1.,max(0.,z_at_u-z_base(k))/(z_base(k+1)-z_base(k))) - wk = 1.-wkp1 - ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*( & - +wk *u_base(k ) & - +wkp1*u_base(k+1) ) - - - k = ktf - z_at_u = 0.25*( phb(i ,k,j)+phb(i ,k+1,j) & - +phb(i-1,k,j)+phb(i-1,k+1,j) & - +ph(i ,k,j)+ph(i ,k+1,j) & - +ph(i-1,k,j)+ph(i-1,k+1,j))/g - wkm1 = min(1.,max(0.,z_base(k)-z_at_u)/(z_base(k)-z_base(k-1))) - wk = 1.-wkm1 - ru(i,k,j) = ru_in(i,k,j) - muu(i,j)*( & - wkm1*u_base(k-1) & - +wk *u_base(k ) ) - - ENDDO - ENDDO - -! compute coriolis forcing for v momentum equation -! Map scale factors: see comments above for Coriolis - - IF ( (config_flags%open_ys) .and. (jts == jds) ) THEN - - DO k=kts,ktf - DO i=its,MIN(ide-1,ite) - - rv_tend(i,k,jts)=rv_tend(i,k,jts) - (msfvy(i,jts)/msfvx(i,jts))*0.5*(f(i,jts)+f(i,jts)) & - *0.25*(ru(i,k,jts)+ru(i+1,k,jts)+ru(i,k,jts)+ru(i+1,k,jts)) & - + (msfvy(i,jts)/msfvx(i,jts))*0.5*(e(i,jts)+e(i,jts))*0.5*(sina(i,jts)+sina(i,jts)) & - *0.25*(rw(i,k+1,jts)+rw(i,k,jts)+rw(i,k+1,jts)+rw(i,k,jts)) - - ENDDO - ENDDO - - ENDIF - - DO j=j_start, j_end - DO k=kts,ktf - DO i=its,MIN(ide-1,ite) - - rv_tend(i,k,j)=rv_tend(i,k,j) - (msfvy(i,j)/msfvx(i,j))*0.5*(f(i,j)+f(i,j-1)) & - *0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) & - + (msfvy(i,j)/msfvx(i,j))*0.5*(e(i,j)+e(i,j-1))*0.5*(sina(i,j)+sina(i,j-1)) & - *0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j)) - - ENDDO - ENDDO - ENDDO - - - IF ( (config_flags%open_ye) .and. (jte == jde) ) THEN - - DO k=kts,ktf - DO i=its,MIN(ide-1,ite) - - rv_tend(i,k,jte)=rv_tend(i,k,jte) - (msfvy(i,jte)/msfvx(i,jte))*0.5*(f(i,jte-1)+f(i,jte-1)) & - *0.25*(ru(i,k,jte-1)+ru(i+1,k,jte-1)+ru(i,k,jte-1)+ru(i+1,k,jte-1)) & - + (msfvy(i,jte)/msfvx(i,jte))*0.5*(e(i,jte-1)+e(i,jte-1))*0.5*(sina(i,jte-1)+sina(i,jte-1)) & - *0.25*(rw(i,k+1,jte-1)+rw(i,k,jte-1)+rw(i,k+1,jte-1)+rw(i,k,jte-1)) - - ENDDO - ENDDO - - ENDIF - -! coriolis term for w-mometum -! Map scale factors: see comments above for Coriolis - - DO j=jts,MIN(jte, jde-1) - DO k=kts+1,ktf - DO i=its,MIN(ite, ide-1) - - rw_tend(i,k,j)=rw_tend(i,k,j) + e(i,j)* & - (cosa(i,j)*0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j)) & - +fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j))) & - -(msftx(i,j)/msfty(i,j))*sina(i,j)*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1)) & - +fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1)))) - - ENDDO - ENDDO - ENDDO - -END SUBROUTINE perturbation_coriolis - -!------------------------------------------------------------------------------ - -SUBROUTINE curvature ( ru, rv, rw, u, v, w, ru_tend, rv_tend, rw_tend, & - config_flags, & - msfux, msfuy, msfvx, msfvy, msftx, msfty, & - xlat, fzm, fzp, rdx, rdy, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & - INTENT(INOUT) :: ru_tend, & - rv_tend, & - rw_tend - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & - INTENT(IN ) :: ru, & - rv, & - rw, & - u, & - v, & - w - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & - msfuy, & - msfvx, & - msfvy, & - msftx, & - msfty, & - xlat - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & - fzp - - REAL , INTENT(IN ) :: rdx, & - rdy - - ! Local data - -! INTEGER :: i, j, k, itf, jtf, ktf, kp1, im, ip, jm, jp - INTEGER :: i, j, k, itf, jtf, ktf - INTEGER :: i_start, i_end, j_start, j_end -! INTEGER :: irmin, irmax, jrmin, jrmax - - REAL , DIMENSION( its-1:ite , kts:kte, jts-1:jte ) :: vxgm - - LOGICAL :: specified - -! -! -! curvature calculates the large timestep tendency terms in the -! u, v, and w momentum equations arise from the curvature terms. -! -! - - specified = .false. - if(config_flags%specified .or. config_flags%nested) specified = .true. - - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - ktf=MIN(kte,kde-1) - -! irmin = ims -! irmax = ime -! jrmin = jms -! jrmax = jme -! IF ( config_flags%open_xs ) irmin = ids -! IF ( config_flags%open_xe ) irmax = ide-1 -! IF ( config_flags%open_ys ) jrmin = jds -! IF ( config_flags%open_ye ) jrmax = jde-1 - -! Define v cross grad m at scalar points - vxgm(i,j) - - i_start = its-1 - i_end = ite - j_start = jts-1 - j_end = jte - - IF ( ( config_flags%open_xs .or. specified .or. & - config_flags%nested) .and. (its == ids) ) i_start = its - IF ( ( config_flags%open_xe .or. specified .or. & - config_flags%nested) .and. (ite == ide) ) i_end = ite-1 - IF ( ( config_flags%open_ys .or. specified .or. & - config_flags%nested .or. config_flags%polar) .and. (jts == jds) ) j_start = jts - IF ( ( config_flags%open_ye .or. specified .or. & - config_flags%nested .or. config_flags%polar) .and. (jte == jde) ) j_end = jte-1 - IF ( config_flags%periodic_x ) i_start = its-1 - IF ( config_flags%periodic_x ) i_end = ite - - DO j=j_start, j_end - DO k=kts,ktf - DO i=i_start, i_end -! Map scale factor notes: -! msf...y is constant everywhere for cylindrical map projection -! msf...x varies with y only -! But we know that this is not = 0 for cylindrical, -! therefore use msfvX in 1st line -! which => by symmetry use msfuY in 2nd line - ??? - vxgm(i,k,j)=0.5*(u(i,k,j)+u(i+1,k,j))*(msfvx(i,j+1)-msfvx(i,j))*rdy - & - 0.5*(v(i,k,j)+v(i,k,j+1))*(msfuy(i+1,j)-msfuy(i,j))*rdx - ENDDO - ENDDO - ENDDO - -! Pick up the boundary rows for open (radiation) lateral b.c. -! Rather crude at present, we are assuming there is no -! variation in this term at the boundary. - - IF ( ( config_flags%open_xs .or. (specified .AND. .NOT. config_flags%periodic_x) .or. & - config_flags%nested) .and. (its == ids) ) THEN - - DO j = jts, jte-1 - DO k = kts, ktf - vxgm(its-1,k,j) = vxgm(its,k,j) - ENDDO - ENDDO - - ENDIF - - IF ( ( config_flags%open_xe .or. (specified .AND. .NOT. config_flags%periodic_x) .or. & - config_flags%nested) .and. (ite == ide) ) THEN - - DO j = jts, jte-1 - DO k = kts, ktf - vxgm(ite,k,j) = vxgm(ite-1,k,j) - ENDDO - ENDDO - - ENDIF - -! Polar boundary condition: -! The following change is needed in case one tries using the vxgm route with -! polar B.C.'s in the future, but not needed if 'tan' used - IF ( ( config_flags%open_ys .or. specified .or. & - config_flags%nested .or. config_flags%polar) .and. (jts == jds) ) THEN - - DO k = kts, ktf - DO i = its-1, ite - vxgm(i,k,jts-1) = vxgm(i,k,jts) - ENDDO - ENDDO - - ENDIF - -! Polar boundary condition: -! The following change is needed in case one tries using the vxgm route with -! polar B.C.'s in the future, but not needed if 'tan' used - IF ( ( config_flags%open_ye .or. specified .or. & - config_flags%nested .or. config_flags%polar) .and. (jte == jde) ) THEN - - DO k = kts, ktf - DO i = its-1, ite - vxgm(i,k,jte) = vxgm(i,k,jte-1) - ENDDO - ENDDO - - ENDIF - -! curvature term for u momentum eqn. - -! Map scale factor notes: -! ADT eqn 44, RHS terms 4 and 5, in cylindrical: mu u v tan(lat)/(a my) -! - mu u w /(a my) -! ru = mu u / my ; rw = mu w / my ; rv = mu v / mx -! => terms are: -! (mx/my)*u rv tan(lat) / a - u rw / a = (u/a)*[(mx/my) rv tan(lat) - rw] -! ru v tan(lat) / a - u rw / a -! xlat defined with end points half grid space from pole, -! hence are on u latitude points - - i_start = its - IF ( config_flags%open_xs .or. specified .or. & - config_flags%nested) i_start = MAX ( ids+1 , its ) - IF ( config_flags%open_xe .or. specified .or. & - config_flags%nested) i_end = MIN ( ide-1 , ite ) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = ite - -! Polar boundary condition - IF ((config_flags%map_proj == 6) .OR. (config_flags%polar)) THEN - - DO j=jts,MIN(jde-1,jte) - DO k=kts,ktf - DO i=i_start,i_end - - ru_tend(i,k,j)=ru_tend(i,k,j) + u(i,k,j)*reradius* ( & - (msfux(i,j)/msfuy(i,j))*0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+ & - rv(i-1,k,j)+rv(i,k,j))*tan(xlat(i,j)*degrad) & - - 0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j)) ) - ENDDO - ENDDO - ENDDO - - ELSE ! normal code - - - DO j=jts,MIN(jde-1,jte) - DO k=kts,ktf - DO i=i_start,i_end - - ru_tend(i,k,j)=ru_tend(i,k,j) + 0.5*(vxgm(i,k,j)+vxgm(i-1,k,j)) & - *0.25*(rv(i-1,k,j+1)+rv(i,k,j+1)+rv(i-1,k,j)+rv(i,k,j)) & - - u(i,k,j)*reradius & - *0.25*(rw(i-1,k+1,j)+rw(i-1,k,j)+rw(i,k+1,j)+rw(i,k,j)) - - ENDDO - ENDDO - ENDDO - - END IF - -! curvature term for v momentum eqn. - -! Map scale factor notes -! ADT eqn 45, RHS terms 4 and 5, in cylindrical: mu u*u tan(lat)/(a mx) -! - mu v w /(a mx) -! ru = mu u / my ; rw = mu w / my ; rv = mu v / mx -! terms are: -! (my/mx)*u ru tan(lat) / a - (my/mx)*v rw / a -! = [my/(mx*a)]*[u ru tan(lat) - v rw] -! (1/a)*[(my/mx)*u ru tan(lat) - w rv] -! xlat defined with end points half grid space from pole, hence are on -! u latitude points => av here -! -! in original wrf, there was a sign error for the rw contribution - - j_start = jts - IF ( config_flags%open_ys .or. specified .or. & - config_flags%nested .or. config_flags%polar) j_start = MAX ( jds+1 , jts ) - IF ( config_flags%open_ye .or. specified .or. & - config_flags%nested .or. config_flags%polar) j_end = MIN ( jde-1 , jte ) - - IF ((config_flags%map_proj == 6) .OR. (config_flags%polar)) THEN - - DO j=j_start,j_end - DO k=kts,ktf - DO i=its,MIN(ite,ide-1) - rv_tend(i,k,j)=rv_tend(i,k,j) - (msfvy(i,j)/msfvx(i,j))*reradius* ( & - 0.25*(u(i,k,j)+u(i+1,k,j)+u(i,k,j-1)+u(i+1,k,j-1))* & - tan((xlat(i,j)+xlat(i,j-1))*0.5*degrad)* & - 0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) & - - v(i,k,j)*0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+ & - rw(i,k+1,j)+rw(i,k,j)) ) - ENDDO - ENDDO - ENDDO - - ELSE ! normal code - - DO j=j_start,j_end - DO k=kts,ktf - DO i=its,MIN(ite,ide-1) - - rv_tend(i,k,j)=rv_tend(i,k,j) - 0.5*(vxgm(i,k,j)+vxgm(i,k,j-1)) & - *0.25*(ru(i,k,j)+ru(i+1,k,j)+ru(i,k,j-1)+ru(i+1,k,j-1)) & - - (msfvy(i,j)/msfvx(i,j))*v(i,k,j)*reradius & - *0.25*(rw(i,k+1,j-1)+rw(i,k,j-1)+rw(i,k+1,j)+rw(i,k,j)) - - ENDDO - ENDDO - ENDDO - - END IF - -! curvature term for vertical momentum eqn. - -! Notes on map scale factors: -! ADT eqn 46, RHS term 4: [mu/(a my)]*[u*u + v*v] -! ru = mu u / my ; rw = mu w / my ; rv = mu v / mx -! terms are: u ru / a + (mx/my)v rv / a - - DO j=jts,MIN(jte,jde-1) - DO k=MAX(2,kts),ktf - DO i=its,MIN(ite,ide-1) - - rw_tend(i,k,j)=rw_tend(i,k,j) + reradius* & - (0.5*(fzm(k)*(ru(i,k,j)+ru(i+1,k,j))+fzp(k)*(ru(i,k-1,j)+ru(i+1,k-1,j))) & - *0.5*(fzm(k)*( u(i,k,j) +u(i+1,k,j))+fzp(k)*( u(i,k-1,j) +u(i+1,k-1,j))) & - +(msftx(i,j)/msfty(i,j))*0.5*(fzm(k)*(rv(i,k,j)+rv(i,k,j+1))+fzp(k)*(rv(i,k-1,j)+rv(i,k-1,j+1))) & - *0.5*(fzm(k)*( v(i,k,j) +v(i,k,j+1))+fzp(k)*( v(i,k-1,j) +v(i,k-1,j+1)))) - - ENDDO - ENDDO - ENDDO - -END SUBROUTINE curvature - -!------------------------------------------------------------------------------ - -SUBROUTINE decouple ( rr, rfield, field, name, config_flags, & - fzm, fzp, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - CHARACTER(LEN=1) , INTENT(IN ) :: name - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: rfield - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: rr - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT ) :: field - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, fzp - - ! Local data - - INTEGER :: i, j, k, itf, jtf, ktf - -! -! -! decouple decouples a variable from the column dry-air mass. -! -! - - ktf=MIN(kte,kde-1) - - IF (name .EQ. 'u')THEN - itf=ite - jtf=MIN(jte,jde-1) - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - field(i,k,j)=rfield(i,k,j)/(0.5*(rr(i,k,j)+rr(i-1,k,j))) - ENDDO - ENDDO - ENDDO - - ELSE IF (name .EQ. 'v')THEN - itf=MIN(ite,ide-1) - jtf=jte - - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - field(i,k,j)=rfield(i,k,j)/(0.5*(rr(i,k,j)+rr(i,k,j-1))) - ENDDO - ENDDO - ENDDO - - ELSE IF (name .EQ. 'w')THEN - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - DO j=jts,jtf - DO k=kts+1,ktf - DO i=its,itf - field(i,k,j)=rfield(i,k,j)/(fzm(k)*rr(i,k,j)+fzp(k)*rr(i,k-1,j)) - ENDDO - ENDDO - ENDDO - - DO j=jts,jtf - DO i=its,itf - field(i,kte,j) = 0. - ENDDO - ENDDO - - ELSE - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - ! For theta we will decouple tb and tp and add them to give t afterwards - DO j=jts,jtf - DO k=kts,ktf - DO i=its,itf - field(i,k,j)=rfield(i,k,j)/rr(i,k,j) - ENDDO - ENDDO - ENDDO - - ENDIF - -END SUBROUTINE decouple - -!------------------------------------------------------------------------------- - - -SUBROUTINE zero_tend ( tendency, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - - IMPLICIT NONE - - ! Input data - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency - - ! Local data - - INTEGER :: i, j, k, itf, jtf, ktf - -! -! -! zero_tend sets the input tendency array to zero. -! -! - - DO j = jts, jte - DO k = kts, kte - DO i = its, ite - tendency(i,k,j) = 0. - ENDDO - ENDDO - ENDDO - - END SUBROUTINE zero_tend - -!------------------------------------------------------------------------------- -! Sets the an array on the polar v point(s) to zero -SUBROUTINE zero_pole ( field, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - - IMPLICIT NONE - - ! Input data - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: field - - ! Local data - - INTEGER :: i, k - - IF (jts == jds) THEN - DO k = kts, kte - DO i = its-1, ite+1 - field(i,k,jts) = 0. - END DO - END DO - END IF - IF (jte == jde) THEN - DO k = kts, kte - DO i = its-1, ite+1 - field(i,k,jte) = 0. - END DO - END DO - END IF - -END SUBROUTINE zero_pole - -!------------------------------------------------------------------------------- -! Sets the an array on the polar v point(s) -SUBROUTINE pole_point_bc ( field, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - - IMPLICIT NONE - - ! Input data - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: field - - ! Local data - - INTEGER :: i, k - - IF (jts == jds) THEN - DO k = kts, kte - DO i = its, ite -! field(i,k,jts) = 2*field(i,k,jts+1) - field(i,k,jts+2) - field(i,k,jts) = field(i,k,jts+1) - END DO - END DO - END IF - IF (jte == jde) THEN - DO k = kts, kte - DO i = its, ite -! field(i,k,jte) = 2*field(i,k,jte-1) - field(i,k,jte-2) - field(i,k,jte) = field(i,k,jte-1) - END DO - END DO - END IF - -END SUBROUTINE pole_point_bc - -!====================================================================== -! physics prep routines -!====================================================================== - - SUBROUTINE phy_prep ( config_flags, & ! input - mu, muu, muv, u, v, w, p, pb, alt, ph, & ! input - phb, t, tsk, moist, n_moist, & ! input - mu_3d, rho, th_phy, p_phy , pi_phy , & ! output - u_phy, v_phy, w_phy, p8w, t_phy, t8w, & ! output - z, z_at_w, dz8w, & ! output - fzm, fzp, & ! params - RTHRATEN, & - RTHBLTEN, RUBLTEN, RVBLTEN, & - RQVBLTEN, RQCBLTEN, RQIBLTEN, & - RTHCUTEN, RQVCUTEN, RQCCUTEN, & - RQRCUTEN, RQICUTEN, RQSCUTEN, & - RTHFTEN, RQVFTEN, & - RUNDGDTEN, RVNDGDTEN, RTHNDGDTEN, & - RQVNDGDTEN, RMUNDGDTEN, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -!---------------------------------------------------------------------- - IMPLICIT NONE -!---------------------------------------------------------------------- - - TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - INTEGER , INTENT(IN ) :: n_moist - - REAL, DIMENSION( ims:ime, kms:kme , jms:jme , n_moist ), INTENT(IN) :: moist - - - REAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: TSK, mu, muu, muv - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & - INTENT( OUT) :: u_phy, & - v_phy, & - w_phy, & - pi_phy, & - p_phy, & - p8w, & - t_phy, & - th_phy, & - t8w, & - mu_3d, & - rho, & - z, & - dz8w, & - z_at_w - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & - INTENT(IN ) :: pb, & - p, & - u, & - v, & - w, & - alt, & - ph, & - phb, & - t - - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & - fzp - - REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & - INTENT(INOUT) :: RTHRATEN - - REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & - INTENT(INOUT) :: RTHCUTEN, & - RQVCUTEN, & - RQCCUTEN, & - RQRCUTEN, & - RQICUTEN, & - RQSCUTEN - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , & - INTENT(INOUT) :: RUBLTEN, & - RVBLTEN, & - RTHBLTEN, & - RQVBLTEN, & - RQCBLTEN, & - RQIBLTEN - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , & - INTENT(INOUT) :: RTHFTEN, & - RQVFTEN - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , & - INTENT(INOUT) :: RUNDGDTEN, & - RVNDGDTEN, & - RTHNDGDTEN, & - RQVNDGDTEN, & - RMUNDGDTEN - - INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end, i_startu, j_startv - INTEGER :: i, j, k - REAL :: w1, w2, z0, z1, z2 - -!----------------------------------------------------------------------- - -! -! -! phys_prep calculates a number of diagnostic quantities needed by -! the physics routines. It also decouples the physics tendencies from -! the column dry-air mass (the physics routines expect to see/update the -! uncoupled tendencies). -! -! - -! set up loop bounds for this grid's boundary conditions - - i_start = its - i_end = min( ite,ide-1 ) - j_start = jts - j_end = min( jte,jde-1 ) - - k_start = kts - k_end = min( kte, kde-1 ) - -! compute thermodynamics and velocities at pressure points - - do j = j_start,j_end - do k = k_start, k_end - do i = i_start, i_end - - th_phy(i,k,j) = t(i,k,j) + t0 - p_phy(i,k,j) = p(i,k,j) + pb(i,k,j) - pi_phy(i,k,j) = (p_phy(i,k,j)/p1000mb)**rcp - !! TAKE INTO ACCOUNT cp=f(T) on Venus - IF (planet.eq. "venus" ) THEN - t_phy(i,k,j)= (th_phy(i,k,j)**nu - nu*(TT00**nu)*log((p1000mb/p_phy(i,k,j))**rcp))**(1/nu) - ELSE - t_phy(i,k,j) = th_phy(i,k,j)*pi_phy(i,k,j) - ENDIF - rho(i,k,j) = 1./alt(i,k,j)*(1.+moist(i,k,j,P_QV)) - mu_3d(i,k,j) = mu(i,j) - u_phy(i,k,j) = 0.5*(u(i,k,j)+u(i+1,k,j)) - v_phy(i,k,j) = 0.5*(v(i,k,j)+v(i,k,j+1)) - - enddo - enddo - enddo - -! compute z at w points - - do j = j_start,j_end - do k = k_start, kte - do i = i_start, i_end - z_at_w(i,k,j) = (phb(i,k,j)+ph(i,k,j))/g - enddo - enddo - enddo - - do j = j_start,j_end - do k = k_start, kte-1 - do i = i_start, i_end - dz8w(i,k,j) = z_at_w(i,k+1,j)-z_at_w(i,k,j) - enddo - enddo - enddo - - do j = j_start,j_end - do i = i_start, i_end - dz8w(i,kte,j) = 0. - enddo - enddo - -! compute z at p points (average of z at w points) - - do j = j_start,j_end - do k = k_start, k_end - do i = i_start, i_end - z(i,k,j) = 0.5*(z_at_w(i,k,j) + z_at_w(i,k+1,j) ) -!!!! MARS MARS ajout aymeric (ainsi que les arguments de cette routine) - w_phy(i,k,j) = 0.5*(w(i,k,j) + w(i,k+1,j) ) - enddo - enddo - enddo - -! interp t and p at w points - - do j = j_start,j_end - do k = 2, k_end - do i = i_start, i_end - p8w(i,k,j) = fzm(k)*p_phy(i,k,j)+fzp(k)*p_phy(i,k-1,j) - t8w(i,k,j) = fzm(k)*t_phy(i,k,j)+fzp(k)*t_phy(i,k-1,j) - enddo - enddo - enddo - -! extrapolate p and t to surface and top. -! we'll use an extrapolation in z for now - - do j = j_start,j_end - do i = i_start, i_end - -! bottom - - z0 = z_at_w(i,1,j) - z1 = z(i,1,j) - z2 = z(i,2,j) - w1 = (z0 - z2)/(z1 - z2) - w2 = 1. - w1 - p8w(i,1,j) = w1*p_phy(i,1,j)+w2*p_phy(i,2,j) - t8w(i,1,j) = w1*t_phy(i,1,j)+w2*t_phy(i,2,j) - -! top - - z0 = z_at_w(i,kte,j) - z1 = z(i,k_end,j) - z2 = z(i,k_end-1,j) - w1 = (z0 - z2)/(z1 - z2) - w2 = 1. - w1 - -! p8w(i,kde,j) = w1*p_phy(i,kde-1,j)+w2*p_phy(i,kde-2,j) -!!! bug fix extrapolate ln(p) so p is positive definite - p8w(i,kde,j) = exp(w1*log(p_phy(i,kde-1,j))+w2*log(p_phy(i,kde-2,j))) - t8w(i,kde,j) = w1*t_phy(i,kde-1,j)+w2*t_phy(i,kde-2,j) - - enddo - enddo - -! decouple all physics tendencies - - IF (config_flags%ra_lw_physics .gt. 0 .or. config_flags%ra_sw_physics .gt. 0) THEN - - DO J=j_start,j_end - DO K=k_start,k_end - DO I=i_start,i_end - RTHRATEN(I,K,J)=RTHRATEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - - ENDIF - - IF (config_flags%cu_physics .gt. 0) THEN - - DO J=j_start,j_end - DO I=i_start,i_end - DO K=k_start,k_end - RTHCUTEN(I,K,J)=RTHCUTEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - - IF (P_QV .ge. PARAM_FIRST_SCALAR)THEN - DO J=j_start,j_end - DO I=i_start,i_end - DO K=k_start,k_end - RQVCUTEN(I,K,J)=RQVCUTEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - ENDIF - - IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN - DO J=j_start,j_end - DO I=i_start,i_end - DO K=k_start,k_end - RQCCUTEN(I,K,J)=RQCCUTEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - ENDIF - - IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN - DO J=j_start,j_end - DO I=i_start,i_end - DO K=k_start,k_end - RQRCUTEN(I,K,J)=RQRCUTEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - ENDIF - - IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN - DO J=j_start,j_end - DO I=i_start,i_end - DO K=k_start,k_end - RQICUTEN(I,K,J)=RQICUTEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - ENDIF - - IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN - DO J=j_start,j_end - DO I=i_start,i_end - DO K=k_start,k_end - RQSCUTEN(I,K,J)=RQSCUTEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - ENDIF - - ENDIF - -!!MARS MARS -! IF (config_flags%bl_pbl_physics .gt. 0) THEN - IF ( (config_flags%bl_pbl_physics .gt. 0) & - .OR. (config_flags%modif_wrf) ) THEN -!****MARS - DO J=j_start,j_end - DO K=k_start,k_end - DO I=i_start,i_end - RUBLTEN(I,K,J) =RUBLTEN(I,K,J)/mu(I,J) - RVBLTEN(I,K,J) =RVBLTEN(I,K,J)/mu(I,J) - RTHBLTEN(I,K,J)=RTHBLTEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - - IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN - DO J=j_start,j_end - DO K=k_start,k_end - DO I=i_start,i_end - RQVBLTEN(I,K,J)=RQVBLTEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - ENDIF - - IF (P_QC .ge. PARAM_FIRST_SCALAR) THEN - DO J=j_start,j_end - DO K=k_start,k_end - DO I=i_start,i_end - RQCBLTEN(I,K,J)=RQCBLTEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - ENDIF - - IF (P_QI .ge. PARAM_FIRST_SCALAR) THEN - DO J=j_start,j_end - DO K=k_start,k_end - DO I=i_start,i_end - RQIBLTEN(I,K,J)=RQIBLTEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - ENDIF - - ENDIF - -! decouple advective forcing required by Grell-Devenyi scheme - - if(( config_flags%cu_physics == GDSCHEME ) .OR. & - ( config_flags%cu_physics == G3SCHEME )) then - - DO J=j_start,j_end - DO I=i_start,i_end - DO K=k_start,k_end - RTHFTEN(I,K,J)=RTHFTEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - - IF (P_QV .ge. PARAM_FIRST_SCALAR)THEN - DO J=j_start,j_end - DO I=i_start,i_end - DO K=k_start,k_end - RQVFTEN(I,K,J)=RQVFTEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - ENDIF - - END IF - -! fdda -! note fdda u and v tendencies are staggered, also only interior points have muu/muv, -! so only decouple those - - IF (config_flags%grid_fdda .gt. 0) THEN - - i_startu=MAX(its,ids+1) - j_startv=MAX(jts,jds+1) - - DO J=j_start,j_end - DO K=k_start,k_end - DO I=i_startu,i_end - RUNDGDTEN(I,K,J) =RUNDGDTEN(I,K,J)/muu(I,J) - ENDDO - ENDDO - ENDDO - DO J=j_startv,j_end - DO K=k_start,k_end - DO I=i_start,i_end - RVNDGDTEN(I,K,J) =RVNDGDTEN(I,K,J)/muv(I,J) - ENDDO - ENDDO - ENDDO - DO J=j_start,j_end - DO K=k_start,k_end - DO I=i_start,i_end - RTHNDGDTEN(I,K,J)=RTHNDGDTEN(I,K,J)/mu(I,J) -! RMUNDGDTEN(I,J) - no coupling - ENDDO - ENDDO - ENDDO - IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN - DO J=j_start,j_end - DO K=k_start,k_end - DO I=i_start,i_end - RQVNDGDTEN(I,K,J)=RQVNDGDTEN(I,K,J)/mu(I,J) - ENDDO - ENDDO - ENDDO - ENDIF - - ENDIF - -END SUBROUTINE phy_prep - -!------------------------------------------------------------ - - SUBROUTINE moist_physics_prep_em( t_new, t_old, t0, rho, al, alb, & - p, p8w, p0, pb, ph, phb, & - th_phy, pii, pf, & - z, z_at_w, dz8w, & - dt,h_diabatic, & - config_flags,fzm, fzp, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) - - IMPLICIT NONE - -! Here we construct full fields -! needed by the microphysics - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde - INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme - INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte - - REAL, INTENT(IN ) :: dt - - REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & - INTENT(IN ) :: al, & - alb, & - p, & - pb, & - ph, & - phb - - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & - fzp - - REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & - INTENT( OUT) :: rho, & - th_phy, & - pii, & - pf, & - z, & - z_at_w, & - dz8w, & - p8w - - REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & - INTENT(INOUT) :: h_diabatic - - REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & - INTENT(INOUT) :: t_new, & - t_old - - REAL, INTENT(IN ) :: t0, p0 - REAL :: z0,z1,z2,w1,w2 - - INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end - INTEGER :: i, j, k - -!-------------------------------------------------------------------- - -! -! -! moist_phys_prep_em calculates a number of diagnostic quantities needed by -! the microphysics routines. -! -! - -! set up loop bounds for this grid's boundary conditions - - i_start = its - i_end = min( ite,ide-1 ) - j_start = jts - j_end = min( jte,jde-1 ) - - k_start = kts - k_end = min( kte, kde-1 ) - - DO j = j_start, j_end - DO k = k_start, kte - DO i = i_start, i_end - z_at_w(i,k,j) = (ph(i,k,j)+phb(i,k,j))/g - ENDDO - ENDDO - ENDDO - - do j = j_start,j_end - do k = k_start, kte-1 - do i = i_start, i_end - dz8w(i,k,j) = z_at_w(i,k+1,j)-z_at_w(i,k,j) - enddo - enddo - enddo - - do j = j_start,j_end - do i = i_start, i_end - dz8w(i,kte,j) = 0. - enddo - enddo - - - ! compute full pii, rho, and z at the new time-level - ! (needed for physics). - ! convert perturbation theta to full theta (th_phy) - ! use h_diabatic to temporarily save pre-microphysics full theta - - DO j = j_start, j_end - DO k = k_start, k_end - DO i = i_start, i_end - -#ifdef REVERT - t_new(i,k,j) = t_new(i,k,j)-h_diabatic(i,k,j)*dt -#endif - th_phy(i,k,j) = t_new(i,k,j) + t0 - h_diabatic(i,k,j) = th_phy(i,k,j) - rho(i,k,j) = 1./(al(i,k,j)+alb(i,k,j)) - pii(i,k,j) = ((p(i,k,j)+pb(i,k,j))/p0)**rcp - z(i,k,j) = 0.5*(z_at_w(i,k,j) +z_at_w(i,k+1,j) ) - pf(i,k,j) = p(i,k,j)+pb(i,k,j) - - ENDDO - ENDDO - ENDDO - -! interp t and p at w points - - do j = j_start,j_end - do k = 2, k_end - do i = i_start, i_end - p8w(i,k,j) = fzm(k)*pf(i,k,j)+fzp(k)*pf(i,k-1,j) - enddo - enddo - enddo - -! extrapolate p and t to surface and top. -! we'll use an extrapolation in z for now - - do j = j_start,j_end - do i = i_start, i_end - -! bottom - - z0 = z_at_w(i,1,j) - z1 = z(i,1,j) - z2 = z(i,2,j) - w1 = (z0 - z2)/(z1 - z2) - w2 = 1. - w1 - p8w(i,1,j) = w1*pf(i,1,j)+w2*pf(i,2,j) - -! top - - z0 = z_at_w(i,kte,j) - z1 = z(i,k_end,j) - z2 = z(i,k_end-1,j) - w1 = (z0 - z2)/(z1 - z2) - w2 = 1. - w1 -! p8w(i,kde,j) = w1*pf(i,kde-1,j)+w2*pf(i,kde-2,j) - p8w(i,kde,j) = exp(w1*log(pf(i,kde-1,j))+w2*log(pf(i,kde-2,j))) - - enddo - enddo - - END SUBROUTINE moist_physics_prep_em - -!------------------------------------------------------------------------------ - - SUBROUTINE moist_physics_finish_em( t_new, t_old, t0, mut, & - th_phy, h_diabatic, dt, & - config_flags, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) - - IMPLICIT NONE - -! Here we construct full fields -! needed by the microphysics - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde - INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme - INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte - - REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & - INTENT(INOUT) :: t_new, & - t_old, & - th_phy, & - h_diabatic - - REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: mut - - - REAL, INTENT(IN ) :: t0, dt - - INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end - INTEGER :: i, j, k - -!-------------------------------------------------------------------- - -! -! -! moist_phys_finish_em resets theta to its perturbation value and -! computes and stores the microphysics diabatic heating term. -! -! - -! set up loop bounds for this grid's boundary conditions - - - i_start = its - i_end = min( ite,ide-1 ) - j_start = jts - j_end = min( jte,jde-1 ) - - k_start = kts - k_end = min( kte, kde-1 ) - -! add microphysics theta diff to perturbation theta, set h_diabatic - - IF ( config_flags%no_mp_heating .eq. 0 ) THEN - DO j = j_start, j_end - DO k = k_start, k_end - DO i = i_start, i_end - t_new(i,k,j) = t_new(i,k,j) + (th_phy(i,k,j)-h_diabatic(i,k,j)) - h_diabatic(i,k,j) = (th_phy(i,k,j)-h_diabatic(i,k,j))/dt - ENDDO - ENDDO - ENDDO - - ELSE - - DO j = j_start, j_end - DO k = k_start, k_end - DO i = i_start, i_end -! t_new(i,k,j) = t_new(i,k,j) - h_diabatic(i,k,j) = 0. - ENDDO - ENDDO - ENDDO - ENDIF - - END SUBROUTINE moist_physics_finish_em - -!---------------------------------------------------------------- - - - SUBROUTINE init_module_big_step - END SUBROUTINE init_module_big_step - -SUBROUTINE set_tend ( field, field_adv_tend, msf, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: field - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN) :: field_adv_tend - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: msf - - ! Local data - - INTEGER :: i, j, k, itf, jtf, ktf - -! -! -! set_tend copies the advective tendency array into the tendency array. -! -! - - jtf = MIN(jte,jde-1) - ktf = MIN(kte,kde-1) - itf = MIN(ite,ide-1) - DO j = jts, jtf - DO k = kts, ktf - DO i = its, itf - field(i,k,j) = field_adv_tend(i,k,j)*msf(i,j) - ENDDO - ENDDO - ENDDO - -END SUBROUTINE set_tend - -!------------------------------------------------------------------------------ - - SUBROUTINE rk_rayleigh_damp( ru_tendf, rv_tendf, & - rw_tendf, t_tendf, & - u, v, w, t, t_init, & - mut, muu, muv, ph, phb, & - u_base, v_base, t_base, z_base, & - dampcoef, zdamp, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! History: Apr 2005 Modifications by George Bryan, NCAR: -! - Generalized the code in a way that allows for -! simulations with steep terrain. -! -! Jul 2004 Modifications by George Bryan, NCAR: -! - Modified the code to use u_base, v_base, and t_base -! arrays for the background state. Removed the hard-wired -! base-state values. -! - Modified the code to use dampcoef, zdamp, and damp_opt, -! i.e., the upper-level damper variables in namelist.input. -! Removed the hard-wired variables in the older version. -! This damper is used when damp_opt = 2. -! - Modified the code to account for the movement of the -! model surfaces with time. The code now obtains a base- -! state value by interpolation using the "_base" arrays. - -! Nov 2003 Bug fix by Jason Knievel, NCAR - -! Aug 2003 Meridional dimension, some comments, and -! changes in layout of the code added by -! Jason Knievel, NCAR - -! Jul 2003 Original code by Bill Skamarock, NCAR - -! Purpose: This routine applies Rayleigh damping to a layer at top -! of the model domain. - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - INTEGER, INTENT( IN ) & - :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & - :: ru_tendf, rv_tendf, rw_tendf, t_tendf - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: u, v, w, t, t_init, ph, phb - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: mut, muu, muv - - REAL, DIMENSION( kms:kme ) , INTENT(IN ) & - :: u_base, v_base, t_base, z_base - - REAL, INTENT(IN ) & - :: dampcoef, zdamp - -! Local variables. - - INTEGER & - :: i_start, i_end, j_start, j_end, k_start, k_end, i, j, k, ktf, k1, k2 - - REAL & - :: pii, dcoef, z, ztop - - REAL :: wkp1, wk, wkm1 - - REAL, DIMENSION( kms:kme ) :: z00, u00, v00, t00 - -! End declarations. -!----------------------------------------------------------------------- - - pii = 2.0 * asin(1.0) - - ktf = MIN( kte, kde-1 ) - -!----------------------------------------------------------------------- -! Adjust u to base state. - - DO j = jts, MIN( jte, jde-1 ) - DO i = its, MIN( ite, ide ) - - ! Get height at top of model - ztop = 0.5*( phb(i ,kde,j)+phb(i-1,kde,j) & - +ph(i ,kde,j)+ph(i-1,kde,j) )/g - - ! Find bottom of damping layer - k1 = ktf - z = ztop - DO WHILE( z >= (ztop-zdamp) ) - z = 0.25*( phb(i ,k1,j)+phb(i ,k1+1,j) & - +phb(i-1,k1,j)+phb(i-1,k1+1,j) & - +ph(i ,k1,j)+ph(i ,k1+1,j) & - +ph(i-1,k1,j)+ph(i-1,k1+1,j))/g - z00(k1) = z - k1 = k1 - 1 - ENDDO - k1 = k1 + 2 - - ! Get reference state at model levels - DO k = k1, ktf - k2 = ktf - DO WHILE( z_base(k2) .gt. z00(k) ) - k2 = k2 - 1 - ENDDO - if(k2+1.gt.ktf)then - u00(k) = u_base(k2) + ( u_base(k2) - u_base(k2-1) ) & - * ( z00(k) - z_base(k2) ) & - / ( z_base(k2) - z_base(k2-1) ) - else - u00(k) = u_base(k2) + ( u_base(k2+1) - u_base(k2) ) & - * ( z00(k) - z_base(k2) ) & - / ( z_base(k2+1) - z_base(k2) ) - endif - ENDDO - - ! Apply the Rayleigh damper - DO k = k1, ktf - dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp ) - dcoef = (SIN( 0.5 * pii * dcoef ) )**2 - ru_tendf(i,k,j) = ru_tendf(i,k,j) - & - muu(i,j) * ( dcoef * dampcoef ) * & - ( u(i,k,j) - u00(k) ) - END DO - - END DO - END DO - -! End adjustment of u. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Adjust v to base state. - - DO j = jts, MIN( jte, jde ) - DO i = its, MIN( ite, ide-1 ) - - ! Get height at top of model - ztop = 0.5*( phb(i,kde,j )+phb(i,kde,j-1) & - +ph(i,kde,j )+ph(i,kde,j-1) )/g - - ! Find bottom of damping layer - k1 = ktf - z = ztop - DO WHILE( z >= (ztop-zdamp) ) - z = 0.25*( phb(i,k1,j )+phb(i,k1+1,j ) & - +phb(i,k1,j-1)+phb(i,k1+1,j-1) & - +ph(i,k1,j )+ph(i,k1+1,j ) & - +ph(i,k1,j-1)+ph(i,k1+1,j-1))/g - z00(k1) = z - k1 = k1 - 1 - ENDDO - k1 = k1 + 2 - - ! Get reference state at model levels - DO k = k1, ktf - k2 = ktf - DO WHILE( z_base(k2) .gt. z00(k) ) - k2 = k2 - 1 - ENDDO - if(k2+1.gt.ktf)then - v00(k) = v_base(k2) + ( v_base(k2) - v_base(k2-1) ) & - * ( z00(k) - z_base(k2) ) & - / ( z_base(k2) - z_base(k2-1) ) - else - v00(k) = v_base(k2) + ( v_base(k2+1) - v_base(k2) ) & - * ( z00(k) - z_base(k2) ) & - / ( z_base(k2+1) - z_base(k2) ) - endif - ENDDO - - ! Apply the Rayleigh damper - DO k = k1, ktf - dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp ) - dcoef = (SIN( 0.5 * pii * dcoef ) )**2 - rv_tendf(i,k,j) = rv_tendf(i,k,j) - & - muv(i,j) * ( dcoef * dampcoef ) * & - ( v(i,k,j) - v00(k) ) - END DO - - END DO - END DO - -! End adjustment of v. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Adjust w to base state. - - DO j = jts, MIN( jte, jde-1 ) - DO i = its, MIN( ite, ide-1 ) - ztop = ( phb(i,kde,j) + ph(i,kde,j) ) / g - DO k = kts, MIN( kte, kde ) - z = ( phb(i,k,j) + ph(i,k,j) ) / g - IF ( z >= (ztop-zdamp) ) THEN - dcoef = 1.0 - MIN( 1.0, ( ztop - z ) / zdamp ) - dcoef = ( SIN( 0.5 * pii * dcoef ) )**2 - rw_tendf(i,k,j) = rw_tendf(i,k,j) - & - mut(i,j) * ( dcoef * dampcoef ) * w(i,k,j) - END IF - END DO - END DO - END DO - -! End adjustment of w. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Adjust potential temperature to base state. - - DO j = jts, MIN( jte, jde-1 ) - DO i = its, MIN( ite, ide-1 ) - - ! Get height at top of model - ztop = ( phb(i,kde,j) + ph(i,kde,j) ) / g - - ! Find bottom of damping layer - k1 = ktf - z = ztop - DO WHILE( z >= (ztop-zdamp) ) - z = 0.5 * ( phb(i,k1,j) + phb(i,k1+1,j) + & - ph(i,k1,j) + ph(i,k1+1,j) ) / g - z00(k1) = z - k1 = k1 - 1 - ENDDO - k1 = k1 + 2 - - ! Get reference state at model levels - DO k = k1, ktf - k2 = ktf - DO WHILE( z_base(k2) .gt. z00(k) ) - k2 = k2 - 1 - ENDDO - if(k2+1.gt.ktf)then - t00(k) = t_base(k2) + ( t_base(k2) - t_base(k2-1) ) & - * ( z00(k) - z_base(k2) ) & - / ( z_base(k2) - z_base(k2-1) ) - else - t00(k) = t_base(k2) + ( t_base(k2+1) - t_base(k2) ) & - * ( z00(k) - z_base(k2) ) & - / ( z_base(k2+1) - z_base(k2) ) - endif - ENDDO - - ! Apply the Rayleigh damper - DO k = k1, ktf - dcoef = 1.0 - MIN( 1.0, ( ztop - z00(k) ) / zdamp ) - dcoef = (SIN( 0.5 * pii * dcoef ) )**2 - t_tendf(i,k,j) = t_tendf(i,k,j) - & - mut(i,j) * ( dcoef * dampcoef ) * & - ( t(i,k,j) - t00(k) ) - END DO - - END DO - END DO - -! End adjustment of potential temperature. -!----------------------------------------------------------------------- - - END SUBROUTINE rk_rayleigh_damp - -!============================================================================== -!============================================================================== - - SUBROUTINE sixth_order_diffusion( name, field, tendency, mu, dt, & - config_flags, & - diff_6th_opt, diff_6th_factor, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! History: 14 Nov 2006 Name of variable changed by Jason Knievel -! 07 Jun 2006 Revised and generalized by Jason Knievel -! 25 Apr 2005 Original code by Jason Knievel, NCAR - -! Purpose: Apply 6th-order, monotonic (flux-limited), numerical -! diffusion to 3-d velocity and to scalars. - -! References: Ming Xue (MWR Aug 2000) -! Durran ("Numerical Methods for Wave Equations..." 1999) -! George Bryan (personal communication) - -!------------------------------------------------------------------------------ -! Begin: Declarations. - - IMPLICIT NONE - - INTEGER, INTENT(IN) & - :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - TYPE(grid_config_rec_type), INTENT(IN) & - :: config_flags - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) & - :: tendency - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN) & - :: field - - REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) & - :: mu - - REAL, INTENT(IN) & - :: dt - - REAL, INTENT(IN) & - :: diff_6th_factor - - INTEGER, INTENT(IN) & - :: diff_6th_opt - - CHARACTER(LEN=1) , INTENT(IN) & - :: name - - INTEGER & - :: i, j, k, & - i_start, i_end, & - j_start, j_end, & - k_start, k_end, & - ktf - - REAL & - :: dflux_x_p0, dflux_y_p0, & - dflux_x_p1, dflux_y_p1, & - tendency_x, tendency_y, & - mu_avg_p0, mu_avg_p1, & - diff_6th_coef - - LOGICAL & - :: specified - -! End: Declarations. -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -! Begin: Translate the diffusion factor into a diffusion coefficient. See -! Durran's text, section 2.4.3, then adjust for sixth-order diffusion (not -! fourth) and for diffusion in two dimensions (not one). For reference, a -! factor of 1.0 would mean complete diffusion of a 2dx wave in one time step, -! although application of the flux limiter reduces somewhat the effects of -! diffusion for a given coefficient. - - diff_6th_coef = diff_6th_factor * 0.015625 / ( 2.0 * dt ) - -! End: Translate diffusion factor. -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -! Begin: Assign limits of spatial loops depending on variable to be diffused. -! The halo regions are already filled with values by the time this subroutine -! is called, which allows the stencil to extend beyond the domains' edges. - - ktf = MIN( kte, kde-1 ) - - IF ( name .EQ. 'u' ) THEN - - i_start = its - i_end = ite - j_start = jts - j_end = MIN(jde-1,jte) - k_start = kts - k_end = ktf - - ELSE IF ( name .EQ. 'v' ) THEN - - i_start = its - i_end = MIN(ide-1,ite) - j_start = jts - j_end = jte - k_start = kts - k_end = ktf - - ELSE IF ( name .EQ. 'w' ) THEN - - i_start = its - i_end = MIN(ide-1,ite) - j_start = jts - j_end = MIN(jde-1,jte) - k_start = kts+1 - k_end = ktf - - ELSE - - i_start = its - i_end = MIN(ide-1,ite) - j_start = jts - j_end = MIN(jde-1,jte) - k_start = kts - k_end = ktf - - ENDIF - -! End: Assignment of limits of spatial loops. -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -! Begin: Loop across spatial dimensions. - - DO j = j_start, j_end - DO k = k_start, k_end - DO i = i_start, i_end - -!------------------------------------------------------------------------------ -! Begin: Diffusion in x (i index). - -! Calculate the diffusive flux in x direction (from Xue's eq. 3). - - dflux_x_p0 = ( 10.0 * ( field(i, k,j) - field(i-1,k,j) ) & - - 5.0 * ( field(i+1,k,j) - field(i-2,k,j) ) & - + ( field(i+2,k,j) - field(i-3,k,j) ) ) - - dflux_x_p1 = ( 10.0 * ( field(i+1,k,j) - field(i ,k,j) ) & - - 5.0 * ( field(i+2,k,j) - field(i-1,k,j) ) & - + ( field(i+3,k,j) - field(i-2,k,j) ) ) - -! If requested in the namelist (diff_6th_opt=2), prohibit up-gradient diffusion -! (variation on Xue's eq. 10). - - IF ( diff_6th_opt .EQ. 2 ) THEN - - IF ( dflux_x_p0 * ( field(i ,k,j)-field(i-1,k,j) ) .LE. 0.0 ) THEN - dflux_x_p0 = 0.0 - END IF - - IF ( dflux_x_p1 * ( field(i+1,k,j)-field(i ,k,j) ) .LE. 0.0 ) THEN - dflux_x_p1 = 0.0 - END IF - - END IF - -! Apply 6th-order diffusion in x direction. - - IF ( name .EQ. 'u' ) THEN - mu_avg_p0 = mu(i-1,j) - mu_avg_p1 = mu(i ,j) - ELSE IF ( name .EQ. 'v' ) THEN - mu_avg_p0 = 0.25 * ( & - mu(i-1,j-1) + & - mu(i ,j-1) + & - mu(i-1,j ) + & - mu(i ,j ) ) - mu_avg_p1 = 0.25 * ( & - mu(i ,j-1) + & - mu(i+1,j-1) + & - mu(i ,j ) + & - mu(i+1,j ) ) - ELSE - mu_avg_p0 = 0.5 * ( & - mu(i-1,j) + & - mu(i ,j) ) - mu_avg_p1 = 0.5 * ( & - mu(i ,j) + & - mu(i+1,j) ) - END IF - - tendency_x = diff_6th_coef * & - ( ( mu_avg_p1 * dflux_x_p1 ) - ( mu_avg_p0 * dflux_x_p0 ) ) - -! End: Diffusion in x. -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -! Begin: Diffusion in y (j index). - -! Calculate the diffusive flux in y direction (from Xue's eq. 3). - - dflux_y_p0 = ( 10.0 * ( field(i,k,j ) - field(i,k,j-1) ) & - - 5.0 * ( field(i,k,j+1) - field(i,k,j-2) ) & - + ( field(i,k,j+2) - field(i,k,j-3) ) ) - - dflux_y_p1 = ( 10.0 * ( field(i,k,j+1) - field(i,k,j ) ) & - - 5.0 * ( field(i,k,j+2) - field(i,k,j-1) ) & - + ( field(i,k,j+3) - field(i,k,j-2) ) ) - -! If requested in the namelist (diff_6th_opt=2), prohibit up-gradient diffusion -! (variation on Xue's eq. 10). - - IF ( diff_6th_opt .EQ. 2 ) THEN - - IF ( dflux_y_p0 * ( field(i,k,j )-field(i,k,j-1) ) .LE. 0.0 ) THEN - dflux_y_p0 = 0.0 - END IF - - IF ( dflux_y_p1 * ( field(i,k,j+1)-field(i,k,j ) ) .LE. 0.0 ) THEN - dflux_y_p1 = 0.0 - END IF - - END IF - -! Apply 6th-order diffusion in y direction. - - IF ( name .EQ. 'u' ) THEN - mu_avg_p0 = 0.25 * ( & - mu(i-1,j-1) + & - mu(i ,j-1) + & - mu(i-1,j ) + & - mu(i ,j ) ) - mu_avg_p1 = 0.25 * ( & - mu(i-1,j ) + & - mu(i ,j ) + & - mu(i-1,j+1) + & - mu(i ,j+1) ) - ELSE IF ( name .EQ. 'v' ) THEN - mu_avg_p0 = mu(i,j-1) - mu_avg_p1 = mu(i,j ) - ELSE - mu_avg_p0 = 0.5 * ( & - mu(i,j-1) + & - mu(i,j ) ) - mu_avg_p1 = 0.5 * ( & - mu(i,j ) + & - mu(i,j+1) ) - END IF - - tendency_y = diff_6th_coef * & - ( ( mu_avg_p1 * dflux_y_p1 ) - ( mu_avg_p0 * dflux_y_p0 ) ) - -! End: Diffusion in y. -!------------------------------------------------------------------------------ - -!------------------------------------------------------------------------------ -! Begin: Combine diffusion in x and y. - - tendency(i,k,j) = tendency(i,k,j) + tendency_x + tendency_y - -! End: Combine diffusion in x and y. -!------------------------------------------------------------------------------ - - ENDDO - ENDDO - ENDDO - -! End: Loop across spatial dimensions. -!------------------------------------------------------------------------------ - - END SUBROUTINE sixth_order_diffusion - -!============================================================================== -!============================================================================== - -END MODULE module_big_step_utilities_em Index: unk/WRF.COMMON/WRFV3/modif_mars/module_diffusion_em.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/modif_mars/module_diffusion_em.F (revision 2760) +++ (revision ) @@ -1,5525 +1,0 @@ -! WRF:MODEL_LAYER:PHYSICS - - MODULE module_diffusion_em - - USE module_configure - USE module_bc - USE module_state_description - USE module_big_step_utilities_em - USE module_model_constants - USE module_wrf_error - - CONTAINS - -!======================================================================= -!======================================================================= - - SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & - defor11, defor22, defor33, & - defor12, defor13, defor23, & - u_base, v_base, msfux, msfuy, & - msfvx, msfvy, msftx, msfty, & - rdx, rdy, dn, dnw, rdz, rdzw, & - fnm, fnp, cf1, cf2, cf3, zx, zy, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! History: Sep 2003 Changes by Jason Knievel and George Bryan, NCAR -! Oct 2001 Converted to mass core by Bill Skamarock, NCAR -! ... ... - -! Purpose: This routine calculates deformation and 3-d divergence. - -! References: Klemp and Wilhelmson (JAS 1978) -! Chen and Dudhia (NCAR WRF physics report 2000) - -!----------------------------------------------------------------------- -! Comments 10-MAR-05 -! Equations 13a-f, Chen and Dudhia 2000, Appendix A: -! Eqn 13a: D11=defor11= 2m^2 * (partial du^/dX + partial dpsi/dx * partial du^/dpsi) -! Eqn 13b: D22=defor22= 2m^2 * (partial dv^/dY + partial dpsi/dy * partial dv^/dpsi) -! Eqn 13c: D33=defor33= 2 * partial dw/dz [SIMPLER FORM] -! Eqn 13d: D12=defor12= m^2 * (partial dv^/dX + partial du^/dY + -! partial dpsi/dx * partial dv^/dpsi + -! partial dpsi/dy * partial du^/dpsi) -! Eqn 13e: D13=defor13= m^2 * (partial dw^/dX + partial dpsi/dx * partial dw^/dpsi) -! + partial du/dz [SIMPLER FORM] -! Eqn 13f: D23=defor23= m^2 * (partial dw^/dY + partial dpsi/dy * partial dw^/dpsi) -! + partial dv/dz [SIMPLER FORM] -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type ), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, INTENT( IN ) & - :: rdx, rdy, cf1, cf2, cf3 - - REAL, DIMENSION( kms:kme ), INTENT( IN ) & - :: fnm, fnp, dn, dnw, u_base, v_base - - REAL, DIMENSION( ims:ime , jms:jme ), INTENT( IN ) & - :: msfux, msfuy, msfvx, msfvy, msftx, msfty - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: u, v, w, zx, zy, rdz, rdzw - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & - :: defor11, defor22, defor33, defor12, defor13, defor23, div - -! Local variables. - - INTEGER & - :: i, j, k, ktf, ktes1, ktes2, i_start, i_end, j_start, j_end - - REAL & - :: tmp, tmpzx, tmpzy, tmpzeta_z, cft1, cft2 - - REAL, DIMENSION( its:ite, jts:jte ) & - :: mm, zzavg, zeta_zd12 - - REAL, DIMENSION( its-2:ite+2, kts:kte, jts-2:jte+2 ) & - :: tmp1, hat, hatavg - -! End declarations. -!----------------------------------------------------------------------- - -! Comments 10-MAR-2005 -! Treat all differentials as 'div-style' [or 'curl-style'], -! i.e., du/dX becomes (in map coordinate space) mx*my * d(u/my)/dx, -! NB - all equations referred to here are from Chen and Dudhia 2002, from the -! WRF physics documents web pages: -! http://www.mmm.ucar.edu/wrf/users/docs/wrf-doc-physics.pdf - -!======================================================================= -! In the following section, calculate 3-d divergence and the first three -! (defor11, defor22, defor33) of six deformation terms. - - ktes1 = kte-1 - ktes2 = kte-2 - - cft2 = - 0.5 * dnw(ktes1) / dn(ktes1) - cft1 = 1.0 - cft2 - - ktf = MIN( kte, kde-1 ) - - i_start = its - i_end = MIN( ite, ide-1 ) - j_start = jts - j_end = MIN( jte, jde-1 ) - -! Square the map scale factor. - - DO j = j_start, j_end - DO i = i_start, i_end - mm(i,j) = msftx(i,j) * msfty(i,j) - END DO - END DO - -!----------------------------------------------------------------------- -! Calculate du/dx. - -! Apply a coordinate transformation to zonal velocity, u. - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end+1 - hat(i,k,j) = u(i,k,j) / msfuy(i,j) - END DO - END DO - END DO - -! Average in x and z. - - DO j=j_start,j_end - DO k=kts+1,ktf - DO i=i_start,i_end - hatavg(i,k,j) = 0.5 * & - ( fnm(k) * ( hat(i,k ,j) + hat(i+1, k,j) ) + & - fnp(k) * ( hat(i,k-1,j) + hat(i+1,k-1,j) ) ) - END DO - END DO - END DO - -! Extrapolate to top and bottom of domain (to w levels). - - DO j = j_start, j_end - DO i = i_start, i_end - hatavg(i,1,j) = 0.5 * ( & - cf1 * hat(i ,1,j) + & - cf2 * hat(i ,2,j) + & - cf3 * hat(i ,3,j) + & - cf1 * hat(i+1,1,j) + & - cf2 * hat(i+1,2,j) + & - cf3 * hat(i+1,3,j) ) - hatavg(i,kte,j) = 0.5 * ( & - cft1 * ( hat(i,ktes1,j) + hat(i+1,ktes1,j) ) + & - cft2 * ( hat(i,ktes2,j) + hat(i+1,ktes2,j) ) ) - END DO - END DO - - ! Comments 10-MAR-05 - ! Eqn 13a: D11=defor11= 2m^2 * (partial du^/dX + partial dpsi/dx * partial du^/dpsi) - ! Below, D11 is set = 2*tmp1 - ! => tmp1 = m^2 * (partial du^/dX + partial dpsi/dx * partial du^/dpsi) - ! tmpzx = averaged value of dpsi/dx (=zx) - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tmpzx = 0.25 * ( & - zx(i,k ,j) + zx(i+1,k ,j) + & - zx(i,k+1,j) + zx(i+1,k+1,j) ) - tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) *tmpzx * rdzw(i,k,j) - ! tmp1 to here = partial dpsi/dx * partial du^/dpsi: - END DO - END DO - END DO - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tmp1(i,k,j) = mm(i,j) * ( rdx * ( hat(i+1,k,j) - hat(i,k,j) ) - & - tmp1(i,k,j)) - END DO - END DO - END DO - -! End calculation of du/dx. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Calculate defor11 (2*du/dx). -! Comments 10-MAR-05 -! Eqn 13a: D11=defor11= 2 m^2 * (partial du^/dX + partial dpsi/dx * partial du^/dpsi) -! = 2*tmp1 - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - defor11(i,k,j) = 2.0 * tmp1(i,k,j) - END DO - END DO - END DO - -! End calculation of defor11. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Calculate zonal divergence (du/dx) and add it to the divergence array. - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - div(i,k,j) = tmp1(i,k,j) - END DO - END DO - END DO - -! End calculation of zonal divergence. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Calculate dv/dy. - -! Apply a coordinate transformation to meridional velocity, v. - - DO j = j_start, j_end+1 - DO k = kts, ktf - DO i = i_start, i_end - ! Because msfvx at the poles will be undefined (1./0.), we will have - ! trouble. But we are OK since v at the poles is 0., and that takes - ! precedence in this case. - IF ((config_flags%polar) .AND. ((j == jds) .OR. (j == jde))) THEN - hat(i,k,j) = 0. - ELSE ! normal code - hat(i,k,j) = v(i,k,j) / msfvx(i,j) - ENDIF - END DO - END DO - END DO - -! Account for the slope in y of eta surfaces. - - DO j=j_start,j_end - DO k=kts+1,ktf - DO i=i_start,i_end - hatavg(i,k,j) = 0.5 * ( & - fnm(k) * ( hat(i,k ,j) + hat(i,k ,j+1) ) + & - fnp(k) * ( hat(i,k-1,j) + hat(i,k-1,j+1) ) ) - END DO - END DO - END DO - -! Extrapolate to top and bottom of domain (to w levels). - - DO j = j_start, j_end - DO i = i_start, i_end - hatavg(i,1,j) = 0.5 * ( & - cf1 * hat(i,1,j ) + & - cf2 * hat(i,2,j ) + & - cf3 * hat(i,3,j ) + & - cf1 * hat(i,1,j+1) + & - cf2 * hat(i,2,j+1) + & - cf3 * hat(i,3,j+1) ) - hatavg(i,kte,j) = 0.5 * ( & - cft1 * ( hat(i,ktes1,j) + hat(i,ktes1,j+1) ) + & - cft2 * ( hat(i,ktes2,j) + hat(i,ktes2,j+1) ) ) - END DO - END DO - - ! Comments 10-MAR-05 - ! Eqn 13b: D22=defor22= 2m^2 * (partial dv^/dY + partial dpsi/dy * partial dv^/dpsi) - ! Below, D22 is set = 2*tmp1 - ! => tmp1 = m^2 * (partial dv^/dY + partial dpsi/dy * partial dv^/dpsi) - ! tmpzy = averaged value of dpsi/dy (=zy) - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tmpzy = 0.25 * ( & - zy(i,k ,j) + zy(i,k ,j+1) + & - zy(i,k+1,j) + zy(i,k+1,j+1) ) - tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) * tmpzy * rdzw(i,k,j) - ! tmp1 to here = partial dpsi/dy * partial dv^/dpsi: - END DO - END DO - END DO - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tmp1(i,k,j) = mm(i,j) * ( & - rdy * ( hat(i,k,j+1) - hat(i,k,j) ) - tmp1(i,k,j) ) - END DO - END DO - END DO - -! End calculation of dv/dy. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Calculate defor22 (2*dv/dy). -! Comments 10-MAR-05 -! Eqn 13b: D22=defor22= 2 m^2 * (partial dv^/dY + partial dpsi/dy * partial dv^/dpsi) -! = 2*tmp1 - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - defor22(i,k,j) = 2.0 * tmp1(i,k,j) - END DO - END DO - END DO - -! End calculation of defor22. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Calculate meridional divergence (dv/dy) and add it to the divergence -! array. - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - div(i,k,j) = div(i,k,j) + tmp1(i,k,j) - END DO - END DO - END DO - -! End calculation of meridional divergence. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Comments 10-MAR-05 -! Eqn 13c: D33=defor33= 2 * partial dw/dz -! Below, D33 is set = 2*tmp1 -! => tmp1 = partial dw/dz - -! Calculate dw/dz. - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tmp1(i,k,j) = ( w(i,k+1,j) - w(i,k,j) ) * rdzw(i,k,j) - END DO - END DO - END DO - -! End calculation of dw/dz. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Calculate defor33 (2*dw/dz). - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - defor33(i,k,j) = 2.0 * tmp1(i,k,j) - END DO - END DO - END DO - -! End calculation of defor33. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Calculate vertical divergence (dw/dz) and add it to the divergence -! array. - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - div(i,k,j) = div(i,k,j) + tmp1(i,k,j) - END DO - END DO - END DO - -! End calculation of vertical divergence. -!----------------------------------------------------------------------- - -! Three-dimensional divergence is now finished and values are in array -! "div." Also, the first three (defor11, defor22, defor33) of six -! deformation terms are now calculated at pressure points. -!======================================================================= - -! Comments 10-MAR-2005 -! Treat all differentials as 'div-style' [or 'curl-style'], -! i.e., du/dY becomes (in map coordinate space) mx*my * d(u/mx)/dy, -! dv/dX becomes (in map coordinate space) mx*my * d(v/my)/dx, -! (see e.g. Haltiner and Williams p. 441) - -!======================================================================= -! Calculate the final three deformations (defor12, defor13, defor23) at -! vorticity points. - - i_start = its - i_end = ite - j_start = jts - j_end = jte - - IF ( config_flags%open_xs .OR. config_flags%specified .OR. & - config_flags%nested) i_start = MAX( ids+1, its ) - IF ( config_flags%open_xe .OR. config_flags%specified .OR. & - config_flags%nested) i_end = MIN( ide-1, ite ) - IF ( config_flags%open_ys .OR. config_flags%specified .OR. & - config_flags%nested) j_start = MAX( jds+1, jts ) - IF ( config_flags%open_ye .OR. config_flags%specified .OR. & - config_flags%nested) j_end = MIN( jde-1, jte ) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = ite - - -!----------------------------------------------------------------------- -! Calculate du/dy. - -! First, calculate an average mapscale factor. - -! Comments 10-MAR-05 -! du/dy => need u map scale factor in x (which is defined at u points) -! averaged over j and j-1 -! dv/dx => need v map scale factor in y (which is defined at v points) -! averaged over i and i-1 - - DO j = j_start, j_end - DO i = i_start, i_end - mm(i,j) = 0.25 * ( msfux(i,j-1) + msfux(i,j) ) * ( msfvy(i-1,j) + msfvy(i,j) ) - END DO - END DO - -! Apply a coordinate transformation to zonal velocity, u. - - DO j =j_start-1, j_end - DO k =kts, ktf - DO i =i_start, i_end - ! Fixes to set_physical_bc2/3d for polar boundary conditions - ! remove issues with loop over j - hat(i,k,j) = u(i,k,j) / msfux(i,j) - END DO - END DO - END DO - -! Average in y and z. - - DO j=j_start,j_end - DO k=kts+1,ktf - DO i=i_start,i_end - hatavg(i,k,j) = 0.5 * ( & - fnm(k) * ( hat(i,k ,j-1) + hat(i,k ,j) ) + & - fnp(k) * ( hat(i,k-1,j-1) + hat(i,k-1,j) ) ) - END DO - END DO - END DO - -! Extrapolate to top and bottom of domain (to w levels). - - DO j = j_start, j_end - DO i = i_start, i_end - hatavg(i,1,j) = 0.5 * ( & - cf1 * hat(i,1,j-1) + & - cf2 * hat(i,2,j-1) + & - cf3 * hat(i,3,j-1) + & - cf1 * hat(i,1,j ) + & - cf2 * hat(i,2,j ) + & - cf3 * hat(i,3,j ) ) - hatavg(i,kte,j) = 0.5 * ( & - cft1 * ( hat(i,ktes1,j-1) + hat(i,ktes1,j) ) + & - cft2 * ( hat(i,ktes2,j-1) + hat(i,ktes2,j) ) ) - END DO - END DO - - ! tmpzy = averaged value of dpsi/dy (=zy) on vorticity grid - ! tmp1 = partial dpsi/dy * partial du^/dpsi - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tmpzy = 0.25 * ( & - zy(i-1,k ,j) + zy(i,k ,j) + & - zy(i-1,k+1,j) + zy(i,k+1,j) ) - tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) * & - 0.25 * tmpzy * ( rdzw(i,k,j) + rdzw(i-1,k,j) + & - rdzw(i-1,k,j-1) + rdzw(i,k,j-1) ) - END DO - END DO - END DO - -! End calculation of du/dy. -!---------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Add the first term to defor12 (du/dy+dv/dx) at vorticity points. - -! Comments 10-MAR-05 -! Eqn 13d: D12=defor12= m^2 * (partial dv^/dX + partial du^/dY + -! partial dpsi/dx * partial dv^/dpsi + -! partial dpsi/dy * partial du^/dpsi) -! Here deal with m^2 * (partial du^/dY + partial dpsi/dy * partial du^/dpsi) -! Still need to add v^ terms: -! m^2 * (partial dv^/dX + partial dpsi/dx * partial dv^/dpsi) - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - defor12(i,k,j) = mm(i,j) * ( & - rdy * ( hat(i,k,j) - hat(i,k,j-1) ) - tmp1(i,k,j) ) - END DO - END DO - END DO - -! End addition of the first term to defor12. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Calculate dv/dx. - -! Apply a coordinate transformation to meridional velocity, v. - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start-1, i_end - hat(i,k,j) = v(i,k,j) / msfvy(i,j) - END DO - END DO - END DO - -! Account for the slope in x of eta surfaces. - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - hatavg(i,k,j) = 0.5 * ( & - fnm(k) * ( hat(i-1,k ,j) + hat(i,k ,j) ) + & - fnp(k) * ( hat(i-1,k-1,j) + hat(i,k-1,j) ) ) - END DO - END DO - END DO - -! Extrapolate to top and bottom of domain (to w levels). - - DO j = j_start, j_end - DO i = i_start, i_end - hatavg(i,1,j) = 0.5 * ( & - cf1 * hat(i-1,1,j) + & - cf2 * hat(i-1,2,j) + & - cf3 * hat(i-1,3,j) + & - cf1 * hat(i ,1,j) + & - cf2 * hat(i ,2,j) + & - cf3 * hat(i ,3,j) ) - hatavg(i,kte,j) = 0.5 * ( & - cft1 * ( hat(i,ktes1,j) + hat(i-1,ktes1,j) ) + & - cft2 * ( hat(i,ktes2,j) + hat(i-1,ktes2,j) ) ) - END DO - END DO - - ! Fixes to set_physical_bc2/3d have made any check for polar B.C.'s - ! unnecessary in this place. zx, rdzw, and hatavg are all defined - ! in places they need to be and the values at the poles are replications - ! of the values one grid point in, so the averaging over j and j-1 works - ! to act as just using the value at j or j-1 (with out extra code). - ! - ! tmpzx = averaged value of dpsi/dx (=zx) on vorticity grid - ! tmp1 = partial dpsi/dx * partial dv^/dpsi - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tmpzx = 0.25 * ( & - zx(i,k ,j-1) + zx(i,k ,j) + & - zx(i,k+1,j-1) + zx(i,k+1,j) ) - tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) * & - 0.25 * tmpzx * ( rdzw(i,k,j) + rdzw(i,k,j-1) + & - rdzw(i-1,k,j-1) + rdzw(i-1,k,j) ) - END DO - END DO - END DO - -! End calculation of dv/dx. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Add the second term to defor12 (du/dy+dv/dx) at vorticity points. - -! Comments 10-MAR-05 -! Eqn 13d: D12=defor12= m^2 * (partial dv^/dX + partial du^/dY + -! partial dpsi/dx * partial dv^/dpsi + -! partial dpsi/dy * partial du^/dpsi) -! Here adding v^ terms: -! m^2 * (partial dv^/dX + partial dpsi/dx * partial dv^/dpsi) - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - defor12(i,k,j) = defor12(i,k,j) + & - mm(i,j) * ( & - rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) ) - END DO - END DO - END DO - -! End addition of the second term to defor12. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Update the boundary for defor12 (might need to change later). - - IF ( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1 ) THEN - DO j = jts, jte - DO k = kts, kte - defor12(ids,k,j) = defor12(ids+1,k,j) - END DO - END DO - END IF - - IF ( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN - DO k = kts, kte - DO i = its, ite - defor12(i,k,jds) = defor12(i,k,jds+1) - END DO - END DO - END IF - - IF ( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN - DO j = jts, jte - DO k = kts, kte - defor12(ide,k,j) = defor12(ide-1,k,j) - END DO - END DO - END IF - - IF ( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN - DO k = kts, kte - DO i = its, ite - defor12(i,k,jde) = defor12(i,k,jde-1) - END DO - END DO - END IF - -! End update of boundary for defor12. -!----------------------------------------------------------------------- - -! Comments 10-MAR-05 -! Further deformation terms not needed for 2-dimensional Smagorinsky diffusion, -! so those terms have not been dealt with yet. -! A "y" has simply been added to all map scale factors to allow the model to -! compile without errors. - -!----------------------------------------------------------------------- -! Calculate dw/dx. - - i_start = its - i_end = MIN( ite, ide-1 ) - j_start = jts - j_end = MIN( jte, jde-1 ) - - IF ( config_flags%open_xs .OR. config_flags%specified .OR. & - config_flags%nested) i_start = MAX( ids+1, its ) - IF ( config_flags%open_ys .OR. config_flags%specified .OR. & - config_flags%nested) j_start = MAX( jds+1, jts ) - - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN( ite, ide ) - IF ( config_flags%periodic_y ) j_end = MIN( jte, jde ) - -! Square the mapscale factor. - - DO j = jts, jte - DO i = its, ite - mm(i,j) = msfux(i,j) * msfuy(i,j) - END DO - END DO - -! Apply a coordinate transformation to vertical velocity, w. This is for both -! defor13 and defor23. - - DO j = j_start, j_end - DO k = kts, kte - DO i = i_start, i_end - hat(i,k,j) = w(i,k,j) / msfty(i,j) - END DO - END DO - END DO - - i = i_start-1 - DO j = j_start, MIN( jte, jde-1 ) - DO k = kts, kte - hat(i,k,j) = w(i,k,j) / msfty(i,j) - END DO - END DO - - j = j_start-1 - DO k = kts, kte - DO i = i_start, MIN( ite, ide-1 ) - hat(i,k,j) = w(i,k,j) / msfty(i,j) - END DO - END DO - -! QUESTION: What is this for? - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - hatavg(i,k,j) = 0.25 * ( & - hat(i ,k ,j) + & - hat(i ,k+1,j) + & - hat(i-1,k ,j) + & - hat(i-1,k+1,j) ) - END DO - END DO - END DO - -! Calculate dw/dx. - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - tmp1(i,k,j) = ( hatavg(i,k,j) - hatavg(i,k-1,j) ) * zx(i,k,j) * & - 0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) ) - END DO - END DO - END DO - -! End calculation of dw/dx. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Add the first term (dw/dx) to defor13 (dw/dx+du/dz) at vorticity -! points. - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - defor13(i,k,j) = mm(i,j) * ( & - rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) ) - END DO - END DO - END DO - - DO j = j_start, j_end - DO i = i_start, i_end - defor13(i,kts,j ) = 0.0 - defor13(i,ktf+1,j) = 0.0 - END DO - END DO - -! End addition of the first term to defor13. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Calculate du/dz. - - IF ( config_flags%mix_full_fields ) THEN - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - tmp1(i,k,j) = ( u(i,k,j) - u(i,k-1,j) ) * & - 0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) ) - END DO - END DO - END DO - - ELSE - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - tmp1(i,k,j) = ( u(i,k,j) - u_base(k) - u(i,k-1,j) + u_base(k-1) ) * & - 0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) ) - END DO - END DO - END DO - - END IF - -!----------------------------------------------------------------------- -! Add the second term (du/dz) to defor13 (dw/dx+du/dz) at vorticity -! points. - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - defor13(i,k,j) = defor13(i,k,j) + tmp1(i,k,j) - END DO - END DO - END DO - -! End addition of the second term to defor13. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Calculate dw/dy. - - i_start = its - i_end = MIN( ite, ide-1 ) - j_start = jts - j_end = MIN( jte, jde-1 ) - - IF ( config_flags%open_xs .OR. config_flags%specified .OR. & - config_flags%nested) i_start = MAX( ids+1, its ) - IF ( config_flags%open_ys .OR. config_flags%specified .OR. & - config_flags%nested) j_start = MAX( jds+1, jts ) - IF ( config_flags%periodic_y ) j_end = MIN( jte, jde ) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) - -! Square mapscale factor. - - DO j = jts, jte - DO i = its, ite - mm(i,j) = msfvx(i,j) * msfvy(i,j) - END DO - END DO - -! Apply a coordinate transformation to vertical velocity, w. Added by CW 7/19/07 - - DO j = j_start, j_end - DO k = kts, kte - DO i = i_start, i_end - hat(i,k,j) = w(i,k,j) / msftx(i,j) - END DO - END DO - END DO - - i = i_start-1 - DO j = j_start, MIN( jte, jde-1 ) - DO k = kts, kte - hat(i,k,j) = w(i,k,j) / msftx(i,j) - END DO - END DO - - j = j_start-1 - DO k = kts, kte - DO i = i_start, MIN( ite, ide-1 ) - hat(i,k,j) = w(i,k,j) / msftx(i,j) - END DO - END DO - -! QUESTION: What is this for? - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - hatavg(i,k,j) = 0.25 * ( & - hat(i,k ,j ) + & - hat(i,k+1,j ) + & - hat(i,k ,j-1) + & - hat(i,k+1,j-1) ) - END DO - END DO - END DO - -! Calculate dw/dy and store in tmp1. - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - tmp1(i,k,j) = ( hatavg(i,k,j) - hatavg(i,k-1,j) ) * zy(i,k,j) * & - 0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) ) - END DO - END DO - END DO - -! End calculation of dw/dy. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Add the first term (dw/dy) to defor23 (dw/dy+dv/dz) at vorticity -! points. - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - defor23(i,k,j) = mm(i,j) * ( & - rdy * ( hat(i,k,j) - hat(i,k,j-1) ) - tmp1(i,k,j) ) - END DO - END DO - END DO - - DO j = j_start, j_end - DO i = i_start, i_end - defor23(i,kts,j ) = 0.0 - defor23(i,ktf+1,j) = 0.0 - END DO - END DO - -! End addition of the first term to defor23. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Calculate dv/dz. - - IF ( config_flags%mix_full_fields ) THEN - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - tmp1(i,k,j) = ( v(i,k,j) - v(i,k-1,j) ) * & - 0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) ) - END DO - END DO - END DO - - ELSE - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - tmp1(i,k,j) = ( v(i,k,j) - v_base(k) - v(i,k-1,j) + v_base(k-1) ) * & - 0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) ) - END DO - END DO - END DO - - END IF - -! End calculation of dv/dz. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Add the second term (dv/dz) to defor23 (dw/dy+dv/dz) at vorticity -! points. - -! Add tmp1 to defor23. - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - defor23(i,k,j) = defor23(i,k,j) + tmp1(i,k,j) - END DO - END DO - END DO - -! End addition of the second term to defor23. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Update the boundary for defor13 and defor23 (might need to change -! later). - - IF ( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1) THEN - DO j = jts, jte - DO k = kts, kte - defor13(ids,k,j) = defor13(ids+1,k,j) - defor23(ids,k,j) = defor23(ids+1,k,j) - END DO - END DO - END IF - - IF ( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN - DO k = kts, kte - DO i = its, ite - defor13(i,k,jds) = defor13(i,k,jds+1) - defor23(i,k,jds) = defor23(i,k,jds+1) - END DO - END DO - END IF - - IF ( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN - DO j = jts, jte - DO k = kts, kte - defor13(ide,k,j) = defor13(ide-1,k,j) - defor23(ide,k,j) = defor23(ide-1,k,j) - END DO - END DO - END IF - - IF ( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN - DO k = kts, kte - DO i = its, ite - defor13(i,k,jde) = defor13(i,k,jde-1) - defor23(i,k,jde) = defor23(i,k,jde-1) - END DO - END DO - END IF - -! End update of boundary for defor13 and defor23. -!----------------------------------------------------------------------- - -! The second three (defor12, defor13, defor23) of six deformation terms -! are now calculated at vorticity points. -!======================================================================= - - END SUBROUTINE cal_deform_and_div - -!======================================================================= -!======================================================================= - - SUBROUTINE calculate_km_kh( config_flags, dt, & - dampcoef, zdamp, damp_opt, & - xkmh, xkmv, xkhh, xkhv, & - BN2, khdif, kvdif, div, & - defor11, defor22, defor33, & - defor12, defor13, defor23, & - tke, p8w, t8w, theta, t, p, moist, & - dn, dnw, dx, dy, rdz, rdzw, isotropic, & - n_moist, cf1, cf2, cf3, warm_rain, & - mix_upper_bound, & - msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! History: Sep 2003 Changes by George Bryan and Jason Knievel, NCAR -! Oct 2001 Converted to mass core by Bill Skamarock, NCAR -! ... ... - -! Purpose: This routine calculates exchange coefficients for the TKE -! scheme. - -! References: Klemp and Wilhelmson (JAS 1978) -! Deardorff (B-L Meteor 1980) -! Chen and Dudhia (NCAR WRF physics report 2000) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type ), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: n_moist, damp_opt, isotropic, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - LOGICAL, INTENT( IN ) & - :: warm_rain - - REAL, INTENT( IN ) & - :: dx, dy, zdamp, dt, dampcoef, cf1, cf2, cf3, khdif, kvdif - - REAL, DIMENSION( kms:kme ), INTENT( IN ) & - :: dnw, dn - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ), INTENT( INOUT ) & - :: moist - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & - :: xkmv, xkmh, xkhv, xkhh, BN2 - - REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT( IN ) & - :: defor11, defor22, defor33, defor12, defor13, defor23, & - div, rdz, rdzw, p8w, t8w, theta, t, p - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & - :: tke - - REAL, INTENT( IN ) & - :: mix_upper_bound - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: msftx, msfty - -! Local variables. - - INTEGER & - :: i_start, i_end, j_start, j_end, ktf, i, j, k - -! End declarations. -!----------------------------------------------------------------------- - - ktf = MIN( kte, kde-1 ) - i_start = its - i_end = MIN( ite, ide-1 ) - j_start = jts - j_end = MIN( jte, jde-1 ) - - CALL calculate_N2( config_flags, BN2, moist, & - theta, t, p, p8w, t8w, & - dnw, dn, rdz, rdzw, & - n_moist, cf1, cf2, cf3, warm_rain, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! Select a scheme for calculating diffusion coefficients. - - km_coef: SELECT CASE( config_flags%km_opt ) - - CASE (1) - CALL isotropic_km( config_flags, xkmh, xkmv, & - xkhh, xkhv, khdif, kvdif, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - CASE (2) - CALL tke_km( config_flags, xkmh, xkmv, & - xkhh, xkhv, BN2, tke, p8w, t8w, theta, & - rdz, rdzw, dx, dy, dt, isotropic, & - mix_upper_bound, msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - CASE (3) - CALL smag_km( config_flags, xkmh, xkmv, & - xkhh, xkhv, BN2, div, & - defor11, defor22, defor33, & - defor12, defor13, defor23, & - rdzw, dx, dy, dt, isotropic, & - mix_upper_bound, msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - CASE (4) - CALL smag2d_km( config_flags, xkmh, xkmv, & - xkhh, xkhv, defor11, defor22, defor12, & - rdzw, dx, dy, msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - CASE DEFAULT - CALL wrf_error_fatal( 'Please choose diffusion coefficient scheme' ) - - END SELECT km_coef - - IF ( damp_opt .eq. 1 ) THEN - CALL cal_dampkm( config_flags, xkmh, xkhh, xkmv, xkhv, & - dx, dy, dt, dampcoef, rdz, rdzw, zdamp, & - msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - END IF - - END SUBROUTINE calculate_km_kh - -!======================================================================= - -SUBROUTINE cal_dampkm( config_flags,xkmh,xkhh,xkmv,xkhv, & - dx,dy,dt,dampcoef, & - rdz, rdzw ,zdamp, & - msftx, msfty, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , INTENT(IN ) :: zdamp,dx,dy,dt,dampcoef - - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: xkmh , & - xkhh , & - xkmv , & - xkhv - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: rdz, & - rdzw - - REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: msftx, & - msfty -! LOCAL VARS - - INTEGER :: i_start, i_end, j_start, j_end, ktf, ktfm1, i, j, k - REAL :: kmmax,kmmvmax,degrad90,dz,tmp - REAL :: ds - REAL , DIMENSION( its:ite ) :: deltaz - REAL , DIMENSION( its:ite, kts:kte, jts:jte) :: dampk,dampkv - -! End declarations. -!----------------------------------------------------------------------- - - ktf = min(kte,kde-1) - ktfm1 = ktf-1 - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - -! keep upper damping diffusion away from relaxation zones at boundaries if used - IF(config_flags%specified .OR. config_flags%nested)THEN - i_start = MAX(i_start,ids+config_flags%spec_bdy_width-1) - i_end = MIN(i_end,ide-config_flags%spec_bdy_width) - j_start = MAX(j_start,jds+config_flags%spec_bdy_width-1) - j_end = MIN(j_end,jde-config_flags%spec_bdy_width) - ENDIF - - kmmax=dx*dx/dt - degrad90=DEGRAD*90. - DO j = j_start, j_end - - k=ktf - DO i = i_start, i_end - ! Unmodified dx used above may produce very large diffusivities - ! when msftx is very large. And the above formula ignores the fact - ! that dy may now be different from dx as well. Let's fix that by - ! defining a "ds" as the minimum of the "real-space" (physical - ! distance) values of dx and dy, and then using that smallest value - ! to calculate a point-by-point kmmax - ds = MIN(dx/msftx(i,j),dy/msfty(i,j)) - kmmax=ds*ds/dt - -! deltaz(i)=0.5*dnw(k)/zeta_z(i,j) -! dz=dnw(k)/zeta_z(i,j) - dz = 1./rdzw(i,k,j) - deltaz(i) = 0.5*dz - - kmmvmax=dz*dz/dt - tmp=min(deltaz(i)/zdamp,1.) - dampk(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmax*dampcoef - dampkv(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmvmax*dampcoef -! set upper limit on vertical K (based on horizontal K) - dampkv(i,k,j)=min(dampkv(i,k,j),dampk(i,k,j)) - - ENDDO - - DO k = ktfm1,kts,-1 - DO i = i_start, i_end - ! Unmodified dx used above may produce very large diffusivities - ! when msftx is very large. And the above formula ignores the fact - ! that dy may now be different from dx as well. Let's fix that by - ! defining a "ds" as the minimum of the "real-space" (physical - ! distance) values of dx and dy, and then using that smallest value - ! to calculate a point-by-point kmmax - ds = MIN(dx/msftx(i,j),dy/msfty(i,j)) - kmmax=ds*ds/dt - -! deltaz(i)=deltaz(i)+dn(k)/zeta_z(i,j) -! dz=dnw(k)/zeta_z(i,j) - dz = 1./rdz(i,k,j) - deltaz(i) = deltaz(i) + dz - dz = 1./rdzw(i,k,j) - - kmmvmax=dz*dz/dt - tmp=min(deltaz(i)/zdamp,1.) - dampk(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmax*dampcoef - dampkv(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmvmax*dampcoef -! set upper limit on vertical K (based on horizontal K) - dampkv(i,k,j)=min(dampkv(i,k,j),dampk(i,k,j)) - ENDDO - ENDDO - - ENDDO - - DO j = j_start, j_end - DO k = kts,ktf - DO i = i_start, i_end - xkmh(i,k,j)=max(xkmh(i,k,j),dampk(i,k,j)) - xkhh(i,k,j)=max(xkhh(i,k,j),dampk(i,k,j)) - xkmv(i,k,j)=max(xkmv(i,k,j),dampkv(i,k,j)) - xkhv(i,k,j)=max(xkhv(i,k,j),dampkv(i,k,j)) - ENDDO - ENDDO - ENDDO - -END SUBROUTINE cal_dampkm - -!======================================================================= -!======================================================================= - - SUBROUTINE calculate_N2( config_flags, BN2, moist, & - theta, t, p, p8w, t8w, & - dnw, dn, rdz, rdzw, & - n_moist, cf1, cf2, cf3, warm_rain, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type ), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: n_moist, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - LOGICAL, INTENT( IN ) & - :: warm_rain - - REAL, INTENT( IN ) & - :: cf1, cf2, cf3 - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & - :: BN2 - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: rdz, rdzw, theta, t, p, p8w, t8w - - REAL, DIMENSION( kms:kme ), INTENT( IN ) & - :: dnw, dn - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist), INTENT( INOUT ) & - :: moist - -! Local variables. - - INTEGER & - :: i, j, k, ktf, ispe, ktes1, ktes2, & - i_start, i_end, j_start, j_end - - REAL & - :: coefa, thetaep1, thetaem1, qc_cr, es, tc, qlpqi, qsw, qsi, & - tmpdz, xlvqv, thetaesfc, thetasfc, qvtop, qvsfc, thetatop, thetaetop - - REAL, DIMENSION( its:ite, jts:jte ) & - :: tmp1sfc, tmp1top - - REAL, DIMENSION( its:ite, kts:kte, jts:jte ) & - :: tmp1, qvs, qctmp - -! End declarations. -!----------------------------------------------------------------------- - - qc_cr = 0.00001 ! in Kg/Kg - - ktf = MIN( kte, kde-1 ) - ktes1 = kte-1 - ktes2 = kte-2 - - i_start = its - i_end = MIN( ite, ide-1 ) - j_start = jts - j_end = MIN( jte, jde-1 ) - - IF ( config_flags%open_xs .OR. config_flags%specified .OR. & - config_flags%nested) i_start = MAX( ids+1, its ) - IF ( config_flags%open_xe .OR. config_flags%specified .OR. & - config_flags%nested) i_end = MIN( ide-2, ite ) - IF ( config_flags%open_ys .OR. config_flags%specified .OR. & - config_flags%nested) j_start = MAX( jds+1, jts ) - IF ( config_flags%open_ye .OR. config_flags%specified .OR. & - config_flags%nested) j_end = MIN( jde-2 ,jte ) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) - - IF ( P_QC .GT. PARAM_FIRST_SCALAR) THEN - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - qctmp(i,k,j) = moist(i,k,j,P_QC) - END DO - END DO - END DO - ELSE - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - qctmp(i,k,j) = 0.0 - END DO - END DO - END DO - END IF - - DO j = jts, jte - DO k = kts, kte - DO i = its, ite - tmp1(i,k,j) = 0.0 - END DO - END DO - END DO - - DO j = jts,jte - DO i = its,ite - tmp1sfc(i,j) = 0.0 - tmp1top(i,j) = 0.0 - END DO - END DO - - DO ispe = PARAM_FIRST_SCALAR, n_moist - IF ( ispe .EQ. P_QV .OR. ispe .EQ. P_QC .OR. ispe .EQ. P_QI) THEN - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tmp1(i,k,j) = tmp1(i,k,j) + moist(i,k,j,ispe) - END DO - END DO - END DO - - DO j = j_start, j_end - DO i = i_start, i_end - tmp1sfc(i,j) = tmp1sfc(i,j) + & - cf1 * moist(i,1,j,ispe) + & - cf2 * moist(i,2,j,ispe) + & - cf3 * moist(i,3,j,ispe) - tmp1top(i,j) = tmp1top(i,j) + & - moist(i,ktes1,j,ispe) + & - ( moist(i,ktes1,j,ispe) - moist(i,ktes2,j,ispe) ) * & - 0.5 * dnw(ktes1) / dn(ktes1) - END DO - END DO - END IF - END DO - -! Calculate saturation mixing ratio. - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tc = t(i,k,j) - SVPT0 - es = 1000.0 * SVP1 * EXP( SVP2 * tc / ( t(i,k,j) - SVP3 ) ) - qvs(i,k,j) = EP_2 * es / ( p(i,k,j) - es ) - END DO - END DO - END DO - - DO j = j_start, j_end - DO k = kts+1, ktf-1 - DO i = i_start, i_end - tmpdz = 1.0 / rdz(i,k,j) + 1.0 / rdz(i,k+1,j) - IF ( moist(i,k,j,P_QV) .GE. qvs(i,k,j) .OR. qctmp(i,k,j) .GE. qc_cr) THEN - xlvqv = XLV * moist(i,k,j,P_QV) - coefa = ( 1.0 + xlvqv / R_d / t(i,k,j) ) / & - ( 1.0 + XLV * xlvqv / Cp / R_v / t(i,k,j) / t(i,k,j) ) / & - theta(i,k,j) - thetaep1 = theta(i,k+1,j) * & - ( 1.0 + XLV * qvs(i,k+1,j) / Cp / t(i,k+1,j) ) - thetaem1 = theta(i,k-1,j) * & - ( 1.0 + XLV * qvs(i,k-1,j) / Cp / t(i,k-1,j) ) - BN2(i,k,j) = g * ( coefa * ( thetaep1 - thetaem1 ) / tmpdz - & - ( tmp1(i,k+1,j) - tmp1(i,k-1,j) ) / tmpdz ) - ELSE - BN2(i,k,j) = g * ( (theta(i,k+1,j) - theta(i,k-1,j) ) / & - theta(i,k,j) / tmpdz + & - 1.61 * ( moist(i,k+1,j,P_QV) - moist(i,k-1,j,P_QV) ) / & - tmpdz - & - ( tmp1(i,k+1,j) - tmp1(i,k-1,j) ) / tmpdz ) - ENDIF - END DO - END DO - END DO - - k = kts - DO j = j_start, j_end - DO i = i_start, i_end - tmpdz = 1.0 / rdz(i,k+1,j) + 0.5 / rdzw(i,k,j) - thetasfc = T8w(i,kts,j) / ( p8w(i,k,j) / p1000mb )**( R_d / Cp ) - IF ( moist(i,k,j,P_QV) .GE. qvs(i,k,j) .OR. qctmp(i,k,j) .GE. qc_cr) THEN - qvsfc = cf1 * qvs(i,1,j) + & - cf2 * qvs(i,2,j) + & - cf3 * qvs(i,3,j) - xlvqv = XLV * moist(i,k,j,P_QV) - coefa = ( 1.0 + xlvqv / R_d / t(i,k,j) ) / & - ( 1.0 + XLV * xlvqv / Cp / R_v / t(i,k,j) / t(i,k,j) ) / & - theta(i,k,j) - thetaep1 = theta(i,k+1,j) * & - ( 1.0 + XLV * qvs(i,k+1,j) / Cp / t(i,k+1,j) ) - thetaesfc = thetasfc * & - ( 1.0 + XLV * qvsfc / Cp / t8w(i,kts,j) ) - BN2(i,k,j) = g * ( coefa * ( thetaep1 - thetaesfc ) / tmpdz - & - ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz ) - ELSE - qvsfc = cf1 * moist(i,1,j,P_QV) + & - cf2 * moist(i,2,j,P_QV) + & - cf3 * moist(i,3,j,P_QV) -! BN2(i,k,j) = g * ( ( theta(i,k+1,j) - thetasfc ) / & -! theta(i,k,j) / tmpdz + & -! 1.61 * ( moist(i,k+1,j,P_QV) - qvsfc ) / & -! tmpdz - & -! ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz ) -!...... MARTA: change in computation of BN2 at the surface, WCS 040331 - - tmpdz= 1./rdzw(i,k,j) ! controlare come calcola rdzw - BN2(i,k,j) = g * ( ( theta(i,k+1,j) - theta(i,k,j)) / & - theta(i,k,j) / tmpdz + & - 1.61 * ( moist(i,k+1,j,P_QV) - qvsfc ) / & - tmpdz - & - ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz ) -! end of MARTA/WCS change - - ENDIF - END DO - END DO - - -!...... MARTA: change in computation of BN2 at the top, WCS 040331 - DO j = j_start, j_end - DO i = i_start, i_end - BN2(i,ktf,j)=BN2(i,ktf-1,j) - END DO - END DO -! end of MARTA/WCS change - - END SUBROUTINE calculate_N2 - -!======================================================================= -!======================================================================= - -SUBROUTINE isotropic_km( config_flags, & - xkmh,xkmv,xkhh,xkhv,khdif,kvdif, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , INTENT(IN ) :: khdif,kvdif - - REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: xkmh, & - xkmv, & - xkhh, & - xkhv -! LOCAL VARS - - INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k - REAL :: khdif3,kvdif3 - -! End declarations. -!----------------------------------------------------------------------- - - ktf = kte - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - -! khdif3=khdif*3. -! kvdif3=kvdif*3. - khdif3=khdif/prandtl - kvdif3=kvdif/prandtl - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - xkmh(i,k,j)=khdif - xkmv(i,k,j)=kvdif - xkhh(i,k,j)=khdif3 - xkhv(i,k,j)=kvdif3 - ENDDO - ENDDO - ENDDO - -END SUBROUTINE isotropic_km - -!======================================================================= -!======================================================================= - -SUBROUTINE smag_km( config_flags,xkmh,xkmv,xkhh,xkhv,BN2, & - div,defor11,defor22,defor33,defor12, & - defor13,defor23, & - rdzw,dx,dy,dt,isotropic, & - mix_upper_bound, msftx, msfty, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER , INTENT(IN ) :: isotropic - REAL , INTENT(IN ) :: dx, dy, dt, mix_upper_bound - - - REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: BN2, & - rdzw - - REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: xkmh, & - xkmv, & - xkhh, & - xkhv - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN ) :: & - defor11, & - defor22, & - defor33, & - defor12, & - defor13, & - defor23, & - div - REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: msftx, & - msfty -! LOCAL VARS - - INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k - REAL :: deltas, tmp, pr, mlen_h, mlen_v, c_s - - REAL, DIMENSION( its:ite , kts:kte , jts:jte ) :: def2 - -! End declarations. -!----------------------------------------------------------------------- - - ktf = min(kte,kde-1) - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .or. config_flags%specified .or. & - config_flags%nested) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. config_flags%specified .or. & - config_flags%nested) i_end = MIN(ide-2,ite) - IF ( config_flags%open_ys .or. config_flags%specified .or. & - config_flags%nested) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. config_flags%specified .or. & - config_flags%nested) j_end = MIN(jde-2,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) - - pr = prandtl - c_s = config_flags%c_s - - do j=j_start,j_end - do k=kts,ktf - do i=i_start,i_end - def2(i,k,j)=0.5*(defor11(i,k,j)*defor11(i,k,j) + & - defor22(i,k,j)*defor22(i,k,j) + & - defor33(i,k,j)*defor33(i,k,j)) - enddo - enddo - enddo - - do j=j_start,j_end - do k=kts,ktf - do i=i_start,i_end - tmp=0.25*(defor12(i ,k,j)+defor12(i ,k,j+1)+ & - defor12(i+1,k,j)+defor12(i+1,k,j+1)) - def2(i,k,j)=def2(i,k,j)+tmp*tmp - enddo - enddo - enddo - - do j=j_start,j_end - do k=kts,ktf - do i=i_start,i_end - tmp=0.25*(defor13(i ,k+1,j)+defor13(i ,k,j)+ & - defor13(i+1,k+1,j)+defor13(i+1,k,j)) - def2(i,k,j)=def2(i,k,j)+tmp*tmp - enddo - enddo - enddo - - do j=j_start,j_end - do k=kts,ktf - do i=i_start,i_end - tmp=0.25*(defor23(i,k+1,j )+defor23(i,k,j )+ & - defor23(i,k+1,j+1)+defor23(i,k,j+1)) - def2(i,k,j)=def2(i,k,j)+tmp*tmp - enddo - enddo - enddo -! - IF (isotropic .EQ. 0) THEN - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - mlen_h=sqrt(dx/msftx(i,j) * dy/msfty(i,j)) - mlen_v= 1./rdzw(i,k,j) - tmp=max(0.,def2(i,k,j)-BN2(i,k,j)/pr) - tmp=tmp**0.5 - xkmh(i,k,j)=max(c_s*c_s*mlen_h*mlen_h*tmp, 1.0E-6*mlen_h*mlen_h ) - xkmh(i,k,j)=min(xkmh(i,k,j), mix_upper_bound * mlen_h * mlen_h / dt ) - xkmv(i,k,j)=max(c_s*c_s*mlen_v*mlen_v*tmp, 1.0E-6*mlen_v*mlen_v ) - xkmv(i,k,j)=min(xkmv(i,k,j), mix_upper_bound * mlen_v * mlen_v / dt ) - xkhh(i,k,j)=xkmh(i,k,j)/pr - xkhh(i,k,j)=min(xkhh(i,k,j), mix_upper_bound * mlen_h * mlen_h / dt ) - xkhv(i,k,j)=xkmv(i,k,j)/pr - xkhv(i,k,j)=min(xkhv(i,k,j), mix_upper_bound * mlen_v * mlen_v / dt ) - ENDDO - ENDDO - ENDDO - ELSE - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - deltas=(dx/msftx(i,j) * dy/msfty(i,j)/rdzw(i,k,j))**0.33333333 - tmp=max(0.,def2(i,k,j)-BN2(i,k,j)/pr) - tmp=tmp**0.5 - xkmh(i,k,j)=max(c_s*c_s*deltas*deltas*tmp, 1.0E-6*deltas*deltas ) - xkmh(i,k,j)=min(xkmh(i,k,j), mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt ) - xkmv(i,k,j)=xkmh(i,k,j) - xkmv(i,k,j)=min(xkmv(i,k,j), mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt ) - xkhh(i,k,j)=xkmh(i,k,j)/pr - xkhh(i,k,j)=min(xkhh(i,k,j), mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt ) - xkhv(i,k,j)=xkmv(i,k,j)/pr - xkhv(i,k,j)=min(xkhv(i,k,j), mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt ) - ENDDO - ENDDO - ENDDO - ENDIF - -END SUBROUTINE smag_km - -!======================================================================= -!======================================================================= - -SUBROUTINE smag2d_km( config_flags,xkmh,xkmv,xkhh,xkhv, & - defor11,defor22,defor12, & - rdzw,dx,dy,msftx, msfty, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , INTENT(IN ) :: dx, dy - - - REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: rdzw - - REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: xkmh, & - xkmv, & - xkhh, & - xkhv - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN ) :: & - defor11, & - defor22, & - defor12 - - REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: msftx, & - msfty -! LOCAL VARS - - INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k - REAL :: deltas, tmp, pr, mlen_h, c_s - - REAL, DIMENSION( its:ite , kts:kte , jts:jte ) :: def2 - -! End declarations. -!----------------------------------------------------------------------- - - ktf = min(kte,kde-1) - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .or. config_flags%specified .or. & - config_flags%nested) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. config_flags%specified .or. & - config_flags%nested) i_end = MIN(ide-2,ite) - IF ( config_flags%open_ys .or. config_flags%specified .or. & - config_flags%nested) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. config_flags%specified .or. & - config_flags%nested) j_end = MIN(jde-2,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) - - pr=prandtl - c_s = config_flags%c_s - - do j=j_start,j_end - do k=kts,ktf - do i=i_start,i_end - def2(i,k,j)=0.25*((defor11(i,k,j)-defor22(i,k,j))*(defor11(i,k,j)-defor22(i,k,j))) - tmp=0.25*(defor12(i ,k,j)+defor12(i ,k,j+1)+ & - defor12(i+1,k,j)+defor12(i+1,k,j+1)) - def2(i,k,j)=def2(i,k,j)+tmp*tmp - enddo - enddo - enddo -! - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - mlen_h=sqrt(dx/msftx(i,j) * dy/msfty(i,j)) - tmp=sqrt(def2(i,k,j)) -! xkmh(i,k,j)=max(c_s*c_s*mlen_h*mlen_h*tmp, 1.0E-6*mlen_h*mlen_h ) - xkmh(i,k,j)=c_s*c_s*mlen_h*mlen_h*tmp - xkmh(i,k,j)=min(xkmh(i,k,j), 10.*mlen_h ) - xkmv(i,k,j)=0. - xkhh(i,k,j)=xkmh(i,k,j)/pr - xkhv(i,k,j)=0. - ENDDO - ENDDO - ENDDO - -END SUBROUTINE smag2d_km - -!======================================================================= -!======================================================================= - - SUBROUTINE tke_km( config_flags, xkmh, xkmv, xkhh, xkhv, & - bn2, tke, p8w, t8w, theta, & - rdz, rdzw, dx,dy, dt, isotropic, & - mix_upper_bound, msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! History: Sep 2003 Changes by Jason Knievel and George Bryan, NCAR -! Oct 2001 Converted to mass core by Bill Skamarock, NCAR -! ... ... - -! Purpose: This routine calculates the exchange coefficients for the -! TKE turbulence parameterization. - -! References: Klemp and Wilhelmson (JAS 1978) -! Chen and Dudhia (NCAR WRF physics report 2000) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type ), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER, INTENT( IN ) :: isotropic - REAL, INTENT( IN ) & - :: dx, dy, dt - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: tke, p8w, t8w, theta, rdz, rdzw, bn2 - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & - :: xkmh, xkmv, xkhh, xkhv - - REAL, INTENT( IN ) & - :: mix_upper_bound - - REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: msftx, & - msfty -! Local variables. - - REAL, DIMENSION( its:ite, kts:kte, jts:jte ) & - :: l_scale - - REAL, DIMENSION( its:ite, kts:kte, jts:jte ) & - :: dthrdn - - REAL & - :: deltas, tmp, mlen_s, mlen_h, mlen_v, tmpdz, & - thetasfc, thetatop, minkx, pr_inv, pr_inv_h, pr_inv_v, c_k - - INTEGER & - :: i_start, i_end, j_start, j_end, ktf, i, j, k - - REAL, PARAMETER :: tke_seed_value = 1.e-06 - REAL :: tke_seed - REAL, PARAMETER :: epsilon = 1.e-10 - -! End declarations. -!----------------------------------------------------------------------- - - ktf = MIN( kte, kde-1 ) - i_start = its - i_end = MIN( ite, ide-1 ) - j_start = jts - j_end = MIN( jte, jde-1 ) - - IF ( config_flags%open_xs .OR. config_flags%specified .OR. & - config_flags%nested) i_start = MAX( ids+1, its ) - IF ( config_flags%open_xe .OR. config_flags%specified .OR. & - config_flags%nested) i_end = MIN( ide-2, ite ) - IF ( config_flags%open_ys .OR. config_flags%specified .OR. & - config_flags%nested) j_start = MAX( jds+1, jts ) - IF ( config_flags%open_ye .OR. config_flags%specified .OR. & - config_flags%nested) j_end = MIN( jde-2, jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) - -! in the absence of surface drag or a surface heat flux, there -! is no way to generate tke without pre-existing tke. Use -! tke_seed if the drag and flux are off. - - c_k = config_flags%c_k - tke_seed = tke_seed_value - if( (config_flags%tke_drag_coefficient .gt. epsilon) .or. & - (config_flags%tke_heat_flux .gt. epsilon) ) tke_seed = 0. - - DO j = j_start, j_end - DO k = kts+1, ktf-1 - DO i = i_start, i_end - tmpdz = 1.0 / ( rdz(i,k+1,j) + rdz(i,k,j) ) - dthrdn(i,k,j) = ( theta(i,k+1,j) - theta(i,k-1,j) ) / tmpdz - END DO - END DO - END DO - - k = kts - DO j = j_start, j_end - DO i = i_start, i_end - tmpdz = 1.0 / ( rdzw(i,k+1,j) + rdzw(i,k,j) ) - thetasfc = T8w(i,kts,j) / ( p8w(i,k,j) / p1000mb )**( R_d / Cp ) - dthrdn(i,k,j) = ( theta(i,k+1,j) - thetasfc ) / tmpdz - END DO - END DO - - k = ktf - DO j = j_start, j_end - DO i = i_start, i_end - tmpdz = 1.0 / rdz(i,k,j) + 0.5 / rdzw(i,k,j) - thetatop = T8w(i,kde,j) / ( p8w(i,kde,j) / p1000mb )**( R_d / Cp ) - dthrdn(i,k,j) = ( thetatop - theta(i,k-1,j) ) / tmpdz - END DO - END DO - - IF ( isotropic .EQ. 0 ) THEN - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - mlen_h = SQRT( dx/msftx(i,j) * dy/msfty(i,j) ) - tmp = SQRT( MAX( tke(i,k,j), tke_seed ) ) - deltas = 1.0 / rdzw(i,k,j) - mlen_v = deltas - IF ( dthrdn(i,k,j) .GT. 0.) THEN - mlen_s = 0.76 * tmp / ( ABS( g / theta(i,k,j) * dthrdn(i,k,j) ) )**0.5 - mlen_v = MIN( mlen_v, mlen_s ) - END IF - xkmh(i,k,j) = MAX( c_k * tmp * mlen_h, 1.0E-6 * mlen_h * mlen_h ) - xkmh(i,k,j) = MIN( xkmh(i,k,j), mix_upper_bound * mlen_h *mlen_h / dt ) - xkmv(i,k,j) = MAX( c_k * tmp * mlen_v, 1.0E-6 * deltas * deltas ) - xkmv(i,k,j) = MIN( xkmv(i,k,j), mix_upper_bound * deltas *deltas / dt ) - pr_inv_h = 1./prandtl - pr_inv_v = 1.0 + 2.0 * mlen_v / deltas - xkhh(i,k,j) = xkmh(i,k,j) * pr_inv_h - xkhv(i,k,j) = xkmv(i,k,j) * pr_inv_v - END DO - END DO - END DO - ELSE - CALL calc_l_scale( config_flags, tke, BN2, l_scale, & - i_start, i_end, ktf, j_start, j_end, & - dx, dy, rdzw, msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tmp = SQRT( MAX( tke(i,k,j), tke_seed ) ) - deltas = ( dx/msftx(i,j) * dy/msfty(i,j) / rdzw(i,k,j) )**0.33333333 - xkmh(i,k,j) = c_k * tmp * l_scale(i,k,j) - xkmh(i,k,j) = MIN( mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt, xkmh(i,k,j) ) - xkmv(i,k,j) = c_k * tmp * l_scale(i,k,j) - xkmv(i,k,j) = MIN( mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt , xkmv(i,k,j) ) - pr_inv = 1.0 + 2.0 * l_scale(i,k,j) / deltas - xkhh(i,k,j) = MIN( mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt, xkmh(i,k,j) * pr_inv ) - xkhv(i,k,j) = MIN( mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt, xkmv(i,k,j) * pr_inv ) - END DO - END DO - END DO - END IF - - END SUBROUTINE tke_km - -!======================================================================= -!======================================================================= - - SUBROUTINE calc_l_scale( config_flags, tke, BN2, l_scale, & - i_start, i_end, ktf, j_start, j_end, & - dx, dy, rdzw, msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! History: Sep 2003 Written by Bryan and Knievel, NCAR - -! Purpose: This routine calculates the length scale, based on stability, -! for TKE parameterization of subgrid-scale turbulence. - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type ), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: i_start, i_end, ktf, j_start, j_end, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: BN2, tke, rdzw - - REAL, INTENT( IN ) & - :: dx, dy - - REAL, DIMENSION( its:ite, kts:kte, jts:jte ), INTENT( OUT ) & - :: l_scale - - REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: msftx, & - msfty -! Local variables. - - INTEGER & - :: i, j, k - - REAL & - :: deltas, tmp - -! End declarations. -!----------------------------------------------------------------------- - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - deltas = ( dx/msftx(i,j) * dy/msfty(i,j) / rdzw(i,k,j) )**0.33333333 - l_scale(i,k,j) = deltas - - IF ( BN2(i,k,j) .gt. 1.0e-6 ) THEN - tmp = SQRT( MAX( tke(i,k,j), 1.0e-6 ) ) - l_scale(i,k,j) = 0.76 * tmp / SQRT( BN2(i,k,j) ) - l_scale(i,k,j) = MIN( l_scale(i,k,j), deltas) - l_scale(i,k,j) = MAX( l_scale(i,k,j), 0.001 * deltas ) - END IF - - END DO - END DO - END DO - - END SUBROUTINE calc_l_scale - -!======================================================================= -!======================================================================= - -SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & - tke_tendf, & - moist_tendf, n_moist, & - chem_tendf, n_chem, & - scalar_tendf, n_scalar, & - thp, theta, mu, tke, config_flags, & - defor11, defor22, defor12, & - defor13, defor23, div, & - moist, chem, scalar, & - msfux, msfuy, msfvx, msfvy, & - msftx, msfty, xkmh, xkhh,km_opt, & - rdx, rdy, rdz, rdzw, fnm, fnp, & - cf1, cf2, cf3, zx, zy, dn, dnw, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER , INTENT(IN ) :: n_moist, n_chem, n_scalar, km_opt - - REAL , INTENT(IN ) :: cf1, cf2, cf3 - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dn - - REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfux, & - msfuy, & - msfvx, & - msfvy, & - msftx, & - msfty, & - mu - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::rt_tendf,& - ru_tendf,& - rv_tendf,& - rw_tendf,& - tke_tendf - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist), & - INTENT(INOUT) :: moist_tendf - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem), & - INTENT(INOUT) :: chem_tendf - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar), & - INTENT(INOUT) :: scalar_tendf - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist), & - INTENT(IN ) :: moist - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem), & - INTENT(IN ) :: chem - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar) , & - INTENT(IN ) :: scalar - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) ::defor11, & - defor22, & - defor12, & - defor13, & - defor23, & - div, & - xkmh, & - xkhh, & - zx, & - zy, & - theta, & - thp, & - tke, & - rdz, & - rdzw - - - REAL , INTENT(IN ) :: rdx, & - rdy - -! LOCAL VARS - - INTEGER :: im, ic, is - -! REAL , DIMENSION(its-1:ite+1, kts:kte, jts-1:jte+1) :: xkhh - -! End declarations. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Call diffusion subroutines. - - CALL horizontal_diffusion_u_2( ru_tendf, mu, config_flags, & - defor11, defor12, div, & - tke(ims,kms,jms), & - msfux, msfuy, xkmh, rdx, rdy, fnm, fnp, & - zx, zy, rdzw, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL horizontal_diffusion_v_2( rv_tendf, mu, config_flags, & - defor12, defor22, div, & - tke(ims,kms,jms), & - msfvx, msfvy, xkmh, rdx, rdy, fnm, fnp, & - zx, zy, rdzw, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL horizontal_diffusion_w_2( rw_tendf, mu, config_flags, & - defor13, defor23, div, & - tke(ims,kms,jms), & - msftx, msfty, xkmh, rdx, rdy, fnm, fnp, & - zx, zy, rdz, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL horizontal_diffusion_s ( rt_tendf, mu, config_flags, thp, & - msftx, msfty, msfux, msfuy, & - msfvx, msfvy, xkhh, rdx, rdy, & - fnm, fnp, cf1, cf2, cf3, & - zx, zy, rdz, rdzw, dnw, dn, & - .false., & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IF (km_opt .eq. 2) & - CALL horizontal_diffusion_s ( tke_tendf(ims,kms,jms), & - mu, config_flags, & - tke(ims,kms,jms), & - msftx, msfty, msfux, msfuy, & - msfvx, msfvy, xkhh, rdx, rdy, & - fnm, fnp, cf1, cf2, cf3, & - zx, zy, rdz, rdzw, dnw, dn, & - .true., & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IF (n_moist .ge. PARAM_FIRST_SCALAR) THEN - - moist_loop: do im = PARAM_FIRST_SCALAR, n_moist - - CALL horizontal_diffusion_s( moist_tendf(ims,kms,jms,im), & - mu, config_flags, & - moist(ims,kms,jms,im), & - msftx, msfty, msfux, msfuy, & - msfvx, msfvy, xkhh, rdx, rdy, & - fnm, fnp, cf1, cf2, cf3, & - zx, zy, rdz, rdzw, dnw, dn, & - .false., & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - ENDDO moist_loop - - ENDIF - - IF (n_chem .ge. PARAM_FIRST_SCALAR) THEN - - chem_loop: do ic = PARAM_FIRST_SCALAR, n_chem - - CALL horizontal_diffusion_s( chem_tendf(ims,kms,jms,ic), & - mu, config_flags, & - chem(ims,kms,jms,ic), & - msftx, msfty, msfux, msfuy, & - msfvx, msfvy, xkhh, rdx, rdy, & - fnm, fnp, cf1, cf2, cf3, & - zx, zy, rdz, rdzw, dnw, dn, & - .false., & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - ENDDO chem_loop - - ENDIF - IF (n_scalar .ge. PARAM_FIRST_SCALAR) THEN - - scalar_loop: do is = PARAM_FIRST_SCALAR, n_scalar - - CALL horizontal_diffusion_s( scalar_tendf(ims,kms,jms,is), & - mu, config_flags, & - scalar(ims,kms,jms,is), & - msftx, msfty, msfux, msfuy, & - msfvx, msfvy, xkhh, rdx, rdy, & - fnm, fnp, cf1, cf2, cf3, & - zx, zy, rdz, rdzw, dnw, dn, & - .false., & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - ENDDO scalar_loop - - ENDIF - - END SUBROUTINE horizontal_diffusion_2 - -!======================================================================= -!======================================================================= - -SUBROUTINE horizontal_diffusion_u_2( tendency, mu, config_flags, & - defor11, defor12, div, tke, & - msfux, msfuy, & - xkmh, rdx, rdy, fnm, fnp, & - zx, zy, rdzw, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp - - REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfux, & - msfuy, & - mu - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: rdzw - - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) ::defor11, & - defor12, & - div, & - tke, & - xkmh, & - zx, & - zy - - REAL , INTENT(IN ) :: rdx, & - rdy -! Local data - - INTEGER :: i, j, k, ktf - - INTEGER :: i_start, i_end, j_start, j_end - INTEGER :: is_ext,ie_ext,js_ext,je_ext - - REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau1avg, & - titau2avg, & - titau1, & - titau2, & - xkxavg, & - rravg -! new -! zxavg, & -! zyavg - REAL :: mrdx, mrdy, rcoup - - REAL :: tmpzy, tmpzeta_z - - REAL :: term1, term2, term3 - -! End declarations. -!----------------------------------------------------------------------- - - ktf=MIN(kte,kde-1) - -!----------------------------------------------------------------------- -! u : p (.), u(|), w(-) -! -! p u p u u u -! -! p | . | . | . | k+1 | . | . | . | k+1 -! -! w - 13 - - k+1 13 k+1 -! -! p | 11 O 11 | . | k | 12 O 12 | . | k -! -! w - 13 - - k 13 k -! -! p | . | . | . | k-1 | . | . | . | k-1 -! -! i-1 i i i+1 j-1 j j j+1 j+1 -! - - i_start = its - i_end = ite - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .or. config_flags%specified .or. & - config_flags%nested) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. config_flags%specified .or. & - config_flags%nested) i_end = MIN(ide-1,ite) - IF ( config_flags%open_ys .or. config_flags%specified .or. & - config_flags%nested) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. config_flags%specified .or. & - config_flags%nested) j_end = MIN(jde-2,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = ite - -! titau1 = titau11 - is_ext=1 - ie_ext=0 - js_ext=0 - je_ext=0 - CALL cal_titau_11_22_33( config_flags, titau1, & - mu, tke, xkmh, defor11, & - is_ext, ie_ext, js_ext, je_ext, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! titau2 = titau12 - is_ext=0 - ie_ext=0 - js_ext=0 - je_ext=1 - CALL cal_titau_12_21( config_flags, titau2, & - mu, xkmh, defor12, & - is_ext, ie_ext, js_ext, je_ext, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! titau1avg = titau11avg -! titau2avg = titau12avg - - DO j = j_start, j_end - DO k = kts+1,ktf - DO i = i_start, i_end - titau1avg(i,k,j)=0.5*(fnm(k)*(titau1(i-1,k ,j)+titau1(i,k ,j))+ & - fnp(k)*(titau1(i-1,k-1,j)+titau1(i,k-1,j))) - titau2avg(i,k,j)=0.5*(fnm(k)*(titau2(i,k ,j+1)+titau2(i,k ,j))+ & - fnp(k)*(titau2(i,k-1,j+1)+titau2(i,k-1,j))) - tmpzy = 0.25*( zy(i-1,k,j )+zy(i,k,j )+ & - zy(i-1,k,j+1)+zy(i,k,j+1) ) -! tmpzeta_z = 0.5*(zeta_z(i,j)+zeta_z(i-1,j)) -! titau1avg(i,k,j)=titau1avg(i,k,j)*zx(i,k,j)*tmpzeta_z -! titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy *tmpzeta_z - - titau1avg(i,k,j)=titau1avg(i,k,j)*zx(i,k,j) - titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy - - ENDDO - ENDDO - ENDDO -! - DO j = j_start, j_end - DO i = i_start, i_end - titau1avg(i,kts,j)=0. - titau1avg(i,ktf+1,j)=0. - titau2avg(i,kts,j)=0. - titau2avg(i,ktf+1,j)=0. - ENDDO - ENDDO -! - DO j = j_start, j_end - DO k = kts,ktf - DO i = i_start, i_end - - mrdx=msfux(i,j)*rdx - mrdy=msfuy(i,j)*rdy - tendency(i,k,j)=tendency(i,k,j)- & - (mrdx*(titau1(i,k,j )-titau1(i-1,k,j))+ & - mrdy*(titau2(i,k,j+1)-titau2(i,k,j ))- & - msfuy(i,j)*rdzw(i,k,j)*((titau1avg(i,k+1,j)-titau1avg(i,k,j))+ & - (titau2avg(i,k+1,j)-titau2avg(i,k,j)) & - ) ) - ENDDO - ENDDO - ENDDO - -END SUBROUTINE horizontal_diffusion_u_2 - -!======================================================================= -!======================================================================= - -SUBROUTINE horizontal_diffusion_v_2( tendency, mu, config_flags, & - defor12, defor22, div, tke, & - msfvx, msfvy, & - xkmh, rdx, rdy, fnm, fnp, & - zx, zy, rdzw, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp - - REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfvx, & - msfvy, & - mu - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) ::defor12, & - defor22, & - div, & - tke, & - xkmh, & - zx, & - zy, & - rdzw - - REAL , INTENT(IN ) :: rdx, & - rdy - -! Local data - - INTEGER :: i, j, k, ktf - - INTEGER :: i_start, i_end, j_start, j_end - INTEGER :: is_ext,ie_ext,js_ext,je_ext - - REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau1avg, & - titau2avg, & - titau1, & - titau2, & - xkxavg, & - rravg -! new -! zxavg, & -! zyavg - - REAL :: mrdx, mrdy, rcoup - - REAL :: tmpzx, tmpzeta_z - -! End declarations. -!----------------------------------------------------------------------- - - ktf=MIN(kte,kde-1) - -!----------------------------------------------------------------------- -! v : p (.), v(+), w(-) -! -! p v p v v v -! -! p + . + . + . + k+1 + . + . + . + k+1 -! -! w - 23 - - k+1 23 k+1 -! -! p + 22 O 22 + . + k + 21 O 21 + . + k -! -! w - 23 - - k 23 k -! -! p + . + . + . + k-1 + . + . + . + k-1 -! -! j-1 j j j+1 i-1 i i i+1 i+1 -! - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = jte - - IF ( config_flags%open_xs .or. config_flags%specified .or. & - config_flags%nested) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. config_flags%specified .or. & - config_flags%nested) i_end = MIN(ide-2,ite) - IF ( config_flags%open_ys .or. config_flags%specified .or. & - config_flags%nested) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. config_flags%specified .or. & - config_flags%nested) j_end = MIN(jde-1,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) - -! titau1 = titau21 - is_ext=0 - ie_ext=1 - js_ext=0 - je_ext=0 - CALL cal_titau_12_21( config_flags, titau1, & - mu, xkmh, defor12, & - is_ext,ie_ext,js_ext,je_ext, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! titau2 = titau22 - is_ext=0 - ie_ext=0 - js_ext=1 - je_ext=0 - CALL cal_titau_11_22_33( config_flags, titau2, & - mu, tke, xkmh, defor22, & - is_ext, ie_ext, js_ext, je_ext, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - DO j = j_start, j_end - DO k = kts+1,ktf - DO i = i_start, i_end - titau1avg(i,k,j)=0.5*(fnm(k)*(titau1(i+1,k ,j)+titau1(i,k ,j))+ & - fnp(k)*(titau1(i+1,k-1,j)+titau1(i,k-1,j))) - titau2avg(i,k,j)=0.5*(fnm(k)*(titau2(i,k ,j-1)+titau2(i,k ,j))+ & - fnp(k)*(titau2(i,k-1,j-1)+titau2(i,k-1,j))) - - tmpzx = 0.25*( zx(i,k,j )+zx(i+1,k,j )+ & - zx(i,k,j-1)+zx(i+1,k,j-1) ) - - - titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx - titau2avg(i,k,j)=titau2avg(i,k,j)*zy(i,k,j) - - - ENDDO - ENDDO - ENDDO - - DO j = j_start, j_end - DO i = i_start, i_end - titau1avg(i,kts,j)=0. - titau1avg(i,ktf+1,j)=0. - titau2avg(i,kts,j)=0. - titau2avg(i,ktf+1,j)=0. - ENDDO - ENDDO -! - DO j = j_start, j_end - DO k = kts,ktf - DO i = i_start, i_end - - mrdx=msfvx(i,j)*rdx - mrdy=msfvy(i,j)*rdy - tendency(i,k,j)=tendency(i,k,j)- & - (mrdy*(titau2(i ,k,j)-titau2(i,k,j-1))+ & - mrdx*(titau1(i+1,k,j)-titau1(i,k,j ))- & - msfvy(i,j)*rdzw(i,k,j)*((titau1avg(i,k+1,j)-titau1avg(i,k,j))+ & - (titau2avg(i,k+1,j)-titau2avg(i,k,j)) & - ) & - ) - - ENDDO - ENDDO - ENDDO - -END SUBROUTINE horizontal_diffusion_v_2 - -!======================================================================= -!======================================================================= - -SUBROUTINE horizontal_diffusion_w_2( tendency, mu, config_flags, & - defor13, defor23, div, tke, & - msftx, msfty, & - xkmh, rdx, rdy, fnm, fnp, & - zx, zy, rdz, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp - - REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msftx, & - msfty, & - mu - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) ::defor13, & - defor23, & - div, & - tke, & - xkmh, & - zx, & - zy, & - rdz - - REAL , INTENT(IN ) :: rdx, & - rdy - -! Local data - - INTEGER :: i, j, k, ktf - - INTEGER :: i_start, i_end, j_start, j_end - INTEGER :: is_ext,ie_ext,js_ext,je_ext - - REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau1avg, & - titau2avg, & - titau1, & - titau2, & - xkxavg, & - rravg -! new -! zxavg, & -! zyavg - - REAL :: mrdx, mrdy, rcoup - - REAL :: tmpzx, tmpzy, tmpzeta_z - -! End declarations. -!----------------------------------------------------------------------- - - ktf=MIN(kte,kde-1) - -!----------------------------------------------------------------------- -! w : p (.), u(|), v(+), w(-) -! -! p u p u p v p v -! -! w - - - k+1 w - - - k+1 -! -! p . | 33 | . k p . + 33 + . k -! -! w - 31 O 31 - k w - 32 O 32 - k -! -! p . | 33 | . k-1 p . | 33 | . k-1 -! -! w - - - k-1 w - - - k-1 -! -! i-1 i i i+1 j-1 j j j+1 -! - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .or. config_flags%specified .or. & - config_flags%nested) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. config_flags%specified .or. & - config_flags%nested) i_end = MIN(ide-2,ite) - IF ( config_flags%open_ys .or. config_flags%specified .or. & - config_flags%nested) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. config_flags%specified .or. & - config_flags%nested) j_end = MIN(jde-2,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) - -! titau1 = titau31 - is_ext=0 - ie_ext=1 - js_ext=0 - je_ext=0 - CALL cal_titau_13_31( config_flags, titau1, defor13, & - mu, xkmh, fnm, fnp, & - is_ext, ie_ext, js_ext, je_ext, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! titau2 = titau32 - is_ext=0 - ie_ext=0 - js_ext=0 - je_ext=1 - CALL cal_titau_23_32( config_flags, titau2, defor23, & - mu, xkmh, fnm, fnp, & - is_ext, ie_ext, js_ext, je_ext, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! titau1avg = titau31avg * zx * zeta_z = titau13avg * zx * zeta_z -! titau2avg = titau32avg * zy * zeta_z = titau23avg * zy * zeta_z - - DO j = j_start, j_end - DO k = kts,ktf - DO i = i_start, i_end - titau1avg(i,k,j)=0.25*(titau1(i+1,k+1,j)+titau1(i,k+1,j)+ & - titau1(i+1,k ,j)+titau1(i,k ,j)) - titau2avg(i,k,j)=0.25*(titau2(i,k+1,j+1)+titau2(i,k+1,j)+ & - titau2(i,k ,j+1)+titau2(i,k ,j)) -! new - tmpzx =0.25*( zx(i,k ,j)+zx(i+1,k ,j)+ & - zx(i,k+1,j)+zx(i+1,k+1,j) ) - tmpzy =0.25*( zy(i,k ,j)+zy(i,k ,j+1)+ & - zy(i,k+1,j)+zy(i,k+1,j+1) ) - - titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx - titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy -! titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx*zeta_z(i,j) -! titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy*zeta_z(i,j) - ENDDO - ENDDO - ENDDO - - DO j = j_start, j_end - DO i = i_start, i_end - titau1avg(i,ktf+1,j)=0. - titau2avg(i,ktf+1,j)=0. - ENDDO - ENDDO - - DO j = j_start, j_end - DO k = kts+1,ktf - DO i = i_start, i_end - - mrdx=msftx(i,j)*rdx - mrdy=msfty(i,j)*rdy - - tendency(i,k,j)=tendency(i,k,j)- & - (mrdx*(titau1(i+1,k,j)-titau1(i,k,j))+ & - mrdy*(titau2(i,k,j+1)-titau2(i,k,j))- & - msfty(i,j)*rdz(i,k,j)*(titau1avg(i,k,j)-titau1avg(i,k-1,j)+ & - titau2avg(i,k,j)-titau2avg(i,k-1,j) & - ) & - ) -! msft(i,j)/dn(k)*(titau1avg(i,k,j)-titau1avg(i,k-1,j)+ & -! titau2avg(i,k,j)-titau2avg(i,k-1,j) & -! ) & -! ) - ENDDO - ENDDO - ENDDO - -END SUBROUTINE horizontal_diffusion_w_2 - -!======================================================================= -!======================================================================= - -SUBROUTINE horizontal_diffusion_s (tendency, mu, config_flags, var, & - msftx, msfty, msfux, msfuy, & - msfvx, msfvy, xkhh, rdx, rdy, & - fnm, fnp, cf1, cf2, cf3, & - zx, zy, rdz, rdzw, dnw, dn, & - doing_tke, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - LOGICAL, INTENT(IN ) :: doing_tke - - REAL , INTENT(IN ) :: cf1, cf2, cf3 - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dn - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw - - REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfux - REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfuy - REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfvx - REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfvy - REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msftx - REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfty - - REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: mu - -! REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1), & -! INTENT(IN ) :: xkhh - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & - xkhh, & - rdz, & - rdzw - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: var, & - zx, & - zy - - REAL , INTENT(IN ) :: rdx, & - rdy - -! Local data - - INTEGER :: i, j, k, ktf - - INTEGER :: i_start, i_end, j_start, j_end - - REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: H1avg, & - H2avg, & - H1, & - H2, & - xkxavg -! new -! zxavg, & -! zyavg - - REAL , DIMENSION( its:ite, kts:kte, jts:jte) :: tmptendf - - REAL :: mrdx, mrdy, rcoup - REAL :: tmpzx, tmpzy, tmpzeta_z, rdzu, rdzv - INTEGER :: ktes1,ktes2 - -! End declarations. -!----------------------------------------------------------------------- - - ktf=MIN(kte,kde-1) - -!----------------------------------------------------------------------- -! scalars: t (.), u(|), v(+), w(-) -! -! t u t u t v t v -! -! w - 3 - k+1 w - 3 - k+1 -! -! t . 1 O 1 . k t . 2 O 2 . k -! -! w - 3 - k w - 3 - k -! -! t . | . | . k-1 t . + . + . k-1 -! -! w - - - k-1 w - - - k-1 -! -! t i-1 i i i+1 j-1 j j j+1 -! - - ktes1=kte-1 - ktes2=kte-2 - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .or. config_flags%specified .or. & - config_flags%nested) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. config_flags%specified .or. & - config_flags%nested) i_end = MIN(ide-2,ite) - IF ( config_flags%open_ys .or. config_flags%specified .or. & - config_flags%nested) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. config_flags%specified .or. & - config_flags%nested) j_end = MIN(jde-2,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) - -! diffusion of the TKE needs mutiple 2 - - IF ( doing_tke ) THEN - DO j = j_start, j_end - DO k = kts,ktf - DO i = i_start, i_end - tmptendf(i,k,j)=tendency(i,k,j) - ENDDO - ENDDO - ENDDO - ENDIF - -! H1 = partial var over partial x - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end + 1 -! new -! zxavg(i,k,j) =0.5*( zx(i-1,k,j)+ zx(i,k,j)) - xkxavg(i,k,j)=0.5*(xkhh(i-1,k,j)+xkhh(i,k,j)) - ENDDO - ENDDO - ENDDO - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end + 1 - H1avg(i,k,j)=0.5*(fnm(k)*(var(i-1,k ,j)+var(i,k ,j))+ & - fnp(k)*(var(i-1,k-1,j)+var(i,k-1,j))) - ENDDO - ENDDO - ENDDO - - DO j = j_start, j_end - DO i = i_start, i_end + 1 - H1avg(i,kts ,j)=0.5*(cf1*var(i ,1,j)+cf2*var(i ,2,j)+ & - cf3*var(i ,3,j)+cf1*var(i-1,1,j)+ & - cf2*var(i-1,2,j)+cf3*var(i-1,3,j)) - H1avg(i,ktf+1,j)=0.5*(var(i,ktes1,j)+(var(i,ktes1,j)- & - var(i,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)+ & - var(i-1,ktes1,j)+(var(i-1,ktes1,j)- & - var(i-1,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)) - ENDDO - ENDDO - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end + 1 -! new - tmpzx = 0.5*( zx(i,k,j)+ zx(i,k+1,j)) - rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j)) - H1(i,k,j)=-msfuy(i,j)*xkxavg(i,k,j)*( & - rdx*(var(i,k,j)-var(i-1,k,j)) - tmpzx* & - (H1avg(i,k+1,j)-H1avg(i,k,j))*rdzu ) - -! tmpzeta_z = 0.5*(zeta_z(i,j)+zeta_z(i-1,j)) -! H1(i,k,j)=-msfuy(i,j)*xkxavg(i,k,j)*( & -! rdx*(var(i,k,j)-var(i-1,k,j)) - tmpzx*tmpzeta_z* & -! (H1avg(i,k+1,j)-H1avg(i,k,j))/dnw(k)) - ENDDO - ENDDO - ENDDO - -! H2 = partial var over partial y - - DO j = j_start, j_end + 1 - DO k = kts, ktf - DO i = i_start, i_end -! new -! zyavg(i,k,j) =0.5*( zy(i,k,j-1)+ zy(i,k,j)) - xkxavg(i,k,j)=0.5*(xkhh(i,k,j-1)+xkhh(i,k,j)) - ENDDO - ENDDO - ENDDO - - DO j = j_start, j_end + 1 - DO k = kts+1, ktf - DO i = i_start, i_end -! new - H2avg(i,k,j)=0.5*(fnm(k)*(var(i,k ,j-1)+var(i,k ,j))+ & - fnp(k)*(var(i,k-1,j-1)+var(i,k-1,j))) - ENDDO - ENDDO - ENDDO - - DO j = j_start, j_end + 1 - DO i = i_start, i_end - H2avg(i,kts ,j)=0.5*(cf1*var(i,1,j )+cf2*var(i ,2,j)+ & - cf3*var(i,3,j )+cf1*var(i,1,j-1)+ & - cf2*var(i,2,j-1)+cf3*var(i,3,j-1)) - H2avg(i,ktf+1,j)=0.5*(var(i,ktes1,j)+(var(i,ktes1,j)- & - var(i,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)+ & - var(i,ktes1,j-1)+(var(i,ktes1,j-1)- & - var(i,ktes2,j-1))*0.5*dnw(ktes1)/dn(ktes1)) - ENDDO - ENDDO - - DO j = j_start, j_end + 1 - DO k = kts, ktf - DO i = i_start, i_end -! new - tmpzy = 0.5*( zy(i,k,j)+ zy(i,k+1,j)) - rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1)) - H2(i,k,j)=-msfvy(i,j)*xkxavg(i,k,j)*( & - rdy*(var(i,k,j)-var(i,k,j-1)) - tmpzy* & - (H2avg(i ,k+1,j)-H2avg(i,k,j))*rdzv) - -! tmpzeta_z = 0.5*(zeta_z(i,j)+zeta_z(i,j-1)) -! H2(i,k,j)=-msfvy(i,j)*xkxavg(i,k,j)*( & -! rdy*(var(i,k,j)-var(i,k,j-1)) - tmpzy*tmpzeta_z* & -! (H2avg(i ,k+1,j)-H2avg(i,k,j))/dnw(k)) - ENDDO - ENDDO - ENDDO - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - H1avg(i,k,j)=0.5*(fnm(k)*(H1(i+1,k ,j)+H1(i,k ,j))+ & - fnp(k)*(H1(i+1,k-1,j)+H1(i,k-1,j))) - H2avg(i,k,j)=0.5*(fnm(k)*(H2(i,k ,j+1)+H2(i,k ,j))+ & - fnp(k)*(H2(i,k-1,j+1)+H2(i,k-1,j))) -! new -! zxavg(i,k,j)=fnm(k)*zx(i,k,j)+fnp(k)*zx(i,k-1,j) -! zyavg(i,k,j)=fnm(k)*zy(i,k,j)+fnp(k)*zy(i,k-1,j) - -! H1avg(i,k,j)=zx*H1avg*zeta_z -! H2avg(i,k,j)=zy*H2avg*zeta_z - - tmpzx = 0.5*( zx(i,k,j)+ zx(i+1,k,j )) - tmpzy = 0.5*( zy(i,k,j)+ zy(i ,k,j+1)) - - H1avg(i,k,j)=H1avg(i,k,j)*tmpzx - H2avg(i,k,j)=H2avg(i,k,j)*tmpzy - -! H1avg(i,k,j)=H1avg(i,k,j)*tmpzx*zeta_z(i,j) -! H2avg(i,k,j)=H2avg(i,k,j)*tmpzy*zeta_z(i,j) - ENDDO - ENDDO - ENDDO - - DO j = j_start, j_end - DO i = i_start, i_end - H1avg(i,kts ,j)=0. - H1avg(i,ktf+1,j)=0. - H2avg(i,kts ,j)=0. - H2avg(i,ktf+1,j)=0. - ENDDO - ENDDO - - DO j = j_start, j_end - DO k = kts,ktf - DO i = i_start, i_end - - mrdx=msftx(i,j)*rdx - mrdy=msfty(i,j)*rdy - - tendency(i,k,j)=tendency(i,k,j)- & - (mrdx*0.5*((mu(i+1,j)+mu(i,j))*H1(i+1,k,j)- & - (mu(i-1,j)+mu(i,j))*H1(i ,k,j))+ & - mrdy*0.5*((mu(i,j+1)+mu(i,j))*H2(i,k,j+1)- & - (mu(i,j-1)+mu(i,j))*H2(i,k,j ))- & - msfty(i,j)*mu(i,j)*(H1avg(i,k+1,j)-H1avg(i,k,j)+ & - H2avg(i,k+1,j)-H2avg(i,k,j) & - )*rdzw(i,k,j) & - ) - - ENDDO - ENDDO - ENDDO - - IF ( doing_tke ) THEN - DO j = j_start, j_end - DO k = kts,ktf - DO i = i_start, i_end - tendency(i,k,j)=tmptendf(i,k,j)+2.* & - (tendency(i,k,j)-tmptendf(i,k,j)) - ENDDO - ENDDO - ENDDO - ENDIF - -END SUBROUTINE horizontal_diffusion_s - -!======================================================================= -!======================================================================= - -SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & - tke_tendf, moist_tendf, n_moist, & - chem_tendf, n_chem, & - scalar_tendf, n_scalar, & - u_2, v_2, & - thp,u_base,v_base,t_base,qv_base,mu,tke, & - config_flags,defor13,defor23,defor33,div, & - moist, chem, scalar, xkmv, xkhv,km_opt, & - fnm, fnp, dn, dnw, rdz, rdzw, & - hfx, qfx, ust, rho, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER , INTENT(IN ) :: n_moist, n_chem, n_scalar, km_opt - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dn - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: qv_base - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: u_base - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: v_base - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: t_base - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::ru_tendf,& - rv_tendf,& - rw_tendf,& - tke_tendf,& - rt_tendf - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist), & - INTENT(INOUT) :: moist_tendf - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem), & - INTENT(INOUT) :: chem_tendf - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar) , & - INTENT(INOUT) :: scalar_tendf - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist), & - INTENT(INOUT) :: moist - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem), & - INTENT(INOUT) :: chem - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar) , & - INTENT(IN ) :: scalar - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) ::defor13, & - defor23, & - defor33, & - div, & - xkmv, & - xkhv, & - tke, & - rdz, & - u_2, & - v_2, & - rdzw - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: rho - REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: hfx, & - qfx - REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: ust - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: thp - -! LOCAL VAR - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme) :: var_mix - - INTEGER :: im, i,j,k - INTEGER :: i_start, i_end, j_start, j_end - -! REAL , DIMENSION( its:ite, kts:kte, jts:jte) :: xkhv - -!*************************************************************************** -!*************************************************************************** -!MODIFICA VARIABILI PER I FLUSSI -! - REAL :: V0_u,V0_v,tao_xz,tao_yz,ustar,cd0 - REAL :: xsfc,psi1,vk2,zrough,lnz - REAL :: heat_flux, moist_flux, heat_flux0 - REAL :: cpm -! -!FINE MODIFICA VARIABILI PER I FLUSSI -!*************************************************************************** -! - -! End declarations. -!----------------------------------------------------------------------- - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) -! -!----------------------------------------------------------------------- - - CALL vertical_diffusion_u_2( ru_tendf, config_flags, mu, & - defor13, xkmv, & - dnw, rdzw, fnm, fnp, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - - CALL vertical_diffusion_v_2( rv_tendf, config_flags, mu, & - defor23, xkmv, & - dnw, rdzw, fnm, fnp, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL vertical_diffusion_w_2( rw_tendf, config_flags, mu, & - defor33, tke(ims,kms,jms), & - div, xkmv, & - dn, rdz, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!***************************************** -!***************************************** -! MODIFICA al flusso di momento alla parete -! - vflux: SELECT CASE( config_flags%isfflx ) - CASE (0) ! Assume cd a constant, specified in namelist - cd0 = config_flags%tke_drag_coefficient ! constant drag coefficient - ! set in namelist.input -! -!calcolo del modulo della velocita - DO j = j_start, j_end - DO i = i_start, ite - V0_u=0. - tao_xz=0. - V0_u= sqrt((u_2(i,kts,j)**2) + & - (((v_2(i ,kts,j )+ & - v_2(i ,kts,j+1)+ & - v_2(i-1,kts,j )+ & - v_2(i-1,kts,j+1))/4)**2))+epsilon - tao_xz=cd0*V0_u*u_2(i,kts,j) - ru_tendf(i,kts,j)=ru_tendf(i,kts,j) & - -0.25*(mu(i,j)+mu(i-1,j))*tao_xz*(rdzw(i,kts,j)+rdzw(i-1,kts,j)) - ENDDO - ENDDO - -! - DO j = j_start, jte - DO i = i_start, i_end - V0_v=0. - tao_yz=0. - V0_v= sqrt((v_2(i,kts,j)**2) + & - (((u_2(i ,kts,j )+ & - u_2(i ,kts,j-1)+ & - u_2(i+1,kts,j )+ & - u_2(i+1,kts,j-1))/4)**2))+epsilon - tao_yz=cd0*V0_v*v_2(i,kts,j) - rv_tendf(i,kts,j)=rv_tendf(i,kts,j) & - -0.25*(mu(i,j)+mu(i,j-1))*tao_yz*(rdzw(i,kts,j)+rdzw(i,kts,j-1)) - ENDDO - ENDDO - - CASE (1,2) ! ustar computed from surface routine - DO j = j_start, j_end - DO i = i_start, ite - V0_u=0. - tao_xz=0. - V0_u= sqrt((u_2(i,kts,j)**2) + & - (((v_2(i ,kts,j )+ & - v_2(i ,kts,j+1)+ & - v_2(i-1,kts,j )+ & - v_2(i-1,kts,j+1))/4)**2))+epsilon - ustar=0.5*(ust(i,j)+ust(i-1,j)) - tao_xz=ustar*ustar*u_2(i,kts,j)/V0_u - ru_tendf(i,kts,j)=ru_tendf(i,kts,j) & - -0.25*(mu(i,j)+mu(i-1,j))*tao_xz*(rdzw(i,kts,j)+rdzw(i-1,kts,j)) - ENDDO - ENDDO - - DO j = j_start, jte - DO i = i_start, i_end - V0_v=0. - tao_yz=0. - V0_v= sqrt((v_2(i,kts,j)**2) + & - (((u_2(i ,kts,j )+ & - u_2(i ,kts,j-1)+ & - u_2(i+1,kts,j )+ & - u_2(i+1,kts,j-1))/4)**2))+epsilon - ustar=0.5*(ust(i,j)+ust(i,j-1)) - tao_yz=ustar*ustar*v_2(i,kts,j)/V0_v - rv_tendf(i,kts,j)=rv_tendf(i,kts,j) & - -0.25*(mu(i,j)+mu(i,j-1))*tao_yz*(rdzw(i,kts,j)+rdzw(i,kts,j-1)) - ENDDO - ENDDO - - CASE DEFAULT - CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' ) - END SELECT vflux - -! -! FINE MODIFICA al flusso di momento alla parete -!***************************************** -!***************************************** - - IF ( config_flags%mix_full_fields ) THEN - - DO j=jts,min(jte,jde-1) - DO k=kts,kte-1 - DO i=its,min(ite,ide-1) - var_mix(i,k,j) = thp(i,k,j) - ENDDO - ENDDO - ENDDO - - ELSE - - DO j=jts,min(jte,jde-1) - DO k=kts,kte-1 - DO i=its,min(ite,ide-1) - var_mix(i,k,j) = thp(i,k,j) - t_base(k) - ENDDO - ENDDO - ENDDO - - END IF - - CALL vertical_diffusion_s( rt_tendf, config_flags, var_mix, mu, xkhv, & - dn, dnw, rdz, rdzw, fnm, fnp, & - .false., & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - -!***************************************** -!***************************************** -!MODIFICA al flusso di calore -! -! - hflux: SELECT CASE( config_flags%isfflx ) - CASE (0,2) ! with fixed surface heat flux given in the namelist - heat_flux = config_flags%tke_heat_flux ! constant heat flux value - ! set in namelist.input - DO j = j_start, j_end - DO i = i_start, i_end - rt_tendf(i,kts,j)=rt_tendf(i,kts,j) & - +mu(i,j)*heat_flux*rdzw(i,kts,j) - ENDDO - ENDDO - - CASE (1) ! use surface heat flux computed from surface routine - DO j = j_start, j_end - DO i = i_start, i_end - - cpm = cp * (1. + 0.8 * moist(i,kts,j,P_QV)) - heat_flux = hfx(i,j)/cpm/rho(i,1,j) - rt_tendf(i,kts,j)=rt_tendf(i,kts,j) & - +mu(i,j)*heat_flux*rdzw(i,kts,j) - - ENDDO - ENDDO - - CASE DEFAULT - CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' ) - END SELECT hflux - -! -! FINE MODIFICA al flusso di calore -!***************************************** -!***************************************** - - If (km_opt .eq. 2) then - CALL vertical_diffusion_s( tke_tendf(ims,kms,jms), & - config_flags, tke(ims,kms,jms), & - mu, xkhv, & - dn, dnw, rdz, rdzw, fnm, fnp, & - .true., & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - endif - - IF (n_moist .ge. PARAM_FIRST_SCALAR) THEN - - moist_loop: do im = PARAM_FIRST_SCALAR, n_moist - - IF ( (.not. config_flags%mix_full_fields) .and. (im == P_QV) ) THEN - - DO j=jts,min(jte,jde-1) - DO k=kts,kte-1 - DO i=its,min(ite,ide-1) - var_mix(i,k,j) = moist(i,k,j,im) - qv_base(k) - ENDDO - ENDDO - ENDDO - - ELSE - - DO j=jts,min(jte,jde-1) - DO k=kts,kte-1 - DO i=its,min(ite,ide-1) - var_mix(i,k,j) = moist(i,k,j,im) - ENDDO - ENDDO - ENDDO - - END IF - - - CALL vertical_diffusion_s( moist_tendf(ims,kms,jms,im), & - config_flags, var_mix, & - mu, xkhv, & - dn, dnw, rdz, rdzw, fnm, fnp, & - .false., & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!***************************************** -!***************************************** -!MODIFICATIONS for water vapor flux -! -! - qflux: SELECT CASE( config_flags%isfflx ) - CASE (0) -! do nothing - CASE (1,2) ! with surface moisture flux - IF ( im == P_QV ) THEN - DO j = j_start, j_end - DO i = i_start, i_end - moist_flux = qfx(i,j)/rho(i,1,j) - moist_tendf(i,kts,j,im)=moist_tendf(i,kts,j,im) & - +mu(i,j)*moist_flux*rdzw(i,kts,j) - ENDDO - ENDDO - ENDIF - - CASE DEFAULT - CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' ) - END SELECT qflux -! -! END MODIFICATIONS for water vapor flux -!***************************************** -!***************************************** - ENDDO moist_loop - - ENDIF - - IF (n_chem .ge. PARAM_FIRST_SCALAR) THEN - - chem_loop: do im = PARAM_FIRST_SCALAR, n_chem - - CALL vertical_diffusion_s( chem_tendf(ims,kms,jms,im), & - config_flags, chem(ims,kms,jms,im), & - mu, xkhv, & - dn, dnw, rdz, rdzw, fnm, fnp, & - .false., & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - ENDDO chem_loop - - ENDIF - - - IF (n_scalar .ge. PARAM_FIRST_SCALAR) THEN - - scalar_loop: do im = PARAM_FIRST_SCALAR, n_scalar - - CALL vertical_diffusion_s( scalar_tendf(ims,kms,jms,im), & - config_flags, scalar(ims,kms,jms,im), & - mu, xkhv, & - dn, dnw, rdz, rdzw, fnm, fnp, & - .false., & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - ENDDO scalar_loop - - ENDIF - -END SUBROUTINE vertical_diffusion_2 - -!======================================================================= -!======================================================================= - -SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu, & - defor13, xkmv, & - dnw, rdzw, fnm, fnp, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw -! REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: zeta_z - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & - INTENT(IN ) ::defor13, & - xkmv, & - rdzw - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu - -! LOCAL VARS - - INTEGER :: i, j, k, ktf - - INTEGER :: i_start, i_end, j_start, j_end - INTEGER :: is_ext,ie_ext,js_ext,je_ext - - REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau3 - - REAL , DIMENSION( its:ite, jts:jte) :: zzavg - - REAL :: rdzu - -! End declarations. -!----------------------------------------------------------------------- - - ktf=MIN(kte,kde-1) - - i_start = its - i_end = ite - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .or. config_flags%specified .or. & - config_flags%nested) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. config_flags%specified .or. & - config_flags%nested) i_end = MIN(ide-1,ite) - IF ( config_flags%open_ys .or. config_flags%specified .or. & - config_flags%nested) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. config_flags%specified .or. & - config_flags%nested) j_end = MIN(jde-2,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = ite - -! titau3 = titau13 - is_ext=0 - ie_ext=0 - js_ext=0 - je_ext=0 - CALL cal_titau_13_31( config_flags, titau3, defor13, & - mu, xkmv, fnm, fnp, & - is_ext, ie_ext, js_ext, je_ext, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -! - DO j = j_start, j_end - DO k=kts+1,ktf - DO i = i_start, i_end - - rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j)) - tendency(i,k,j)=tendency(i,k,j)-rdzu*(titau3(i,k+1,j)-titau3(i,k,j)) - - ENDDO - ENDDO - ENDDO - -! ******** MODIF... -! we will pick up the surface drag (titau3(i,kts,j)) later -! - DO j = j_start, j_end - k=kts - DO i = i_start, i_end - - rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j)) - tendency(i,k,j)=tendency(i,k,j)-rdzu*(titau3(i,k+1,j)) - ENDDO - ENDDO -! ******** MODIF... - -END SUBROUTINE vertical_diffusion_u_2 - -!======================================================================= -!======================================================================= - -SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu, & - defor23, xkmv, & - dnw, rdzw, fnm, fnp, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw -! REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: zeta_z - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & - INTENT(IN ) ::defor23, & - xkmv, & - rdzw - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu - -! LOCAL VARS - - INTEGER :: i, j, k, ktf - - INTEGER :: i_start, i_end, j_start, j_end - INTEGER :: is_ext,ie_ext,js_ext,je_ext - - REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau3 - - REAL , DIMENSION( its:ite, jts:jte) :: zzavg - - REAL :: rdzv - -! End declarations. -!----------------------------------------------------------------------- - - ktf=MIN(kte,kde-1) - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = jte - - IF ( config_flags%open_xs .or. config_flags%specified .or. & - config_flags%nested) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. config_flags%specified .or. & - config_flags%nested) i_end = MIN(ide-2,ite) - IF ( config_flags%open_ys .or. config_flags%specified .or. & - config_flags%nested) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. config_flags%specified .or. & - config_flags%nested) j_end = MIN(jde-1,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) - -! titau3 = titau23 - is_ext=0 - ie_ext=0 - js_ext=0 - je_ext=0 - CALL cal_titau_23_32( config_flags, titau3, defor23, & - mu, xkmv, fnm, fnp, & - is_ext, ie_ext, js_ext, je_ext, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - DO j = j_start, j_end - DO k = kts+1,ktf - DO i = i_start, i_end - - rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1)) - tendency(i,k,j)=tendency(i,k,j)-rdzv*(titau3(i,k+1,j)-titau3(i,k,j)) - - ENDDO - ENDDO - ENDDO - -! ******** MODIF... -! we will pick up the surface drag (titau3(i,kts,j)) later -! - DO j = j_start, j_end - k=kts - DO i = i_start, i_end - - rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1)) - tendency(i,k,j)=tendency(i,k,j)-rdzv*(titau3(i,k+1,j)) - - ENDDO - ENDDO -! ******** MODIF... - -END SUBROUTINE vertical_diffusion_v_2 - -!======================================================================= -!======================================================================= - -SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu, & - defor33, tke, div, xkmv, & - dn, rdz, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dn - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & - INTENT(IN ) ::defor33, & - tke, & - div, & - xkmv, & - rdz - - REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: mu - -! LOCAL VARS - - INTEGER :: i, j, k, ktf - - INTEGER :: i_start, i_end, j_start, j_end - INTEGER :: is_ext,ie_ext,js_ext,je_ext - - REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau3 - -! End declarations. -!----------------------------------------------------------------------- - - ktf=MIN(kte,kde-1) - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .or. config_flags%specified .or. & - config_flags%nested) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. config_flags%specified .or. & - config_flags%nested) i_end = MIN(ide-2,ite) - IF ( config_flags%open_ys .or. config_flags%specified .or. & - config_flags%nested) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. config_flags%specified .or. & - config_flags%nested) j_end = MIN(jde-2,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) - -! titau3 = titau33 - is_ext=0 - ie_ext=0 - js_ext=0 - je_ext=0 - CALL cal_titau_11_22_33( config_flags, titau3, & - mu, tke, xkmv, defor33, & - is_ext, ie_ext, js_ext, je_ext, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! DO j = j_start, j_end -! DO k = kts+1, ktf -! DO i = i_start, i_end -! titau3(i,k,j)=titau3(i,k,j)*zeta_z(i,j) -! ENDDO -! ENDDO -! ENDDO - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - tendency(i,k,j)=tendency(i,k,j)-rdz(i,k,j)*(titau3(i,k,j)-titau3(i,k-1,j)) - ENDDO - ENDDO - ENDDO - -END SUBROUTINE vertical_diffusion_w_2 - -!======================================================================= -!======================================================================= - -SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, mu, xkhv, & - dn, dnw, rdz, rdzw, fnm, fnp, & - doing_tke, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - LOGICAL, INTENT(IN ) :: doing_tke - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dn - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN) :: xkhv - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: mu - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & - INTENT(IN ) :: var, & - rdz, & - rdzw -! LOCAL VARS - - INTEGER :: i, j, k, ktf - - INTEGER :: i_start, i_end, j_start, j_end - - REAL , DIMENSION( its:ite, kts:kte, jts:jte) :: H3, & - xkxavg, & - rravg - - REAL , DIMENSION( its:ite, kts:kte, jts:jte) :: tmptendf - -! End declarations. -!----------------------------------------------------------------------- - - ktf=MIN(kte,kde-1) - - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .or. config_flags%specified .or. & - config_flags%nested) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. config_flags%specified .or. & - config_flags%nested) i_end = MIN(ide-2,ite) - IF ( config_flags%open_ys .or. config_flags%specified .or. & - config_flags%nested) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. config_flags%specified .or. & - config_flags%nested) j_end = MIN(jde-2,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1) - - IF (doing_tke) THEN - DO j = j_start, j_end - DO k = kts,ktf - DO i = i_start, i_end - tmptendf(i,k,j)=tendency(i,k,j) - ENDDO - ENDDO - ENDDO - ENDIF - -! H3 - - xkxavg = 0. - - DO j = j_start, j_end - DO k = kts+1,ktf - DO i = i_start, i_end - xkxavg(i,k,j)=fnm(k)*xkhv(i,k,j)+fnp(k)*xkhv(i,k-1,j) - H3(i,k,j)=-xkxavg(i,k,j)*(var(i,k,j)-var(i,k-1,j))*rdz(i,k,j) -! H3(i,k,j)=-xkxavg(i,k,j)*zeta_z(i,j)* & -! (var(i,k,j)-var(i,k-1,j))/dn(k) - ENDDO - ENDDO - ENDDO - - DO j = j_start, j_end - DO i = i_start, i_end - H3(i,kts,j)=0. - H3(i,ktf+1,j)=0. -! H3(i,kts,j)=H3(i,kts+1,j) -! H3(i,ktf+1,j)=H3(i,ktf,j) - ENDDO - ENDDO - - DO j = j_start, j_end - DO k = kts,ktf - DO i = i_start, i_end - tendency(i,k,j)=tendency(i,k,j) & - -mu(i,j)*(H3(i,k+1,j)-H3(i,k,j))*rdzw(i,k,j) - ENDDO - ENDDO - ENDDO - - IF (doing_tke) THEN - DO j = j_start, j_end - DO k = kts,ktf - DO i = i_start, i_end - tendency(i,k,j)=tmptendf(i,k,j)+2.* & - (tendency(i,k,j)-tmptendf(i,k,j)) - ENDDO - ENDDO - ENDDO - ENDIF - -END SUBROUTINE vertical_diffusion_s - -!======================================================================= -!======================================================================= - - SUBROUTINE cal_titau_11_22_33( config_flags, titau, & - mu, tke, xkx, defor, & - is_ext, ie_ext, js_ext, je_ext, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! History: Sep 2003 Changes by George Bryan and Jason Knievel, NCAR -! Oct 2001 Converted to mass core by Bill Skamarock, NCAR -! Aug 2000 Original code by Shu-Hua Chen, UC-Davis - -! Purpose: This routine calculates stress terms (taus) for use in -! the calculation of production of TKE by sheared wind - -! References: Klemp and Wilhelmson (JAS 1978) -! Deardorff (B-L Meteor 1980) -! Chen and Dudhia (NCAR WRF physics report 2000) - -! Key: - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type ), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER, INTENT( IN ) & - :: is_ext, ie_ext, js_ext, je_ext - - REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT ) & - :: titau - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: defor, xkx, tke - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: mu - -! Local variables. - - INTEGER & - :: i, j, k, ktf, i_start, i_end, j_start, j_end - -! End declarations. -!----------------------------------------------------------------------- - - ktf = MIN( kte, kde-1 ) - - i_start = its - i_end = ite - j_start = jts - j_end = jte - - IF ( config_flags%open_xs .OR. config_flags%specified .OR. & - config_flags%nested) i_start = MAX( ids+1, its ) - IF ( config_flags%open_xe .OR. config_flags%specified .OR. & - config_flags%nested) i_end = MIN( ide-1, ite ) - IF ( config_flags%open_ys .OR. config_flags%specified .OR. & - config_flags%nested) j_start = MAX( jds+1, jts ) - IF ( config_flags%open_ye .OR. config_flags%specified .OR. & - config_flags%nested) j_end = MIN( jde-1, jte ) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = ite - - i_start = i_start - is_ext - i_end = i_end + ie_ext - j_start = j_start - js_ext - j_end = j_end + je_ext - - IF ( config_flags%km_opt .EQ. 2) THEN - DO j = j_start,j_end - DO k = kts,ktf - DO i = i_start,i_end - titau(i,k,j) = mu(i,j) * ( - xkx(i,k,j) * ( defor(i,k,j) ) ) - END DO - END DO - END DO - ELSE - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - titau(i,k,j) = - mu(i,j) * xkx(i,k,j) * defor(i,k,j) - END DO - END DO - END DO - END IF - - END SUBROUTINE cal_titau_11_22_33 - -!======================================================================= -!======================================================================= - - SUBROUTINE cal_titau_12_21( config_flags, titau, & - mu, xkx, defor, & - is_ext, ie_ext, js_ext, je_ext, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! History: Sep 2003 Modifications by George Bryan and Jason Knievel, NCAR -! Oct 2001 Converted to mass core by Bill Skamarock, NCAR -! Aug 2000 Original code by Shu-Hua Chen, UC-Davis - -! Pusrpose This routine calculates the stress terms (taus) for use in -! the calculation of production of TKE by sheared wind - -! References: Klemp and Wilhelmson (JAS 1978) -! Deardorff (B-L Meteor 1980) -! Chen and Dudhia (NCAR WRF physics report 2000) - -! Key: - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER, INTENT( IN ) & - :: is_ext, ie_ext, js_ext, je_ext - - REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT ) & - :: titau - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: defor, xkx - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: mu - -! Local variables. - - INTEGER & - :: i, j, k, ktf, i_start, i_end, j_start, j_end - - REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) & - :: xkxavg - - REAL, DIMENSION( its-1:ite+1, jts-1:jte+1 ) & - :: muavg - -! End declarations. -!----------------------------------------------------------------------- - - ktf = MIN( kte, kde-1 ) - -! Needs one more point in the x and y directions. - - i_start = its - i_end = ite - j_start = jts - j_end = jte - - IF ( config_flags%open_xs .OR. config_flags%specified .OR. & - config_flags%nested ) i_start = MAX( ids+1, its ) - IF ( config_flags%open_xe .OR. config_flags%specified .OR. & - config_flags%nested ) i_end = MIN( ide-1, ite ) - IF ( config_flags%open_ys .OR. config_flags%specified .OR. & - config_flags%nested ) j_start = MAX( jds+1, jts ) - IF ( config_flags%open_ye .OR. config_flags%specified .OR. & - config_flags%nested ) j_end = MIN( jde-1, jte ) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = ite - - i_start = i_start - is_ext - i_end = i_end + ie_ext - j_start = j_start - js_ext - j_end = j_end + je_ext - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - xkxavg(i,k,j) = 0.25 * ( xkx(i-1,k,j ) + xkx(i,k,j ) + & - xkx(i-1,k,j-1) + xkx(i,k,j-1) ) - END DO - END DO - END DO - - DO j = j_start, j_end - DO i = i_start, i_end - muavg(i,j) = 0.25 * ( mu(i-1,j ) + mu(i,j ) + & - mu(i-1,j-1) + mu(i,j-1) ) - END DO - END DO - -! titau12 or titau21 - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j) - END DO - END DO - END DO - - END SUBROUTINE cal_titau_12_21 - -!======================================================================= - - SUBROUTINE cal_titau_13_31( config_flags, titau, & - defor, mu, xkx, fnm, fnp, & - is_ext, ie_ext, js_ext, je_ext, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! History: Sep 2003 Modifications by George Bryan and Jason Knievel, NCAR -! Oct 2001 Converted to mass core by Bill Skamarock, NCAR -! Aug 2000 Original code by Shu-Hua Chen, UC-Davis - -! Purpose: This routine calculates the stress terms (taus) for use in -! the calculation of production of TKE by sheared wind - -! References: Klemp and Wilhelmson (JAS 1978) -! Deardorff (B-L Meteor 1980) -! Chen and Dudhia (NCAR WRF physics report 2000) - -! Key: - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER, INTENT( IN ) & - :: is_ext, ie_ext, js_ext, je_ext - - REAL, DIMENSION( kms:kme ), INTENT( IN ) & - :: fnm, fnp - - REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT ) & - :: titau - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme), INTENT( IN ) & - :: defor, xkx - - REAL, DIMENSION( ims:ime, jms:jme), INTENT( IN ) & - :: mu - -! Local variables. - - INTEGER & - :: i, j, k, ktf, i_start, i_end, j_start, j_end - - REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) & - :: xkxavg - - REAL, DIMENSION( its-1:ite+1, jts-1:jte+1 ) & - :: muavg - -! End declarations. -!----------------------------------------------------------------------- - - ktf = MIN( kte, kde-1 ) - -! Find ide-1 and jde-1 for averaging to p point. - - i_start = its - i_end = ite - j_start = jts - j_end = MIN( jte, jde-1 ) - - IF ( config_flags%open_xs .OR. config_flags%specified .OR. & - config_flags%nested) i_start = MAX( ids+1, its ) - IF ( config_flags%open_xe .OR. config_flags%specified .OR. & - config_flags%nested) i_end = MIN( ide-1, ite ) - IF ( config_flags%open_ys .OR. config_flags%specified .OR. & - config_flags%nested) j_start = MAX( jds+1, jts ) - IF ( config_flags%open_ye .OR. config_flags%specified .OR. & - config_flags%nested) j_end = MIN( jde-2, jte ) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = ite - - i_start = i_start - is_ext - i_end = i_end + ie_ext - j_start = j_start - js_ext - j_end = j_end + je_ext - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k ,j) + xkx(i-1,k ,j) ) + & - fnp(k) * ( xkx(i,k-1,j) + xkx(i-1,k-1,j) ) ) - END DO - END DO - END DO - - DO j = j_start, j_end - DO i = i_start, i_end - muavg(i,j) = 0.5 * ( mu(i,j) + mu(i-1,j) ) - END DO - END DO - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j) - ENDDO - ENDDO - ENDDO - - DO j = j_start, j_end - DO i = i_start, i_end - titau(i,kts ,j) = 0.0 - titau(i,ktf+1,j) = 0.0 - ENDDO - ENDDO - - END SUBROUTINE cal_titau_13_31 - -!======================================================================= -!======================================================================= - - SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & - mu, xkx, fnm, fnp, & - is_ext, ie_ext, js_ext, je_ext, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! History: Sep 2003 Changes by George Bryan and Jason Knievel, NCAR -! Oct 2001 Converted to mass core by Bill Skamarock, NCAR -! Aug 2000 Original code by Shu-Hua Chen, UC-Davis - -! Purpose: This routine calculates stress terms (taus) for use in -! the calculation of production of TKE by sheared wind - -! References: Klemp and Wilhelmson (JAS 1978) -! Deardorff (B-L Meteor 1980) -! Chen and Dudhia (NCAR WRF physics report 2000) - -! Key: - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type ), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER, INTENT( IN ) & - :: is_ext,ie_ext,js_ext,je_ext - - REAL, DIMENSION( kms:kme ), INTENT( IN ) & - :: fnm, fnp - - REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT ) & - :: titau - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: defor, xkx - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: mu - -! Local variables. - - INTEGER & - :: i, j, k, ktf, i_start, i_end, j_start, j_end - - REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) & - :: xkxavg - - REAL, DIMENSION( its-1:ite+1, jts-1:jte+1 ) & - :: muavg - -! End declarations. -!----------------------------------------------------------------------- - - ktf = MIN( kte, kde-1 ) - -! Find ide-1 and jde-1 for averaging to p point. - - i_start = its - i_end = MIN( ite, ide-1 ) - j_start = jts - j_end = jte - - IF ( config_flags%open_xs .OR. config_flags%specified .OR. & - config_flags%nested) i_start = MAX( ids+1, its ) - IF ( config_flags%open_xe .OR. config_flags%specified .OR. & - config_flags%nested) i_end = MIN( ide-2, ite ) - IF ( config_flags%open_ys .OR. config_flags%specified .OR. & - config_flags%nested) j_start = MAX( jds+1, jts ) - IF ( config_flags%open_ye .OR. config_flags%specified .OR. & - config_flags%nested) j_end = MIN( jde-1, jte ) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) - - i_start = i_start - is_ext - i_end = i_end + ie_ext - j_start = j_start - js_ext - j_end = j_end + je_ext - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k ,j) + xkx(i,k ,j-1) ) + & - fnp(k) * ( xkx(i,k-1,j) + xkx(i,k-1,j-1) ) ) - END DO - END DO - END DO - - DO j = j_start, j_end - DO i = i_start, i_end - muavg(i,j) = 0.5 * ( mu(i,j) + mu(i,j-1) ) - END DO - END DO - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j) - END DO - END DO - END DO - - DO j = j_start, j_end - DO i = i_start, i_end - titau(i,kts ,j) = 0.0 - titau(i,ktf+1,j) = 0.0 - END DO - END DO - - END SUBROUTINE cal_titau_23_32 - -!======================================================================= -!======================================================================= - -SUBROUTINE phy_bc ( config_flags,div,defor11,defor22,defor33, & - defor12,defor13,defor23,xkmh,xkmv,xkhh,xkhv,tke, & - RUBLTEN, RVBLTEN, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - -!------------------------------------------------------------------------------ -! Begin declarations. - - IMPLICIT NONE - - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::RUBLTEN, & - RVBLTEN, & - defor11, & - defor22, & - defor33, & - defor12, & - defor13, & - defor23, & - xkmh, & - xkmv, & - xkhh, & - xkhv, & - tke, & - div - -! End declarations. -!----------------------------------------------------------------------- - - IF( (config_flags%bl_pbl_physics .GT. 0) & - .OR. (config_flags%modif_wrf) ) THEN -!****MARS: Always do that ?? > yes, for periodic simu -- grep in share - - CALL set_physical_bc3d( RUBLTEN , 't', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - CALL set_physical_bc3d( RVBLTEN , 't', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - ENDIF - - ! move out of the conditional, below; horiz coeffs needed for - ! all diff_opt cases. JM - - CALL set_physical_bc3d( xkmh , 't', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - CALL set_physical_bc3d( xkhh , 't', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - IF(config_flags%diff_opt .eq. 2) THEN - - CALL set_physical_bc3d( xkmv , 't', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - CALL set_physical_bc3d( xkhv , 't', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - CALL set_physical_bc3d( tke , 't', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - CALL set_physical_bc3d( div , 't', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - CALL set_physical_bc3d( defor11 , 't', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - CALL set_physical_bc3d( defor22 , 't', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - CALL set_physical_bc3d( defor33 , 't', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - CALL set_physical_bc3d( defor12 , 'd', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - CALL set_physical_bc3d( defor13 , 'e', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - CALL set_physical_bc3d( defor23 , 'f', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte ) - - ENDIF - -END SUBROUTINE phy_bc - -!======================================================================= -!======================================================================= - - SUBROUTINE tke_rhs( tendency, BN2, config_flags, & - defor11, defor22, defor33, & - defor12, defor13, defor23, & - u, v, w, div, tke, mu, & - theta, p, p8w, t8w, z, fnm, fnp, & - cf1, cf2, cf3, msftx, msfty, & - xkmh, xkmv, xkhv, & - rdx, rdy, dx, dy, dt, zx, zy, & - rdz, rdzw, dn, dnw, isotropic, & - hfx, qfx, qv, ust, rho, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type ), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER, INTENT( IN ) :: isotropic - REAL, INTENT( IN ) & - :: cf1, cf2, cf3, dt, rdx, rdy, dx, dy - - REAL, DIMENSION( kms:kme ), INTENT( IN ) & - :: fnm, fnp, dnw, dn - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: msftx, msfty - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & - :: tendency - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: defor11, defor22, defor33, defor12, defor13, defor23, & - div, BN2, tke, xkmh, xkmv, xkhv, zx, zy, u, v, w, theta, & - p, p8w, t8w, z, rdz, rdzw - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: mu - - REAL, DIMENSION ( ims:ime, jms:jme ), INTENT( IN ) & - :: hfx, ust, qfx - REAL, DIMENSION ( ims:ime, kms:kme, jms:jme ), INTENT ( IN ) & - :: qv, rho - -! Local variables. - - INTEGER & - :: i, j, k, ktf, i_start, i_end, j_start, j_end - -! End declarations. -!----------------------------------------------------------------------- - - CALL tke_shear( tendency, config_flags, & - defor11, defor22, defor33, & - defor12, defor13, defor23, & - u, v, w, tke, ust, mu, fnm, fnp, & - cf1, cf2, cf3, msftx, msfty, & - xkmh, xkmv, & - rdx, rdy, zx, zy, rdz, rdzw, dnw, dn, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL tke_buoyancy( tendency, config_flags, mu, & - tke, xkhv, BN2, theta, dt, & - hfx, qfx, qv, rho, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL tke_dissip( tendency, config_flags, & - mu, tke, bn2, theta, p8w, t8w, z, & - dx, dy,rdz, rdzw, isotropic, & - msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! Set a lower limit on TKE. - - ktf = MIN( kte, kde-1 ) - i_start = its - i_end = MIN( ite, ide-1 ) - j_start = jts - j_end = MIN( jte, jde-1 ) - - IF ( config_flags%open_xs .or. config_flags%specified .or. & - config_flags%nested) i_start = MAX(ids+1,its) - IF ( config_flags%open_xe .or. config_flags%specified .or. & - config_flags%nested) i_end = MIN(ide-2,ite) - IF ( config_flags%open_ys .or. config_flags%specified .or. & - config_flags%nested) j_start = MAX(jds+1,jts) - IF ( config_flags%open_ye .or. config_flags%specified .or. & - config_flags%nested) j_end = MIN(jde-2,jte) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tendency(i,k,j) = max( tendency(i,k,j), -mu(i,j) * max( 0.0 , tke(i,k,j) ) / dt ) - END DO - END DO - END DO - - END SUBROUTINE tke_rhs - -!======================================================================= -!======================================================================= - - SUBROUTINE tke_buoyancy( tendency, config_flags, mu, & - tke, xkhv, BN2, theta, dt, & - hfx, qfx, qv, rho, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type ), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, INTENT( IN ) & - :: dt - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & - :: tendency - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: xkhv, tke, BN2, theta - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: mu - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT ( IN ) & - :: qv, rho - - REAL, DIMENSION(ims:ime, jms:jme ), INTENT ( IN ) :: hfx, qfx - -! Local variables. - - INTEGER & - :: i, j, k, ktf - - INTEGER & - :: i_start, i_end, j_start, j_end - - REAL :: heat_flux, heat_flux0 - - REAL :: cpm - -! End declarations. -!----------------------------------------------------------------------- - -!----------------------------------------------------------------------- -! Add to the TKE tendency the term that accounts for production of TKE -! due to buoyant motions. - - ktf = MIN( kte, kde-1 ) - i_start = its - i_end = MIN( ite, ide-1 ) - j_start = jts - j_end = MIN( jte, jde-1 ) - - IF ( config_flags%open_xs .OR. config_flags%specified .OR. & - config_flags%nested ) i_start = MAX( ids+1, its ) - IF ( config_flags%open_xe .OR. config_flags%specified .OR. & - config_flags%nested ) i_end = MIN( ide-2, ite ) - IF ( config_flags%open_ys .OR. config_flags%specified .OR. & - config_flags%nested ) j_start = MAX( jds+1, jts ) - IF ( config_flags%open_ye .OR. config_flags%specified .OR. & - config_flags%nested ) j_end = MIN( jde-2, jte ) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end - tendency(i,k,j) = tendency(i,k,j) - mu(i,j) * xkhv(i,k,j) * BN2(i,k,j) - END DO - END DO - END DO - -! MARTA: change in the computation of the tke's tendency at the surface. -! the buoyancy flux is the average of the surface heat flux (0.06) and the -! flux at the first w level -! -! WCS 040331 - - hflux: SELECT CASE( config_flags%isfflx ) - CASE (0,2) ! with fixed surface heat flux given in the namelist - heat_flux0 = config_flags%tke_heat_flux ! constant heat flux value - ! set in namelist.input -! LES mods - K=KTS - PRINT *, 'USE constant H/rho/cp : e.g. value of Hs ', heat_flux0*cp*rho(i_start,k,j_start) - DO j = j_start, j_end - DO i = i_start, i_end - heat_flux = heat_flux0 - tendency(i,k,j)= tendency(i,k,j) - & - mu(i,j)*((xkhv(i,k,j)*BN2(i,k,j))- (g/theta(i,k,j))*heat_flux)/2. - - ENDDO - ENDDO - - CASE (1) ! use surface heat flux computed from surface routine - PRINT *, 'USE surface heat flux from PHYSICS', hfx(i_start,j_start) - K=KTS - DO j = j_start, j_end - DO i = i_start, i_end - cpm = cp * (1. + 0.8*qv(i,k,j)) - heat_flux = (hfx(i,j)/cpm)/rho(i,k,j) - - tendency(i,k,j)= tendency(i,k,j) - & - mu(i,j)*((xkhv(i,k,j)*BN2(i,k,j))- (g/theta(i,k,j))*heat_flux)/2. - - ENDDO - ENDDO - - CASE DEFAULT - CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' ) - END SELECT hflux - -! end of MARTA/WCS change - -! The tendency array now includes production of TKE from buoyant -! motions. -!----------------------------------------------------------------------- - - END SUBROUTINE tke_buoyancy - -!======================================================================= -!======================================================================= - - SUBROUTINE tke_dissip( tendency, config_flags, & - mu, tke, bn2, theta, p8w, t8w, z, & - dx, dy, rdz, rdzw, isotropic, & - msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! History: Sep 2003 Changes by George Bryan and Jason Knievel, NCAR -! Oct 2001 Converted to mass core by Bill Skamarock, NCAR -! Aug 2000 Original code by Shu-Hua Chen, UC-Davis - -! Purpose: This routine calculates dissipation of turbulent kinetic -! energy. - -! References: Klemp and Wilhelmson (JAS 1978) -! Deardorff (B-L Meteor 1980) -! Chen and Dudhia (NCAR WRF physics report 2000) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type ), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER, INTENT( IN ) :: isotropic - REAL, INTENT( IN ) & - :: dx, dy - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & - :: tendency - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: tke, bn2, theta, p8w, t8w, z, rdz, rdzw - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: mu - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: msftx, msfty -! Local variables. - - REAL, DIMENSION( its:ite, kts:kte, jts:jte ) & - :: dthrdn - - REAL, DIMENSION( its:ite, kts:kte, jts:jte ) & - :: l_scale - - REAL, DIMENSION( its:ite ) & - :: sumtke, sumtkez - - INTEGER & - :: i, j, k, ktf, i_start, i_end, j_start, j_end - - REAL & - :: disp_len, deltas, coefc, tmpdz, len_s, thetasfc, & - thetatop, len_0, tketmp, tmp, ce1, ce2, c_k - -! End declarations. -!----------------------------------------------------------------------- - c_k = config_flags%c_k - - ce1 = ( c_k / 0.10 ) * 0.19 - ce2 = max( 0.0 , 0.93 - ce1 ) - - ktf = MIN( kte, kde-1 ) - i_start = its - i_end = MIN(ite,ide-1) - j_start = jts - j_end = MIN(jte,jde-1) - - IF ( config_flags%open_xs .OR. config_flags%specified .OR. & - config_flags%nested) i_start = MAX( ids+1, its ) - IF ( config_flags%open_xe .OR. config_flags%specified .OR. & - config_flags%nested) i_end = MIN( ide-2, ite ) - IF ( config_flags%open_ys .OR. config_flags%specified .OR. & - config_flags%nested) j_start = MAX( jds+1, jts ) - IF ( config_flags%open_ye .OR. config_flags%specified .OR. & - config_flags%nested) j_end = MIN( jde-2, jte ) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) - - CALL calc_l_scale( config_flags, tke, BN2, l_scale, & - i_start, i_end, ktf, j_start, j_end, & - dx, dy, rdzw, msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - deltas = ( dx/msftx(i,j) * dy/msfty(i,j) / rdzw(i,k,j) )**0.33333333 - tketmp = MAX( tke(i,k,j), 1.0e-6 ) - -! Apply Deardorff's (1980) "wall effect" at the bottom of the domain. -! For LES with fine grid, no need for this wall effect! - - IF ( k .eq. kts .or. k .eq. ktf ) then - coefc = 3.9 - ELSE - coefc = ce1 + ce2 * l_scale(i,k,j) / deltas - END IF - - tendency(i,k,j) = tendency(i,k,j) - & - mu(i,j) * coefc * tketmp**1.5 / l_scale(i,k,j) - END DO - END DO - END DO - - END SUBROUTINE tke_dissip - -!======================================================================= -!======================================================================= - - SUBROUTINE tke_shear( tendency, config_flags, & - defor11, defor22, defor33, & - defor12, defor13, defor23, & - u, v, w, tke, ust, mu, fnm, fnp, & - cf1, cf2, cf3, msftx, msfty, & - xkmh, xkmv, & - rdx, rdy, zx, zy, rdz, rdzw, dn, dnw, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! History: Sep 2003 Rewritten by George Bryan and Jason Knievel, -! NCAR -! Oct 2001 Converted to mass core by Bill Skamarock, NCAR -! Aug 2000 Original code by Shu-Hua Chen, UC-Davis - -! Purpose: This routine calculates the production of turbulent -! kinetic energy by stresses due to sheared wind. - -! References: Klemp and Wilhelmson (JAS 1978) -! Deardorff (B-L Meteor 1980) -! Chen and Dudhia (NCAR WRF physics report 2000) - -! Key: - -! avg temporary working array -! cf1 -! cf2 -! cf3 -! defor11 deformation term ( du/dx + du/dx ) -! defor12 deformation term ( dv/dx + du/dy ); same as defor21 -! defor13 deformation term ( dw/dx + du/dz ); same as defor31 -! defor22 deformation term ( dv/dy + dv/dy ) -! defor23 deformation term ( dw/dy + dv/dz ); same as defor32 -! defor33 deformation term ( dw/dz + dw/dz ) -! div 3-d divergence -! dn -! dnw -! fnm -! fnp -! msftx -! msfty -! rdx -! rdy -! tendency -! titau tau (stress tensor) with a tilde, indicating division by -! a map-scale factor and the fraction of the total modeled -! atmosphere beneath a given altitude (titau = tau/m/zeta) -! tke turbulent kinetic energy - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type ), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, INTENT( IN ) & - :: cf1, cf2, cf3, rdx, rdy - - REAL, DIMENSION( kms:kme ), INTENT( IN ) & - :: fnm, fnp, dn, dnw - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: msftx, msfty - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & - :: tendency - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: defor11, defor22, defor33, defor12, defor13, defor23, & - tke, xkmh, xkmv, zx, zy, u, v, w, rdz, rdzw - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: mu - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: ust - -! Local variables. - - INTEGER & - :: i, j, k, ktf, ktes1, ktes2, & - i_start, i_end, j_start, j_end, & - is_ext, ie_ext, js_ext, je_ext - - REAL & - :: mtau - - REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ) & - :: avg, titau, tmp2 - - REAL, DIMENSION( its:ite, kts:kte, jts:jte ) & - :: titau12, tmp1, zxavg, zyavg - - REAL :: absU, cd0, Cd - -! End declarations. -!----------------------------------------------------------------------- - - ktf = MIN( kte, kde-1 ) - ktes1 = kte-1 - ktes2 = kte-2 - - i_start = its - i_end = MIN( ite, ide-1 ) - j_start = jts - j_end = MIN( jte, jde-1 ) - - IF ( config_flags%open_xs .OR. config_flags%specified .OR. & - config_flags%nested ) i_start = MAX( ids+1, its ) - IF ( config_flags%open_xe .OR. config_flags%specified .OR. & - config_flags%nested ) i_end = MIN( ide-2, ite ) - IF ( config_flags%open_ys .OR. config_flags%specified .OR. & - config_flags%nested ) j_start = MAX( jds+1, jts ) - IF ( config_flags%open_ye .OR. config_flags%specified .OR. & - config_flags%nested ) j_end = MIN( jde-2, jte ) - IF ( config_flags%periodic_x ) i_start = its - IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - zxavg(i,k,j) = 0.25 * ( zx(i,k ,j) + zx(i+1,k ,j) + & - zx(i,k+1,j) + zx(i+1,k+1,j) ) - zyavg(i,k,j) = 0.25 * ( zy(i,k ,j) + zy(i,k ,j+1) + & - zy(i,k+1,j) + zy(i,k+1,j+1) ) - END DO - END DO - END DO - -! Begin calculating production of turbulence due to shear. The approach -! is to add together contributions from six terms, each of which is the -! square of a deformation that is then multiplied by an exchange -! coefficiant. The same exchange coefficient is assumed for horizontal -! and vertical coefficients for some of the terms (the vertical value is -! the one used). - -! For defor11. - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tendency(i,k,j) = tendency(i,k,j) + 0.5 * & - mu(i,j) * xkmh(i,k,j) * ( ( defor11(i,k,j) )**2 ) - END DO - END DO - END DO - -! For defor22. - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tendency(i,k,j) = tendency(i,k,j) + 0.5 * & - mu(i,j) * xkmh(i,k,j) * ( ( defor22(i,k,j) )**2 ) - END DO - END DO - END DO - -! For defor33. - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tendency(i,k,j) = tendency(i,k,j) + 0.5 * & - mu(i,j) * xkmv(i,k,j) * ( ( defor33(i,k,j) )**2 ) - END DO - END DO - END DO - -! For defor12. - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - avg(i,k,j) = 0.25 * & - ( ( defor12(i ,k,j)**2 ) + ( defor12(i ,k,j+1)**2 ) + & - ( defor12(i+1,k,j)**2 ) + ( defor12(i+1,k,j+1)**2 ) ) - END DO - END DO - END DO - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmh(i,k,j) * avg(i,k,j) - END DO - END DO - END DO - -! For defor13. - - DO j = j_start, j_end - DO k = kts+1, ktf - DO i = i_start, i_end+1 - tmp2(i,k,j) = defor13(i,k,j) - END DO - END DO - END DO - - DO j = j_start, j_end - DO i = i_start, i_end+1 - tmp2(i,kts ,j) = 0.0 - tmp2(i,ktf+1,j) = 0.0 - END DO - END DO - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - avg(i,k,j) = 0.25 * & - ( ( tmp2(i ,k+1,j)**2 ) + ( tmp2(i ,k,j)**2 ) + & - ( tmp2(i+1,k+1,j)**2 ) + ( tmp2(i+1,k,j)**2 ) ) - END DO - END DO - END DO - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmv(i,k,j) * avg(i,k,j) - END DO - END DO - END DO - -!MARTA: add the drag at the surface; WCS 040331 - K=KTS - - uflux: SELECT CASE( config_flags%isfflx ) - CASE (0) ! Assume cd a constant, specified in namelist - - cd0 = config_flags%tke_drag_coefficient ! drag coefficient set - ! in namelist.input - DO j = j_start, j_end - DO i = i_start, i_end - - absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2) - Cd = cd0 - tendency(i,k,j) = tendency(i,k,j) + & - mu(i,j)*( (u(i,k,j)+u(i+1,k,j))*0.5* & - Cd*absU*(defor13(i,kts+1,j)+defor13(i+1,kts+1,j))*0.5 ) - - END DO - END DO - - CASE (1,2) ! ustar computed from surface routine - - PRINT *, 'USE u star (surf drag) from PHYSICS', ust(i_start,j_start) - DO j = j_start, j_end - DO i = i_start, i_end - - absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)+epsilon - Cd = (ust(i,j)**2)/(absU**2) - tendency(i,k,j) = tendency(i,k,j) + & - mu(i,j)*( (u(i,k,j)+u(i+1,k,j))*0.5* & - Cd*absU*(defor13(i,kts+1,j)+defor13(i+1,kts+1,j))*0.5 ) - - END DO - END DO - - CASE DEFAULT - CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' ) - END SELECT uflux -! end of MARTA/WCS change - -! For defor23. - - DO j = j_start, j_end+1 - DO k = kts+1, ktf - DO i = i_start, i_end - tmp2(i,k,j) = defor23(i,k,j) - END DO - END DO - END DO - - DO j = j_start, j_end+1 - DO i = i_start, i_end - tmp2(i,kts, j) = 0.0 - tmp2(i,ktf+1,j) = 0.0 - END DO - END DO - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - avg(i,k,j) = 0.25 * & - ( ( tmp2(i,k+1,j )**2 ) + ( tmp2(i,k,j )**2) + & - ( tmp2(i,k+1,j+1)**2 ) + ( tmp2(i,k,j+1)**2) ) - END DO - END DO - END DO - - DO j = j_start, j_end - DO k = kts, ktf - DO i = i_start, i_end - tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmv(i,k,j) * avg(i,k,j) - END DO - END DO - END DO - -!MARTA: add the drag at the surface; WCS 040331 - K=KTS - - vflux: SELECT CASE( config_flags%isfflx ) - CASE (0) ! Assume cd a constant, specified in namelist - - cd0 = config_flags%tke_drag_coefficient ! constant drag coefficient - ! set in namelist.input - DO j = j_start, j_end - DO i = i_start, i_end - - absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2) - Cd = cd0 - tendency(i,k,j) = tendency(i,k,j) + & - mu(i,j)*( (v(i,k,j)+v(i,k,j+1))*0.5* & - Cd*absU*(defor23(i,kts+1,j)+defor23(i,kts+1,j+1))*0.5 ) - - END DO - END DO - - CASE (1,2) ! ustar computed from surface routine - - DO j = j_start, j_end - DO i = i_start, i_end - - absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)+epsilon - Cd = (ust(i,j)**2)/(absU**2) - tendency(i,k,j) = tendency(i,k,j) + & - mu(i,j)*( (v(i,k,j)+v(i,k,j+1))*0.5* & - Cd*absU*(defor23(i,kts+1,j)+defor23(i,kts+1,j+1))*0.5 ) - - END DO - END DO - - CASE DEFAULT - CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' ) - END SELECT vflux -! end of MARTA/WCS change - - END SUBROUTINE tke_shear - -!======================================================================= -!======================================================================= - - SUBROUTINE compute_diff_metrics( config_flags, ph, phb, z, rdz, rdzw, & - zx, zy, rdx, rdy, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!----------------------------------------------------------------------- -! Begin declarations. - - IMPLICIT NONE - - TYPE( grid_config_rec_type ), INTENT( IN ) & - :: config_flags - - INTEGER, INTENT( IN ) & - :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: ph, phb - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( OUT ) & - :: rdz, rdzw, zx, zy, z - - REAL, INTENT( IN ) & - :: rdx, rdy - -! Local variables. - - INTEGER & - :: i, j, k, i_start, i_end, j_start, j_end, ktf - -! End declarations. -!----------------------------------------------------------------------- - - ktf = MIN( kte, kde-1 ) - -! Bug fix, WCS, 22 april 2002. - -! We need rdzw in halo for average to u and v points. - - j_start = jts-1 - j_end = jte - -! Begin with dz computations. - - DO j = j_start, j_end - - IF ( ( j_start >= jts ) .AND. ( j_end <= MIN( jte, jde-1 ) ) ) THEN - i_start = its-1 - i_end = ite - ELSE - i_start = its - i_end = MIN( ite, ide-1 ) - END IF - -! Compute z at w points for rdz and rdzw computations. We'll switch z -! to z at p points before returning - - DO k = 1, kte - -! Bug fix, WCS, 22 april 2002 - - DO i = i_start, i_end - z(i,k,j) = ( ph(i,k,j) + phb(i,k,j) ) / g - END DO - END DO - - DO k = 1, ktf - DO i = i_start, i_end - rdzw(i,k,j) = 1.0 / ( z(i,k+1,j) - z(i,k,j) ) - END DO - END DO - - DO k = 2, ktf - DO i = i_start, i_end - rdz(i,k,j) = 2.0 / ( z(i,k+1,j) - z(i,k-1,j) ) - END DO - END DO - -! Bug fix, WCS, 22 april 2002; added the following code - - DO i = i_start, i_end - rdz(i,1,j) = 2./(z(i,2,j)-z(i,1,j)) - END DO - - END DO - -! End bug fix. - -! Now compute zx and zy; we'll assume that the halo for ph and phb is -! properly filled. - - i_start = its - i_end = MIN( ite, ide-1 ) - j_start = jts - j_end = MIN( jte, jde-1 ) - - DO j = j_start, j_end - DO k = 1, kte - DO i = MAX( ids+1, its ), i_end - zx(i,k,j) = rdx * ( phb(i,k,j) - phb(i-1,k,j) ) / g - END DO - END DO - END DO - - DO j = j_start, j_end - DO k = 1, kte - DO i = MAX( ids+1, its ), i_end - zx(i,k,j) = zx(i,k,j) + rdx * ( ph(i,k,j) - ph(i-1,k,j) ) / g - END DO - END DO - END DO - - DO j = MAX( jds+1, jts ), j_end - DO k = 1, kte - DO i = i_start, i_end - zy(i,k,j) = rdy * ( phb(i,k,j) - phb(i,k,j-1) ) / g - END DO - END DO - END DO - - DO j = MAX( jds+1, jts ), j_end - DO k = 1, kte - DO i = i_start, i_end - zy(i,k,j) = zy(i,k,j) + rdy * ( ph(i,k,j) - ph(i,k,j-1) ) / g - END DO - END DO - END DO - -! Some b.c. on zx and zy. - - IF ( .NOT. config_flags%periodic_x ) THEN - - IF ( ite == ide ) THEN - DO j = j_start, j_end - DO k = 1, ktf - zx(ide,k,j) = 0.0 - END DO - END DO - END IF - - IF ( its == ids ) THEN - DO j = j_start, j_end - DO k = 1, ktf - zx(ids,k,j) = 0.0 - END DO - END DO - END IF - - ELSE - - IF ( ite == ide ) THEN - DO j=j_start,j_end - DO k=1,ktf - zx(ide,k,j) = rdx * ( phb(ide,k,j) - phb(ide-1,k,j) ) / g - END DO - END DO - - DO j = j_start, j_end - DO k = 1, ktf - zx(ide,k,j) = zx(ide,k,j) + rdx * ( ph(ide,k,j) - ph(ide-1,k,j) ) / g - END DO - END DO - END IF - - IF ( its == ids ) THEN - DO j = j_start, j_end - DO k = 1, ktf - zx(ids,k,j) = rdx * ( phb(ids,k,j) - phb(ids-1,k,j) ) / g - END DO - END DO - - DO j =j_start,j_end - DO k =1,ktf - zx(ids,k,j) = zx(ids,k,j) + rdx * ( ph(ids,k,j) - ph(ids-1,k,j) ) / g - END DO - END DO - END IF - - END IF - - IF ( .NOT. config_flags%periodic_y ) THEN - - IF ( jte == jde ) THEN - DO k =1, ktf - DO i =i_start, i_end - zy(i,k,jde) = 0.0 - END DO - END DO - END IF - - IF ( jts == jds ) THEN - DO k =1, ktf - DO i =i_start, i_end - zy(i,k,jds) = 0.0 - END DO - END DO - END IF - - ELSE - - IF ( jte == jde ) THEN - DO j=j_start, j_end - DO k=1, ktf - zy(i,k,jde) = rdy * ( phb(i,k,jde) - phb(i,k,jde-1) ) / g - END DO - END DO - - DO j = j_start, j_end - DO k = 1, ktf - zy(i,k,jde) = zy(i,k,jde) + rdy * ( ph(i,k,jde) - ph(i,k,jde-1) ) / g - END DO - END DO - END IF - - IF ( jts == jds ) THEN - DO j = j_start, j_end - DO k = 1, ktf - zy(i,k,jds) = rdy * ( phb(i,k,jds) - phb(i,k,jds-1) ) / g - END DO - END DO - - DO j = j_start, j_end - DO k = 1, ktf - zy(i,k,jds) = zy(i,k,jds) + rdy * ( ph(i,k,jds) - ph(i,k,jds-1) ) / g - END DO - END DO - END IF - - END IF - -! Calculate z at p points. - - DO j = j_start, j_end - DO k = 1, ktf - DO i = i_start, i_end - z(i,k,j) = 0.5 * & - ( ph(i,k,j) + phb(i,k,j) + ph(i,k+1,j) + phb(i,k+1,j) ) / g - END DO - END DO - END DO - - END SUBROUTINE compute_diff_metrics - -!======================================================================= -!======================================================================= - - END MODULE module_diffusion_em - -!======================================================================= -!======================================================================= - - Index: unk/WRF.COMMON/WRFV3/modif_mars/module_driver_constants.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/modif_mars/module_driver_constants.F (revision 2760) +++ (revision ) @@ -1,108 +1,0 @@ -!WRF:DRIVER_LAYER:CONSTANTS -! -! This MODULE contains all of the constants used in the model. These -! are separated by uage within the code. - -MODULE module_driver_constants - - ! 0. The following tells the rest of the model what data ordering we are - ! using - - INTEGER , PARAMETER :: DATA_ORDER_XYZ = 1 - INTEGER , PARAMETER :: DATA_ORDER_YXZ = 2 - INTEGER , PARAMETER :: DATA_ORDER_ZXY = 3 - INTEGER , PARAMETER :: DATA_ORDER_ZYX = 4 - INTEGER , PARAMETER :: DATA_ORDER_XZY = 5 - INTEGER , PARAMETER :: DATA_ORDER_YZX = 6 - INTEGER , PARAMETER :: DATA_ORDER_XY = DATA_ORDER_XYZ - INTEGER , PARAMETER :: DATA_ORDER_YX = DATA_ORDER_YXZ - - -#include - - ! 1. Following are constants for use in defining maximal values for array - ! definitions. - ! - - ! The maximum number of levels in the model is how deeply the domains may - ! be nested. - - INTEGER , PARAMETER :: max_levels = 20 - - ! The maximum number of nests that can depend on a single parent and other way round - - INTEGER , PARAMETER :: max_nests = 20 - - ! The maximum number of parents that a nest can have (simplified assumption -> one only) - - INTEGER , PARAMETER :: max_parents = 1 - - ! The maximum number of domains is how many grids the model will be running. - - INTEGER , PARAMETER :: max_domains = ( MAX_DOMAINS_F - 1 ) / 2 + 1 - - ! The maximum number of nest move specifications allowed in a namelist - - INTEGER , PARAMETER :: max_moves = 50 - - ! The maximum number of eta levels - - INTEGER , PARAMETER :: max_eta = 501 - - ! The maximum number of outer iterations (for DA minimisation) - - INTEGER , PARAMETER :: max_outer_iterations = 10 - - ! The maximum number of instruments (for radiance DA) - - INTEGER , PARAMETER :: max_instruments = 30 - - ! 2. Following related to driver leve data structures for DM_PARALLEL communications - -#ifdef DM_PARALLEL - INTEGER , PARAMETER :: max_comms = 1024 -#else - INTEGER , PARAMETER :: max_comms = 1 -#endif - - ! 3. Following is information related to the file I/O. - - ! These are the bounds of the available FORTRAN logical unit numbers for the file I/O. - ! Only logical unti numbers within these bounds will be chosen for I/O unit numbers. - - INTEGER , PARAMETER :: min_file_unit = 10 - INTEGER , PARAMETER :: max_file_unit = 99 - - ! 4. Unfortunately, the following definition is needed here (rather - ! than the more logical place in share/module_model_constants.F) - ! for the namelist reads in frame/module_configure.F, and for some - ! conversions in share/set_timekeeping.F - ! Actually, using it here will mean that we don't need to set it - ! in share/module_model_constants.F, since this file will be - ! included (USEd) in: - ! frame/module_configure.F - ! which will be USEd in: - ! share/module_bc.F - ! which will be USEd in: - ! phys/module_radiation_driver.F - ! which is the other important place for it to be, and where - ! it is passed as a subroutine parameter to any physics subroutine. - ! - ! P2SI is the number of SI seconds in an planetary solar day - ! divided by the number of SI seconds in an earth solar day -!#if defined MARS -! ! For Mars, P2SI = 88775.2/86400. -! REAL , PARAMETER :: P2SI = 1.0274907 -!#elif defined TITAN -! ! For Titan, P2SI = 1378080.0/86400. -! REAL , PARAMETER :: P2SI = 15.95 -!#else - ! Default for Earth - REAL , PARAMETER :: P2SI = 1.0 -!!!!MARS -! REAL , PARAMETER :: P2SI = 1.0274907 -!#endif - CONTAINS - SUBROUTINE init_module_driver_constants - END SUBROUTINE init_module_driver_constants - END MODULE module_driver_constants Index: unk/WRF.COMMON/WRFV3/modif_mars/module_em.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/modif_mars/module_em.F (revision 2760) +++ (revision ) @@ -1,1781 +1,0 @@ -!WRF:MODEL_LAYER:DYNAMICS -! - -MODULE module_em - - USE module_model_constants - USE module_advect_em - USE module_big_step_utilities_em - USE module_state_description - USE module_damping_em - -CONTAINS - -!------------------------------------------------------------------------ - -SUBROUTINE rk_step_prep ( config_flags, rk_step, & - u, v, w, t, ph, mu, & - moist, & - ru, rv, rw, ww, php, alt, & - muu, muv, & - mub, mut, phb, pb, p, al, alb, & - cqu, cqv, cqw, & - msfux, msfuy, & - msfvx, msfvx_inv, msfvy, & - msftx, msfty, & - fnm, fnp, dnw, rdx, rdy, & - n_moist, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - - ! Input data. - - TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER , INTENT(IN ) :: n_moist, rk_step - - REAL , INTENT(IN ) :: rdx, rdy - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & - INTENT(IN ) :: u, & - v, & - w, & - t, & - ph, & - phb, & - pb, & - al, & - alb - - REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & - INTENT( OUT) :: ru, & - rv, & - rw, & - ww, & - php, & - cqu, & - cqv, & - cqw, & - alt - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & - INTENT(IN ) :: p - - - - - REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ), INTENT( IN) :: & - moist - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msftx, & - msfty, & - msfux, & - msfuy, & - msfvx, & - msfvx_inv, & - msfvy, & - mu, & - mub - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT( OUT) :: muu, & - muv, & - mut - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm, fnp, dnw - - integer :: k - - -! -! -! rk_step_prep prepares a number of diagnostic quantities -! in preperation for a Runge-Kutta timestep. subroutines called -! by rk_step_prep calculate -! -! (1) total column dry air mass (mut, call to calculate_full) -! -! (2) total column dry air mass at u and v points -! (muu, muv, call to calculate_mu_uv) -! -! (3) mass-coupled velocities for advection -! (ru, rv, and rw, call to couple_momentum) -! -! (4) omega (call to calc_ww_cp) -! -! (5) moisture coefficients (cqu, cqv, cqw, call to calc_cq) -! -! (6) inverse density (alt, call to calc_alt) -! -! (7) geopotential at pressure points (php, call to calc_php) -! -! - - CALL calculate_full( mut, mub, mu, & - ids, ide, jds, jde, 1, 2, & - ims, ime, jms, jme, 1, 1, & - its, ite, jts, jte, 1, 1 ) - - CALL calc_mu_uv ( config_flags, & - mu, mub, muu, muv, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL couple_momentum( muu, ru, u, msfuy, & - muv, rv, v, msfvx, msfvx_inv, & - mut, rw, w, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! new call, couples V with mu, also has correct map factors. WCS, 3 june 2001 - CALL calc_ww_cp ( u, v, mu, mub, ww, & - rdx, rdy, msftx, msfty, & - msfux, msfuy, msfvx, msfvx_inv, & - msfvy, dnw, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL calc_cq ( moist, cqu, cqv, cqw, n_moist, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL calc_alt ( alt, al, alb, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL calc_php ( php, ph, phb, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -END SUBROUTINE rk_step_prep - -!------------------------------------------------------------------------------- - -SUBROUTINE rk_tendency ( config_flags, rk_step, & - ru_tend, rv_tend, rw_tend, ph_tend, t_tend, & - ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, & - mu_tend, u_save, v_save, w_save, ph_save, & - t_save, mu_save, RTHFTEN, & - ru, rv, rw, ww, & - u, v, w, t, ph, & - u_old, v_old, w_old, t_old, ph_old, & - h_diabatic, phb,t_init, & - mu, mut, muu, muv, mub, & - al, alt, p, pb, php, cqu, cqv, cqw, & - u_base, v_base, t_base, qv_base, z_base, & - msfux, msfuy, msfvx, msfvx_inv, & - msfvy, msftx, msfty, & - xlat, f, e, sina, cosa, & - fnm, fnp, rdn, rdnw, & - dt, rdx, rdy, khdif, kvdif, xkmhd, xkhh, & - diff_6th_opt, diff_6th_factor, & - dampcoef,zdamp,damp_opt, & - cf1, cf2, cf3, cfn, cfn1, n_moist, & - non_hydrostatic, top_lid, & - u_frame, v_frame, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte, & - max_vert_cfl, max_horiz_cfl) - - IMPLICIT NONE - - ! Input data. - - TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - LOGICAL , INTENT(IN ) :: non_hydrostatic, top_lid - - INTEGER , INTENT(IN ) :: n_moist, rk_step - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & - INTENT(IN ) :: ru, & - rv, & - rw, & - ww, & - u, & - v, & - w, & - t, & - ph, & - u_old, & - v_old, & - w_old, & - t_old, & - ph_old, & - phb, & - al, & - alt, & - p, & - pb, & - php, & - cqu, & - cqv, & - t_init, & - xkmhd, & - xkhh, & - h_diabatic - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & - INTENT(OUT ) :: ru_tend, & - rv_tend, & - rw_tend, & - t_tend, & - ph_tend, & - RTHFTEN, & - u_save, & - v_save, & - w_save, & - ph_save, & - t_save - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & - INTENT(INOUT) :: ru_tendf, & - rv_tendf, & - rw_tendf, & - t_tendf, & - ph_tendf, & - cqw - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT( OUT) :: mu_tend, & - mu_save - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & - msfuy, & - msfvx, & - msfvx_inv, & - msfvy, & - msftx, & - msfty, & - xlat, & - f, & - e, & - sina, & - cosa, & - mu, & - mut, & - mub, & - muu, & - muv - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm, & - fnp, & - rdn, & - rdnw, & - u_base, & - v_base, & - t_base, & - qv_base, & - z_base - - REAL , INTENT(IN ) :: rdx, & - rdy, & - dt, & - u_frame, & - v_frame, & - khdif, & - kvdif - INTEGER, INTENT( IN ) :: diff_6th_opt - REAL, INTENT( IN ) :: diff_6th_factor - - INTEGER, INTENT( IN ) :: damp_opt - - REAL, INTENT( IN ) :: zdamp, dampcoef - - REAL, INTENT( OUT ) :: max_horiz_cfl - REAL, INTENT( OUT ) :: max_vert_cfl - - REAL :: kdift, khdq, kvdq, cfn, cfn1, cf1, cf2, cf3 - INTEGER :: i,j,k - INTEGER :: time_step - -! -! -! rk_tendency computes the large-timestep tendency terms in the -! momentum, thermodynamic (theta), and geopotential equations. -! These terms include: -! -! (1) advection (for u, v, w, theta - calls to advect_u, advect_v, -! advect_w, and advact_scalar). -! -! (2) geopotential equation terms (advection and "gw" - call to rhs_ph). -! -! (3) buoyancy term in vertical momentum equation (call to pg_buoy_w). -! -! (4) Coriolis and curvature terms in u,v,w momentum equations -! (calls to subroutines coriolis, curvature) -! -! (5) 3D diffusion on coordinate surfaces. -! -! - - CALL zero_tend ( ru_tend, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( rv_tend, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( rw_tend, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( t_tend, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( ph_tend, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( u_save, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( v_save, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( w_save, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( ph_save, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( t_save, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( mu_tend, & - ids, ide, jds, jde, 1, 1, & - ims, ime, jms, jme, 1, 1, & - its, ite, jts, jte, 1, 1 ) - - CALL zero_tend ( mu_save, & - ids, ide, jds, jde, 1, 1, & - ims, ime, jms, jme, 1, 1, & - its, ite, jts, jte, 1, 1 ) - - ! advection tendencies - CALL nl_get_time_step ( 1, time_step ) - - CALL advect_u ( u, u , ru_tend, ru, rv, ww, & - mut, time_step, config_flags, & - msfux, msfuy, msfvx, msfvy, & - msftx, msfty, & - fnm, fnp, rdx, rdy, rdnw, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL advect_v ( v, v , rv_tend, ru, rv, ww, & - mut, time_step, config_flags, & - msfux, msfuy, msfvx, msfvy, & - msftx, msfty, & - fnm, fnp, rdx, rdy, rdnw, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IF (non_hydrostatic) & - CALL advect_w ( w, w, rw_tend, ru, rv, ww, & - mut, time_step, config_flags, & - msfux, msfuy, msfvx, msfvy, & - msftx, msfty, & - fnm, fnp, rdx, rdy, rdn, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! theta flux divergence - - CALL advect_scalar ( t, t, t_tend, ru, rv, ww, & - mut, time_step, config_flags, & - msfux, msfuy, msfvx, msfvy, & - msftx, msfty, fnm, fnp, & - rdx, rdy, rdnw, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IF ( config_flags%cu_physics == GDSCHEME .OR. & - config_flags%cu_physics == G3SCHEME ) THEN - - ! theta advection only: - - CALL set_tend( RTHFTEN, t_tend, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - END IF - - CALL rhs_ph( ph_tend, u, v, ww, ph, ph, phb, w, & - mut, muu, muv, & - fnm, fnp, & - rdnw, cfn, cfn1, rdx, rdy, & - msfux, msfuy, msfvx, & - msfvx_inv, msfvy, & - msftx, msfty, & - non_hydrostatic, & - config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL horizontal_pressure_gradient( ru_tend,rv_tend, & - ph,alt,p,pb,al,php,cqu,cqv, & - muu,muv,mu,fnm,fnp,rdnw, & - cf1,cf2,cf3,rdx,rdy,msfux,msfuy,& - msfvx,msfvy,msftx,msfty, & - config_flags, non_hydrostatic, & - top_lid, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IF (non_hydrostatic) & - CALL pg_buoy_w( rw_tend, p, cqw, mu, mub, & - rdnw, rdn, g, msftx, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL w_damp ( rw_tend, max_vert_cfl, & - max_horiz_cfl, & - u, v, ww, w, mut, rdnw, & - rdx, rdy, msfux, msfuy, msfvx, & - msfvy, dt, config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IF(config_flags%pert_coriolis) THEN - - CALL perturbation_coriolis ( ru, rv, rw, & - ru_tend, rv_tend, rw_tend, & - config_flags, & - u_base, v_base, z_base, & - muu, muv, phb, ph, & - msftx, msfty, msfux, msfuy, & - msfvx, msfvy, & - f, e, sina, cosa, fnm, fnp, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - ELSE - CALL coriolis ( ru, rv, rw, & - ru_tend, rv_tend, rw_tend, & - config_flags, & - msftx, msfty, msfux, msfuy, & - msfvx, msfvy, & - f, e, sina, cosa, fnm, fnp, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - END IF - - CALL curvature ( ru, rv, rw, u, v, w, & - ru_tend, rv_tend, rw_tend, & - config_flags, & - msfux, msfuy, msfvx, msfvy, & - msftx, msfty, & - xlat, fnm, fnp, rdx, rdy, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! Damping option added for Held-Suarez test (also uses lw option HELDSUAREZ) - IF (config_flags%ra_lw_physics == HELDSUAREZ) THEN - CALL held_suarez_damp ( ru_tend, rv_tend, & - ru,rv,p,pb, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - END IF - -!************************************************************** -! -! Next, the terms that we integrate only with forward-in-time -! (evaluate with time t variables). -! -!************************************************************** - - forward_step: IF( rk_step == 1 ) THEN - - diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN - - CALL horizontal_diffusion ('u', u, ru_tendf, mut, config_flags, & - msfux, msfuy, msfvx, msfvx_inv, & - msfvy,msftx, msfty, & - khdif, xkmhd, rdx, rdy, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL horizontal_diffusion ('v', v, rv_tendf, mut, config_flags, & - msfux, msfuy, msfvx, msfvx_inv, & - msfvy,msftx, msfty, & - khdif, xkmhd, rdx, rdy, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL horizontal_diffusion ('w', w, rw_tendf, mut, config_flags, & - msfux, msfuy, msfvx, msfvx_inv, & - msfvy,msftx, msfty, & - khdif, xkmhd, rdx, rdy, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - khdq = 3.*khdif - CALL horizontal_diffusion_3dmp ( 'm', t, t_tendf, mut, & - config_flags, t_init, & - msfux, msfuy, msfvx, msfvx_inv, & - msfvy, msftx, msfty, & - khdq , xkhh, rdx, rdy, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN -!!!****MARS: vertical diffusion is done in the physics (TODO: consider the nonhydrostatic case ?) - pbl_test : IF ( (config_flags%bl_pbl_physics .eq. 0) & - .AND. (.not. config_flags%modif_wrf) ) THEN - - CALL vertical_diffusion_u ( u, ru_tendf, config_flags, & - u_base, & - alt, muu, rdn, rdnw, kvdif, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL vertical_diffusion_v ( v, rv_tendf, config_flags, & - v_base, & - alt, muv, rdn, rdnw, kvdif, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IF (non_hydrostatic) & - CALL vertical_diffusion ( 'w', w, rw_tendf, config_flags, & - alt, mut, rdn, rdnw, kvdif, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - kvdq = 3.*kvdif - CALL vertical_diffusion_3dmp ( t, t_tendf, config_flags, t_init, & - alt, mut, rdn, rdnw, kvdq , & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - ENDIF pbl_test - - ! Theta tendency computations. - - END IF diff_opt1 - - IF ( diff_6th_opt .NE. 0 ) THEN - - CALL sixth_order_diffusion( 'u', u, ru_tendf, mut, dt, & - config_flags, & - diff_6th_opt, diff_6th_factor, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL sixth_order_diffusion( 'v', v, rv_tendf, mut, dt, & - config_flags, & - diff_6th_opt, diff_6th_factor, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IF (non_hydrostatic) & - CALL sixth_order_diffusion( 'w', w, rw_tendf, mut, dt, & - config_flags, & - diff_6th_opt, diff_6th_factor, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL sixth_order_diffusion( 'm', t, t_tendf, mut, dt, & - config_flags, & - diff_6th_opt, diff_6th_factor, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - ENDIF - - IF( damp_opt .eq. 2 ) & - CALL rk_rayleigh_damp( ru_tendf, rv_tendf, & - rw_tendf, t_tendf, & - u, v, w, t, t_init, & - mut, muu, muv, ph, phb, & - u_base, v_base, t_base, z_base, & - dampcoef, zdamp, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - END IF forward_step - -END SUBROUTINE rk_tendency - -!------------------------------------------------------------------------------- - -SUBROUTINE rk_addtend_dry ( ru_tend, rv_tend, rw_tend, ph_tend, t_tend, & - ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, & - u_save, v_save, w_save, ph_save, t_save, & - mu_tend, mu_tendf, rk_step, & - h_diabatic, mut, msftx, msfty, msfux, msfuy, & - msfvx, msfvx_inv, msfvy, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - ips,ipe, jps,jpe, kps,kpe, & - its,ite, jts,jte, kts,kte ) - - IMPLICIT NONE - - ! Input data. - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - its, ite, jts, jte, kts, kte - INTEGER , INTENT(IN ) :: rk_step - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: ru_tend, & - rv_tend, & - rw_tend, & - ph_tend, & - t_tend, & - ru_tendf, & - rv_tendf, & - rw_tendf, & - ph_tendf, & - t_tendf - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: mu_tend, & - mu_tendf - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: u_save, & - v_save, & - w_save, & - ph_save, & - t_save, & - h_diabatic - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut, & - msftx, & - msfty, & - msfux, & - msfuy, & - msfvx, & - msfvx_inv, & - msfvy - - -! Local - INTEGER :: i, j, k - -! -! -! rk_addtend_dry constructs the full large-timestep tendency terms for -! momentum (u,v,w), theta and geopotential equations. This is accomplished -! by combining the physics tendencies (in *tendf; these are computed -! the first RK substep, held fixed thereafter) with the RK tendencies -! (in *tend, these include advection, pressure gradient, etc; -! these change each rk substep). Output is in *tend. -! -! - -! Finally, add the forward-step tendency to the rk_tendency - -! u/v/w/save contain bc tendency that needs to be multiplied by msf -! (u by msfuy, v by msfvx) -! before adding it to physics tendency (*tendf) -! For momentum we need the final tendency to include an inverse msf -! physics/bc tendency needs to be divided, advection tendency already has it - -! For scalars we need the final tendency to include an inverse msf (msfty) -! advection tendency is OK, physics/bc tendency needs to be divided by msf - - DO j = jts,MIN(jte,jde-1) - DO k = kts,kte-1 - DO i = its,ite - ! multiply by my to uncouple u - IF(rk_step == 1)ru_tendf(i,k,j) = ru_tendf(i,k,j) + u_save(i,k,j)*msfuy(i,j) - ! divide by my to couple u - ru_tend(i,k,j) = ru_tend(i,k,j) + ru_tendf(i,k,j)/msfuy(i,j) - ENDDO - ENDDO - ENDDO - - DO j = jts,jte - DO k = kts,kte-1 - DO i = its,MIN(ite,ide-1) - ! multiply by mx to uncouple v - IF(rk_step == 1)rv_tendf(i,k,j) = rv_tendf(i,k,j) + v_save(i,k,j)*msfvx(i,j) - ! divide by mx to couple v - rv_tend(i,k,j) = rv_tend(i,k,j) + rv_tendf(i,k,j)*msfvx_inv(i,j) - ENDDO - ENDDO - ENDDO - - DO j = jts,MIN(jte,jde-1) - DO k = kts,kte - DO i = its,MIN(ite,ide-1) - ! multiply by my to uncouple w - IF(rk_step == 1)rw_tendf(i,k,j) = rw_tendf(i,k,j) + w_save(i,k,j)*msfty(i,j) - ! divide by my to couple w - rw_tend(i,k,j) = rw_tend(i,k,j) + rw_tendf(i,k,j)/msfty(i,j) - IF(rk_step == 1)ph_tendf(i,k,j) = ph_tendf(i,k,j) + ph_save(i,k,j) - ! divide by my to couple scalar - ph_tend(i,k,j) = ph_tend(i,k,j) + ph_tendf(i,k,j)/msfty(i,j) - ENDDO - ENDDO - ENDDO - - DO j = jts,MIN(jte,jde-1) - DO k = kts,kte-1 - DO i = its,MIN(ite,ide-1) - IF(rk_step == 1)t_tendf(i,k,j) = t_tendf(i,k,j) + t_save(i,k,j) - ! divide by my to couple theta - t_tend(i,k,j) = t_tend(i,k,j) + t_tendf(i,k,j)/msfty(i,j) & - + mut(i,j)*h_diabatic(i,k,j)/msfty(i,j) - ! divide by my to couple heating - ENDDO - ENDDO - ENDDO - - DO j = jts,MIN(jte,jde-1) - DO i = its,MIN(ite,ide-1) -! mu tendencies not coupled with 1/msf - mu_tend(i,j) = mu_tend(i,j) + mu_tendf(i,j) - ENDDO - ENDDO - -END SUBROUTINE rk_addtend_dry - -!------------------------------------------------------------------------------- - -SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & - rk_step, dt, & - ru, rv, ww, mut, mub, mu_old, & - alt, & - scalar_old, scalar, & - scalar_tends, advect_tend, & - RQVFTEN, & - base, moist_step, fnm, fnp, & - msfux, msfuy, msfvx, msfvx_inv, & - msfvy, msftx, msfty, & - rdx, rdy, rdn, rdnw, & - khdif, kvdif, xkmhd, & - diff_6th_opt, diff_6th_factor, & - pd_advection, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data. - - TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: rk_step, scs, sce - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - LOGICAL , INTENT(IN ) :: moist_step - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ), & - INTENT(IN ) :: scalar, scalar_old - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ), & - INTENT(INOUT) :: scalar_tends - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: advect_tend - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), INTENT(OUT ) :: RQVFTEN - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: ru, & - rv, & - ww, & - xkmhd, & - alt - - - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm, & - fnp, & - rdn, & - rdnw, & - base - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & - msfuy, & - msfvx, & - msfvx_inv, & - msfvy, & - msftx, & - msfty, & - mub, & - mut, & - mu_old - - REAL , INTENT(IN ) :: rdx, & - rdy, & - khdif, & - kvdif - - INTEGER, INTENT( IN ) :: diff_6th_opt - REAL, INTENT( IN ) :: diff_6th_factor - - REAL , INTENT(IN ) :: dt - - LOGICAL, INTENT(IN ) :: pd_advection - - ! Local data - - INTEGER :: im, i,j,k - INTEGER :: time_step - - REAL :: khdq, kvdq, tendency - -! -! -! rk_scalar_tend calls routines that computes scalar tendency from advection -! and 3D mixing (TKE or fixed eddy viscosities). -! -! - - - khdq = khdif/prandtl - kvdq = kvdif/prandtl - - scalar_loop : DO im = scs, sce - - CALL zero_tend ( advect_tend(ims,kms,jms), & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL nl_get_time_step ( 1, time_step ) - - IF( (rk_step == 3) .and. pd_advection ) THEN - - CALL advect_scalar_pd ( scalar(ims,kms,jms,im), & - scalar_old(ims,kms,jms,im), & - advect_tend(ims,kms,jms), & - ru, rv, ww, mut, mub, mu_old, & - config_flags, & - msfux, msfuy, msfvx, msfvy, & - msftx, msfty, fnm, fnp, & - rdx, rdy, rdnw,dt, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - ELSE - - CALL advect_scalar ( scalar(ims,kms,jms,im), & - scalar(ims,kms,jms,im), & - advect_tend(ims,kms,jms), & - ru, rv, ww, mut, time_step, & - config_flags, & - msfux, msfuy, msfvx, msfvy, & - msftx, msfty, fnm, fnp, & - rdx, rdy, rdnw, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - END IF - - IF((config_flags%cu_physics == GDSCHEME .OR. config_flags%cu_physics == G3SCHEME) & - .and. moist_step .and. ( im == P_QV) ) THEN - - CALL set_tend( RQVFTEN, advect_tend, msfty, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - ENDIF - - rk_step_1: IF( rk_step == 1 ) THEN - - diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN - - CALL horizontal_diffusion ( 'm', scalar(ims,kms,jms,im), & - scalar_tends(ims,kms,jms,im), mut, & - config_flags, & - msfux, msfuy, msfvx, msfvx_inv, & - msfvy, msftx, msfty, & - khdq , xkmhd, rdx, rdy, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -!!!****MARS: done in the physics - pbl_test : IF ( (config_flags%bl_pbl_physics .eq. 0) & - .AND. (.not. config_flags%modif_wrf) ) THEN -! pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN - - IF( (moist_step) .and. ( im == P_QV)) THEN - - CALL vertical_diffusion_mp ( scalar(ims,kms,jms,im), & - scalar_tends(ims,kms,jms,im), & - config_flags, base, & - alt, mut, rdn, rdnw, kvdq , & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - ELSE - - CALL vertical_diffusion ( 'm', scalar(ims,kms,jms,im), & - scalar_tends(ims,kms,jms,im), & - config_flags, & - alt, mut, rdn, rdnw, kvdq, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - END IF - - ENDIF pbl_test - - ENDIF diff_opt1 - - IF ( diff_6th_opt .NE. 0 ) & - CALL sixth_order_diffusion( 'm', scalar(ims,kms,jms,im), & - scalar_tends(ims,kms,jms,im), & - mut, dt, config_flags, & - diff_6th_opt, diff_6th_factor, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - ENDIF rk_step_1 - - END DO scalar_loop - -END SUBROUTINE rk_scalar_tend - -!------------------------------------------------------------------------------- - -SUBROUTINE rk_update_scalar( scs, sce, & - scalar_1, scalar_2, sc_tend, & - advect_tend, msftx, msfty, & - mu_old, mu_new, mu_base, & - rk_step, dt, spec_zone, & - config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data. - - TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: scs, sce, rk_step, spec_zone - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, INTENT(IN ) :: dt - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce), & - INTENT(INOUT) :: scalar_1, & - scalar_2, & - sc_tend - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), & - INTENT(IN) :: advect_tend - - REAL, DIMENSION(ims:ime, jms:jme ), INTENT(IN ) :: mu_old, & - mu_new, & - mu_base, & - msftx, & - msfty - - INTEGER :: i,j,k,im - REAL :: sc_middle, msfsq - REAL, DIMENSION(its:ite) :: muold, r_munew - - REAL, DIMENSION(its:ite, kts:kte, jts:jte ) :: tendency - - INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end - INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc - -! -! -! rk_scalar_update advances the scalar equation given the time t value -! of the scalar and the scalar tendency. -! -! - - -! -! set loop limits. - - i_start = its - i_end = ite - j_start = jts - j_end = jte - k_start = kts - k_end = kte-1 - IF(j_end == jde) j_end = j_end - 1 - IF(i_end == ide) i_end = i_end - 1 - - i_start_spc = i_start - i_end_spc = i_end - j_start_spc = j_start - j_end_spc = j_end - k_start_spc = k_start - k_end_spc = k_end - - IF( config_flags%nested .or. config_flags%specified ) THEN - IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone ) - IF( .NOT. config_flags%periodic_x)i_end = min( ite,ide-spec_zone-1 ) - j_start = max( jts,jds+spec_zone ) - j_end = min( jte,jde-spec_zone-1 ) - k_start = kts - k_end = min( kte, kde-1 ) - ENDIF - - IF ( rk_step == 1 ) THEN - - ! replace t-dt values (in scalar_1) with t values scalar_2, - ! then compute new values by adding tendency to values at t - - DO im = scs,sce - - DO j = jts, min(jte,jde-1) - DO k = kts, min(kte,kde-1) - DO i = its, min(ite,ide-1) - tendency(i,k,j) = 0. - ENDDO - ENDDO - ENDDO - - DO j = j_start,j_end - DO k = k_start,k_end - DO i = i_start,i_end - ! scalar was coupled with my - tendency(i,k,j) = advect_tend(i,k,j) * msfty(i,j) - ENDDO - ENDDO - ENDDO - - DO j = j_start_spc,j_end_spc - DO k = k_start_spc,k_end_spc - DO i = i_start_spc,i_end_spc - tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im) - ENDDO - ENDDO - ENDDO - - DO j = jts, min(jte,jde-1) - - DO i = its, min(ite,ide-1) - muold(i) = mu_old(i,j) + mu_base(i,j) - r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j)) - ENDDO - - DO k = kts, min(kte,kde-1) - DO i = its, min(ite,ide-1) - - scalar_1(i,k,j,im) = scalar_2(i,k,j,im) - scalar_2(i,k,j,im) = (muold(i)*scalar_1(i,k,j,im) & - + dt*tendency(i,k,j))*r_munew(i) - - ENDDO - ENDDO - ENDDO - - ENDDO - - ELSE - - ! just compute new values, scalar_1 already at time t. - - DO im = scs, sce - - DO j = jts, min(jte,jde-1) - DO k = kts, min(kte,kde-1) - DO i = its, min(ite,ide-1) - tendency(i,k,j) = 0. - ENDDO - ENDDO - ENDDO - - DO j = j_start,j_end - DO k = k_start,k_end - DO i = i_start,i_end - ! scalar was coupled with my - tendency(i,k,j) = advect_tend(i,k,j) * msfty(i,j) - ENDDO - ENDDO - ENDDO - - DO j = j_start_spc,j_end_spc - DO k = k_start_spc,k_end_spc - DO i = i_start_spc,i_end_spc - tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im) - ENDDO - ENDDO - ENDDO - - DO j = jts, min(jte,jde-1) - - DO i = its, min(ite,ide-1) - muold(i) = mu_old(i,j) + mu_base(i,j) - r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j)) - ENDDO - - DO k = kts, min(kte,kde-1) - DO i = its, min(ite,ide-1) - - scalar_2(i,k,j,im) = (muold(i)*scalar_1(i,k,j,im) & - + dt*tendency(i,k,j))*r_munew(i) - - ENDDO - ENDDO - ENDDO - - ENDDO - - END IF - -END SUBROUTINE rk_update_scalar - -!------------------------------------------------------------------------------- - -SUBROUTINE rk_update_scalar_pd( scs, sce, & - scalar, sc_tend, & - mu_old, mu_new, mu_base, & - rk_step, dt, spec_zone, & - config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IMPLICIT NONE - - ! Input data. - - TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN ) :: scs, sce, rk_step, spec_zone - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, INTENT(IN ) :: dt - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce), & - INTENT(INOUT) :: scalar, & - sc_tend - - REAL, DIMENSION(ims:ime, jms:jme ), INTENT(IN ) :: mu_old, & - mu_new, & - mu_base - - INTEGER :: i,j,k,im - REAL :: sc_middle, msfsq - REAL, DIMENSION(its:ite) :: muold, r_munew - - REAL, DIMENSION(its:ite, kts:kte, jts:jte ) :: tendency - - INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end - INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc - -! -! -! rk_scalar_update advances the scalar equation given the time t value -! of the scalar and the scalar tendency. -! -! - - -! -! set loop limits. - - i_start = its - i_end = ite - j_start = jts - j_end = jte - k_start = kts - k_end = kte-1 - IF(j_end == jde) j_end = j_end - 1 - IF(i_end == ide) i_end = i_end - 1 - - i_start_spc = i_start - i_end_spc = i_end - j_start_spc = j_start - j_end_spc = j_end - k_start_spc = k_start - k_end_spc = k_end - - IF( config_flags%nested .or. config_flags%specified ) THEN - IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone ) - IF( .NOT. config_flags%periodic_x)i_end = min( ite,ide-spec_zone-1 ) - j_start = max( jts,jds+spec_zone ) - j_end = min( jte,jde-spec_zone-1 ) - k_start = kts - k_end = min( kte, kde-1 ) - ENDIF - - DO im = scs, sce - - DO j = jts, min(jte,jde-1) - DO k = kts, min(kte,kde-1) - DO i = its, min(ite,ide-1) - tendency(i,k,j) = 0. - ENDDO - ENDDO - ENDDO - - DO j = j_start_spc,j_end_spc - DO k = k_start_spc,k_end_spc - DO i = i_start_spc,i_end_spc - tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im) - sc_tend(i,k,j,im) = 0. - ENDDO - ENDDO - ENDDO - - DO j = jts, min(jte,jde-1) - - DO i = its, min(ite,ide-1) - muold(i) = mu_old(i,j) + mu_base(i,j) - r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j)) - ENDDO - - DO k = kts, min(kte,kde-1) - DO i = its, min(ite,ide-1) - - scalar(i,k,j,im) = (muold(i)*scalar(i,k,j,im) & - + dt*tendency(i,k,j))*r_munew(i) - ENDDO - ENDDO - ENDDO - - ENDDO - -END SUBROUTINE rk_update_scalar_pd - -!------------------------------------------------------------ - -SUBROUTINE init_zero_tendency(ru_tendf, rv_tendf, rw_tendf, ph_tendf, & - t_tendf, tke_tendf, mu_tendf, & - moist_tendf,chem_tendf,scalar_tendf, & - n_moist,n_chem,n_scalar,rk_step, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -!----------------------------------------------------------------------- - IMPLICIT NONE -!----------------------------------------------------------------------- - - INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - INTEGER , INTENT(IN ) :: n_moist,n_chem,n_scalar,rk_step - - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: & - ru_tendf, & - rv_tendf, & - rw_tendf, & - ph_tendf, & - t_tendf, & - tke_tendf - - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: mu_tendf - - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),INTENT(INOUT)::& - moist_tendf - - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_chem ),INTENT(INOUT)::& - chem_tendf - - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar ),INTENT(INOUT)::& - scalar_tendf - -! LOCAL VARS - - INTEGER :: im, ic, is - -! -! -! init_zero_tendency -! sets tendency arrays to zero for all prognostic variables. -! -! - - - CALL zero_tend ( ru_tendf, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( rv_tendf, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( rw_tendf, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( ph_tendf, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( t_tendf, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( tke_tendf, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL zero_tend ( mu_tendf, & - ids, ide, jds, jde, kds, kds, & - ims, ime, jms, jme, kms, kms, & - its, ite, jts, jte, kts, kts ) - -! DO im=PARAM_FIRST_SCALAR,n_moist - DO im=1,n_moist ! make sure first one is zero too - CALL zero_tend ( moist_tendf(ims,kms,jms,im), & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - ENDDO - -! DO ic=PARAM_FIRST_SCALAR,n_chem - DO ic=1,n_chem ! make sure first one is zero too - CALL zero_tend ( chem_tendf(ims,kms,jms,ic), & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - ENDDO - -! DO ic=PARAM_FIRST_SCALAR,n_scalar - DO ic=1,n_scalar ! make sure first one is zero too - CALL zero_tend ( scalar_tendf(ims,kms,jms,ic), & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - ENDDO - -END SUBROUTINE init_zero_tendency - -!=================================================================== - - -SUBROUTINE dump_data( a, field, io_unit, & - ims, ime, jms, jme, kms, kme, & - ids, ide, jds, jde, kds, kde ) -implicit none -integer :: ims, ime, jms, jme, kms, kme, & - ids, ide, jds, jde, kds, kde -real, dimension(ims:ime, kms:kme, jds:jde) :: a -character :: field -integer :: io_unit - -integer :: is,ie,js,je,ks,ke - -! -! -! calculate_phy_tend couples the physics tendencies to the column mass (mu), -! because prognostic equations are in flux form, but physics tendencies are -! computed for uncoupled variables. -! -! - - itf=MIN(ite,ide-1) - jtf=MIN(jte,jde-1) - ktf=MIN(kte,kde-1) - itsu=MAX(its,ids+1) - jtsv=MAX(jts,jds+1) - -! radiation - - IF (config_flags%ra_lw_physics .gt. 0 .or. config_flags%ra_sw_physics .gt. 0) THEN - - DO J=jts,jtf - DO K=kts,ktf - DO I=its,itf - RTHRATEN(I,K,J)=mu(I,J)*RTHRATEN(I,K,J) - ENDDO - ENDDO - ENDDO - - ENDIF - -! cumulus - - IF (config_flags%cu_physics .gt. 0) THEN - - DO J=jts,jtf - DO I=its,itf - DO K=kts,ktf - RTHCUTEN(I,K,J)=mu(I,J)*RTHCUTEN(I,K,J) - RQVCUTEN(I,K,J)=mu(I,J)*RQVCUTEN(I,K,J) - ENDDO - ENDDO - ENDDO - - IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN - DO J=jts,jtf - DO I=its,itf - DO K=kts,ktf - RQCCUTEN(I,K,J)=mu(I,J)*RQCCUTEN(I,K,J) - ENDDO - ENDDO - ENDDO - ENDIF - - IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN - DO J=jts,jtf - DO I=its,itf - DO K=kts,ktf - RQRCUTEN(I,K,J)=mu(I,J)*RQRCUTEN(I,K,J) - ENDDO - ENDDO - ENDDO - ENDIF - - IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN - DO J=jts,jtf - DO I=its,itf - DO K=kts,ktf - RQICUTEN(I,K,J)=mu(I,J)*RQICUTEN(I,K,J) - ENDDO - ENDDO - ENDDO - ENDIF - - IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN - DO J=jts,jtf - DO I=its,itf - DO K=kts,ktf - RQSCUTEN(I,K,J)=mu(I,J)*RQSCUTEN(I,K,J) - ENDDO - ENDDO - ENDDO - ENDIF - - ENDIF - -! pbl - -! IF (config_flags%bl_pbl_physics .gt. 0) THEN -!!****MARS - IF ( (config_flags%bl_pbl_physics .gt. 0) .OR. (config_flags%modif_wrf) ) THEN - - DO J=jts,jtf - DO K=kts,ktf - DO I=its,itf - RUBLTEN(I,K,J) =mu(I,J)*RUBLTEN(I,K,J) - RVBLTEN(I,K,J) =mu(I,J)*RVBLTEN(I,K,J) - RTHBLTEN(I,K,J)=mu(I,J)*RTHBLTEN(I,K,J) - ENDDO - ENDDO - ENDDO - - IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN - DO J=jts,jtf - DO K=kts,ktf - DO I=its,itf - RQVBLTEN(I,K,J)=mu(I,J)*RQVBLTEN(I,K,J) - ENDDO - ENDDO - ENDDO - ENDIF - - IF (P_QC .ge. PARAM_FIRST_SCALAR) THEN - DO J=jts,jtf - DO K=kts,ktf - DO I=its,itf - RQCBLTEN(I,K,J)=mu(I,J)*RQCBLTEN(I,K,J) - ENDDO - ENDDO - ENDDO - ENDIF - - IF (P_QI .ge. PARAM_FIRST_SCALAR) THEN - DO J=jts,jtf - DO K=kts,ktf - DO I=its,itf - RQIBLTEN(I,K,J)=mu(I,J)*RQIBLTEN(I,K,J) - ENDDO - ENDDO - ENDDO - ENDIF - - ENDIF - -! fdda -! note fdda u and v tendencies are staggered, also only interior points have muu/muv, -! so only couple those - - IF (config_flags%grid_fdda .gt. 0) THEN - - DO J=jts,jtf - DO K=kts,ktf - DO I=itsu,itf -! if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) & -! write(*,'(a,3i6,e15.5)') 'u_ten before=',i,k,j, RUNDGDTEN(i,k,j) - RUNDGDTEN(I,K,J) =muu(I,J)*RUNDGDTEN(I,K,J) -! if( i == itf/2 .AND. j == jtf/2 .AND. k==ktf/2 ) & -! write(*,'(a,2f15.5)') 'mu, muu=',mu(i,j), muu(i,j) -! if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) & -! write(*,'(a,3i6,e15.5)') 'u_ten after=',i,k,j, RUNDGDTEN(i,k,j) -! if( RUNDGDTEN(i,k,j) > 30.0 ) write(*,*) 'IKJ=',i,k,j - ENDDO - ENDDO - ENDDO -! write(*,'(a,e15.5)') 'u_ten MAXIMUM after=', maxval(RUNDGDTEN) - DO J=jtsv,jtf - DO K=kts,ktf - DO I=its,itf - RVNDGDTEN(I,K,J) =muv(I,J)*RVNDGDTEN(I,K,J) - ENDDO - ENDDO - ENDDO - DO J=jts,jtf - DO K=kts,ktf - DO I=its,itf -! if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) & -! write(*,'(a,3i6,e15.5)') 'th before=',i,k,j, RTHNDGDTEN(I,K,J) - RTHNDGDTEN(I,K,J)=mu(I,J)*RTHNDGDTEN(I,K,J) -! RMUNDGDTEN(I,J) - no coupling -! if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) & -! write(*,'(a,3i6,e15.5)') 'th after=',i,k,j, RTHNDGDTEN(I,K,J) - ENDDO - ENDDO - ENDDO - - IF (P_QV .ge. PARAM_FIRST_SCALAR) THEN - DO J=jts,jtf - DO K=kts,ktf - DO I=its,itf - RQVNDGDTEN(I,K,J)=mu(I,J)*RQVNDGDTEN(I,K,J) - ENDDO - ENDDO - ENDDO - ENDIF - - ENDIF - -END SUBROUTINE calculate_phy_tend - -!----------------------------------------------------------------------- - -SUBROUTINE positive_definite_filter ( a, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) - - IMPLICIT NONE - - INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte - - REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: a - - INTEGER :: i,k,j - -! -! -! debug and testing code for bounding a variable -! -! - - DO j=jts,min(jte,jde-1) - DO k=kts,kte-1 - DO i=its,min(ite,ide-1) -! a(i,k,j) = max(a(i,k,j),0.) - a(i,k,j) = min(1000.,max(a(i,k,j),0.)) - ENDDO - ENDDO - ENDDO - - END SUBROUTINE positive_definite_filter - -!----------------------------------------------------------------------- - -SUBROUTINE bound_tke ( tke, tke_upper_bound, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) - - IMPLICIT NONE - - INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte - - REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: tke - REAL, INTENT( IN) :: tke_upper_bound - - INTEGER :: i,k,j - -! -! -! bounds tke between zero and tke_upper_bound. -! -! - - DO j=jts,min(jte,jde-1) - DO k=kts,kte-1 - DO i=its,min(ite,ide-1) - tke(i,k,j) = min(tke_upper_bound,max(tke(i,k,j),0.)) - ENDDO - ENDDO - ENDDO - - END SUBROUTINE bound_tke - - - -END MODULE module_em Index: unk/WRF.COMMON/WRFV3/modif_mars/module_first_rk_step_part1.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/modif_mars/module_first_rk_step_part1.F (revision 2760) +++ (revision ) @@ -1,701 +1,0 @@ -!WRF:MEDIATION_LAYER:SOLVER - -#define BENCH_START(A) -#define BENCH_END(A) - -MODULE module_first_rk_step_part1 - -CONTAINS - - SUBROUTINE first_rk_step_part1 ( grid , config_flags & - , moist , moist_tend & - , chem , chem_tend & - , scalar , scalar_tend & - , fdda3d, fdda2d & - , ru_tendf, rv_tendf & - , rw_tendf, t_tendf & - , ph_tendf, mu_tendf & - , tke_tend & - , adapt_step_flag , curr_secs & - , psim , psih , wspd , gz1oz0 , br , chklowq & - , cu_act_flag , hol , th_phy & - , pi_phy , p_phy , t_phy , u_phy , v_phy & - , dz8w , p8w , t8w , rho_phy , rho & - , z_at_w , mu_3d & - , ids, ide, jds, jde, kds, kde & - , ims, ime, jms, jme, kms, kme & - , ips, ipe, jps, jpe, kps, kpe & - , k_start , k_end & - ) - USE module_state_description - USE module_model_constants - USE module_domain, ONLY : domain - USE module_configure, ONLY : grid_config_rec_type, model_config_rec -!!!!****MARS MARS -!!!!****MARS MARS -! USE module_radiation_driver, ONLY : pre_radiation_driver, radiation_driver -! USE module_surface_driver, ONLY : surface_driver -! USE module_cumulus_driver, ONLY : cumulus_driver -! USE module_pbl_driver, ONLY : pbl_driver -! USE module_fddagd_driver, ONLY : fddagd_driver - USE module_em, ONLY : init_zero_tendency -!!MARS - USE module_lmd_driver -!!MARS - USE module_big_step_utilities_em, ONLY : phy_prep - USE module_dm - IMPLICIT NONE - - TYPE ( domain ), INTENT(INOUT) :: grid - TYPE ( grid_config_rec_type ), INTENT(IN) :: config_flags - - INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe - - LOGICAL ,INTENT(IN) :: adapt_step_flag - REAL, INTENT(IN) :: curr_secs - - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist_tend - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: chem - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: chem_tend - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: scalar - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: scalar_tend - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_fdda3d),INTENT(INOUT) :: fdda3d - REAL ,DIMENSION(ims:ime,1:1,jms:jme,num_fdda2d),INTENT(INOUT) :: fdda2d - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: psim - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: psih - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: wspd - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: gz1oz0 - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: br - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: chklowq - LOGICAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: cu_act_flag - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: hol - - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: th_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: pi_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: u_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: v_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme) :: w_phy !!MARS aymeric var loc - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: dz8w - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p8w - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t8w - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: z_at_w - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: mu_3d - - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ru_tendf - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rv_tendf - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rw_tendf - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ph_tendf - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_tendf - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: tke_tend - - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: mu_tendf - - INTEGER , INTENT(IN) :: k_start, k_end - -! Local - - REAL, DIMENSION( ims:ime, jms:jme ) :: ht_loc - INTEGER, DIMENSION( ims:ime, jms:jme ) :: shadowmask - INTEGER :: ij - INTEGER num_roof_layers - INTEGER num_wall_layers - INTEGER num_road_layers - INTEGER iswater - INTEGER rk_step - - ! initialize all tendencies to zero in order to update physics - ! tendencies first (separate from dry dynamics). - - rk_step = 1 - -BENCH_START(init_zero_tend_tim) - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - - DO ij = 1 , grid%num_tiles - - CALL wrf_debug ( 200 , ' call init_zero_tendency' ) - CALL init_zero_tendency ( ru_tendf, rv_tendf, rw_tendf, & - ph_tendf, t_tendf, tke_tend, & - mu_tendf, & - moist_tend,chem_tend,scalar_tend, & - num_moist,num_chem,num_scalar, & - rk_step, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start, k_end ) - - END DO - !$OMP END PARALLEL DO -BENCH_END(init_zero_tend_tim) - -#ifdef DM_PARALLEL -# include "HALO_EM_PHYS_A.inc" -#endif - - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - DO ij = 1 , grid%num_tiles - - CALL wrf_debug ( 200 , ' call phy_prep' ) - CALL phy_prep ( config_flags, & - grid%mut, grid%muu, grid%muv, grid%u_2, & - grid%v_2, grid%w_2, grid%p, grid%pb, grid%alt, & - grid%ph_2, grid%phb, grid%t_2, grid%tsk, moist, num_moist, & - mu_3d, rho, & - th_phy, p_phy, pi_phy, u_phy, v_phy, w_phy, & - p8w, t_phy, t8w, grid%z, z_at_w, & - dz8w, grid%fnm, grid%fnp, & - grid%rthraten, & - grid%rthblten, grid%rublten, grid%rvblten, & - grid%rqvblten, grid%rqcblten, grid%rqiblten, & - grid%rthcuten, grid%rqvcuten, grid%rqccuten, & - grid%rqrcuten, grid%rqicuten, grid%rqscuten, & - grid%rthften, grid%rqvften, & - grid%RUNDGDTEN, grid%RVNDGDTEN, grid%RTHNDGDTEN, & - grid%RQVNDGDTEN, grid%RMUNDGDTEN, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start, k_end ) - ENDDO - !$OMP END PARALLEL DO - -BENCH_END(phy_prep_tim) - -!!!!****MARS MARS -!!!!****MARS MARS - -!! radiation -! -!! this driver is only needed to handle non-local shadowing effects -! CALL pre_radiation_driver ( grid, config_flags & -! & ,itimestep=grid%itimestep, ra_call_offset=grid%ra_call_offset & -! & ,XLAT=grid%xlat, XLONG=grid%xlong, GMT=grid%gmt & -! & ,julian=grid%julian, xtime=grid%xtime, RADT=grid%radt & -! & ,STEPRA=grid%stepra & -! & ,ht=grid%ht,dx=grid%dx,dy=grid%dy,sina=grid%sina,cosa=grid%cosa & -! & ,shadowmask=shadowmask,slope_rad=config_flags%slope_rad & -! & ,topo_shading=config_flags%topo_shading & -! & ,shadlen=config_flags%shadlen,ht_shad=grid%ht_shad,ht_loc=ht_loc & -! & ,ht_shad_bxs=grid%ht_shad_bxs, ht_shad_bxe=grid%ht_shad_bxe & -! & ,ht_shad_bys=grid%ht_shad_bys, ht_shad_bye=grid%ht_shad_bye & -! & ,nested=config_flags%nested, min_ptchsz=grid%min_ptchsz & -! & ,spec_bdy_width=config_flags%spec_bdy_width & -! ! indexes -! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & -! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & -! & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe & -! & ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1) & -! & ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1) & -! & ,kts=k_start, kte=min(k_end,kde-1) & -! & ,num_tiles=grid%num_tiles ) -! -! CALL wrf_debug ( 200 , ' call radiation_driver' ) -!BENCH_START(rad_driver_tim) -! -! CALL radiation_driver( & -! & ACFRCV=grid%acfrcv ,ACFRST=grid%acfrst ,ALBEDO=grid%albedo & -! & ,CFRACH=grid%cfrach ,CFRACL=grid%cfracl ,CFRACM=grid%cfracm & -! & ,CUPPT=grid%cuppt ,CZMEAN=grid%czmean ,DT=grid%dt & -! & ,DZ8W=dz8w ,EMISS=grid%emiss ,GLW=grid%glw & -! & ,GMT=grid%gmt ,GSW=grid%gsw ,HBOT=grid%hbot & -! & ,HTOP=grid%htop ,HBOTR=grid%hbotr ,HTOPR=grid%htopr & -! & ,ICLOUD=config_flags%icloud & -! & ,ITIMESTEP=grid%itimestep,JULDAY=grid%julday , JULIAN=grid%julian & -! & ,JULYR=grid%julyr ,LW_PHYSICS=config_flags%ra_lw_physics & -! & ,NCFRCV=grid%ncfrcv ,NCFRST=grid%ncfrst ,NPHS=1 & -! & ,P8W=p8w ,P=p_phy ,PI=pi_phy & -! & ,RADT=grid%radt ,RA_CALL_OFFSET=grid%ra_call_offset & -! & ,RHO=rho ,RLWTOA=grid%rlwtoa & -! & ,RSWTOA=grid%rswtoa ,RTHRATEN=grid%rthraten & -! & ,RTHRATENLW=grid%rthratenlw ,RTHRATENSW=grid%rthratensw & -! & ,SNOW=grid%snow ,STEPRA=grid%stepra ,SWDOWN=grid%swdown & -! & ,SWDOWNC=grid%swdownc ,SW_PHYSICS=config_flags%ra_sw_physics & -! & ,T8W=t8w ,T=t_phy ,TAUCLDC=grid%taucldc & -! & ,TAUCLDI=grid%taucldi ,TSK=grid%tsk ,VEGFRA=grid%vegfra & -! & ,WARM_RAIN=grid%warm_rain ,XICE=grid%xice ,XLAND=grid%xland & -! & ,XLAT=grid%xlat ,XLONG=grid%xlong & -!!Optional urban -! & ,DECLIN_URB=grid%declin_urb ,COSZ_URB2D=grid%cosz_urb2d & -! & ,OMG_URB2D=grid%omg_urb2d & -!! -! & ,Z=grid%z & -! & ,LEVSIZ=grid%levsiz, N_OZMIXM=num_ozmixm & -! & ,N_AEROSOLC=num_aerosolc & -! & ,PAERLEV=grid%paerlev & -! & ,CAM_ABS_DIM1=grid%cam_abs_dim1, CAM_ABS_DIM2=grid%cam_abs_dim2 & -! & ,CAM_ABS_FREQ_S=grid%cam_abs_freq_s & -! & ,XTIME=grid%xtime & -! ,CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag & -! ! indexes -! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & -! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & -! & ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1) & -! & ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1) & -! & ,kts=k_start, kte=min(k_end,kde-1) & -! & ,num_tiles=grid%num_tiles & -! ! Optional -! & , CLDFRA=grid%cldfra & -! & , PB=grid%pb & -! & , F_ICE_PHY=grid%f_ice_phy,F_RAIN_PHY=grid%f_rain_phy & -! & , QV=moist(ims,kms,jms,P_QV), F_QV=F_QV & -! & , QC=moist(ims,kms,jms,P_QC), F_QC=F_QC & -! & , QR=moist(ims,kms,jms,P_QR), F_QR=F_QR & -! & , QI=moist(ims,kms,jms,P_QI), F_QI=F_QI & -! & , QS=moist(ims,kms,jms,P_QS), F_QS=F_QS & -! & , QG=moist(ims,kms,jms,P_QG), F_QG=F_QG & -! & , QNDROP=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP & -!#ifdef ACFLUX -! & ,ACSWUPT=acswupt ,ACSWUPTC=acswuptc & -! & ,ACSWDNT=acswdnt ,ACSWDNTC=acswdntc & -! & ,ACSWUPB=acswupb ,ACSWUPBC=acswupbc & -! & ,ACSWDNB=acswdnb ,ACSWDNBC=acswdnbc & -! & ,ACLWUPT=aclwupt ,ACLWUPTC=aclwuptc & -! & ,ACLWDNT=aclwdnt ,ACLWDNTC=aclwdntc & -! & ,ACLWUPB=aclwupb ,ACLWUPBC=aclwupbc & -! & ,ACLWDNB=aclwdnb ,ACLWDNBC=aclwdnbc & -! & ,SWUPT=swupt ,SWUPTC=swuptc & -! & ,SWDNT=swdnt ,SWDNTC=swdntc & -! & ,SWUPB=swupb ,SWUPBC=swupbc & -! & ,SWDNB=swdnb ,SWDNBC=swdnbc & -! & ,LWUPT=lwupt ,LWUPTC=lwuptc & -! & ,LWDNT=lwdnt ,LWDNTC=lwdntc & -! & ,LWUPB=lwupb ,LWUPBC=lwupbc & -! & ,LWDNB=lwdnb ,LWDNBC=lwdnbc & -!#endif -! & ,LWCF=grid%lwcf & -! & ,SWCF=grid%swcf & -! & ,OLR=grid%olr & -! & ,OZMIXM=grid%ozmixm, PIN=grid%pin & -! & ,M_PS_1=grid%m_ps_1, M_PS_2=grid%m_ps_2, AEROSOLC_1=grid%aerosolc_1 & -! & ,AEROSOLC_2=grid%aerosolc_2, M_HYBI0=grid%m_hybi & -! & ,ABSTOT=grid%abstot, ABSNXT=grid%absnxt, EMSTOT=grid%emstot & -!#ifdef WRF_CHEM -! & ,CU_RAD_FEEDBACK=config_flags%cu_rad_feedback & -! & ,AER_RA_FEEDBACK=config_flags%aer_ra_feedback & -! & ,QC_ADJUST=grid%GD_CLOUD_B , QI_ADJUST=grid%GD_CLOUD2_B & -! & ,PM2_5_DRY=grid%pm2_5_dry, PM2_5_WATER=grid%pm2_5_water & -! & ,PM2_5_DRY_EC=grid%pm2_5_dry_ec & -! & ,TAUAER300=grid%tauaer1, TAUAER400=grid%tauaer2 & ! jcb -! & ,TAUAER600=grid%tauaer3, TAUAER999=grid%tauaer4 & ! jcb -! & ,GAER300=grid%gaer1, GAER400=grid%gaer2, GAER600=grid%gaer3, GAER999=grid%gaer4 & ! jcb -! & ,WAER300=grid%waer1, WAER400=grid%waer2, WAER600=grid%waer3, WAER999=grid%waer4 & ! jcb -!#endif -! & ,slope_rad=config_flags%slope_rad,topo_shading=config_flags%topo_shading & -! & ,shadowmask=shadowmask,ht=grid%ht,dx=grid%dx,dy=grid%dy,sina=grid%sina,cosa=grid%cosa ) -! -!BENCH_END(rad_driver_tim) -! -!!********* Surface driver -!! surface -! -!BENCH_START(surf_driver_tim) -! -!!----------------------------------------------------------------- -!! urban related variable are added to arguments of surface_driver -!!----------------------------------------------------------------- -! num_roof_layers = grid%num_soil_layers !urban -! num_wall_layers = grid%num_soil_layers !urban -! num_road_layers = grid%num_soil_layers !urban -! CALL nl_get_iswater(grid%id, iswater) -! -! CALL wrf_debug ( 200 , ' call surface_driver' ) -! -! CALL surface_driver( & -! & ACSNOM=grid%acsnom ,ACSNOW=grid%acsnow ,AKHS=grid%akhs & -! & ,AKMS=grid%akms ,ALBBCK=grid%albbck ,ALBEDO=grid%albedo & -! & ,EMBCK=grid%embck & -! & ,BR=br ,CANWAT=grid%canwat ,CHKLOWQ=chklowq & -! & ,CT=grid%ct ,DT=grid%dt ,DX=grid%dx & -! & ,DZ8W=dz8w ,DZS=grid%dzs ,FLHC=grid%flhc & -! & ,FLQC=grid%flqc ,GLW=grid%glw ,GRDFLX=grid%grdflx & -! & ,GSW=grid%gsw ,SWDOWN=grid%swdown ,GZ1OZ0=gz1oz0 ,HFX=grid%hfx & -! & ,HT=grid%ht ,IFSNOW=config_flags%ifsnow ,ISFFLX=config_flags%isfflx & -! & ,ISLTYP=grid%isltyp ,ITIMESTEP=grid%itimestep & -! & ,IVGTYP=grid%ivgtyp ,LH=grid%lh ,LOWLYR=grid%lowlyr & -! & ,MAVAIL=grid%mavail ,NUM_SOIL_LAYERS=config_flags%num_soil_layers & -! & ,P8W=p8w ,PBLH=grid%pblh ,PI_PHY=pi_phy & -! & ,PSFC=grid%psfc ,PSHLTR=grid%pshltr ,PSIH=psih & -! & ,BLDT=grid%bldt ,CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag & -! & ,PSIM=psim ,P_PHY=p_phy ,Q10=grid%q10 & -! & ,Q2=grid%q2 ,QFX=grid%qfx ,QSFC=grid%qsfc & -! & ,QSHLTR=grid%qshltr ,QZ0=grid%qz0 ,RAINCV=grid%raincv & -! & ,RA_LW_PHYSICS=config_flags%ra_lw_physics ,RHO=rho & -! & ,RMOL=grid%rmol ,SFCEVP=grid%sfcevp ,SFCEXC=grid%sfcexc & -! & ,SFCRUNOFF=grid%sfcrunoff & -! & ,SF_SFCLAY_PHYSICS=config_flags%sf_sfclay_physics & -! & ,SF_SURFACE_PHYSICS=config_flags%sf_surface_physics ,SH2O=grid%sh2o & -! & ,SHDMAX=grid%shdmax ,SHDMIN=grid%shdmin ,SMOIS=grid%smois & -! & ,SMSTAV=grid%smstav ,SMSTOT=grid%smstot ,SNOALB=grid%snoalb & -! & ,SNOW=grid%snow ,SNOWC=grid%snowc ,SNOWH=grid%snowh & -! & ,SST=grid%sst ,SST_UPDATE=grid%sst_update & -! & ,STEPBL=grid%stepbl ,TH10=grid%th10 ,TH2=grid%th2 & -! & ,THZ0=grid%thz0 ,TH_PHY=th_phy ,TKE_MYJ=grid%tke_myj & -! & ,TMN=grid%tmn ,TSHLTR=grid%tshltr ,TSK=grid%tsk & -! & ,TSLB=grid%tslb ,T_PHY=t_phy ,U10=grid%u10 & -! & ,URATX=grid%uratx ,VRATX=grid%vratx ,TRATX=grid%tratx & -! & ,UDRUNOFF=grid%udrunoff ,UST=grid%ust ,UZ0=grid%uz0 & -! & ,U_FRAME=grid%u_frame ,U_PHY=u_phy ,V10=grid%v10 & -! & ,VEGFRA=grid%vegfra ,VZ0=grid%vz0 ,V_FRAME=grid%v_frame & -! & ,V_PHY=v_phy ,WARM_RAIN=grid%warm_rain & -! & ,WSPD=wspd ,XICE=grid%xice ,XLAND=grid%xland & -! & ,Z0=grid%z0 ,Z=grid%z ,ZNT=grid%znt & -! & ,ZS=grid%zs ,XICEM=grid%xicem ,ISICE=grid%landuse_isice& -! & ,USTM=grid%ustm ,CK=grid%ck ,CKA=grid%cka & -! & ,CD=grid%cd ,CDA=grid%cda & -! & ,ISFTCFLX=config_flags%isftcflx & -! & ,OMLCALL=config_flags%omlcall ,OML_HML0=config_flags%oml_hml0 ,OML_GAMMA=config_flags%oml_gamma & -! & ,TML=grid%tml, T0ML=grid%t0ml, HML=grid%hml, H0ML=grid%h0ml, HUML=grid%huml, HVML=grid%hvml, F=grid%f & -! & ,ISWATER=iswater & -! & ,DECLIN_URB=grid%declin_urb ,COSZ_URB2D=grid%cosz_urb2d & !I urban -! & ,OMG_URB2D=grid%omg_urb2d ,xlat_urb2d=grid%XLAT & !I urban -! & ,NUM_ROOF_LAYERS=num_roof_layers & !I urban -! & ,NUM_WALL_LAYERS=num_wall_layers & !I urban -! & ,NUM_ROAD_LAYERS=num_road_layers & -! & ,DZR=grid%dzr ,DZB=grid%dzb ,DZG=grid%dzg & !I urban -! & ,TR_URB2D=grid%tr_urb2d ,TB_URB2D=grid%tb_urb2d & -! & ,TG_URB2D=grid%tg_urb2d & !H urban -! & ,TC_URB2D=grid%tc_urb2d ,QC_URB2D=grid%qc_urb2d & !H urban -! & ,UC_URB2D=grid%uc_urb2d & !H urban -! & ,XXXR_URB2D=grid%xxxr_urb2d & -! & ,XXXB_URB2D=grid%xxxb_urb2d & !H urban -! & ,XXXG_URB2D=grid%xxxg_urb2d & -! & ,XXXC_URB2D=grid%xxxc_urb2d & !H urban -! & ,TRL_URB3D=grid%trl_urb3d ,TBL_URB3D=grid%tbl_urb3d & !H urban -! & ,TGL_URB3D=grid%tgl_urb3d & !H urban -! & ,SH_URB2D=grid%sh_urb2d ,LH_URB2D=grid%lh_urb2d & -! & ,G_URB2D=grid%g_urb2d & !H urban -! & ,RN_URB2D=grid%rn_urb2d , TS_URB2D=grid%ts_urb2d & !H urban -! & ,FRC_URB2D=grid%frc_urb2d & !H urban -! & ,UTYPE_URB2D=grid%utype_urb2d & !H urban -! & ,ucmcall=grid%ucmcall & !H urban -! ! P-X LSM Variables -! & ,LANDUSEF=grid%landusef, SOILCTOP=grid%soilctop & ! P-X LSM -! & ,SOILCBOT=grid%soilcbot & ! P-X LSM -! & ,RA=grid%ra, RS=grid%rs, LAI=grid%lai & ! P-X LSM -! & ,NLCAT=grid%num_land_cat, NSCAT=grid%num_soil_cat & ! P-X LSM -! & ,VEGF_PX=grid%vegf_px, SNOWNCV=grid%snowncv & ! P-X LSM -! & ,ANAL_INTERVAL=config_flags%interval_seconds & ! P-X LSM -! & ,PXLSM_SMOIS_INIT=config_flags%pxlsm_smois_init & ! P-X LSM -! & ,PXLSM_SOIL_NUDGE=config_flags%grid_fdda & ! P-X LSM -! ! Optional PX LSM nudging -! & ,t2_ndg_old=fdda2d(ims,1,jms,P_t2_ndg_old) & -! & ,q2_ndg_old=fdda2d(ims,1,jms,P_q2_ndg_old) & -! & ,t2_ndg_new=fdda2d(ims,1,jms,P_t2_ndg_new) & -! & ,q2_ndg_new=fdda2d(ims,1,jms,P_q2_ndg_new) & -! & ,sn_ndg_old=fdda2d(ims,1,jms,P_sn_ndg_old) & -! & ,sn_ndg_new=fdda2d(ims,1,jms,P_sn_ndg_new) & -! ! Indexes -! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & -! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & -! & , I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & -! & , J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & -! & , KTS=k_start, KTE=min(k_end,kde-1) & -! & , NUM_TILES=grid%num_tiles & -! ! Optional -! & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & -! & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & -! & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & -! & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & -! & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & -! & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & -! & ,CAPG=grid%capg, EMISS=grid%emiss, HOL=hol,MOL=grid%mol & -! & ,T2OBS=grid%t2obs, Q2OBS=grid%q2obs & -! & ,RAINBL=grid%rainbl,SR=grid%sr & -! & ,RAINNCV=grid%rainncv,REGIME=grid%regime,T2=grid%t2,THC=grid%thc & -! & ,QSG=grid%qsg,QVG=grid%qvg,QCG=grid%qcg,SOILT1=grid%soilt1,TSNAV=grid%tsnav & ! ruc lsm -! & ,SMFR3D=grid%smfr3d,KEEPFR3DFLAG=grid%keepfr3dflag & ! ruc lsm -! & ,POTEVP=grid%POTEVP, SNOPCX=grid%SNOPCX, SOILTB=grid%SOILTB & ! ruc lsm -! & ) -!BENCH_END(surf_driver_tim) -! -!!********* -!! pbl -! -! CALL wrf_debug ( 200 , ' call pbl_driver' ) -!BENCH_START(pbl_driver_tim) -! CALL pbl_driver( & -! & AKHS=grid%akhs ,AKMS=grid%akms & -! & ,BL_PBL_PHYSICS=config_flags%bl_pbl_physics & -! & ,BLDT=grid%bldt, CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag & -! & ,BR=br ,CHKLOWQ=chklowq ,CT=grid%ct & -! & ,DT=grid%dt ,DX=grid%dx ,DZ8W=dz8w & -! & ,EL_MYJ=grid%el_myj ,EXCH_H=grid%exch_h ,GRDFLX=grid%grdflx & -! & ,GZ1OZ0=gz1oz0 ,HFX=grid%hfx ,HT=grid%ht & -! & ,ITIMESTEP=grid%itimestep ,KPBL=grid%kpbl & -! & ,LH=grid%lh ,LOWLYR=grid%lowlyr ,P8W=p8w & -! & ,PBLH=grid%pblh ,PI_PHY=pi_phy ,PSIH=psih & -! & ,PSIM=psim ,P_PHY=p_phy ,QFX=grid%qfx & -! & ,QSFC=grid%qsfc ,QZ0=grid%qz0 & -! & ,RA_LW_PHYSICS=config_flags%ra_lw_physics & -! & ,RHO=rho ,RQCBLTEN=grid%rqcblten ,RQIBLTEN=grid%rqiblten & -! & ,RQVBLTEN=grid%rqvblten ,RTHBLTEN=grid%rthblten ,RUBLTEN=grid%rublten & -! & ,RVBLTEN=grid%rvblten ,SNOW=grid%snow ,STEPBL=grid%stepbl & -! & ,THZ0=grid%thz0 ,TH_PHY=th_phy ,TKE_MYJ=grid%tke_myj & -! & ,TSK=grid%tsk ,T_PHY=t_phy ,UST=grid%ust & -! & ,U10=grid%u10 ,UZ0=grid%uz0 ,U_FRAME=grid%u_frame ,U_PHY=u_phy & -! & ,V10=grid%v10 ,VZ0=grid%vz0 ,V_FRAME=grid%v_frame ,V_PHY=v_phy & -! & ,WARM_RAIN=grid%warm_rain ,WSPD=wspd & -! & ,XICE=grid%xice ,XLAND=grid%xland ,Z=grid%z & -! & ,ZNT=grid%znt & -! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & -! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & -! & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & -! & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & -! & ,KTS=k_start, KTE=min(k_end,kde-1) & -! & ,NUM_TILES=grid%num_tiles & -! ! Variables Required by ACM PBL - jp -! & ,ZNU=grid%znu,ZNW=grid%znw,MUT=grid%mut,P_TOP=grid%p_top & -! ! optional -! & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & -! & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & -! & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & -! & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & -! & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & -! & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & -! & ,HOL=HOL, MOL=grid%mol, REGIME=grid%REGIME & -! & ) -! -!BENCH_END(pbl_driver_tim) -! -!! cumulus para. -! -! CALL wrf_debug ( 200 , ' call cumulus_driver' ) -! -! -!BENCH_START(cu_driver_tim) -! CALL cumulus_driver(grid & -! ! Prognostic variables -! & ,U=u_phy ,V=v_phy ,TH=th_phy ,T=t_phy & -! & ,W=grid%w_2 ,P=p_phy ,PI=pi_phy ,RHO=rho & -! ! Other arguments -! & ,ITIMESTEP=grid%itimestep ,DT=grid%dt ,DX=grid%dx & -! & ,CUDT=grid%cudt,CURR_SECS=curr_secs,ADAPT_STEP_FLAG=adapt_step_flag & -! & ,RAINC=grid%rainc ,RAINCV=grid%raincv ,PRATEC=grid%pratec & -! & , NCA=grid%nca & -! & ,HTOP=grid%cutop ,HBOT=grid%cubot ,KPBL=grid%kpbl & -! & ,DZ8W=dz8w ,P8W=p8w & -! & ,W0AVG=grid%w0avg ,STEPCU=grid%stepcu & -! & ,CLDEFI=grid%cldefi ,LOWLYR=grid%lowlyr ,XLAND=grid%xland & -! & ,APR_GR=grid%apr_gr ,APR_W=grid%apr_w ,APR_MC=grid%apr_mc & -! & ,APR_ST=grid%apr_st ,APR_AS=grid%apr_as ,APR_CAPMA=grid%apr_capma & -! & ,APR_CAPME=grid%apr_capme ,APR_CAPMI=grid%apr_capmi & -! & ,MASS_FLUX=grid%mass_flux ,XF_ENS=grid%xf_ens & -! & ,PR_ENS=grid%pr_ens ,HT=grid%ht,EDT_OUT=grid%edt_out & -! & ,imomentum=grid%imomentum,clos_choice=grid%clos_choice & -! & ,cugd_tten=grid%cugd_tten,cugd_qvten=grid%cugd_qvten,cugd_qcten=grid%cugd_qcten & -! & ,cugd_ttens=grid%cugd_ttens,cugd_qvtens=grid%cugd_qvtens & -! & ,ENSDIM=config_flags%ensdim ,MAXIENS=config_flags%maxiens ,MAXENS=config_flags%maxens & -! & ,MAXENS2=config_flags%maxens2 ,MAXENS3=config_flags%maxens3 & -! & ,CU_ACT_FLAG=cu_act_flag ,WARM_RAIN=grid%warm_rain & -! & ,GSW=grid%gsw,cugd_avedx=config_flags%cugd_avedx & -! & ,PERIODIC_X=(config_flags%polar .OR. config_flags%periodic_x) & -! & ,PERIODIC_Y=config_flags%periodic_y & -! ! Selection flag -! & ,CU_PHYSICS=config_flags%cu_physics & -! ! Dimension arguments -! & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & -! & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & -! & ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe & -! & ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & -! & ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & -! & ,KTS=k_start, KTE=min(k_end,kde-1) & -! & ,NUM_TILES=grid%num_tiles & -! ! Moisture tendency arguments -! & ,RQVCUTEN=grid%rqvcuten , RQCCUTEN=grid%rqccuten & -! & ,RQSCUTEN=grid%rqscuten , RQICUTEN=grid%rqicuten & -! & ,RQRCUTEN=grid%rqrcuten , RQVBLTEN=grid%rqvblten & -! & ,RQVFTEN=grid%rqvften & -! ! Other tendency arguments -! & ,RTHRATEN=grid%rthraten , RTHBLTEN=grid%rthblten & -! & ,RTHCUTEN=grid%rthcuten , RTHFTEN=grid%rthften & -! ! Moisture tracer arguments -! & ,QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV & -! & ,QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC & -! & ,QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR & -! & ,QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI & -! & ,QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS & -! & ,QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG & -!#ifdef WRF_CHEM -! & ,GD_CLOUD=grid%GD_CLOUD,GD_CLOUD2=grid%GD_CLOUD2 & -!#endif -! & ) -!BENCH_END(cu_driver_tim) -! -! CALL wrf_debug ( 200 , ' call fddagd_driver' ) -! -!BENCH_START(fdda_driver_tim) -! CALL fddagd_driver(itimestep=grid%itimestep,dt=grid%dt,xtime=grid%XTIME, & -! id=grid%id, & -! RUNDGDTEN=grid%rundgdten,RVNDGDTEN=grid%rvndgdten, & -! RTHNDGDTEN=grid%rthndgdten,RQVNDGDTEN=grid%rqvndgdten, & -! RMUNDGDTEN=grid%rmundgdten, & -! u_ndg_old=fdda3d(ims,kms,jms,P_u_ndg_old), & -! v_ndg_old=fdda3d(ims,kms,jms,P_v_ndg_old), & -! t_ndg_old=fdda3d(ims,kms,jms,P_t_ndg_old), & -! q_ndg_old=fdda3d(ims,kms,jms,P_q_ndg_old), & -! mu_ndg_old=fdda2d(ims,1,jms,P_mu_ndg_old), & -! u_ndg_new=fdda3d(ims,kms,jms,P_u_ndg_new), & -! v_ndg_new=fdda3d(ims,kms,jms,P_v_ndg_new), & -! t_ndg_new=fdda3d(ims,kms,jms,P_t_ndg_new), & -! q_ndg_new=fdda3d(ims,kms,jms,P_q_ndg_new), & -! mu_ndg_new=fdda2d(ims,1,jms,P_mu_ndg_new), & -! u3d=grid%u_2,v3d=grid%v_2,th_phy=th_phy,rho=rho,moist=moist, & -! p_phy=p_phy,pi_phy=pi_phy,p8w=p8w,t_phy=t_phy, & -! dz8w=dz8w,z=grid%z,z_at_w=z_at_w, & -! config_flags=config_flags,dx=grid%DX,n_moist=num_moist, & -! STEPFG=grid%STEPFG, & -! pblh=grid%pblh,ht=grid%ht, & -! IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & -! ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & -! ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1) & -! ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1) & -! ,KTS=k_start, KTE=min(k_end,kde-1) & -! , num_tiles=grid%num_tiles ) -!BENCH_END(fdda_driver_tim) - -!!****MARS -IF (config_flags%modif_wrf) THEN -!!!!!!!!!!!!!!!!!!!!!!! -! call to LMD physics ! -!!!!!!!!!!!!!!!!!!!!!!! - CALL wrf_debug ( 200 , ' call lmd_driver' ) - CALL lmd_driver( & - ! structure - & id=grid%id,max_dom=grid%max_dom & - & ,DT=grid%dt & - & ,ITIMESTEP=grid%itimestep & - ! position - & ,XLAT=grid%xlat,XLONG=grid%xlong & - & ,DX=grid%dx ,DY=grid%dy & - & ,MSFT=grid%msftx,MSFU=grid%msfux,MSFV=grid%msfvx & -! & ,MSFT=grid%msft,MSFU=grid%msfu,MSFV=grid%msfv & - ! indexes - & ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & - & ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme & - & ,i_start=grid%i_start,i_end=min(grid%i_end, ide-1) & - & ,j_start=grid%j_start,j_end=min(grid%j_end, jde-1) & - & ,kts=k_start, kte=min(k_end,kde-1) & - & ,num_tiles=grid%num_tiles & - ! time variables - & ,GMT=grid%gmt ,JULYR=grid%julyr ,JULDAY=grid%julday & - ! output from phy_prep - & ,P8W=p8w ,DZ8W=dz8w ,T8W=t8w & - ! Prognostic variables at p points -! & ,Z=grid%em_z & - & ,Z=grid%z & - ! z is the geopotential height at p points - ! ... (cf phy_prep in module_big_step_utilities_em) - & ,HT=grid%ht & - & ,U=u_phy ,V=v_phy ,W=w_phy & - & ,TH=th_phy ,T=t_phy & - & ,P=p_phy ,EXNER=pi_phy ,RHO=rho & -!!!!!ADDITION CAS IDEALISES - & ,PTOP=grid%p_top & - ! physics calls - & ,RADT=grid%radt & - & ,CUDT=grid%cudt & - ! surface temperature and surface pressure - & ,TSK=grid%tsk,PSFC=grid%psfc & - ! tendencies for the dynamics - & ,RTHBLTEN=grid%rthblten ,RUBLTEN=grid%rublten,RVBLTEN=grid%rvblten & - ! scalars -! & ,NUM_3D_S=num_3d_s,SCALAR=grid%scalar & - & ,NUM_3D_S=num_scalar,SCALAR=grid%scalar & - & ,NUM_3D_M=num_moist,MOIST=grid%moist & - ! mode - & ,MARS_MODE=config_flags%mars & -#ifdef NEWPHYS - ! planet - & ,planet_type=config_flags%planet & -#endif - ! added variables - & ,M_ALBEDO=grid%m_albedo,M_TI=grid%m_ti & - & ,M_CO2ICE=grid%m_co2ice,M_EMISS=grid%m_emiss & - & ,M_H2OICE=grid%m_h2oice & - & ,M_TSOIL=grid%m_tsoil & - & ,M_Q2=grid%m_q2 & - & ,M_TSURF=grid%m_tsurf & -#ifdef NEWPHYS - & ,M_FLUXRAD=grid%m_fluxrad & - & ,M_WSTAR=grid%m_wstar & - & ,M_ISOIL=grid%m_isoil & - & ,M_DSOIL=grid%m_dsoil & - & ,M_Z0=grid%m_z0 & - & ,CST_Z0=config_flags%init_Z0 & -#endif - & ,M_GW=grid%m_gw & - & ,NUM_SOIL_LAYERS=config_flags%num_soil_layers & - ! cst fields - & ,CST_AL=config_flags%init_AL & - & ,CST_TI=config_flags%init_TI & - & ,ISFFLX=config_flags%isfflx & - & ,DIFF_OPT=config_flags%diff_opt & - & ,KM_OPT=config_flags%km_opt & - & ,HISTORY_INTERVAL=model_config_rec%history_interval(1) & - !------------------! - ! OUTPUT VARIABLES ! - !------------------! -#ifdef NEWPHYS - & ,HR_SW=grid%HR_SW & - & ,HR_LW=grid%HR_LW & - & ,HR_DYN=grid%HR_DYN & - & ,DDT=grid%DDT & - & ,DT_RAD=grid%DT_RAD & - & ,DT_VDF=grid%DT_VDF & - & ,DT_AJS=grid%DT_AJS & - & ,CLOUDFRAC=grid%CLOUDFRAC & - & ,TOTCLOUDFRAC=grid%TOTCLOUDFRAC & - & ,GRAIN=grid%GRAIN & - & ,GSNOW=grid%GSNOW & - & ,REEVAP=grid%REEVAP & - & ,SURFRAIN=grid%SURFRAIN & - & ,ALBEQ=grid%ALBEQ & - & ,FLUXTOP_DN=grid%FLUXTOP_DN & - & ,FLUXABS_SW=grid%FLUXABS_SW & - & ,FLUXTOP_LW=grid%FLUXTOP_LW & - & ,FLUXSURF_SW=grid%FLUXSURF_SW & - & ,FLUXSURF_LW=grid%FLUXSURF_LW & - & ,FLXGRD=grid%FLXGRD & - & ,LSCEZ=grid%LSCEZ & - & ,H2OICE_REFF=grid%H2OICE_REFF & - & ,LATENT_HF=grid%LATENT_HF & - & ,SWDOWNZ=grid%SWDOWNZ & - & ,TAU_DUST=grid%TAU_DUST & - & ,RDUST=grid%RDUST & - & ,QSURFDUST=grid%QSURFDUST & - & ,MTOT=grid%MTOT & - & ,ICETOT=grid%ICETOT & - & ,VMR_ICE=grid%VMR_ICE & - & ,TAU_ICE=grid%TAU_ICE & - & ,RICE=grid%RICE & - & ,ZMAX=grid%ZMAX & - & ,HFMAX=grid%HFMAX & - & ,USTM=grid%USTM & - & ,HFX=grid%HFX & -#else -#include "module_lmd_driver_output4.inc" -#endif - & ,SLPX=grid%slpx,SLPY=grid%slpy,RESTART=config_flags%restart) -ENDIF - -!!!!!!!!!!!!!!!!!!!!!!! -! call to LMD physics ! -!!!!!!!!!!!!!!!!!!!!!!! -!****MARS - - END SUBROUTINE first_rk_step_part1 - -END MODULE module_first_rk_step_part1 - Index: unk/WRF.COMMON/WRFV3/modif_mars/module_first_rk_step_part2.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/modif_mars/module_first_rk_step_part2.F (revision 2760) +++ (revision ) @@ -1,618 +1,0 @@ -!WRF:MEDIATION_LAYER:SOLVER - -#define BENCH_START(A) -#define BENCH_END(A) - -MODULE module_first_rk_step_part2 - -CONTAINS - - SUBROUTINE first_rk_step_part2 ( grid , config_flags & - , moist , moist_tend & - , chem , chem_tend & - , scalar , scalar_tend & - , fdda3d, fdda2d & - , ru_tendf, rv_tendf & - , rw_tendf, t_tendf & - , ph_tendf, mu_tendf & - , tke_tend & - , adapt_step_flag , curr_secs & - , psim , psih , wspd , gz1oz0 , br , chklowq & - , cu_act_flag , hol , th_phy & - , pi_phy , p_phy , t_phy , u_phy , v_phy & - , dz8w , p8w , t8w , rho_phy , rho & - , z_at_w , mu_3d & - , ids, ide, jds, jde, kds, kde & - , ims, ime, jms, jme, kms, kme & - , ips, ipe, jps, jpe, kps, kpe & - , k_start , k_end & - ) - USE module_state_description - USE module_model_constants - USE module_domain, ONLY : domain - USE module_configure, ONLY : grid_config_rec_type, model_config_rec - USE module_dm - USE module_diffusion_em, ONLY : phy_bc, cal_deform_and_div, compute_diff_metrics, & - vertical_diffusion_2, horizontal_diffusion_2, calculate_km_kh, & - tke_rhs - USE module_em, ONLY : calculate_phy_tend -!!!!****MARS MARS -! USE module_fddaobs_driver, ONLY : fddaobs_driver - USE module_bc, ONLY : set_physical_bc3d, set_physical_bc2d - USE module_physics_addtendc, ONLY : update_phy_ten - - IMPLICIT NONE - - TYPE ( domain ), INTENT(INOUT) :: grid - TYPE ( grid_config_rec_type ), INTENT(IN) :: config_flags - - INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe - - LOGICAL ,INTENT(IN) :: adapt_step_flag - REAL, INTENT(IN) :: curr_secs - - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: moist_tend - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: chem - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: chem_tend - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: scalar - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_moist),INTENT(INOUT) :: scalar_tend - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme,num_fdda3d),INTENT(INOUT) :: fdda3d - REAL ,DIMENSION(ims:ime,1:1,jms:jme,num_fdda2d),INTENT(INOUT) :: fdda2d - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: psim - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: psih - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: wspd - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: gz1oz0 - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: br - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: chklowq - LOGICAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: cu_act_flag - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: hol - - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: th_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: pi_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: u_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: v_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: dz8w - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: p8w - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t8w - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho_phy - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rho - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: z_at_w - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: mu_3d - - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ru_tendf - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rv_tendf - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: rw_tendf - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: ph_tendf - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: t_tendf - REAL ,DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(INOUT) :: tke_tend - - REAL ,DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: mu_tendf - - INTEGER , INTENT(IN) :: k_start, k_end - -! Local - - REAL, DIMENSION( ims:ime, jms:jme ) :: ht_loc - INTEGER, DIMENSION( ims:ime, jms:jme ) :: shadowmask - INTEGER :: ij - INTEGER num_roof_layers - INTEGER num_wall_layers - INTEGER num_road_layers - INTEGER iswater - INTEGER rk_step - - ! initialize all tendencies to zero in order to update physics - ! tendencies first (separate from dry dynamics). - - rk_step = 1 - -! calculate_phy_tend - -BENCH_START(cal_phy_tend) - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - - DO ij = 1 , grid%num_tiles - - CALL wrf_debug ( 200 , ' call calculate_phy_tend' ) - CALL calculate_phy_tend (config_flags,grid%mut,grid%muu,grid%muv,pi_phy, & - grid%rthraten, & - grid%rublten,grid%rvblten,grid%rthblten, & - grid%rqvblten,grid%rqcblten,grid%rqiblten, & - grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten, & - grid%rqicuten,grid%rqscuten, & - grid%RUNDGDTEN,grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RQVNDGDTEN, & - grid%RMUNDGDTEN, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - grid%i_start(ij), min(grid%i_end(ij),ide-1), & - grid%j_start(ij), min(grid%j_end(ij),jde-1), & - k_start , min(k_end,kde-1) ) - - ENDDO - !$OMP END PARALLEL DO -BENCH_END(cal_phy_tend) - -! tke diffusion - - IF(config_flags%diff_opt .eq. 2 .OR. config_flags%diff_opt .eq. 1) THEN - -BENCH_START(comp_diff_metrics_tim) - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - DO ij = 1 , grid%num_tiles - CALL wrf_debug ( 200 , ' call compute_diff_metrics ' ) - CALL compute_diff_metrics ( config_flags, grid%ph_2, grid%phb, grid%z, grid%rdz, grid%rdzw, & - grid%zx, grid%zy, grid%rdx, grid%rdy, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start , k_end ) - ENDDO - !$OMP END PARALLEL DO -BENCH_END(comp_diff_metrics_tim) - -#ifdef DM_PARALLEL -# include "HALO_EM_TKE_C.inc" -# include "PERIOD_BDY_EM_A1.inc" -#endif - -BENCH_START(tke_diff_bc_tim) - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - - DO ij = 1 , grid%num_tiles - - CALL wrf_debug ( 200 , ' call bc for diffusion_metrics ' ) - CALL set_physical_bc3d( grid%rdzw , 'w', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start , k_end ) - CALL set_physical_bc3d( grid%rdz , 'w', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start , k_end ) - CALL set_physical_bc3d( grid%z , 'w', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start , k_end ) - CALL set_physical_bc3d( grid%zx , 'w', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start , k_end ) - CALL set_physical_bc3d( grid%zy , 'w', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start , k_end ) - CALL set_physical_bc2d( grid%ustm, 't', config_flags, & - ids, ide, jds, jde, & - ims, ime, jms, jme, & - ips, ipe, jps, jpe, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij) ) - - ENDDO - !$OMP END PARALLEL DO -BENCH_END(tke_diff_bc_tim) - -BENCH_START(deform_div_tim) - - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - - DO ij = 1 , grid%num_tiles - - CALL wrf_debug ( 200 , ' call cal_deform_and_div' ) - CALL cal_deform_and_div ( config_flags,grid%u_2,grid%v_2,grid%w_2,grid%div, & - grid%defor11,grid%defor22,grid%defor33, & - grid%defor12,grid%defor13,grid%defor23, & - grid%u_base, grid%v_base,grid%msfux,grid%msfuy, & - grid%msfvx,grid%msfvy,grid%msftx,grid%msfty, & - grid%rdx, grid%rdy, grid%dn, grid%dnw, grid%rdz, & - grid%rdzw,grid%fnm,grid%fnp,grid%cf1,grid%cf2, & - grid%cf3,grid%zx,grid%zy, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start , k_end ) - ENDDO - !$OMP END PARALLEL DO -BENCH_END(deform_div_tim) - -#ifdef DM_PARALLEL -# include "HALO_EM_TKE_D.inc" -#endif - -! calculate tke, kmh, and kmv - -BENCH_START(calc_tke_tim) - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - DO ij = 1 , grid%num_tiles - - CALL wrf_debug ( 200 , ' call calculate_km_kh' ) - CALL calculate_km_kh( config_flags,grid%dt,grid%dampcoef,grid%zdamp, & - config_flags%damp_opt, & - grid%xkmh,grid%xkmv,grid%xkhh,grid%xkhv,grid%bn2, & - grid%khdif,grid%kvdif,grid%div, & - grid%defor11,grid%defor22,grid%defor33,grid%defor12, & - grid%defor13,grid%defor23, & - grid%tke_2,p8w,t8w,th_phy, & - t_phy,p_phy,moist,grid%dn,grid%dnw, & - grid%dx,grid%dy,grid%rdz,grid%rdzw, & - config_flags%mix_isotropic,num_moist, & - grid%cf1, grid%cf2, grid%cf3, grid%warm_rain, & - grid%mix_upper_bound, & - grid%msftx, grid%msfty, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start , k_end ) - ENDDO - !$OMP END PARALLEL DO -BENCH_END(calc_tke_tim) - -#ifdef DM_PARALLEL -# include "HALO_EM_TKE_E.inc" -#endif - - ENDIF - -#ifdef DM_PARALLEL -# include "PERIOD_BDY_EM_PHY_BC.inc" - IF ( config_flags%grid_fdda .eq. 1) THEN -# include "PERIOD_BDY_EM_FDDA_BC.inc" - ENDIF -# include "PERIOD_BDY_EM_CHEM.inc" -#endif - -BENCH_START(phy_bc_tim) - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - - DO ij = 1 , grid%num_tiles - - CALL wrf_debug ( 200 , ' call phy_bc' ) - CALL phy_bc (config_flags,grid%div,grid%defor11,grid%defor22,grid%defor33, & - grid%defor12,grid%defor13,grid%defor23, & - grid%xkmh,grid%xkmv,grid%xkhh,grid%xkhv, & - grid%tke_2, & - grid%rublten, grid%rvblten, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start , k_end ) - ENDDO - !$OMP END PARALLEL DO -BENCH_END(phy_bc_tim) - -#ifdef DM_PARALLEL -!----------------------------------------------------------------------- -! -! MPP for some physics tendency, km, kh, deformation, and divergence -! -! * * * * * * * -! * * * * * * * * * * * * -! * * * * * * * * * * * * * * -! * + * * + * + * * + * * * * * + * * * -! * * * * * * * * * * * * * * -! * * * * * * * * * * * * -! * * * * * * * -! -! (for PBL) -! rublten x -! rvblten x -! -! (for FDDA) -! rundgdten x -! rvndgdten x -! -! (for TKE3) -! tke_2 x -! (for TKE5) -! tke_2 x -! -! (for diff_opt >= 1) -! defor11 x -! defor22 x -! defor12 x -! defor13 x -! defor23 x -! div x -! xkmv x -! xkmh x -! xkhv x -! xkhh x -! tke x -! -!----------------------------------------------------------------------- - -!!****MARS: always include this HALO for Mars version ... - IF ( ( config_flags%bl_pbl_physics .ge. 1 ) & - .OR. ( config_flags%modif_wrf ) ) THEN -! IF ( config_flags%bl_pbl_physics .ge. 1 ) THEN -# include "HALO_EM_PHYS_PBL.inc" - ENDIF - IF ( config_flags%grid_fdda .eq. 1) THEN -# include "HALO_EM_FDDA.inc" - ENDIF - IF ( config_flags%diff_opt .ge. 1 ) THEN -# include "HALO_EM_PHYS_DIFFUSION.inc" - ENDIF - - IF ( config_flags%h_mom_adv_order <= 4 ) THEN -# include "HALO_EM_TKE_3.inc" - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN -# include "HALO_EM_TKE_5.inc" - ELSE - WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order - CALL wrf_error_fatal(TRIM(wrf_err_message)) - ENDIF -#endif - -BENCH_START(update_phy_ten_tim) - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - - DO ij = 1 , grid%num_tiles - - CALL wrf_debug ( 200 , ' call update_phy_ten' ) - CALL update_phy_ten(t_tendf, ru_tendf, rv_tendf,moist_tend, & - scalar_tend, mu_tendf, & - grid%rthraten,grid%rthblten,grid%rthcuten, & - grid%rublten,grid%rvblten, & - grid%rqvblten,grid%rqcblten,grid%rqiblten, & - grid%rqvcuten,grid%rqccuten,grid%rqrcuten, & - grid%rqicuten,grid%rqscuten,grid%RUNDGDTEN, & - grid%RVNDGDTEN,grid%RTHNDGDTEN,grid%RQVNDGDTEN, & - grid%RMUNDGDTEN, & - num_moist,num_scalar,config_flags,rk_step, & - grid%adv_moist_cond, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start, k_end ) - - END DO - !$OMP END PARALLEL DO -BENCH_END(update_phy_ten_tim) - -#ifdef PLANET - ! do rayleigh (and zonal-average newtonian) damping during - ! first iteration of RK loop only - - IF ( (config_flags%damp_opt == 101) .OR. & - (config_flags%damp_opt == 103) ) THEN - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - DO ij = 1 , grid%num_tiles - CALL damptop( grid%u_2, grid%v_2, grid%t_2, & - grid%mut, grid%muu, grid%muv, & - pi_phy, & - t_tendf, ru_tendf, rv_tendf, P2SI, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start, k_end ) - END DO - !$OMP END PARALLEL DO - END IF -#endif - - IF( config_flags%diff_opt .eq. 2 .and. config_flags%km_opt .eq. 2 ) THEN - -BENCH_START(tke_rhs_tim) - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - DO ij = 1 , grid%num_tiles - - CALL tke_rhs ( tke_tend,grid%bn2, & - config_flags,grid%defor11,grid%defor22, & - grid%defor33, & - grid%defor12,grid%defor13,grid%defor23, & - grid%u_2,grid%v_2,grid%w_2,grid%div, & - grid%tke_2,grid%mut, & - th_phy,p_phy,p8w,t8w,grid%z,grid%fnm, & - grid%fnp,grid%cf1,grid%cf2,grid%cf3, & - grid%msftx,grid%msfty,grid%xkmh, & - grid%xkmv,grid%xkhv,grid%rdx,grid%rdy, & - grid%dx,grid%dy,grid%dt,grid%zx,grid%zy, & - grid%rdz,grid%rdzw,grid%dn, & - grid%dnw,config_flags%mix_isotropic, & - grid%hfx, grid%qfx, moist(ims,kms,jms,P_QV), & - grid%ustm, rho, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start , k_end ) - - ENDDO - !$OMP END PARALLEL DO -BENCH_END(tke_rhs_tim) - - ENDIF - -! calculate vertical diffusion first and then horizontal -! (keep this order) - - IF(config_flags%diff_opt .eq. 2) THEN - -!!!!****MARS: vertical diffusion is done by the physics -!!!!****MARS: a part si isfflx=1 (SGS completement fait par WRF) -!!!!****MARS: ou si TKE_heat precisee dans la namelist -! IF ( (config_flags%bl_pbl_physics .eq. 0) & -! .AND. (.not. config_flags%modif_wrf ) ) THEN -!! IF (config_flags%bl_pbl_physics .eq. 0) THEN -!! -!! - IF ( ( config_flags%bl_pbl_physics .eq. 0 ) & - .AND. ( ( config_flags%isfflx .ge. 1 ) & - .OR. ( config_flags%tke_heat_flux .ne. 0.) ) ) THEN -!! -!! -BENCH_START(vert_diff_tim) - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - DO ij = 1 , grid%num_tiles - - CALL wrf_debug ( 200 , ' call vertical_diffusion_2 ' ) - CALL vertical_diffusion_2( ru_tendf, rv_tendf, rw_tendf, & - t_tendf, tke_tend, & - moist_tend, num_moist, & - chem_tend, num_chem, & - scalar_tend, num_scalar, & - grid%u_2, grid%v_2, & - grid%t_2,grid%u_base,grid%v_base,grid%t_base,grid%qv_base, & - grid%mut,grid%tke_2,config_flags, & - grid%defor13,grid%defor23,grid%defor33, & - grid%div, moist, chem, scalar, & - grid%xkmv, grid%xkhv, config_flags%km_opt, & - grid%fnm, grid%fnp, grid%dn, grid%dnw, grid%rdz, grid%rdzw, & - grid%hfx, grid%qfx, grid%ustm, rho, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start, k_end ) - - ENDDO - !$OMP END PARALLEL DO -BENCH_END(vert_diff_tim) - - ENDIF -! -BENCH_START(hor_diff_tim) - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - DO ij = 1 , grid%num_tiles - - CALL wrf_debug ( 200 , ' call horizontal_diffusion_2' ) - CALL horizontal_diffusion_2( t_tendf, ru_tendf, rv_tendf, rw_tendf, & - tke_tend, & - moist_tend, num_moist, & - chem_tend, num_chem, & - scalar_tend, num_scalar, & - grid%t_2, th_phy, & - grid%mut, grid%tke_2, config_flags, & - grid%defor11, grid%defor22, grid%defor12, & - grid%defor13, grid%defor23, grid%div, & - moist, chem, scalar, & - grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx, & - grid%msfty, grid%xkmh, grid%xkhh, config_flags%km_opt, & - grid%rdx, grid%rdy, grid%rdz, grid%rdzw, & - grid%fnm, grid%fnp, grid%cf1, grid%cf2, grid%cf3, & - grid%zx, grid%zy, grid%dn, grid%dnw, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start , k_end ) - ENDDO - !$OMP END PARALLEL DO -BENCH_END(hor_diff_tim) - ENDIF - -!!!!****MARS MARS -!!!!****MARS MARS - -! IF ( grid%obs_nudge_opt .EQ. 1 ) THEN -!# ifdef DM_PARALLEL -!# include "HALO_OBS_NUDGE.inc" -!#endif -!!*********************************************************************** -!! This section for obs nudging -! !$OMP PARALLEL DO & -! !$OMP PRIVATE ( ij ) -! -! DO ij = 1 , grid%num_tiles -! -! CALL fddaobs_driver (grid%grid_id, model_config_rec%grid_id, & -! model_config_rec%parent_id, config_flags%restart, & -! grid%obs_nudge_opt, & -! grid%obs_ipf_errob, & -! grid%obs_ipf_nudob, & -! grid%fdda_start, & -! grid%fdda_end, & -! grid%obs_nudge_wind, & -! grid%obs_nudge_temp, & -! grid%obs_nudge_mois, & -! grid%obs_nudge_pstr, & -! grid%obs_coef_wind, & -! grid%obs_coef_temp, & -! grid%obs_coef_mois, & -! grid%obs_coef_pstr, & -! grid%obs_rinxy, & -! grid%obs_rinsig, & -! grid%obs_npfi, & -! grid%obs_ionf, & -! grid%obs_nobs_prt, & -! grid%obs_idynin, & -! grid%obs_dtramp, & -! model_config_rec%cen_lat(1), & -! model_config_rec%cen_lon(1), & -! config_flags%truelat1, & -! config_flags%truelat2, & -! config_flags%map_proj, & -! model_config_rec%i_parent_start, & -! model_config_rec%j_parent_start, & -! grid%parent_grid_ratio, & -! grid%max_dom, grid%itimestep, & -! grid%dt, grid%gmt, grid%julday, grid%fdob, & -! grid%max_obs, & -! model_config_rec%nobs_ndg_vars, & -! model_config_rec%nobs_err_flds, & -! grid%fdob%nstat, grid%fdob%varobs, grid%fdob%errf, & -! grid%dx, grid%KPBL,grid%HT, & -! grid%mut, grid%muu, grid%muv, & -! grid%msftx, grid%msfty, grid%msfux, grid%msfuy, grid%msfvx, grid%msfvy, & -! p_phy, t_tendf, t0, & -! grid%u_2, grid%v_2, grid%t_2, & -! moist(ims,kms,jms,P_QV), & -! grid%pb, grid%p_top, grid%p, & -! grid%uratx, grid%vratx, grid%tratx, & -! ru_tendf, rv_tendf, & -! moist_tend(ims,kms,jms,P_QV), grid%obs_savwt, & -! ids,ide, jds,jde, kds,kde, & -! ims,ime, jms,jme, kms,kme, & -! grid%i_start(ij), min(grid%i_end(ij),ide-1), & -! grid%j_start(ij), min(grid%j_end(ij),jde-1), & -! k_start , min(k_end,kde-1) ) -! -! ENDDO -! !$OMP END PARALLEL DO -! ENDIF ! obs_nudge_opt .eq. 1 -!! -!!*********************************************************************** - - END SUBROUTINE first_rk_step_part2 - -END MODULE module_first_rk_step_part2 - Index: unk/WRF.COMMON/WRFV3/modif_mars/module_initialize_les.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/modif_mars/module_initialize_les.F (revision 2760) +++ (revision ) @@ -1,1406 +1,0 @@ -!IDEAL:MODEL_LAYER:INITIALIZATION -! - -! This MODULE holds the routines which are used to perform various initializations -! for the individual domains. - -! This MODULE CONTAINS the following routines: - -! initialize_field_test - 1. Set different fields to different constant -! values. This is only a test. If the correct -! domain is not found (based upon the "id") -! then a fatal error is issued. - -!----------------------------------------------------------------------- - -MODULE module_initialize_ideal - - USE module_domain - USE module_io_domain - USE module_state_description - USE module_model_constants - USE module_bc - USE module_timing - USE module_configure - USE module_init_utilities -#ifdef DM_PARALLEL - USE module_dm -#endif - - -CONTAINS - - -!------------------------------------------------------------------- -! this is a wrapper for the solver-specific init_domain routines. -! Also dereferences the grid variables and passes them down as arguments. -! This is crucial, since the lower level routines may do message passing -! and this will get fouled up on machines that insist on passing down -! copies of assumed-shape arrays (by passing down as arguments, the -! data are treated as assumed-size -- ie. f77 -- arrays and the copying -! business is avoided). Fie on the F90 designers. Fie and a pox. - - SUBROUTINE init_domain ( grid ) - - IMPLICIT NONE - - ! Input data. - TYPE (domain), POINTER :: grid - ! Local data. - INTEGER :: idum1, idum2 - - CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 ) - - CALL init_domain_rk( grid & -! -#include -! - ) - - END SUBROUTINE init_domain - -!------------------------------------------------------------------- - - SUBROUTINE init_domain_rk ( grid & -! -# include -! -) - IMPLICIT NONE - - ! Input data. - TYPE (domain), POINTER :: grid - -# include - - TYPE (grid_config_rec_type) :: config_flags - - ! Local data - INTEGER :: & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte, & - i, j, k - - ! Local data - - INTEGER, PARAMETER :: nl_max = 1000 - REAL, DIMENSION(nl_max) :: zk, p_in, theta, rho, u, v, qv, pd_in - REAL*8, DIMENSION(nl_max) :: pd_in8 - INTEGER :: nl_in - - INTEGER :: icm,jcm, ii, im1, jj, jm1, loop, error, fid, nxc, nyc - REAL :: u_mean,v_mean, f0, p_surf, p_level, qvf, z_at_v, z_at_u - REAL*8 :: p_level8 - REAL :: xrad, yrad, zrad, rad, delt, cof1, cof2 -! REAL, EXTERNAL :: interp_0 - REAL :: hm - REAL :: pi - -! stuff from original initialization that has been dropped from the Registry - REAL :: vnu, xnu, xnus, dinit0, cbh, p0_temp, t0_temp, zd, zt - REAL :: qvf1, qvf2, pd_surf - INTEGER :: it - real :: thtmp, ptmp, temp(3) - - LOGICAL :: moisture_init - LOGICAL :: stretch_grid, dry_sounding - - INTEGER :: xs , xe , ys , ye - REAL :: mtn_ht - LOGICAL, EXTERNAL :: wrf_dm_on_monitor -! For LES, add randx - real :: randx - -!!MARS - REAL :: lon_input, lat_input, alt_input, tsurf_input - ! for mode 3 - REAL, DIMENSION(nl_max) :: profdustq,profdustn - REAL, DIMENSION(nl_max) :: prescribed_sw,prescribed_lw,prescribed_dyn - REAL, DIMENSION(nl_max) :: hrsw,hrlw,hrdyn - REAL, DIMENSION(nl_max) :: lsf_dt,lsf_dq,lsfdt,lsfdq - REAL, DIMENSION(nl_max) :: venus_hrdyn - REAL, DIMENSION(nl_max) :: altitude - REAL*8, DIMENSION(nl_max) :: trac -!!MARS - - REAL :: pfu, pfd, phm - INTEGER :: hypsometric_opt = 1 ! classic - !INTEGER :: hypsometric_opt = 2 ! Wee et al. 2012 correction - - LOGICAL :: logp = .true. ! use logp to interpolate (and not p) - -#ifdef DM_PARALLEL -# include -#endif - - - SELECT CASE ( model_data_order ) - CASE ( DATA_ORDER_ZXY ) - kds = grid%sd31 ; kde = grid%ed31 ; - ids = grid%sd32 ; ide = grid%ed32 ; - jds = grid%sd33 ; jde = grid%ed33 ; - - kms = grid%sm31 ; kme = grid%em31 ; - ims = grid%sm32 ; ime = grid%em32 ; - jms = grid%sm33 ; jme = grid%em33 ; - - kts = grid%sp31 ; kte = grid%ep31 ; ! note that tile is entire patch - its = grid%sp32 ; ite = grid%ep32 ; ! note that tile is entire patch - jts = grid%sp33 ; jte = grid%ep33 ; ! note that tile is entire patch - CASE ( DATA_ORDER_XYZ ) - ids = grid%sd31 ; ide = grid%ed31 ; - jds = grid%sd32 ; jde = grid%ed32 ; - kds = grid%sd33 ; kde = grid%ed33 ; - - ims = grid%sm31 ; ime = grid%em31 ; - jms = grid%sm32 ; jme = grid%em32 ; - kms = grid%sm33 ; kme = grid%em33 ; - - its = grid%sp31 ; ite = grid%ep31 ; ! note that tile is entire patch - jts = grid%sp32 ; jte = grid%ep32 ; ! note that tile is entire patch - kts = grid%sp33 ; kte = grid%ep33 ; ! note that tile is entire patch - CASE ( DATA_ORDER_XZY ) - ids = grid%sd31 ; ide = grid%ed31 ; - kds = grid%sd32 ; kde = grid%ed32 ; - jds = grid%sd33 ; jde = grid%ed33 ; - - ims = grid%sm31 ; ime = grid%em31 ; - kms = grid%sm32 ; kme = grid%em32 ; - jms = grid%sm33 ; jme = grid%em33 ; - - its = grid%sp31 ; ite = grid%ep31 ; ! note that tile is entire patch - kts = grid%sp32 ; kte = grid%ep32 ; ! note that tile is entire patch - jts = grid%sp33 ; jte = grid%ep33 ; ! note that tile is entire patch - - END SELECT - - IF (planet == "mars" .or. planet == "titan") THEN - stretch_grid = .false. - !! FOR LES, set stretch to false - ELSE - stretch_grid = .true. !! VENUS - ENDIF - delt = 3. -! z_scale = .50 -! z_scale = .10 -! z_scale = .25 -! z_scale = .15 - pi = 2.*asin(1.0) - write(6,*) ' pi is ',pi - nxc = (ide-ids)/2 - nyc = (jde-jds)/2 - - CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags ) - -! here we check to see if the boundary conditions are set properly - - CALL boundary_condition_check( config_flags, bdyzone, error, grid%id ) - - moisture_init = .true. - - grid%itimestep=0 - -#ifdef DM_PARALLEL - CALL wrf_dm_bcast_bytes( icm , IWORDSIZE ) - CALL wrf_dm_bcast_bytes( jcm , IWORDSIZE ) -#endif - - CALL nl_set_mminlu(1, ' ') - CALL nl_set_iswater(1,0) - CALL nl_set_cen_lat(1,40.) - CALL nl_set_cen_lon(1,-105.) - CALL nl_set_truelat1(1,0.) - CALL nl_set_truelat2(1,0.) - CALL nl_set_moad_cen_lat (1,0.) - CALL nl_set_stand_lon (1,0.) - CALL nl_set_map_proj(1,0) - - -! here we initialize data we currently is not initialized -! in the input data - - DO j = jts, jte - DO i = its, ite - grid%msftx(i,j) = 1. - grid%msfty(i,j) = 1. - grid%msfux(i,j) = 1. - grid%msfuy(i,j) = 1. - grid%msfvx(i,j) = 1. - grid%msfvx_inv(i,j)= 1. - grid%msfvy(i,j) = 1. - grid%sina(i,j) = 0. - grid%cosa(i,j) = 1. - grid%e(i,j) = 0. -! for LES, include Coriolis force - grid%f(i,j) = 0. !!MARS MARS 1.e-4 -!! grid%f(i,j) = 2*EOMEG*SIN(grid%xlat(i,j)*degrad) - END DO - END DO - - DO j = jts, jte - DO k = kts, kte - DO i = its, ite - grid%ww(i,k,j) = 0. - END DO - END DO - END DO - - grid%step_number = 0 - -! set up the grid - - IF (stretch_grid) THEN ! exponential stretch for eta (nearly constant dz) - DO k=1, kde - grid%znw(k) = (exp(-(k-1)/float(kde-1)/z_scale) - exp(-1./z_scale))/ & - (1.-exp(-1./z_scale)) - ENDDO - ELSE - !!MARS - !!MARS - IF (planet .ne. "mars" .and. planet .ne. "titan") THEN - open(unit=12,file='levels',form='formatted',status='old') - rewind(12) - DO k=1, kde - read(12,*) grid%znw(k) - write(6,*) 'read level ', k,grid%znw(k) - ENDDO - close(12) - ENDIF - !!MARS - !!MARS - ! !DO k=1, kde - ! ! grid%znw(k) = 1. - float(k-1)/float(kde-1) - ! !ENDDO - ENDIF - - !! SPECIFIC FOR LES PBL MARS - IF (planet == "mars" .or. planet == "titan") THEN - !!!MARS - grid%znw(1)=1.000 - grid%znw(2)=0.9995 !5m - grid%znw(3)=0.9980 !20m - grid%znw(4)=0.9950 !55m - DO k=5, kde - grid%znw(k) = grid%znw(4) * ( 1. - float(k-4)/float(kde-4) ) - ENDDO - ENDIF - - open(unit=12,file='levels',form='formatted',status='old') - rewind(12) - DO k=1, kde - write(12,*) grid%znw(k) - write(6,*) 'for update_inputs_physiq_mod (e.g. Titan, generic)',k,grid%znw(k) - ENDDO - close(12) - - - - DO k=1, kde-1 - grid%dnw(k) = grid%znw(k+1) - grid%znw(k) - grid%rdnw(k) = 1./grid%dnw(k) - grid%znu(k) = 0.5*(grid%znw(k+1)+grid%znw(k)) - ENDDO - DO k=2, kde-1 - grid%dn(k) = 0.5*(grid%dnw(k)+grid%dnw(k-1)) - grid%rdn(k) = 1./grid%dn(k) - grid%fnp(k) = .5* grid%dnw(k )/grid%dn(k) - grid%fnm(k) = .5* grid%dnw(k-1)/grid%dn(k) - ENDDO - - cof1 = (2.*grid%dn(2)+grid%dn(3))/(grid%dn(2)+grid%dn(3))*grid%dnw(1)/grid%dn(2) - cof2 = grid%dn(2) /(grid%dn(2)+grid%dn(3))*grid%dnw(1)/grid%dn(3) - grid%cf1 = grid%fnp(2) + cof1 - grid%cf2 = grid%fnm(2) - cof1 - cof2 - grid%cf3 = cof2 - - grid%cfn = (.5*grid%dnw(kde-1)+grid%dn(kde-1))/grid%dn(kde-1) - grid%cfn1 = -.5*grid%dnw(kde-1)/grid%dn(kde-1) - grid%rdx = 1./config_flags%dx - grid%rdy = 1./config_flags%dy - -! get the sounding from the ascii sounding file, first get dry sounding and -! calculate base state - - dry_sounding = .true. - IF ( wrf_dm_on_monitor() ) THEN - write(6,*) ' getting dry sounding for base state ' - - CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in ) - ENDIF - CALL wrf_dm_bcast_real( zk , nl_max ) - CALL wrf_dm_bcast_real( p_in , nl_max ) - CALL wrf_dm_bcast_real( pd_in , nl_max ) - CALL wrf_dm_bcast_real( theta , nl_max ) - CALL wrf_dm_bcast_real( rho , nl_max ) - CALL wrf_dm_bcast_real( u , nl_max ) - CALL wrf_dm_bcast_real( v , nl_max ) - CALL wrf_dm_bcast_real( qv , nl_max ) - CALL wrf_dm_bcast_integer ( nl_in , 1 ) - - write(6,*) ' returned from reading sounding, nl_in is ',nl_in - -!!MARS -!!MARS - open(unit=14,file='input_coord',form='formatted',status='old') - rewind(14) - read(14,*) lon_input - read(14,*) lat_input - close(14) - write(6,*) ' lon is ',lon_input - write(6,*) ' lat is ',lat_input -!!MARS -!!MARS - -!!MARS -!!MARS - open(unit=18,file='input_more',form='formatted',status='old') - rewind(18) - read(18,*) alt_input, tsurf_input - close(18) - write(6,*) ' alt is ',alt_input - write(6,*) ' tsurf is ',tsurf_input -!!MARS -!!MARS - -! find ptop for the desired ztop (ztop is input from the namelist), -! and find surface pressure - - write(6,*) ' ztop above ground is ',config_flags%ztop - write(6,*) ' real ztop is ',config_flags%ztop + alt_input - grid%p_top = interp_0( p_in, zk, config_flags%ztop + alt_input, nl_in ) - - DO j=jts,jte - DO i=its,ite -!!MARS - grid%ht(i,j) = alt_input - grid%m_tsurf(i,j) = tsurf_input -!!MARS - grid%xlat(i,j) = lat_input !+ float(j)*config_flags%dy/59000. - grid%xlong(i,j) = lon_input !+ float(i)*config_flags%dx/59000. - grid%m_emiss(i,j)=0.95 - grid%m_co2ice(i,j)=0. - grid%m_h2oice(i,j)=0. -!! >> Used for restarts only: - grid%m_q2(i,:,j)=0. - grid%m_fluxrad(i,j)=0. - grid%m_wstar(i,j)=0. -!! << - grid%slpx(i,j) = 0. - grid%slpy(i,j) = 0. - DO k=1,config_flags%num_soil_layers - grid%m_tsoil(i,k,j) = 0. - ENDDO - grid%m_gw(i,1,j) = 0. - grid%m_gw(i,2,j) = 0. - grid%m_gw(i,3,j) = 0. - grid%m_gw(i,4,j) = 0. - grid%m_gw(i,5,j) = 0. -!!MARS - ENDDO - ENDDO - - xs=ide/2 -3 - xs=ids -3 - xe=xs + 6 - ys=jde/2 -3 - ye=ys + 6 - mtn_ht = 500 -#ifdef MTN - DO j=max(ys,jds),min(ye,jde-1) - DO i=max(xs,ids),min(xe,ide-1) - grid%ht(i,j) = alt_input + mtn_ht * 0.25 * & - ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) ) * & - ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) ) - ENDDO - ENDDO -#endif -#ifdef EW_RIDGE - DO j=max(ys,jds),min(ye,jde-1) - DO i=ids,ide - grid%ht(i,j) = mtn_ht * 0.50 * & - ( 1. + COS ( 2*pi/(ye-ys) * ( j-ys ) + pi ) ) - ENDDO - ENDDO -#endif -#ifdef NS_RIDGE - DO j=jds,jde - DO i=max(xs,ids),min(xe,ide-1) - grid%ht(i,j) = mtn_ht * 0.50 * & - ( 1. + COS ( 2*pi/(xe-xs) * ( i-xs ) + pi ) ) - ENDDO - ENDDO -#endif - DO j=jts,jte - DO i=its,ite - grid%phb(i,1,j) = g * grid%ht(i,j) - grid%ph0(i,1,j) = g * grid%ht(i,j) - ENDDO - ENDDO - - IF (.not.logp) THEN - write(6,*) 'interpolate in p' - ELSE - write(6,*) 'interpolate in logp' - ENDIF - - DO J = jts, jte - DO I = its, ite - - p_surf = interp_0( p_in, zk, grid%phb(i,1,j)/g, nl_in ) - grid%mub(i,j) = p_surf-grid%p_top - -! this is dry hydrostatic sounding (base state), so given grid%p (coordinate), -! interp theta (from interp) and compute 1/rho from eqn. of state - - DO K = 1, kte-1 - p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top - grid%pb(i,k,j) = p_level - IF (.not.logp) THEN - grid%t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0 - ELSE - grid%t_init(i,k,j) = interp_0_log( theta, p_in, p_level, nl_in ) - t0 - ENDIF - grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm - ENDDO - -! calc hydrostatic balance (alternatively we could interp the geopotential from the -! sounding, but this assures that the base state is in exact hydrostatic balance with -! respect to the model eqns. - - IF (hypsometric_opt == 1) THEN - DO k = 2,kte - grid%phb(i,k,j) = grid%phb(i,k-1,j) - grid%dnw(k-1)*grid%mub(i,j)*grid%alb(i,k-1,j) - ENDDO - ELSE IF (hypsometric_opt == 2) THEN - DO k = 2,kte - pfu = grid%mub(i,j)*grid%znw(k) + grid%p_top - pfd = grid%mub(i,j)*grid%znw(k-1) + grid%p_top - phm = grid%mub(i,j)*grid%znu(k-1) + grid%p_top - grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu) - END DO - END IF - - - ENDDO - ENDDO - IF ( wrf_dm_on_monitor() ) THEN - write(6,*) ' ptop is ',grid%p_top - write(6,*) ' base state grid%mub(1,1), p_surf is ',grid%mub(1,1),grid%mub(1,1)+grid%p_top - ENDIF - -! calculate full state for each column - this includes moisture. - - write(6,*) ' getting moist sounding for full state ' - dry_sounding = .false. - CALL get_sounding( zk, p_in, pd_in, theta, rho, u, v, qv, dry_sounding, nl_max, nl_in ) - - DO J = jts, min(jde-1,jte) - DO I = its, min(ide-1,ite) - -! At this point grid%p_top is already set. find the DRY mass in the column -! by interpolating the DRY pressure. - - pd_surf = interp_0( pd_in, zk, grid%phb(i,1,j)/g, nl_in ) - -! compute the perturbation mass and the full mass - - grid%mu_1(i,j) = pd_surf-grid%p_top - grid%mub(i,j) - grid%mu_2(i,j) = grid%mu_1(i,j) - grid%mu0(i,j) = grid%mu_1(i,j) + grid%mub(i,j) - -! given the dry pressure and coordinate system, interp the potential -! temperature and qv - - do k=1,kde-1 - - p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top - IF (.not.logp) THEN - moist(i,k,j,P_QV) = interp_0( qv, pd_in, p_level, nl_in ) - grid%t_1(i,k,j) = interp_0( theta, pd_in, p_level, nl_in ) - t0 - ELSE - moist(i,k,j,P_QV) = interp_0_log( qv, pd_in, p_level, nl_in ) - grid%t_1(i,k,j) = interp_0_log( theta, pd_in, p_level, nl_in ) - t0 - ENDIF - grid%t_2(i,k,j) = grid%t_1(i,k,j) - - - enddo - -! integrate the hydrostatic equation (from the RHS of the bigstep -! vertical momentum equation) down from the top to get grid%p. -! first from the top of the model to the top pressure - - k = kte-1 ! top level - - qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV)) - qvf2 = 1./(1.+qvf1) - qvf1 = qvf1*qvf2 - -! grid%p(i,k,j) = - 0.5*grid%mu_1(i,j)/grid%rdnw(k) - grid%p(i,k,j) = - 0.5*(grid%mu_1(i,j)+qvf1*grid%mub(i,j))/grid%rdnw(k)/qvf2 - qvf = 1. + rvovrd*moist(i,k,j,P_QV) - grid%alt(i,k,j) = (r_d/p1000mb)*(grid%t_1(i,k,j)+t0)*qvf* & - (((grid%p(i,k,j)+grid%pb(i,k,j))/p1000mb)**cvpm) - grid%al(i,k,j) = grid%alt(i,k,j) - grid%alb(i,k,j) - -! down the column - - do k=kte-2,1,-1 - qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV)) - qvf2 = 1./(1.+qvf1) - qvf1 = qvf1*qvf2 - grid%p(i,k,j) = grid%p(i,k+1,j) - (grid%mu_1(i,j) + qvf1*grid%mub(i,j))/qvf2/grid%rdn(k+1) - qvf = 1. + rvovrd*moist(i,k,j,P_QV) - grid%alt(i,k,j) = (r_d/p1000mb)*(grid%t_1(i,k,j)+t0)*qvf* & - (((grid%p(i,k,j)+grid%pb(i,k,j))/p1000mb)**cvpm) - grid%al(i,k,j) = grid%alt(i,k,j) - grid%alb(i,k,j) - enddo - -! this is the hydrostatic equation used in the model after the -! small timesteps. In the model, grid%al (inverse density) -! is computed from the geopotential. - - - grid%ph_1(i,1,j) = 0. - IF (hypsometric_opt == 1) THEN - DO k = 2,kte - grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (1./grid%rdnw(k-1))*( & - (grid%mub(i,j)+grid%mu_1(i,j))*grid%al(i,k-1,j)+ & - grid%mu_1(i,j)*grid%alb(i,k-1,j) ) - - grid%ph_2(i,k,j) = grid%ph_1(i,k,j) - grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j) - ENDDO - ELSE IF (hypsometric_opt == 2) THEN - - ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure. - ! Note that al*p approximates Rd*T and dLOG(p) does z. - ! Here T varies mostly linear with z, the first-order integration produces better result. - - grid%ph_2(i,1,j) = grid%phb(i,1,j) - DO k = 2,kte - pfu = grid%mu0(i,j)*grid%znw(k) + grid%p_top - pfd = grid%mu0(i,j)*grid%znw(k-1) + grid%p_top - phm = grid%mu0(i,j)*grid%znu(k-1) + grid%p_top - grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu) - END DO - - DO k = 1,kte - grid%ph_2(i,k,j) = grid%ph_2(i,k,j) - grid%phb(i,k,j) - grid%ph_1(i,k,j) = grid%ph_2(i,k,j) - END DO - - END IF - - - - IF ( wrf_dm_on_monitor() ) THEN - if((i==2) .and. (j==2)) then - write(6,*) ' grid%ph_1 calc ',grid%ph_1(2,1,2),grid%ph_1(2,2,2),& - grid%mu_1(2,2)+grid%mub(2,2),grid%mu_1(2,2), & - grid%alb(2,1,2),grid%al(1,2,1),grid%rdnw(1) - endif - ENDIF - - ENDDO - ENDDO - -!#if 0 - -! thermal perturbation to kick off convection - - write(6,*) ' nxc, nyc for perturbation ',nxc,nyc - write(6,*) ' delt for perturbation ',delt - -! For LES, change the initial random perturbations -! For 2D test, call randx outside I-loop -! For 3D runs, call randx inside both I-J loops - - DO J = jts, min(jde-1,jte) -! yrad = config_flags%dy*float(j-nyc)/10000. - yrad = 0. - DO I = its, min(ide-1,ite) -! xrad = config_flags%dx*float(i-nxc)/10000. - xrad = 0. - call random_number (randx) - randx = randx - 0.5 -! DO K = 1, kte-1 - DO K = 1, 4 - -! No bubbles for LES! -! put in preturbation theta (bubble) and recalc density. note, -! the mass in the column is not changing, so when theta changes, -! we recompute density and geopotential - -! zrad = 0.5*(grid%ph_1(i,k,j)+grid%ph_1(i,k+1,j) & -! +grid%phb(i,k,j)+grid%phb(i,k+1,j))/g -! zrad = (zrad-1500.)/1500. - zrad = 0. - RAD=SQRT(xrad*xrad+yrad*yrad+zrad*zrad) - IF(RAD <= 1.) THEN -! grid%t_1(i,k,j)=grid%t_1(i,k,j)+delt*COS(.5*PI*RAD)**2 - grid%t_1(i,k,j)=grid%t_1(i,k,j)+ 0.1 *randx - grid%t_2(i,k,j)=grid%t_1(i,k,j) - qvf = 1. + rvovrd*moist(i,k,j,P_QV) - grid%alt(i,k,j) = (r_d/p1000mb)*(grid%t_1(i,k,j)+t0)*qvf* & - (((grid%p(i,k,j)+grid%pb(i,k,j))/p1000mb)**cvpm) - grid%al(i,k,j) = grid%alt(i,k,j) - grid%alb(i,k,j) - ENDIF - ENDDO - -! rebalance hydrostatically - - IF (hypsometric_opt == 1) THEN - - DO k = 2,kte - grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (1./grid%rdnw(k-1))*( & - (grid%mub(i,j)+grid%mu_1(i,j))*grid%al(i,k-1,j)+ & - grid%mu_1(i,j)*grid%alb(i,k-1,j) ) - - grid%ph_2(i,k,j) = grid%ph_1(i,k,j) - grid%ph0(i,k,j) = grid%ph_1(i,k,j) + grid%phb(i,k,j) - ENDDO - - ELSE IF (hypsometric_opt == 2) THEN - - ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure. - ! Note that al*p approximates Rd*T and dLOG(p) does z. - ! Here T varies mostly linear with z, the first-order integration produces better result. - - grid%ph_2(i,1,j) = grid%phb(i,1,j) - DO k = 2,kte - pfu = grid%mu0(i,j)*grid%znw(k) + grid%p_top - pfd = grid%mu0(i,j)*grid%znw(k-1) + grid%p_top - phm = grid%mu0(i,j)*grid%znu(k-1) + grid%p_top - grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu) - END DO - - DO k = 1,kte - grid%ph_2(i,k,j) = grid%ph_2(i,k,j) - grid%phb(i,k,j) - grid%ph_1(i,k,j) = grid%ph_2(i,k,j) - END DO - - END IF - - - ENDDO - ENDDO - -!#endif - - IF ( wrf_dm_on_monitor() ) THEN - write(6,*) ' grid%mu_1 from comp ', grid%mu_1(1,1) - write(6,*) ' full state sounding from comp, ph/g, grid%p, grid%al, grid%t_1, qv ' - do k=1,kde-1 - write(6,'(i3,1x,5(1x,1pe10.3))') k, (grid%ph_1(1,k,1)+grid%phb(1,k,1))/g, & - grid%p(1,k,1)+grid%pb(1,k,1), grid%alt(1,k,1), & - grid%t_1(1,k,1)+t0, moist(1,k,1,P_QV) - enddo - - write(6,*) ' pert state sounding from comp, grid%ph_1, pp, alp, grid%t_1, qv ' - do k=1,kde-1 - write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%ph_1(1,k,1), & - grid%p(1,k,1), grid%al(1,k,1), & - grid%t_1(1,k,1), moist(1,k,1,P_QV) - enddo - ENDIF - -! interp v - - DO J = jts, jte - DO I = its, min(ide-1,ite) - - IF (j == jds) THEN - z_at_v = grid%phb(i,1,j)/g - ELSE IF (j == jde) THEN - z_at_v = grid%phb(i,1,j-1)/g - ELSE - z_at_v = 0.5*(grid%phb(i,1,j)+grid%phb(i,1,j-1))/g - END IF - - p_surf = interp_0( p_in, zk, z_at_v, nl_in ) - - DO K = 1, kte-1 - p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top - IF (.not.logp) THEN - grid%v_1(i,k,j) = interp_0( v, p_in, p_level, nl_in ) - ELSE - grid%v_1(i,k,j) = interp_0_log( v, p_in, p_level, nl_in ) - ENDIF - grid%v_2(i,k,j) = grid%v_1(i,k,j) - ENDDO - - ENDDO - ENDDO - -! interp u - - DO J = jts, min(jde-1,jte) - DO I = its, ite - - IF (i == ids) THEN - z_at_u = grid%phb(i,1,j)/g - ELSE IF (i == ide) THEN - z_at_u = grid%phb(i-1,1,j)/g - ELSE - z_at_u = 0.5*(grid%phb(i,1,j)+grid%phb(i-1,1,j))/g - END IF - - p_surf = interp_0( p_in, zk, z_at_u, nl_in ) - - DO K = 1, kte-1 - p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top - IF (.not.logp) THEN - grid%u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in ) - ELSE - grid%u_1(i,k,j) = interp_0_log( u, p_in, p_level, nl_in ) - ENDIF - grid%u_2(i,k,j) = grid%u_1(i,k,j) - ENDDO - - ENDDO - ENDDO - -! set w - - DO J = jts, min(jde-1,jte) - DO K = kts, kte - DO I = its, min(ide-1,ite) - grid%w_1(i,k,j) = 0. - grid%w_2(i,k,j) = 0. - ENDDO - ENDDO - ENDDO - -!!!MARS MARS -IF (config_flags%init_MU .ne. 0.) THEN - grid%u_1 = grid%u_1*config_flags%init_MU - grid%u_2 = grid%u_2*config_flags%init_MU - print *, 'multiply zonal wind ', config_flags%init_MU -ENDIF -IF (config_flags%init_MV .ne. 0.) THEN - grid%v_1 = grid%v_1*config_flags%init_MV - grid%v_2 = grid%v_2*config_flags%init_MV - print *, 'multiply meridional wind ', config_flags%init_MV -ENDIF -IF (config_flags%init_U .ne. 0.) THEN - DO J = jts, min(jde-1,jte) - DO K = kts, kte-1 - DO I = its, min(ide-1,ite) - grid%u_1(i,k,j) = config_flags%init_U - grid%u_2(i,k,j) = config_flags%init_U - ENDDO - ENDDO - ENDDO - print *, 'constant zonal wind ', config_flags%init_U - !!! ****** ou autre possibilité - !!! > grid%u_1 = grid%u_1*0. + config_flags%init_U - !!! > grid%u_2 = grid%u_2*0. + config_flags%init_U -ENDIF -IF (config_flags%init_V .ne. 0.) THEN - DO J = jts, min(jde-1,jte) - DO K = kts, kte-1 - DO I = its, min(ide-1,ite) - grid%v_1(i,k,j) = config_flags%init_V - grid%v_2(i,k,j) = config_flags%init_V - ENDDO - ENDDO - ENDDO - print *, 'constant meridional wind ', config_flags%init_V -ENDIF - -!!!MARS MARS - - -! set a few more things - - DO J = jts, min(jde-1,jte) - DO K = kts, kte-1 - DO I = its, min(ide-1,ite) - grid%h_diabatic(i,k,j) = 0. - !!!!! MARS NO WIND CASE - !grid%u_1(i,k,j) = 0. - !grid%u_2(i,k,j) = 0. - !grid%v_1(i,k,j) = 0. - !grid%v_2(i,k,j) = 0. - !!!!! MARS NO WIND CASE - ENDDO - ENDDO - ENDDO - - IF ( wrf_dm_on_monitor() ) THEN - DO k=1,kte-1 - grid%t_base(k) = grid%t_1(1,k,1) - grid%qv_base(k) = moist(1,k,1,P_QV) - grid%u_base(k) = grid%u_1(1,k,1) - grid%v_base(k) = grid%v_1(1,k,1) - grid%z_base(k) = 0.5*(grid%phb(1,k,1)+grid%phb(1,k+1,1)+grid%ph_1(1,k,1)+grid%ph_1(1,k+1,1))/g - -!!!!! MARS SIMPLE LES (PURE BUOYANCY) -!! grid%t_base(k) = grid%t_init(its,k,jts) -! grid%t_base(k) = 0. -! grid%qv_base(k) = 0. -! grid%u_base(k) = 0. -! grid%v_base(k) = 0. -! grid%z_base(k) = 0. -!!!!! MARS SIMPLE LES - - ENDDO - ENDIF - CALL wrf_dm_bcast_real( grid%t_base , kte ) - CALL wrf_dm_bcast_real( grid%qv_base , kte ) - CALL wrf_dm_bcast_real( grid%u_base , kte ) - CALL wrf_dm_bcast_real( grid%v_base , kte ) - CALL wrf_dm_bcast_real( grid%z_base , kte ) - - DO J = jts, min(jde-1,jte) - DO I = its, min(ide-1,ite) - thtmp = grid%t_2(i,1,j)+t0 - ptmp = grid%p(i,1,j)+grid%pb(i,1,j) - temp(1) = thtmp * (ptmp/p1000mb)**rcp - thtmp = grid%t_2(i,2,j)+t0 - ptmp = grid%p(i,2,j)+grid%pb(i,2,j) - temp(2) = thtmp * (ptmp/p1000mb)**rcp - thtmp = grid%t_2(i,3,j)+t0 - ptmp = grid%p(i,3,j)+grid%pb(i,3,j) - temp(3) = thtmp * (ptmp/p1000mb)**rcp - -!! For LES-CBL, add 5 degrees to the surface temperature! -!! -! grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3) -!! grid%tsk(I,J)=grid%cf1*temp(1)+grid%cf2*temp(2)+grid%cf3*temp(3)+5. - grid%tmn(I,J)=grid%tsk(I,J)-0.5 - - ENDDO - ENDDO - -!!!!! MARS - - ! interpolate water vapor - if ( ( config_flags%mars == 1 ) & - .OR. ( config_flags%mars == 11 ) & - .OR. ( config_flags%mars == 12 ) ) then - print *, '**** INTERPOLATE HV **** RANK 2 in SCALAR' - DO k=1,kte-1 - p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top - IF (.not.logp) THEN - scalar(its:ite,k,jts:jte,2) = interp_0( qv, pd_in, p_level, nl_in ) - ELSE - scalar(its:ite,k,jts:jte,2) = interp_0_log( qv, pd_in, p_level, nl_in ) - ENDIF - scalar(its:ite,k,jts:jte,3) = 0. - !! water ice is set to 0 (was put into water vapor when building prof from MCD) - ENDDO - print *, "WATER VAPOR",scalar(its,:,jts,2) - endif - - ! interpolate qdust - if ( ( config_flags%mars == 11 ) & - .OR. ( config_flags%mars == 12 ) ) then - call read_dust(profdustq,profdustn,nl_in) - print *, '**** INTERPOLATE DUSTQ **** RANK 4 in SCALAR' - print *, '**** INTERPOLATE DUSTN **** RANK 5 in SCALAR' - DO k=1,kte-1 - p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top - IF (.not.logp) THEN - scalar(its:ite,k,jts:jte,4) = interp_0( profdustq, pd_in, p_level,nl_in ) - scalar(its:ite,k,jts:jte,5) = interp_0( profdustn, pd_in, p_level,nl_in ) - ELSE - scalar(its:ite,k,jts:jte,4) = interp_0_log( profdustq, pd_in, p_level, nl_in ) - scalar(its:ite,k,jts:jte,5) = interp_0_log( profdustn, pd_in, p_level, nl_in ) - ENDIF - ENDDO - print *, "DUST Q", scalar(its,:,jts,4) - print *, "DUST N", scalar(its,:,jts,5) - endif - - if ( config_flags%mars == 12 ) then - scalar(its:ite,1:kte-1,jts:jte,6) = 0. - scalar(its:ite,1:kte-1,jts:jte,7) = 0. - endif - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - IF (planet .ne. "mars") THEN - call read_dust(profdustq,profdustn,nl_in) - DO k=1,kte!-1 - p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top - DO j = jts, jte - DO i = its, ite - !!! we use Q2 as a vehicle for heating rates! sick! - grid%m_q2(i,k,j) = interp_0_log( profdustq, pd_in, p_level, nl_in ) & - + interp_0_log( profdustn, pd_in, p_level, nl_in ) - ENDDO - ENDDO - !print*,'grid%m_q2' - !print*,k,grid%m_q2(1,k,1) - ENDDO - ENDIF - - IF (planet.eq."prescribed") Then - call read_hr(hrsw,hrlw,hrdyn,nl_in) - open(unit=17,file="prescribed_sw.txt",action="write") - open(unit=18,file="prescribed_lw.txt",action="write") - open(unit=19,file="prescribed_dyn.txt",action="write") - DO k=1,kte!-1 - p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top - prescribed_sw(k) = interp_0_log( hrsw, pd_in, p_level, nl_in ) - prescribed_lw(k) = interp_0_log( hrlw, pd_in, p_level, nl_in ) - prescribed_dyn(k) = interp_0_log( hrdyn, pd_in, p_level, nl_in ) - write (17,*) prescribed_sw(k) - write (18,*) prescribed_lw(k) - write (19,*) prescribed_dyn(k) - ENDDO - close(unit=19) - close(unit=18) - close(unit=17) - ENDIF - - IF (planet.eq."venus") Then - call read_hr(hrsw,hrlw,hrdyn,nl_in) - open(unit=20,file="venus_hrdyn.txt",action="write") - DO k=1,kte!-1 - p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top - venus_hrdyn(k) = interp_0_log( hrdyn, pd_in, p_level, nl_in ) - write (20,*) venus_hrdyn(k) - ENDDO - close(unit=20) - ENDIF - - IF (planet.eq."generic") THEN - call read_lsf(lsfdt,lsfdq,nl_in) - open(unit=17,file="lsf.txt",action="write") - DO k=1,kte!-1 - p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top - lsf_dt = interp_0_log( lsfdt, pd_in, p_level, nl_in ) - lsf_dq = interp_0_log( lsfdq, pd_in, p_level, nl_in ) - write (17,*) lsf_dt(k),lsf_dq(k) - ENDDO - ENDIF - - IF ((planet.eq."venus") .AND. ( config_flags%mars == 34 )) Then - pd_in8(:)=pd_in(:) - do i = 1,34 - call read_tracer(trac,num_scalar,i,nl_in) - DO k=1,kte-1 - p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top - p_level8=p_level - scalar(its:ite,k,jts:jte,i+1) = interp_0_log2( trac, pd_in8, p_level8, nl_in ) - ENDDO - ENDDO - !close(unit=22) - ENDIF - - open(unit=21,file="altitude.txt",action="write") - DO k=1,kte!-1 - p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top - altitude(k) = interp_0_log( zk, pd_in, p_level, nl_in ) - write (21,*) altitude(k) - ENDDO - close(unit=21) - -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - -!!!!! MARS - - - END SUBROUTINE init_domain_rk - - SUBROUTINE init_module_initialize - END SUBROUTINE init_module_initialize - -!--------------------------------------------------------------------- - -! test driver for get_sounding -! -! implicit none -! integer n -! parameter(n = 1000) -! real zk(n),p(n),theta(n),rho(n),u(n),v(n),qv(n),pd(n) -! logical dry -! integer nl,k -! -! dry = .false. -! dry = .true. -! call get_sounding( zk, p, pd, theta, rho, u, v, qv, dry, n, nl ) -! write(6,*) ' input levels ',nl -! write(6,*) ' sounding ' -! write(6,*) ' k height(m) press (Pa) pd(Pa) theta (K) den(kg/m^3) u(m/s) v(m/s) qv(g/g) ' -! do k=1,nl -! write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), pd(k), theta(k), rho(k), u(k), v(k), qv(k) -! enddo -! end -! -!--------------------------------------------------------------------------- - - subroutine get_sounding( zk, p, p_dry, theta, rho, & - u, v, qv, dry, nl_max, nl_in ) - implicit none - - integer nl_max, nl_in - real zk(nl_max), p(nl_max), theta(nl_max), rho(nl_max), & - u(nl_max), v(nl_max), qv(nl_max), p_dry(nl_max) - logical dry - - integer n - parameter(n=1000) - logical debug - parameter( debug = .true.) - -! input sounding data - - real p_surf, th_surf, qv_surf - real pi_surf, pi(n) - real h_input(n), th_input(n), qv_input(n), u_input(n), v_input(n) - -! input therm data (element 0 is the ground so it's n+1 but n is 1000 anyway so...) - - real r_therm(n),cp_therm(n),p_therm(n),rho_therm(n),t_therm(n) - -! diagnostics - - real rho_surf, p_input(n), rho_input(n) - real pm_input(n) ! this are for full moist sounding - -! local data - -! real p1000mb,cv,cp,r,cvpm,g -! parameter (p1000mb = 1.e+05, r = 287, cp = 1003., cv = cp-r, cvpm = -cv/cp, g=9.81 ) -! parameter (p1000mb = 610., r = 192., cp = 844.6, cv = cp-r, cvpm = -cv/cp, g=3.72) -! parameter (p1000mb = 610., r = 191., cp = 744.5, cv = cp-r, cvpm = -cv/cp, g=3.72) - !parameter (p1000mb = 92.e+05, r = 192., cp = 900.0, cv = cp-r, cvpm = -cv/cp, g=8.87) - integer k, it, nl - real qvf, qvf1, dz - - LOGICAL :: direct_from_file - - IF (planet == "mars") THEN - direct_from_file = .false. - ELSE - direct_from_file = .true. - ENDIF - -! first, read the sounding - - call read_sounding( p_surf, th_surf, qv_surf, & - h_input, th_input, qv_input, & - u_input, v_input,n, nl, debug ) - -! and the therm : - - call read_therm(r_therm,cp_therm,p_therm,rho_therm,t_therm,n) - - if(debug) write(6,*) ' number of input levels = ',nl - nl_in = nl - if(nl_in .gt. nl_max ) then - write(6,*) ' too many levels for input arrays ',nl_in,nl_max - call wrf_error_fatal ( ' too many levels for input arrays ' ) - end if - - IF (.NOT. direct_from_file) THEN - -! To use r/cp as defined above, one has to recompute teta from T (default MCD computes -! teta for a variable r/cp) - - do k=1,nl - th_input(k) = t_therm(k)*(p1000mb/p_therm(k))**(rcp) - enddo - th_surf = t_therm(1)*(p1000mb/p_therm(1))**(rcp) -! ----- - - !if(dry) then - ! do k=1,nl - ! qv_input(k) = 0. - ! enddo - !endif - -! compute diagnostics, -! first, convert qv(g/kg) to qv(g/g) - - do k=1,nl - !!!!!!!!!!!!!! MARS - !! from mol/mol to kg/kg - qv_input(k) = qv_input(k)*18./mwdry - qv_input(k) = 0.001*qv_input(k) - enddo - - p_surf = 100.*p_surf ! convert to pascals - qvf = 1. + rvovrd*qv_input(1) -!!MARS - qvf = 1. - rho_surf = 1./((r_d/p1000mb)*th_surf*qvf*((p_surf/p1000mb)**cvpm)) - pi_surf = (p_surf/p1000mb)**(rcp) - - if(debug) then - write(6,*) ' surface density is ',rho_surf - write(6,*) ' surface pi is ',pi_surf - end if - - -! integrate moist sounding hydrostatically, starting from the -! specified surface pressure -! -> first, integrate from surface to lowest level - - qvf = 1. + rvovrd*qv_input(1) - qvf1 = 1. + qv_input(1) -!!MARS - qvf = 1. - qvf1 = 1. - rho_input(1) = rho_surf - dz = h_input(1) - do it=1,10 -! pm_input(1) = p_surf & -! - 0.5*dz*(rho_surf+rho_input(1))*g*qvf1 -!!!MARS MARS MARS - pm_input(1) = p_surf - rho_input(1) = 1./((r_d/p1000mb)*th_input(1)*qvf*((pm_input(1)/p1000mb)**cvpm)) - enddo - -! integrate up the column - - do k=2,nl - rho_input(k) = rho_input(k-1) - dz = h_input(k)-h_input(k-1) - qvf1 = 0.5*(2.+(qv_input(k-1)+qv_input(k))) - qvf = 1. + rvovrd*qv_input(k) ! qv is in g/kg here -!!MARS - qvf = 1. - qvf1 = 1. -!!MARS - - do it=1,10 - pm_input(k) = pm_input(k-1) & - - 0.5*dz*(rho_input(k)+rho_input(k-1))*g*qvf1 - rho_input(k) = 1./((r_d/p1000mb)*th_input(k)*qvf*((pm_input(k)/p1000mb)**cvpm)) - enddo - enddo - -! we have the moist sounding - -! next, compute the dry sounding using p at the highest level from the -! moist sounding and integrating down. - - p_input(nl) = pm_input(nl) - - do k=nl-1,1,-1 - dz = h_input(k+1)-h_input(k) - p_input(k) = p_input(k+1) + 0.5*dz*(rho_input(k)+rho_input(k+1))*g - enddo - - ELSE !IF (.NOT. direct_from_file) THEN - - do k=1,nl - !!!! direct input from file - write(6,*) '*** DIRECT INPUT FROM FILE ***' - pm_input(k) = p_therm(k) - p_input(k) = p_therm(k) - rho_input(k) = rho_therm(k) - enddo - - ENDIF - - - do k=1,nl - - zk(k) = h_input(k) - p(k) = pm_input(k) - p_dry(k) = p_input(k) - theta(k) = th_input(k) - rho(k) = rho_input(k) - u(k) = u_input(k) - v(k) = v_input(k) - qv(k) = qv_input(k) - - enddo - - if(debug) then - write(6,*) ' sounding ' - write(6,*) ' k height(m) press (Pa) pd(Pa) theta (K) den(kg/m^3) u(m/s) v(m/s) qv(g/g) ' - do k=1,nl - write(6,'(1x,i3,8(1x,1pe10.3))') k, zk(k), p(k), p_dry(k), theta(k), rho(k), u(k), v(k), qv(k) - enddo - - end if - - end subroutine get_sounding - -!------------------------------------------------------- - - subroutine read_sounding( ps,ts,qvs,h,th,qv,u,v,n,nl,debug ) - implicit none - integer n,nl - real ps,ts,qvs,h(n),th(n),qv(n),u(n),v(n) - logical end_of_file - logical debug - - integer k - - open(unit=10,file='input_sounding',form='formatted',status='old') - rewind(10) - read(10,*) ps, ts, qvs - if(debug) then - write(6,*) ' input sounding surface parameters ' - write(6,*) ' surface pressure (mb) ',ps - write(6,*) ' surface pot. temp (K) ',ts - write(6,*) ' surface mixing ratio (g/kg) ',qvs - end if - - end_of_file = .false. - k = 0 - - do while (.not. end_of_file) - - read(10,*,end=100) h(k+1), th(k+1), qv(k+1), u(k+1), v(k+1) - k = k+1 - if(debug) write(6,'(1x,i3,5(1x,e10.3))') k, h(k), th(k), qv(k), u(k), v(k) - go to 110 - 100 end_of_file = .true. - 110 continue - enddo - - nl = k - - close(unit=10,status = 'keep') - - end subroutine read_sounding - - subroutine read_therm(r,cp,p,rho,t,n) - implicit none - integer n - real r(n),cp(n),p(n),rho(n),t(n) - logical end_of_file - - integer k - -! first element is the surface - - open(unit=11,file='input_therm',form='formatted',status='old') - rewind(11) - end_of_file = .false. - k = 0 - do while (.not. end_of_file) - - read(11,*,end=101) r(k+1), cp(k+1), p(k+1), rho(k+1), t(k+1) - write(*,*) k, r(k+1), cp(k+1), p(k+1), rho(k+1), t(k+1) - k = k+1 - go to 112 - 101 end_of_file = .true. - 112 continue - enddo - - close(unit=11,status = 'keep') - - end subroutine read_therm - -!!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine read_dust(pdustq,pdustn,n) - implicit none - integer n - real pdustq(n+1),pdustn(n+1) - logical end_of_file - - integer k - -! first element is the surface - - open(unit=11,file='input_dust',form='formatted',status='old') - rewind(11) - end_of_file = .false. - k = 0 - do while (.not. end_of_file) - - read(11,*,end=102) pdustq(k+1),pdustn(k+1) - write(*,*) k,pdustq(k+1),pdustn(k+1) - k = k+1 - go to 113 - 102 end_of_file = .true. - 113 continue - enddo - - close(unit=11,status = 'keep') - - end subroutine read_dust -!!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc - subroutine read_hr(hr_sw,hr_lw,hr_dyn,n) - implicit none - integer n - real hr_sw(n+1),hr_lw(n+1),hr_dyn(n+1) - logical end_of_file - - integer k - -! first element is the surface - - open(unit=11,file='input_hr',form='formatted',status='old') - rewind(11) - end_of_file = .false. - k = 0 - do while (.not. end_of_file) - - read(11,*,end=103) hr_sw(k+1),hr_lw(k+1),hr_dyn(k+1) - write(*,*) k,hr_sw(k+1),hr_lw(k+1),hr_dyn(k+1) - k = k+1 - go to 114 - 103 end_of_file = .true. - 114 continue - enddo - - close(unit=11,status = 'keep') - - end subroutine read_hr - - subroutine read_lsf(dt,dq,n) - implicit none - integer n - real dt(n+1),dq(n+1) - logical end_of_file - - integer k - -! first element is the surface - - open(unit=12,file='input_lsf',form='formatted',status='old') - rewind(12) - end_of_file = .false. - k = 0 - do while (.not. end_of_file) - - read(12,*,end=103) dt(k+1),dq(k+1) - write(*,*) k,dt(k+1),dq(k+1) - k = k+1 - go to 114 - 103 end_of_file = .true. - 114 continue - enddo - - close(unit=12,status = 'keep') - - end subroutine read_lsf - - subroutine read_tracer(trace,nq,qn,n) - implicit none - integer n,qn,nq ! qn : number of the tracer - real*8 tra(nq-1,n+1) - real*8 trace(n+1) !output - logical end_of_file - - integer k,j - -! first element is the surface - open(unit=14,file='input_tracer',form='formatted',status='old') - rewind(14) - end_of_file = .false. - DO k=1,n - read(14,*) tra(:,k) - write(*,*) k,tra(qn,k) - ENDDO - - close(14) - trace(:)=tra(qn,:) - end subroutine read_tracer - - -END MODULE module_initialize_ideal Index: unk/WRF.COMMON/WRFV3/modif_mars/module_physics_addtendc.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/modif_mars/module_physics_addtendc.F (revision 2760) +++ (revision ) @@ -1,1222 +1,0 @@ -!WRF:MODEL_LAYER: PHYSICS -! -! note: this module really belongs in the dyn_em directory since it is -! specific only to the EM core. Leaving here for now, with an -! #if ( EM_CORE == 1 ) directive. JM 20031201 -! - -! This MODULE holds the routines which are used to perform updates of the -! model C-grid tendencies with physics A-grid tendencies -! The module consolidates code that was (up to v1.2) duplicated in -! module_em and module_rk and in -! module_big_step_utilities.F and module_big_step_utilities_em.F - -! This MODULE CONTAINS the following routines: -! update_phy_ten, phy_ra_ten, phy_bl_ten, phy_cu_ten, advance_ppt, -! add_a2a, add_a2c_u, and add_a2c_v - - -MODULE module_physics_addtendc - -#if ( EM_CORE == 1 ) - - USE module_state_description - USE module_configure - -CONTAINS - -SUBROUTINE update_phy_ten(rt_tendf,ru_tendf,rv_tendf,moist_tendf, & - scalar_tendf,mu_tendf, & - RTHRATEN,RTHBLTEN,RTHCUTEN,RUBLTEN,RVBLTEN, & - RQVBLTEN,RQCBLTEN,RQIBLTEN, & - RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN,& - RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN, & - RMUNDGDTEN, & - n_moist,n_scalar,config_flags,rk_step,adv_moist_cond, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -!------------------------------------------------------------------- - IMPLICIT NONE -!------------------------------------------------------------------- - - TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte, & - n_moist,n_scalar,rk_step - - LOGICAL , INTENT(IN) :: adv_moist_cond - - REAL , DIMENSION(ims:ime , kms:kme, jms:jme),INTENT(INOUT) :: & - ru_tendf, & - rv_tendf, & - rt_tendf - - REAL , DIMENSION(ims:ime , jms:jme),INTENT(INOUT) :: mu_tendf - - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), & - INTENT(INOUT) :: moist_tendf - - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), & - INTENT(INOUT) :: scalar_tendf - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & - RTHRATEN, & - RTHBLTEN, & - RTHCUTEN, & - RUBLTEN, & - RVBLTEN, & - RQVBLTEN, & - RQCBLTEN, & - RQIBLTEN, & - RQVCUTEN, & - RQCCUTEN, & - RQRCUTEN, & - RQICUTEN, & - RQSCUTEN, & - RTHNDGDTEN, & - RQVNDGDTEN, & - RUNDGDTEN, & - RVNDGDTEN - - REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN -!------------------------------------------------------------------ - -! set up loop bounds for this grid's boundary conditions - - if (config_flags%ra_lw_physics .gt. 0 .or. & - config_flags%ra_sw_physics .gt. 0) & - CALL phy_ra_ten(config_flags,rt_tendf,RTHRATEN, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! if (config_flags%bl_pbl_physics .gt. 0) & -!****MARS -! - All the LMD physics packages provide one tendency in the WRF sense -! - PBL was chosen for practical reasons (U+V+T) -! - The tendencies are supposed to be A-gridded - if ( (config_flags%bl_pbl_physics .gt. 0) & - .OR. (config_flags%modif_wrf) ) & - CALL phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, & - rt_tendf,ru_tendf,rv_tendf,moist_tendf, & - scalar_tendf,adv_moist_cond, & - RTHBLTEN,RUBLTEN,RVBLTEN, & - RQVBLTEN,RQCBLTEN,RQIBLTEN, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (config_flags%cu_physics .gt. 0) & - CALL phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf, & - RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & - RQICUTEN,RQSCUTEN,moist_tendf, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (config_flags%grid_fdda .gt. 0) & - CALL phy_fg_ten(config_flags,rk_step,n_moist, & - rt_tendf,ru_tendf,rv_tendf, & - mu_tendf, moist_tendf, & - RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, & - RQVNDGDTEN,RMUNDGDTEN, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -END SUBROUTINE update_phy_ten - -!================================================================= -SUBROUTINE phy_ra_ten(config_flags,rt_tendf,RTHRATEN, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -!----------------------------------------------------------------- - IMPLICIT NONE -!----------------------------------------------------------------- - TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & - RTHRATEN - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: & - rt_tendf - -! LOCAL VARS - - INTEGER :: i,j,k - - CALL add_a2a(rt_tendf,RTHRATEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -END SUBROUTINE phy_ra_ten - -!================================================================= -SUBROUTINE phy_bl_ten(config_flags,rk_step,n_moist,n_scalar, & - rt_tendf,ru_tendf,rv_tendf,moist_tendf, & - scalar_tendf,adv_moist_cond, & - RTHBLTEN,RUBLTEN,RVBLTEN, & - RQVBLTEN,RQCBLTEN,RQIBLTEN, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -!----------------------------------------------------------------- - IMPLICIT NONE -!----------------------------------------------------------------- - TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte, & - n_moist, n_scalar, rk_step - - LOGICAL , INTENT(IN) :: adv_moist_cond - - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), & - INTENT(INOUT) :: moist_tendf - - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar), & - INTENT(INOUT) :: scalar_tendf - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & - RTHBLTEN, & - RUBLTEN, & - RVBLTEN, & - RQVBLTEN, & - RQCBLTEN, & - RQIBLTEN - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & - rt_tendf, & - ru_tendf, & - rv_tendf -! LOCAL VARS - - INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND - -!----------------------------------------------------------------- - - -!****MARS -!****MARS -!update with LMD physics tendencies -if (config_flags%modif_wrf) then -CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -endif -!****MARS -!****MARS - - - SELECT CASE(config_flags%bl_pbl_physics) - - CASE (YSUSCHEME) - - CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QV .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QC .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QI .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IF(.not. adv_moist_cond)THEN - - if (P_QT .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QT .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - ENDIF - - CASE (MRFSCHEME) - - CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QV .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QC .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QI .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IF(.not. adv_moist_cond)THEN - - if (P_QT .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QT .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - ENDIF - - CASE (ACMPBLSCHEME) - - CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QV .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QC .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QI .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IF(.not. adv_moist_cond)THEN - - if (P_QT .ge. PARAM_FIRST_SCALAR)THEN - CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - ENDIF - - ENDIF - - CASE (MYJPBLSCHEME) - - CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QV .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IF(.not. adv_moist_cond)THEN - - if (P_QT .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - ELSE - - if (P_QC .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - ENDIF - - CASE (GFSSCHEME) - - CALL add_a2a(rt_tendf,RTHBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QV .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QC .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QI .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - IF(.not. adv_moist_cond)THEN - - if (P_QT .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QT .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - ENDIF - - CASE DEFAULT - - ! print*,'phy_bl_ten: The pbl scheme does not exist' - - END SELECT - -END SUBROUTINE phy_bl_ten - -!================================================================= -SUBROUTINE phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf, & - RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & - RQICUTEN,RQSCUTEN,moist_tendf, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -!----------------------------------------------------------------- - IMPLICIT NONE -!----------------------------------------------------------------- - TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte, & - n_moist, rk_step - - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), & - INTENT(INOUT) :: moist_tendf - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & - RTHCUTEN, & - RQVCUTEN, & - RQCCUTEN, & - RQRCUTEN, & - RQICUTEN, & - RQSCUTEN - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: & - rt_tendf - -! LOCAL VARS - - INTEGER :: i,j,k - - SELECT CASE (config_flags%cu_physics) - - CASE (KFSCHEME) - CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QV .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QC .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QR .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QI .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QS .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CASE (BMJSCHEME) - CALL add_a2a(rt_tendf,RTHCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QV .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CASE (KFETASCHEME) - CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QV .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QC .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QR .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QI .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QS .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CASE (GDSCHEME, G3SCHEME) - CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QV .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QC .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QI .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CASE (SASSCHEME) - CALL add_a2a(rt_tendf,RTHCUTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QV .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QC .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - if (P_QI .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CASE DEFAULT - - END SELECT - -END SUBROUTINE phy_cu_ten - -!================================================================= -SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist, & - rt_tendf,ru_tendf,rv_tendf, & - mu_tendf, moist_tendf, & - RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN, & - RQVNDGDTEN,RMUNDGDTEN, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -!----------------------------------------------------------------- - IMPLICIT NONE -!----------------------------------------------------------------- - TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags - - INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte, & - n_moist, rk_step - - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), & - INTENT(INOUT) :: moist_tendf - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: & - RTHNDGDTEN, & - RUNDGDTEN, & - RVNDGDTEN, & - RQVNDGDTEN - - REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: RMUNDGDTEN - - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & - rt_tendf, & - ru_tendf, & - rv_tendf - - REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT):: mu_tendf - -! LOCAL VARS - - INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND - -!----------------------------------------------------------------- - - SELECT CASE(config_flags%grid_fdda) - - CASE (PSUFDDAGD) - - CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - -! note fdda u and v tendencies are staggered - CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags, & - ids,ide, jds, jde, kds, kds, & - ims, ime, jms, jme, kms, kms, & - its, ite, jts, jte, kts, kts ) - - if (P_QV .ge. PARAM_FIRST_SCALAR) & - CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN, & - config_flags, & - ids,ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) - - - CASE DEFAULT - - END SELECT - -END SUBROUTINE phy_fg_ten - -!---------------------------------------------------------------------- -SUBROUTINE advance_ppt(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & - RQICUTEN,RQSCUTEN,RAINC,RAINCV,PRATEC,NCA, & - HTOP,HBOT,CUTOP,CUBOT, & - CUPPT, DT, config_flags, & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte ) -!---------------------------------------------------------------------- - USE module_state_description -!!!******MARS MARS -!!!******MARS MARS -! USE module_cu_kf -! USE module_cu_kfeta -!---------------------------------------------------------------------- - IMPLICIT NONE -!---------------------------------------------------------------------- - TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags - - INTEGER, INTENT(IN ) :: & - ids,ide, jds,jde, kds,kde, & - ims,ime, jms,jme, kms,kme, & - its,ite, jts,jte, kts,kte - - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & - INTENT(INOUT) :: RTHCUTEN, & - RQVCUTEN, & - RQCCUTEN, & - RQRCUTEN, & - RQICUTEN, & - RQSCUTEN - - REAL, DIMENSION( ims:ime , jms:jme ), & - INTENT(INOUT) :: RAINC, & - RAINCV, & - PRATEC, & - NCA, & - HTOP, & - HBOT, & - CUTOP, & - CUBOT, & - CUPPT - REAL, INTENT(IN) :: DT - -! LOCAL VAR - - INTEGER :: i,j,k,i_start,i_end,j_start,j_end,k_start,k_end - INTEGER :: NCUTOP, NCUBOT - -!----------------------------------------------------------------- - - IF (config_flags%cu_physics .eq. 0) return - -! SET START AND END POINTS FOR TILES - - i_start = its - i_end = min( ite,ide-1 ) - j_start = jts - j_end = min( jte,jde-1 ) -! -! IF( config_flags%nested .or. config_flags%specified ) THEN -! i_start = max( its,ids+1 ) -! i_end = min( ite,ide-2 ) -! j_start = max( jts,jds+1 ) -! j_end = min( jte,jde-2 ) -! ENDIF -! - k_start = kts - k_end = min( kte, kde-1 ) - -! Update total cumulus scheme precipitation - -! in mm - - DO J = j_start,j_end - DO i = i_start,i_end - RAINC(I,J)=RAINC(I,J)+PRATEC(I,J)*DT - CUPPT(I,J)=CUPPT(I,J)+PRATEC(I,J)*DT/1000. - ENDDO - ENDDO - - SELECT CASE (config_flags%cu_physics) - - CASE (KFSCHEME) - - DO J = j_start,j_end - DO i = i_start,i_end - - IF ( NCA(I,J) .GT. 0 ) THEN - - IF ( NINT(NCA(I,J) / DT) .le. 0 ) THEN - - ! set tendency to zero - PRATEC(I,J)=0. - RAINCV(I,J)=0. - DO k = k_start,k_end - RTHCUTEN(i,k,j)=0. - RQVCUTEN(i,k,j)=0. - RQCCUTEN(i,k,j)=0. - RQRCUTEN(i,k,j)=0. - if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0. - if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0. - ENDDO - ENDIF - - NCA(I,J)=NCA(I,J)-DT ! Decrease NCA - - ENDIF -! - ENDDO - ENDDO - - CASE (BMJSCHEME) - - DO J = j_start,j_end - DO i = i_start,i_end - -! HTOP, HBOT FOR GFDL RADIATION - NCUTOP=NINT(CUTOP(I,J)) - NCUBOT=NINT(CUBOT(I,J)) - IF(NCUTOP>1.AND.NCUTOP0.AND.NCUBOT1.AND.NCUTOP0.AND.NCUBOT ',6*(max_cats*max_seas)+1*max_cats - ENDIF - curs = 1 - DO cats = 1, max_cats - SCFX(cats) = lu_state(curs) ; curs = curs + 1 - DO seas = 1, max_seas - ALBD(cats,seas) = lu_state(curs) ; curs = curs + 1 - SLMO(cats,seas) = lu_state(curs) ; curs = curs + 1 - SFEM(cats,seas) = lu_state(curs) ; curs = curs + 1 - SFZ0(cats,seas) = lu_state(curs) ; curs = curs + 1 - SFHC(cats,seas) = lu_state(curs) ; curs = curs + 1 - THERIN(cats,seas) = lu_state(curs) ; curs = curs + 1 - ENDDO - ENDDO - -! Determine season (summer=1, winter=2) - ISN=1 - IF(JULDAY.LT.105.OR.JULDAY.GT.288)ISN=2 - IF(CEN_LAT.LT.0.0)ISN=3-ISN - - FOUND_LU = .TRUE. - IF ( allowed_to_read ) THEN - landuse_unit = 29 - IF ( wrf_dm_on_monitor() ) THEN - OPEN(landuse_unit, FILE='LANDUSE.TBL',FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr) - IF ( ierr .NE. OPEN_OK ) THEN - WRITE(message,FMT='(A)') & - 'module_physics_init.F: LANDUSE_INIT: open failure for LANDUSE.TBL' - CALL wrf_error_fatal ( message ) - END IF - ENDIF - -! Read info from file LANDUSE.TBL - IF(MMINLU.EQ.'OLD ')THEN -! ISWATER=7 - ISICE=11 - ELSE IF(MMINLU.EQ.'USGS')THEN -! ISWATER=16 - ISICE=24 - ELSE IF(MMINLU.EQ.'SiB ')THEN -! ISWATER=15 - ISICE=16 - ELSE IF(MMINLU.EQ.'LW12')THEN -! ISWATER=15 - ISICE=3 - ENDIF - PRINT *, 'INPUT LANDUSE = ',MMINLU - FOUND_LU = .FALSE. - end_of_file = .FALSE. -!!! BEGINNING OF 1999 LOOP - 1999 CONTINUE - IF ( wrf_dm_on_monitor() ) THEN - READ (landuse_unit,2000,END=2002)LUTYPE - GOTO 2003 - 2002 CONTINUE - CALL wrf_message( 'INPUT FILE FOR LANDUSE REACHED END OF FILE' ) - end_of_file = .TRUE. - 2003 CONTINUE - IF ( .NOT. end_of_file ) READ (landuse_unit,*)LUCATS,LUSEAS - FOUND_LU = LUTYPE.EQ.MMINLU - ENDIF - CALL wrf_dm_bcast_bytes (end_of_file, LWORDSIZE ) - IF ( .NOT. end_of_file ) THEN - CALL wrf_dm_bcast_string(lutype, 4) - CALL wrf_dm_bcast_bytes (lucats, IWORDSIZE ) - CALL wrf_dm_bcast_bytes (luseas, IWORDSIZE ) - CALL wrf_dm_bcast_bytes (found_lu, LWORDSIZE ) - 2000 FORMAT (A4) - IF(FOUND_LU)THEN - LUN=LUCATS - NSN=LUSEAS - PRINT *, 'LANDUSE TYPE = ',LUTYPE,' FOUND', & - LUCATS,' CATEGORIES',LUSEAS,' SEASONS', & - ' WATER CATEGORY = ',ISWATER, & - ' SNOW CATEGORY = ',ISICE - ENDIF - DO ls=1,luseas - if ( wrf_dm_on_monitor() ) then - READ (landuse_unit,*) - endif - DO LC=1,LUCATS - IF(found_lu)THEN - IF ( wrf_dm_on_monitor() ) THEN - READ (landuse_unit,*)LI,ALBD(LC,LS),SLMO(LC,LS),SFEM(LC,LS), & - SFZ0(LC,LS),THERIN(LC,LS),SCFX(LC),SFHC(LC,LS) - ENDIF - CALL wrf_dm_bcast_bytes (LI, IWORDSIZE ) - IF(LC.NE.LI)CALL wrf_error_fatal ( 'module_start: MISSING LANDUSE UNIT ' ) - ELSE - IF ( wrf_dm_on_monitor() ) THEN - READ (landuse_unit,*) - ENDIF - ENDIF - ENDDO - ENDDO - IF(NSN.EQ.1.AND.FOUND_LU) THEN - ISN = 1 - END IF - CALL wrf_dm_bcast_bytes (albd, max_cats * max_seas * RWORDSIZE ) - CALL wrf_dm_bcast_bytes (slmo, max_cats * max_seas * RWORDSIZE ) - CALL wrf_dm_bcast_bytes (sfem, max_cats * max_seas * RWORDSIZE ) - CALL wrf_dm_bcast_bytes (sfz0, max_cats * max_seas * RWORDSIZE ) - CALL wrf_dm_bcast_bytes (therin, max_cats * max_seas * RWORDSIZE ) - CALL wrf_dm_bcast_bytes (sfhc, max_cats * max_seas * RWORDSIZE ) - CALL wrf_dm_bcast_bytes (scfx, max_cats * RWORDSIZE ) - ENDIF - - IF(.NOT. found_lu .AND. .NOT. end_of_file ) GOTO 1999 -!!! END OF 1999 LOOP - - IF(.NOT. found_lu .OR. end_of_file )THEN - CALL wrf_message ( 'LANDUSE IN INPUT FILE DOES NOT MATCH LUTABLE: TABLE NOT USED' ) - ENDIF - ENDIF ! allowed_to_read - - IF(FOUND_LU)THEN -! Set arrays according to lu_index - itf = min0(ite, ide-1) - jtf = min0(jte, jde-1) - IF(usemonalb)CALL wrf_message ( 'Climatological albedo is used instead of table values' ) - DO j = jts, jtf - DO i = its, itf - IS=nint(lu_index(i,j)) - ! only do this check on read-in data - IF(IS.LT.0.OR.IS.GT.LUN.AND.allowed_to_read)THEN - WRITE ( wrf_err_message , * ) 'ERROR: LANDUSE OUTSIDE RANGE =',IS,' AT ',I,J,' LUN= ',LUN - CALL wrf_error_fatal ( TRIM ( wrf_err_message ) ) - ENDIF -! SET NO-DATA POINTS (IS=0) TO WATER - IF(IS.EQ.0)THEN - IS=ISWATER - ENDIF - IF(.NOT.usemonalb)ALBBCK(I,J)=ALBD(IS,ISN)/100. - ALBEDO(I,J)=ALBBCK(I,J) - IF(SNOWC(I,J) .GT. 0.5)ALBEDO(I,J)=ALBBCK(I,J)*(1.+SCFX(IS)) - THC(I,J)=THERIN(IS,ISN)/100. - Z0(I,J)=SFZ0(IS,ISN)/100. - ZNT(I,J)=Z0(I,J) - EMBCK(I,J)=SFEM(IS,ISN) - EMISS(I,J)=EMBCK(I,J) - MAVAIL(I,J)=SLMO(IS,ISN) - IF(IS.NE.ISWATER)THEN - XLAND(I,J)=1.0 - ELSE - XLAND(I,J)=2.0 - ENDIF -! SET SEA-ICE POINTS TO LAND WITH ICE/SNOW SURFACE PROPERTIES - XICEM(I,J)=XICE(I,J) - IF(XICE(I,J).GT.0.5)THEN - XLAND(I,J)=1.0 - ALBBCK(I,J)=ALBD(ISICE,ISN)/100. - ALBEDO(I,J)=ALBBCK(I,J) - THC(I,J)=THERIN(ISICE,ISN)/100. - Z0(I,J)=SFZ0(ISICE,ISN)/100. - ZNT(I,J)=Z0(I,J) - EMBCK(I,J)=SFEM(ISICE,ISN) - EMISS(I,J)=EMBCK(I,J) - MAVAIL(I,J)=SLMO(ISICE,ISN) - ENDIF - ENDDO - ENDDO - ENDIF - if ( wrf_dm_on_monitor() .and. allowed_to_read ) then - CLOSE (landuse_unit) - endif - CALL wrf_debug( 100 , 'returning from of landuse_init' ) - -! restore LU variables from state - curs = 1 - DO cats = 1, max_cats - lu_state(curs) = SCFX(cats) ; curs = curs + 1 - DO seas = 1, max_seas - lu_state(curs) = ALBD(cats,seas) ; curs = curs + 1 - lu_state(curs) = SLMO(cats,seas) ; curs = curs + 1 - lu_state(curs) = SFEM(cats,seas) ; curs = curs + 1 - lu_state(curs) = SFZ0(cats,seas) ; curs = curs + 1 - lu_state(curs) = SFHC(cats,seas) ; curs = curs + 1 - lu_state(curs) = THERIN(cats,seas) ; curs = curs + 1 - ENDDO - ENDDO - - RETURN - - END SUBROUTINE landuse_init - -!!!!******MARS MARS MARS -!!!!******MARS MARS MARS -!!!!******MARS MARS MARS - -!!===================================================================== -! SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW, & -! RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT, & -! levsiz,XLAT,n_ozmixm, & -! cldfra_old, & ! Optional -! ozmixm,pin, & ! Optional -! m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2, & ! Optional -! paerlev,n_aerosolc, & -! sfull,shalf,pptop,swrad_scat, & -! config_flags,restart, & -! allowed_to_read, start_of_simulation, & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -!!--------------------------------------------------------------------- -! USE module_ra_rrtm -! USE module_ra_cam -! USE module_ra_sw -! USE module_ra_gsfcsw -! USE module_ra_gfdleta -! USE module_ra_hs -! USE module_domain -!!--------------------------------------------------------------------- -! IMPLICIT NONE -!!--------------------------------------------------------------------- -! INTEGER, INTENT(IN) :: id -! TYPE (grid_config_rec_type) :: config_flags -! LOGICAL , INTENT(IN) :: restart -! LOGICAL, INTENT(IN) :: allowed_to_read -! -! INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte -! -! INTEGER , INTENT(IN) :: JULDAY,JULYR -! REAL , INTENT(IN) :: DT, RADT, cen_lat, GMT, pptop, & -! swrad_scat -! LOGICAL, INTENT(IN) :: start_of_simulation -! -! INTEGER, INTENT(IN ) :: levsiz, n_ozmixm -! INTEGER, INTENT(IN ) :: paerlev, n_aerosolc -! -! REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: XLAT -! -! REAL, DIMENSION( ims:ime, levsiz, jms:jme, n_ozmixm ), OPTIONAL, & -! INTENT(INOUT) :: OZMIXM -! -! REAL, DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(INOUT) :: m_ps_1,m_ps_2 -! REAL, DIMENSION(paerlev), OPTIONAL, INTENT(INOUT) :: m_hybi -! REAL, DIMENSION( ims:ime, paerlev, jms:jme, n_aerosolc ), OPTIONAL, & -! INTENT(INOUT) :: aerosolc_1, aerosolc_2 -! -! REAL, DIMENSION(levsiz), OPTIONAL, INTENT(INOUT) :: PIN -! -! INTEGER , INTENT(INOUT) :: STEPRA -! INTEGER :: isn -! -! REAL , DIMENSION( kms:kme ) , INTENT(IN) :: sfull, shalf -! REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & -! RTHRATEN, & -! RTHRATENLW, & -! RTHRATENSW, & -! CLDFRA -! -! REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: & -! CLDFRA_OLD -! -! REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: EMISS -! LOGICAL :: etalw = .false. -! LOGICAL :: camlw = .false. -! LOGICAL :: etamp = .false. -! integer :: month,iday -! INTEGER :: i, j, k, itf, jtf, ktf -!!--------------------------------------------------------------------- -! -! jtf=min0(jte,jde-1) -! ktf=min0(kte,kde-1) -! itf=min0(ite,ide-1) -! -!!--------------------------------------------------------------------- -! -!!-- calculate radiation time step -! -! STEPRA = nint(RADT*60./DT) -! STEPRA = max(STEPRA,1) -! -!!-- initialization -! -! IF(start_of_simulation)THEN -! DO j=jts,jtf -! DO k=kts,ktf -! DO i=its,itf -! RTHRATEN(i,k,j)=0. -! RTHRATENLW(i,k,j)=0. -! RTHRATENSW(i,k,j)=0. -! CLDFRA(i,k,j)=0. -! ENDDO -! ENDDO -! ENDDO -! -! if( present(cldfra_old) ) then -! DO j=jts,jtf -! DO k=kts,ktf -! DO i=its,itf -! cldfra_old(i,k,j) = 0. -! ENDDO -! ENDDO -! ENDDO -! end if -! ENDIF -! -!!-- find out which microphysics option is used first -! -! mp_select: SELECT CASE(config_flags%mp_physics) -! -! CASE (ETAMPNEW) -! etamp = .true. -! -! END SELECT mp_select -! -!!-- chose long wave radiation scheme -! -! lwrad_select: SELECT CASE(config_flags%ra_lw_physics) -! -! CASE (RRTMSCHEME) -! CALL rrtminit( & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! -! CASE (CAMLWSCHEME) -!#ifdef MAC_KLUDGE -! CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' ) -!#endif -! IF ( PRESENT( OZMIXM ) .AND. PRESENT( PIN ) .AND. & -! PRESENT(M_PS_1) .AND. PRESENT(M_PS_2) .AND. & -! PRESENT(M_HYBI) .AND. PRESENT(AEROSOLC_1) & -! .AND. PRESENT(AEROSOLC_2)) THEN -! CALL camradinit( & -! R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop, & -! ozmixm,pin,levsiz,XLAT,n_ozmixm, & -! m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,& -! paerlev, n_aerosolc, & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! ELSE -! CALL wrf_error_fatal ( 'arguments not present for calling cam radiation' ) -! ENDIF -! -! camlw = .true. -! -! CASE (GFDLLWSCHEME) -! CALL nl_get_start_month(id,month) -! CALL nl_get_start_day(id,iday) -! CALL gfdletainit(emiss,sfull,shalf,pptop, & -! julyr,month,iday,gmt, & -! config_flags,allowed_to_read, & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! etalw = .true. -! CASE (HELDSUAREZ) -! CALL hsinit(RTHRATEN,restart, & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! CASE DEFAULT -! -! END SELECT lwrad_select -!!-- initialize short wave radiation scheme -! -! swrad_select: SELECT CASE(config_flags%ra_sw_physics) -! -! CASE (SWRADSCHEME) -! CALL swinit( & -! swrad_scat, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! -! CASE (CAMSWSCHEME) -!#ifdef MAC_KLUDGE -! CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' ) -!#endif -! IF(.not.camlw)THEN -! CALL camradinit( & -! R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop, & -! ozmixm,pin,levsiz,XLAT,n_ozmixm, & -! m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,& -! paerlev, n_aerosolc, & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! ENDIF -! -! CASE (GSFCSWSCHEME) -! CALL gsfc_swinit(cen_lat, allowed_to_read ) -! -! CASE (GFDLSWSCHEME) -! IF(.not.etalw)THEN -! CALL nl_get_start_month(id,month) -! CALL nl_get_start_day(id,iday) -! CALL gfdletainit(emiss,sfull,shalf,pptop, & -! julyr,month,iday,gmt, & -! config_flags,allowed_to_read, & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! ENDIF -! -! CASE DEFAULT -! -! END SELECT swrad_select -! -! END SUBROUTINE ra_init -! -! SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN, & -! RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN, & -! config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS, & -! num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA, & -! SNOW,SNOWC, CANWAT,SMSTAV, & -! SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM, & -! IVGTYP,ISLTYP,SMOIS,SMFR3D,mavail, & -! SNOWH,SH2O,FNDSOILW, FNDSNOWH, & -!#if ( NMM_CORE == 1 ) -! Z0,XLAND,XICE, & -!#else -! ZNT,XLAND,XICE, & -!#endif -! SFCEVP,GRDFLX, & -! allowed_to_read, & -! start_of_simulation, & -!! num_roof_layers,num_wall_layers,num_road_layers,& !Optional urban -! DZR, DZB, DZG, & !Optional urban -! TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !Optional urban -! XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !Optional urban -! TRL_URB3D, TBL_URB3D, TGL_URB3D, & !Optional urban -! SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D, & !Optional urban -! TS_URB2D, FRC_URB2D, UTYPE_URB2D,UCMCALL, & !Optional urban -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte, & -! oml_hml0, omlcall, & !Optional oml -! TML,T0ML,HML,H0ML,HUML,HVML ) !Optional oml -!!-------------------------------------------------------------------- -! USE module_sf_sfclay -! USE module_sf_slab -! USE module_sf_pxsfclay -! USE module_bl_ysu -! USE module_bl_mrf -! USE module_bl_gfs -! USE module_bl_acm -! USE module_sf_myjsfc -! USE module_sf_noahdrv -! USE module_sf_urban -! USE module_sf_ruclsm -! USE module_sf_pxlsm -! USE module_bl_myjpbl -!#if (NMM_CORE == 1) -! USE module_sf_lsm_nmm -!#endif -!!-------------------------------------------------------------------- -! IMPLICIT NONE -!!-------------------------------------------------------------------- -! TYPE (grid_config_rec_type) :: config_flags -! LOGICAL , INTENT(IN) :: restart -! LOGICAL, INTENT(IN) :: FNDSOILW, FNDSNOWH -! -! INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte -! INTEGER , INTENT(IN) :: num_soil_layers -! INTEGER , INTENT(IN) :: UCMCALL -! -! REAL , INTENT(IN) :: DT, BLDT -! INTEGER , INTENT(INOUT) :: STEPBL -! -! REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ), & -! INTENT(OUT) :: SMFR3D -! -! REAL, DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),& -! INTENT(INOUT) :: SMOIS,SH2O,TSLB -! -! REAL, DIMENSION( ims:ime, jms:jme ) , & -! INTENT(INOUT) :: SNOW, & -! SNOWH, & -! SNOWC, & -! CANWAT, & -! MAVAIL, & -! SMSTAV, & -! SMSTOT, & -! SFCRUNOFF, & -! UDRUNOFF, & -! ACSNOW, & -! VEGFRA, & -! ACSNOM, & -! SFCEVP, & -! GRDFLX, & -! UST, & -!#if ( NMM_CORE == 1 ) -! Z0, & -!#else -! ZNT, & -!#endif -! XLAND, & -! XICE -! -! INTEGER, DIMENSION( ims:ime, jms:jme ) , & -! INTENT(INOUT) :: IVGTYP, & -! ISLTYP, & -! LOWLYR -! -! -! REAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: ZS,DZS -! -! REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & -! RUBLTEN, & -! RVBLTEN, & -! EXCH_H, & -! RTHBLTEN, & -! RQVBLTEN, & -! RQCBLTEN, & -! RQIBLTEN, & -! TKE_MYJ -! -! REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: TSK -! REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: TMN -! LOGICAL, INTENT(IN) :: allowed_to_read -! INTEGER :: isn, isfc -! -!!URBAN -!! REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR !Optional urban -!! REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB !Optional urban -!! REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG !Optional urban -! REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR !Optional urban -! REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB !Optional urban -! REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !Optional urban -! INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !Optional urban -!! REAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban -!! REAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban -!! REAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban -! REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban -! -!! Optional OML variables -! REAL, DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(INOUT) :: & -! TML,T0ML,HML,H0ML,HUML,HVML -! INTEGER, OPTIONAL, INTENT(IN) :: omlcall -! REAL, OPTIONAL, INTENT(IN) :: oml_hml0 -! LOGICAL, INTENT(IN) :: start_of_simulation -! -!!-- calculate pbl time step -! -! STEPBL = nint(BLDT*60./DT) -! STEPBL = max(STEPBL,1) -! -! -!!-- initialize surface layer scheme -! -! sfclay_select: SELECT CASE(config_flags%sf_sfclay_physics) -! -! CASE (SFCLAYSCHEME) -! CALL sfclayinit( allowed_to_read ) -! isfc = 1 -! CASE (PXSFCSCHEME) -! CALL pxsfclayinit( allowed_to_read ) -! isfc = 1 -! CASE (MYJSFCSCHEME) -! CALL myjsfcinit(LOWLYR,UST, & -!#if ( NMM_CORE == 1 ) -! Z0, & -!#else -! ZNT, & -!#endif -! XLAND,XICE, & -! IVGTYP,restart, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! isfc = 2 -! -! CASE (GFSSFCSCHEME) -! CALL myjsfcinit(LOWLYR,UST, & -!#if ( NMM_CORE == 1 ) -! Z0, & -!#else -! ZNT, & -!#endif -! XLAND,XICE, & -! IVGTYP,restart, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! isfc = 1 -! -! CASE DEFAULT -! -! END SELECT sfclay_select -! -! -!!-- initialize surface scheme -! -! sfc_select: SELECT CASE(config_flags%sf_surface_physics) -! -! CASE (SLABSCHEME) -! -! CALL slabinit(TSK,TMN, & -! TSLB,ZS,DZS,num_soil_layers, & -! allowed_to_read ,start_of_simulation ,& -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte, & -! oml_hml0, omlcall, & -! tml, t0ml, hml, h0ml, huml, hvml ) -! -!#if (NMM_CORE == 1) -! CASE (NMMLSMSCHEME) -! CALL nmmlsminit(isn,XICE,VEGFRA,SNOW,SNOWC, CANWAT,SMSTAV, & -! SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW, & -! ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,DZS,SFCEVP, & -! TMN, & -! num_soil_layers, & -! allowed_to_read , & -! ids,ide, jds,jde, kds,kde, & -! ims,ime, jms,jme, kms,kme, & -! its,ite, jts,jte, kts,kte ) -!#endif -! CASE (LSMSCHEME) -! CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV, & -! SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW, & -! ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, & -! FNDSOILW, FNDSNOWH, & -! num_soil_layers, restart, & -! allowed_to_read , & -! ids,ide, jds,jde, kds,kde, & -! ims,ime, jms,jme, kms,kme, & -! its,ite, jts,jte, kts,kte ) -! -!!URBAN -! IF(UCMCALL.eq.1) THEN -! -! IF ( PRESENT( FRC_URB2D ) .AND. PRESENT( UTYPE_URB2D )) THEN -! -! CALL urban_param_init(DZR,DZB,DZG,num_soil_layers & !urban -! ) -!! num_roof_layers,num_wall_layers,road_soil_layers) !urban -! CALL urban_var_init(TSK,TSLB,TMN,IVGTYP, & !urban -! ims,ime,jms,jme,num_soil_layers, & !urban -!! num_roof_layers,num_wall_layers,num_road_layers, & !urban -! restart, & !urban -! XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D, & !urban -! TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D, & !urban -! TRL_URB3D,TBL_URB3D,TGL_URB3D, & !urban -! SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D, TS_URB2D, & ! urban -! FRC_URB2D, UTYPE_URB2D) !urban -! ELSE -! CALL wrf_error_fatal ( 'arguments not present for calling urban model' ) -! ENDIF -! ENDIF -! -! -! CASE (RUCLSMSCHEME) -!! if(isfc .ne. 2)CALL wrf_error_fatal & -!! ( 'module_physics_init: use myjsfc and myjpbl scheme for this lsm option' ) -! CALL lsmrucinit( SMFR3D,TSLB,SMOIS,ISLTYP,mavail, & -! num_soil_layers, restart, & -! allowed_to_read , & -! ids,ide, jds,jde, kds,kde, & -! ims,ime, jms,jme, kms,kme, & -! its,ite, jts,jte, kts,kte ) -! -! CASE (PXLSMSCHEME) -! CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV, & -! SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW, & -! ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, & -! FNDSOILW, FNDSNOWH, & -! num_soil_layers, restart, & -! allowed_to_read , & -! ids,ide, jds,jde, kds,kde, & -! ims,ime, jms,jme, kms,kme, & -! its,ite, jts,jte, kts,kte ) -! -! CASE DEFAULT -! -! END SELECT sfc_select -! -! -!!-- initialize pbl scheme -! -! pbl_select: SELECT CASE(config_flags%bl_pbl_physics) -! -! CASE (YSUSCHEME) -! if(isfc .ne. 1)CALL wrf_error_fatal & -! ( 'module_physics_init: use sfclay scheme for this pbl option' ) -! CALL ysuinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & -! RQCBLTEN,RQIBLTEN,P_QI, & -! PARAM_FIRST_SCALAR, & -! restart, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! CASE (MRFSCHEME) -! if(isfc .ne. 1)CALL wrf_error_fatal & -! ( 'module_physics_init: use sfclay scheme for this pbl option' ) -! CALL mrfinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & -! RQCBLTEN,RQIBLTEN,P_QI, & -! PARAM_FIRST_SCALAR, & -! restart, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! CASE (ACMPBLSCHEME) -! if(isfc .ne. 1)CALL wrf_error_fatal & -! ( 'module_physics_init: use sfclay scheme for this pbl option' ) -! CALL acminit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & -! RQCBLTEN,RQIBLTEN,P_QI, & -! PARAM_FIRST_SCALAR, & -! restart, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! CASE (GFSSCHEME) -! if(isfc .ne. 1)CALL wrf_error_fatal & -! ( 'module_physics_init: use sfclay scheme for this pbl option' ) -! CALL gfsinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & -! RQCBLTEN,RQIBLTEN,P_QI, & -! PARAM_FIRST_SCALAR, & -! restart, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! CASE (MYJPBLSCHEME) -! if(isfc .ne. 2)CALL wrf_error_fatal & -! ( 'module_physics_init: use myjsfc scheme for this pbl option' ) -! CALL myjpblinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, & -! TKE_MYJ,EXCH_H,restart, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! CASE DEFAULT -! -! END SELECT pbl_select -! -! END SUBROUTINE bl_init -! -!!================================================================== -! SUBROUTINE cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN, & -! RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC, & -! RAINCV,W0AVG,config_flags,restart, & -! CLDEFI,LOWLYR,MASS_FLUX, & -! RTHFTEN, RQVFTEN, & -! APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & -! APR_CAPMA,APR_CAPME,APR_CAPMI, & -! cugd_tten,cugd_ttens,cugd_qvten, & -! cugd_qvtens,cugd_qcten, & -! allowed_to_read, start_of_simulation, & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -!!------------------------------------------------------------------ -! USE module_cu_kf -! USE module_cu_kfeta -! USE MODULE_CU_BMJ -! USE module_cu_gd, ONLY : GDINIT -! USE module_cu_g3, ONLY : G3INIT -! USE module_cu_sas -!!------------------------------------------------------------------ -! IMPLICIT NONE -!!------------------------------------------------------------------ -! TYPE (grid_config_rec_type) :: config_flags -! LOGICAL , INTENT(IN) :: restart -! -! -! INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte -! -! REAL , INTENT(IN) :: DT, CUDT -! LOGICAL , INTENT(IN) :: start_of_simulation -! LOGICAL , INTENT(IN) :: allowed_to_read -! INTEGER , INTENT(INOUT) :: STEPCU -! -! REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: & -! RTHCUTEN, RQVCUTEN, RQCCUTEN, RQRCUTEN, RQICUTEN, RQSCUTEN -! REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(INOUT) :: & -! cugd_tten,cugd_ttens,cugd_qvten, & -! cugd_qvtens,cugd_qcten -! -! REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG -! -! REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & -! RTHFTEN, RQVFTEN -! -! REAL , DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: RAINC, RAINCV -! -! REAL , DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: CLDEFI -! -! REAL , DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: NCA -! -! REAL , DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MASS_FLUX, & -! APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & -! APR_CAPMA,APR_CAPME,APR_CAPMI -! -! INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: LOWLYR -! -!! LOCAL VAR -! -! INTEGER :: i,j,itf,jtf -! -!!-------------------------------------------------------------------- -! -!!-- calculate cumulus parameterization time step -! -! itf=min0(ite,ide-1) -! jtf=min0(jte,jde-1) -!! -! STEPCU = nint(CUDT*60./DT) -! STEPCU = max(STEPCU,1) -! -!!-- initialization -! -! IF(start_of_simulation)THEN -! DO j=jts,jtf -! DO i=its,itf -! RAINC(i,j)=0. -! RAINCV(i,j)=0. -! ENDDO -! ENDDO -! ENDIF -! -! cps_select: SELECT CASE(config_flags%cu_physics) -! -! CASE (KFSCHEME) -! CALL kfinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & -! RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS, & -! PARAM_FIRST_SCALAR,restart, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! -! CASE (BMJSCHEME) -! CALL bmjinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & -! CLDEFI,LOWLYR,cp,r_d,restart, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! -! CASE (KFETASCHEME) -! CALL kf_eta_init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN, & -! RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS, & -! SVP1,SVP2,SVP3,SVPT0, & -! PARAM_FIRST_SCALAR,restart, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! CASE (GDSCHEME) -! CALL gdinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, & -! MASS_FLUX,cp,restart, & -! P_QC,P_QI,PARAM_FIRST_SCALAR, & -! RTHFTEN, RQVFTEN, & -! APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & -! APR_CAPMA,APR_CAPME,APR_CAPMI, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -!#if ( EM_CORE == 1 ) -! CASE (G3SCHEME) -! CALL g3init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, & -! MASS_FLUX,cp,restart, & -! P_QC,P_QI,PARAM_FIRST_SCALAR, & -! RTHFTEN, RQVFTEN, & -! APR_GR,APR_W,APR_MC,APR_ST,APR_AS, & -! APR_CAPMA,APR_CAPME,APR_CAPMI, & -! cugd_tten,cugd_ttens,cugd_qvten, & -! cugd_qvtens,cugd_qcten, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -!#endif -! CASE (SASSCHEME) -! CALL sasinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, & -! restart,P_QC,P_QI,PARAM_FIRST_SCALAR, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! -! CASE DEFAULT -! -! END SELECT cps_select -! -! END SUBROUTINE cu_init -! -!!================================================================== -! SUBROUTINE mp_init(RAINNC,config_flags,restart,warm_rain, & -! adv_moist_cond, & -! MPDT, DT, DX, DY, LOWLYR, & ! for eta mp -! F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & ! for eta mp -! mp_restart_state,tbpvs_state,tbpvs0_state, & ! eta mp -! allowed_to_read, start_of_simulation, & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -!!------------------------------------------------------------------ -! USE module_mp_wsm3 -! USE module_mp_wsm5 -! USE module_mp_wsm6 -! USE module_mp_etanew -! USE module_mp_thompson -! USE module_mp_morr_two_moment -!!------------------------------------------------------------------ -! IMPLICIT NONE -!!------------------------------------------------------------------ -!! Arguments -! TYPE (grid_config_rec_type) :: config_flags -! LOGICAL , INTENT(IN) :: restart -! LOGICAL , INTENT(OUT) :: warm_rain,adv_moist_cond -! REAL , INTENT(IN) :: MPDT, DT, DX, DY -! LOGICAL , INTENT(IN) :: start_of_simulation -! -! INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte -! -! INTEGER , DIMENSION( ims:ime , jms:jme ) ,INTENT(INOUT) :: LOWLYR -! REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: RAINNC -! REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: & -! F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY -! REAL , DIMENSION(:) ,INTENT(INOUT) :: mp_restart_state,tbpvs_state,tbpvs0_state -! LOGICAL , INTENT(IN) :: allowed_to_read -! -!! Local -! INTEGER :: i, j, itf, jtf -! -! warm_rain = .false. -! adv_moist_cond = .true. -! itf=min0(ite,ide-1) -! jtf=min0(jte,jde-1) -! -! IF(start_of_simulation)THEN -! DO j=jts,jtf -! DO i=its,itf -! RAINNC(i,j) = 0. -! ENDDO -! ENDDO -! ENDIF -! -! mp_select: SELECT CASE(config_flags%mp_physics) -! -! CASE (KESSLERSCHEME) -! warm_rain = .true. -! CASE (WSM3SCHEME) -! CALL wsm3init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read ) -! CASE (WSM5SCHEME) -! CALL wsm5init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read ) -! CASE (WSM6SCHEME) -! CALL wsm6init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read ) -! CASE (ETAMPNEW) -! adv_moist_cond = .false. -! CALL etanewinit (MPDT,DT,DX,DY,LOWLYR,restart, & -! F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY, & -! mp_restart_state,tbpvs_state,tbpvs0_state,& -! allowed_to_read, & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! CASE (THOMPSON) -! CALL thompson_init -! CASE (MORR_TWO_MOMENT) -! CALL morr_two_moment_init -! -! CASE DEFAULT -! -! END SELECT mp_select -! -! END SUBROUTINE mp_init -! -!#if ( EM_CORE == 1 ) -!!========================================================== -! SUBROUTINE fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN, & -! RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN, & -! config_flags,restart, & -! allowed_to_read , & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! -! -!!-------------------------------------------------------------------- -! USE module_fdda_psufddagd -!!-------------------------------------------------------------------- -! IMPLICIT NONE -!!-------------------------------------------------------------------- -! TYPE (grid_config_rec_type) :: config_flags -! LOGICAL , INTENT(IN) :: restart -! -! INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte -! -! REAL , INTENT(IN) :: DT, FGDT -! INTEGER , INTENT(IN) :: id -! INTEGER , INTENT(INOUT) :: STEPFG -! REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: & -! RUNDGDTEN, & -! RVNDGDTEN, & -! RTHNDGDTEN, & -! RQVNDGDTEN -! REAL, DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: RMUNDGDTEN -! -! LOGICAL, INTENT(IN) :: allowed_to_read -!!-------------------------------------------------------------------- -! -!!-- calculate pbl time step -! -! STEPFG = nint(FGDT*60./DT) -! STEPFG = max(STEPFG,1) -! -! -!!-- initialize fdda scheme -! -! fdda_select: SELECT CASE(config_flags%grid_fdda) -! -! CASE (PSUFDDAGD) -! CALL fddagdinit(id,rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten,& -! config_flags%run_hours, & -! config_flags%if_no_pbl_nudging_uv, & -! config_flags%if_no_pbl_nudging_t, & -! config_flags%if_no_pbl_nudging_q, & -! config_flags%if_zfac_uv, & -! config_flags%k_zfac_uv, & -! config_flags%if_zfac_t, & -! config_flags%k_zfac_t, & -! config_flags%if_zfac_q, & -! config_flags%k_zfac_q, & -! config_flags%guv, & -! config_flags%gt, config_flags%gq, & -! config_flags%if_ramping, config_flags%dtramp_min, & -! config_flags%gfdda_end_h, & -! restart, allowed_to_read, & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! CASE DEFAULT -! -! END SELECT fdda_select -! -! END SUBROUTINE fg_init -! -!!------------------------------------------------------------------- -! SUBROUTINE fdob_init(obs_nudge_opt, maxdom, inest, parid, & -! idynin, dtramp, fdaend, restart, & -! obs_twindo_cg, obs_twindo, itimestep, & -! cen_lat, cen_lon, stand_lon, & -! true_lat1, true_lat2, map_proj, & -! xlat, xlong, & -! s_sn_cg, e_sn_cg, s_we_cg, e_we_cg, & -! fdob, ipf_init, & -! ids, ide, jds, jde, kds, kde, & -! ims, ime, jms, jme, kms, kme, & -! its, ite, jts, jte, kts, kte ) -! -!!-------------------------------------------------------------------- -! USE module_domain -! USE module_fddaobs_rtfdda -! USE module_llxy -!!-------------------------------------------------------------------- -! IMPLICIT NONE -!!-------------------------------------------------------------------- -! INTEGER , INTENT(IN) :: maxdom -! INTEGER , INTENT(IN) :: obs_nudge_opt(maxdom) -! INTEGER , INTENT(IN) :: ids,ide, jds,jde, kds,kde, & -! ims,ime, jms,jme, kms,kme, & -! its,ite, jts,jte, kts,kte -! INTEGER , INTENT(IN) :: inest -! INTEGER , INTENT(IN) :: parid(maxdom) -! INTEGER , INTENT(IN) :: idynin ! flag for dynamic initialization -! REAL , INTENT(IN) :: dtramp ! time period for ramping (idynin) -! REAL , INTENT(IN) :: fdaend(maxdom) ! nudging end time for domain (min) -! LOGICAL , INTENT(IN) :: restart -! REAL , INTENT(IN) :: obs_twindo_cg ! twindo on course grid -! REAL , INTENT(IN) :: obs_twindo -! INTEGER , INTENT(IN) :: itimestep -! REAL , INTENT(IN) :: cen_lat ! domain center latitude -! REAL , INTENT(IN) :: cen_lon ! domain center longitude -! REAL , INTENT(IN) :: stand_lon ! domain longitude -! REAL , INTENT(IN) :: true_lat1 ! domain standard parallel -! REAL , INTENT(IN) :: true_lat2 ! domain second standard parallel -! INTEGER , INTENT(IN) :: map_proj ! map projection -! REAL, DIMENSION( ims:ime, jms:jme ), & -! INTENT(IN ) :: xlat, xlong ! lat/long locations on mass point grid -! INTEGER, intent(in) :: s_sn_cg ! starting north-south coarse-grid index -! INTEGER, intent(in) :: e_sn_cg ! ending north-south coarse-grid index -! INTEGER, intent(in) :: s_we_cg ! starting west-east coarse-grid index -! INTEGER, intent(in) :: e_we_cg ! ending west-east coarse-grid index -! -! TYPE(fdob_type), INTENT(INOUT) :: fdob -! -! INTEGER :: e_sn ! ending north-south grid index -! LOGICAL :: ipf_init ! print warnings detected at initialzn -!!-------------------------------------------------------------------- -!!-- initialize fdda obs-nudging scheme -! -! IF ( obs_nudge_opt(inest) .eq. 0 ) RETURN -! -! e_sn = jde -! CALL fddaobs_init(obs_nudge_opt, maxdom, inest, parid, & -! idynin, dtramp, fdaend, restart, & -! obs_twindo_cg, & -! obs_twindo, itimestep, & -! cen_lat, cen_lon, stand_lon, & -! true_lat1, true_lat2, map_proj, & -! xlat, xlong, & -! e_sn, s_sn_cg, e_sn_cg, s_we_cg, e_we_cg, & -! fdob, ipf_init, & -! ids,ide, jds,jde, kds,kde, & -! ims,ime, jms,jme, kms,kme, & -! its,ite, jts,jte, kts,kte) -! -! END SUBROUTINE fdob_init -!#endif - -!-------------------------------------------------------------------- - SUBROUTINE z2sigma(zf,zh,sf,sh,p_top,pptop,config_flags, & - allowed_to_read , & - kds,kde,kms,kme,kts,kte) - IMPLICIT NONE -! Arguments - INTEGER, INTENT(IN) :: kds,kde,kms,kme,kts,kte - REAL , DIMENSION( kms:kme ), INTENT(IN) :: zf,zh - REAL , DIMENSION( kms:kme ), INTENT(OUT):: sf,sh - REAL , INTENT(IN) :: p_top - REAL , INTENT(OUT) :: pptop - TYPE (grid_config_rec_type) :: config_flags - LOGICAL , INTENT(IN) :: allowed_to_read -! Local - REAL R, G, TS, GAMMA, PS, ZTROP, TSTRAT, PTROP, Z, T, P, ZTOP, PTOP - INTEGER K - - IF(zf(kde/2) .GT. 1.0)THEN -! Height levels assumed (zeta coordinate) -! Convert to sigma using standard atmosphere for pressure-height relation -! constants for standard atmosphere definition - r=287.05 - g=9.80665 - ts=288.15 - gamma=-6.5/1000. - ps=1013.25 - ztrop=11000. - tstrat=ts+gamma*ztrop - ptrop=ps*(tstrat/ts)**(-g/(gamma*r)) - - do k=kde,kds,-1 -! full levels - z=zf(k) - if(z.le.ztrop)then - t=ts+gamma*z - p=ps*(t/ts)**(-g/(gamma*r)) - else - t=tstrat - p=ptrop*exp(-g*(z-ztrop)/(r*tstrat)) - endif - if(k.eq.kde)then - ztop=zf(k) - ptop=p - endif - sf(k)=(p-ptop)/(ps-ptop) -! half levels - if(k.ne.kds)then - z=0.5*(zf(k)+zf(k-1)) - if(z.le.ztrop)then - t=ts+gamma*z - p=ps*(t/ts)**(-g/(gamma*r)) - else - t=tstrat - p=ptrop*exp(-g*(z-ztrop)/(r*tstrat)) - endif - sh(k-1)=(p-ptop)/(ps-ptop) - endif - enddo - pptop=ptop/10. - ELSE -! Levels are already sigma/eta - do k=kde,kds,-1 -! sf(k)=zf(kde-k+kds) -! if(k .ne. kde)sh(k)=zh(kde-1-k+kds) - sf(k)=zf(k) - if(k .ne. kde)sh(k)=zh(k) - enddo - pptop=p_top/1000. - - ENDIF - - END SUBROUTINE z2sigma - -END MODULE module_physics_init Index: unk/WRF.COMMON/WRFV3/modif_mars/solve_em.F =================================================================== --- /trunk/WRF.COMMON/WRFV3/modif_mars/solve_em.F (revision 2760) +++ (revision ) @@ -1,3258 +1,0 @@ -!WRF:MEDIATION_LAYER:SOLVER - -SUBROUTINE solve_em ( grid , config_flags & -! Arguments generated from Registry -#include "dummy_new_args.inc" -! - ) -! Driver layer modules - USE module_state_description - USE module_domain, ONLY : domain, get_ijk_from_grid, get_ijk_from_subgrid, domain_get_current_time, domain_get_start_time - USE module_configure, ONLY : grid_config_rec_type - USE module_driver_constants - USE module_machine - USE module_tiles, ONLY : set_tiles -#ifdef DM_PARALLEL - USE module_dm, ONLY : local_communicator, mytask, ntasks, ntasks_x, ntasks_y, local_communicator_periodic, wrf_dm_maxval -#else - USE module_dm -#endif - USE module_comm_dm - USE module_utility -! Mediation layer modules -! Model layer modules - USE module_model_constants - USE module_small_step_em - USE module_em - USE module_big_step_utilities_em - USE module_bc - USE module_bc_em - USE module_solvedebug_em - USE module_physics_addtendc - USE module_diffusion_em - USE module_polarfft -!!!!****MARS MARS -!!!!****MARS MARS -! USE module_microphysics_driver -! USE module_microphysics_zero_out -! USE module_fddaobs_driver -! USE module_diagnostics -#ifdef WRF_CHEM - USE module_input_chem_data - USE module_chem_utilities -#endif - USE module_first_rk_step_part1 - USE module_first_rk_step_part2 - USE module_llxy, ONLY : proj_cassini - - IMPLICIT NONE - - ! Input data. - - TYPE(domain) , TARGET :: grid - - ! Definitions of dummy arguments to this routine (generated from Registry). -#include "dummy_new_decl.inc" - - ! Structure that contains run-time configuration (namelist) data for domain - TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags - - ! Local data - - INTEGER :: k_start , k_end, its, ite, jts, jte - INTEGER :: ids , ide , jds , jde , kds , kde , & - ims , ime , jms , jme , kms , kme , & - ips , ipe , jps , jpe , kps , kpe - - INTEGER :: sids , side , sjds , sjde , skds , skde , & - sims , sime , sjms , sjme , skms , skme , & - sips , sipe , sjps , sjpe , skps , skpe - - - INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, & - ipsx, ipex, jpsx, jpex, kpsx, kpex, & - imsy, imey, jmsy, jmey, kmsy, kmey, & - ipsy, ipey, jpsy, jpey, kpsy, kpey - - INTEGER :: ij , iteration - INTEGER :: im , num_3d_m , ic , num_3d_c , is , num_3d_s - INTEGER :: loop - INTEGER :: sz - INTEGER :: iswater - - LOGICAL :: specified_bdy, channel_bdy - - REAL :: t_new - -! storage for tendencies and decoupled state (generated from Registry) - -#include -! Previous time level of tracer arrays now defined as i1 variables; -! the state 4d arrays now redefined as 1-time level arrays in Registry. -! Benefit: save memory in nested runs, since only 1 domain is active at a -! time. Potential problem on stack-limited architectures: increases -! amount of data on program stack by making these automatic arrays. - - INTEGER :: rc - INTEGER :: number_of_small_timesteps, rk_step - INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2 ! for prints/plots only - INTEGER :: idum1, idum2, dynamics_option - - INTEGER :: rk_order, iwmax, jwmax, kwmax - REAL :: dt_rk, dts_rk, dts, dtm, wmax - REAL , ALLOCATABLE , DIMENSION(:) :: max_vert_cfl_tmp, max_horiz_cfl_tmp - LOGICAL :: leapfrog - INTEGER :: l,kte,kk - REAL :: curr_secs - INTEGER :: num_sound_steps - INTEGER :: idex, jdex - REAL :: max_msft - REAL :: spacing - - INTEGER :: ii, jj !kk is above after l,kte - REAL :: dclat - INTEGER :: debug_level - -! urban related variables - INTEGER :: NUM_ROOF_LAYERS, NUM_WALL_LAYERS, NUM_ROAD_LAYERS ! urban - - TYPE(WRFU_TimeInterval) :: tmpTimeInterval - REAL :: real_time - LOGICAL :: adapt_step_flag - -! Define benchmarking timers if -DBENCH is compiled -#include - -!---------------------- -! Executable statements -!---------------------- - -! -!
-! solve_em is the main driver for advancing a grid a single timestep.
-! It is a mediation-layer routine -> DM and SM calls are made where 
-! needed for parallel processing.  
-!
-! solve_em can integrate the equations using 3 time-integration methods
-!      
-!    - 3rd order Runge-Kutta time integration (recommended)
-!      
-!    - 2nd order Runge-Kutta time integration
-!      
-! The main sections of solve_em are
-!     
-! (1) Runge-Kutta (RK) loop
-!     
-! (2) Non-timesplit physics (i.e., tendencies computed for updating
-!     model state variables during the first RK sub-step (loop)
-!     
-! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
-!     
-! (4) scalar advance for moist and chem scalar variables (and TKE)
-!     within the RK sub-steps.
-!     
-! (5) time-split physics (after the RK step), currently this includes
-!     only microphyics
-!
-! A more detailed description of these sections follows.
-!
-! - -! Initialize timers if compiled with -DBENCH -#include - -! set runge-kutta solver (2nd or 3rd order) - - dynamics_option = config_flags%rk_ord - -! Obtain dimension information stored in the grid data structure. - - CALL get_ijk_from_grid ( grid , & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - imsx, imex, jmsx, jmex, kmsx, kmex, & - ipsx, ipex, jpsx, jpex, kpsx, kpex, & - imsy, imey, jmsy, jmey, kmsy, kmey, & - ipsy, ipey, jpsy, jpey, kpsy, kpey ) - - CALL get_ijk_from_subgrid ( grid , & - sids, side, sjds, sjde, skds, skde, & - sims, sime, sjms, sjme, skms, skme, & - sips, sipe, sjps, sjpe, skps, skpe ) - k_start = kps - k_end = kpe - - num_3d_m = num_moist - num_3d_c = num_chem - num_3d_s = num_scalar - - -! Compute these starting and stopping locations for each tile and number of tiles. -! See: http://www.mmm.ucar.edu/wrf/WG2/topics/settiles - CALL set_tiles ( grid , ids , ide , jds , jde , ips , ipe , jps , jpe ) - -! Max values of CFL for adaptive time step scheme - - ALLOCATE (max_vert_cfl_tmp(grid%num_tiles)) - ALLOCATE (max_horiz_cfl_tmp(grid%num_tiles)) - - grid%itimestep = grid%itimestep + 1 - - IF (config_flags%polar) dclat = 90./REAL(jde-jds) !(0.5 * 180/ny) - -!********************************************************************** -! -! LET US BEGIN....... -! -! -!
-! (1) RK integration loop is named the "Runge_Kutta_loop:"
-!
-!   Predictor-corrector type time integration.
-!   Advection terms are evaluated at time t for the predictor step,
-!   and advection is re-evaluated with the latest predicted value for
-!   each succeeding time corrector step
-!
-!   2nd order Runge Kutta (rk_order = 2):
-!   Step 1 is taken to the midpoint predictor, step 2 is the full step.
-!
-!   3rd order Runge Kutta (rk_order = 3):
-!   Step 1 is taken to from t to dt/3, step 2 is from t to dt/2,
-!   and step 3 is from t to dt.
-!
-!   non-timesplit physics are evaluated during first RK step and
-!   these physics tendencies are stored for use in each RK pass.
-!
-! -!********************************************************************** - -#ifdef WRF_CHEM -! -! prepare chem aerosols for advection before communication -! - - kte=min(k_end,kde-1) -# ifdef DM_PARALLEL - if ( num_chem >= PARAM_FIRST_SCALAR ) then -!----------------------------------------------------------------------- -! see matching halo calls below for stencils -!-------------------------------------------------------------- - CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' ) - IF ( config_flags%h_mom_adv_order <= 4 ) THEN -# include "HALO_EM_CHEM_E_3.inc" - IF( config_flags%progn > 0 ) THEN -# include "HALO_EM_SCALAR_E_3.inc" - ENDIF - ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN -# include "HALO_EM_CHEM_E_5.inc" - IF( config_flags%progn > 0 ) THEN -# include "HALO_EM_SCALAR_E_5.inc" - ENDIF - ELSE - WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order - CALL wrf_error_fatal(TRIM(wrf_err_message)) - ENDIF - ENDIF -# endif -!-------------------------------------------------------------- -#endif - - rk_order = config_flags%rk_ord - - - ! - ! Calculate current time in seconds since beginning of model run. - ! Unfortunately, ESMF does not seem to have a way to return - ! floating point seconds based on a TimeInterval. So, we will - ! calculate it here--but, this is not clean!! - ! - tmpTimeInterval = domain_get_current_time ( grid ) - domain_get_start_time ( grid ) - curr_secs = real_time(tmpTimeInterval) - -!----------------------------------------------------------------------------- -! Adaptive time step: Added by T. Hutchinson, WSI 3/5/07 -! In this call, we do the time-step adaptation and set time-dependent lateral -! boundary condition nudging weights. -! - IF (config_flags%use_adaptive_time_step) THEN - CALL adapt_timestep(grid, config_flags) - adapt_step_flag = .TRUE. - ELSE - adapt_step_flag = .FALSE. - ENDIF -! End of adaptive time step modifications -!----------------------------------------------------------------------------- - - IF ( grid%time_step_sound == 0 ) THEN -! This function will give 4 for 6*dx and 6 for 10*dx and returns even numbers only - spacing = min(grid%dx, grid%dy) - IF ( ( config_flags%use_adaptive_time_step ) .AND. ( config_flags%map_proj == PROJ_CASSINI ) ) THEN - max_msft=MIN ( MAX(grid%max_msftx, grid%max_msfty) , & - 1.0/COS(config_flags%fft_filter_lat*degrad) ) - num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 ) - ELSE IF ( config_flags%use_adaptive_time_step ) THEN - max_msft= MAX(grid%max_msftx, grid%max_msfty) - num_sound_steps = max ( 2 * ( INT (300. * grid%dt / (spacing / max_msft) - 0.01 ) + 1 ), 4 ) - ELSE - num_sound_steps = max ( 2 * ( INT (300. * grid%dt / spacing - 0.01 ) + 1 ), 4 ) - END IF - WRITE(wrf_err_message,*)'grid spacing, dt, time_step_sound=',spacing,grid%dt,num_sound_steps - CALL wrf_debug ( 50 , wrf_err_message ) - ELSE - num_sound_steps = grid%time_step_sound - ENDIF - - IF (config_flags%use_adaptive_time_step) THEN - - CALL get_wrf_debug_level( debug_level ) - IF ((config_flags%time_step < 0) .AND. (debug_level.GE.50)) THEN -#ifdef DM_PARALLEL - CALL wrf_dm_maxval(grid%max_vert_cfl, idex, jdex) -#endif - WRITE(wrf_err_message,*)'variable dt, max horiz cfl, max vert cfl: ',& - grid%dt, grid%max_horiz_cfl, grid%max_vert_cfl - CALL wrf_debug ( 0 , wrf_err_message ) - ENDIF - - grid%max_cfl_val = 0 - grid%max_horiz_cfl = 0 - grid%max_vert_cfl = 0 - ENDIF - - dts = grid%dt/float(num_sound_steps) - - Runge_Kutta_loop: DO rk_step = 1, rk_order - - ! Set the step size and number of small timesteps for - ! each part of the timestep - - dtm = grid%dt - IF ( rk_order == 1 ) THEN - - write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option - CALL wrf_error_fatal( wrf_err_message ) - - ELSE IF ( rk_order == 2 ) THEN ! 2nd order Runge-Kutta timestep - - IF ( rk_step == 1) THEN - dt_rk = 0.5*grid%dt - dts_rk = dts - number_of_small_timesteps = num_sound_steps/2 - ELSE - dt_rk = grid%dt - dts_rk = dts - number_of_small_timesteps = num_sound_steps - ENDIF - - ELSE IF ( rk_order == 3 ) THEN ! third order Runge-Kutta - - IF ( rk_step == 1) THEN - dt_rk = grid%dt/3. - dts_rk = dt_rk - number_of_small_timesteps = 1 - ELSE IF (rk_step == 2) THEN - dt_rk = 0.5*grid%dt - dts_rk = dts - number_of_small_timesteps = num_sound_steps/2 - ELSE - dt_rk = grid%dt - dts_rk = dts - number_of_small_timesteps = num_sound_steps - ENDIF - - ELSE - - write(wrf_err_message,*)' unknown solver, error exit for dynamics_option = ',dynamics_option - CALL wrf_error_fatal( wrf_err_message ) - - END IF - -! Ensure that polar meridional velocity is zero - IF (config_flags%polar) THEN - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - DO ij = 1 , grid%num_tiles - CALL zero_pole ( grid%v_1, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start, k_end ) - CALL zero_pole ( grid%v_2, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start, k_end ) - END DO - !$OMP END PARALLEL DO - END IF -! -! Time level t is in the *_2 variable in the first part -! of the step, and in the *_1 variable after the predictor. -! the latest predicted values are stored in the *_2 variables. -! - CALL wrf_debug ( 200 , ' call rk_step_prep ' ) - -BENCH_START(step_prep_tim) - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij ) - - DO ij = 1 , grid%num_tiles - - CALL rk_step_prep ( config_flags, rk_step, & - grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2, grid%mu_2, & - moist, & - grid%ru, grid%rv, grid%rw, grid%ww, grid%php, grid%alt, grid%muu, grid%muv, & - grid%mub, grid%mut, grid%phb, grid%pb, grid%p, grid%al, grid%alb, & - cqu, cqv, cqw, & - grid%msfux, grid%msfuy, grid%msfvx, grid%msfvx_inv, & - grid%msfvy, grid%msftx, grid%msfty, & - grid%fnm, grid%fnp, grid%dnw, grid%rdx, grid%rdy, & - num_3d_m, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start, k_end ) - - END DO - !$OMP END PARALLEL DO -BENCH_END(step_prep_tim) - -#ifdef DM_PARALLEL -!----------------------------------------------------------------------- -! Stencils for patch communications (WCS, 29 June 2001) -! Note: the small size of this halo exchange reflects the -! fact that we are carrying the uncoupled variables -! as state variables in the mass coordinate model, as -! opposed to the coupled variables as in the height -! coordinate model. -! -! * * * * * -! * * * * * * * * * -! * + * * + * * * + * * -! * * * * * * * * * -! * * * * * -! -! 3D variables - note staggering! ru(X), rv(Y), ww(Z), php(Z) -! -! ru x -! rv x -! ww x -! php x -! alt x -! ph_2 x -! phb x -! -! the following are 2D (xy) variables -! -! muu x -! muv x -! mut x -!-------------------------------------------------------------- -# include "HALO_EM_A.inc" -#endif - -! set boundary conditions on variables -! from big_step_prep for use in big_step_proc - -#ifdef DM_PARALLEL -# include "PERIOD_BDY_EM_A.inc" -#endif - -BENCH_START(set_phys_bc_tim) - !$OMP PARALLEL DO & - !$OMP PRIVATE ( ij, ii, jj, kk ) - - DO ij = 1 , grid%num_tiles - - CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' ) - - CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww, & - grid%muu, grid%muv, grid%mut, grid%php, grid%alt, grid%p, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start, k_end ) - CALL set_physical_bc3d( grid%al, 'p', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start , k_end ) - CALL set_physical_bc3d( grid%ph_2, 'w', config_flags, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start, k_end ) - - IF (config_flags%polar) THEN - -!------------------------------------------------------- -! lat-lon grid pole-point (v) specification (extrapolate v, rv to the pole) -!------------------------------------------------------- - - CALL pole_point_bc ( grid%v_1, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start, k_end ) - - CALL pole_point_bc ( grid%v_2, & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - grid%i_start(ij), grid%i_end(ij), & - grid%j_start(ij), grid%j_end(ij), & - k_start, k_end ) - -!------------------------------------------------------- -! end lat-lon grid pole-point (v) specification -!------------------------------------------------------- - - ENDIF - END DO - !$OMP END PARALLEL DO -BENCH_END(set_phys_bc_tim) - - rk_step_is_one : IF (rk_step == 1) THEN ! only need to initialize diffusion tendencies - -! -!
-!(2) The non-timesplit physics begins with a call to "phy_prep"
-!    (which computes some diagnostic variables such as temperature,
-!    pressure, u and v at p points, etc).  This is followed by
-!    calls to the physics drivers:
-!
-!              radiation,
-!              surface,
-!              pbl,
-!              cumulus,
-!              fddagd,
-!              3D TKE and mixing.
-!
-!
-
-       CALL first_rk_step_part1 (    grid, config_flags         &
-                             , moist , moist_tend               &
-                             , chem  , chem_tend                &
-                             , scalar , scalar_tend             &
-                             , fdda3d, fdda2d                   &
-                             , ru_tendf, rv_tendf               &
-                             , rw_tendf, t_tendf                &
-                             , ph_tendf, mu_tendf               &
-                             , tke_tend                         &
-                             , adapt_step_flag , curr_secs      &
-                             , psim , psih , wspd , gz1oz0      &
-                             , br , chklowq                     &
-                             , cu_act_flag , hol , th_phy       &
-                             , pi_phy , p_phy , t_phy           &
-                             , u_phy , v_phy                    &
-                             , dz8w , p8w , t8w , rho_phy , rho &
-                             , z_at_w , mu_3d                   &
-                             , ids, ide, jds, jde, kds, kde     &
-                             , ims, ime, jms, jme, kms, kme     &
-                             , ips, ipe, jps, jpe, kps, kpe     &
-                             , k_start , k_end                  &
-                            )
-
-       CALL first_rk_step_part2 (    grid, config_flags         &
-                             , moist , moist_tend               &
-                             , chem  , chem_tend                &
-                             , scalar , scalar_tend             &
-                             , fdda3d, fdda2d                   &
-                             , ru_tendf, rv_tendf               &
-                             , rw_tendf, t_tendf                &
-                             , ph_tendf, mu_tendf               &
-                             , tke_tend                         &
-                             , adapt_step_flag , curr_secs      &
-                             , psim , psih , wspd , gz1oz0      &
-                             , br , chklowq                     &
-                             , cu_act_flag , hol , th_phy       &
-                             , pi_phy , p_phy , t_phy           &
-                             , u_phy , v_phy                    &
-                             , dz8w , p8w , t8w , rho_phy , rho &
-                             , z_at_w , mu_3d                   &
-                             , ids, ide, jds, jde, kds, kde     &
-                             , ims, ime, jms, jme, kms, kme     &
-                             , ips, ipe, jps, jpe, kps, kpe     &
-                             , k_start , k_end                  &
-                            )
-
-     END IF rk_step_is_one
-
-BENCH_START(rk_tend_tim)
-     !$OMP PARALLEL DO   &
-     !$OMP PRIVATE ( ij )
-     DO ij = 1 , grid%num_tiles
-
-       CALL wrf_debug ( 200 , ' call rk_tendency' )
-       CALL rk_tendency ( config_flags, rk_step                                                                &
-                         ,grid%ru_tend, grid%rv_tend, rw_tend, ph_tend, t_tend                                 &
-                         ,ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf                                      &
-                         ,mu_tend, grid%u_save, grid%v_save, w_save, ph_save                                   &
-                         ,grid%t_save, mu_save, grid%rthften                                                   &
-                         ,grid%ru, grid%rv, grid%rw, grid%ww                                                   &
-                         ,grid%u_2, grid%v_2, grid%w_2, grid%t_2, grid%ph_2                                    &
-                         ,grid%u_1, grid%v_1, grid%w_1, grid%t_1, grid%ph_1                                    &
-                         ,grid%h_diabatic, grid%phb, grid%t_init                                               &
-                         ,grid%mu_2, grid%mut, grid%muu, grid%muv, grid%mub                                    &
-                         ,grid%al, grid%alt, grid%p, grid%pb, grid%php, cqu, cqv, cqw                          &
-                         ,grid%u_base, grid%v_base, grid%t_base, grid%qv_base, grid%z_base                     &
-                         ,grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv                                    &
-                         ,grid%msfvy, grid%msftx,grid%msfty, grid%xlat, grid%f, grid%e, grid%sina, grid%cosa   &
-                         ,grid%fnm, grid%fnp, grid%rdn, grid%rdnw                                              &
-                         ,grid%dt, grid%rdx, grid%rdy, grid%khdif, grid%kvdif, grid%xkmh, grid%xkhh            &
-                         ,grid%diff_6th_opt, grid%diff_6th_factor                                              &
-                         ,grid%dampcoef,grid%zdamp,config_flags%damp_opt                                       &
-                         ,grid%cf1, grid%cf2, grid%cf3, grid%cfn, grid%cfn1, num_3d_m                          &
-                         ,config_flags%non_hydrostatic, config_flags%top_lid                                   &
-                         ,grid%u_frame, grid%v_frame                                                           &
-                         ,ids, ide, jds, jde, kds, kde                                                         &
-                         ,ims, ime, jms, jme, kms, kme                                                         &
-                         ,grid%i_start(ij), grid%i_end(ij)                                                     &
-                         ,grid%j_start(ij), grid%j_end(ij)                                                     &
-                         ,k_start, k_end                                                                       &
-                         ,max_vert_cfl_tmp(ij), max_horiz_cfl_tmp(ij)                                         )
-     END DO
-     !$OMP END PARALLEL DO
-BENCH_END(rk_tend_tim)
-
-     IF (config_flags%use_adaptive_time_step) THEN
-       DO ij = 1 , grid%num_tiles
-         IF (max_horiz_cfl_tmp(ij) .GT. grid%max_horiz_cfl) THEN
-           grid%max_horiz_cfl = max_horiz_cfl_tmp(ij)
-         ENDIF
-         IF (max_vert_cfl_tmp(ij) .GT. grid%max_vert_cfl) THEN
-           grid%max_vert_cfl = max_vert_cfl_tmp(ij)
-         ENDIF
-       END DO
-     
-       IF (grid%max_horiz_cfl .GT. grid%max_cfl_val) THEN
-         grid%max_cfl_val = grid%max_horiz_cfl
-       ENDIF
-       IF (grid%max_vert_cfl .GT. grid%max_cfl_val) THEN
-         grid%max_cfl_val = grid%max_vert_cfl
-       ENDIF
-     ENDIF
-
-BENCH_START(relax_bdy_dry_tim)
-     !$OMP PARALLEL DO   &
-     !$OMP PRIVATE ( ij )
-     DO ij = 1 , grid%num_tiles
-
-       IF( (config_flags%specified .or. config_flags%nested) .and. rk_step == 1 ) THEN 
-
-         CALL relax_bdy_dry ( config_flags,                                &
-                              grid%u_save, grid%v_save, ph_save, grid%t_save,             &
-                              w_save, mu_tend,                             & 
-                              grid%ru, grid%rv, grid%ph_2, grid%t_2,                           &
-                              grid%w_2, grid%mu_2, grid%mut,                              &
-                              grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
-                              grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
-                              grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
-                              grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
-                              grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
-                              grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
-                              grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
-                              grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
-                              grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
-                              grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
-                              grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
-                              grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
-                              config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone,       &
-                              grid%dtbc, grid%fcx, grid%gcx,                              &
-                              ids,ide, jds,jde, kds,kde,                   &
-                              ims,ime, jms,jme, kms,kme,                   &
-                              ips,ipe, jps,jpe, kps,kpe,                   &
-                              grid%i_start(ij), grid%i_end(ij),            &
-                              grid%j_start(ij), grid%j_end(ij),            &
-                              k_start, k_end                              )
-
-       ENDIF
-
-       CALL rk_addtend_dry( grid%ru_tend,  grid%rv_tend,  rw_tend,  ph_tend,  t_tend,  &
-                            ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
-                            grid%u_save, grid%v_save, w_save, ph_save, grid%t_save, &
-                            mu_tend, mu_tendf, rk_step,                      &
-                            grid%h_diabatic, grid%mut, grid%msftx,        &
-                            grid%msfty, grid%msfux,grid%msfuy,               &
-                            grid%msfvx, grid%msfvx_inv, grid%msfvy,          &
-                            ids,ide, jds,jde, kds,kde,                       &
-                            ims,ime, jms,jme, kms,kme,                       &
-                            ips,ipe, jps,jpe, kps,kpe,                       &
-                            grid%i_start(ij), grid%i_end(ij),                &
-                            grid%j_start(ij), grid%j_end(ij),                &
-                            k_start, k_end                                  )
-
-       IF( config_flags%specified .or. config_flags%nested ) THEN 
-         CALL spec_bdy_dry ( config_flags,                                    &
-                             grid%ru_tend, grid%rv_tend, ph_tend, t_tend,               &
-                             rw_tend, mu_tend,                                &
-                             grid%u_bxs,grid%u_bxe,grid%u_bys,grid%u_bye, &
-                             grid%v_bxs,grid%v_bxe,grid%v_bys,grid%v_bye, &
-                             grid%ph_bxs,grid%ph_bxe,grid%ph_bys,grid%ph_bye, &
-                             grid%t_bxs,grid%t_bxe,grid%t_bys,grid%t_bye, &
-                             grid%w_bxs,grid%w_bxe,grid%w_bys,grid%w_bye, &
-                             grid%mu_bxs,grid%mu_bxe,grid%mu_bys,grid%mu_bye, &
-                             grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, &
-                             grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, &
-                             grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, &
-                             grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, &
-                             grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, &
-                             grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, &
-                             config_flags%spec_bdy_width, grid%spec_zone,                       &
-                             ids,ide, jds,jde, kds,kde,  & ! domain dims
-                             ims,ime, jms,jme, kms,kme,  & ! memory dims
-                             ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
-                             grid%i_start(ij), grid%i_end(ij),                &
-                             grid%j_start(ij), grid%j_end(ij),                &
-                             k_start, k_end                                  )
-     
-       ENDIF
-
-     END DO
-     !$OMP END PARALLEL DO
-BENCH_END(relax_bdy_dry_tim)
-
-!
-!
-! (3) Small (acoustic,sound) steps.
-!
-!    Several acoustic steps are taken each RK pass.  A small step 
-!    sequence begins with calculating perturbation variables 
-!    and coupling them to the column dry-air-mass mu 
-!    (call to small_step_prep).  This is followed by computing
-!    coefficients for the vertically implicit part of the
-!    small timestep (call to calc_coef_w).  
-!
-!    The small steps are taken
-!    in the named loop "small_steps:".  In the small_steps loop, first 
-!    the horizontal momentum (u and v) are advanced (call to advance_uv),
-!    next mu and theta are advanced (call to advance_mu_t) followed by
-!    advancing w and the geopotential (call to advance_w).  Diagnostic
-!    values for pressure and inverse density are updated at the end of
-!    each small_step.
-!
-!    The small-step section ends with the change of the perturbation variables
-!    back to full variables (call to small_step_finish).
-!

-!
-
-BENCH_START(small_step_prep_tim)
-     !$OMP PARALLEL DO   &
-     !$OMP PRIVATE ( ij )
-     DO ij = 1 , grid%num_tiles
-
-    ! Calculate coefficients for the vertically implicit acoustic/gravity wave
-    ! integration.  We only need calculate these for the first pass through -
-    ! the predictor step.  They are reused as is for the corrector step.
-    ! For third-order RK, we need to recompute these after the first 
-    ! predictor because we may have changed the small timestep -> grid%dts.
-
-       CALL wrf_debug ( 200 , ' call small_step_prep ' )
-
-       CALL small_step_prep( grid%u_1,grid%u_2,grid%v_1,grid%v_2,grid%w_1,grid%w_2,   &
-                             grid%t_1,grid%t_2,grid%ph_1,grid%ph_2,                   &
-                             grid%mub, grid%mu_1, grid%mu_2,                          &
-                             grid%muu, muus, grid%muv, muvs,                          &
-                             grid%mut, grid%muts, grid%mudf,                          &
-                             grid%u_save, grid%v_save, w_save,                        &
-                             grid%t_save, ph_save, mu_save,                           &
-                             grid%ww, ww1,                                            &
-                             grid%dnw, c2a, grid%pb, grid%p, grid%alt,                &
-                             grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,       &
-                             grid%msfvy, grid%msftx,grid%msfty,                       &
-                             grid%rdx, grid%rdy, rk_step,                             &
-                             ids, ide, jds, jde, kds, kde,                            &
-                             ims, ime, jms, jme, kms, kme,                            &
-                             grid%i_start(ij), grid%i_end(ij),                        &
-                             grid%j_start(ij), grid%j_end(ij),                        &
-                             k_start    , k_end                                       )
- 
-       CALL calc_p_rho( grid%al, grid%p, grid%ph_2,                 &
-                        grid%alt, grid%t_2, grid%t_save, c2a, pm1,  &
-                        grid%mu_2, grid%muts, grid%znu, t0,         &
-                        grid%rdnw, grid%dnw, grid%smdiv,            &
-                        config_flags%non_hydrostatic, 0,            &
-                        ids, ide, jds, jde, kds, kde,               &
-                        ims, ime, jms, jme, kms, kme,               &
-                        grid%i_start(ij), grid%i_end(ij),           &
-                        grid%j_start(ij), grid%j_end(ij),           &
-                        k_start    , k_end                          )
-
-       IF (config_flags%non_hydrostatic) THEN
-         CALL calc_coef_w( a,alpha,gamma,                    &
-                           grid%mut, cqw,                    &
-                           grid%rdn, grid%rdnw, c2a,         &
-                           dts_rk, g, grid%epssm,            &
-                           config_flags%top_lid,             &
-                           ids, ide, jds, jde, kds, kde,     &
-                           ims, ime, jms, jme, kms, kme,     &
-                           grid%i_start(ij), grid%i_end(ij), &
-                           grid%j_start(ij), grid%j_end(ij), &
-                           k_start    , k_end               )
-       ENDIF
-
-     ENDDO
-     !$OMP END PARALLEL DO
-BENCH_END(small_step_prep_tim)
-
-#ifdef DM_PARALLEL
-!-----------------------------------------------------------------------
-!  Stencils for patch communications  (WCS, 29 June 2001)
-!  Note:  the small size of this halo exchange reflects the 
-!         fact that we are carrying the uncoupled variables 
-!         as state variables in the mass coordinate model, as
-!         opposed to the coupled variables as in the height
-!         coordinate model.
-!
-!                              * * * * *
-!            *        * * *    * * * * *
-!          * + *      * + *    * * + * * 
-!            *        * * *    * * * * *
-!                              * * * * *
-!
-!  3D variables - note staggering!  ph_2(Z), u_save(X), v_save(Y)
-!
-!  ph_2      x
-!  al        x
-!  p         x
-!  t_1       x
-!  t_save    x
-!  u_save    x
-!  v_save    x
-!
-!  the following are 2D (xy) variables
-!
-!  mu_1      x
-!  mu_2      x
-!  mudf      x
-!  php       x
-!  alt       x
-!  pb        x
-!--------------------------------------------------------------
-#      include "HALO_EM_B.inc"
-#      include "PERIOD_BDY_EM_B.inc"
-#endif
-
-BENCH_START(set_phys_bc2_tim)
-     !$OMP PARALLEL DO   &
-     !$OMP PRIVATE ( ij )
-
-     DO ij = 1 , grid%num_tiles
-
-       CALL set_physical_bc3d( grid%ru_tend, 'u', config_flags,      &
-                               ids, ide, jds, jde, kds, kde,         &
-                               ims, ime, jms, jme, kms, kme,         &
-                               ips, ipe, jps, jpe, kps, kpe,         &
-                               grid%i_start(ij), grid%i_end(ij),     &
-                               grid%j_start(ij), grid%j_end(ij),     &
-                               k_start    , k_end                    )
-
-       CALL set_physical_bc3d( grid%rv_tend, 'v', config_flags,      &
-                               ids, ide, jds, jde, kds, kde,         &
-                               ims, ime, jms, jme, kms, kme,         &
-                               ips, ipe, jps, jpe, kps, kpe,         &
-                               grid%i_start(ij), grid%i_end(ij),     &
-                               grid%j_start(ij), grid%j_end(ij),     &
-                               k_start    , k_end                    )
-
-       CALL set_physical_bc3d( grid%ph_2, 'w', config_flags,         &
-                               ids, ide, jds, jde, kds, kde,         &
-                               ims, ime, jms, jme, kms, kme,         &
-                               ips, ipe, jps, jpe, kps, kpe,         &
-                               grid%i_start(ij), grid%i_end(ij),     &
-                               grid%j_start(ij), grid%j_end(ij),     &
-                               k_start    , k_end                    )
-
-       CALL set_physical_bc3d( grid%al, 'p', config_flags,           &
-                               ids, ide, jds, jde, kds, kde,         &
-                               ims, ime, jms, jme, kms, kme,         &
-                               ips, ipe, jps, jpe, kps, kpe,         &
-                               grid%i_start(ij), grid%i_end(ij),     &
-                               grid%j_start(ij), grid%j_end(ij),     &
-                               k_start    , k_end                    )
-
-       CALL set_physical_bc3d( grid%p, 'p', config_flags,            &
-                               ids, ide, jds, jde, kds, kde,         &
-                               ims, ime, jms, jme, kms, kme,         &
-                               ips, ipe, jps, jpe, kps, kpe,         &
-                               grid%i_start(ij), grid%i_end(ij),     &
-                               grid%j_start(ij), grid%j_end(ij),     &
-                               k_start    , k_end                    )
-
-       CALL set_physical_bc3d( grid%t_1, 'p', config_flags,          &
-                               ids, ide, jds, jde, kds, kde,         &
-                               ims, ime, jms, jme, kms, kme,         &
-                               ips, ipe, jps, jpe, kps, kpe,         &
-                               grid%i_start(ij), grid%i_end(ij),     &
-                               grid%j_start(ij), grid%j_end(ij),     &
-                               k_start    , k_end                    )
-
-       CALL set_physical_bc3d( grid%t_save, 't', config_flags,       &
-                               ids, ide, jds, jde, kds, kde,         &
-                               ims, ime, jms, jme, kms, kme,         &
-                               ips, ipe, jps, jpe, kps, kpe,         &
-                               grid%i_start(ij), grid%i_end(ij),     &
-                               grid%j_start(ij), grid%j_end(ij),     &
-                               k_start    , k_end                    )
-
-       CALL set_physical_bc2d( grid%mu_1, 't', config_flags,         &
-                               ids, ide, jds, jde,                   &
-                               ims, ime, jms, jme,                   &
-                               ips, ipe, jps, jpe,                   &
-                               grid%i_start(ij), grid%i_end(ij),     &
-                               grid%j_start(ij), grid%j_end(ij)      )
-
-       CALL set_physical_bc2d( grid%mu_2, 't', config_flags,         &
-                               ids, ide, jds, jde,                   &
-                               ims, ime, jms, jme,                   &
-                               ips, ipe, jps, jpe,                   &
-                               grid%i_start(ij), grid%i_end(ij),     &
-                               grid%j_start(ij), grid%j_end(ij)      )
-
-       CALL set_physical_bc2d( grid%mudf, 't', config_flags,         &
-                               ids, ide, jds, jde,                   &
-                               ims, ime, jms, jme,                   &
-                               ips, ipe, jps, jpe,                   &
-                               grid%i_start(ij), grid%i_end(ij),     &
-                               grid%j_start(ij), grid%j_end(ij)      )
-
-     END DO
-     !$OMP END PARALLEL DO
-BENCH_END(set_phys_bc2_tim)
-     small_steps : DO iteration = 1 , number_of_small_timesteps
-
-       ! Boundary condition time (or communication time).  
-#ifdef DM_PARALLEL
-#      include "PERIOD_BDY_EM_B.inc"
-#endif
-
-       !$OMP PARALLEL DO   &
-       !$OMP PRIVATE ( ij )
-
-       DO ij = 1 , grid%num_tiles
-
-BENCH_START(advance_uv_tim)
-         CALL advance_uv ( grid%u_2, grid%ru_tend, grid%v_2, grid%rv_tend,        &
-                           grid%p, grid%pb,                                       &
-                           grid%ph_2, grid%php, grid%alt,  grid%al,               &
-                           grid%mu_2,                                             &
-                           grid%muu, cqu, grid%muv, cqv, grid%mudf,               &
-                           grid%msfux, grid%msfuy, grid%msfvx,                    &
-                           grid%msfvx_inv, grid%msfvy,                            &
-                           grid%rdx, grid%rdy, dts_rk,                            &
-                           grid%cf1, grid%cf2, grid%cf3, grid%fnm, grid%fnp,      &
-                           grid%emdiv,                                            &
-                           grid%rdnw, config_flags,grid%spec_zone,                &
-                           config_flags%non_hydrostatic, config_flags%top_lid,    &
-                           ids, ide, jds, jde, kds, kde,                          &
-                           ims, ime, jms, jme, kms, kme,                          &
-                           grid%i_start(ij), grid%i_end(ij),                      &
-                           grid%j_start(ij), grid%j_end(ij),                      &
-                           k_start    , k_end                                     )
-BENCH_END(advance_uv_tim)
-
-       END DO
-       !$OMP END PARALLEL DO
-
-!-----------------------------------------------------------
-!  acoustic integration polar filter for smallstep u, v
-!-----------------------------------------------------------
-
-       IF (config_flags%polar) THEN
-
-         CALL pxft ( grid=grid                                              &
-               ,lineno=__LINE__                                             &
-               ,flag_uv            = 1                                      &
-               ,flag_rurv          = 0                                      &
-               ,flag_wph           = 0                                      &
-               ,flag_ww            = 0                                      &
-               ,flag_t             = 0                                      &
-               ,flag_mu            = 0                                      &
-               ,flag_mut           = 0                                      &
-               ,flag_moist         = 0                                      &
-               ,flag_chem          = 0                                      &
-               ,flag_scalar        = 0                                      &
-               ,positive_definite  = .FALSE.                                &
-               ,moist=moist,chem=chem,scalar=scalar                         &
-               ,fft_filter_lat = config_flags%fft_filter_lat                &
-               ,dclat = dclat                                               &
-               ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-               ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-               ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
-               ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
-               ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
-
-       END IF
-
-!-----------------------------------------------------------
-!  end acoustic integration polar filter for smallstep u, v
-!-----------------------------------------------------------
-
-       !$OMP PARALLEL DO   &
-       !$OMP PRIVATE ( ij )
-       DO ij = 1 , grid%num_tiles
-
-BENCH_START(spec_bdy_uv_tim)
-         IF( config_flags%specified .or. config_flags%nested ) THEN
-           CALL spec_bdyupdate(grid%u_2, grid%ru_tend, dts_rk,      &
-                               'u'         , config_flags, &
-                                grid%spec_zone,                  &
-                                ids,ide, jds,jde, kds,kde,  & ! domain dims
-                                ims,ime, jms,jme, kms,kme,  & ! memory dims
-                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
-                                grid%i_start(ij), grid%i_end(ij),         &
-                                grid%j_start(ij), grid%j_end(ij),         &
-                                k_start    , k_end             )
-
-           CALL spec_bdyupdate(grid%v_2, grid%rv_tend, dts_rk,      &
-                                'v'         , config_flags, &
-                                grid%spec_zone,                  &
-                                ids,ide, jds,jde, kds,kde,  & ! domain dims
-                                ims,ime, jms,jme, kms,kme,  & ! memory dims
-                                ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
-                                grid%i_start(ij), grid%i_end(ij),         &
-                                grid%j_start(ij), grid%j_end(ij),         &
-                                k_start    , k_end             )
-
-         ENDIF
-BENCH_END(spec_bdy_uv_tim)
-
-       END DO
-       !$OMP END PARALLEL DO
-
-#ifdef DM_PARALLEL
-!
-!  Stencils for patch communications  (WCS, 29 June 2001)
-!
-!         *                     *
-!       * + *      * + *        +
-!         *                     *
-!
-!  u_2               x
-!  v_2                          x
-!
-#     include "HALO_EM_C.inc"
-#endif
-
-       !$OMP PARALLEL DO   &
-       !$OMP PRIVATE ( ij )
-       DO ij = 1 , grid%num_tiles
-
-        !  advance the mass in the column, theta, and calculate ww
-
-BENCH_START(advance_mu_t_tim)
-         CALL advance_mu_t( grid%ww, ww1, grid%u_2, grid%u_save, grid%v_2, grid%v_save, &
-                          grid%mu_2, grid%mut, muave, grid%muts, grid%muu, grid%muv,    &
-                          grid%mudf, grid%ru_m, grid%rv_m, grid%ww_m,                   &
-                          grid%t_2, grid%t_save, t_2save, t_tend,                       &
-                          mu_tend,                                                      &
-                          grid%rdx, grid%rdy, dts_rk, grid%epssm,                       &
-                          grid%dnw, grid%fnm, grid%fnp, grid%rdnw,                      &
-                          grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,            &
-                          grid%msfvy, grid%msftx,grid%msfty,                            &
-                          iteration, config_flags,                                      &
-                          ids, ide, jds, jde, kds, kde,      &
-                          ims, ime, jms, jme, kms, kme,      &
-                          grid%i_start(ij), grid%i_end(ij),  &
-                          grid%j_start(ij), grid%j_end(ij),  &
-                          k_start    , k_end                )
-BENCH_END(advance_mu_t_tim)
-       ENDDO
-       !$OMP END PARALLEL DO
-
-!-----------------------------------------------------------
-!  acoustic integration polar filter for smallstep mu, t
-!-----------------------------------------------------------
-
-       IF ( (config_flags%polar) ) THEN
-
-         CALL pxft ( grid=grid                                               &
-                ,lineno=__LINE__                                             &
-                ,flag_uv            = 0                                      &
-                ,flag_rurv          = 0                                      &
-                ,flag_wph           = 0                                      &
-                ,flag_ww            = 0                                      &
-                ,flag_t             = 1                                      &
-                ,flag_mu            = 1                                      &
-                ,flag_mut           = 0                                      &
-                ,flag_moist         = 0                                      &
-                ,flag_chem          = 0                                      &
-                ,flag_scalar        = 0                                      &
-                ,positive_definite  = .FALSE.                                &
-                ,moist=moist,chem=chem,scalar=scalar                         &
-                ,fft_filter_lat = config_flags%fft_filter_lat                &
-                ,dclat = dclat                                               &
-                ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
-                ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
-                ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
-
-         grid%muts = grid%mut + grid%mu_2  ! reset muts using filtered mu_2
- 
-       END IF
-
-!-----------------------------------------------------------
-!  end acoustic integration polar filter for smallstep mu, t
-!-----------------------------------------------------------
-
-BENCH_START(spec_bdy_t_tim)
-
-       !$OMP PARALLEL DO   &
-       !$OMP PRIVATE ( ij )
-       DO ij = 1 , grid%num_tiles
-
-         IF( config_flags%specified .or. config_flags%nested ) THEN
-
-           CALL spec_bdyupdate(grid%t_2, t_tend, dts_rk,        &
-                               't'         , config_flags,      &
-                               grid%spec_zone,                  &
-                               ids,ide, jds,jde, kds,kde,       &
-                               ims,ime, jms,jme, kms,kme,       &
-                               ips,ipe, jps,jpe, kps,kpe,       &
-                               grid%i_start(ij), grid%i_end(ij),&
-                               grid%j_start(ij), grid%j_end(ij),&
-                               k_start    , k_end              )
-
-           CALL spec_bdyupdate(grid%mu_2, mu_tend, dts_rk,       &
-                               'm'         , config_flags,      &
-                               grid%spec_zone,                  &
-                               ids,ide, jds,jde, 1  ,1  ,       &
-                               ims,ime, jms,jme, 1  ,1  ,       &
-                               ips,ipe, jps,jpe, 1  ,1  ,       &
-                               grid%i_start(ij), grid%i_end(ij),&
-                               grid%j_start(ij), grid%j_end(ij),&
-                               1    , 1             )
-
-           CALL spec_bdyupdate(grid%muts, mu_tend, dts_rk,      &
-                              'm'         , config_flags, &
-                              grid%spec_zone,                  &
-                              ids,ide, jds,jde, 1  ,1  ,  & ! domain dims
-                              ims,ime, jms,jme, 1  ,1  ,  & ! memory dims
-                              ips,ipe, jps,jpe, 1  ,1  ,  & ! patch  dims
-                              grid%i_start(ij), grid%i_end(ij),         &
-                              grid%j_start(ij), grid%j_end(ij),         &
-                              1    , 1             )
-         ENDIF
-BENCH_END(spec_bdy_t_tim)
-
-         ! small (acoustic) step for the vertical momentum,
-         ! density and coupled potential temperature.
-
-
-BENCH_START(advance_w_tim)
-         IF ( config_flags%non_hydrostatic ) THEN
-           CALL advance_w( grid%w_2, rw_tend, grid%ww, w_save,         &
-                           grid%u_2, grid%v_2,                         &
-                           grid%mu_2, grid%mut, muave, grid%muts,      &
-                           t_2save, grid%t_2, grid%t_save,             &
-                           grid%ph_2, ph_save, grid%phb, ph_tend,      &
-                           grid%ht, c2a, cqw, grid%alt, grid%alb,      &
-                           a, alpha, gamma,                            &
-                           grid%rdx, grid%rdy, dts_rk, t0, grid%epssm, &
-                           grid%dnw, grid%fnm, grid%fnp, grid%rdnw,    &
-                           grid%rdn, grid%cf1, grid%cf2, grid%cf3,     &
-                           grid%msftx, grid%msfty,                     &
-                           config_flags,  config_flags%top_lid,        &
-                           ids,ide, jds,jde, kds,kde,                  &
-                           ims,ime, jms,jme, kms,kme,                  &
-                           grid%i_start(ij), grid%i_end(ij),           &
-                           grid%j_start(ij), grid%j_end(ij),           &
-                           k_start    , k_end                          )
-         ENDIF
-BENCH_END(advance_w_tim)
-
-       ENDDO
-       !$OMP END PARALLEL DO
-
-!-----------------------------------------------------------
-!  acoustic integration polar filter for smallstep w, geopotential
-!-----------------------------------------------------------
-
-       IF ( (config_flags%polar) .AND. (config_flags%non_hydrostatic) ) THEN
-
-         CALL pxft ( grid=grid                                               &
-                ,lineno=__LINE__                                             &
-                ,flag_uv            = 0                                      &
-                ,flag_rurv          = 0                                      &
-                ,flag_wph           = 1                                      &
-                ,flag_ww            = 0                                      &
-                ,flag_t             = 0                                      &
-                ,flag_mu            = 0                                      &
-                ,flag_mut           = 0                                      &
-                ,flag_moist         = 0                                      &
-                ,flag_chem          = 0                                      &
-                ,flag_scalar        = 0                                      &
-                ,positive_definite  = .FALSE.                                &
-                ,moist=moist,chem=chem,scalar=scalar                         &
-                ,fft_filter_lat = config_flags%fft_filter_lat                &
-                ,dclat = dclat                                               &
-                ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
-                ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
-                ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
-
-       END IF
-
-!-----------------------------------------------------------
-!  end acoustic integration polar filter for smallstep w, geopotential
-!-----------------------------------------------------------
-
-       !$OMP PARALLEL DO   &
-       !$OMP PRIVATE ( ij )
-       DO ij = 1 , grid%num_tiles
-
-BENCH_START(sumflux_tim)
-         CALL sumflux ( grid%u_2, grid%v_2, grid%ww,          &
-                        grid%u_save, grid%v_save, ww1,        &
-                        grid%muu, grid%muv,                   &
-                        grid%ru_m, grid%rv_m, grid%ww_m, grid%epssm,  &
-                        grid%msfux, grid% msfuy, grid%msfvx,  &
-                        grid%msfvx_inv, grid%msfvy,           &
-                        iteration, number_of_small_timesteps, &
-                        ids, ide, jds, jde, kds, kde,         &
-                        ims, ime, jms, jme, kms, kme,         &
-                        grid%i_start(ij), grid%i_end(ij),     &
-                        grid%j_start(ij), grid%j_end(ij),     &
-                        k_start    , k_end                   )
-BENCH_END(sumflux_tim)
-
-         IF( config_flags%specified .or. config_flags%nested ) THEN
-
-BENCH_START(spec_bdynhyd_tim)
-           IF (config_flags%non_hydrostatic)  THEN
-             CALL spec_bdyupdate_ph( ph_save, grid%ph_2, ph_tend,     &
-                                     mu_tend, grid%muts, dts_rk,      &
-                                     'h'         , config_flags,      &
-                                     grid%spec_zone,                  &
-                                     ids,ide, jds,jde, kds,kde,       &
-                                     ims,ime, jms,jme, kms,kme,       &
-                                     ips,ipe, jps,jpe, kps,kpe,       &
-                                     grid%i_start(ij), grid%i_end(ij),&
-                                     grid%j_start(ij), grid%j_end(ij),&
-                                     k_start    , k_end               )
-             IF( config_flags%specified ) THEN
-               CALL zero_grad_bdy ( grid%w_2,                         &
-                                    'w'         , config_flags,       &
-                                    grid%spec_zone,                   &
-                                    ids,ide, jds,jde, kds,kde,        &
-                                    ims,ime, jms,jme, kms,kme,        &
-                                    ips,ipe, jps,jpe, kps,kpe,        &
-                                    grid%i_start(ij), grid%i_end(ij), &
-                                    grid%j_start(ij), grid%j_end(ij), &
-                                    k_start    , k_end                )
-             ELSE
-               CALL spec_bdyupdate ( grid%w_2, rw_tend, dts_rk,       &
-                                     'h'         , config_flags,      &
-                                     grid%spec_zone,                  &
-                                     ids,ide, jds,jde, kds,kde,       &
-                                     ims,ime, jms,jme, kms,kme,       &
-                                     ips,ipe, jps,jpe, kps,kpe,       &
-                                     grid%i_start(ij), grid%i_end(ij),&
-                                     grid%j_start(ij), grid%j_end(ij),&
-                                     k_start    , k_end               )
-             ENDIF
-           ENDIF
-BENCH_END(spec_bdynhyd_tim)
-         ENDIF
-
-BENCH_START(cald_p_rho_tim)
-         CALL calc_p_rho( grid%al, grid%p, grid%ph_2,                 &
-                          grid%alt, grid%t_2, grid%t_save, c2a, pm1,  &
-                          grid%mu_2, grid%muts, grid%znu, t0,         &
-                          grid%rdnw, grid%dnw, grid%smdiv,            &
-                          config_flags%non_hydrostatic, iteration,    &
-                          ids, ide, jds, jde, kds, kde,     &
-                          ims, ime, jms, jme, kms, kme,     &
-                          grid%i_start(ij), grid%i_end(ij), &
-                          grid%j_start(ij), grid%j_end(ij), &
-                          k_start    , k_end               )
-BENCH_END(cald_p_rho_tim)
-
-       ENDDO
-       !$OMP END PARALLEL DO
-
-#ifdef DM_PARALLEL
-!
-!  Stencils for patch communications  (WCS, 29 June 2001)
-!
-!         *                     *
-!       * + *      * + *        +
-!         *                     *
-!
-!  ph_2   x
-!  al     x
-!  p      x
-!
-!  2D variables (x,y)
-!
-!  mu_2   x
-!  muts   x
-!  mudf   x
-
-#      include "HALO_EM_C2.inc"
-#      include "PERIOD_BDY_EM_B3.inc"
-#endif
-
-BENCH_START(phys_bc_tim)
-       !$OMP PARALLEL DO   &
-       !$OMP PRIVATE ( ij )
-       DO ij = 1 , grid%num_tiles
-
-       ! boundary condition set for next small timestep
-
-         CALL set_physical_bc3d( grid%ph_2, 'w', config_flags,          &
-                                 ids, ide, jds, jde, kds, kde,     &
-                                 ims, ime, jms, jme, kms, kme,     &
-                                 ips, ipe, jps, jpe, kps, kpe,     &
-                                 grid%i_start(ij), grid%i_end(ij), &
-                                 grid%j_start(ij), grid%j_end(ij), &
-                                 k_start    , k_end               )
-
-         CALL set_physical_bc3d( grid%al, 'p', config_flags,            &
-                                 ids, ide, jds, jde, kds, kde,     &
-                                 ims, ime, jms, jme, kms, kme,     &
-                                 ips, ipe, jps, jpe, kps, kpe,     &
-                                 grid%i_start(ij), grid%i_end(ij), &
-                                 grid%j_start(ij), grid%j_end(ij), &
-                                 k_start    , k_end               )
-
-         CALL set_physical_bc3d( grid%p, 'p', config_flags,             &
-                                 ids, ide, jds, jde, kds, kde,     &
-                                 ims, ime, jms, jme, kms, kme,     &
-                                 ips, ipe, jps, jpe, kps, kpe,     &
-                                 grid%i_start(ij), grid%i_end(ij), &
-                                 grid%j_start(ij), grid%j_end(ij), &
-                                 k_start    , k_end               )
-
-         CALL set_physical_bc2d( grid%muts, 't', config_flags,          &
-                                 ids, ide, jds, jde,               &
-                                 ims, ime, jms, jme,               &
-                                 ips, ipe, jps, jpe,               &
-                                 grid%i_start(ij), grid%i_end(ij), &
-                                 grid%j_start(ij), grid%j_end(ij) )
-
-         CALL set_physical_bc2d( grid%mu_2, 't', config_flags,          &
-                                 ids, ide, jds, jde,               &
-                                 ims, ime, jms, jme,               &
-                                 ips, ipe, jps, jpe,               &
-                                 grid%i_start(ij), grid%i_end(ij), &
-                                 grid%j_start(ij), grid%j_end(ij) )
-
-         CALL set_physical_bc2d( grid%mudf, 't', config_flags,          &
-                                 ids, ide, jds, jde,               &
-                                 ims, ime, jms, jme,               &
-                                 ips, ipe, jps, jpe,               &
-                                 grid%i_start(ij), grid%i_end(ij), &
-                                 grid%j_start(ij), grid%j_end(ij) )
-
-       END DO
-       !$OMP END PARALLEL DO
-BENCH_END(phys_bc_tim)
-
-     END DO small_steps
-
-     !$OMP PARALLEL DO   &
-     !$OMP PRIVATE ( ij )
-     DO ij = 1 , grid%num_tiles
-
-       CALL wrf_debug ( 200 , ' call rk_small_finish' )
-
-      ! change time-perturbation variables back to 
-      ! full perturbation variables.
-      ! first get updated mu at u and v points
-
-BENCH_START(calc_mu_uv_tim)
-       CALL calc_mu_uv_1 ( config_flags,                     &
-                           grid%muts, muus, muvs,                 &
-                           ids, ide, jds, jde, kds, kde,     &
-                           ims, ime, jms, jme, kms, kme,     &
-                           grid%i_start(ij), grid%i_end(ij), &
-                           grid%j_start(ij), grid%j_end(ij), &
-                           k_start    , k_end               )
-BENCH_END(calc_mu_uv_tim)
-BENCH_START(small_step_finish_tim)
-       CALL small_step_finish( grid%u_2, grid%u_1, grid%v_2, grid%v_1, grid%w_2, grid%w_1,     &
-                               grid%t_2, grid%t_1, grid%ph_2, grid%ph_1, grid%ww, ww1,    &
-                               grid%mu_2, grid%mu_1,                       &
-                               grid%mut, grid%muts, grid%muu, muus, grid%muv, muvs,  & 
-                               grid%u_save, grid%v_save, w_save,           &
-                               grid%t_save, ph_save, mu_save,         &
-                               grid%msfux,grid%msfuy, grid%msfvx,grid%msfvy, grid%msftx,grid%msfty, &
-                               grid%h_diabatic,                       &
-                               number_of_small_timesteps,dts_rk, &
-                               rk_step, rk_order,                &
-                               ids, ide, jds, jde, kds, kde,     &
-                               ims, ime, jms, jme, kms, kme,     &
-                               grid%i_start(ij), grid%i_end(ij), &
-                               grid%j_start(ij), grid%j_end(ij), &
-                               k_start    , k_end               )
-!  call  to set ru_m, rv_m and ww_m b.c's for PD advection
-
-       IF (rk_step == rk_order) THEN
-
-         CALL set_physical_bc3d( grid%ru_m, 'u', config_flags,   &
-                                 ids, ide, jds, jde, kds, kde,      &
-                                 ims, ime, jms, jme, kms, kme,      &
-                                 ips, ipe, jps, jpe, kps, kpe,      &
-                                 grid%i_start(ij), grid%i_end(ij),  &
-                                 grid%j_start(ij), grid%j_end(ij),  &
-                                 k_start    , k_end                )
-
-         CALL set_physical_bc3d( grid%rv_m, 'v', config_flags,   &
-                                 ids, ide, jds, jde, kds, kde,      &
-                                 ims, ime, jms, jme, kms, kme,      &
-                                 ips, ipe, jps, jpe, kps, kpe,      &
-                                 grid%i_start(ij), grid%i_end(ij),  &
-                                 grid%j_start(ij), grid%j_end(ij),  &
-                                 k_start    , k_end                )
-
-         CALL set_physical_bc3d( grid%ww_m, 'w', config_flags,   &
-                                 ids, ide, jds, jde, kds, kde,      &
-                                 ims, ime, jms, jme, kms, kme,      &
-                                 ips, ipe, jps, jpe, kps, kpe,      &
-                                 grid%i_start(ij), grid%i_end(ij),  &
-                                 grid%j_start(ij), grid%j_end(ij),  &
-                                 k_start    , k_end                )
-
-         CALL set_physical_bc2d( grid%mut, 't', config_flags,   &
-                                 ids, ide, jds, jde,               &
-                                 ims, ime, jms, jme,                &
-                                 ips, ipe, jps, jpe,                &
-                                 grid%i_start(ij), grid%i_end(ij),  &
-                                 grid%j_start(ij), grid%j_end(ij) )
- 
-       END IF
-
-BENCH_END(small_step_finish_tim)
-
-     END DO
-     !$OMP END PARALLEL DO
-
-!-----------------------------------------------------------
-!  polar filter for full dynamics variables and time-averaged mass fluxes 
-!-----------------------------------------------------------
-
-     IF (config_flags%polar) THEN
-
-       CALL pxft ( grid=grid                                                   &
-                  ,lineno=__LINE__                                             &
-                  ,flag_uv            = 1                                      &
-                  ,flag_rurv          = 1                                      &
-                  ,flag_wph           = 1                                      &
-                  ,flag_ww            = 1                                      &
-                  ,flag_t             = 1                                      &
-                  ,flag_mu            = 1                                      &
-                  ,flag_mut           = 1                                      &
-                  ,flag_moist         = 0                                      &
-                  ,flag_chem          = 0                                      &
-                  ,flag_scalar        = 0                                      &
-                  ,positive_definite  = .FALSE.                                &
-                  ,moist=moist,chem=chem,scalar=scalar                         &
-                  ,fft_filter_lat = config_flags%fft_filter_lat                &
-                  ,dclat = dclat                                               &
-                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
-                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
-                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
-
-     END IF
-
-!-----------------------------------------------------------
-!  end polar filter for full dynamics variables and time-averaged mass fluxes 
-!-----------------------------------------------------------
-
-!-----------------------------------------------------------------------
-!  add in physics tendency first if positive definite advection is used.
-!  pd advection applies advective flux limiter on last runge-kutta step
-!-----------------------------------------------------------------------
-! first moisture
-
-     IF (config_flags%pd_moist .and. (rk_step == rk_order)) THEN
-
-       !$OMP PARALLEL DO   &
-       !$OMP PRIVATE ( ij )
-       DO ij = 1 , grid%num_tiles
-         CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
-         DO im = PARAM_FIRST_SCALAR, num_3d_m
-           CALL rk_update_scalar_pd( im, im,                                   &
-                                     moist_old(ims,kms,jms,im),                &
-                                     moist_tend(ims,kms,jms,im),               &
-                                     grid%mu_1, grid%mu_1, grid%mub,  &
-                                     rk_step, dt_rk, grid%spec_zone,           &
-                                     config_flags,                             &
-                                     ids, ide, jds, jde, kds, kde,             &
-                                     ims, ime, jms, jme, kms, kme,             &
-                                     grid%i_start(ij), grid%i_end(ij),         &
-                                     grid%j_start(ij), grid%j_end(ij),         &
-                                     k_start    , k_end                       )
-         ENDDO
-       END DO
-       !$OMP END PARALLEL DO
-
-!---------------------- positive definite bc call
-#ifdef DM_PARALLEL
-       IF (config_flags%pd_moist) THEN
-         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
-#     include "HALO_EM_MOIST_OLD_E_5.inc"
-         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
-#     include "HALO_EM_MOIST_OLD_E_7.inc"
-         ELSE
-           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
-           CALL wrf_error_fatal(TRIM(wrf_err_message))
-         ENDIF
-       ENDIF
-#endif
-
-#ifdef DM_PARALLEL
-#  include "PERIOD_BDY_EM_MOIST_OLD.inc"
-#endif
-
-       !$OMP PARALLEL DO   &
-       !$OMP PRIVATE ( ij )
-       DO ij = 1 , grid%num_tiles
-         IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
-           DO im = PARAM_FIRST_SCALAR , num_3d_m
-             CALL set_physical_bc3d( moist_old(ims,kms,jms,im), 'p', config_flags,   &
-                                     ids, ide, jds, jde, kds, kde,                  &
-                                     ims, ime, jms, jme, kms, kme,                  &
-                                     ips, ipe, jps, jpe, kps, kpe,                  &
-                                     grid%i_start(ij), grid%i_end(ij),              &
-                                     grid%j_start(ij), grid%j_end(ij),              &
-                                     k_start    , k_end                            )
-           END DO
-         ENDIF
-       END DO
-       !$OMP END PARALLEL DO
-
-     END IF  ! end if for pd_moist
-
-! scalars
-
-     IF (config_flags%pd_scalar .and. (rk_step == rk_order)) THEN
-
-       !$OMP PARALLEL DO   &
-       !$OMP PRIVATE ( ij )
-       DO ij = 1 , grid%num_tiles
-         CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
-         DO im = PARAM_FIRST_SCALAR, num_3d_s
-           CALL rk_update_scalar_pd( im, im,                                  &
-                                     scalar_old(ims,kms,jms,im),              &
-                                     scalar_tend(ims,kms,jms,im),             &
-                                     grid%mu_1, grid%mu_1, grid%mub, &
-                                     rk_step, dt_rk, grid%spec_zone,          &
-                                     config_flags,                            &
-                                     ids, ide, jds, jde, kds, kde,            &
-                                     ims, ime, jms, jme, kms, kme,            &
-                                     grid%i_start(ij), grid%i_end(ij),        &
-                                     grid%j_start(ij), grid%j_end(ij),        &
-                                     k_start    , k_end                      )
-         ENDDO
-       ENDDO
-       !$OMP END PARALLEL DO
-
-!---------------------- positive definite bc call
-#ifdef DM_PARALLEL
-       IF (config_flags%pd_scalar) THEN
-#ifndef RSL
-         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
-#     include "HALO_EM_SCALAR_OLD_E_5.inc"
-         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
-#     include "HALO_EM_SCALAR_OLD_E_7.inc"
-         ELSE
-           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
-           CALL wrf_error_fatal(TRIM(wrf_err_message))
-         ENDIF
-#else
-         WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
-         CALL wrf_error_fatal(TRIM(wrf_err_message))
-#endif   
-  endif
-#endif
-
-#ifdef DM_PARALLEL
-#  include "PERIOD_BDY_EM_SCALAR_OLD.inc"
-#endif
-         !$OMP PARALLEL DO   &
-         !$OMP PRIVATE ( ij )
-
-         DO ij = 1 , grid%num_tiles
-           IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
-             DO im = PARAM_FIRST_SCALAR , num_3d_s
-               CALL set_physical_bc3d(  scalar_old(ims,kms,jms,im), 'p', config_flags, &
-                                        ids, ide, jds, jde, kds, kde,                    &
-                                        ims, ime, jms, jme, kms, kme,                    &
-                                        ips, ipe, jps, jpe, kps, kpe,                    &
-                                        grid%i_start(ij), grid%i_end(ij),                &
-                                        grid%j_start(ij), grid%j_end(ij),                &
-                                        k_start    , k_end                              )
-             END DO
-           ENDIF
-         END DO
-         !$OMP END PARALLEL DO
-
-       END IF  ! end if for pd_scalar
-
-! chem
-
-       IF (config_flags%pd_chem .and. (rk_step == rk_order)) THEN
-
-         !$OMP PARALLEL DO   &
-         !$OMP PRIVATE ( ij )
-         DO ij = 1 , grid%num_tiles
-           CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
-           DO im = PARAM_FIRST_SCALAR, num_3d_c
-             CALL rk_update_scalar_pd( im, im,                                  &
-                                       chem_old(ims,kms,jms,im),                &
-                                       chem_tend(ims,kms,jms,im),               &
-                                       grid%mu_1, grid%mu_1, grid%mub, &
-                                       rk_step, dt_rk, grid%spec_zone,          &
-                                       config_flags,                            &
-                                       ids, ide, jds, jde, kds, kde,            &
-                                       ims, ime, jms, jme, kms, kme,            &
-                                       grid%i_start(ij), grid%i_end(ij),        &
-                                       grid%j_start(ij), grid%j_end(ij),        &
-                                       k_start    , k_end                      )
-           ENDDO
-         END DO
-         !$OMP END PARALLEL DO
-
-!---------------------- positive definite bc call
-#ifdef DM_PARALLEL
-         IF (config_flags%pd_chem) THEN
-           IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
-#     include "HALO_EM_CHEM_OLD_E_5.inc"
-           ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
-#     include "HALO_EM_CHEM_OLD_E_7.inc"
-           ELSE
-             WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
-             CALL wrf_error_fatal(TRIM(wrf_err_message))
-           ENDIF
-         ENDIF
-#endif
-
-#ifdef DM_PARALLEL
-#  include "PERIOD_BDY_EM_CHEM_OLD.inc"
-#endif
-
-         !$OMP PARALLEL DO   &
-         !$OMP PRIVATE ( ij )
-         DO ij = 1 , grid%num_tiles
-           IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
-             DO im = PARAM_FIRST_SCALAR , num_3d_c
-               CALL set_physical_bc3d(  chem_old(ims,kms,jms,im), 'p', config_flags,     &
-                                        ids, ide, jds, jde, kds, kde,                    &
-                                        ims, ime, jms, jme, kms, kme,                    &
-                                        ips, ipe, jps, jpe, kps, kpe,                    &
-                                        grid%i_start(ij), grid%i_end(ij),                &
-                                        grid%j_start(ij), grid%j_end(ij),                &
-                                        k_start    , k_end                              )
-             END DO 
-           ENDIF
-         END DO
-         !$OMP END PARALLEL DO
-
-       ENDIF  ! end if for pd_chem
-
-! tke
-
-       IF (config_flags%pd_tke .and. (rk_step == rk_order) &
-           .and. (config_flags%km_opt .eq. 2)                ) THEN
-
-         !$OMP PARALLEL DO   &
-         !$OMP PRIVATE ( ij )
-         DO ij = 1 , grid%num_tiles
-           CALL wrf_debug ( 200 , ' call rk_update_scalar_pd' )
-           CALL rk_update_scalar_pd( 1, 1,                                    &
-                                     grid%tke_1,                              &
-                                     tke_tend(ims,kms,jms),                   &
-                                     grid%mu_1, grid%mu_1, grid%mub,          &
-                                     rk_step, dt_rk, grid%spec_zone,          &
-                                     config_flags,                            &
-                                     ids, ide, jds, jde, kds, kde,            &
-                                     ims, ime, jms, jme, kms, kme,            &
-                                     grid%i_start(ij), grid%i_end(ij),        &
-                                     grid%j_start(ij), grid%j_end(ij),        &
-                                     k_start    , k_end                       )
-         ENDDO
-         !$OMP END PARALLEL DO
-
-!---------------------- positive definite bc call
-#ifdef DM_PARALLEL
-         IF (config_flags%pd_tke) THEN
-           IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
-#     include "HALO_EM_TKE_OLD_E_5.inc"
-           ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
-#     include "HALO_EM_TKE_OLD_E_7.inc"
-           ELSE
-             WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
-             CALL wrf_error_fatal(TRIM(wrf_err_message))
-           ENDIF
-         ENDIF
-#endif
-
-#ifdef DM_PARALLEL
-#  include "PERIOD_BDY_EM_TKE_OLD.inc"
-#endif
-
-         !$OMP PARALLEL DO   &
-         !$OMP PRIVATE ( ij )
-         DO ij = 1 , grid%num_tiles
-           CALL set_physical_bc3d(  grid%tke_1, 'p', config_flags,  &
-                                    ids, ide, jds, jde, kds, kde,      &
-                                    ims, ime, jms, jme, kms, kme,      &
-                                    ips, ipe, jps, jpe, kps, kpe,      &
-                                    grid%i_start(ij), grid%i_end(ij),  &
-                                    grid%j_start(ij), grid%j_end(ij),  &
-                                    k_start    , k_end                )
-         END DO
-         !$OMP END PARALLEL DO
-
-!---  end of positive definite physics tendency update
-
-       END IF  ! end if for pd_tke
-
-#ifdef DM_PARALLEL
-!
-!  Stencils for patch communications  (WCS, 29 June 2001)
-!
-!          * * * * *            
-!          * * * * *            
-!          * * + * *            
-!          * * * * *            
-!          * * * * *            
-!
-! ru_m         x
-! rv_m         x
-! ww_m         x
-! mut          x
-!
-!--------------------------------------------------------------
-
-#  include "HALO_EM_D.inc"
-#endif
-
-!
-!
-! (4) Still within the RK loop, the scalar variables are advanced.
-!
-!    For the moist and chem variables, each one is advanced
-!    individually, using named loops "moist_variable_loop:"
-!    and "chem_variable_loop:".  Each RK substep begins by
-!    calculating the advective tendency, and, for the first RK step, 
-!    3D mixing (calling rk_scalar_tend) followed by an update
-!    of the scalar (calling rk_scalar_update).
-!

-!
-
-
-       moist_scalar_advance: IF (num_3d_m >= PARAM_FIRST_SCALAR )  THEN
-
-         moist_variable_loop: DO im = PARAM_FIRST_SCALAR, num_3d_m
-
-! adv_moist_cond is set in module_physics_init based on mp_physics choice
-!       true except for Ferrier scheme
-
-           IF (grid%adv_moist_cond .or. im==p_qv ) THEN
-
-             !$OMP PARALLEL DO   &
-             !$OMP PRIVATE ( ij )
-             moist_tile_loop_1: DO ij = 1 , grid%num_tiles
-
-               CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
-
-BENCH_START(rk_scalar_tend_tim)
-               CALL rk_scalar_tend (  im, im, config_flags,                  &
-                           rk_step, dt_rk,                                   &
-                           grid%ru_m, grid%rv_m, grid%ww_m,                  &
-                           grid%mut, grid%mub, grid%mu_1,                    &
-                           grid%alt,                                         &
-                           moist_old(ims,kms,jms,im),                        &
-                           moist(ims,kms,jms,im),                            &
-                           moist_tend(ims,kms,jms,im),                       &
-                           advect_tend,grid%rqvften,                         &
-                           grid%qv_base, .true., grid%fnm, grid%fnp,         &
-                           grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
-                           grid%msfvy, grid%msftx,grid%msfty,                & 
-                           grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
-                           grid%kvdif, grid%xkhh,                            &
-                           grid%diff_6th_opt, grid%diff_6th_factor,          &
-                           config_flags%pd_moist,            &
-                           ids, ide, jds, jde, kds, kde,     &
-                           ims, ime, jms, jme, kms, kme,     &
-                           grid%i_start(ij), grid%i_end(ij), &
-                           grid%j_start(ij), grid%j_end(ij), &
-                           k_start    , k_end               )
-
-BENCH_END(rk_scalar_tend_tim)
-
-BENCH_START(rlx_bdy_scalar_tim)
-               IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN 
-                 IF ( im .EQ. P_QV .OR. config_flags%nested ) THEN
-                   CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im),            & 
-                                     moist(ims,kms,jms,im),  grid%mut,         &
-                                     moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
-                                     moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
-                                     moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
-                                     moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
-                                     config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
-                                     grid%dtbc, grid%fcx, grid%gcx,             &
-                                     config_flags,               &
-                                     ids,ide, jds,jde, kds,kde,  & ! domain dims
-                                     ims,ime, jms,jme, kms,kme,  & ! memory dims
-                                     ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
-                                     grid%i_start(ij), grid%i_end(ij),      &
-                                     grid%j_start(ij), grid%j_end(ij),      &
-                                     k_start, k_end                        )
-
-                   CALL spec_bdy_scalar  ( moist_tend(ims,kms,jms,im),                &
-                                     moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
-                                     moist_bys(ims,kms,1,im),moist_bye(ims,kms,1,im), &
-                                     moist_btxs(jms,kms,1,im),moist_btxe(jms,kms,1,im), &
-                                     moist_btys(ims,kms,1,im),moist_btye(ims,kms,1,im), &
-                                     config_flags%spec_bdy_width, grid%spec_zone,                 &
-                                     config_flags,               &
-                                     ids,ide, jds,jde, kds,kde,  & ! domain dims
-                                     ims,ime, jms,jme, kms,kme,  & ! memory dims
-                                     ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
-                                     grid%i_start(ij), grid%i_end(ij),          &
-                                     grid%j_start(ij), grid%j_end(ij),          &
-                                     k_start, k_end                               )
-                 ENDIF
-               ENDIF
-BENCH_END(rlx_bdy_scalar_tim)
-
-             ENDDO moist_tile_loop_1
-             !$OMP END PARALLEL DO
-
-             !$OMP PARALLEL DO   &
-             !$OMP PRIVATE ( ij )
-             moist_tile_loop_2: DO ij = 1 , grid%num_tiles
-
-               CALL wrf_debug ( 200 , ' call rk_update_scalar' )
-
-BENCH_START(update_scal_tim)
-               CALL rk_update_scalar( im, im,                     &
-                               moist_old(ims,kms,jms,im),         &
-                               moist(ims,kms,jms,im),             &
-                               moist_tend(ims,kms,jms,im),        &
-                               advect_tend, grid%msftx,grid%msfty, &
-                               grid%mu_1, grid%mu_2, grid%mub,    &
-                               rk_step, dt_rk, grid%spec_zone,    &
-                               config_flags,                      &
-                               ids, ide, jds, jde, kds, kde,     &
-                               ims, ime, jms, jme, kms, kme,     &
-                               grid%i_start(ij), grid%i_end(ij), &
-                               grid%j_start(ij), grid%j_end(ij), &
-                               k_start    , k_end                )
-BENCH_END(update_scal_tim)
-
-BENCH_START(flow_depbdy_tim)
-               IF( config_flags%specified ) THEN
-                 IF(im .ne. P_QV)THEN
-                   CALL flow_dep_bdy  (  moist(ims,kms,jms,im),                 &
-                                grid%ru_m, grid%rv_m, config_flags,             &
-                                grid%spec_zone,                                 &
-                                ids,ide, jds,jde, kds,kde,                      &
-                                ims,ime, jms,jme, kms,kme,                      &
-                                ips,ipe, jps,jpe, kps,kpe,                      &
-                                grid%i_start(ij), grid%i_end(ij),               &
-                                grid%j_start(ij), grid%j_end(ij),               &
-                                k_start, k_end                               )
-                 ENDIF
-               ENDIF
-BENCH_END(flow_depbdy_tim)
-
-             ENDDO moist_tile_loop_2
-             !$OMP END PARALLEL DO
-
-           ENDIF  !-- if (grid%adv_moist_cond .or. im==p_qv ) then
-
-         ENDDO moist_variable_loop
-
-       ENDIF moist_scalar_advance
-
-BENCH_START(tke_adv_tim)
-       TKE_advance: IF (config_flags%km_opt .eq. 2) then
-#ifdef DM_PARALLEL
-         IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
-#       include "HALO_EM_TKE_ADVECT_3.inc"
-         ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
-#       include "HALO_EM_TKE_ADVECT_5.inc"
-         ELSE
-          WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
-          CALL wrf_error_fatal(TRIM(wrf_err_message))
-         ENDIF
-#endif
-         !$OMP PARALLEL DO   &
-         !$OMP PRIVATE ( ij )
-         tke_tile_loop_1: DO ij = 1 , grid%num_tiles
-
-           CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
-           CALL rk_scalar_tend ( 1, 1, config_flags,                               &
-                            rk_step, dt_rk,                                        &
-                            grid%ru_m, grid%rv_m, grid%ww_m,                       &
-                            grid%mut, grid%mub, grid%mu_1,                         &
-                            grid%alt,                                              &
-                            grid%tke_1,                                            &
-                            grid%tke_2,                                            &
-                            tke_tend(ims,kms,jms),                                 &
-                            advect_tend,grid%rqvften,                              &
-                            grid%qv_base, .false., grid%fnm, grid%fnp,             &
-                            grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,     &
-                            grid%msfvy, grid%msftx,grid%msfty,                     &
-                            grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif,   &
-                            grid%kvdif, grid%xkhh,                                 &
-                            grid%diff_6th_opt, grid%diff_6th_factor,               &
-                            config_flags%pd_tke,              &
-                            ids, ide, jds, jde, kds, kde,     &
-                            ims, ime, jms, jme, kms, kme,     &
-                            grid%i_start(ij), grid%i_end(ij), &
-                            grid%j_start(ij), grid%j_end(ij), &
-                            k_start    , k_end               )
-
-         ENDDO tke_tile_loop_1
-         !$OMP END PARALLEL DO
-
-         !$OMP PARALLEL DO   &
-         !$OMP PRIVATE ( ij )
-         tke_tile_loop_2: DO ij = 1 , grid%num_tiles
-
-           CALL wrf_debug ( 200 , ' call rk_update_scalar' )
-           CALL rk_update_scalar( 1, 1,                             &
-                             grid%tke_1,                            &
-                             grid%tke_2,                            &
-                             tke_tend(ims,kms,jms),                 &
-                             advect_tend,grid%msftx,grid%msfty,     &
-                             grid%mu_1, grid%mu_2, grid%mub,        &
-                             rk_step, dt_rk, grid%spec_zone,        &
-                             config_flags,                          &
-                             ids, ide, jds, jde, kds, kde,     &
-                             ims, ime, jms, jme, kms, kme,     &
-                             grid%i_start(ij), grid%i_end(ij), &
-                             grid%j_start(ij), grid%j_end(ij), &
-                             k_start    , k_end               ) 
-
-! bound the tke (greater than 0, less than tke_upper_bound)
-
-           CALL bound_tke( grid%tke_2, grid%tke_upper_bound,    &
-                           ids, ide, jds, jde, kds, kde,        &
-                           ims, ime, jms, jme, kms, kme,        &
-                           grid%i_start(ij), grid%i_end(ij),    &
-                           grid%j_start(ij), grid%j_end(ij),    &
-                           k_start    , k_end                  )
-
-           IF( config_flags%specified .or. config_flags%nested ) THEN
-              CALL flow_dep_bdy (  grid%tke_2,                     &
-                                   grid%ru_m, grid%rv_m, config_flags,               &
-                                   grid%spec_zone,                              &
-                                   ids,ide, jds,jde, kds,kde,  & ! domain dims
-                                   ims,ime, jms,jme, kms,kme,  & ! memory dims
-                                   ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
-                                   grid%i_start(ij), grid%i_end(ij),       &
-                                   grid%j_start(ij), grid%j_end(ij),       &
-                                   k_start, k_end                               )
-           ENDIF
-         ENDDO tke_tile_loop_2
-         !$OMP END PARALLEL DO
-
-       ENDIF TKE_advance
-BENCH_END(tke_adv_tim)
-
-#ifdef WRF_CHEM
-!  next the chemical species
-BENCH_START(chem_adv_tim)
-       chem_scalar_advance: IF (num_3d_c >= PARAM_FIRST_SCALAR)  THEN
-
-         chem_variable_loop: DO ic = PARAM_FIRST_SCALAR, num_3d_c
-
-           !$OMP PARALLEL DO   &
-           !$OMP PRIVATE ( ij )
-           chem_tile_loop_1: DO ij = 1 , grid%num_tiles
-
-             CALL wrf_debug ( 200 , ' call rk_scalar_tend in chem_tile_loop_1' )
-             CALL rk_scalar_tend ( ic, ic, config_flags,                         &
-                              rk_step, dt_rk,                                    &
-                              grid%ru_m, grid%rv_m, grid%ww_m,                   &
-                              grid%mut, grid%mub, grid%mu_1,                     &
-                              grid%alt,                                          &
-                              chem_old(ims,kms,jms,ic),                          &
-                              chem(ims,kms,jms,ic),                              &
-                              chem_tend(ims,kms,jms,ic),                         &
-                              advect_tend,grid%rqvften,                          &
-                              grid%qv_base, .false., grid%fnm, grid%fnp,         &
-                              grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
-                              grid%msfvy, grid%msftx,grid%msfty,                 &
-                              grid%rdx, grid%rdy, grid%rdn, grid%rdnw,     &
-                              grid%khdif, grid%kvdif, grid%xkhh,                 &
-                              grid%diff_6th_opt, grid%diff_6th_factor,           &
-                              config_flags%pd_chem,                              &
-                              ids, ide, jds, jde, kds, kde,                      &
-                              ims, ime, jms, jme, kms, kme,                      &
-                              grid%i_start(ij), grid%i_end(ij),                  &
-                              grid%j_start(ij), grid%j_end(ij),                  &
-                              k_start    , k_end                                )
-!
-! Currently, chemistry species with specified boundaries (i.e. the mother
-! domain)  are being over written by flow_dep_bdy_chem. So, relax_bdy and
-! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
-! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.) 
-!
-           IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
-             IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
-             CALL relax_bdy_scalar ( chem_tend(ims,kms,jms,ic),                                    &
-                                     chem(ims,kms,jms,ic),  grid%mut,                              &
-                                     chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic),                &
-                                     chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic),                &
-                                     chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic),              &
-                                     chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic),              &
-                                     config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
-                                     grid%dtbc, grid%fcx, grid%gcx,                                &
-                                     config_flags,                                                 &
-                                     ids,ide, jds,jde, kds,kde,                                    &
-                                     ims,ime, jms,jme, kms,kme,                                    &
-                                     ips,ipe, jps,jpe, kps,kpe,                                    &
-                                     grid%i_start(ij), grid%i_end(ij),                             &
-                                     grid%j_start(ij), grid%j_end(ij),                             &
-                                     k_start, k_end                                                )
-             CALL spec_bdy_scalar  ( chem_tend(ims,kms,jms,ic),                 &
-                                     chem_bxs(jms,kms,1,ic),chem_bxe(jms,kms,1,ic),                &
-                                     chem_bys(ims,kms,1,ic),chem_bye(ims,kms,1,ic),                &
-                                     chem_btxs(jms,kms,1,ic),chem_btxe(jms,kms,1,ic),              &
-                                     chem_btys(ims,kms,1,ic),chem_btye(ims,kms,1,ic),              &
-                                     config_flags%spec_bdy_width, grid%spec_zone,                  &
-                                     config_flags,                                                 &
-                                     ids,ide, jds,jde, kds,kde,                                    &
-                                     ims,ime, jms,jme, kms,kme,                                    &
-                                     ips,ipe, jps,jpe, kps,kpe,                                    &
-                                     grid%i_start(ij), grid%i_end(ij),                             &
-                                     grid%j_start(ij), grid%j_end(ij),                             &
-                                     k_start, k_end                                                )
-           ENDIF
-
-         ENDDO chem_tile_loop_1
-         !$OMP END PARALLEL DO
-
-         !$OMP PARALLEL DO   &
-         !$OMP PRIVATE ( ij )
-
-         chem_tile_loop_2: DO ij = 1 , grid%num_tiles
-
-           CALL wrf_debug ( 200 , ' call rk_update_scalar' )
-           CALL rk_update_scalar( ic, ic,                           &
-                                  chem_old(ims,kms,jms,ic),         &  ! was chem_1
-                                  chem(ims,kms,jms,ic),             &
-                                  chem_tend(ims,kms,jms,ic),        &
-                                  advect_tend, grid%msftx, grid%msfty, &
-                                  grid%mu_1, grid%mu_2, grid%mub,      &
-                                  rk_step, dt_rk, grid%spec_zone,      &
-                                  config_flags,                     &
-                                  ids, ide, jds, jde, kds, kde,     &
-                                  ims, ime, jms, jme, kms, kme,     &
-                                  grid%i_start(ij), grid%i_end(ij), &
-                                  grid%j_start(ij), grid%j_end(ij), &
-                                  k_start    , k_end               )
-
-           IF( config_flags%specified  ) THEN
-             CALL flow_dep_bdy_chem( chem(ims,kms,jms,ic),                          &
-                                     chem_bxs(jms,kms,1,ic), chem_btxs(jms,kms,1,ic),  &
-                                     chem_bxe(jms,kms,1,ic), chem_btxe(jms,kms,1,ic),  &
-                                     chem_bys(ims,kms,1,ic), chem_btys(ims,kms,1,ic),  &
-                                     chem_bye(ims,kms,1,ic), chem_btye(ims,kms,1,ic),  &
-                                     dt_rk+grid%dtbc,                                  &
-                                     config_flags%spec_bdy_width,grid%z,      &
-                                     grid%have_bcs_chem,      &
-                                     grid%ru_m, grid%rv_m, config_flags,grid%alt,       &
-                                     grid%t_1,grid%pb,grid%p,t0,p1000mb,rcp,grid%ph_2,grid%phb,g, &
-                                     grid%spec_zone,ic,                  &
-                                     ids,ide, jds,jde, kds,kde,  & ! domain dims
-                                     ims,ime, jms,jme, kms,kme,  & ! memory dims
-                                     ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
-                                     grid%i_start(ij), grid%i_end(ij),   &
-                                     grid%j_start(ij), grid%j_end(ij),   &
-                                     k_start, k_end                      )
-           ENDIF
-         ENDDO chem_tile_loop_2
-         !$OMP END PARALLEL DO
-
-       ENDDO chem_variable_loop
-     ENDIF chem_scalar_advance
-BENCH_END(chem_adv_tim)
-#endif
-
-!  next the other scalar species
-     other_scalar_advance: IF (num_3d_s >= PARAM_FIRST_SCALAR)  THEN
-
-       scalar_variable_loop: do is = PARAM_FIRST_SCALAR, num_3d_s
-         !$OMP PARALLEL DO   &
-         !$OMP PRIVATE ( ij )
-         scalar_tile_loop_1: DO ij = 1 , grid%num_tiles
-
-           CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
-           CALL rk_scalar_tend ( is, is, config_flags,                            &
-                                 rk_step, dt_rk,                                  &
-                                 grid%ru_m, grid%rv_m, grid%ww_m,                 &
-                                 grid%mut, grid%mub, grid%mu_1,                   &
-                                 grid%alt,                                        &
-                                 scalar_old(ims,kms,jms,is),                      &
-                                 scalar(ims,kms,jms,is),                          &
-                                 scalar_tend(ims,kms,jms,is),                     &
-                                 advect_tend,grid%rqvften,                        &
-                                 grid%qv_base, .false., grid%fnm, grid%fnp,       &
-                                 grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
-                                 grid%msfvy, grid%msftx,grid%msfty,               &
-                                 grid%rdx, grid%rdy, grid%rdn, grid%rdnw,         &
-                                 grid%khdif, grid%kvdif, grid%xkhh,               &
-                                 grid%diff_6th_opt, grid%diff_6th_factor,         &
-                                 config_flags%pd_scalar,           &
-                                 ids, ide, jds, jde, kds, kde,     &
-                                 ims, ime, jms, jme, kms, kme,     &
-                                 grid%i_start(ij), grid%i_end(ij), &
-                                 grid%j_start(ij), grid%j_end(ij), &
-                                 k_start    , k_end               )
-
-           IF( config_flags%nested .and. (rk_step == 1) ) THEN
-
-             IF (is .EQ. P_QNDROP .OR. is .EQ. P_QNI          & 
-                                  .OR. is .EQ. P_QNS          &
-                                  .OR. is .EQ. P_QNR          &
-                                  .OR. is .EQ. P_QNG) THEN             
-
-               CALL relax_bdy_scalar ( scalar_tend(ims,kms,jms,is),                            &
-                                       scalar(ims,kms,jms,is),  grid%mut,                      &
-                                       scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is),      &
-                                       scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is),      &
-                                       scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is),    &
-                                       scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is),    &
-                                       config_flags%spec_bdy_width, grid%spec_zone, grid%relax_zone, &
-                                       grid%dtbc, grid%fcx, grid%gcx,                          &
-                                       config_flags,                                           &
-                                       ids,ide, jds,jde, kds,kde,                              &
-                                       ims,ime, jms,jme, kms,kme,                              &
-                                       ips,ipe, jps,jpe, kps,kpe,                              &
-                                       grid%i_start(ij), grid%i_end(ij),                       &
-                                       grid%j_start(ij), grid%j_end(ij),                       &
-                                       k_start, k_end                                          )
-
-               CALL spec_bdy_scalar  ( scalar_tend(ims,kms,jms,is),                            &
-                                       scalar_bxs(jms,kms,1,is),scalar_bxe(jms,kms,1,is),      &
-                                       scalar_bys(ims,kms,1,is),scalar_bye(ims,kms,1,is),      &
-                                       scalar_btxs(jms,kms,1,is),scalar_btxe(jms,kms,1,is),    &
-                                       scalar_btys(ims,kms,1,is),scalar_btye(ims,kms,1,is),    &
-                                       config_flags%spec_bdy_width, grid%spec_zone,            &
-                                       config_flags,                                           &
-                                       ids,ide, jds,jde, kds,kde,                              &
-                                       ims,ime, jms,jme, kms,kme,                              &
-                                       ips,ipe, jps,jpe, kps,kpe,                              &
-                                       grid%i_start(ij), grid%i_end(ij),                       &
-                                       grid%j_start(ij), grid%j_end(ij),                       &
-                                       k_start, k_end                                          )
-
-             ENDIF
-
-           ENDIF ! b.c test for chem nested boundary condition
-
-         ENDDO scalar_tile_loop_1
-         !$OMP END PARALLEL DO
-
-         !$OMP PARALLEL DO   &
-         !$OMP PRIVATE ( ij )
-         scalar_tile_loop_2: DO ij = 1 , grid%num_tiles
-
-           CALL wrf_debug ( 200 , ' call rk_update_scalar' )
-           CALL rk_update_scalar( is, is,                           &
-                                  scalar_old(ims,kms,jms,is),       &  ! was scalar_1
-                                  scalar(ims,kms,jms,is),           &
-                                  scalar_tend(ims,kms,jms,is),      &
-                                  advect_tend, grid%msftx, grid%msfty, &
-                                  grid%mu_1, grid%mu_2, grid%mub,                  &
-                                  rk_step, dt_rk, grid%spec_zone,        &
-                                  config_flags,     &
-                                  ids, ide, jds, jde, kds, kde,     &
-                                  ims, ime, jms, jme, kms, kme,     &
-                                  grid%i_start(ij), grid%i_end(ij), &
-                                  grid%j_start(ij), grid%j_end(ij), &
-                                  k_start    , k_end               )
-
-
-           IF( config_flags%specified ) THEN
-             CALL flow_dep_bdy  ( scalar(ims,kms,jms,is),     &
-                                  grid%ru_m, grid%rv_m, config_flags,   &
-                                  grid%spec_zone,                  &
-                                  ids,ide, jds,jde, kds,kde,  & ! domain dims
-                                  ims,ime, jms,jme, kms,kme,  & ! memory dims
-                                  ips,ipe, jps,jpe, kps,kpe,  & ! patch  dims
-                                  grid%i_start(ij), grid%i_end(ij),  &
-                                  grid%j_start(ij), grid%j_end(ij),  &
-                                  k_start, k_end                    )
-           ENDIF
-
-         ENDDO scalar_tile_loop_2
-         !$OMP END PARALLEL DO
-
-       ENDDO scalar_variable_loop
-
-     ENDIF other_scalar_advance
-
- !  update the pressure and density at the new time level
-
-     !$OMP PARALLEL DO   &
-     !$OMP PRIVATE ( ij )
-     DO ij = 1 , grid%num_tiles
-
-BENCH_START(calc_p_rho_tim)
-
-       CALL calc_p_rho_phi( moist, num_3d_m,                &
-                            grid%al, grid%alb, grid%mu_2, grid%muts,              &
-                            grid%ph_2, grid%p, grid%pb, grid%t_2,                 &
-                            p0, t0, grid%znu, grid%dnw, grid%rdnw,           &
-                            grid%rdn, config_flags%non_hydrostatic,             &
-                            ids, ide, jds, jde, kds, kde,     &
-                            ims, ime, jms, jme, kms, kme,     &
-                            grid%i_start(ij), grid%i_end(ij), &
-                            grid%j_start(ij), grid%j_end(ij), &
-                            k_start    , k_end               )
-
-BENCH_END(calc_p_rho_tim)
-
-     ENDDO
-     !$OMP END PARALLEL DO
-
-!  Reset the boundary conditions if there is another corrector step.
-!  (rk_step < rk_order), else we'll handle it at the end of everything
-!  (after the split physics, before exiting the timestep).
-
-     rk_step_1_check: IF ( rk_step < rk_order ) THEN
-
-!-----------------------------------------------------------
-!  rk3 substep polar filter for scalars (moist,chem,scalar)
-!-----------------------------------------------------------
-
-       IF (config_flags%polar) THEN 
-         IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
-           CALL wrf_debug ( 200 , ' call filter moist ' )
-           DO im = PARAM_FIRST_SCALAR, num_3d_m
-             CALL couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im)              &
-                    ,MU=grid%mu_2 , MUB=grid%mub                                 &
-                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
-             CALL pxft ( grid=grid                                               &
-                    ,lineno=__LINE__                                             &
-                    ,flag_uv            = 0                                      &
-                    ,flag_rurv          = 0                                      &
-                    ,flag_wph           = 0                                      &
-                    ,flag_ww            = 0                                      &
-                    ,flag_t             = 0                                      &
-                    ,flag_mu            = 0                                      &
-                    ,flag_mut           = 0                                      &
-                    ,flag_moist         = im                                     &
-                    ,flag_chem          = 0                                      &
-                    ,flag_scalar        = 0                                      &
-                    ,positive_definite=.FALSE.                                   &
-                    ,moist=moist,chem=chem,scalar=scalar                         &
-                    ,fft_filter_lat = config_flags%fft_filter_lat                &
-                    ,dclat = dclat                                               &
-                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
-                    ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
-                    ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
-             CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im)            &
-                    ,MU=grid%mu_2 , MUB=grid%mub                                 &
-                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
-           END DO
-         END IF
-   
-         IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
-           CALL wrf_debug ( 200 , ' call filter chem ' )
-           DO im = PARAM_FIRST_SCALAR, num_3d_c
-             CALL couple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im)               &
-                    ,MU=grid%mu_2 , MUB=grid%mub                                 &
-                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe           )
-             CALL pxft ( grid=grid                                               &
-                    ,lineno=__LINE__                                             &
-                    ,flag_uv            = 0                                      &
-                    ,flag_rurv          = 0                                      &
-                    ,flag_wph           = 0                                      &
-                    ,flag_ww            = 0                                      &
-                    ,flag_t             = 0                                      &
-                    ,flag_mu            = 0                                      &
-                    ,flag_mut           = 0                                      &
-                    ,flag_moist         = 0                                      &
-                    ,flag_chem          = im                                     &
-                    ,flag_scalar        = 0                                      &
-                    ,positive_definite=.FALSE.                                   &
-                    ,moist=moist,chem=chem,scalar=scalar                         &
-                    ,fft_filter_lat = config_flags%fft_filter_lat                &
-                    ,dclat = dclat                                               &
-                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
-                    ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
-                    ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
-             CALL uncouple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im)             &
-                    ,MU=grid%mu_2 , MUB=grid%mub                                 &
-                    ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                    ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                    ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
-           END DO
-         END IF
-   
-         IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
-           CALL wrf_debug ( 200 , ' call filter scalar ' )
-           DO im = PARAM_FIRST_SCALAR, num_3d_s
-             CALL couple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im)           &
-                  ,MU=grid%mu_2 , MUB=grid%mub                                 &
-                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
-             CALL pxft ( grid=grid                                             &
-                  ,lineno=__LINE__                                             &
-                  ,flag_uv            = 0                                      &
-                  ,flag_rurv          = 0                                      &
-                  ,flag_wph           = 0                                      &
-                  ,flag_ww            = 0                                      &
-                  ,flag_t             = 0                                      &
-                  ,flag_mu            = 0                                      &
-                  ,flag_mut           = 0                                      &
-                  ,flag_moist         = 0                                      &
-                  ,flag_chem          = 0                                      &
-                  ,flag_scalar        = im                                     &
-                  ,positive_definite=.FALSE.                                   &
-                  ,moist=moist,chem=chem,scalar=scalar                         &
-                  ,fft_filter_lat = config_flags%fft_filter_lat                &
-                  ,dclat = dclat                                               &
-                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
-                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
-                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
-             CALL uncouple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im)   &
-                  ,MU=grid%mu_2 , MUB=grid%mub                                 &
-                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
-           END DO
-         END IF
-       END IF ! polar filter test
-
-!-----------------------------------------------------------
-!  END rk3 substep polar filter for scalars (moist,chem,scalar)
-!-----------------------------------------------------------
-
-!-----------------------------------------------------------
-!  Stencils for patch communications  (WCS, 29 June 2001)
-!
-!  here's where we need a wide comm stencil - these are the 
-!  uncoupled variables so are used for high order calc in
-!  advection and mixong routines.
-!
-!
-!                                  * * * * * * *
-!                     * * * * *    * * * * * * *
-!            *        * * * * *    * * * * * * *
-!          * + *      * * + * *    * * * + * * *
-!            *        * * * * *    * * * * * * *
-!                     * * * * *    * * * * * * *
-!                                  * * * * * * *
-!
-! al        x
-!
-!  2D variable
-! mu_2      x
-!
-! (adv order <=4)
-! u_2                     x
-! v_2                     x
-! w_2                     x
-! t_2                     x
-! ph_2                    x
-!
-! (adv order <=6)
-! u_2                                    x
-! v_2                                    x
-! w_2                                    x
-! t_2                                    x
-! ph_2                                   x
-!
-!  4D variable
-! moist                   x
-! chem                    x
-! scalar                  x
-
-#ifdef DM_PARALLEL
-       IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
-#    include "HALO_EM_D2_3.inc"
-       ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
-#    include "HALO_EM_D2_5.inc"
-       ELSE 
-         WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
-         CALL wrf_error_fatal(TRIM(wrf_err_message))
-       ENDIF
-#  include "PERIOD_BDY_EM_D.inc"
-#  include "PERIOD_BDY_EM_MOIST2.inc"
-#  include "PERIOD_BDY_EM_CHEM2.inc"
-#  include "PERIOD_BDY_EM_SCALAR2.inc"
-#endif
-
-BENCH_START(bc_end_tim)
-       !$OMP PARALLEL DO   &
-       !$OMP PRIVATE ( ij )
-       tile_bc_loop_1: DO ij = 1 , grid%num_tiles
-         CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_2' )
-
-         CALL rk_phys_bc_dry_2( config_flags,                     &
-                                grid%u_2, grid%v_2, grid%w_2,     &
-                                grid%t_2, grid%ph_2, grid%mu_2,   &
-                                ids, ide, jds, jde, kds, kde,     &
-                                ims, ime, jms, jme, kms, kme,     &
-                                ips, ipe, jps, jpe, kps, kpe,     &
-                                grid%i_start(ij), grid%i_end(ij), &
-                                grid%j_start(ij), grid%j_end(ij), &
-                                k_start    , k_end               )
-
-BENCH_START(diag_w_tim)
-         IF (.not. config_flags%non_hydrostatic) THEN
-           CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, dt_rk,  &
-                            grid%u_2, grid%v_2, grid%ht,                           &
-                            grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
-                            ids, ide, jds, jde, kds, kde,           &
-                            ims, ime, jms, jme, kms, kme,           &
-                            grid%i_start(ij), grid%i_end(ij),       &
-                            grid%j_start(ij), grid%j_end(ij),       &
-                            k_start    , k_end                     )
-         ENDIF
-BENCH_END(diag_w_tim)
-
-         IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
-
-           moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
-  
-             CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags,   &
-                                     ids, ide, jds, jde, kds, kde,             &
-                                     ims, ime, jms, jme, kms, kme,             &
-                                     ips, ipe, jps, jpe, kps, kpe,             &
-                                     grid%i_start(ij), grid%i_end(ij),                   &
-                                     grid%j_start(ij), grid%j_end(ij),                   &
-                                     k_start    , k_end                       )
-           END DO moisture_loop_bdy_1
-
-         ENDIF
-
-         IF (num_3d_c >= PARAM_FIRST_SCALAR) THEN
-
-           chem_species_bdy_loop_1 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
-
-             CALL set_physical_bc3d( chem(ims,kms,jms,ic), 'p', config_flags,   &
-                                     ids, ide, jds, jde, kds, kde,            &
-                                     ims, ime, jms, jme, kms, kme,            &
-                                     ips, ipe, jps, jpe, kps, kpe,            &
-                                     grid%i_start(ij), grid%i_end(ij),                  &
-                                     grid%j_start(ij), grid%j_end(ij),                  &
-                                     k_start    , k_end-1                    )
-
-           END DO chem_species_bdy_loop_1
-
-         END IF
-
-         IF (num_3d_s >= PARAM_FIRST_SCALAR) THEN
-
-           scalar_species_bdy_loop_1 : DO is = PARAM_FIRST_SCALAR , num_3d_s
-
-             CALL set_physical_bc3d( scalar(ims,kms,jms,is), 'p', config_flags,   &
-                                     ids, ide, jds, jde, kds, kde,            &
-                                     ims, ime, jms, jme, kms, kme,            &
-                                     ips, ipe, jps, jpe, kps, kpe,            &
-                                     grid%i_start(ij), grid%i_end(ij),                  &
-                                     grid%j_start(ij), grid%j_end(ij),                  &
-                                     k_start    , k_end-1                    )
-
-           END DO scalar_species_bdy_loop_1
-
-         END IF
-
-         IF (config_flags%km_opt .eq. 2) THEN
-
-           CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags,  &
-                                   ids, ide, jds, jde, kds, kde,            &
-                                   ims, ime, jms, jme, kms, kme,            &
-                                   ips, ipe, jps, jpe, kps, kpe,            &
-                                   grid%i_start(ij), grid%i_end(ij),        &
-                                   grid%j_start(ij), grid%j_end(ij),        &
-                                   k_start    , k_end                      )
-         END IF
-
-       END DO tile_bc_loop_1
-       !$OMP END PARALLEL DO
-BENCH_END(bc_end_tim)
-
-
-#ifdef DM_PARALLEL
-
-!                           * * * * *
-!         *        * * *    * * * * *
-!       * + *      * + *    * * + * *
-!         *        * * *    * * * * *
-!                           * * * * *
-
-! moist, chem, scalar, tke      x
-
-
-       IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
-         IF ( (config_flags%pd_tke) .and. (rk_step == rk_order-1) ) THEN
-#         include "HALO_EM_TKE_5.inc"
-         ELSE
-#         include "HALO_EM_TKE_3.inc"
-         ENDIF
-       ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
-         IF ( (config_flags%pd_tke) .and. (rk_step == rk_order-1) ) THEN
-#         include "HALO_EM_TKE_7.inc"
-         ELSE
-#         include "HALO_EM_TKE_5.inc"
-         ENDIF
-       ELSE
-         WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
-         CALL wrf_error_fatal(TRIM(wrf_err_message))
-       ENDIF
-
-       IF ( num_moist .GE. PARAM_FIRST_SCALAR ) THEN
-         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
-           IF ( (config_flags%pd_moist) .and. (rk_step == rk_order-1) ) THEN
-#        include "HALO_EM_MOIST_E_5.inc"
-           ELSE
-#        include "HALO_EM_MOIST_E_3.inc"
-           END IF
-         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
-           IF ( (config_flags%pd_moist) .and. (rk_step == rk_order-1) ) THEN
-#        include "HALO_EM_MOIST_E_7.inc"
-           ELSE
-#        include "HALO_EM_MOIST_E_5.inc"
-           END IF
-         ELSE
-           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
-           CALL wrf_error_fatal(TRIM(wrf_err_message))
-         ENDIF
-       ENDIF
-       IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
-         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
-           IF ( (config_flags%pd_chem) .and. (rk_step == rk_order-1) ) THEN
-#        include "HALO_EM_CHEM_E_5.inc"
-           ELSE
-#        include "HALO_EM_CHEM_E_3.inc"
-           ENDIF
-         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
-           IF ( (config_flags%pd_chem) .and. (rk_step == rk_order-1) ) THEN
-#        include "HALO_EM_CHEM_E_7.inc"
-           ELSE
-#        include "HALO_EM_CHEM_E_5.inc"
-           ENDIF
-         ELSE
-           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
-           CALL wrf_error_fatal(TRIM(wrf_err_message))
-         ENDIF
-       ENDIF
-       IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
-         IF      ( config_flags%h_sca_adv_order <= 4 ) THEN
-           IF ( (config_flags%pd_scalar) .and. (rk_step == rk_order-1) ) THEN
-#        include "HALO_EM_SCALAR_E_5.inc"
-           ELSE
-#        include "HALO_EM_SCALAR_E_3.inc"
-           ENDIF
-         ELSE IF ( config_flags%h_sca_adv_order <= 6 ) THEN
-           IF ( (config_flags%pd_scalar) .and. (rk_step == rk_order-1) ) THEN
-#        include "HALO_EM_SCALAR_E_7.inc"
-           ELSE
-#        include "HALO_EM_SCALAR_E_5.inc"
-           ENDIF
-         ELSE
-           WRITE(wrf_err_message,*)'solve_em: invalid h_sca_adv_order = ',config_flags%h_sca_adv_order
-           CALL wrf_error_fatal(TRIM(wrf_err_message))
-         ENDIF
-       ENDIF
-#endif
-
-     ENDIF rk_step_1_check
-
-
-!**********************************************************
-!
-!  end of RK predictor-corrector loop
-!
-!**********************************************************
-
-   END DO Runge_Kutta_loop
-
-   !$OMP PARALLEL DO   &
-   !$OMP PRIVATE ( ij )
-   DO ij = 1 , grid%num_tiles
-
-BENCH_START(advance_ppt_tim)
-     CALL wrf_debug ( 200 , ' call advance_ppt' )
-     CALL advance_ppt(grid%rthcuten,grid%rqvcuten,grid%rqccuten,grid%rqrcuten, &
-                      grid%rqicuten,grid%rqscuten,grid%rainc,grid%raincv,grid%pratec, grid%nca,    &
-                      grid%htop,grid%hbot,grid%cutop,grid%cubot,                 &
-                      grid%cuppt, grid%dt, config_flags,                   &
-                      ids,ide, jds,jde, kds,kde,             &
-                      ims,ime, jms,jme, kms,kme,             &
-                      grid%i_start(ij), grid%i_end(ij),      &
-                      grid%j_start(ij), grid%j_end(ij),      &
-                      k_start    , k_end                    )
-BENCH_END(advance_ppt_tim)
-
-   ENDDO
-  !$OMP END PARALLEL DO
-
-!
-!
-! (5) time-split physics.
-!
-!     Microphysics are the only time  split physics in the WRF model 
-!     at this time.  Split-physics begins with the calculation of
-!     needed diagnostic quantities (pressure, temperature, etc.)
-!     followed by a call to the microphysics driver, 
-!     and finishes with a clean-up, storing off of a diabatic tendency
-!     from the moist physics, and a re-calulation of the  diagnostic
-!     quantities pressure and density.
-!

-!
-
-   IF( config_flags%specified .or. config_flags%nested ) THEN
-     sz = grid%spec_zone
-   ELSE
-     sz = 0
-   ENDIF
-
-!!!!****MARS MARS
-!!!!****MARS MARS
-
-!   IF (config_flags%mp_physics /= 0)  then
-!
-!     !$OMP PARALLEL DO   &
-!     !$OMP PRIVATE ( ij, its, ite, jts, jte )
-!
-!     scalar_tile_loop_1a: DO ij = 1 , grid%num_tiles
-!
-!       IF ( config_flags%periodic_x ) THEN
-!         its = max(grid%i_start(ij),ids)
-!         ite = min(grid%i_end(ij),ide-1)
-!       ELSE
-!         its = max(grid%i_start(ij),ids+sz)
-!         ite = min(grid%i_end(ij),ide-1-sz)
-!       ENDIF
-!       jts = max(grid%j_start(ij),jds+sz)
-!       jte = min(grid%j_end(ij),jde-1-sz)
-!
-!       CALL wrf_debug ( 200 , ' call moist_physics_prep' )
-!BENCH_START(moist_physics_prep_tim)
-!       CALL moist_physics_prep_em( grid%t_2, grid%t_1, t0, rho,                &
-!                                   grid%al, grid%alb, grid%p, p8w, p0, grid%pb,          &
-!                                   grid%ph_2, grid%phb, th_phy, pi_phy, p_phy, &
-!                                   grid%z, z_at_w, dz8w,                  &
-!                                   dtm, grid%h_diabatic,                  &
-!                                   config_flags,grid%fnm, grid%fnp,            &
-!                                   ids, ide, jds, jde, kds, kde,     &
-!                                   ims, ime, jms, jme, kms, kme,     &
-!                                   its, ite, jts, jte,               &
-!                                   k_start    , k_end               )
-!BENCH_END(moist_physics_prep_tim)
-!     END DO scalar_tile_loop_1a
-!     !$OMP END PARALLEL DO
-!
-!     CALL wrf_debug ( 200 , ' call microphysics_driver' )
-!
-!     grid%sr = 0.
-!     specified_bdy = config_flags%specified .OR. config_flags%nested
-!     channel_bdy = config_flags%specified .AND. config_flags%periodic_x
-!
-!BENCH_START(micro_driver_tim)
-!
-!     CALL microphysics_driver(                                            &
-!      &         DT=dtm             ,DX=grid%dx              ,DY=grid%dy   &
-!      &        ,DZ8W=dz8w          ,F_ICE_PHY=grid%f_ice_phy              &
-!      &        ,ITIMESTEP=grid%itimestep                    ,LOWLYR=grid%lowlyr  &
-!      &        ,P8W=p8w            ,P=p_phy            ,PI_PHY=pi_phy     &
-!      &        ,RHO=rho            ,SPEC_ZONE=grid%spec_zone              &
-!      &        ,SR=grid%sr              ,TH=th_phy                        &
-!      &        ,WARM_RAIN=grid%warm_rain                                  &
-!      &        ,T8W=t8w                                                   &
-!      &        ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h &
-!      &        ,NSOURCE=grid%qndropsource                                 &
-!#ifdef WRF_CHEM
-!      &        ,QLSINK=grid%qlsink,CLDFRA_OLD=grid%cldfra_old             &
-!      &        ,PRECR=grid%precr, PRECI=grid%preci, PRECS=grid%precs, PRECG=grid%precg &
-!      &        ,CHEM_OPT=config_flags%chem_opt, PROGN=config_flags%progn  &
-!#endif
-!      &        ,XLAND=grid%xland                                          &
-!      &        ,SPECIFIED=specified_bdy, CHANNEL_SWITCH=channel_bdy       &
-!      &        ,F_RAIN_PHY=grid%f_rain_phy                                &
-!      &        ,F_RIMEF_PHY=grid%f_rimef_phy                              &
-!      &        ,MP_PHYSICS=config_flags%mp_physics                        &
-!      &        ,ID=grid%id                                                &
-!      &        ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde         &
-!      &        ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme         &
-!#ifdef RUN_ON_GPU
-!      &        ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe         &
-!#endif
-!      &        ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)         &
-!      &        ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)         &
-!      &        ,KTS=k_start, KTE=min(k_end,kde-1)                         &
-!      &        ,NUM_TILES=grid%num_tiles                                  &
-!      &        ,NAER=grid%naer                                            &
-!                 ! Optional
-!      &        , RAINNC=grid%rainnc, RAINNCV=grid%rainncv                 &
-!      &        , SNOWNC=grid%snownc, SNOWNCV=grid%snowncv                 &
-!      &        , GRAUPELNC=grid%graupelnc, GRAUPELNCV=grid%graupelncv     &
-!      &        , W=grid%w_2, Z=grid%z, HT=grid%ht                         &
-!      &        , MP_RESTART_STATE=grid%mp_restart_state                   &
-!      &        , TBPVS_STATE=grid%tbpvs_state                             & ! etampnew
-!      &        , TBPVS0_STATE=grid%tbpvs0_state                           & ! etampnew
-!      &        , QV_CURR=moist(ims,kms,jms,P_QV), F_QV=F_QV               &
-!      &        , QC_CURR=moist(ims,kms,jms,P_QC), F_QC=F_QC               &
-!      &        , QR_CURR=moist(ims,kms,jms,P_QR), F_QR=F_QR               &
-!      &        , QI_CURR=moist(ims,kms,jms,P_QI), F_QI=F_QI               &
-!      &        , QS_CURR=moist(ims,kms,jms,P_QS), F_QS=F_QS               &
-!      &        , QG_CURR=moist(ims,kms,jms,P_QG), F_QG=F_QG               &
-!      &        , QNDROP_CURR=scalar(ims,kms,jms,P_QNDROP), F_QNDROP=F_QNDROP &
-!      &        , QNI_CURR=scalar(ims,kms,jms,P_QNI), F_QNI=F_QNI          &
-!      &        , QT_CURR=scalar(ims,kms,jms,P_QT), F_QT=F_QT              &
-!      &        , QNS_CURR=scalar(ims,kms,jms,P_QNS), F_QNS=F_QNS          &  
-!      &        , QNR_CURR=scalar(ims,kms,jms,P_QNR), F_QNR=F_QNR          &  
-!      &        , QNG_CURR=scalar(ims,kms,jms,P_QNG), F_QNG=F_QNG          &  
-!      &        , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten             &  
-!      &        , qicuten=grid%rqicuten,mu=grid%mut                        &  
-!      &        , HAIL=config_flags%gsfcgce_hail                           & ! for gsfcgce
-!      &        , ICE2=config_flags%gsfcgce_2ice                           & ! for gsfcgce
-!                                                                          )
-!BENCH_END(micro_driver_tim)
-!
-!#if 0
-!BENCH_START(microswap_2)
-!! for load balancing; communication to redistribute the points
-!     IF ( config_flags%mp_physics .EQ. ETAMPNEW ) THEN
-!#include "SWAP_ETAMP_NEW.inc"
-!     ELSE IF ( config_flags%mp_physics .EQ. WSM3SCHEME ) THEN
-!#include "SWAP_WSM3.inc"
-!     ENDIF
-!BENCH_END(microswap_2)
-!#endif
-!
-!     CALL wrf_debug ( 200 , ' call moist_physics_finish' )
-!BENCH_START(moist_phys_end_tim)
-!
-!     !$OMP PARALLEL DO   &
-!     !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
-!
-!     DO ij = 1 , grid%num_tiles
-!
-!       IF ( config_flags%periodic_x ) THEN
-!         its = max(grid%i_start(ij),ids)
-!         ite = min(grid%i_end(ij),ide-1)
-!       ELSE
-!         its = max(grid%i_start(ij),ids+sz)
-!         ite = min(grid%i_end(ij),ide-1-sz)
-!       ENDIF
-!       jts = max(grid%j_start(ij),jds+sz)
-!       jte = min(grid%j_end(ij),jde-1-sz)
-!
-!       CALL microphysics_zero_out (                                    &
-!                      moist , num_moist , config_flags ,                &
-!                      ids, ide, jds, jde, kds, kde,                     &
-!                      ims, ime, jms, jme, kms, kme,                     &
-!                      its, ite, jts, jte,                               &
-!                      k_start    , k_end                                )
-!
-!
-!       CALL moist_physics_finish_em( grid%t_2, grid%t_1, t0, grid%muts, th_phy,       &
-!                                      grid%h_diabatic, dtm, config_flags,    &
-!                                      ids, ide, jds, jde, kds, kde,     &
-!                                      ims, ime, jms, jme, kms, kme,     &
-!                                      its, ite, jts, jte,               &
-!                                      k_start    , k_end               )
-!
-!     END DO
-!     !$OMP END PARALLEL DO
-!
-!   ENDIF  ! microphysics test
-
-!-----------------------------------------------------------
-!  filter for moist variables post-microphysics and end of timestep
-!-----------------------------------------------------------
-
-   IF (config_flags%polar) THEN
-     IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
-       CALL wrf_debug ( 200 , ' call filter moist' )
-       DO im = PARAM_FIRST_SCALAR, num_3d_m
-         DO jj = jps, MIN(jpe,jde-1)
-           DO kk = kps, MIN(kpe,kde-1)
-             DO ii = ips, MIN(ipe,ide-1)
-               moist(ii,kk,jj,im)=moist(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
-             ENDDO
-           ENDDO
-         ENDDO
- 
-         CALL pxft ( grid=grid                                                 &
-                  ,lineno=__LINE__                                             &
-                  ,flag_uv            = 0                                      &
-                  ,flag_rurv          = 0                                      &
-                  ,flag_wph           = 0                                      &
-                  ,flag_ww            = 0                                      &
-                  ,flag_t             = 0                                      &
-                  ,flag_mu            = 0                                      &
-                  ,flag_mut           = 0                                      &
-                  ,flag_moist         = im                                     &
-                  ,flag_chem          = 0                                      &
-                  ,flag_scalar        = 0                                      &
-                  ,positive_definite=.FALSE.                                   &
-                  ,moist=moist,chem=chem,scalar=scalar                         &
-                  ,fft_filter_lat = config_flags%fft_filter_lat                &
-                  ,dclat = dclat                                               &
-                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
-                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
-                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
- 
-         DO jj = jps, MIN(jpe,jde-1)
-           DO kk = kps, MIN(kpe,kde-1)
-             DO ii = ips, MIN(ipe,ide-1)
-               moist(ii,kk,jj,im)=moist(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
-             ENDDO
-           ENDDO
-         ENDDO
-       ENDDO
-     ENDIF
-   ENDIF
-
-!-----------------------------------------------------------
-!  end filter for moist variables post-microphysics and end of timestep
-!-----------------------------------------------------------
-
-   !$OMP PARALLEL DO   &
-   !$OMP PRIVATE ( ij, its, ite, jts, jte, im, ii, jj, kk )
-   scalar_tile_loop_1ba: DO ij = 1 , grid%num_tiles
-
-     IF ( config_flags%periodic_x ) THEN
-       its = max(grid%i_start(ij),ids)
-       ite = min(grid%i_end(ij),ide-1)
-     ELSE
-       its = max(grid%i_start(ij),ids+sz)
-       ite = min(grid%i_end(ij),ide-1-sz)
-     ENDIF
-     jts = max(grid%j_start(ij),jds+sz)
-     jte = min(grid%j_end(ij),jde-1-sz)
-
-     CALL calc_p_rho_phi( moist, num_3d_m,                &
-                          grid%al, grid%alb, grid%mu_2, grid%muts,              &
-                          grid%ph_2, grid%p, grid%pb, grid%t_2,                 &
-                          p0, t0, grid%znu, grid%dnw, grid%rdnw,           &
-                          grid%rdn, config_flags%non_hydrostatic,             &
-                          ids, ide, jds, jde, kds, kde,     &
-                          ims, ime, jms, jme, kms, kme,     &
-                          its, ite, jts, jte,               &
-                          k_start    , k_end               )
-
-   END DO scalar_tile_loop_1ba
-   !$OMP END PARALLEL DO
-BENCH_END(moist_phys_end_tim)
-
-   IF (.not. config_flags%non_hydrostatic) THEN
-#ifdef DM_PARALLEL
-#    include "HALO_EM_HYDRO_UV.inc"
-#    include "PERIOD_EM_HYDRO_UV.inc"
-#endif
-     !$OMP PARALLEL DO   &
-     !$OMP PRIVATE ( ij )
-     DO ij = 1 , grid%num_tiles
-       CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, dt_rk,  &
-                       grid%u_2, grid%v_2, grid%ht,                           &
-                       grid%cf1, grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
-                       ids, ide, jds, jde, kds, kde,           &
-                       ims, ime, jms, jme, kms, kme,           &
-                       grid%i_start(ij), grid%i_end(ij),       &
-                       grid%j_start(ij), grid%j_end(ij),       &
-                       k_start    , k_end                     )
-
-     END DO
-     !$OMP END PARALLEL DO
-
-   END IF
-
-   CALL wrf_debug ( 200 , ' call chem polar filter ' )
-
-!-----------------------------------------------------------
-!  filter for chem and scalar variables at end of timestep
-!-----------------------------------------------------------
-
-   IF (config_flags%polar) THEN
-
-     IF ( num_3d_c >= PARAM_FIRST_SCALAR ) then
-       chem_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_c
-         DO jj = jps, MIN(jpe,jde-1)
-           DO kk = kps, MIN(kpe,kde-1)
-             DO ii = ips, MIN(ipe,ide-1)
-               chem(ii,kk,jj,im)=chem(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
-             ENDDO
-           ENDDO
-         ENDDO
-
-         CALL pxft ( grid=grid                                                 &
-                  ,lineno=__LINE__                                             &
-                  ,flag_uv            = 0                                      &
-                  ,flag_rurv          = 0                                      &
-                  ,flag_wph           = 0                                      &
-                  ,flag_ww            = 0                                      &
-                  ,flag_t             = 0                                      &
-                  ,flag_mu            = 0                                      &
-                  ,flag_mut           = 0                                      &
-                  ,flag_moist         = 0                                      &
-                  ,flag_chem          = im                                     &
-                  ,flag_scalar        = 0                                      &
-                  ,positive_definite=.FALSE.                                   &
-                  ,moist=moist,chem=chem,scalar=scalar                         &
-                  ,fft_filter_lat = config_flags%fft_filter_lat                &
-                  ,dclat = dclat                                               &
-                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
-                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
-                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
-
-         DO jj = jps, MIN(jpe,jde-1)
-           DO kk = kps, MIN(kpe,kde-1)
-             DO ii = ips, MIN(ipe,ide-1)
-               chem(ii,kk,jj,im)=chem(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
-             ENDDO
-           ENDDO
-         ENDDO
-       ENDDO chem_filter_loop
-     ENDIF
-
-     IF ( num_3d_s >= PARAM_FIRST_SCALAR ) then
-       scalar_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_s
-         DO jj = jps, MIN(jpe,jde-1)
-           DO kk = kps, MIN(kpe,kde-1)
-             DO ii = ips, MIN(ipe,ide-1)
-               scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj))
-             ENDDO
-           ENDDO
-         ENDDO
-
-         CALL pxft ( grid=grid                                                 &
-                  ,lineno=__LINE__                                             &
-                  ,flag_uv            = 0                                      &
-                  ,flag_rurv          = 0                                      &
-                  ,flag_wph           = 0                                      &
-                  ,flag_ww            = 0                                      &
-                  ,flag_t             = 0                                      &
-                  ,flag_mu            = 0                                      &
-                  ,flag_mut           = 0                                      &
-                  ,flag_moist         = 0                                      &
-                  ,flag_chem          = 0                                      &
-                  ,flag_scalar        = im                                     &
-                  ,positive_definite=.FALSE.                                   &
-                  ,moist=moist,chem=chem,scalar=scalar                         &
-                  ,fft_filter_lat = config_flags%fft_filter_lat                &
-                  ,dclat = dclat                                               &
-                  ,ids=ids,ide=ide,jds=jds,jde=jde,kds=kds,kde=kde             &
-                  ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
-                  ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
-                  ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
-                  ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
-
-         DO jj = jps, MIN(jpe,jde-1)
-           DO kk = kps, MIN(kpe,kde-1)
-             DO ii = ips, MIN(ipe,ide-1)
-               scalar(ii,kk,jj,im)=scalar(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj))
-             ENDDO
-           ENDDO
-         ENDDO
-       ENDDO scalar_filter_loop
-     ENDIF
-   ENDIF
-
-!-----------------------------------------------------------
-!  end filter for chem and scalar variables at end of timestep
-!-----------------------------------------------------------
-
-   !  We're finished except for boundary condition (and patch) update
-
-   ! Boundary condition time (or communication time).  At this time, we have
-   ! implemented periodic and symmetric physical boundary conditions.
-
-   ! b.c. routine for data within patch.
-
-   ! we need to do both time levels of 
-   ! data because the time filter only works in the physical solution space.
-
-   ! First, do patch communications for boundary conditions (periodicity)
-
-!-----------------------------------------------------------
-!  Stencils for patch communications  (WCS, 29 June 2001)
-!
-!  here's where we need a wide comm stencil - these are the 
-!  uncoupled variables so are used for high order calc in
-!  advection and mixong routines.
-!
-!                              * * * * *
-!            *        * * *    * * * * *
-!          * + *      * + *    * * + * * 
-!            *        * * *    * * * * *
-!                              * * * * *
-!
-!   grid%u_1                            x
-!   grid%u_2                            x
-!   grid%v_1                            x
-!   grid%v_2                            x
-!   grid%w_1                            x
-!   grid%w_2                            x
-!   grid%t_1                            x
-!   grid%t_2                            x
-!  grid%ph_1                            x
-!  grid%ph_2                            x
-!  grid%tke_1                           x
-!  grid%tke_2                           x
-!
-!    2D variables
-!  grid%mu_1     x
-!  grid%mu_2     x
-!
-!    4D variables
-!  moist                         x
-!   chem                         x
-! scalar                         x
-!----------------------------------------------------------
-
-
-#ifdef DM_PARALLEL
-   IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
-#    include "HALO_EM_D3_3.inc"
-   ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
-#    include "HALO_EM_D3_5.inc"
-   ELSE 
-      WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
-      CALL wrf_error_fatal(TRIM(wrf_err_message))
-   ENDIF
-#  include "PERIOD_BDY_EM_D3.inc"
-#  include "PERIOD_BDY_EM_MOIST.inc"
-#  include "PERIOD_BDY_EM_CHEM.inc"
-#  include "PERIOD_BDY_EM_SCALAR.inc"
-#endif
-
-!  now set physical b.c on a patch
-
-BENCH_START(bc_2d_tim)
-   !$OMP PARALLEL DO   &
-   !$OMP PRIVATE ( ij )
-   tile_bc_loop_2: DO ij = 1 , grid%num_tiles
-
-     CALL wrf_debug ( 200 , ' call set_phys_bc_dry_2' )
-
-     CALL set_phys_bc_dry_2( config_flags,                           &
-                             grid%u_1, grid%u_2, grid%v_1, grid%v_2, grid%w_1, grid%w_2,           &
-                             grid%t_1, grid%t_2, grid%ph_1, grid%ph_2, grid%mu_1, grid%mu_2,       &
-                             ids, ide, jds, jde, kds, kde,           &
-                             ims, ime, jms, jme, kms, kme,           &
-                             ips, ipe, jps, jpe, kps, kpe,           &
-                             grid%i_start(ij), grid%i_end(ij),       &
-                             grid%j_start(ij), grid%j_end(ij),       &
-                             k_start    , k_end                     )
-
-     CALL set_physical_bc3d( grid%tke_1, 'p', config_flags,   &
-                             ids, ide, jds, jde, kds, kde,            &
-                             ims, ime, jms, jme, kms, kme,            &
-                             ips, ipe, jps, jpe, kps, kpe,            &
-                             grid%i_start(ij), grid%i_end(ij),        &
-                             grid%j_start(ij), grid%j_end(ij),        &
-                             k_start    , k_end-1                    )
-
-     CALL set_physical_bc3d( grid%tke_2 , 'p', config_flags,  &
-                             ids, ide, jds, jde, kds, kde,            &
-                             ims, ime, jms, jme, kms, kme,            &
-                             ips, ipe, jps, jpe, kps, kpe,            &
-                             grid%i_start(ij), grid%i_end(ij),        &
-                             grid%j_start(ij), grid%j_end(ij),        &
-                             k_start    , k_end                      )
-
-     moisture_loop_bdy_2 : DO im = PARAM_FIRST_SCALAR , num_3d_m
-
-       CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p',           &
-                               config_flags,                           &
-                               ids, ide, jds, jde, kds, kde,           &
-                               ims, ime, jms, jme, kms, kme,           &
-                               ips, ipe, jps, jpe, kps, kpe,           &
-                               grid%i_start(ij), grid%i_end(ij),       &
-                               grid%j_start(ij), grid%j_end(ij),       &
-                               k_start    , k_end                     )
-
-     END DO moisture_loop_bdy_2
-
-     chem_species_bdy_loop_2 : DO ic = PARAM_FIRST_SCALAR , num_3d_c
-
-       CALL set_physical_bc3d( chem(ims,kms,jms,ic) , 'p', config_flags,  &
-                               ids, ide, jds, jde, kds, kde,            &
-                               ims, ime, jms, jme, kms, kme,            &
-                               ips, ipe, jps, jpe, kps, kpe,            &
-                               grid%i_start(ij), grid%i_end(ij),                  &
-                               grid%j_start(ij), grid%j_end(ij),                  &
-                               k_start    , k_end                      )
-
-     END DO chem_species_bdy_loop_2
-
-     scalar_species_bdy_loop_2 : DO is = PARAM_FIRST_SCALAR , num_3d_s
-
-       CALL set_physical_bc3d( scalar(ims,kms,jms,is) , 'p', config_flags,  &
-                               ids, ide, jds, jde, kds, kde,            &
-                               ims, ime, jms, jme, kms, kme,            &
-                               ips, ipe, jps, jpe, kps, kpe,            &
-                               grid%i_start(ij), grid%i_end(ij),                  &
-                               grid%j_start(ij), grid%j_end(ij),                  &
-                               k_start    , k_end                      )
-
-     END DO scalar_species_bdy_loop_2
-
-   END DO tile_bc_loop_2
-   !$OMP END PARALLEL DO
-BENCH_END(bc_2d_tim)
-
-   IF( config_flags%specified .or. config_flags%nested ) THEN 
-     grid%dtbc = grid%dtbc + grid%dt
-   ENDIF
-
-!!!!****MARS MARS
-!!!!****MARS MARS
-
-!! calculate some model diagnostics.
-!
-!   CALL wrf_debug ( 200 , ' call diagnostic_driver' )
-!   
-!   CALL diagnostic_output_calc(                                            &
-!      &              DPSDT=grid%dpsdt   ,DMUDT=grid%dmudt                  &
-!      &             ,P8W=p8w   ,PK1M=grid%pk1m                             &
-!      &             ,MU_2=grid%mu_2  ,MU_2M=grid%mu_2m                     &
-!      &             ,U=grid%u_2    ,V=grid%v_2                             &
-!      &             ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv           &
-!      &             ,RAINC=grid%rainc    ,RAINNC=grid%rainnc               &
-!      &             ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh     &
-!      &             ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width      &
-!      &             ,XTIME=grid%xtime                                      &
-!                  ! Selection flag
-!      &             ,DIAG_PRINT=config_flags%diag_print                    &
-!                  ! Dimension arguments
-!      &             ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde     &
-!      &             ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme     &
-!      &             ,IPS=ips,IPE=ipe, JPS=jps,JPE=jpe, KPS=kps,KPE=kpe     &
-!      &             ,I_START=grid%i_start,I_END=min(grid%i_end, ide-1)     &
-!      &             ,J_START=grid%j_start,J_END=min(grid%j_end, jde-1)     &
-!      &             ,KTS=k_start, KTE=min(k_end,kde-1)                     &
-!      &             ,NUM_TILES=grid%num_tiles                              &
-!      &                                                          )
-
-#ifdef DM_PARALLEL
-!-----------------------------------------------------------------------
-! see above
-!--------------------------------------------------------------
-   CALL wrf_debug ( 200 , ' call HALO_RK_E' )
-   IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
-#    include "HALO_EM_E_3.inc"
-   ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
-#    include "HALO_EM_E_5.inc"
-   ELSE
-     WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
-     CALL wrf_error_fatal(TRIM(wrf_err_message))
-   ENDIF
-#endif
-
-#ifdef DM_PARALLEL
-   IF ( num_moist >= PARAM_FIRST_SCALAR  ) THEN
-!-----------------------------------------------------------------------
-! see above
-!--------------------------------------------------------------
-     CALL wrf_debug ( 200 , ' call HALO_RK_MOIST' )
-     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
-#      include "HALO_EM_MOIST_E_3.inc"
-     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
-#      include "HALO_EM_MOIST_E_5.inc"
-     ELSE
-       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
-       CALL wrf_error_fatal(TRIM(wrf_err_message))
-     ENDIF
-   ENDIF
-   IF ( num_chem >= PARAM_FIRST_SCALAR ) THEN
-!-----------------------------------------------------------------------
-! see above
-!--------------------------------------------------------------
-     CALL wrf_debug ( 200 , ' call HALO_RK_CHEM' )
-     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
-#      include "HALO_EM_CHEM_E_3.inc"
-     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
-#      include "HALO_EM_CHEM_E_5.inc"
-     ELSE
-       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
-       CALL wrf_error_fatal(TRIM(wrf_err_message))
-     ENDIF
-   ENDIF
-   IF ( num_scalar >= PARAM_FIRST_SCALAR ) THEN
-!-----------------------------------------------------------------------
-! see above
-!--------------------------------------------------------------
-     CALL wrf_debug ( 200 , ' call HALO_RK_SCALAR' )
-     IF      ( config_flags%h_mom_adv_order <= 4 ) THEN
-#      include "HALO_EM_SCALAR_E_3.inc"
-     ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
-#      include "HALO_EM_SCALAR_E_5.inc"
-     ELSE
-       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
-       CALL wrf_error_fatal(TRIM(wrf_err_message))
-     ENDIF
-   ENDIF
-#endif
-
-!  Max values of CFL for adaptive time step scheme
-
-   DEALLOCATE(max_vert_cfl_tmp)
-   DEALLOCATE(max_horiz_cfl_tmp)
-
-
-!!!!!!!!!!!!!MARS
-!!!!!!!!!!!!!MARS
-!!
-!! to get lighter output files, output the sum of the constant value phb (pb)
-!with ph (p)
-!! --- these variables were added to the Registry
-!!
-!!pressure
-     grid%ptot  = grid%p + grid%pb
-!!geopotential: already in php
-     grid%phtot = grid%php
-!!mass
-     !grid%em_mutot = grid%em_mub + grid%em_mu_2
-!!
-!!!!!!!!!!!!!MARS
-!!!!!!!!!!!!!MARS
-
-
-   CALL wrf_debug ( 200 , ' call end of solve_em' )
-
-! Finish timers if compiled with -DBENCH.
-#include 
-
-   RETURN
-
-END SUBROUTINE solve_em
Index: /trunk/WRF.COMMON/WRFV3/phys/Makefile
===================================================================
--- /trunk/WRF.COMMON/WRFV3/phys/Makefile	(revision 2761)
+++ /trunk/WRF.COMMON/WRFV3/phys/Makefile	(revision 2761)
@@ -0,0 +1,64 @@
+#
+
+LN      =       ln -sf
+MAKE    =       make -i -r
+RM      =       rm -f
+
+
+MODULES = \
+	module_physics_addtendc.o \
+	module_physics_init.o \
+	variables_mod.o \
+	update_inputs_physiq_mod.o \
+	update_outputs_physiq_mod.o \
+	iniphysiq_mod.o \
+	callphysiq_mod.o \
+	module_lmd_driver.o
+  
+OBJS    =
+
+NMM_MODULES =  
+
+LIBTARGET    =  physics
+TARGETDIR    =  ./
+
+$(LIBTARGET) :
+		if [ $(WRF_NMM_CORE) -eq 1 ] ; then \
+                  $(MAKE) nmm_contrib                                      ; \
+                  $(AR) $(ARFLAGS) ../main/$(LIBWRFLIB) $(MODULES) $(OBJS) $(NMM_OBJS) $(NMM_MODULES) ; \
+                else                                                         \
+                  $(MAKE) non_nmm                                          ; \
+                  $(AR) $(ARFLAGS) ../main/$(LIBWRFLIB) $(MODULES) $(OBJS)             ; \
+                fi
+
+include ../configure.wrf
+
+nmm_contrib : $(NMM_OBJS) $(NMM_MODULES) $(MODULES) $(OBJS)
+
+non_nmm : $(MODULES) $(OBJS)
+
+clean:
+	@ echo 'use the clean script'
+
+# DEPENDENCIES : only dependencies after this line (don't remove the word DEPENDENCIES)
+
+module_physics_addtendc.o: \
+		../frame/module_state_description.o \
+		../frame/module_configure.o
+
+module_physics_init.o : \
+		../frame/module_state_description.o \
+		../frame/module_configure.o \
+		../frame/module_wrf_error.o \
+		../frame/module_dm.o \
+		../share/module_model_constants.o 
+
+module_lmd_driver.o: \
+		../frame/module_state_description.o \
+		../frame/module_wrf_error.o \
+		../frame/module_configure.o \
+		../share/module_model_constants.o \
+#../frame/module_wrf_error.o \
+#../share/module_model_constants.o
+
+# DO NOT DELETE
Index: /trunk/WRF.COMMON/WRFV3/phys/module_physics_addtendc.F
===================================================================
--- /trunk/WRF.COMMON/WRFV3/phys/module_physics_addtendc.F	(revision 2761)
+++ /trunk/WRF.COMMON/WRFV3/phys/module_physics_addtendc.F	(revision 2761)
@@ -0,0 +1,1222 @@
+!WRF:MODEL_LAYER: PHYSICS
+!
+! note: this module really belongs in the dyn_em directory since it is 
+!       specific only to the EM core. Leaving here for now, with an 
+!       #if ( EM_CORE == 1 ) directive. JM 20031201
+!
+
+!  This MODULE holds the routines which are used to perform updates of the
+!  model C-grid tendencies with physics A-grid tendencies
+!  The module consolidates code that was (up to v1.2) duplicated in 
+!  module_em and module_rk and in
+!  module_big_step_utilities.F and module_big_step_utilities_em.F
+
+!  This MODULE CONTAINS the following routines:
+!  update_phy_ten, phy_ra_ten, phy_bl_ten, phy_cu_ten, advance_ppt,
+!  add_a2a, add_a2c_u, and add_a2c_v
+
+
+MODULE module_physics_addtendc
+
+#if ( EM_CORE == 1 )
+
+   USE module_state_description
+   USE module_configure
+
+CONTAINS
+
+SUBROUTINE update_phy_ten(rt_tendf,ru_tendf,rv_tendf,moist_tendf,  &
+                      scalar_tendf,mu_tendf,                       &
+                      RTHRATEN,RTHBLTEN,RTHCUTEN,RUBLTEN,RVBLTEN,  &
+                      RQVBLTEN,RQCBLTEN,RQIBLTEN,                  &
+                      RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN,&
+                      RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,   &
+                      RMUNDGDTEN,                                  &
+                      n_moist,n_scalar,config_flags,rk_step,adv_moist_cond, &
+                      ids, ide, jds, jde, kds, kde,                &
+                      ims, ime, jms, jme, kms, kme,                &
+                      its, ite, jts, jte, kts, kte                 )
+!-------------------------------------------------------------------
+   IMPLICIT NONE
+!-------------------------------------------------------------------
+
+   TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde,   &
+                                   ims, ime, jms, jme, kms, kme,   &
+                                   its, ite, jts, jte, kts, kte,   &
+                                   n_moist,n_scalar,rk_step
+
+   LOGICAL , INTENT(IN)        :: adv_moist_cond
+
+   REAL , DIMENSION(ims:ime , kms:kme, jms:jme),INTENT(INOUT) ::   &
+                                                         ru_tendf, &
+                                                         rv_tendf, &
+                                                         rt_tendf
+
+   REAL , DIMENSION(ims:ime , jms:jme),INTENT(INOUT) ::  mu_tendf
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),           &
+          INTENT(INOUT)     ::                        moist_tendf
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar),           &
+          INTENT(INOUT)     ::                        scalar_tendf
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
+                                                       RTHRATEN, &
+                                                       RTHBLTEN, &
+                                                       RTHCUTEN, &
+                                                        RUBLTEN, &
+                                                        RVBLTEN, &
+                                                       RQVBLTEN, &
+                                                       RQCBLTEN, &
+                                                       RQIBLTEN, &
+                                                       RQVCUTEN, &
+                                                       RQCCUTEN, &
+                                                       RQRCUTEN, &
+                                                       RQICUTEN, &
+                                                       RQSCUTEN, &
+                                                     RTHNDGDTEN, &
+                                                     RQVNDGDTEN, &
+                                                      RUNDGDTEN, &
+                                                      RVNDGDTEN
+
+   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN  ) :: RMUNDGDTEN
+!------------------------------------------------------------------
+
+!  set up loop bounds for this grid's boundary conditions
+
+   if (config_flags%ra_lw_physics .gt. 0 .or.                  &
+       config_flags%ra_sw_physics .gt. 0)                      &
+      CALL phy_ra_ten(config_flags,rt_tendf,RTHRATEN,          &
+                      ids, ide, jds, jde, kds, kde,            &
+                      ims, ime, jms, jme, kms, kme,            &
+                      its, ite, jts, jte, kts, kte             )
+
+!   if (config_flags%bl_pbl_physics .gt. 0)                     &
+!****MARS
+! - All the LMD physics packages provide one tendency in the WRF sense
+! - PBL was chosen for practical reasons (U+V+T)
+! - The tendencies are supposed to be A-gridded
+   if ( (config_flags%bl_pbl_physics .gt. 0)                   &
+        .OR. (config_flags%modif_wrf) )                        &
+      CALL phy_bl_ten(config_flags,rk_step,n_moist,n_scalar,   &
+                      rt_tendf,ru_tendf,rv_tendf,moist_tendf,  &
+                      scalar_tendf,adv_moist_cond,             &
+                      RTHBLTEN,RUBLTEN,RVBLTEN,                &
+                      RQVBLTEN,RQCBLTEN,RQIBLTEN,              &
+                      ids, ide, jds, jde, kds, kde,            &
+                      ims, ime, jms, jme, kms, kme,            &
+                      its, ite, jts, jte, kts, kte             )
+
+   if (config_flags%cu_physics .gt. 0)                         &
+      CALL phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf,  &
+                      RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,     &
+                      RQICUTEN,RQSCUTEN,moist_tendf,           &
+                      ids, ide, jds, jde, kds, kde,            &
+                      ims, ime, jms, jme, kms, kme,            &
+                      its, ite, jts, jte, kts, kte             )
+
+   if (config_flags%grid_fdda .gt. 0)                     &
+      CALL phy_fg_ten(config_flags,rk_step,n_moist,            &
+                      rt_tendf,ru_tendf,rv_tendf,              &
+                      mu_tendf, moist_tendf,                   &
+                      RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,          &
+                      RQVNDGDTEN,RMUNDGDTEN,                   &
+                      ids, ide, jds, jde, kds, kde,            &
+                      ims, ime, jms, jme, kms, kme,            &
+                      its, ite, jts, jte, kts, kte             )
+
+END SUBROUTINE update_phy_ten
+
+!=================================================================
+SUBROUTINE phy_ra_ten(config_flags,rt_tendf,RTHRATEN,            &
+                      ids, ide, jds, jde, kds, kde,              &
+                      ims, ime, jms, jme, kms, kme,              &
+                      its, ite, jts, jte, kts, kte               )
+!-----------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE(grid_config_rec_type  ) , INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
+                                                       RTHRATEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
+                                                       rt_tendf
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k
+
+   CALL add_a2a(rt_tendf,RTHRATEN,config_flags,                  &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+END SUBROUTINE phy_ra_ten
+
+!=================================================================
+SUBROUTINE phy_bl_ten(config_flags,rk_step,n_moist,n_scalar,     &
+                      rt_tendf,ru_tendf,rv_tendf,moist_tendf,    &
+                      scalar_tendf,adv_moist_cond,               &
+                      RTHBLTEN,RUBLTEN,RVBLTEN,                  & 
+                      RQVBLTEN,RQCBLTEN,RQIBLTEN,                &
+                      ids, ide, jds, jde, kds, kde,              &
+                      ims, ime, jms, jme, kms, kme,              &
+                      its, ite, jts, jte, kts, kte               )
+!-----------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte, &
+                                   n_moist, n_scalar, rk_step
+
+   LOGICAL , INTENT(IN)     :: adv_moist_cond
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
+          INTENT(INOUT)     ::                      moist_tendf
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar),         &
+          INTENT(INOUT)     ::                      scalar_tendf
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   & 
+                                                       RTHBLTEN, &
+                                                        RUBLTEN, &
+                                                        RVBLTEN, &
+                                                       RQVBLTEN, &
+                                                       RQCBLTEN, &
+                                                       RQIBLTEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
+                                                       rt_tendf, &
+                                                       ru_tendf, &
+                                                       rv_tendf
+! LOCAL VARS
+
+   INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
+
+!-----------------------------------------------------------------
+
+
+!****MARS
+!****MARS
+!update with LMD physics tendencies
+if (config_flags%modif_wrf) then
+CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+     ids,ide, jds, jde, kds, kde,                     &
+     ims, ime, jms, jme, kms, kme,                    &
+     its, ite, jts, jte, kts, kte                     )
+CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+     ids,ide, jds, jde, kds, kde,                     &
+     ims, ime, jms, jme, kms, kme,                    &
+     its, ite, jts, jte, kts, kte                     )
+CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+     ids,ide, jds, jde, kds, kde,                     &
+     ims, ime, jms, jme, kms, kme,                    &
+     its, ite, jts, jte, kts, kte                     )
+endif
+!****MARS
+!****MARS    
+
+
+   SELECT CASE(config_flags%bl_pbl_physics)
+
+      CASE (YSUSCHEME)
+
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+       IF(.not. adv_moist_cond)THEN
+
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+       ENDIF
+
+      CASE (MRFSCHEME)
+
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+       IF(.not. adv_moist_cond)THEN
+
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+       ENDIF
+
+      CASE (ACMPBLSCHEME)
+
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+       IF(.not. adv_moist_cond)THEN
+
+        if (P_QT .ge. PARAM_FIRST_SCALAR)THEN
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+        ENDIF
+     
+       ENDIF
+
+      CASE (MYJPBLSCHEME)
+
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+       IF(.not. adv_moist_cond)THEN
+
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+       ELSE
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+       ENDIF
+
+      CASE (GFSSCHEME)
+                                                                                                                                        
+           CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+           CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+           CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+       IF(.not. adv_moist_cond)THEN
+
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+     
+        if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+       ENDIF
+
+      CASE DEFAULT
+
+      ! print*,'phy_bl_ten: The pbl scheme does not exist'
+
+   END SELECT
+
+END SUBROUTINE phy_bl_ten
+
+!=================================================================
+SUBROUTINE phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf,    &
+                      RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,       &
+                      RQICUTEN,RQSCUTEN,moist_tendf,             &
+                      ids, ide, jds, jde, kds, kde,              &
+                      ims, ime, jms, jme, kms, kme,              &
+                      its, ite, jts, jte, kts, kte               )
+!-----------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE(grid_config_rec_type  ) , INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte, &
+                                   n_moist, rk_step
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
+          INTENT(INOUT)     ::                      moist_tendf
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
+                                                       RTHCUTEN, &
+                                                       RQVCUTEN, &
+                                                       RQCCUTEN, &
+                                                       RQRCUTEN, &
+                                                       RQICUTEN, &
+                                                       RQSCUTEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
+                                                       rt_tendf
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k
+
+   SELECT CASE (config_flags%cu_physics)   
+
+   CASE (KFSCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QR .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QS .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE (BMJSCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,                          &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE (KFETASCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QR .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QS .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE (GDSCHEME, G3SCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE (SASSCHEME)
+        CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+                                                                                                                                        
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+          
+        if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+          
+        if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
+        CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+   CASE DEFAULT
+
+   END SELECT
+
+END SUBROUTINE phy_cu_ten
+
+!=================================================================
+SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist,            &
+                      rt_tendf,ru_tendf,rv_tendf,              &
+                      mu_tendf, moist_tendf,                   &
+                      RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,          &
+                      RQVNDGDTEN,RMUNDGDTEN,                   &
+                      ids, ide, jds, jde, kds, kde,              &
+                      ims, ime, jms, jme, kms, kme,              &
+                      its, ite, jts, jte, kts, kte               )
+!-----------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------
+   TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
+
+   INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
+                                   ims, ime, jms, jme, kms, kme, &
+                                   its, ite, jts, jte, kts, kte, &
+                                   n_moist, rk_step
+
+   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
+          INTENT(INOUT)     ::                      moist_tendf
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
+                                                       RTHNDGDTEN, &
+                                                        RUNDGDTEN, &
+                                                        RVNDGDTEN, &
+                                                       RQVNDGDTEN
+
+   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN  ) ::  RMUNDGDTEN
+
+   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
+                                                       rt_tendf, &
+                                                       ru_tendf, &
+                                                       rv_tendf
+
+   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT)::  mu_tendf
+
+! LOCAL VARS
+
+   INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
+
+!-----------------------------------------------------------------
+
+   SELECT CASE(config_flags%grid_fdda)
+
+      CASE (PSUFDDAGD)
+
+           CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags,        &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+! note fdda u and v tendencies are staggered
+           CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags,       &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags,       &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+           CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags,      &
+                ids,ide, jds, jde, kds, kds,                     &
+                ims, ime, jms, jme, kms, kms,                    &
+                its, ite, jts, jte, kts, kts                     )
+
+        if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
+           CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN,  &
+                config_flags,                                    &
+                ids,ide, jds, jde, kds, kde,                     &
+                ims, ime, jms, jme, kms, kme,                    &
+                its, ite, jts, jte, kts, kte                     )
+
+
+      CASE DEFAULT
+
+   END SELECT
+
+END SUBROUTINE phy_fg_ten
+
+!----------------------------------------------------------------------
+SUBROUTINE advance_ppt(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,           &
+                     RQICUTEN,RQSCUTEN,RAINC,RAINCV,PRATEC,NCA,       &
+                     HTOP,HBOT,CUTOP,CUBOT,                           &
+                     CUPPT, DT, config_flags,                         &
+                     ids,ide, jds,jde, kds,kde,                       &
+                     ims,ime, jms,jme, kms,kme,                       &
+                     its,ite, jts,jte, kts,kte                        )     
+!----------------------------------------------------------------------
+   USE module_state_description
+!!!******MARS MARS
+!!!******MARS MARS
+!   USE module_cu_kf
+!   USE module_cu_kfeta
+!----------------------------------------------------------------------
+   IMPLICIT NONE
+!----------------------------------------------------------------------
+   TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
+
+   INTEGER,      INTENT(IN   )    ::                             &
+                                      ids,ide, jds,jde, kds,kde, &
+                                      ims,ime, jms,jme, kms,kme, &
+                                      its,ite, jts,jte, kts,kte
+
+
+   REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
+         INTENT(INOUT)  ::                             RTHCUTEN, &
+                                                       RQVCUTEN, &
+                                                       RQCCUTEN, &
+                                                       RQRCUTEN, &
+                                                       RQICUTEN, &
+                                                       RQSCUTEN
+
+   REAL, DIMENSION( ims:ime , jms:jme ),                         &
+          INTENT(INOUT) ::                                RAINC, &
+                                                         RAINCV, &
+                                                         PRATEC, &
+                                                            NCA, &
+                                                           HTOP, &
+                                                           HBOT, &
+                                                          CUTOP, &
+                                                          CUBOT, &
+                                                          CUPPT
+   REAL, INTENT(IN) ::                                       DT
+
+! LOCAL  VAR
+
+   INTEGER :: i,j,k,i_start,i_end,j_start,j_end,k_start,k_end
+   INTEGER :: NCUTOP, NCUBOT
+
+!-----------------------------------------------------------------
+
+   IF (config_flags%cu_physics .eq. 0) return
+
+! SET START AND END POINTS FOR TILES
+
+   i_start = its
+   i_end   = min( ite,ide-1 )
+   j_start = jts
+   j_end   = min( jte,jde-1 )
+!
+!  IF( config_flags%nested .or. config_flags%specified ) THEN
+!    i_start = max( its,ids+1 )
+!    i_end   = min( ite,ide-2 )
+!    j_start = max( jts,jds+1 )
+!    j_end   = min( jte,jde-2 )
+!  ENDIF
+!
+   k_start = kts
+   k_end = min( kte, kde-1 )
+
+! Update total cumulus scheme precipitation
+
+! in mm  
+
+   DO J = j_start,j_end
+   DO i = i_start,i_end
+      RAINC(I,J)=RAINC(I,J)+PRATEC(I,J)*DT
+      CUPPT(I,J)=CUPPT(I,J)+PRATEC(I,J)*DT/1000.
+   ENDDO
+   ENDDO
+
+   SELECT CASE (config_flags%cu_physics)
+
+   CASE (KFSCHEME)
+
+        DO J = j_start,j_end
+        DO i = i_start,i_end
+
+           IF ( NCA(I,J) .GT. 0 ) THEN
+
+              IF ( NINT(NCA(I,J) / DT) .le. 0 ) THEN
+
+              ! set tendency to zero
+                 PRATEC(I,J)=0.
+                 RAINCV(I,J)=0.
+                 DO k = k_start,k_end
+                    RTHCUTEN(i,k,j)=0.
+                    RQVCUTEN(i,k,j)=0.
+                    RQCCUTEN(i,k,j)=0.
+                    RQRCUTEN(i,k,j)=0.
+                    if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
+                    if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
+                 ENDDO
+              ENDIF
+
+              NCA(I,J)=NCA(I,J)-DT ! Decrease NCA
+
+           ENDIF
+!
+        ENDDO
+        ENDDO
+
+   CASE (BMJSCHEME)
+ 
+        DO J = j_start,j_end
+        DO i = i_start,i_end
+
+! HTOP, HBOT FOR GFDL RADIATION
+           NCUTOP=NINT(CUTOP(I,J))
+           NCUBOT=NINT(CUBOT(I,J))
+           IF(NCUTOP>1.AND.NCUTOP0.AND.NCUBOT1.AND.NCUTOP0.AND.NCUBOT ',6*(max_cats*max_seas)+1*max_cats
+   ENDIF
+   curs = 1
+   DO cats = 1, max_cats
+     SCFX(cats) =           lu_state(curs)         ; curs = curs + 1
+     DO seas = 1, max_seas
+       ALBD(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       SLMO(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       SFEM(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       SFZ0(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       SFHC(cats,seas) =    lu_state(curs)         ; curs = curs + 1
+       THERIN(cats,seas) =  lu_state(curs)         ; curs = curs + 1
+     ENDDO
+   ENDDO
+
+! Determine season (summer=1, winter=2)
+   ISN=1                                                            
+   IF(JULDAY.LT.105.OR.JULDAY.GT.288)ISN=2                         
+   IF(CEN_LAT.LT.0.0)ISN=3-ISN                                   
+
+   FOUND_LU = .TRUE.
+   IF ( allowed_to_read ) THEN
+      landuse_unit = 29
+      IF ( wrf_dm_on_monitor() ) THEN
+        OPEN(landuse_unit, FILE='LANDUSE.TBL',FORM='FORMATTED',STATUS='OLD',IOSTAT=ierr)
+        IF ( ierr .NE. OPEN_OK ) THEN
+          WRITE(message,FMT='(A)') &
+          'module_physics_init.F: LANDUSE_INIT: open failure for LANDUSE.TBL'
+          CALL wrf_error_fatal ( message ) 
+        END IF
+      ENDIF
+
+! Read info from file LANDUSE.TBL
+      IF(MMINLU.EQ.'OLD ')THEN
+!       ISWATER=7
+        ISICE=11 
+      ELSE IF(MMINLU.EQ.'USGS')THEN
+!       ISWATER=16
+        ISICE=24
+      ELSE IF(MMINLU.EQ.'SiB ')THEN
+!       ISWATER=15
+        ISICE=16
+      ELSE IF(MMINLU.EQ.'LW12')THEN
+!       ISWATER=15
+        ISICE=3
+      ENDIF
+      PRINT *, 'INPUT LANDUSE = ',MMINLU
+      FOUND_LU = .FALSE.
+      end_of_file = .FALSE.
+!!! BEGINNING OF 1999 LOOP
+ 1999 CONTINUE                                                      
+      IF ( wrf_dm_on_monitor() ) THEN
+        READ (landuse_unit,2000,END=2002)LUTYPE                                
+        GOTO 2003
+ 2002   CONTINUE
+        CALL wrf_message( 'INPUT FILE FOR LANDUSE REACHED END OF FILE' )
+        end_of_file = .TRUE.
+ 2003   CONTINUE
+        IF ( .NOT. end_of_file ) READ (landuse_unit,*)LUCATS,LUSEAS                                    
+        FOUND_LU = LUTYPE.EQ.MMINLU
+      ENDIF
+      CALL wrf_dm_bcast_bytes (end_of_file, LWORDSIZE )
+      IF ( .NOT. end_of_file ) THEN
+        CALL wrf_dm_bcast_string(lutype, 4)
+        CALL wrf_dm_bcast_bytes (lucats,  IWORDSIZE )
+        CALL wrf_dm_bcast_bytes (luseas,  IWORDSIZE )
+        CALL wrf_dm_bcast_bytes (found_lu,  LWORDSIZE )
+ 2000   FORMAT (A4)                                                
+        IF(FOUND_LU)THEN                                  
+          LUN=LUCATS                                             
+          NSN=LUSEAS                                            
+            PRINT *, 'LANDUSE TYPE = ',LUTYPE,' FOUND',        &
+                   LUCATS,' CATEGORIES',LUSEAS,' SEASONS',     &
+                   ' WATER CATEGORY = ',ISWATER,               &
+                   ' SNOW CATEGORY = ',ISICE                
+        ENDIF                                             
+        DO ls=1,luseas                                   
+          if ( wrf_dm_on_monitor() ) then
+            READ (landuse_unit,*)                                   
+          endif
+          DO LC=1,LUCATS                               
+            IF(found_lu)THEN                  
+              IF ( wrf_dm_on_monitor() ) THEN
+                READ (landuse_unit,*)LI,ALBD(LC,LS),SLMO(LC,LS),SFEM(LC,LS),        &       
+                           SFZ0(LC,LS),THERIN(LC,LS),SCFX(LC),SFHC(LC,LS)       
+              ENDIF
+              CALL wrf_dm_bcast_bytes (LI,  IWORDSIZE )
+              IF(LC.NE.LI)CALL wrf_error_fatal ( 'module_start: MISSING LANDUSE UNIT ' )
+            ELSE                                                            
+              IF ( wrf_dm_on_monitor() ) THEN
+                READ (landuse_unit,*)                                                  
+              ENDIF
+            ENDIF                                                         
+          ENDDO                                                          
+        ENDDO                                                           
+        IF(NSN.EQ.1.AND.FOUND_LU) THEN
+           ISN = 1
+        END IF
+        CALL wrf_dm_bcast_bytes (albd,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (slmo,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (sfem,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (sfz0,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (therin, max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (sfhc,   max_cats * max_seas * RWORDSIZE )
+        CALL wrf_dm_bcast_bytes (scfx,   max_cats *            RWORDSIZE )
+      ENDIF
+
+      IF(.NOT. found_lu .AND. .NOT. end_of_file ) GOTO 1999
+!!! END OF 1999 LOOP
+
+      IF(.NOT. found_lu .OR. end_of_file )THEN                                         
+        CALL wrf_message ( 'LANDUSE IN INPUT FILE DOES NOT MATCH LUTABLE: TABLE NOT USED' )
+      ENDIF                                                     
+    ENDIF  ! allowed_to_read
+
+    IF(FOUND_LU)THEN
+! Set arrays according to lu_index
+      itf = min0(ite, ide-1)
+      jtf = min0(jte, jde-1)
+      IF(usemonalb)CALL wrf_message ( 'Climatological albedo is used instead of table values' )
+      DO j = jts, jtf
+        DO i = its, itf
+          IS=nint(lu_index(i,j))
+          ! only do this check on read-in data
+          IF(IS.LT.0.OR.IS.GT.LUN.AND.allowed_to_read)THEN                                        
+            WRITE ( wrf_err_message , * ) 'ERROR: LANDUSE OUTSIDE RANGE =',IS,' AT ',I,J,' LUN= ',LUN
+            CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
+          ENDIF                                                            
+!   SET NO-DATA POINTS (IS=0) TO WATER                                    
+          IF(IS.EQ.0)THEN                                                
+            IS=ISWATER                                                  
+          ENDIF                                                        
+          IF(.NOT.usemonalb)ALBBCK(I,J)=ALBD(IS,ISN)/100.                                  
+          ALBEDO(I,J)=ALBBCK(I,J)
+          IF(SNOWC(I,J) .GT. 0.5)ALBEDO(I,J)=ALBBCK(I,J)*(1.+SCFX(IS))
+          THC(I,J)=THERIN(IS,ISN)/100.                               
+          Z0(I,J)=SFZ0(IS,ISN)/100.                                
+          ZNT(I,J)=Z0(I,J)
+          EMBCK(I,J)=SFEM(IS,ISN)                                  
+          EMISS(I,J)=EMBCK(I,J)                                  
+          MAVAIL(I,J)=SLMO(IS,ISN)                                
+          IF(IS.NE.ISWATER)THEN                                  
+            XLAND(I,J)=1.0                                      
+          ELSE                                                 
+            XLAND(I,J)=2.0                                    
+          ENDIF                                              
+!    SET SEA-ICE POINTS TO LAND WITH ICE/SNOW SURFACE PROPERTIES
+          XICEM(I,J)=XICE(I,J)
+          IF(XICE(I,J).GT.0.5)THEN
+            XLAND(I,J)=1.0
+            ALBBCK(I,J)=ALBD(ISICE,ISN)/100.
+            ALBEDO(I,J)=ALBBCK(I,J)
+            THC(I,J)=THERIN(ISICE,ISN)/100.                              
+            Z0(I,J)=SFZ0(ISICE,ISN)/100.                               
+            ZNT(I,J)=Z0(I,J)
+            EMBCK(I,J)=SFEM(ISICE,ISN)                                 
+            EMISS(I,J)=EMBCK(I,J)                                  
+            MAVAIL(I,J)=SLMO(ISICE,ISN)                               
+          ENDIF
+        ENDDO
+      ENDDO
+    ENDIF
+    if ( wrf_dm_on_monitor() .and. allowed_to_read ) then
+      CLOSE (landuse_unit)
+    endif
+    CALL wrf_debug( 100 , 'returning from of landuse_init' )
+
+! restore LU variables from state
+    curs = 1
+    DO cats = 1, max_cats
+      lu_state(curs) = SCFX(cats)                 ; curs = curs + 1
+      DO seas = 1, max_seas
+        lu_state(curs) = ALBD(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = SLMO(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = SFEM(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = SFZ0(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = SFHC(cats,seas)          ; curs = curs + 1
+        lu_state(curs) = THERIN(cats,seas)        ; curs = curs + 1
+      ENDDO
+    ENDDO
+
+    RETURN
+        
+   END SUBROUTINE landuse_init 
+
+!!!!******MARS MARS MARS
+!!!!******MARS MARS MARS
+!!!!******MARS MARS MARS
+
+!!=====================================================================
+!   SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       & 
+!                      RTHRATENSW,CLDFRA,EMISS,cen_lat,JULYR,JULDAY,GMT,    &
+!                      levsiz,XLAT,n_ozmixm,                           &
+!                      cldfra_old,                                     & ! Optional
+!                      ozmixm,pin,                                     & ! Optional
+!                      m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,     & ! Optional
+!                      paerlev,n_aerosolc,                             &
+!                      sfull,shalf,pptop,swrad_scat,                  &
+!                      config_flags,restart,                          & 
+!                      allowed_to_read, start_of_simulation,          &
+!                      ids, ide, jds, jde, kds, kde,                  &
+!                      ims, ime, jms, jme, kms, kme,                  &
+!                      its, ite, jts, jte, kts, kte                   )
+!!---------------------------------------------------------------------
+!   USE module_ra_rrtm
+!   USE module_ra_cam
+!   USE module_ra_sw
+!   USE module_ra_gsfcsw
+!   USE module_ra_gfdleta
+!   USE module_ra_hs
+!   USE module_domain
+!!---------------------------------------------------------------------
+!   IMPLICIT NONE
+!!---------------------------------------------------------------------
+!   INTEGER,  INTENT(IN)           :: id
+!   TYPE (grid_config_rec_type)    :: config_flags
+!   LOGICAL , INTENT(IN)           :: restart
+!   LOGICAL,  INTENT(IN)           :: allowed_to_read
+!
+!   INTEGER , INTENT(IN)           :: ids, ide, jds, jde, kds, kde,   &
+!                                     ims, ime, jms, jme, kms, kme,   &
+!                                     its, ite, jts, jte, kts, kte
+!
+!   INTEGER , INTENT(IN)           :: JULDAY,JULYR
+!   REAL ,    INTENT(IN)           :: DT, RADT, cen_lat, GMT, pptop,  &
+!                                     swrad_scat
+!   LOGICAL,  INTENT(IN)           :: start_of_simulation
+!
+!   INTEGER,      INTENT(IN   )    ::   levsiz, n_ozmixm
+!   INTEGER,      INTENT(IN   )    ::   paerlev, n_aerosolc
+!
+!   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN) ::  XLAT
+!
+!   REAL,  DIMENSION( ims:ime, levsiz, jms:jme, n_ozmixm ), OPTIONAL,      &
+!          INTENT(INOUT) ::                                  OZMIXM
+!
+!   REAL,  DIMENSION(ims:ime,jms:jme), OPTIONAL, INTENT(INOUT)  :: m_ps_1,m_ps_2
+!   REAL,  DIMENSION(paerlev), OPTIONAL, INTENT(INOUT)  ::         m_hybi
+!   REAL,  DIMENSION( ims:ime, paerlev, jms:jme, n_aerosolc ), OPTIONAL,     &
+!          INTENT(INOUT) ::                      aerosolc_1, aerosolc_2
+!
+!   REAL,  DIMENSION(levsiz), OPTIONAL, INTENT(INOUT)  ::          PIN
+!
+!   INTEGER , INTENT(INOUT)        :: STEPRA
+!   INTEGER :: isn
+!
+!   REAL , DIMENSION( kms:kme ) , INTENT(IN) :: sfull, shalf
+!   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::           &
+!                                                           RTHRATEN, &
+!                                                         RTHRATENLW, &
+!                                                         RTHRATENSW, &
+!                                                             CLDFRA
+!
+!   REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(OUT) :: &
+!                                                         CLDFRA_OLD
+!
+!   REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: EMISS
+!   LOGICAL :: etalw = .false.
+!   LOGICAL :: camlw = .false.
+!   LOGICAL :: etamp = .false.
+!   integer :: month,iday
+!   INTEGER :: i, j, k, itf, jtf, ktf
+!!---------------------------------------------------------------------
+!
+!   jtf=min0(jte,jde-1)
+!   ktf=min0(kte,kde-1)
+!   itf=min0(ite,ide-1)
+!
+!!---------------------------------------------------------------------
+!
+!!-- calculate radiation time step
+!
+!    STEPRA = nint(RADT*60./DT)
+!    STEPRA = max(STEPRA,1)
+!
+!!-- initialization
+!
+!   IF(start_of_simulation)THEN
+!     DO j=jts,jtf
+!     DO k=kts,ktf
+!     DO i=its,itf
+!        RTHRATEN(i,k,j)=0.
+!        RTHRATENLW(i,k,j)=0.
+!        RTHRATENSW(i,k,j)=0.
+!        CLDFRA(i,k,j)=0.
+!     ENDDO
+!     ENDDO
+!     ENDDO
+!
+!     if( present(cldfra_old) ) then
+!        DO j=jts,jtf
+!        DO k=kts,ktf
+!        DO i=its,itf
+!           cldfra_old(i,k,j) = 0.
+!        ENDDO
+!        ENDDO
+!        ENDDO
+!     end if
+!   ENDIF
+!
+!!-- find out which microphysics option is used first
+!
+!   mp_select: SELECT CASE(config_flags%mp_physics)
+!
+!        CASE (ETAMPNEW)
+!             etamp = .true.
+!
+!   END SELECT mp_select
+!
+!!-- chose long wave radiation scheme
+! 
+!   lwrad_select: SELECT CASE(config_flags%ra_lw_physics)
+!
+!        CASE (RRTMSCHEME)
+!             CALL rrtminit(                                 &
+!                           allowed_to_read ,                &
+!                           ids, ide, jds, jde, kds, kde,    &
+!                           ims, ime, jms, jme, kms, kme,    &
+!                           its, ite, jts, jte, kts, kte     )
+!
+!        CASE (CAMLWSCHEME)
+!#ifdef MAC_KLUDGE
+!             CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' )
+!#endif
+!             IF ( PRESENT( OZMIXM ) .AND. PRESENT( PIN ) .AND. &
+!                  PRESENT(M_PS_1) .AND. PRESENT(M_PS_2) .AND.  &
+!                  PRESENT(M_HYBI) .AND. PRESENT(AEROSOLC_1)    &
+!                  .AND. PRESENT(AEROSOLC_2)) THEN
+!             CALL camradinit(                                  &
+!                         R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop, &
+!                         ozmixm,pin,levsiz,XLAT,n_ozmixm,      &
+!                         m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,&
+!                         paerlev, n_aerosolc,              &
+!                         ids, ide, jds, jde, kds, kde,     &
+!                         ims, ime, jms, jme, kms, kme,     &
+!                         its, ite, jts, jte, kts, kte      )
+!             ELSE
+!                CALL wrf_error_fatal ( 'arguments not present for calling cam radiation' )
+!             ENDIF
+!
+!             camlw = .true.
+!
+!        CASE (GFDLLWSCHEME)
+!             CALL nl_get_start_month(id,month)
+!             CALL nl_get_start_day(id,iday)
+!             CALL gfdletainit(emiss,sfull,shalf,pptop,      &
+!                              julyr,month,iday,gmt,         &
+!                              config_flags,allowed_to_read, &
+!                              ids, ide, jds, jde, kds, kde, &
+!                              ims, ime, jms, jme, kms, kme, &
+!                              its, ite, jts, jte, kts, kte  )
+!             etalw = .true.
+!        CASE (HELDSUAREZ)
+!             CALL hsinit(RTHRATEN,restart,             &
+!                         ids, ide, jds, jde, kds, kde, &
+!                         ims, ime, jms, jme, kms, kme, &
+!                         its, ite, jts, jte, kts, kte )
+!        CASE DEFAULT
+!
+!   END SELECT lwrad_select
+!!-- initialize short wave radiation scheme
+! 
+!   swrad_select: SELECT CASE(config_flags%ra_sw_physics)
+!
+!        CASE (SWRADSCHEME)
+!             CALL swinit(                                  &
+!                         swrad_scat,                       &
+!                         allowed_to_read ,                 &
+!                         ids, ide, jds, jde, kds, kde,     &
+!                         ims, ime, jms, jme, kms, kme,     &
+!                         its, ite, jts, jte, kts, kte      )
+!
+!        CASE (CAMSWSCHEME)
+!#ifdef MAC_KLUDGE
+!             CALL wrf_error_fatal ( 'CAM radiation scheme not supported under the chosen build configuration' )
+!#endif
+!             IF(.not.camlw)THEN
+!             CALL camradinit(                              &
+!                         R_D,R_V,CP,G,STBOLT,EP_2,shalf,pptop,               &
+!                         ozmixm,pin,levsiz,XLAT,n_ozmixm,     &
+!                         m_ps_1,m_ps_2,m_hybi,aerosolc_1,aerosolc_2,&
+!                         paerlev, n_aerosolc,              &
+!                         ids, ide, jds, jde, kds, kde,     &
+!                         ims, ime, jms, jme, kms, kme,     &
+!                         its, ite, jts, jte, kts, kte      )
+!             ENDIF
+!
+!        CASE (GSFCSWSCHEME)
+!             CALL gsfc_swinit(cen_lat, allowed_to_read )
+!
+!        CASE (GFDLSWSCHEME)
+!             IF(.not.etalw)THEN
+!             CALL nl_get_start_month(id,month)
+!             CALL nl_get_start_day(id,iday)
+!             CALL gfdletainit(emiss,sfull,shalf,pptop,      &
+!                              julyr,month,iday,gmt,         &
+!                              config_flags,allowed_to_read, &
+!                              ids, ide, jds, jde, kds, kde, &
+!                              ims, ime, jms, jme, kms, kme, &
+!                              its, ite, jts, jte, kts, kte  )
+!             ENDIF
+!
+!        CASE DEFAULT
+!
+!   END SELECT swrad_select
+!
+!   END SUBROUTINE ra_init
+!
+!   SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
+!                RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN,             &
+!                config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS,    &
+!                num_soil_layers,TKE_MYJ,EXCH_H,VEGFRA,          &
+!                SNOW,SNOWC, CANWAT,SMSTAV,                      &
+!                SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,ACSNOM,       &
+!                IVGTYP,ISLTYP,SMOIS,SMFR3D,mavail,              &
+!                SNOWH,SH2O,FNDSOILW, FNDSNOWH,                  &
+!#if  ( NMM_CORE == 1 )
+!                Z0,XLAND,XICE,                                  &
+!#else
+!                ZNT,XLAND,XICE,                                 &
+!#endif
+!                SFCEVP,GRDFLX,                                  &
+!                allowed_to_read,                                &
+!                start_of_simulation,                            &
+!!                num_roof_layers,num_wall_layers,num_road_layers,& !Optional urban
+!                DZR, DZB, DZG,                                  & !Optional urban
+!                TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D,   & !Optional urban
+!                XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,    & !Optional urban
+!                TRL_URB3D, TBL_URB3D, TGL_URB3D,                & !Optional urban
+!                SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D,             & !Optional urban
+!                TS_URB2D, FRC_URB2D, UTYPE_URB2D,UCMCALL,       & !Optional urban
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte,                   &
+!                oml_hml0, omlcall,                              & !Optional oml
+!                TML,T0ML,HML,H0ML,HUML,HVML                     ) !Optional oml
+!!--------------------------------------------------------------------
+!   USE module_sf_sfclay
+!   USE module_sf_slab
+!   USE module_sf_pxsfclay
+!   USE module_bl_ysu
+!   USE module_bl_mrf
+!   USE module_bl_gfs
+!   USE module_bl_acm
+!   USE module_sf_myjsfc
+!   USE module_sf_noahdrv
+!   USE module_sf_urban
+!   USE module_sf_ruclsm
+!   USE module_sf_pxlsm
+!   USE module_bl_myjpbl
+!#if (NMM_CORE == 1)
+!   USE module_sf_lsm_nmm
+!#endif
+!!--------------------------------------------------------------------
+!   IMPLICIT NONE
+!!--------------------------------------------------------------------
+!   TYPE (grid_config_rec_type) ::     config_flags
+!   LOGICAL , INTENT(IN)        :: restart
+!   LOGICAL, INTENT(IN)         ::   FNDSOILW, FNDSNOWH
+!
+!   INTEGER , INTENT(IN)        ::     ids, ide, jds, jde, kds, kde, &
+!                                      ims, ime, jms, jme, kms, kme, &
+!                                      its, ite, jts, jte, kts, kte
+!   INTEGER , INTENT(IN)        ::     num_soil_layers
+!   INTEGER , INTENT(IN)        ::     UCMCALL 
+!
+!   REAL ,    INTENT(IN)        ::     DT, BLDT
+!   INTEGER , INTENT(INOUT)     ::     STEPBL
+!
+!   REAL,     DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),    &
+!             INTENT(OUT) :: SMFR3D
+!
+!   REAL,     DIMENSION( ims:ime , 1:num_soil_layers , jms:jme ),&
+!                   INTENT(INOUT) :: SMOIS,SH2O,TSLB 
+!
+!   REAL,    DIMENSION( ims:ime, jms:jme )                     , &
+!            INTENT(INOUT)    ::                           SNOW, &
+!                                                         SNOWH, &
+!                                                         SNOWC, &
+!                                                        CANWAT, &
+!                                                        MAVAIL, &
+!                                                        SMSTAV, &
+!                                                        SMSTOT, &
+!                                                     SFCRUNOFF, &
+!                                                      UDRUNOFF, &
+!                                                        ACSNOW, &
+!                                                        VEGFRA, &
+!                                                        ACSNOM, &
+!                                                        SFCEVP, &
+!                                                        GRDFLX, &
+!                                                           UST, &
+!#if ( NMM_CORE == 1 )
+!                                                            Z0, &
+!#else
+!                                                           ZNT, &
+!#endif
+!                                                         XLAND, &
+!                                                         XICE
+!
+!   INTEGER, DIMENSION( ims:ime, jms:jme )                     , &
+!            INTENT(INOUT)    ::                         IVGTYP, &
+!                                                        ISLTYP, &
+!                                                        LOWLYR
+!
+!
+!   REAL,     DIMENSION(1:num_soil_layers), INTENT(INOUT)  ::  ZS,DZS
+!
+!   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::       &
+!                                                           RUBLTEN, &
+!                                                           RVBLTEN, &
+! 						          EXCH_H,   &
+!                                                          RTHBLTEN, &
+!                                                          RQVBLTEN, &
+!                                                          RQCBLTEN, &
+!                                                          RQIBLTEN, &
+!                                                          TKE_MYJ
+!
+!   REAL,  DIMENSION( ims:ime , jms:jme ) , INTENT(IN) ::     TSK
+!   REAL,  DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) ::  TMN
+!   LOGICAL,  INTENT(IN)           :: allowed_to_read
+!   INTEGER :: isn, isfc
+!
+!!URBAN
+!!   REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR  !Optional urban
+!!   REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB  !Optional urban
+!!   REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG  !Optional urban
+!    REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR  !Optional urban
+!    REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB  !Optional urban
+!    REAL, OPTIONAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG  !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D !Optional urban
+!    INTEGER, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D !Optional urban
+!!    REAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban
+!!    REAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban
+!!    REAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D !Optional urban
+!    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D !Optional urban
+!
+!! Optional OML variables
+!   REAL,  DIMENSION( ims:ime , jms:jme ) , OPTIONAL, INTENT(INOUT) ::    &
+!                                        TML,T0ML,HML,H0ML,HUML,HVML
+!   INTEGER,  OPTIONAL,  INTENT(IN) :: omlcall
+!   REAL,  OPTIONAL,  INTENT(IN) :: oml_hml0
+!   LOGICAL,  INTENT(IN) :: start_of_simulation
+!
+!!-- calculate pbl time step
+!
+!   STEPBL = nint(BLDT*60./DT)
+!   STEPBL = max(STEPBL,1)
+!
+!
+!!-- initialize surface layer scheme
+!
+!   sfclay_select: SELECT CASE(config_flags%sf_sfclay_physics)
+!
+!      CASE (SFCLAYSCHEME)
+!           CALL sfclayinit( allowed_to_read )
+!           isfc = 1
+!      CASE (PXSFCSCHEME)
+!           CALL pxsfclayinit( allowed_to_read )
+!           isfc = 1
+!      CASE (MYJSFCSCHEME)
+!           CALL myjsfcinit(LOWLYR,UST,                         &
+!#if ( NMM_CORE == 1 )
+!                                      Z0,                      &
+!#else
+!                                      ZNT,                     &
+!#endif
+!                                          XLAND,XICE,          &
+!                         IVGTYP,restart,                       &
+!                         allowed_to_read ,                     &
+!                         ids, ide, jds, jde, kds, kde,         &
+!                         ims, ime, jms, jme, kms, kme,         &
+!                         its, ite, jts, jte, kts, kte          )
+!           isfc = 2
+!
+!      CASE (GFSSFCSCHEME)
+!           CALL myjsfcinit(LOWLYR,UST,                         &
+!#if ( NMM_CORE == 1 )
+!                                      Z0,                      &
+!#else
+!                                      ZNT,                     &
+!#endif
+!                                          XLAND,XICE,          &
+!                         IVGTYP,restart,                       &
+!                         allowed_to_read ,                     &
+!                         ids, ide, jds, jde, kds, kde,         &
+!                         ims, ime, jms, jme, kms, kme,         &
+!                         its, ite, jts, jte, kts, kte          )
+!           isfc = 1
+!
+!      CASE DEFAULT
+!
+!   END SELECT sfclay_select
+!
+!
+!!-- initialize surface scheme
+!
+!   sfc_select: SELECT CASE(config_flags%sf_surface_physics)
+!
+!      CASE (SLABSCHEME)
+!
+!           CALL slabinit(TSK,TMN,                              &
+!                         TSLB,ZS,DZS,num_soil_layers,          & 
+!                         allowed_to_read ,start_of_simulation ,&
+!                         ids, ide, jds, jde, kds, kde,         &
+!                         ims, ime, jms, jme, kms, kme,         &
+!                         its, ite, jts, jte, kts, kte,         &
+!                         oml_hml0, omlcall,                    &
+!                         tml, t0ml, hml, h0ml, huml, hvml      )
+!
+!#if (NMM_CORE == 1)
+!      CASE (NMMLSMSCHEME)
+!           CALL nmmlsminit(isn,XICE,VEGFRA,SNOW,SNOWC, CANWAT,SMSTAV, &
+!                     SMSTOT, SFCRUNOFF,UDRUNOFF,GRDFLX,ACSNOW,     &
+!                     ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,DZS,SFCEVP,   &
+!                     TMN,                                          &
+!                     num_soil_layers,                              &
+!                     allowed_to_read ,                             &
+!                     ids,ide, jds,jde, kds,kde,                    &
+!                     ims,ime, jms,jme, kms,kme,                    &
+!                     its,ite, jts,jte, kts,kte                     )
+!#endif
+!      CASE (LSMSCHEME)
+!          CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,  &
+!                     SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,        &
+!                     ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, &
+!                     FNDSOILW, FNDSNOWH,                       &
+!                     num_soil_layers, restart,                 &
+!                     allowed_to_read ,                         &
+!                     ids,ide, jds,jde, kds,kde,                &
+!                     ims,ime, jms,jme, kms,kme,                &
+!                     its,ite, jts,jte, kts,kte                 )
+!
+!!URBAN
+!          IF(UCMCALL.eq.1) THEN
+!
+!             IF ( PRESENT( FRC_URB2D ) .AND. PRESENT( UTYPE_URB2D )) THEN
+!
+!                CALL urban_param_init(DZR,DZB,DZG,num_soil_layers                    & !urban
+!                                )
+!!                                num_roof_layers,num_wall_layers,road_soil_layers)   !urban
+!                CALL urban_var_init(TSK,TSLB,TMN,IVGTYP,                             & !urban
+!                              ims,ime,jms,jme,num_soil_layers,                 & !urban
+!!                              num_roof_layers,num_wall_layers,num_road_layers, & !urban
+!                              restart,                                         & !urban
+!                              XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,     & !urban
+!                              TR_URB2D,TB_URB2D,TG_URB2D,TC_URB2D,QC_URB2D,    & !urban
+!                              TRL_URB3D,TBL_URB3D,TGL_URB3D,                   & !urban
+!                              SH_URB2D,LH_URB2D,G_URB2D,RN_URB2D, TS_URB2D,    & ! urban
+!                              FRC_URB2D, UTYPE_URB2D)                            !urban
+!             ELSE
+!                CALL wrf_error_fatal ( 'arguments not present for calling urban model' )
+!             ENDIF
+!          ENDIF
+!
+!
+!      CASE (RUCLSMSCHEME)
+!!          if(isfc .ne. 2)CALL wrf_error_fatal &
+!!           ( 'module_physics_init: use myjsfc and myjpbl scheme for this lsm option' )
+!           CALL lsmrucinit( SMFR3D,TSLB,SMOIS,ISLTYP,mavail,       &
+!                     num_soil_layers, restart,                     &
+!                     allowed_to_read ,                             &
+!                     ids,ide, jds,jde, kds,kde,                    &
+!                     ims,ime, jms,jme, kms,kme,                    &
+!                     its,ite, jts,jte, kts,kte                     )
+!
+!      CASE (PXLSMSCHEME)
+!          CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,  &
+!                     SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,        &
+!                     ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, &
+!                     FNDSOILW, FNDSNOWH,                       &
+!                     num_soil_layers, restart,                 &
+!                     allowed_to_read ,                         &
+!                     ids,ide, jds,jde, kds,kde,                &
+!                     ims,ime, jms,jme, kms,kme,                &
+!                     its,ite, jts,jte, kts,kte                 )
+!
+!      CASE DEFAULT
+!
+!   END SELECT sfc_select
+!
+!
+!!-- initialize pbl scheme
+!
+!   pbl_select: SELECT CASE(config_flags%bl_pbl_physics)
+!
+!      CASE (YSUSCHEME)
+!           if(isfc .ne. 1)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use sfclay scheme for this pbl option' )
+!           CALL ysuinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,    &
+!                        RQCBLTEN,RQIBLTEN,P_QI,               &
+!                        PARAM_FIRST_SCALAR,                   &
+!                        restart,                              &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE (MRFSCHEME)
+!           if(isfc .ne. 1)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use sfclay scheme for this pbl option' )
+!           CALL mrfinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,    &
+!                        RQCBLTEN,RQIBLTEN,P_QI,               &
+!                        PARAM_FIRST_SCALAR,                   &
+!                        restart,                              &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE (ACMPBLSCHEME)
+!           if(isfc .ne. 1)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use sfclay scheme for this pbl option' )
+!           CALL acminit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,    &
+!                        RQCBLTEN,RQIBLTEN,P_QI,               &
+!                        PARAM_FIRST_SCALAR,                   &
+!                        restart,                              &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE (GFSSCHEME)
+!           if(isfc .ne. 1)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use sfclay scheme for this pbl option' )
+!           CALL gfsinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,    &
+!                        RQCBLTEN,RQIBLTEN,P_QI,               &
+!                        PARAM_FIRST_SCALAR,                   &
+!                        restart,                              &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE (MYJPBLSCHEME)
+!           if(isfc .ne. 2)CALL wrf_error_fatal &
+!            ( 'module_physics_init: use myjsfc scheme for this pbl option' )
+!           CALL myjpblinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN, &
+!                        TKE_MYJ,EXCH_H,restart,               &
+!                        allowed_to_read ,                     &
+!                        ids, ide, jds, jde, kds, kde,         &
+!                        ims, ime, jms, jme, kms, kme,         &
+!                        its, ite, jts, jte, kts, kte          )
+!      CASE DEFAULT
+!
+!   END SELECT pbl_select
+!
+!   END SUBROUTINE bl_init
+!
+!!==================================================================
+!   SUBROUTINE cu_init(STEPCU,CUDT,DT,RTHCUTEN,RQVCUTEN,RQRCUTEN,  &
+!                      RQCCUTEN,RQSCUTEN,RQICUTEN,NCA,RAINC,       &
+!                      RAINCV,W0AVG,config_flags,restart,          &
+!                      CLDEFI,LOWLYR,MASS_FLUX,                    &
+!                      RTHFTEN, RQVFTEN,                           &
+!                      APR_GR,APR_W,APR_MC,APR_ST,APR_AS,          &
+!                      APR_CAPMA,APR_CAPME,APR_CAPMI,              &
+!                      cugd_tten,cugd_ttens,cugd_qvten,            &
+!                      cugd_qvtens,cugd_qcten,                     &
+!                      allowed_to_read, start_of_simulation,       &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!!------------------------------------------------------------------
+!   USE module_cu_kf
+!   USE module_cu_kfeta
+!   USE MODULE_CU_BMJ
+!   USE module_cu_gd,  ONLY : GDINIT
+!   USE module_cu_g3,  ONLY : G3INIT
+!   USE module_cu_sas
+!!------------------------------------------------------------------
+!   IMPLICIT NONE
+!!------------------------------------------------------------------
+!   TYPE (grid_config_rec_type) ::     config_flags
+!   LOGICAL , INTENT(IN)        :: restart
+!
+!
+!   INTEGER , INTENT(IN)        :: ids, ide, jds, jde, kds, kde,   &
+!                                  ims, ime, jms, jme, kms, kme,   &
+!                                  its, ite, jts, jte, kts, kte
+!
+!   REAL ,    INTENT(IN)        :: DT, CUDT
+!   LOGICAL , INTENT(IN)        :: start_of_simulation
+!   LOGICAL , INTENT(IN)        :: allowed_to_read
+!   INTEGER , INTENT(INOUT)     :: STEPCU
+!
+!   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::    &
+!            RTHCUTEN, RQVCUTEN, RQCCUTEN, RQRCUTEN, RQICUTEN, RQSCUTEN
+!   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(INOUT) ::    &
+!                        cugd_tten,cugd_ttens,cugd_qvten,            &
+!                        cugd_qvtens,cugd_qcten
+!
+!   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
+!
+!   REAL,    DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::    &
+!            RTHFTEN, RQVFTEN
+!
+!   REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: RAINC, RAINCV
+!
+!   REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(OUT):: CLDEFI
+!
+!   REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: NCA
+!
+!   REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MASS_FLUX,   &
+!                                   APR_GR,APR_W,APR_MC,APR_ST,APR_AS,    &
+!                                   APR_CAPMA,APR_CAPME,APR_CAPMI
+!
+!   INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: LOWLYR
+!
+!! LOCAL VAR
+!   
+!  INTEGER :: i,j,itf,jtf
+!
+!!--------------------------------------------------------------------
+!
+!!-- calculate cumulus parameterization time step
+!
+!   itf=min0(ite,ide-1)
+!   jtf=min0(jte,jde-1)
+!!
+!   STEPCU = nint(CUDT*60./DT)
+!   STEPCU = max(STEPCU,1)
+!
+!!-- initialization
+!
+!   IF(start_of_simulation)THEN
+!     DO j=jts,jtf
+!     DO i=its,itf
+!        RAINC(i,j)=0.
+!        RAINCV(i,j)=0.
+!     ENDDO
+!     ENDDO
+!   ENDIF
+!
+!   cps_select: SELECT CASE(config_flags%cu_physics)
+!
+!     CASE (KFSCHEME)
+!          CALL kfinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,        &
+!                      RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS,      &
+!                      PARAM_FIRST_SCALAR,restart,                 &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!
+!     CASE (BMJSCHEME)
+!          CALL bmjinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,       &
+!                      CLDEFI,LOWLYR,cp,r_d,restart,               &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!
+!     CASE (KFETASCHEME)
+!          CALL kf_eta_init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,   &
+!                      RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS,      &
+!                      SVP1,SVP2,SVP3,SVPT0,                       &
+!                      PARAM_FIRST_SCALAR,restart,                 &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!     CASE (GDSCHEME)
+!          CALL gdinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,        &
+!                      MASS_FLUX,cp,restart,                       &
+!                      P_QC,P_QI,PARAM_FIRST_SCALAR,               &
+!                      RTHFTEN, RQVFTEN,                           &
+!                      APR_GR,APR_W,APR_MC,APR_ST,APR_AS,          &
+!                      APR_CAPMA,APR_CAPME,APR_CAPMI,              &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!#if ( EM_CORE == 1 )
+!     CASE (G3SCHEME)
+!          CALL g3init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,        &
+!                      MASS_FLUX,cp,restart,                       &
+!                      P_QC,P_QI,PARAM_FIRST_SCALAR,               &
+!                      RTHFTEN, RQVFTEN,                           &
+!                      APR_GR,APR_W,APR_MC,APR_ST,APR_AS,          &
+!                      APR_CAPMA,APR_CAPME,APR_CAPMI,              &
+!                      cugd_tten,cugd_ttens,cugd_qvten,            &
+!                      cugd_qvtens,cugd_qcten,                     &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!#endif
+!     CASE (SASSCHEME)
+!          CALL sasinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,       &
+!                      restart,P_QC,P_QI,PARAM_FIRST_SCALAR,       &
+!                      allowed_to_read ,                           &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!
+!     CASE DEFAULT
+!
+!   END SELECT cps_select
+!
+!   END SUBROUTINE cu_init
+!
+!!==================================================================
+!   SUBROUTINE mp_init(RAINNC,config_flags,restart,warm_rain,      &
+!                      adv_moist_cond,                             &
+!                      MPDT, DT, DX, DY, LOWLYR,                   & ! for eta mp
+!                      F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,           & ! for eta mp
+!                      mp_restart_state,tbpvs_state,tbpvs0_state,   & ! eta mp
+!                      allowed_to_read, start_of_simulation,       &
+!                      ids, ide, jds, jde, kds, kde,               &
+!                      ims, ime, jms, jme, kms, kme,               &
+!                      its, ite, jts, jte, kts, kte                )
+!!------------------------------------------------------------------
+!   USE module_mp_wsm3
+!   USE module_mp_wsm5
+!   USE module_mp_wsm6
+!   USE module_mp_etanew
+!   USE module_mp_thompson
+!   USE module_mp_morr_two_moment  
+!!------------------------------------------------------------------
+!   IMPLICIT NONE
+!!------------------------------------------------------------------
+!! Arguments
+!   TYPE (grid_config_rec_type) ::     config_flags
+!   LOGICAL , INTENT(IN)        :: restart
+!   LOGICAL , INTENT(OUT)       :: warm_rain,adv_moist_cond
+!   REAL    , INTENT(IN)        :: MPDT, DT, DX, DY
+!   LOGICAL , INTENT(IN)        :: start_of_simulation
+!
+!   INTEGER , INTENT(IN)        :: ids, ide, jds, jde, kds, kde,   &
+!                                  ims, ime, jms, jme, kms, kme,   &
+!                                  its, ite, jts, jte, kts, kte
+!
+!   INTEGER , DIMENSION( ims:ime , jms:jme ) ,INTENT(INOUT)  :: LOWLYR
+!   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: RAINNC
+!   REAL,     DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: &
+!                                  F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
+!   REAL , DIMENSION(:) ,INTENT(INOUT)  :: mp_restart_state,tbpvs_state,tbpvs0_state
+!   LOGICAL , INTENT(IN)  :: allowed_to_read
+!
+!! Local
+!   INTEGER :: i, j, itf, jtf
+!
+!   warm_rain = .false.
+!   adv_moist_cond = .true.
+!   itf=min0(ite,ide-1)
+!   jtf=min0(jte,jde-1)
+!
+!   IF(start_of_simulation)THEN
+!     DO j=jts,jtf
+!     DO i=its,itf
+!        RAINNC(i,j) = 0.
+!     ENDDO
+!     ENDDO
+!   ENDIF
+!
+!   mp_select: SELECT CASE(config_flags%mp_physics)
+!
+!     CASE (KESSLERSCHEME)
+!          warm_rain = .true.
+!     CASE (WSM3SCHEME)
+!          CALL wsm3init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read )
+!     CASE (WSM5SCHEME)
+!          CALL wsm5init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read )
+!     CASE (WSM6SCHEME)
+!          CALL wsm6init(rhoair0,rhowater,rhosnow,cliq,cpv, allowed_to_read )
+!     CASE (ETAMPNEW)
+!         adv_moist_cond = .false.
+!         CALL etanewinit (MPDT,DT,DX,DY,LOWLYR,restart,           &
+!                          F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY,       &
+!                          mp_restart_state,tbpvs_state,tbpvs0_state,&
+!                          allowed_to_read,                        &
+!                          ids, ide, jds, jde, kds, kde,           &
+!                          ims, ime, jms, jme, kms, kme,           &
+!                          its, ite, jts, jte, kts, kte            )
+!     CASE (THOMPSON)
+!         CALL thompson_init
+!     CASE (MORR_TWO_MOMENT)          
+!         CALL morr_two_moment_init  
+!
+!     CASE DEFAULT
+!
+!   END SELECT mp_select
+!
+!   END SUBROUTINE mp_init
+!
+!#if  ( EM_CORE == 1 )
+!!==========================================================
+!   SUBROUTINE fg_init(STEPFG,FGDT,DT,id,RUNDGDTEN,RVNDGDTEN,    &
+!                RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,               &
+!                config_flags,restart,                           &
+!                allowed_to_read ,                               &
+!                ids, ide, jds, jde, kds, kde,                   &
+!                ims, ime, jms, jme, kms, kme,                   &
+!                its, ite, jts, jte, kts, kte                    )
+!
+!
+!!--------------------------------------------------------------------
+!   USE module_fdda_psufddagd
+!!--------------------------------------------------------------------
+!   IMPLICIT NONE
+!!--------------------------------------------------------------------
+!   TYPE (grid_config_rec_type) ::     config_flags
+!   LOGICAL , INTENT(IN)        :: restart
+!
+!   INTEGER , INTENT(IN)        ::     ids, ide, jds, jde, kds, kde, &
+!                                      ims, ime, jms, jme, kms, kme, &
+!                                      its, ite, jts, jte, kts, kte
+!
+!   REAL ,    INTENT(IN)        ::     DT, FGDT
+!   INTEGER , INTENT(IN)        ::     id
+!   INTEGER , INTENT(INOUT)     ::     STEPFG
+!   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::       &
+!                                                           RUNDGDTEN, &
+!                                                           RVNDGDTEN, &
+!                                                          RTHNDGDTEN, &
+!                                                          RQVNDGDTEN
+!   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT) :: RMUNDGDTEN
+!
+!   LOGICAL,  INTENT(IN)           :: allowed_to_read
+!!--------------------------------------------------------------------
+!
+!!-- calculate pbl time step
+!
+!   STEPFG = nint(FGDT*60./DT)
+!   STEPFG = max(STEPFG,1)
+!
+!
+!!-- initialize fdda scheme
+!
+!   fdda_select: SELECT CASE(config_flags%grid_fdda)
+!
+!      CASE (PSUFDDAGD)
+!           CALL fddagdinit(id,rundgdten,rvndgdten,rthndgdten,rqvndgdten,rmundgdten,&
+!               config_flags%run_hours, &
+!               config_flags%if_no_pbl_nudging_uv, &
+!               config_flags%if_no_pbl_nudging_t, &
+!               config_flags%if_no_pbl_nudging_q, &
+!               config_flags%if_zfac_uv, &
+!               config_flags%k_zfac_uv, &
+!               config_flags%if_zfac_t, &
+!               config_flags%k_zfac_t, &
+!               config_flags%if_zfac_q, &
+!               config_flags%k_zfac_q, &
+!               config_flags%guv, &
+!               config_flags%gt, config_flags%gq, &
+!               config_flags%if_ramping, config_flags%dtramp_min, &
+!               config_flags%gfdda_end_h, &
+!                      restart, allowed_to_read,                    &
+!                      ids, ide, jds, jde, kds, kde,                &
+!                      ims, ime, jms, jme, kms, kme,                &
+!                      its, ite, jts, jte, kts, kte                 )
+!      CASE DEFAULT
+!
+!   END SELECT fdda_select
+!
+!   END SUBROUTINE fg_init
+!
+!!-------------------------------------------------------------------
+!   SUBROUTINE fdob_init(obs_nudge_opt, maxdom, inest, parid,       &
+!                        idynin, dtramp, fdaend, restart,           &
+!                        obs_twindo_cg, obs_twindo, itimestep,      &
+!                        cen_lat, cen_lon, stand_lon,               &
+!                        true_lat1, true_lat2, map_proj,            &
+!                        xlat, xlong,                               &
+!                        s_sn_cg, e_sn_cg, s_we_cg, e_we_cg,        &
+!                        fdob, ipf_init,                            &
+!                        ids, ide, jds, jde, kds, kde,              &
+!                        ims, ime, jms, jme, kms, kme,              &
+!                        its, ite, jts, jte, kts, kte               )
+!
+!!--------------------------------------------------------------------
+!   USE module_domain
+!   USE module_fddaobs_rtfdda
+!   USE module_llxy
+!!--------------------------------------------------------------------
+!   IMPLICIT NONE
+!!--------------------------------------------------------------------
+!   INTEGER , INTENT(IN)    :: maxdom
+!   INTEGER , INTENT(IN)    :: obs_nudge_opt(maxdom)
+!   INTEGER , INTENT(IN)    :: ids,ide, jds,jde, kds,kde,           &
+!                              ims,ime, jms,jme, kms,kme,           &
+!                              its,ite, jts,jte, kts,kte
+!   INTEGER , INTENT(IN)    :: inest
+!   INTEGER , INTENT(IN)    :: parid(maxdom)
+!   INTEGER , INTENT(IN)    :: idynin          ! flag for dynamic initialization
+!   REAL    , INTENT(IN)    :: dtramp          ! time period for ramping (idynin)
+!   REAL    , INTENT(IN)    :: fdaend(maxdom)  ! nudging end time for domain (min)
+!   LOGICAL , INTENT(IN)    :: restart
+!   REAL    , INTENT(IN)    :: obs_twindo_cg   ! twindo on course grid
+!   REAL    , INTENT(IN)    :: obs_twindo
+!   INTEGER , INTENT(IN)    :: itimestep
+!   REAL    , INTENT(IN)    :: cen_lat      ! domain center latitude
+!   REAL    , INTENT(IN)    :: cen_lon      ! domain center longitude
+!   REAL    , INTENT(IN)    :: stand_lon    ! domain longitude
+!   REAL    , INTENT(IN)    :: true_lat1    ! domain standard parallel 
+!   REAL    , INTENT(IN)    :: true_lat2    ! domain second standard parallel
+!   INTEGER , INTENT(IN)    :: map_proj     ! map projection
+!   REAL, DIMENSION( ims:ime, jms:jme ),                            &
+!         INTENT(IN )       :: xlat, xlong  ! lat/long locations on mass point grid
+!   INTEGER, intent(in)     :: s_sn_cg      ! starting north-south coarse-grid index
+!   INTEGER, intent(in)     :: e_sn_cg      ! ending   north-south coarse-grid index
+!   INTEGER, intent(in)     :: s_we_cg      ! starting west-east   coarse-grid index
+!   INTEGER, intent(in)     :: e_we_cg      ! ending   west-east   coarse-grid index
+!
+!   TYPE(fdob_type), INTENT(INOUT)  :: fdob
+!
+!   INTEGER                 :: e_sn         ! ending   north-south grid index
+!   LOGICAL                 :: ipf_init     ! print warnings detected at initialzn
+!!--------------------------------------------------------------------
+!!-- initialize fdda obs-nudging scheme
+!
+!      IF ( obs_nudge_opt(inest) .eq. 0 ) RETURN
+!
+!      e_sn = jde
+!      CALL fddaobs_init(obs_nudge_opt, maxdom, inest, parid,       &  
+!                        idynin, dtramp, fdaend, restart,           &
+!                        obs_twindo_cg,                             &
+!                        obs_twindo, itimestep,                     &
+!                        cen_lat, cen_lon, stand_lon,               &
+!                        true_lat1, true_lat2, map_proj,            &
+!                        xlat, xlong,                               &
+!                        e_sn, s_sn_cg, e_sn_cg, s_we_cg, e_we_cg,  &
+!                        fdob, ipf_init,                            &
+!                        ids,ide, jds,jde, kds,kde,                 &  
+!                        ims,ime, jms,jme, kms,kme,                 &  
+!                        its,ite, jts,jte, kts,kte)
+!
+!   END SUBROUTINE fdob_init
+!#endif
+
+!--------------------------------------------------------------------
+   SUBROUTINE z2sigma(zf,zh,sf,sh,p_top,pptop,config_flags, &
+                allowed_to_read , &
+                kds,kde,kms,kme,kts,kte)
+   IMPLICIT NONE
+! Arguments
+   INTEGER, INTENT(IN) :: kds,kde,kms,kme,kts,kte
+   REAL , DIMENSION( kms:kme ), INTENT(IN) :: zf,zh
+   REAL , DIMENSION( kms:kme ), INTENT(OUT):: sf,sh
+   REAL , INTENT(IN) :: p_top
+   REAL , INTENT(OUT) :: pptop
+   TYPE (grid_config_rec_type)              :: config_flags
+   LOGICAL , INTENT(IN) :: allowed_to_read
+! Local
+   REAL R, G, TS, GAMMA, PS, ZTROP, TSTRAT, PTROP, Z, T, P, ZTOP, PTOP
+   INTEGER K
+
+   IF(zf(kde/2) .GT. 1.0)THEN
+! Height levels assumed (zeta coordinate)
+! Convert to sigma using standard atmosphere for pressure-height relation
+! constants for standard atmosphere definition
+      r=287.05
+      g=9.80665
+      ts=288.15
+      gamma=-6.5/1000.
+      ps=1013.25
+      ztrop=11000.
+      tstrat=ts+gamma*ztrop
+      ptrop=ps*(tstrat/ts)**(-g/(gamma*r))
+
+      do k=kde,kds,-1
+! full levels
+        z=zf(k)
+        if(z.le.ztrop)then
+          t=ts+gamma*z
+          p=ps*(t/ts)**(-g/(gamma*r))
+        else
+          t=tstrat
+          p=ptrop*exp(-g*(z-ztrop)/(r*tstrat))
+        endif
+        if(k.eq.kde)then
+          ztop=zf(k)
+          ptop=p
+        endif
+        sf(k)=(p-ptop)/(ps-ptop)
+! half levels
+        if(k.ne.kds)then
+        z=0.5*(zf(k)+zf(k-1))
+        if(z.le.ztrop)then
+          t=ts+gamma*z
+          p=ps*(t/ts)**(-g/(gamma*r))
+        else
+          t=tstrat
+          p=ptrop*exp(-g*(z-ztrop)/(r*tstrat))
+        endif
+        sh(k-1)=(p-ptop)/(ps-ptop)
+        endif
+      enddo
+      pptop=ptop/10.
+   ELSE
+!  Levels are already sigma/eta
+      do k=kde,kds,-1
+!        sf(k)=zf(kde-k+kds)
+!        if(k .ne. kde)sh(k)=zh(kde-1-k+kds)
+         sf(k)=zf(k)
+         if(k .ne. kde)sh(k)=zh(k)
+      enddo
+      pptop=p_top/1000.
+
+   ENDIF
+
+   END SUBROUTINE z2sigma
+
+END MODULE module_physics_init