Index: trunk/WRF.COMMON/WRFV3/Registry/Registry.EM =================================================================== --- trunk/WRF.COMMON/WRFV3/Registry/Registry.EM (revision 2759) +++ (revision ) @@ -1,1621 +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 - - -################################################################################ -################################################################################ -################################################################################ - -#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 - i02rh01d=(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 irh "ZS" "DEPTHS OF CENTERS OF SOIL LAYERS" "m" -state real DZS l misc - Z irh "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 - -#----------------------------------------------------------------------------------------------------------------------------------------------------------------- -# -# 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 \ - 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" -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 - -# 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" -# - - -# 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" -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 - rhu=(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 - rh "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 - rhdus "pb" "BASE STATE 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 - 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 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 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 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" - -# 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 - - irh "rdx" "INVERSE X GRID LENGTH" "" -state real rdy - misc - - irh "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 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 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 - \ - i01rhusdf=(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" -state real qr ikjftb moist 1 - \ - i01rhusdf=(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" -state real qs ikjftb moist 1 - \ - i01rhusdf=(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" -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 - \ - i01rhusdf=(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" -state real qt ikjftb scalar 1 - \ - i01rhusdf=(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)" -state real qnr ikjftb scalar 1 - \ - i01rhusdf=(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)" -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 - i012rhd=(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 i02rhd=(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 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 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 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 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 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 - h "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 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" -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 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 - - 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" "" - -# 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 - 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 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 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 - h "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 - rhd "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" - -# 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 - rh "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 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 EMBCK ij misc 1 - r "EMBCK" "BACKGROUND EMISSIVITY" "" -state real EMISS ij misc 1 - rh "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 - 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 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" -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 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 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 - irhd=(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 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_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_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 -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 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 5 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.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 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 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 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 .false. 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 - -#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/arch/configure_new.defaults =================================================================== --- trunk/WRF.COMMON/WRFV3/arch/configure_new.defaults (revision 2759) +++ (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 -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 -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 2759) +++ (revision ) @@ -1,276 +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_microphysics_driver.o \ - ../phys/module_microphysics_zero_out.o \ - ../phys/module_physics_addtendc.o - -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 - -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 \ - ../phys/module_fddaobs_driver.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 2759) +++ (revision ) @@ -1,5594 +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, 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 - 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, & - 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, & - 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 - t_phy(i,k,j) = th_phy(i,k,j)*pi_phy(i,k,j) - 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) ) - 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 - - IF (config_flags%bl_pbl_physics .gt. 0) THEN - - 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 2759) +++ (revision ) @@ -1,5520 +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) THEN - - 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 - 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 - 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 - - 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 2759) +++ (revision ) @@ -1,1773 +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 - - 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 ) - - 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 - - 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 2759) +++ (revision ) @@ -1,562 +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 - 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 - 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), 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%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, & - 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) - -! 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) - - 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 2759) +++ (revision ) @@ -1,599 +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 - 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 -! -!----------------------------------------------------------------------- - 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 - - IF (config_flags%bl_pbl_physics .eq. 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 - - 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 2759) +++ (revision ) @@ -1,839 +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 - 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, 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 - -#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 - - -! stretch_grid = .true. -! FOR LES, set stretch to false - stretch_grid = .false. - delt = 3. -! z_scale = .50 - z_scale = .40 - 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) = 1.e-4 - - 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 - DO k=1, kde - grid%znw(k) = 1. - float(k-1)/float(kde-1) - ENDDO - ENDIF - - 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 - -! 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 ) - - DO j=jts,jte - DO i=its,ite - grid%ht(i,j) = 0. - 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) = 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 - - 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 - grid%t_init(i,k,j) = interp_0( theta, p_in, p_level, nl_in ) - t0 - 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. - - 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 - - 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 - - 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 - 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. - 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 - - 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 - - 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 - - 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, 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), & - 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 - grid%v_1(i,k,j) = interp_0( v, p_in, p_level, nl_in ) - 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 - grid%u_1(i,k,j) = interp_0( u, p_in, p_level, nl_in ) - 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 - -! 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. - 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 - 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 - - 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) - -! 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 ) - integer k, it, nl - real qvf, qvf1, dz - -! 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 ) - - if(dry) then - do k=1,nl - qv_input(k) = 0. - enddo - endif - - 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 - -! compute diagnostics, -! first, convert qv(g/kg) to qv(g/g) - - do k=1,nl - 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) - - 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) - 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)) - 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 - - 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)) - 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 - - - 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 - -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 2759) +++ (revision ) @@ -1,3231 +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 - 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
-
-   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
-
-! 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)
-
-   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 2759)
+++ 	(revision )
@@ -1,106 +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
-#endif
- CONTAINS
-   SUBROUTINE init_module_driver_constants
-   END SUBROUTINE init_module_driver_constants
- END MODULE module_driver_constants
Index: trunk/WRF.COMMON/WRFV3/phys/Makefile
===================================================================
--- trunk/WRF.COMMON/WRFV3/phys/Makefile	(revision 2759)
+++ 	(revision )
@@ -1,286 +1,0 @@
-#
-
-LN      =       ln -sf
-MAKE    =       make -i -r
-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
-  
-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_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 \
-		../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
-
-# DO NOT DELETE
Index: trunk/WRF.COMMON/WRFV3/phys/module_physics_addtendc.F
===================================================================
--- trunk/WRF.COMMON/WRFV3/phys/module_physics_addtendc.F	(revision 2759)
+++ 	(revision )
@@ -1,1192 +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)                     &
-      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
-
-!-----------------------------------------------------------------
-
-   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
-   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 
-
-!=====================================================================
-   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