From dbb4ebbd5052cd9b3f771d27522b1972f4f7ba23 Mon Sep 17 00:00:00 2001 From: David Gill Date: Tue, 5 Jul 2016 21:59:45 +0000 Subject: [PATCH 1/7] Branch for ARW Hybrid Coordinate, root=9429 git-svn-id: https://svn-wrf-model.cgd.ucar.edu/branches/HYBRID_COORDINATE_root=4929_start=20160705@9431 b0b5d27b-6f0f-0410-a2a3-cb1e977edc3d From 9232e6c149fed99b8821f87b2e706cd793500d2f Mon Sep 17 00:00:00 2001 From: David Gill Date: Tue, 5 Jul 2016 22:26:24 +0000 Subject: [PATCH 2/7] Initial branch for the ARW hybrid coordinate modifications. This commit: 1) allows ideal hill2d_x or real 2) bit for bit (hybrid_opt=0) vs terrain following 3) bit for bit serial and MPI 4) Has info for several hill2d cases (nml and inputs) git-svn-id: https://svn-wrf-model.cgd.ucar.edu/branches/HYBRID_COORDINATE_root=4929_start=20160705@9435 b0b5d27b-6f0f-0410-a2a3-cb1e977edc3d --- Registry/Registry.EM | 1 + Registry/registry.hyb_coord | 56 ++ arch/configure_new.defaults | 148 ++-- arch/noopt_exceptions | 276 -------- arch/noopt_exceptions_f | 185 ----- arch/postamble_new | 19 +- dyn_em/couple_or_uncouple_em.F | 112 ++- dyn_em/module_advect_em.F | 68 +- dyn_em/module_bc_em.F | 208 ++++-- dyn_em/module_big_step_utilities_em.F | 653 +++++++++++------- dyn_em/module_diffusion_em.F | 155 +++-- dyn_em/module_em.F | 258 ++++--- dyn_em/module_first_rk_step_part1.F | 5 +- dyn_em/module_first_rk_step_part2.F | 11 +- dyn_em/module_initialize_hill2d_x.F | 234 ++++++- dyn_em/module_initialize_real.F | 377 +++++++--- dyn_em/module_polarfft.F | 22 +- dyn_em/module_small_step_em.F | 223 ++++-- dyn_em/nest_init_utils.F | 23 +- dyn_em/solve_em.F | 230 +++--- dyn_em/start_em.F | 218 ++++-- external/RSL_LITE/module_dm.F | 65 +- external/io_esmf/makefile | 3 - main/Makefile | 2 +- main/ndown_em.F | 18 + main/real_em.F | 14 + phys/module_microphysics_driver.F | 8 +- phys/module_mp_morr_two_moment.F | 6 +- share/mediation_integrate.F | 2 +- share/module_bc.F | 18 +- test/em_hill2d_x/input_sounding-U=10,N=0.01 | 602 ++++++++++++++++ test/em_hill2d_x/input_sounding-U=15,N=0.01 | 602 ++++++++++++++++ test/em_hill2d_x/input_sounding-layers-20mps | 602 ++++++++++++++++ test/em_hill2d_x/namelist.input | 2 + ...km_deep-20km_damping-dampcoef=0.1-etac=0.2 | 101 +++ ...m_deep-15km_damping-dampcoef=0.08-etac=0.2 | 101 +++ test/em_hill2d_x/namelist.input-HILL | 103 +++ test/em_hill2d_x/namelist.input-HILL-51 | 103 +++ test/em_hill2d_x/namelist.input-HILL-schar | 103 +++ test/em_hill2d_x/test.csh | 81 +++ test/em_real/namelist.input | 51 +- 41 files changed, 4664 insertions(+), 1405 deletions(-) create mode 100644 Registry/registry.hyb_coord create mode 100644 test/em_hill2d_x/input_sounding-U=10,N=0.01 create mode 100644 test/em_hill2d_x/input_sounding-U=15,N=0.01 create mode 100644 test/em_hill2d_x/input_sounding-layers-20mps create mode 100644 test/em_hill2d_x/namelist.input-100m_hill-10mps-N^2=0.0001-30km_deep-20km_damping-dampcoef=0.1-etac=0.2 create mode 100644 test/em_hill2d_x/namelist.input-700m_hill-15mps-n^2=0.0001-25km_deep-15km_damping-dampcoef=0.08-etac=0.2 create mode 100644 test/em_hill2d_x/namelist.input-HILL create mode 100644 test/em_hill2d_x/namelist.input-HILL-51 create mode 100644 test/em_hill2d_x/namelist.input-HILL-schar create mode 100755 test/em_hill2d_x/test.csh diff --git a/Registry/Registry.EM b/Registry/Registry.EM index f2e5491f91..e12d9aa383 100644 --- a/Registry/Registry.EM +++ b/Registry/Registry.EM @@ -18,6 +18,7 @@ include registry.afwa include registry.sbm include registry.elec include registry.bdy_perturb +include registry.hyb_coord # added to output 5 for ESMF state real landmask ij misc 1 - i0125rh05d=(interp_fcnm_imask)u=(copy_fcnm) "LANDMASK" "LAND MASK (1 FOR LAND, 0 FOR WATER)" "" diff --git a/Registry/registry.hyb_coord b/Registry/registry.hyb_coord new file mode 100644 index 0000000000..b260744107 --- /dev/null +++ b/Registry/registry.hyb_coord @@ -0,0 +1,56 @@ +# Dry pressure, Pd +# Dry surface pressure = Pds +# Model top pressure = Pt +# Mass in column, Pc = Pds - Pt + +# Total dry pressure +# Pd = BF ( Pds - Pt ) + ( eta - BF ) ( P0 - Pt ) + Pt + +# Hybrid coordinate: mu is still d(Pd)/d(eta) +# new MUT = d Pd / d eta = d BF / d eta * ( Pcb + Pc ) + ( 1 - d BF / d eta ) * ( P0 - Pt ) + +# Define two columnar constants, function only of eta and other constants, specifically for the "mu" replacements. +# C1 = d BF / d eta +# C2 = ( 1 - d BF / d eta ) * ( P0 - Pt ) + +# Total field +# new MUT(i,k,j) = C1(k) * ( Pcb(i,j) + Pc(i,j) ) + C2(k) + +# Base-state, background field +# new MUB(i,k,j) = C1(k) * Pcb(i,j) + C2(k) + +# Perturbation field +# new MU(i,k,j) = C1(k) * Pc(i,j) + +# Define two columnar constants, function only of eta and other constants, specifically for the "pressure" replacements. +# C3 = BF +# C4 = ( eta - BF ) * ( P0 - Pt ) + +# new dry pressure Pd(i,k,j) = C3(k) * ( Pds(i,j) - Pt ) + C4(k) + Pt + + +# + +state real bf k misc 1 Z i02rh0{22}{23}{24} "BF" "full levels, bf=0 => isobaric; bf=znw => sigma" "Dimensionless" +state real c1h k misc 1 - i02rh0{22}{23}{24} "C1H" "half levels, c1h = d bf / d eta, using znw" "Dimensionless" +state real c2h k misc 1 - i02rh0{22}{23}{24} "C2H" "half levels, c2h = (1-c1h)*(p0-pt)" "Pa" + +state real bh k misc 1 - i02rh0{22}{23}{24} "BH" "half levels, bh=0 => isobaric; bh=znu => sigma" "Dimensionless" +state real c1f k misc 1 Z i02rh0{22}{23}{24} "C1F" "full levels, c1f = d bf / d eta, using znu" "Dimensionless" +state real c2f k misc 1 Z i02rh0{22}{23}{24} "C2F" "full levels, c2f = (1-c1f)*(p0-pt)" "Pa" + +state real c3h k misc 1 - i02rh0{22}{23}{24} "C3H" "half levels, c3h = bh" "Dimensionless" +state real c4h k misc 1 - i02rh0{22}{23}{24} "C4H" "half levels, c4h = (eta-bh)*(p0-pt)+pt, using znu" "Pa" + +state real c3f k misc 1 Z i02rh0{22}{23}{24} "C3F" "full levels, c3f = bf" "Dimensionless" +state real c4f k misc 1 Z i02rh0{22}{23}{24} "C4F" "full levels, c4f = (eta-bf)*(p0-pt)+pt, using znw" "Pa" + +state real pcb ij dyn_em 1 - irhdus "PCB" "base state dry air mass in column" "Pa" +state real pc ijb dyn_em 2 - irhusdf=(bdy_interp:dt) "PC" "perturbation dry air mass in column" "Pa" + + + + +#
+rconfig integer hybrid_opt namelist,dynamics 1 0 i0 "HYBRID_OPT" "0=Original WRF coordinate, 1=Terrain Following using hybrid formulation, 2=Klemp cubic form with etac" "Flag" +rconfig real etac namelist,dynamics 1 -1. i0 "ETAC" "znw(k) < etac, eta surfaces are isobaric" "Dimensionless" diff --git a/arch/configure_new.defaults b/arch/configure_new.defaults index 112e72fda4..85dbc322d0 100644 --- a/arch/configure_new.defaults +++ b/arch/configure_new.defaults @@ -33,8 +33,8 @@ BYTESWAPIO = #-FIX_BYTE_SWAP_IF_NECESSARY_FOR_BIG_ENDIAN FCBASEOPTS_NO_G = -w -Wf'-M noflunf -M nozdiv' $(FORMAT_FREE) $(BYTESWAPIO) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -I/SX/usr/include/module/dwdadW64/ -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = sxar ARFLAGS = ru M4 = m4 -B 14000 @@ -77,8 +77,8 @@ BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -120,8 +120,8 @@ BYTESWAPIO = -fendian=big FCBASEOPTS_NO_G = -Wno=101,139,155,158 $(FORMAT_FREE) $(BYTESWAPIO) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -fmod=$(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -163,8 +163,8 @@ BYTESWAPIO = -byteswapio FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(OMP) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -206,8 +206,8 @@ BYTESWAPIO = -byteswapio FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(OMP) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -248,8 +248,8 @@ FCSUFFIX = BYTESWAPIO = -byteswapio FCBASEOPTS = -w $(FCDEBUG) $(FORMAT_FREE) $(BYTESWAPIO) $(OMP) MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -324,8 +324,8 @@ BYTESWAPIO = -convert big_endian FCBASEOPTS_NO_G = -ip -fp-model precise -w -ftz -align all -fno-alias $(FORMAT_FREE) $(BYTESWAPIO) #-xHost -fp-model fast=2 -no-heap-arrays -no-prec-div -no-prec-sqrt -fno-common FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 @@ -370,8 +370,8 @@ BYTESWAPIO = -convert big_endian FCBASEOPTS_NO_G = -w -openmp -auto -ftz -fno-alias -fp-model fast=1 -no-prec-div -no-prec-sqrt $(FORMAT_FREE) $(BYTESWAPIO) -auto -align array64byte #-vec-report6 FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 @@ -416,8 +416,8 @@ BYTESWAPIO = -convert big_endian FCBASEOPTS_NO_G = -w $(OMP) -auto -ftz -fno-alias -fp-model fast=1 -no-prec-div -no-prec-sqrt $(FORMAT_FREE) $(BYTESWAPIO) -auto -align array64byte #-vec-report6 FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 @@ -486,8 +486,8 @@ BYTESWAPIO = -convert big_endian FCBASEOPTS_NO_G = -ip -fp-model precise -w -ftz -align all -fno-alias $(FORMAT_FREE) $(BYTESWAPIO) #-xHost -fp-model fast=2 -no-heap-arrays -no-prec-div -no-prec-sqrt -fno-common FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 @@ -534,8 +534,8 @@ BYTESWAPIO = -convert big_endian FCBASEOPTS_NO_G = -ip -fp-model precise -w -ftz -align all -fno-alias $(FORMAT_FREE) $(BYTESWAPIO) #-xHost -fp-model fast=2 -no-heap-arrays -no-prec-div -no-prec-sqrt -fno-common FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 @@ -614,8 +614,8 @@ FCBASEOPTS_NO_G = -ip -fp-model precise -w -ftz -align all -fno-alias $(FO FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) LIB_LOCAL = -L/usr/lib -lmpi MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 @@ -696,8 +696,8 @@ FCBASEOPTS_NO_G = -ip -fp-model precise -w -ftz -align all -fno-alias $(FO FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) LIB_LOCAL = -L/usr/lib -lmpi MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 @@ -739,8 +739,8 @@ BYTESWAPIO = -byteswapio FCBASEOPTS_NO_G = -w -fno-second-underscore $(FORMAT_FREE) $(BYTESWAPIO) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -782,8 +782,8 @@ BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -G @@ -825,8 +825,8 @@ BYTESWAPIO = -byteswapio FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(OMP) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) -Mnomod MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = cpp -P -xassembler-with-cpp +TRADFLAG = #-traditional-cpp +CPP = cpp -P -C -xassembler-with-cpp AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -870,8 +870,8 @@ BYTESWAPIO = -convert big_endian FCBASEOPTS_NO_G = -ip -fp-model precise -w -ftz -align all -fno-alias $(FORMAT_FREE) $(BYTESWAPIO) #-xHost -fp-model fast=2 -no-heap-arrays -no-prec-div -no-prec-sqrt -fno-common FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = cpp -P -xassembler-with-cpp +TRADFLAG = #-traditional-cpp +CPP = cpp -P -C -xassembler-with-cpp AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -914,8 +914,8 @@ BYTESWAPIO = -convert big_endian FCBASEOPTS_NO_G = -fp-model precise -w -ftz -align all -fno-alias -fno-common $(FORMAT_FREE) $(BYTESWAPIO) #-xHost -fp-model fast=2 -no-heap-arrays -no-prec-div -no-prec-sqrt FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = cpp -P -xassembler-with-cpp +TRADFLAG = #-traditional-cpp +CPP = cpp -P -C -xassembler-with-cpp AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -958,8 +958,8 @@ FCBASEOPTS_NO_G = -Wno=101,139,155,158 $(FORMAT_FREE) $(BYTESWAPIO) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) LIB_LOCAL = -L/usr/lib -lSystemStubs MODULE_SRCH_FLAG = -fmod=$(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = cpp -P -xassembler-with-cpp +TRADFLAG = #-traditional-cpp +CPP = cpp -P -C -xassembler-with-cpp AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -1001,8 +1001,8 @@ BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = cpp -P -xassembler-with-cpp +TRADFLAG = #-traditional-cpp +CPP = cpp -P -C -xassembler-with-cpp AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -1044,8 +1044,8 @@ BYTESWAPIO = -fconvert=big-endian -frecord-marker=4 FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = cpp -P -xassembler-with-cpp +TRADFLAG = #-traditional-cpp +CPP = cpp -P -C -xassembler-with-cpp AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -1089,8 +1089,8 @@ BYTESWAPIO = FCBASEOPTS_NO_G = -qsave -qmaxmem=32767 -qspillsize=32767 -w FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -fmod=$(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = cpp -P +TRADFLAG = #-traditional-cpp +CPP = cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -1137,8 +1137,8 @@ BYTESWAPIO = FCBASEOPTS_NO_G = -w -qspill=81920 -qmaxmem=-1 $(FORMAT_FREE) $(BYTESWAPIO) #-qflttrap=zerodivide:invalid:enable -qsigtrap -C # -qinitauto=7FF7FFFF FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = #-traditional # causing troubles with xl cpp on AIX, -traditional removed fom default settings -CPP = /lib/cpp -P +TRADFLAG = ##-traditional-cpp # causing troubles with xl cpp on AIX, -traditional removed fom default settings +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 20000 @@ -1189,7 +1189,7 @@ MODULE_SRCH_FLAG = TRADFLAG = # instead of the GNU CPP, the CPP shipped with XLF should be used, # which does not work with the -traditional flag -CPP = $(XLF_BASE)/exe/cpp -P +CPP = $(XLF_BASE)/exe/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -1250,8 +1250,8 @@ BYTESWAPIO = -byteswapio FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(OPTERON_TYPE) $(OMP) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P $(TRADFLAG) +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C $(TRADFLAG) AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -1297,8 +1297,8 @@ BYTESWAPIO = -h byteswapio FCBASEOPTS_NO_G = -N1023 $(FORMAT_FREE) $(BYTESWAPIO) #-ra FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 @@ -1344,8 +1344,8 @@ BYTESWAPIO = -convert big_endian FCBASEOPTS_NO_G = -w -ftz -fno-alias -align all $(FORMAT_FREE) $(BYTESWAPIO) #-vec-report6 FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 @@ -1387,8 +1387,8 @@ BYTESWAPIO = FCBASEOPTS_NO_G = -Kautoobjstack,ocl -V -Qa,d,i,p,t,x -Koptmsg=2 $(FORMAT_FREE) $(BYTESWAPIO) $(OMP) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 @@ -1434,12 +1434,12 @@ BYTESWAPIO = FCBASEOPTS_NO_G = -w -qspill=20000 -qmaxmem=64000 $(FORMAT_FREE) $(BYTESWAPIO) $(MPI_INC) #-qflttrap=zerodivide:invalid:enable -qsigtrap FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional +TRADFLAG = #-traditional-cpp # 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 -P +CPP = /opt/ibmcmp/xlf/bg/10.1/exe/cpp -P -C # frost.ucar.edu -CPP = /opt/ibmcmp/xlf/9.1/exe/cpp -P +CPP = /opt/ibmcmp/xlf/9.1/exe/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -1483,10 +1483,10 @@ BYTESWAPIO = FCBASEOPTS_NO_G = -w -qspill=20000 -qmaxmem=64000 $(FORMAT_FREE) $(BYTESWAPIO) #-qflttrap=zerodivide:invalid:enable -qsigtrap FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional +TRADFLAG = #-traditional-cpp # this might be different on different systems but we want the xlf version of cpp, not Linux's # surveyor.alcf.anl.gov -CPP = /opt/ibmcmp/xlf/bg/11.1/exe/cpp -P +CPP = /opt/ibmcmp/xlf/bg/11.1/exe/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -1528,9 +1528,9 @@ BYTESWAPIO = FCBASEOPTS_NO_G = -w -qspill=20000 -qmaxmem=32767 $(FORMAT_FREE) $(BYTESWAPIO) #-qflttrap=zerodivide:invalid:enable -qsigtrap FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional +TRADFLAG = #-traditional-cpp # this might be different on different systems but we want the xlf version of cpp, not Linux -CPP = /opt/ibmcmp/xlf/11.1/exe/cpp -P +CPP = /opt/ibmcmp/xlf/11.1/exe/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -1572,8 +1572,8 @@ BYTESWAPIO = -byteswapio FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(OMP) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -1672,8 +1672,8 @@ BYTESWAPIO = -byteswapio FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(OMP) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -1715,8 +1715,8 @@ BYTESWAPIO = -byteswapio FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(OMP) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) -Mnomod MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = cpp -P -xassembler-with-cpp +TRADFLAG = #-traditional-cpp +CPP = cpp -P -C -xassembler-with-cpp AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -1758,8 +1758,8 @@ BYTESWAPIO = -byteswapio FCBASEOPTS_NO_G = -w $(FORMAT_FREE) $(BYTESWAPIO) $(OMP) FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -module $(WRF_SRC_ROOT_DIR)/main -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 -B 14000 @@ -1801,8 +1801,8 @@ BYTESWAPIO = -convert big_endian FCBASEOPTS_NO_G = -ip -fp-model precise -w -ftz -align all -fno-alias $(FORMAT_FREE) $(BYTESWAPIO) -xHost -fp-model fast=2 -no-heap-arrays -no-prec-div -no-prec-sqrt -fno-common -xCORE-AVX2 FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 @@ -1844,8 +1844,8 @@ BYTESWAPIO = -convert big_endian FCBASEOPTS_NO_G = -ip -fp-model precise -w -ftz -align all -fno-alias $(FORMAT_FREE) $(BYTESWAPIO) -xHost -fp-model fast=2 -no-heap-arrays -no-prec-div -no-prec-sqrt -fno-common -xMIC-AVX512 FCBASEOPTS = $(FCBASEOPTS_NO_G) $(FCDEBUG) MODULE_SRCH_FLAG = -TRADFLAG = -traditional -CPP = /lib/cpp -P +TRADFLAG = #-traditional-cpp +CPP = /lib/cpp -P -C AR = ar ARFLAGS = ru M4 = m4 diff --git a/arch/noopt_exceptions b/arch/noopt_exceptions index 95544e54ab..e69de29bb2 100644 --- a/arch/noopt_exceptions +++ b/arch/noopt_exceptions @@ -1,276 +0,0 @@ -# compile these without high optimization to speed compile - -convert_nmm.o : convert_nmm.F -init_modules_em.o : init_modules_em.F -input_wrf.o : input_wrf.F -module_io.o : module_io.F -mediation_feedback_domain.o : mediation_feedback_domain.F -mediation_force_domain.o : mediation_force_domain.F -mediation_integrate.o : mediation_integrate.F -track_driver.o : track_driver.F -mediation_interp_domain.o : mediation_interp_domain.F -module_comm_dm.o : module_comm_dm.F -module_comm_dm_0.o : module_comm_dm_0.F -module_comm_dm_1.o : module_comm_dm_1.F -module_comm_dm_2.o : module_comm_dm_2.F -module_comm_dm_3.o : module_comm_dm_3.F -module_comm_nesting_dm.o : module_comm_nesting_dm.F -module_configure.o : module_configure.F -module_dm.o : module_dm.F -module_domain.o : module_domain.F -module_domain_type.o : module_domain_type.F -module_alloc_space_0.o : module_alloc_space_0.F -module_alloc_space_1.o : module_alloc_space_1.F -module_alloc_space_2.o : module_alloc_space_2.F -module_alloc_space_3.o : module_alloc_space_3.F -module_alloc_space_4.o : module_alloc_space_4.F -module_alloc_space_5.o : module_alloc_space_5.F -module_alloc_space_6.o : module_alloc_space_6.F -module_alloc_space_7.o : module_alloc_space_7.F -module_alloc_space_8.o : module_alloc_space_8.F -module_alloc_space_9.o : module_alloc_space_9.F -module_tiles.o : module_tiles.F -module_fddaobs_rtfdda.o : module_fddaobs_rtfdda.F -module_initialize.o : module_initialize.F -module_physics_init.o : module_physics_init.F -module_initialize_b_wave.o : module_initialize_b_wave.F -module_initialize_hill2d_x.o : module_initialize_hill2d_x.F -module_initialize_quarter_ss.o : module_initialize_quarter_ss.F -module_initialize_real.o : module_initialize_real.F -module_initialize_real.o: module_initialize_real.F -module_initialize_squall2d_x.o : module_initialize_squall2d_x.F -module_initialize_squall2d_y.o : module_initialize_squall2d_y.F -module_initialize_scm_xy.o : module_initialize_scm_xy.F -module_integrate.o : module_integrate.F -module_io_mm5.o : module_io_mm5.F -module_io_wrf.o : module_io_wrf.F -module_si_io.o : module_si_io.F -module_wps_io_arw.o : module_wps_io_arw.F -module_state_description.o : module_state_description.F -output_wrf.o : output_wrf.F -shift_domain_em.o : shift_domain_em.F -solve_em.o : solve_em.F -solve_interface.o : solve_interface.F -start_domain.o : start_domain.F -start_domain_nmm.o : start_domain_nmm.F -start_em.o : start_em.F -wrf_auxhist10in.o : wrf_auxhist10in.F -wrf_auxhist10out.o : wrf_auxhist10out.F -wrf_auxhist11in.o : wrf_auxhist11in.F -wrf_auxhist11out.o : wrf_auxhist11out.F -wrf_auxhist1in.o : wrf_auxhist1in.F -wrf_auxhist1out.o : wrf_auxhist1out.F -wrf_auxhist2in.o : wrf_auxhist2in.F -wrf_auxhist2out.o : wrf_auxhist2out.F -wrf_auxhist3in.o : wrf_auxhist3in.F -wrf_auxhist3out.o : wrf_auxhist3out.F -wrf_auxhist4in.o : wrf_auxhist4in.F -wrf_auxhist4out.o : wrf_auxhist4out.F -wrf_auxhist5in.o : wrf_auxhist5in.F -wrf_auxhist5out.o : wrf_auxhist5out.F -wrf_auxhist6in.o : wrf_auxhist6in.F -wrf_auxhist6out.o : wrf_auxhist6out.F -wrf_auxhist7in.o : wrf_auxhist7in.F -wrf_auxhist7out.o : wrf_auxhist7out.F -wrf_auxhist8in.o : wrf_auxhist8in.F -wrf_auxhist8out.o : wrf_auxhist8out.F -wrf_auxhist9in.o : wrf_auxhist9in.F -wrf_auxhist9out.o : wrf_auxhist9out.F -wrf_auxinput10in.o : wrf_auxinput10in.F -wrf_auxinput10out.o : wrf_auxinput10out.F -wrf_auxinput11in.o : wrf_auxinput11in.F -wrf_auxinput11out.o : wrf_auxinput11out.F -wrf_auxinput1in.o : wrf_auxinput1in.F -wrf_auxinput1out.o : wrf_auxinput1out.F -wrf_auxinput2in.o : wrf_auxinput2in.F -wrf_auxinput2out.o : wrf_auxinput2out.F -wrf_auxinput3in.o : wrf_auxinput3in.F -wrf_auxinput3out.o : wrf_auxinput3out.F -wrf_auxinput4in.o : wrf_auxinput4in.F -wrf_auxinput4out.o : wrf_auxinput4out.F -wrf_auxinput5in.o : wrf_auxinput5in.F -wrf_auxinput5out.o : wrf_auxinput5out.F -wrf_auxinput6in.o : wrf_auxinput6in.F -wrf_auxinput6out.o : wrf_auxinput6out.F -wrf_auxinput7in.o : wrf_auxinput7in.F -wrf_auxinput7out.o : wrf_auxinput7out.F -wrf_auxinput8in.o : wrf_auxinput8in.F -wrf_auxinput8out.o : wrf_auxinput8out.F -wrf_auxinput9in.o : wrf_auxinput9in.F -wrf_auxinput9out.o : wrf_auxinput9out.F -wrf_bdyin.o : wrf_bdyin.F -wrf_bdyout.o : wrf_bdyout.F -wrf_ext_read_field.o : wrf_ext_read_field.F -wrf_ext_write_field.o : wrf_ext_write_field.F -wrf_fddaobs_in.o : wrf_fddaobs_in.F -wrf_histin.o : wrf_histin.F -wrf_histout.o : wrf_histout.F -wrf_inputin.o : wrf_inputin.F -wrf_inputout.o : wrf_inputout.F -wrf_restartin.o : wrf_restartin.F -wrf_restartout.o : wrf_restartout.F -wrf_tsin.o : wrf_tsin.F -nl_get_0_routines.o : nl_get_0_routines.F -nl_get_1_routines.o : nl_get_1_routines.F -nl_set_0_routines.o : nl_set_0_routines.F -nl_set_1_routines.o : nl_set_1_routines.F - -convert_nmm.o \ -init_modules_em.o \ -mediation_feedback_domain.o \ -mediation_force_domain.o \ -mediation_integrate.o \ -track_driver.o \ -mediation_interp_domain.o \ -module_dm.o \ -module_fddaobs_rtfdda.o \ -module_initialize.o \ -module_initialize_b_wave.o \ -module_initialize_hill2d_x.o \ -module_initialize_quarter_ss.o \ -module_initialize_real.o \ -module_initialize_squall2d_x.o \ -module_initialize_squall2d_y.o \ -module_initialize_scm_xy.o \ -module_integrate.o \ -module_io_mm5.o \ -module_io_wrf.o \ -module_si_io.o \ -module_wps_io_arw.o \ -module_tiles.o \ -output_wrf.o \ -shift_domain_em.o \ -solve_interface.o \ -start_domain.o \ -start_domain_nmm.o \ -start_em.o \ -wrf_fddaobs_in.o \ -wrf_tsin.o : - $(RM) $@ - $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.F > $*.bb - $(SED_FTN) $*.bb | $(CPP) $(TRADFLAG) > $*.f90 - $(RM) $*.b $*.bb - @ if echo $(ARCHFLAGS) | $(FGREP) 'DVAR4D'; then \ - echo COMPILING $*.F for 4DVAR ; \ - $(WRF_SRC_ROOT_DIR)/var/build/da_name_space.pl $*.f90 > $*.f90.tmp ; \ - mv $*.f90.tmp $*.f90 ; \ - fi - if $(FGREP) '!$$OMP' $*.f90 ; then \ - if [ -n "$(OMP)" ] ; then echo COMPILING $*.F WITH OMP ; fi ; \ - $(FC) -c $(PROMOTION) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(OMP) $(FCSUFFIX) $*.f90 ; \ - else \ - if [ -n "$(OMP)" ] ; then echo COMPILING $*.F WITHOUT OMP ; fi ; \ - $(FC) -c $(PROMOTION) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90 ; \ - fi - -solve_em.o : - $(RM) $@ - $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.F > $*.bb - $(SED_FTN) $*.bb | $(CPP) $(TRADFLAG) > $*.f90 - $(RM) $*.b $*.bb - $(FC) -c $(PROMOTION) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(OMP) $(SOLVE_EM_SPECIAL) $(FCSUFFIX) $*.f90 - -module_sf_ruclsm.o : module_sf_ruclsm.F - -module_sf_ruclsm.o : - $(RM) $@ - $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.F > $*.bb - $(SED_FTN) $*.bb | $(CPP) $(TRADFLAG) > $*.f90 - $(RM) $*.b $*.bb - if $(FGREP) '!$$OMP' $*.f90 ; then \ - if [ -n "$(OMP)" ] ; then echo COMPILING $*.F WITH OMP ; fi ; \ - $(FC) -c $(PROMOTION) $(FCREDUCEDOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(OMP) $(FCSUFFIX) $*.f90 ; \ - else \ - if [ -n "$(OMP)" ] ; then echo COMPILING $*.F WITHOUT OMP ; fi ; \ - $(FC) -c $(PROMOTION) $(FCREDUCEDOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90 ; \ - fi - -# compile without OMP -input_wrf.o \ -module_io.o \ -module_domain.o \ -module_domain_type.o \ -module_physics_init.o \ -wrf_auxhist10in.o \ -wrf_auxhist10out.o \ -wrf_auxhist11in.o \ -wrf_auxhist11out.o \ -wrf_auxhist1in.o \ -wrf_auxhist1out.o \ -wrf_auxhist2in.o \ -wrf_auxhist2out.o \ -wrf_auxhist3in.o \ -wrf_auxhist3out.o \ -wrf_auxhist4in.o \ -wrf_auxhist4out.o \ -wrf_auxhist5in.o \ -wrf_auxhist5out.o \ -wrf_auxhist6in.o \ -wrf_auxhist6out.o \ -wrf_auxhist7in.o \ -wrf_auxhist7out.o \ -wrf_auxhist8in.o \ -wrf_auxhist8out.o \ -wrf_auxhist9in.o \ -wrf_auxhist9out.o \ -wrf_auxinput10in.o \ -wrf_auxinput10out.o \ -wrf_auxinput11in.o \ -wrf_auxinput11out.o \ -wrf_auxinput1in.o \ -wrf_auxinput1out.o \ -wrf_auxinput2in.o \ -wrf_auxinput2out.o \ -wrf_auxinput3in.o \ -wrf_auxinput3out.o \ -wrf_auxinput4in.o \ -wrf_auxinput4out.o \ -wrf_auxinput5in.o \ -wrf_auxinput5out.o \ -wrf_auxinput6in.o \ -wrf_auxinput6out.o \ -wrf_auxinput7in.o \ -wrf_auxinput7out.o \ -wrf_auxinput8in.o \ -wrf_auxinput8out.o \ -wrf_auxinput9in.o \ -wrf_auxinput9out.o \ -wrf_bdyin.o \ -wrf_bdyout.o \ -wrf_ext_read_field.o \ -wrf_ext_write_field.o \ -wrf_histin.o \ -wrf_histout.o \ -wrf_inputin.o \ -wrf_inputout.o \ -wrf_restartin.o \ -wrf_restartout.o \ -module_state_description.o \ -module_alloc_space.o \ -module_alloc_space_0.o \ -module_alloc_space_1.o \ -module_alloc_space_2.o \ -module_alloc_space_3.o \ -module_alloc_space_4.o \ -module_alloc_space_5.o \ -module_alloc_space_6.o \ -module_alloc_space_7.o \ -module_alloc_space_8.o \ -module_alloc_space_9.o \ -module_comm_dm.o \ -module_comm_dm_0.o \ -module_comm_dm_1.o \ -module_comm_dm_2.o \ -module_comm_dm_3.o \ -module_comm_nesting_dm.o \ -module_configure.o : - $(RM) $@ - $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.F > $*.bb - $(SED_FTN) $*.bb | $(CPP) $(TRADFLAG) > $*.f90 - @ if echo $(ARCHFLAGS) | $(FGREP) 'DVAR4D'; then \ - echo COMPILING $*.F for 4DVAR ; \ - $(WRF_SRC_ROOT_DIR)/var/build/da_name_space.pl $*.f90 > $*.f90.tmp ; \ - mv $*.f90.tmp $*.f90 ; \ - fi - $(RM) $*.b $*.bb - $(FC) -c $(PROMOTION) $(FCSUFFIX) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 diff --git a/arch/noopt_exceptions_f b/arch/noopt_exceptions_f index ad8cd99e54..e69de29bb2 100644 --- a/arch/noopt_exceptions_f +++ b/arch/noopt_exceptions_f @@ -1,185 +0,0 @@ -# A little more adventurous. Allow full opt on -# mediation_integrate.o \ -# shift_domain_em.o \ -# solve_em.o <-- gets a little kick from SOLVE_EM_SPECIAL too, if defined -# mediation_feedback_domain.o : mediation_feedback_domain.F -# mediation_force_domain.o : mediation_force_domain.F -# mediation_interp_domain.o : mediation_interp_domain.F - -# compile these without high optimization to speed compile -mediation_integrate.o : mediation_integrate.F -track_driver.o : track_driver.F -convert_nmm.o : convert_nmm.F -init_modules_em.o : init_modules_em.F -input_wrf.o : input_wrf.F -module_io.o : module_io.F -module_comm_dm.o : module_comm_dm.F -module_comm_dm_0.o : module_comm_dm_0.F -module_comm_dm_1.o : module_comm_dm_1.F -module_comm_dm_2.o : module_comm_dm_2.F -module_comm_dm_3.o : module_comm_dm_3.F -module_comm_nesting_dm.o : module_comm_nesting_dm.F -module_configure.o : module_configure.F -module_dm.o : module_dm.F -module_domain.o : module_domain.F -module_domain_type.o : module_domain_type.F -module_alloc_space_0.o : module_alloc_space_0.F -module_alloc_space_1.o : module_alloc_space_1.F -module_alloc_space_2.o : module_alloc_space_2.F -module_alloc_space_3.o : module_alloc_space_3.F -module_alloc_space_4.o : module_alloc_space_4.F -module_alloc_space_5.o : module_alloc_space_5.F -module_alloc_space_6.o : module_alloc_space_6.F -module_alloc_space_7.o : module_alloc_space_7.F -module_alloc_space_8.o : module_alloc_space_8.F -module_alloc_space_9.o : module_alloc_space_9.F -module_tiles.o : module_tiles.F -module_fddaobs_rtfdda.o : module_fddaobs_rtfdda.F -module_initialize.o : module_initialize.F -module_physics_init.o : module_physics_init.F -module_initialize_b_wave.o : module_initialize_b_wave.F -module_initialize_hill2d_x.o : module_initialize_hill2d_x.F -module_initialize_quarter_ss.o : module_initialize_quarter_ss.F -module_initialize_real.o : module_initialize_real.F -module_initialize_real.o: module_initialize_real.F -module_initialize_squall2d_x.o : module_initialize_squall2d_x.F -module_initialize_squall2d_y.o : module_initialize_squall2d_y.F -module_initialize_scm_xy.o : module_initialize_scm_xy.F -module_integrate.o : module_integrate.F -module_io_mm5.o : module_io_mm5.F -module_io_wrf.o : module_io_wrf.F -module_si_io.o : module_si_io.F -module_wps_io_arw.o : module_wps_io_arw.F -module_state_description.o : module_state_description.F -output_wrf.o : output_wrf.F -solve_interface.o : solve_interface.F -start_domain.o : start_domain.F -start_em.o : start_em.F -wrf_bdyin.o : wrf_bdyin.F -wrf_bdyout.o : wrf_bdyout.F -wrf_ext_read_field.o : wrf_ext_read_field.F -wrf_ext_write_field.o : wrf_ext_write_field.F -wrf_fddaobs_in.o : wrf_fddaobs_in.F -wrf_histin.o : wrf_histin.F -wrf_histout.o : wrf_histout.F -wrf_inputin.o : wrf_inputin.F -wrf_inputout.o : wrf_inputout.F -wrf_restartin.o : wrf_restartin.F -wrf_restartout.o : wrf_restartout.F -wrf_tsin.o : wrf_tsin.F -nl_get_0_routines.o : nl_get_0_routines.F -nl_get_1_routines.o : nl_get_1_routines.F -nl_set_0_routines.o : nl_set_0_routines.F -nl_set_1_routines.o : nl_set_1_routines.F - -mediation_integrate.o \ -track_driver.o \ -convert_nmm.o \ -init_modules_em.o \ -module_dm.o \ -module_fddaobs_rtfdda.o \ -module_initialize.o \ -module_initialize_b_wave.o \ -module_initialize_hill2d_x.o \ -module_initialize_quarter_ss.o \ -module_initialize_real.o \ -module_initialize_squall2d_x.o \ -module_initialize_squall2d_y.o \ -module_initialize_scm_xy.o \ -module_integrate.o \ -module_io_mm5.o \ -module_io_wrf.o \ -module_si_io.o \ -module_wps_io_arw.o \ -module_tiles.o \ -output_wrf.o \ -solve_interface.o \ -start_domain.o \ -start_em.o \ -wrf_fddaobs_in.o \ -wrf_tsin.o : - $(RM) $@ - $(SED_FTN) $*.F > $*.b - $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b > $*.f90 - $(RM) $*.b - @ if echo $(ARCHFLAGS) | $(FGREP) 'DVAR4D'; then \ - echo COMPILING $*.F for 4DVAR ; \ - $(WRF_SRC_ROOT_DIR)/var/build/da_name_space.pl $*.f90 > $*.f90.tmp ; \ - mv $*.f90.tmp $*.f90 ; \ - fi - if $(FGREP) '!$$OMP' $*.f90 ; then \ - if [ -n "$(OMP)" ] ; then echo COMPILING $*.F WITH OMP ; fi ; \ - $(FC) -c $(PROMOTION) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $(OMP) $*.f90 ; \ - else \ - if [ -n "$(OMP)" ] ; then echo COMPILING $*.F WITHOUT OMP ; fi ; \ - $(FC) -c $(PROMOTION) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90 ; \ - fi - -#solve_em.o : -# $(RM) $@ -# $(SED_FTN) $*.F > $*.b -# $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b > $*.f90 -# $(RM) $*.b -# $(FC) -o $@ -c $(FCFLAGS) $(MODULE_DIRS) $(PROMOTION) $(FCSUFFIX) $(SOLVE_EM_SPECIAL) $(OMP) $*.f90 - -module_sf_ruclsm.o : module_sf_ruclsm.F - -module_sf_ruclsm.o : - $(RM) $@ - $(SED_FTN) $*.F > $*.b - $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.b > $*.f90 - $(RM) $*.b - if $(FGREP) '!$$OMP' $*.f90 ; then \ - echo COMPILING $*.F WITH OMP ; \ - if [ -n "$(OMP)" ] ; then echo COMPILING $*.F WITH OMP ; fi ; \ - $(FC) -c $(PROMOTION) $(FCREDUCEDOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $(OMP) $*.f90 ; \ - else \ - if [ -n "$(OMP)" ] ; then echo COMPILING $*.F WITHOUT OMP ; fi ; \ - $(FC) -c $(PROMOTION) $(FCREDUCEDOPT) $(FCBASEOPTS) $(MODULE_DIRS) $(FCSUFFIX) $*.f90 ; \ - fi - -# compile without OMP -input_wrf.o \ -module_domain.o \ -module_domain_type.o \ -module_physics_init.o \ -module_io.o \ -wrf_bdyin.o \ -wrf_bdyout.o \ -wrf_ext_read_field.o \ -wrf_ext_write_field.o \ -wrf_histin.o \ -wrf_histout.o \ -wrf_inputin.o \ -wrf_inputout.o \ -wrf_restartin.o \ -wrf_restartout.o \ -module_state_description.o \ -module_alloc_space.o \ -module_alloc_space_0.o \ -module_alloc_space_1.o \ -module_alloc_space_2.o \ -module_alloc_space_3.o \ -module_alloc_space_4.o \ -module_alloc_space_5.o \ -module_alloc_space_6.o \ -module_alloc_space_7.o \ -module_alloc_space_8.o \ -module_alloc_space_9.o \ -module_comm_dm.o \ -module_comm_dm_0.o \ -module_comm_dm_1.o \ -module_comm_dm_2.o \ -module_comm_dm_3.o \ -module_comm_nesting_dm.o \ -module_configure.o : - $(RM) $@ - $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.F > $*.bb - $(SED_FTN) $*.bb | $(CPP) $(TRADFLAG) > $*.f90 - @ if echo $(ARCHFLAGS) | $(FGREP) 'DVAR4D'; then \ - echo COMPILING $*.F for 4DVAR ; \ - $(WRF_SRC_ROOT_DIR)/var/build/da_name_space.pl $*.f90 > $*.f90.tmp ; \ - mv $*.f90.tmp $*.f90 ; \ - fi - $(RM) $*.b $*.bb - $(FC) -c $(PROMOTION) $(FCSUFFIX) $(FCNOOPT) $(FCBASEOPTS) $(MODULE_DIRS) $*.f90 diff --git a/arch/postamble_new b/arch/postamble_new index f1090a23e4..203d7d0238 100644 --- a/arch/postamble_new +++ b/arch/postamble_new @@ -23,6 +23,7 @@ ARCHFLAGS = $(COREDEFS) -DIWORDSIZE=$(IWORDSIZE) -DDWORDSIZE=$(DWORDSIZ -DGRIB1 \ -DINTIO \ -DKEEP_INT_AROUND \ + -DHYBRID_COORD=1 \ -DLIMIT_ARGS \ -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) \ -DMAX_DOMAINS_F=$(MAX_DOMAINS) \ @@ -176,15 +177,19 @@ wrfio_esmf : .F.i: $(RM) $@ - $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.F > $@ + sed -e "s/grid%mu/gridmu/g" -e "s/grid%Mu/gridMu/g" -e "s/^\!.*'.*//" -e "s/^ *\!.*'.*//" $*.F > $*.G + $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.G > $*.H + sed -e "s/gridmu/grid%mu/g" -e "s/gridMu/grid%Mu/g" $*.H > $*.i mv $*.i $(DEVTOP)/pick/$*.f90 cp $*.F $(DEVTOP)/pick .F.o: $(RM) $@ - $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.F > $*.bb + sed -e "s/grid%mu/gridmu/g" -e "s/grid%Mu/gridMu/g" -e "s/^\!.*'.*//" -e "s/^ *\!.*'.*//" $*.F > $*.G + $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $(OMPCPP) $*.G > $*.H + sed -e "s/gridmu/grid%mu/g" -e "s/gridMu/grid%Mu/g" $*.H > $*.bb $(SED_FTN) $*.bb | $(CPP) $(TRADFLAG) > $*.f90 - $(RM) $*.b $*.bb + $(RM) $*.G $*.H $*.bb @ if echo $(ARCHFLAGS) | $(FGREP) 'DVAR4D'; then \ echo COMPILING $*.F for 4DVAR ; \ $(WRF_SRC_ROOT_DIR)/var/build/da_name_space.pl $*.f90 > $*.f90.tmp ; \ @@ -195,9 +200,11 @@ wrfio_esmf : .F.f90: $(RM) $@ - $(SED_FTN) $*.F > $*.b - $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.b > $@ - $(RM) $*.b + sed -e "s/grid%mu/gridmu/g" -e "s/grid%Mu/gridMu/g" -e "s/^\!.*'.*//" -e "s/^ *\!.*'.*//" $*.F > $*.G + $(SED_FTN) $*.G > $*.H + $(CPP) -I$(WRF_SRC_ROOT_DIR)/inc $(CPPFLAGS) $*.H > $*.I + sed -e "s/gridmu/grid%mu/g" -e "s/gridMu/grid%Mu/g" $*.I > $@ + $(RM) $*.G $*.H $*.I .f90.o: $(RM) $@ diff --git a/dyn_em/couple_or_uncouple_em.F b/dyn_em/couple_or_uncouple_em.F index 4af40a07a7..48ea8ed653 100644 --- a/dyn_em/couple_or_uncouple_em.F +++ b/dyn_em/couple_or_uncouple_em.F @@ -1,3 +1,21 @@ +! sed -e "s/grid%mu/gridmu/g" -e "s/grid%Mu/gridMu/g" couple_or_uncouple_em.F | cpp -DHYBRID_COORD | sed -e "s/gridmu/grid%mu/g" -e "s/gridMu/grid%Mu/g" >> couple_or_uncouple_em.next +#if ( HYBRID_COORD==1 ) +# define gridmu_2(...) (grid%c1h(k)*XXPC2HXX(__VA_ARGS__)) +# define XXPC2HXX(...) grid%mu_2(__VA_ARGS__) + +# define gridmub(...) (grid%c1h(k)*XXPCBHXX(__VA_ARGS__)+grid%c2h(k)) +# define XXPCBHXX(...) grid%mub(__VA_ARGS__) + +# define gridMu_2(...) (grid%c1f(k)*XXPC2FXX(__VA_ARGS__)) +# define XXPC2FXX(...) grid%Mu_2(__VA_ARGS__) + +# define gridMub(...) (grid%c1f(k)*XXPCBFXX(__VA_ARGS__)+grid%c2f(k)) +# define XXPCBFXX(...) grid%Mub(__VA_ARGS__) +#endif + + + + !WRF:MEDIATION_LAYER:couple_uncouple_utility SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & @@ -51,7 +69,7 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & INTEGER :: num_3d_c, num_3d_m, num_3d_s REAL :: mu_factor - REAL, DIMENSION(grid%sm31:grid%em31,grid%sm33:grid%em33) :: mut_2, muut_2, muvt_2, muwt_2 + REAL, DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: mutf_2, muth_2, muut_2, muvt_2, muwt_2 ! De-reference dimension information stored in the grid data structure. IF ( .NOT. grid%active_this_task ) RETURN @@ -117,9 +135,19 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & ! write(6,*) ' coupling: setting mu arrays ' DO j = max(jds,jps),min(jde-1,jpe) + DO k = kps,kpe + DO i = max(ids,ips),min(ide-1,ipe) + mutf_2(i,k,j) = grid%Mub(i,j) + grid%Mu_2(i,j) + muwt_2(i,k,j) = (grid%Mub(i,j) + grid%Mu_2(i,j))/grid%msfty(i,j) ! w coupled with y + ENDDO + ENDDO + ENDDO + + DO j = max(jds,jps),min(jde-1,jpe) + DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - mut_2(i,j) = grid%mub(i,j) + grid%mu_2(i,j) - muwt_2(i,j) = (grid%mub(i,j) + grid%mu_2(i,j))/grid%msfty(i,j) ! w coupled with y + muth_2(i,k,j) = grid%mub(i,j) + grid%mu_2(i,j) + ENDDO ENDDO ENDDO @@ -128,9 +156,11 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & ! write(6,*) ' coupling: setting muv and muv arrays ' DO j = max(jds,jps),min(jde-1,jpe) + DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - muut_2(i,j) = 0.5*(grid%mub(i,j)+grid%mub(i-1,j) + grid%mu_2(i,j) + grid%mu_2(i-1,j))/grid%msfuy(i,j) ! u coupled with y - muvt_2(i,j) = 0.5*(grid%mub(i,j)+grid%mub(i,j-1) + grid%mu_2(i,j) + grid%mu_2(i,j-1))/grid%msfvx(i,j) ! v coupled with x + muut_2(i,k,j) = 0.5*(grid%mub(i,j)+grid%mub(i-1,j) + grid%mu_2(i,j) + grid%mu_2(i-1,j))/grid%msfuy(i,j) ! u coupled with y + muvt_2(i,k,j) = 0.5*(grid%mub(i,j)+grid%mub(i,j-1) + grid%mu_2(i,j) + grid%mu_2(i,j-1))/grid%msfvx(i,j) ! v coupled with x + ENDDO ENDDO ENDDO @@ -138,14 +168,18 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & IF ( jpe .eq. jde ) THEN j = jde + DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - muvt_2(i,j) = (grid%mub(i,j-1) + grid%mu_2(i,j-1))/grid%msfvx(i,j) ! v coupled with x + muvt_2(i,k,j) = (grid%mub(i,j-1) + grid%mu_2(i,j-1))/grid%msfvx(i,j) ! v coupled with x + ENDDO ENDDO ENDIF IF ( ipe .eq. ide .AND. .NOT. config_flags%periodic_x ) THEN i = ide DO j = max(jds,jps),min(jde-1,jpe) - muut_2(i,j) = (grid%mub(i-1,j) + grid%mu_2(i-1,j))/grid%msfuy(i,j) ! u coupled with y + DO k = kps,kpe-1 + muut_2(i,k,j) = (grid%mub(i-1,j) + grid%mu_2(i-1,j))/grid%msfuy(i,j) ! u coupled with y + ENDDO ENDDO ENDIF @@ -153,14 +187,18 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & IF ( jpe .eq. jde ) THEN j = jde + DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - muvt_2(i,j) = 0.5*(grid%mub(i,j)+grid%mub(i,j-1) + grid%mu_2(i,j) + grid%mu_2(i,j-1))/grid%msfvx(i,j) ! v coupled with x + muvt_2(i,k,j) = 0.5*(grid%mub(i,j)+grid%mub(i,j-1) + grid%mu_2(i,j) + grid%mu_2(i,j-1))/grid%msfvx(i,j) ! v coupled with x + ENDDO ENDDO ENDIF IF ( ipe .eq. ide ) THEN i = ide DO j = max(jds,jps),min(jde-1,jpe) - muut_2(i,j) = 0.5*(grid%mub(i,j)+grid%mub(i-1,j) + grid%mu_2(i,j) + grid%mu_2(i-1,j))/grid%msfuy(i,j) ! u coupled with y + DO k = kps,kpe-1 + muut_2(i,k,j) = 0.5*(grid%mub(i,j)+grid%mub(i-1,j) + grid%mu_2(i,j) + grid%mu_2(i-1,j))/grid%msfuy(i,j) ! u coupled with y + ENDDO ENDDO ENDIF @@ -171,23 +209,37 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & ! write(6,*) ' uncoupling: setting mu arrays ' DO j = max(jds,jps),min(jde-1,jpe) + DO k = kps,kpe + DO i = max(ids,ips),min(ide-1,ipe) + mutf_2(i,k,j) = 1./(grid%Mub(i,j) + grid%Mu_2(i,j)) + muwt_2(i,k,j) = grid%msfty(i,j)/(grid%Mub(i,j) + grid%Mu_2(i,j)) ! w coupled with y + ENDDO + ENDDO + ENDDO + + DO j = max(jds,jps),min(jde-1,jpe) + DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - mut_2(i,j) = 1./(grid%mub(i,j) + grid%mu_2(i,j)) - muwt_2(i,j) = grid%msfty(i,j)/(grid%mub(i,j) + grid%mu_2(i,j)) ! w coupled with y + muth_2(i,k,j) = 1./(grid%mub(i,j) + grid%mu_2(i,j)) + ENDDO ENDDO ENDDO ! write(6,*) ' uncoupling: setting muv arrays ' DO j = max(jds,jps),min(jde-1,jpe) + DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - muut_2(i,j) = 2.*grid%msfuy(i,j)/(grid%mub(i,j)+grid%mub(i-1,j) + grid%mu_2(i,j) + grid%mu_2(i-1,j)) ! u coupled with y + muut_2(i,k,j) = 2.*grid%msfuy(i,j)/(grid%mub(i,j)+grid%mub(i-1,j) + grid%mu_2(i,j) + grid%mu_2(i-1,j)) ! u coupled with y + ENDDO ENDDO ENDDO DO j = max(jds,jps),min(jde-1,jpe) + DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - muvt_2(i,j) = 2.*grid%msfvx(i,j)/(grid%mub(i,j)+grid%mub(i,j-1) + grid%mu_2(i,j) + grid%mu_2(i,j-1)) ! v coupled with x + muvt_2(i,k,j) = 2.*grid%msfvx(i,j)/(grid%mub(i,j)+grid%mub(i,j-1) + grid%mu_2(i,j) + grid%mu_2(i,j-1)) ! v coupled with x + ENDDO ENDDO ENDDO @@ -195,14 +247,18 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & IF ( jpe .eq. jde ) THEN j = jde + DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - muvt_2(i,j) = grid%msfvx(i,j)/(grid%mub(i,j-1) + grid%mu_2(i,j-1)) ! v coupled with x + muvt_2(i,k,j) = grid%msfvx(i,j)/(grid%mub(i,j-1) + grid%mu_2(i,j-1)) ! v coupled with x + ENDDO ENDDO ENDIF IF ( ipe .eq. ide .AND. .NOT. config_flags%periodic_x ) THEN i = ide DO j = max(jds,jps),min(jde-1,jpe) - muut_2(i,j) = grid%msfuy(i,j)/(grid%mub(i-1,j) + grid%mu_2(i-1,j)) ! u coupled with y + DO k = kps,kpe-1 + muut_2(i,k,j) = grid%msfuy(i,j)/(grid%mub(i-1,j) + grid%mu_2(i-1,j)) ! u coupled with y + ENDDO ENDDO ENDIF @@ -210,14 +266,18 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & IF ( jpe .eq. jde ) THEN j = jde + DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - muvt_2(i,j) = 2.*grid%msfvx(i,j)/(grid%mub(i,j)+grid%mub(i,j-1) + grid%mu_2(i,j) + grid%mu_2(i,j-1)) ! v coupled with x + muvt_2(i,k,j) = 2.*grid%msfvx(i,j)/(grid%mub(i,j)+grid%mub(i,j-1) + grid%mu_2(i,j) + grid%mu_2(i,j-1)) ! v coupled with x + ENDDO ENDDO ENDIF IF ( ipe .eq. ide ) THEN i = ide DO j = max(jds,jps),min(jde-1,jpe) - muut_2(i,j) = 2.*grid%msfuy(i,j)/(grid%mub(i,j)+grid%mub(i-1,j) + grid%mu_2(i,j) + grid%mu_2(i-1,j)) ! u coupled with y + DO k = kps,kpe-1 + muut_2(i,k,j) = 2.*grid%msfuy(i,j)/(grid%mub(i,j)+grid%mub(i-1,j) + grid%mu_2(i,j) + grid%mu_2(i-1,j)) ! u coupled with y + ENDDO ENDDO ENDIF @@ -233,14 +293,14 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & DO k = kps,kpe DO i = max(ids,ips),min(ide-1,ipe) - grid%ph_2(i,k,j) = grid%ph_2(i,k,j)*mut_2(i,j) - grid%w_2(i,k,j) = grid%w_2(i,k,j)*muwt_2(i,j) + grid%ph_2(i,k,j) = grid%ph_2(i,k,j)*mutf_2(i,k,j) + grid%w_2(i,k,j) = grid%w_2(i,k,j)*muwt_2(i,k,j) ENDDO ENDDO DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - grid%t_2(i,k,j) = grid%t_2(i,k,j)*mut_2(i,j) + grid%t_2(i,k,j) = grid%t_2(i,k,j)*muth_2(i,k,j) ENDDO ENDDO @@ -248,7 +308,7 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & DO im = PARAM_FIRST_SCALAR, num_3d_m DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - moist(i,k,j,im) = moist(i,k,j,im)*mut_2(i,j) + moist(i,k,j,im) = moist(i,k,j,im)*muth_2(i,k,j) ENDDO ENDDO ENDDO @@ -258,7 +318,7 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & DO im = PARAM_FIRST_SCALAR, num_3d_c DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - chem(i,k,j,im) = chem(i,k,j,im)*mut_2(i,j) + chem(i,k,j,im) = chem(i,k,j,im)*muth_2(i,k,j) ENDDO ENDDO ENDDO @@ -268,7 +328,7 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & DO im = PARAM_FIRST_SCALAR, num_3d_s DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - scalar(i,k,j,im) = scalar(i,k,j,im)*mut_2(i,j) + scalar(i,k,j,im) = scalar(i,k,j,im)*muth_2(i,k,j) ENDDO ENDDO ENDDO @@ -278,7 +338,7 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & DO im = PARAM_FIRST_SCALAR, num_tracer DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - tracer(i,k,j,im) = tracer(i,k,j,im)*mut_2(i,j) + tracer(i,k,j,im) = tracer(i,k,j,im)*muth_2(i,k,j) ENDDO ENDDO ENDDO @@ -288,7 +348,7 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & DO k = kps,kpe-1 DO i = max(ids,ips),min(ide,ipe) - grid%u_2(i,k,j) = grid%u_2(i,k,j)*muut_2(i,j) + grid%u_2(i,k,j) = grid%u_2(i,k,j)*muut_2(i,k,j) ENDDO ENDDO @@ -300,7 +360,7 @@ SUBROUTINE couple_or_uncouple_em ( grid , config_flags , couple & DO j = max(jds,jps),min(jde,jpe) DO k = kps,kpe-1 DO i = max(ids,ips),min(ide-1,ipe) - grid%v_2(i,k,j) = grid%v_2(i,k,j)*muvt_2(i,j) + grid%v_2(i,k,j) = grid%v_2(i,k,j)*muvt_2(i,k,j) ENDDO ENDDO ENDDO diff --git a/dyn_em/module_advect_em.F b/dyn_em/module_advect_em.F index 8272075020..304cedc5ef 100644 --- a/dyn_em/module_advect_em.F +++ b/dyn_em/module_advect_em.F @@ -1,3 +1,16 @@ +#if ( HYBRID_COORD==1 ) +# define mub(...) (c1(k)*XXPCBXX(__VA_ARGS__)+c2(k)) +# define XXPCBXX(...) mub(__VA_ARGS__) + +# define mut(...) (c1(k)*XXPCTXX(__VA_ARGS__)+c2(k)) +# define XXPCTXX(...) mut(__VA_ARGS__) + +# define mu_old(...) (c1(k)*XXPCOLDXX(__VA_ARGS__)) +# define XXPCOLDXX(...) mu_old(__VA_ARGS__) +#endif + + + !WRF:MODEL_LAYER:DYNAMICS ! #if ( defined(ADVECT_KERNEL) ) @@ -124,6 +137,7 @@ MODULE module_advect_em SUBROUTINE advect_u ( u, u_old, tendency, & ru, rv, rom, & + c1, c2, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -161,7 +175,9 @@ SUBROUTINE advect_u ( u, u_old, tendency, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & fzp, & - rdzw + rdzw, & + c1, & + c2 REAL , INTENT(IN ) :: rdx, & rdy @@ -1525,6 +1541,7 @@ END SUBROUTINE advect_u SUBROUTINE advect_v ( v, v_old, tendency, & ru, rv, rom, & + c1, c2, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -1562,7 +1579,9 @@ SUBROUTINE advect_v ( v, v_old, tendency, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & fzp, & - rdzw + rdzw, & + c1, & + c2 REAL , INTENT(IN ) :: rdx, & rdy @@ -3021,6 +3040,7 @@ END SUBROUTINE advect_v #endif SUBROUTINE advect_scalar ( field, field_old, tendency, & ru, rv, rom, & + c1, c2, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -3058,7 +3078,9 @@ SUBROUTINE advect_scalar ( field, field_old, tendency, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & fzp, & - rdzw + rdzw, & + c1, & + c2 REAL , INTENT(IN ) :: rdx, & rdy @@ -4353,6 +4375,7 @@ END SUBROUTINE advect_scalar SUBROUTINE advect_w ( w, w_old, tendency, & ru, rv, rom, & + c1, c2, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -4390,7 +4413,9 @@ SUBROUTINE advect_w ( w, w_old, tendency, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & fzp, & - rdzu + rdzu, & + c1, & + c2 REAL , INTENT(IN ) :: rdx, & rdy @@ -6056,6 +6081,7 @@ END SUBROUTINE advect_w SUBROUTINE advect_scalar_pd ( field, field_old, tendency, & h_tendency, z_tendency, & ru, rv, rom, & + c1, c2, & mut, mub, mu_old, & time_step, config_flags, & tenddec, & @@ -6109,7 +6135,9 @@ SUBROUTINE advect_scalar_pd ( field, field_old, tendency, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & fzp, & - rdzw + rdzw, & + c1, & + c2 REAL , INTENT(IN ) :: rdx, & rdy, & @@ -7837,6 +7865,7 @@ END SUBROUTINE advect_scalar_pd SUBROUTINE advect_scalar_wenopd ( field, field_old, tendency, & ru, rv, rom, & + c1, c2, & mut, mub, mu_old, & time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & @@ -7893,7 +7922,9 @@ SUBROUTINE advect_scalar_wenopd ( field, field_old, tendency, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & fzp, & - rdzw + rdzw, & + c1, & + c2 REAL , INTENT(IN ) :: rdx, & rdy, & @@ -8734,6 +8765,7 @@ END SUBROUTINE advect_scalar_wenopd SUBROUTINE advect_scalar_mono ( field, field_old, tendency, & h_tendency, z_tendency, & ru, rv, rom, & + c1, c2, & mut, mub, mu_old, & config_flags, & tenddec, & @@ -8785,7 +8817,9 @@ SUBROUTINE advect_scalar_mono ( field, field_old, tendency, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & fzp, & - rdzw + rdzw, & + c1, & + c2 REAL , INTENT(IN ) :: rdx, & rdy, & @@ -9946,6 +9980,7 @@ END PROGRAM feeder SUBROUTINE advect_scalar_weno ( field, field_old, tendency, & ru, rv, rom, & + c1, c2, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -9987,7 +10022,9 @@ SUBROUTINE advect_scalar_weno ( field, field_old, tendency, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & fzp, & - rdzw + rdzw, & + c1, & + c2 REAL , INTENT(IN ) :: rdx, & rdy @@ -10627,6 +10664,7 @@ END SUBROUTINE advect_scalar_weno SUBROUTINE advect_weno_u ( u, u_old, tendency, & ru, rv, rom, & + c1, c2, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -10670,7 +10708,9 @@ SUBROUTINE advect_weno_u ( u, u_old, tendency, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & fzp, & - rdzw + rdzw, & + c1, & + c2 REAL , INTENT(IN ) :: rdx, & rdy @@ -11271,6 +11311,7 @@ END SUBROUTINE advect_weno_u SUBROUTINE advect_weno_v ( v, v_old, tendency, & ru, rv, rom, & + c1, c2, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -11314,7 +11355,9 @@ SUBROUTINE advect_weno_v ( v, v_old, tendency, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & fzp, & - rdzw + rdzw, & + c1, & + c2 REAL , INTENT(IN ) :: rdx, & rdy @@ -11963,6 +12006,7 @@ END SUBROUTINE advect_weno_v SUBROUTINE advect_weno_w ( w, w_old, tendency, & ru, rv, rom, & + c1, c2, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -12006,7 +12050,9 @@ SUBROUTINE advect_weno_w ( w, w_old, tendency, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, & fzp, & - rdzu + rdzu, & + c1, & + c2 REAL , INTENT(IN ) :: rdx, & rdy diff --git a/dyn_em/module_bc_em.F b/dyn_em/module_bc_em.F index 1cbf74533b..e2f37a099a 100644 --- a/dyn_em/module_bc_em.F +++ b/dyn_em/module_bc_em.F @@ -1,19 +1,82 @@ +#if ( HYBRID_COORD==1 ) +# define mut(...) (c1(k)*XXPCTXX(__VA_ARGS__)+c2(k)) +# define XXPCTXX(...) mut(__VA_ARGS__) + +# define muts(...) (c1(k)*XXPCTSXX(__VA_ARGS__)+c2(k)) +# define XXPCTSXX(...) muts(__VA_ARGS__) + +# define mu_old(...) (c1(k)*XXPCOLDXX(__VA_ARGS__)+c2(k)) +# define XXPCOLDXX(...) mu_old(__VA_ARGS__) +#endif + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + !WRF:MODEL_LAYER:BOUNDARY ! MODULE module_bc_em - USE module_bc - USE module_configure + USE module_bc, ONLY: set_physical_bc2d, set_physical_bc3d, spec_bdytend, & + spec_bdytend_perturb, relax_bdytend_tile, relax_bdytend, & + spec_bdytend_perturb_chem + USE module_configure, ONLY: grid_config_rec_type USE module_wrf_error - USE module_model_constants + USE module_model_constants, ONLY: R_d, R_v, T0 CONTAINS !------------------------------------------------------------------------ - SUBROUTINE spec_bdyupdate_ph( ph_save, field, & - field_tend, mu_tend, muts, dt, & - variable_in, config_flags, & + SUBROUTINE spec_bdyupdate_ph( ph_save, field, & + field_tend, mu_tend, muts, & + c1, c2, dt, & + variable_in, config_flags, & spec_zone, & ids,ide, jds,jde, kds,kde, & ! domain dims ims,ime, jms,jme, kms,kme, & ! memory dims @@ -38,6 +101,7 @@ SUBROUTINE spec_bdyupdate_ph( ph_save, field, & REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: field_tend, ph_save REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: mu_tend, muts + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: c1, c2 TYPE( grid_config_rec_type ) config_flags CHARACTER :: variable @@ -81,7 +145,7 @@ SUBROUTINE spec_bdyupdate_ph( ph_save, field, & DO k = kts, ktf DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit) - mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j) + MU_OLD(i,j) = MUTS(i,j) - dt*MU_TEND(i,j) field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + & dt*field_tend(i,k,j)/muts(i,j) + & @@ -100,7 +164,7 @@ SUBROUTINE spec_bdyupdate_ph( ph_save, field, & DO k = kts, ktf DO i = max(its,b_limit+ibs), min(itf,ibe-b_limit) - mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j) + MU_OLD(i,j) = MUTS(i,j) - dt*MU_TEND(i,j) field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + & dt*field_tend(i,k,j)/muts(i,j) + & @@ -119,7 +183,7 @@ SUBROUTINE spec_bdyupdate_ph( ph_save, field, & DO k = kts, ktf DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1) - mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j) + MU_OLD(i,j) = MUTS(i,j) - dt*MU_TEND(i,j) field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + & dt*field_tend(i,k,j)/muts(i,j) + & @@ -137,7 +201,7 @@ SUBROUTINE spec_bdyupdate_ph( ph_save, field, & DO k = kts, ktf DO j = max(jts,b_dist+jbs+1), min(jtf,jbe-b_dist-1) - mu_old(i,j) = muts(i,j) - dt*mu_tend(i,j) + MU_OLD(i,j) = MUTS(i,j) - dt*MU_TEND(i,j) field(i,k,j) = field(i,k,j)*mu_old(i,j)/muts(i,j) + & dt*field_tend(i,k,j)/muts(i,j) + & @@ -155,7 +219,7 @@ END SUBROUTINE spec_bdyupdate_ph SUBROUTINE relax_bdy_dry ( config_flags, & ru_tendf, rv_tendf, ph_tendf, t_tendf, & - rw_tendf, mu_tend, & + rw_tendf, mu_tend, c1h, c2h, c1f, c2f, & ru, rv, ph, t, & w, mu, mut, & u_bxs,u_bxe,u_bys,u_bye, & @@ -200,6 +264,9 @@ SUBROUTINE relax_bdy_dry ( config_flags, & rw_tendf, & t_tendf REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: mu_tend + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h, c1f, c2f + REAL , DIMENSION( spec_bdy_width) , INTENT(IN ) :: fcx, gcx REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: u_bxs,u_bxe, & @@ -263,13 +330,18 @@ SUBROUTINE relax_bdy_dry ( config_flags, & j_start = max(jts-1, jds) j_end = min(jte+1, jde-1) - DO j=j_start,j_end - DO k=kts,kte - DO i=i_start,i_end - rfield(i,k,j) = ph(i,k,j)*mut(i,j) - ENDDO - ENDDO - ENDDO +! CALL mass_weight ( ph , mut , rfield , c1f, c2f, & +! ids,ide, jds,jde, kds,kde, & ! domain dims +! ims,ime, jms,jme, kms,kme, & ! memory dims +! i_start,i_end, j_start,j_end, kts,kte) ! tile dims +do j = j_start,j_end +do k = kts,kte +do i = i_start,i_end +rfield(i,k,j) = ph(i,k,j)*(c1f(k)*MUT(i,j)+c2f(k)) +end do +end do +end do + CALL relax_bdytend_tile ( rfield, ph_tendf, & ph_bxs,ph_bxe,ph_bys,ph_bye, ph_btxs,ph_btxe,ph_btys,ph_btye, & 'h' , config_flags, & @@ -280,13 +352,19 @@ SUBROUTINE relax_bdy_dry ( config_flags, & ips,ipe, jps,jpe, kps,kpe, & ! patch dims its,ite, jts,jte, kts,kte, & its-1, ite+1, jts-1,jte+1,kts,kte ) ! dims of first argument - DO j=j_start,j_end - DO k=kts,kte-1 - DO i=i_start,i_end - rfield(i,k,j) = t(i,k,j)*mut(i,j) - ENDDO - ENDDO - ENDDO + +! CALL mass_weight ( t, mut , rfield , c1h, c2h, & +! ids,ide, jds,jde, kds,kde, & ! domain dims +! ims,ime, jms,jme, kms,kme, & ! memory dims +! i_start,i_end, j_start,j_end, kts,kte-1) ! tile dims +do j = j_start,j_end +do k = kts,kte-1 +do i = i_start,i_end +rfield(i,k,j) = t(i,k,j)*(c1h(k)*MUT(i,j)+c2h(k)) +end do +end do +end do + CALL relax_bdytend_tile ( rfield, t_tendf, & t_bxs,t_bxe,t_bys,t_bye, t_btxs,t_btxe,t_btys,t_btye, & 't' , config_flags, & @@ -297,6 +375,7 @@ SUBROUTINE relax_bdy_dry ( config_flags, & ips,ipe, jps,jpe, kps,kpe, & ! patch dims its,ite, jts,jte, kts,kte, & its-1, ite+1, jts-1,jte+1,kts,kte ) ! dims of first argument + CALL relax_bdytend ( mu, mu_tend, & mu_bxs,mu_bxe,mu_bys,mu_bye, mu_btxs,mu_btxe,mu_btys,mu_btye, & 'm' , config_flags, & @@ -314,14 +393,11 @@ SUBROUTINE relax_bdy_dry ( config_flags, & j_start = max(jts-1, jds) j_end = min(jte+1, jde-1) - DO j=j_start,j_end - DO k=kts,kte - DO i=i_start,i_end - rfield(i,k,j) = w(i,k,j)*mut(i,j) - ENDDO - ENDDO - ENDDO - + CALL mass_weight ( w , mut , rfield , c1f, c2f, & + ids,ide, jds,jde, kds,kde, & ! domain dims + ims,ime, jms,jme, kms,kme, & ! memory dims + i_start,i_end, j_start,j_end, kts,kte) ! tile dims + CALL relax_bdytend_tile ( rfield, rw_tendf, & w_bxs,w_bxe,w_bys,w_bye, w_btxs,w_btxe,w_btys,w_btye, & 'h' , config_flags, & @@ -334,11 +410,10 @@ SUBROUTINE relax_bdy_dry ( config_flags, & its-1, ite+1, jts-1,jte+1,kts,kte ) ! dims of first argument END IF - END SUBROUTINE relax_bdy_dry !------------------------------------------------------------------------ SUBROUTINE relax_bdy_scalar ( scalar_tend, & - scalar, mu, & + scalar, mu, c1h, c2h, & scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, & scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, & spec_bdy_width, spec_zone, relax_zone, & @@ -368,6 +443,7 @@ SUBROUTINE relax_bdy_scalar ( scalar_tend, & scalar_btxs,scalar_btxe REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: scalar_bys,scalar_bye, & scalar_btys,scalar_btye + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h REAL, INTENT(IN ) :: dtbc !Local INTEGER :: i,j,k, i_start, i_end, j_start, j_end @@ -381,13 +457,10 @@ SUBROUTINE relax_bdy_scalar ( scalar_tend, & j_start = max(jts-1, jds) j_end = min(jte+1, jde-1) - DO j=j_start,j_end - DO k=kts,min(kte,kde-1) - DO i=i_start,i_end - rscalar(i,k,j) = scalar(i,k,j)*mu(i,j) - ENDDO - ENDDO - ENDDO + CALL mass_weight ( scalar , mu , rscalar, c1h, c2h, & + ids,ide, jds,jde, kds,kde, & ! domain dims + ims,ime, jms,jme, kms,kme, & ! memory dims + i_start,i_end, j_start,j_end, kts,kte-1) ! tile dims CALL relax_bdytend (rscalar, scalar_tend, & scalar_bxs,scalar_bxe,scalar_bys,scalar_bye, scalar_btxs,scalar_btxe,scalar_btys,scalar_btye, & @@ -532,7 +605,7 @@ END SUBROUTINE spec_bdy_dry !------------------------------------------------------------------------ SUBROUTINE spec_bdy_dry_perturb ( config_flags, & - ru_tend, rv_tend, t_tend,mu_2, mub, & + ru_tend, rv_tend, t_tend,mu_2, mub, c1, c2, & msfu, msfv, msft, & field_u_tend_perturb,field_v_tend_perturb,field_t_tend_perturb, & spec_bdy_width, spec_zone, & @@ -563,13 +636,15 @@ SUBROUTINE spec_bdy_dry_perturb ( config_flags, REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: msfu REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: msfv REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: msft + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: c1, c2 REAL, DIMENSION( ims:ime , kms:kme_stoch , jms:jme ), INTENT(IN ) :: field_u_tend_perturb, & field_v_tend_perturb, & field_t_tend_perturb CALL spec_bdytend_perturb ( ru_tend, & - field_u_tend_perturb, mu_2,mub, & + field_u_tend_perturb, & + mu_2,mub, c1, c2, & 'u', msfu, config_flags, & spec_bdy_width, spec_zone, & kme_stoch, & ! stoch dims @@ -578,7 +653,8 @@ SUBROUTINE spec_bdy_dry_perturb ( config_flags, ips,ipe, jps,jpe, kps,kpe, & ! patch dims its,ite, jts,jte, kts,kte ) CALL spec_bdytend_perturb ( rv_tend, & - field_v_tend_perturb,mu_2,mub, & + field_v_tend_perturb, & + mu_2,mub, c1, c2, & 'v', msfv, config_flags, & spec_bdy_width, spec_zone, & kme_stoch, & ! stoch dims @@ -588,7 +664,8 @@ SUBROUTINE spec_bdy_dry_perturb ( config_flags, its,ite, jts,jte, kts,kte ) CALL spec_bdytend_perturb ( t_tend, & - field_t_tend_perturb,mu_2,mub, & + field_t_tend_perturb, & + mu_2,mub, c1, c2, & 't', msft, config_flags, & spec_bdy_width, spec_zone, & kme_stoch, & ! stoch dims @@ -700,7 +777,7 @@ SUBROUTINE set_phys_bc_dry_1( config_flags, u_1, u_2, v_1, v_2, & its,ite, jts,jte, kts,kte ) ! -! this is just a wraper to call the boundary condition routines +! this is just a wrapper to call the boundary condition routines ! for each variable ! @@ -803,7 +880,7 @@ SUBROUTINE set_phys_bc_dry_2( config_flags, & its,ite, jts,jte, kts,kte ) ! -! this is just a wraper to call the boundary condition routines +! this is just a wrapper to call the boundary condition routines ! for each variable ! @@ -905,7 +982,7 @@ SUBROUTINE set_phys_bc_smallstep_1( config_flags, ru_1, du, rv_1, dv, & its,ite, jts,jte, kts,kte ) ! -! this is just a wraper to call the boundary condition routines +! this is just a wrapper to call the boundary condition routines ! for each variable ! @@ -954,7 +1031,7 @@ SUBROUTINE rk_phys_bc_dry_1( config_flags, u, v, rw, w, & its,ite, jts,jte, kts,kte ) ! -! this is just a wraper to call the boundary condition routines +! this is just a wrapper to call the boundary condition routines ! for each variable ! @@ -1039,7 +1116,7 @@ SUBROUTINE rk_phys_bc_dry_2( config_flags, u, v, w, & its,ite, jts,jte, kts,kte ) ! -! this is just a wraper to call the boundary condition routines +! this is just a wrapper to call the boundary condition routines ! for each variable ! @@ -1605,5 +1682,34 @@ SUBROUTINE theta_and_thetam_lbc_only ( & END SUBROUTINE theta_and_thetam_lbc_only !------------------------------------------------------------------------ + + SUBROUTINE mass_weight ( field , mut, rfield , c1 , c2 , & + ids,ide, jds,jde, kds,kde, & ! domain dims + ims,ime, jms,jme, kms,kme, & ! memory dims + its,ite, jts,jte, kts,kte ) ! tile dims + + 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 ) :: field + REAL , DIMENSION(ims:ime, jms:jme) , INTENT(IN ) :: mut + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1, c2 + REAL , DIMENSION(ims:ime, kms:kme, jms:jme) , INTENT( OUT) :: rfield + + ! Local loop counters + + INTEGER :: i , j , k + + DO j = jts , jte + DO k = kts , kte + DO i = its , ite + rfield(i,k,j) = field(i,k,j) * mut(i,j) + END DO + END DO + END DO + + END SUBROUTINE mass_weight END MODULE module_bc_em diff --git a/dyn_em/module_big_step_utilities_em.F b/dyn_em/module_big_step_utilities_em.F index ef87db4c5e..4307ad7769 100644 --- a/dyn_em/module_big_step_utilities_em.F +++ b/dyn_em/module_big_step_utilities_em.F @@ -1,3 +1,42 @@ +#if ( HYBRID_COORD==1 ) +# define mut(...) (c1f(k)*XXPCTXX(__VA_ARGS__)+c2f(k)) +# define XXPCTXX(...) mut(__VA_ARGS__) + +# define muu(...) (c1h(k)*XXPCUXX(__VA_ARGS__)+c2h(k)) +# define XXPCUXX(...) muu(__VA_ARGS__) + +# define muv(...) (c1h(k)*XXPCVXX(__VA_ARGS__)+c2h(k)) +# define XXPCVXX(...) muv(__VA_ARGS__) + +# define mu(...) (c1(k)*XXPCXX(__VA_ARGS__)) +# define XXPCXX(...) mu(__VA_ARGS__) + +# define mub(...) (c1(k)*XXPCBXX(__VA_ARGS__)+c2(k)) +# define XXPCBXX(...) mub(__VA_ARGS__) + +# define muts(...) (c1(k)*XXPCTSXX(__VA_ARGS__)+c2(k)) +# define XXPCTSXX(...) muts(__VA_ARGS__) + +# define muuf(...) (c1f(k)*XXPCUFXX(__VA_ARGS__)+c2f(k)) +# define XXPCUFXX(...) muuf(__VA_ARGS__) + +# define muvf(...) (c1f(k)*XXPCVFXX(__VA_ARGS__)+c2f(k)) +# define XXPCVFXX(...) muvf(__VA_ARGS__) + +# define muf(...) (c1f(k)*XXPCFXX(__VA_ARGS__)) +# define XXPCFXX(...) muf(__VA_ARGS__) + +# define mubf(...) (c1f(k)*XXPCBFXX(__VA_ARGS__)+c2f(k)) +# define XXPCBFXX(...) mubf(__VA_ARGS__) + +# define MUT(...) (c1(k)*XXPCTHXX(__VA_ARGS__)+c2(k)) +# define XXPCTHXX(...) MUT(__VA_ARGS__) +#endif + + + + + !wrf:MODEL_LAYER:DYNAMICS ! @@ -60,58 +99,58 @@ SUBROUTINE calc_mu_uv ( config_flags, & 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)) + 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)) + 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) +! 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)) + 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)) + 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) +! 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)) + 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)) + 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) +! 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)) + 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) +! 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)) + MUU(i,j) = 0.5*(MU(i-1,j)+MU(im,j)+MUB(i-1,j)+MUB(im,j)) ENDDO END IF @@ -121,58 +160,58 @@ SUBROUTINE calc_mu_uv ( config_flags, & 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)) + 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)) + 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) +! 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)) + 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)) + 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) +! 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)) + 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)) + 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) +! 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)) + 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) +! 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)) + MUV(i,j) = 0.5*(MU(i,j-1)+MU(i,jm)+MUB(i,j-1)+MUB(i,jm)) ENDDO END IF @@ -217,50 +256,50 @@ SUBROUTINE calc_mu_uv_1 ( config_flags, & 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)) + 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)) + 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)) + 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)) + 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)) + 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)) + 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)) + 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)) + MUU(i,j) = 0.5*(MU(i-1,j)+MU(im,j)) ENDDO END IF @@ -270,50 +309,50 @@ SUBROUTINE calc_mu_uv_1 ( config_flags, & 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)) + 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)) + 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)) + 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)) + 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)) + 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)) + 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)) + 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)) + MUV(i,j) = 0.5*(MU(i,j-1)+MU(i,jm)) ENDDO END IF @@ -328,6 +367,7 @@ END SUBROUTINE calc_mu_uv_1 SUBROUTINE couple_momentum ( muu, ru, u, msfu, & muv, rv, v, msfv, msfv_inv, & mut, rw, w, msft, & + c1h, c2h, c1f, c2f, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -346,6 +386,7 @@ SUBROUTINE couple_momentum ( muu, ru, u, msfu, & 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 + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h, c1f, c2f ! Local data @@ -378,7 +419,6 @@ SUBROUTINE couple_momentum ( muu, ru, u, msfu, & 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 @@ -431,42 +471,42 @@ SUBROUTINE calc_mu_staggered ( mu, mub, muu, muv, & 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)) + 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)) + 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) + 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)) + 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) + 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)) + 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) + 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) + MUU(i,j) = MU(i-1,j) +MUB(i-1,j) ENDDO END IF @@ -476,42 +516,42 @@ SUBROUTINE calc_mu_staggered ( mu, mub, muu, muv, & 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)) + 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)) + 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) + 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)) + 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) + 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)) + 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) + 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) + MUV(i,j) = MU(i,j-1) +MUB(i,j-1) ENDDO END IF @@ -520,7 +560,7 @@ END SUBROUTINE calc_mu_staggered !------------------------------------------------------------------------------- SUBROUTINE couple ( mu, mub, rfield, field, name, & - msf, & + msf, c1h, c2h, c1, c2, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -540,6 +580,8 @@ SUBROUTINE couple ( mu, mub, rfield, field, name, & REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu, mub, msf REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(IN ) :: field + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h, c1, c2 ! Local data @@ -633,7 +675,7 @@ END SUBROUTINE couple !------------------------------------------------------------------------------- -SUBROUTINE calc_ww_cp ( u, v, mup, mub, ww, & +SUBROUTINE calc_ww_cp ( u, v, mup, mub, c1h, c2h, ww, & rdx, rdy, msftx, msfty, & msfux, msfuy, msfvx, msfvx_inv, & msfvy, dnw, & @@ -657,6 +699,7 @@ SUBROUTINE calc_ww_cp ( u, v, mup, mub, ww, & msfvx, msfvy, & msfvx_inv REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dnw + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT ) :: ww REAL , INTENT(IN ) :: rdx, rdy @@ -693,15 +736,14 @@ SUBROUTINE calc_ww_cp ( u, v, mup, mub, ww, & 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) + 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) + 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 @@ -770,7 +812,7 @@ SUBROUTINE calc_ww_cp ( u, v, mup, mub, ww, & ! +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) + ww(i,k,j)=ww(i,k-1,j) - dnw(k-1)*c1h(k)*dmdt(i) - divv(i,k-1) ENDDO ENDDO @@ -949,8 +991,10 @@ END SUBROUTINE calc_alt !---------------------------------------------------------------------- SUBROUTINE calc_p_rho_phi ( moist, n_moist, hypsometric_opt, & - al, alb, mu, muts, ph, phb, p, pb, & - t, p0, t0, ptop, znu, znw, dnw, rdnw, & + al, alb, mu, muts, & + c1, c2, c3h, c4h, c3f, c4f, & + ph, phb, p, pb, & + t, p0, t0, ptop, znu, znw, dnw, rdnw, & rdn, non_hydrostatic, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -983,11 +1027,13 @@ SUBROUTINE calc_p_rho_phi ( moist, n_moist, hypsometric_opt, & REAL, DIMENSION( kms:kme ), INTENT(IN ) :: znu, znw, dnw, rdnw, rdn + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: c1, c2, c3h, c4h, c3f, c4f + REAL, INTENT(IN ) :: t0, p0, ptop ! Local stuff - INTEGER :: i, j, k, itf, jtf, ktf, ispe + INTEGER :: i, j, k, kk, itf, jtf, ktf, ispe REAL :: qvf, qtot, qf1, qf2 REAL, DIMENSION( its:ite) :: temp,cpovcv_v REAL :: pfu, phm, pfd @@ -1035,9 +1081,15 @@ SUBROUTINE calc_p_rho_phi ( moist, n_moist, hypsometric_opt, & DO j=jts,jtf DO k=kts,ktf DO i=its,itf +#if !( HYBRID_COORD==1 ) pfu = muts(i,j)*znw(k+1)+ptop pfd = muts(i,j)*znw(k) +ptop phm = muts(i,j)*znu(k) +ptop +#elif ( HYBRID_COORD==1 ) + pfu = c3f(k+1)*MUTS(i,j) + c4f(k+1) + ptop + pfd = c3f(k )*MUTS(i,j) + c4f(k ) + ptop + phm = c3h(k )*MUTS(i,j) + c4h(k ) + ptop +#endif al(i,k,j) = (ph(i,k+1,j)-ph(i,k,j)+phb(i,k+1,j)-phb(i,k,j))/phm/LOG(pfd/pfu)-alb(i,k,j) END DO END DO @@ -1163,11 +1215,12 @@ SUBROUTINE calc_p_rho_phi ( moist, n_moist, hypsometric_opt, & IF (hypsometric_opt == 1) THEN DO j=jts,jtf - DO k=2,ktf+1 ! integrate hydrostatic equation for geopotential + DO kk=2,ktf+1 ! integrate hydrostatic equation for geopotential + k = kk-1 DO i=its,itf - 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) ) + ph(i,k+1,j) = ph(i,k,j) - (dnw(k))*( & + (muts(i,j))*al(i,k,j)+ & + mu(i,j)*alb(i,k,j) ) ENDDO ENDDO ENDDO @@ -1182,9 +1235,15 @@ SUBROUTINE calc_p_rho_phi ( moist, n_moist, hypsometric_opt, & DO k=kts+1,ktf+1 DO i=its,itf +#if !( HYBRID_COORD==1 ) pfu = muts(i,j)*znw(k) +ptop pfd = muts(i,j)*znw(k-1)+ptop phm = muts(i,j)*znu(k-1)+ptop +#elif ( HYBRID_COORD==1 ) + pfu = c3f(k )*MUTS(i,j) + c4f(k ) + ptop + pfd = c3f(k-1)*MUTS(i,j) + c4f(k-1) + ptop + phm = c3h(k-1)*MUTS(i,j) + c4h(k-1) + ptop +#endif ph(i,k,j) = ph(i,k-1,j) + (al(i,k-1,j)+alb(i,k-1,j))*phm*LOG(pfd/pfu) ENDDO ENDDO @@ -1247,7 +1306,8 @@ END SUBROUTINE calc_php !------------------------------------------------------------------------------- -SUBROUTINE diagnose_w( ph_tend, ph_new, ph_old, w, mu, dt, & +SUBROUTINE diagnose_w( ph_tend, ph_new, ph_old, w, mut, & + c1f, c2f, dt, & u, v, ht, & cf1, cf2, cf3, rdx, rdy, & msftx, msfty, & @@ -1270,7 +1330,9 @@ SUBROUTINE diagnose_w( ph_tend, ph_new, ph_old, w, mu, dt, & REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT( OUT) :: w - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: mu, ht, msftx, msfty + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: mut, ht, msftx, msfty + + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: c1f, c2f REAL, INTENT(IN ) :: dt, cf1, cf2, cf3, rdx, rdy @@ -1328,7 +1390,7 @@ SUBROUTINE diagnose_w( ph_tend, ph_new, ph_old, w, mu, dt, & 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 + - ph_tend(i,k,j)/mut(i,j) )/g ENDDO ENDDO @@ -1341,7 +1403,8 @@ END SUBROUTINE diagnose_w SUBROUTINE rhs_ph( ph_tend, u, v, ww, & ph, ph_old, phb, w, & - mut, muu, muv, & + mut, muuf, muvf, & + c1f, c2f, & fnm, fnp, & rdnw, cfn, cfn1, rdx, rdy, & msfux, msfuy, msfvx, & @@ -1371,7 +1434,7 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT(INOUT) :: ph_tend - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: muu, muv, mut, & + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: muuf, muvf, mut, & msfux, msfuy, & msfvx, msfvy, & msftx, msfty, & @@ -1379,6 +1442,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & REAL, DIMENSION( kms:kme ), INTENT(IN ) :: rdnw, fnm, fnp + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: c1f, c2f + + REAL, INTENT(IN ) :: cfn, cfn1, rdx, rdy LOGICAL, INTENT(IN ) :: non_hydrostatic @@ -1486,9 +1552,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muvf(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 )* & + +muvf(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 @@ -1496,9 +1562,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muvf(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 )* & + +muvf(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 @@ -1519,9 +1585,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muuf(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)* & + +muuf(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 @@ -1529,9 +1595,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muuf(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)* & + +muuf(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 @@ -1554,8 +1620,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muvf(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1) & + +muvf(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)) & @@ -1568,8 +1634,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muvf(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) & + +muvf(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)) & @@ -1587,9 +1653,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muvf(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 )* & + +muvf(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 @@ -1597,9 +1663,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muvf(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 )* & + +muvf(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 @@ -1611,9 +1677,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muvf(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 )* & + +muvf(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 @@ -1621,9 +1687,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muvf(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 )* & + +muvf(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 @@ -1644,8 +1710,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muuf(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j) & + +muuf(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)) & @@ -1656,8 +1722,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muuf(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) & + +muuf(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)) & @@ -1675,9 +1741,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muuf(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)* & + +muuf(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 @@ -1685,9 +1751,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & k = kte DO j = j_start, jtf 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)* & + ( muuf(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)* & + +muuf(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 @@ -1699,9 +1765,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muuf(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)* & + +muuf(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 @@ -1709,9 +1775,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & k = kte DO j = j_start, jtf 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)* & + ( muuf(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)* & + +muuf(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 @@ -1739,8 +1805,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muvf(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1) & + +muvf(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)) & @@ -1755,8 +1821,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muvf(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) & + +muvf(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)) & @@ -1776,8 +1842,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muvf(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1) & + +muvf(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)) & @@ -1790,8 +1856,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muvf(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) & + +muvf(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)) & @@ -1806,8 +1872,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muvf(i,j+1)*(v(i,k,j+1)+v(i,k-1,j+1))*msfvy(i,j+1) & + +muvf(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)) & @@ -1820,8 +1886,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muvf(i,j+1)*(cfn*v(i,k-1,j+1)+cfn1*v(i,k-2,j+1))*msfvy(i,j+1) & + +muvf(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)) & @@ -1839,9 +1905,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muvf(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 )* & + +muvf(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 @@ -1849,9 +1915,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muvf(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 )* & + +muvf(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 @@ -1863,9 +1929,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muvf(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 )* & + +muvf(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 @@ -1873,9 +1939,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muvf(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 )* & + +muvf(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 @@ -1896,8 +1962,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muuf(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j) & + +muuf(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)) & @@ -1910,8 +1976,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muuf(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) & + +muuf(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)) & @@ -1929,8 +1995,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muuf(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j) & + +muuf(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)) & @@ -1938,8 +2004,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muuf(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) & + +muuf(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)) & @@ -1953,8 +2019,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muuf(i+1,j)*(u(i+1,k,j)+u(i+1,k-1,j))*msfux(i+1,j) & + +muuf(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)) & @@ -1962,8 +2028,8 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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.)*( & + ( muuf(i+1,j)*(cfn*u(i+1,k-1,j)+cfn1*u(i+1,k-2,j))*msfux(i+1,j) & + +muuf(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)) & @@ -1981,9 +2047,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muuf(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)* & + +muuf(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 @@ -1991,9 +2057,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & k = kte DO j = j_start, jtf 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)* & + ( muuf(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)* & + +muuf(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 @@ -2005,9 +2071,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & 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)* & + ( muuf(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)* & + +muuf(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 @@ -2015,9 +2081,9 @@ SUBROUTINE rhs_ph( ph_tend, u, v, ww, & k = kte DO j = j_start, jtf 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)* & + ( muuf(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)* & + +muuf(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 @@ -2136,7 +2202,7 @@ 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, & + muu,muv,mu,c1h,c2h,fnm,fnp,rdnw,& cf1,cf2,cf3,cfn,cfn1, & rdx,rdy,msfux,msfuy,& msfvx,msfvy,msftx,msfty, & @@ -2181,11 +2247,14 @@ SUBROUTINE horizontal_pressure_gradient( ru_tend,rv_tend, & REAL, DIMENSION( kms:kme ), INTENT(IN ) :: rdnw, fnm, fnp + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: c1h, c2h + REAL, INTENT(IN ) :: rdx, rdy, cf1, cf2, cf3, cfn, cfn1 INTEGER :: i,j,k, itf, jtf, ktf, i_start, j_start REAL, DIMENSION( ims:ime, kms:kme ) :: dpn REAL :: dpx, dpy + REAL, DIMENSION( kms:kme ) :: c1 LOGICAL :: specified @@ -2197,6 +2266,7 @@ SUBROUTINE horizontal_pressure_gradient( ru_tend,rv_tend, & ! ! + c1 = c1h specified = .false. if(config_flags%specified .or. config_flags%nested) specified = .true. @@ -2366,7 +2436,8 @@ END SUBROUTINE horizontal_pressure_gradient !------------------------------------------------------------------------------- -SUBROUTINE pg_buoy_w( rw_tend, p, cqw, mu, mub, & +SUBROUTINE pg_buoy_w( rw_tend, p, cqw, muf, mubf, & + c1f, c2f, & rdnw, rdn, g, msftx, msfty, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -2386,10 +2457,12 @@ SUBROUTINE pg_buoy_w( rw_tend, p, cqw, mu, mub, & 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( ims:ime, jms:jme ), INTENT(IN ) :: mubf, muf, msftx, msfty REAL, DIMENSION( kms:kme ), INTENT(IN ) :: rdnw, rdn + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: c1f, c2f + REAL, INTENT(IN ) :: g INTEGER :: itf, jtf, i, j, k @@ -2426,7 +2499,7 @@ SUBROUTINE pg_buoy_w( rw_tend, p, cqw, mu, mub, & 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) ) + -muf(i,j)-cq2*mubf(i,j) ) END DO DO k = 2, kde-1 @@ -2436,7 +2509,7 @@ SUBROUTINE pg_buoy_w( rw_tend, p, cqw, mu, mub, & 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) ) + -muf(i,j)-cq2*mubf(i,j) ) END DO ENDDO @@ -2448,13 +2521,13 @@ 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 ) + u, v, ww, w, mut, c1f, c2f, 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 @@ -2479,6 +2552,8 @@ SUBROUTINE w_damp( rw_tend, max_vert_cfl,max_horiz_cfl, & REAL, DIMENSION( kms:kme ), INTENT(IN ) :: rdnw + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: c1f, c2f + REAL, INTENT(IN) :: dt REAL, INTENT(IN) :: rdx, rdy REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, msfuy @@ -2660,7 +2735,7 @@ END SUBROUTINE w_damp !------------------------------------------------------------------------------- -SUBROUTINE horizontal_diffusion ( name, field, tendency, mu, & +SUBROUTINE horizontal_diffusion ( name, field, tendency, MUT, c1, c2, & config_flags, & msfux, msfuy, msfvx, msfvx_inv, & msfvy, msftx, msfty, & @@ -2685,7 +2760,7 @@ SUBROUTINE horizontal_diffusion ( name, field, tendency, mu, & 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 ) :: MUT REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & msfuy, & @@ -2695,6 +2770,8 @@ SUBROUTINE horizontal_diffusion ( name, field, tendency, mu, & msftx, & msfty + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1, c2 + REAL , INTENT(IN ) :: rdx, & rdy, & khdif @@ -2744,14 +2821,14 @@ SUBROUTINE horizontal_diffusion ( name, field, tendency, mu, & ! 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 + mkrdxm=(msftx(i-1,j)/msfty(i-1,j))*MUT(i-1,j)*xkmhd(i-1,k,j)*rdx + mkrdxp=(msftx(i,j)/msfty(i,j))*MUT(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*(MUT(i,j)+MUT(i,j-1)+MUT(i-1,j-1)+MUT(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*(MUT(i,j)+MUT(i,j+1)+MUT(i-1,j+1)+MUT(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 @@ -2791,10 +2868,10 @@ SUBROUTINE horizontal_diffusion ( name, field, tendency, mu, & 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*(MUT(i,j)+MUT(i,j-1)+MUT(i-1,j-1)+MUT(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*(MUT(i,j)+MUT(i,j-1)+MUT(i+1,j-1)+MUT(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 @@ -2829,19 +2906,19 @@ SUBROUTINE horizontal_diffusion ( name, field, tendency, mu, & 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*(MUT(i,j)+MUT(i-1,j)+MUT(i,j)+MUT(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*(MUT(i+1,j)+MUT(i,j)+MUT(i+1,j)+MUT(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*(MUT(i,j)+MUT(i,j-1)+MUT(i,j)+MUT(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*(MUT(i,j+1)+MUT(i,j)+MUT(i,j+1)+MUT(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 @@ -2873,13 +2950,13 @@ SUBROUTINE horizontal_diffusion ( name, field, tendency, mu, & 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 + mkrdxm=(msfux(i,j)/msfuy(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*0.5*(MUT(i,j)+MUT(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*(MUT(i+1,j)+MUT(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 +! mkrdym=(msfvy(i,j)/msfvx(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(MUT(i,j)+MUT(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*(MUT(i,j)+MUT(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*(MUT(i,j+1)+MUT(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*(MUT(i,j+1)+MUT(i,j))*rdy mrdy=msftx(i,j)*msfty(i,j)*rdy tendency(i,k,j)=tendency(i,k,j)+( & @@ -2897,7 +2974,7 @@ END SUBROUTINE horizontal_diffusion !----------------------------------------------------------------------------------------- -SUBROUTINE horizontal_diffusion_3dmp ( name, field, tendency, mu, & +SUBROUTINE horizontal_diffusion_3dmp ( name, field, tendency, MUT, c1, c2, & config_flags, base_3d, & msfux, msfuy, msfvx, msfvx_inv, & msfvy, msftx, msfty, & @@ -2924,7 +3001,7 @@ SUBROUTINE horizontal_diffusion_3dmp ( name, field, tendency, mu, & 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 ) :: MUT REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & msfuy, & @@ -2934,6 +3011,8 @@ SUBROUTINE horizontal_diffusion_3dmp ( name, field, tendency, mu, & msftx, & msfty + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1, c2 + REAL , INTENT(IN ) :: rdx, & rdy, & khdif @@ -2978,13 +3057,13 @@ SUBROUTINE horizontal_diffusion_3dmp ( name, field, tendency, mu, & 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 + mkrdxm=(msfux(i,j)/msfuy(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i-1,k,j))*0.5*(MUT(i,j)+MUT(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*(MUT(i+1,j)+MUT(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 +! mkrdym=(msfvy(i,j)/msfvx(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(MUT(i,j)+MUT(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*(MUT(i,j+1)+MUT(i,j))*rdy + mkrdym=(msfvy(i,j)*msfvx_inv(i,j))*0.5*(xkmhd(i,k,j)+xkmhd(i,k,j-1))*0.5*(MUT(i,j)+MUT(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*(MUT(i,j+1)+MUT(i,j))*rdy mrdy=msftx(i,j)*msfty(i,j)*rdy tendency(i,k,j)=tendency(i,k,j)+( & @@ -3006,8 +3085,8 @@ END SUBROUTINE horizontal_diffusion_3dmp !----------------------------------------------------------------------------------------- SUBROUTINE vertical_diffusion ( name, field, tendency, & - config_flags, & - alt, mut, rdn, rdnw, kvdif, & + config_flags, c1, c2, & + alt, MUT, rdn, rdnw, kvdif, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -3031,10 +3110,12 @@ SUBROUTINE vertical_diffusion ( name, field, tendency, & REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: MUT REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, rdnw + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1, c2 + REAL , INTENT(IN ) :: kvdif ! Local data @@ -3084,7 +3165,7 @@ SUBROUTINE vertical_diffusion ( name, field, tendency, & 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))) & + +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 @@ -3117,7 +3198,7 @@ SUBROUTINE vertical_diffusion ( name, field, tendency, & 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) & + 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 @@ -3132,8 +3213,8 @@ END SUBROUTINE vertical_diffusion !------------------------------------------------------------------------------- SUBROUTINE vertical_diffusion_mp ( field, tendency, config_flags, & - base, & - alt, mut, rdn, rdnw, kvdif, & + base, c1, c2, & + alt, MUT, rdn, rdnw, kvdif, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -3155,12 +3236,14 @@ SUBROUTINE vertical_diffusion_mp ( field, tendency, config_flags, & REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: MUT REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, & rdnw, & base + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1, c2 + REAL , INTENT(IN ) :: kvdif ! Local data @@ -3211,7 +3294,7 @@ SUBROUTINE vertical_diffusion_mp ( field, tendency, config_flags, & 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) & + 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 @@ -3224,8 +3307,8 @@ END SUBROUTINE vertical_diffusion_mp !------------------------------------------------------------------------------- SUBROUTINE vertical_diffusion_3dmp ( field, tendency, config_flags, & - base_3d, & - alt, mut, rdn, rdnw, kvdif, & + base_3d, c1, c2, & + alt, MUT, rdn, rdnw, kvdif, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -3248,11 +3331,13 @@ SUBROUTINE vertical_diffusion_3dmp ( field, tendency, config_flags, & REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: MUT REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, & rdnw + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1, c2 + REAL , INTENT(IN ) :: kvdif ! Local data @@ -3304,7 +3389,7 @@ SUBROUTINE vertical_diffusion_3dmp ( field, tendency, config_flags, & 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) & + 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 @@ -3318,7 +3403,7 @@ END SUBROUTINE vertical_diffusion_3dmp SUBROUTINE vertical_diffusion_u ( field, tendency, & - config_flags, u_base, & + config_flags, u_base, c1h,c2h,& alt, muu, rdn, rdnw, kvdif, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -3345,6 +3430,8 @@ SUBROUTINE vertical_diffusion_u ( field, tendency, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, rdnw, u_base + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h + REAL , INTENT(IN ) :: kvdif ! Local data @@ -3419,7 +3506,7 @@ END SUBROUTINE vertical_diffusion_u SUBROUTINE vertical_diffusion_v ( field, tendency, & - config_flags, v_base, & + config_flags, v_base, c1h,c2h,& alt, muv, rdn, rdnw, kvdif, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -3441,6 +3528,8 @@ SUBROUTINE vertical_diffusion_v ( field, tendency, & alt REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, rdnw, v_base + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h + REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: tendency REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: muv @@ -3780,7 +3869,7 @@ 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, & + muu, muv, c1h, c2h, phb, ph, & msftx, msfty, msfux, msfuy, msfvx, msfvy, & f, e, sina, cosa, fzm, fzp, & ids, ide, jds, jde, kds, kde, & @@ -3829,6 +3918,8 @@ SUBROUTINE perturbation_coriolis ( ru_in, rv_in, rw, ru_tend, rv_tend, rw_tend, REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: u_base, & v_base, & z_base + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h ! Local storage @@ -4392,6 +4483,8 @@ SUBROUTINE curvature ( ru, rv, rw, u, v, w, ru_tend, rv_tend, rw_tend, & END SUBROUTINE curvature +#if 0 +DANGER - this is a bad routine to have laying around - someone could use it !------------------------------------------------------------------------------ SUBROUTINE decouple ( rr, rfield, field, name, config_flags, & @@ -4488,6 +4581,7 @@ SUBROUTINE decouple ( rr, rfield, field, name, config_flags, & ENDIF END SUBROUTINE decouple +#endif !------------------------------------------------------------------------------- @@ -4649,7 +4743,9 @@ END SUBROUTINE pole_point_bc !====================================================================== SUBROUTINE phy_prep ( config_flags, & ! input - mu, muu, muv, u, v, p, pb, alt, ph, & ! input + mut, muu, muv, & + c1h, c2h, c1f, c2f, & + u, v, p, pb, alt, ph, & ! input phb, t, tsk, moist, n_moist, & ! input rho, th_phy, p_phy , pi_phy , & ! output u_phy, v_phy, p8w, t_phy, t8w, & ! output @@ -4688,7 +4784,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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, jms:jme ), INTENT(IN ) :: TSK, mut, muu, muv REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , & INTENT( OUT) :: u_phy, & @@ -4727,6 +4823,8 @@ SUBROUTINE phy_prep ( config_flags, & ! input REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: znw, & dnw + REAL, DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h, c1f, c2f + REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), & INTENT(INOUT) :: RTHRATEN @@ -4776,6 +4874,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input xland !jdf + REAL, DIMENSION( kms:kme ) :: c1, c2 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 @@ -4793,6 +4892,8 @@ SUBROUTINE phy_prep ( config_flags, & ! input ! ! + c1 = c1h + c2 = c2h ! set up loop bounds for this grid's boundary conditions i_start = its @@ -4921,7 +5022,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input do n = PARAM_FIRST_SCALAR,n_moist qtot = qtot + moist(i,k,j,n) enddo - p_hyd_w(i,k,j) = p_hyd_w(i,k+1,j) - (1.+qtot)*mu(i,j)*dnw(k) + p_hyd_w(i,k,j) = p_hyd_w(i,k+1,j) - (1.+qtot)*MUT(i,j)*dnw(k) ! p_hyd_w(i,k,j) = p_hyd_w(i,k+1,j)+1./alt(i,k,j)*(1.+moist(i,k,j,P_QV))*g*dz8w(i,k,j) enddo enddo @@ -4944,7 +5045,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RTHRATEN(I,K,J)=RTHRATEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -4956,9 +5057,9 @@ SUBROUTINE phy_prep ( config_flags, & ! input DO J=j_start,j_end DO I=i_start,i_end DO K=k_start,k_end - RUCUTEN(I,K,J) =RUCUTEN(I,K,J)/mu(I,J) - RVCUTEN(I,K,J) =RVCUTEN(I,K,J)/mu(I,J) - RTHCUTEN(I,K,J)=RTHCUTEN(I,K,J)/mu(I,J) + RUCUTEN(I,K,J) =RUCUTEN(I,K,J)/MUT(I,J) + RVCUTEN(I,K,J) =RVCUTEN(I,K,J)/MUT(I,J) + RTHCUTEN(I,K,J)=RTHCUTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -4967,7 +5068,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RQVCUTEN(I,K,J)=RQVCUTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -4977,7 +5078,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RQCCUTEN(I,K,J)=RQCCUTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -4987,7 +5088,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RQRCUTEN(I,K,J)=RQRCUTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -4997,7 +5098,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RQICUTEN(I,K,J)=RQICUTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5007,7 +5108,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RQSCUTEN(I,K,J)=RQSCUTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5020,9 +5121,9 @@ SUBROUTINE phy_prep ( config_flags, & ! input DO J=j_start,j_end DO I=i_start,i_end DO K=k_start,k_end - RUSHTEN(I,K,J) =RUSHTEN(I,K,J)/mu(I,J) - RVSHTEN(I,K,J) =RVSHTEN(I,K,J)/mu(I,J) - RTHSHTEN(I,K,J)=RTHSHTEN(I,K,J)/mu(I,J) + RUSHTEN(I,K,J) =RUSHTEN(I,K,J)/MUT(I,J) + RVSHTEN(I,K,J) =RVSHTEN(I,K,J)/MUT(I,J) + RTHSHTEN(I,K,J)=RTHSHTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5031,7 +5132,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input DO J=j_start,j_end DO I=i_start,i_end DO K=k_start,k_end - RQVSHTEN(I,K,J)=RQVSHTEN(I,K,J)/mu(I,J) + RQVSHTEN(I,K,J)=RQVSHTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5041,7 +5142,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input DO J=j_start,j_end DO I=i_start,i_end DO K=k_start,k_end - RQCSHTEN(I,K,J)=RQCSHTEN(I,K,J)/mu(I,J) + RQCSHTEN(I,K,J)=RQCSHTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5051,7 +5152,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input DO J=j_start,j_end DO I=i_start,i_end DO K=k_start,k_end - RQRSHTEN(I,K,J)=RQRSHTEN(I,K,J)/mu(I,J) + RQRSHTEN(I,K,J)=RQRSHTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5061,7 +5162,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input DO J=j_start,j_end DO I=i_start,i_end DO K=k_start,k_end - RQISHTEN(I,K,J)=RQISHTEN(I,K,J)/mu(I,J) + RQISHTEN(I,K,J)=RQISHTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5071,7 +5172,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input DO J=j_start,j_end DO I=i_start,i_end DO K=k_start,k_end - RQSSHTEN(I,K,J)=RQSSHTEN(I,K,J)/mu(I,J) + RQSSHTEN(I,K,J)=RQSSHTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5081,7 +5182,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input DO J=j_start,j_end DO I=i_start,i_end DO K=k_start,k_end - RQGSHTEN(I,K,J)=RQGSHTEN(I,K,J)/mu(I,J) + RQGSHTEN(I,K,J)=RQGSHTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5094,9 +5195,9 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RUBLTEN(I,K,J) =RUBLTEN(I,K,J)/MUT(I,J) + RVBLTEN(I,K,J) =RVBLTEN(I,K,J)/MUT(I,J) + RTHBLTEN(I,K,J)=RTHBLTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5105,7 +5206,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RQVBLTEN(I,K,J)=RQVBLTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5115,7 +5216,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RQCBLTEN(I,K,J)=RQCBLTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5125,7 +5226,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RQIBLTEN(I,K,J)=RQIBLTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5146,7 +5247,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RTHFTEN(I,K,J)=RTHFTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5155,7 +5256,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RQVFTEN(I,K,J)=RQVFTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5189,7 +5290,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RTHNDGDTEN(I,K,J)=RTHNDGDTEN(I,K,J)/MUT(I,J) ! RMUNDGDTEN(I,J) - no coupling ENDDO ENDDO @@ -5199,7 +5300,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input DO J=j_start,j_end DO K=k_start,kte DO I=i_start,i_end - RPHNDGDTEN(I,K,J)=RPHNDGDTEN(I,K,J)/mu(I,J) + RPHNDGDTEN(I,K,J)=RPHNDGDTEN(I,K,J)/mut(I,J) ENDDO ENDDO ENDDO @@ -5209,7 +5310,7 @@ SUBROUTINE phy_prep ( config_flags, & ! input 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) + RQVNDGDTEN(I,K,J)=RQVNDGDTEN(I,K,J)/MUT(I,J) ENDDO ENDDO ENDDO @@ -5606,6 +5707,7 @@ END SUBROUTINE set_tend SUBROUTINE rk_rayleigh_damp( ru_tendf, rv_tendf, & rw_tendf, t_tendf, & u, v, w, t, t_init, & + c1h, c2h, c1f, c2f, & mut, muu, muv, ph, phb, & u_base, v_base, t_base, z_base, & dampcoef, zdamp, & @@ -5662,6 +5764,9 @@ SUBROUTINE rk_rayleigh_damp( ru_tendf, rv_tendf, & REAL, DIMENSION( kms:kme ) , INTENT(IN ) & :: u_base, v_base, t_base, z_base + REAL, DIMENSION( kms:kme ) , INTENT(IN ) & + :: c1h, c2h, c1f, c2f + REAL, INTENT(IN ) & :: dampcoef, zdamp @@ -5670,6 +5775,9 @@ SUBROUTINE rk_rayleigh_damp( ru_tendf, rv_tendf, & INTEGER & :: i_start, i_end, j_start, j_end, k_start, k_end, i, j, k, ktf, k1, k2 + REAL, DIMENSION( kms:kme ) & + :: c1, c2 + REAL & :: pii, dcoef, z, ztop @@ -5680,6 +5788,9 @@ SUBROUTINE rk_rayleigh_damp( ru_tendf, rv_tendf, & ! End declarations. !----------------------------------------------------------------------- + c1 = c1h + c2 = c2h + pii = 2.0 * asin(1.0) ktf = MIN( kte, kde-1 ) @@ -5857,7 +5968,7 @@ SUBROUTINE rk_rayleigh_damp( ru_tendf, rv_tendf, & 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 ) * & + MUT(i,j) * ( dcoef * dampcoef ) * & ( t(i,k,j) - t00(k) ) END DO @@ -5873,7 +5984,7 @@ END SUBROUTINE rk_rayleigh_damp !============================================================================== SUBROUTINE theta_relaxation( t_tendf, t, t_init, & - mut, ph, phb, & + MUT, c1, c2, ph, phb, & t_base, z_base, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -5904,7 +6015,10 @@ SUBROUTINE theta_relaxation( t_tendf, t, t_init, & :: t, t_init, ph, phb REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: mut + :: MUT + + REAL, DIMENSION( kms:kme), INTENT( IN ) & + :: c1, c2 REAL, DIMENSION( kms:kme ) , INTENT(IN ) & :: t_base, z_base @@ -5964,7 +6078,7 @@ SUBROUTINE theta_relaxation( t_tendf, t, t_init, & ! limit rterm: rterm = min( rterm , rmax ) rterm = max( rterm , rmin ) - t_tendf(i,k,j) = t_tendf(i,k,j) + mut(i,j)*rterm + t_tendf(i,k,j) = t_tendf(i,k,j) + MUT(i,j)*rterm END DO END DO @@ -5975,8 +6089,8 @@ END SUBROUTINE theta_relaxation !============================================================================== !============================================================================== - SUBROUTINE sixth_order_diffusion( name, field, tendency, mu, dt, & - config_flags, & + SUBROUTINE sixth_order_diffusion( name, field, tendency, MUT, dt, & + config_flags, c1, c2, & diff_6th_opt, diff_6th_factor, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -6013,7 +6127,10 @@ SUBROUTINE sixth_order_diffusion( name, field, tendency, mu, dt, & :: field REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN) & - :: mu + :: MUT + + REAL, DIMENSION( kms:kme ), INTENT(IN) & + :: c1, c2 REAL, INTENT(IN) & :: dt @@ -6146,26 +6263,26 @@ SUBROUTINE sixth_order_diffusion( name, field, tendency, mu, dt, & ! 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) + mu_avg_p0 = MUT(i-1,j) + mu_avg_p1 = MUT(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 ) ) + MUT(i-1,j-1) + & + MUT(i ,j-1) + & + MUT(i-1,j ) + & + MUT(i ,j ) ) mu_avg_p1 = 0.25 * ( & - mu(i ,j-1) + & - mu(i+1,j-1) + & - mu(i ,j ) + & - mu(i+1,j ) ) + MUT(i ,j-1) + & + MUT(i+1,j-1) + & + MUT(i ,j ) + & + MUT(i+1,j ) ) ELSE mu_avg_p0 = 0.5 * ( & - mu(i-1,j) + & - mu(i ,j) ) + MUT(i-1,j) + & + MUT(i ,j) ) mu_avg_p1 = 0.5 * ( & - mu(i ,j) + & - mu(i+1,j) ) + MUT(i ,j) + & + MUT(i+1,j) ) END IF tendency_x = diff_6th_coef * & @@ -6206,25 +6323,25 @@ SUBROUTINE sixth_order_diffusion( name, field, tendency, mu, dt, & 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 ) ) + MUT(i-1,j-1) + & + MUT(i ,j-1) + & + MUT(i-1,j ) + & + MUT(i ,j ) ) mu_avg_p1 = 0.25 * ( & - mu(i-1,j ) + & - mu(i ,j ) + & - mu(i-1,j+1) + & - mu(i ,j+1) ) + MUT(i-1,j ) + & + MUT(i ,j ) + & + MUT(i-1,j+1) + & + MUT(i ,j+1) ) ELSE IF ( name .EQ. 'v' ) THEN - mu_avg_p0 = mu(i,j-1) - mu_avg_p1 = mu(i,j ) + mu_avg_p0 = MUT(i,j-1) + mu_avg_p1 = MUT(i,j ) ELSE mu_avg_p0 = 0.5 * ( & - mu(i,j-1) + & - mu(i,j ) ) + MUT(i,j-1) + & + MUT(i,j ) ) mu_avg_p1 = 0.5 * ( & - mu(i,j ) + & - mu(i,j+1) ) + MUT(i,j ) + & + MUT(i,j+1) ) END IF tendency_y = diff_6th_coef * & diff --git a/dyn_em/module_diffusion_em.F b/dyn_em/module_diffusion_em.F index 0f58472fd6..f323e71f25 100644 --- a/dyn_em/module_diffusion_em.F +++ b/dyn_em/module_diffusion_em.F @@ -1,3 +1,13 @@ +#if ( HYBRID_COORD==1 ) +# define mu(...) (c1(k)*XXPCTXX(__VA_ARGS__)+c2(k)) +# define XXPCTXX(...) mu(__VA_ARGS__) + +# define muavg(...) (c1(k)*XXPCAVGXX(__VA_ARGS__)+c2(k)) +# define XXPCAVGXX(...) muavg(__VA_ARGS__) +#endif + + + ! WRF:MODEL_LAYER:PHYSICS MODULE module_diffusion_em @@ -2279,7 +2289,8 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & chem_tendf, n_chem, & scalar_tendf, n_scalar, & tracer_tendf, n_tracer, & - thp, theta, mu, tke, config_flags, & + thp, theta, mu, c1, c2, & + tke, config_flags, & defor11, defor22, defor12, & defor13, defor23, & nba_mij, n_nba_mij, & !JDM @@ -2320,6 +2331,7 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & msftx, & msfty, & mu + REAL , DIMENSION( kms:kme) , INTENT(IN ) :: c1, c2 REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::rt_tendf,& ru_tendf,& @@ -2387,7 +2399,7 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & !----------------------------------------------------------------------- ! Call diffusion subroutines. - CALL horizontal_diffusion_u_2( ru_tendf, mu, config_flags, & + CALL horizontal_diffusion_u_2( ru_tendf, mu, c1, c2, config_flags, & defor11, defor12, div, & nba_mij, n_nba_mij, & !JDM tke(ims,kms,jms), & @@ -2397,7 +2409,7 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) - CALL horizontal_diffusion_v_2( rv_tendf, mu, config_flags, & + CALL horizontal_diffusion_v_2( rv_tendf, mu, c1, c2, config_flags, & defor12, defor22, div, & nba_mij, n_nba_mij, & !JDM tke(ims,kms,jms), & @@ -2407,7 +2419,7 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) - CALL horizontal_diffusion_w_2( rw_tendf, mu, config_flags, & + CALL horizontal_diffusion_w_2( rw_tendf, mu, c1, c2, config_flags, & defor13, defor23, div, & nba_mij, n_nba_mij, & !JDM tke(ims,kms,jms), & @@ -2417,7 +2429,7 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) - CALL horizontal_diffusion_s ( rt_tendf, mu, config_flags, thp, & + CALL horizontal_diffusion_s ( rt_tendf, mu, c1, c2, config_flags, thp,& msftx, msfty, msfux, msfuy, & msfvx, msfvy, xkhh, rdx, rdy, & fnm, fnp, cf1, cf2, cf3, & @@ -2429,7 +2441,7 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & IF (km_opt .eq. 2) & CALL horizontal_diffusion_s ( tke_tendf(ims,kms,jms), & - mu, config_flags, & + mu, c1, c2, config_flags, & tke(ims,kms,jms), & msftx, msfty, msfux, msfuy, & msfvx, msfvy, xkhh, rdx, rdy, & @@ -2445,7 +2457,7 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & moist_loop: do im = PARAM_FIRST_SCALAR, n_moist CALL horizontal_diffusion_s( moist_tendf(ims,kms,jms,im), & - mu, config_flags, & + mu, c1, c2, config_flags, & moist(ims,kms,jms,im), & msftx, msfty, msfux, msfuy, & msfvx, msfvy, xkhh, rdx, rdy, & @@ -2465,7 +2477,7 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & chem_loop: do ic = PARAM_FIRST_SCALAR, n_chem CALL horizontal_diffusion_s( chem_tendf(ims,kms,jms,ic), & - mu, config_flags, & + mu, c1, c2, config_flags, & chem(ims,kms,jms,ic), & msftx, msfty, msfux, msfuy, & msfvx, msfvy, xkhh, rdx, rdy, & @@ -2485,7 +2497,7 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & tracer_loop: do ic = PARAM_FIRST_SCALAR, n_tracer CALL horizontal_diffusion_s( tracer_tendf(ims,kms,jms,ic), & - mu, config_flags, & + mu, c1, c2, config_flags, & tracer(ims,kms,jms,ic), & msftx, msfty, msfux, msfuy, & msfvx, msfvy, xkhh, rdx, rdy, & @@ -2504,7 +2516,7 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & scalar_loop: do is = PARAM_FIRST_SCALAR, n_scalar CALL horizontal_diffusion_s( scalar_tendf(ims,kms,jms,is), & - mu, config_flags, & + mu, c1, c2, config_flags, & scalar(ims,kms,jms,is), & msftx, msfty, msfux, msfuy, & msfvx, msfvy, xkhh, rdx, rdy, & @@ -2524,7 +2536,7 @@ END SUBROUTINE horizontal_diffusion_2 !======================================================================= !======================================================================= -SUBROUTINE horizontal_diffusion_u_2( tendency, mu, config_flags, & +SUBROUTINE horizontal_diffusion_u_2( tendency, mu, c1, c2, config_flags, & defor11, defor12, div, & nba_mij, n_nba_mij, & !JDM tke, & @@ -2552,6 +2564,7 @@ SUBROUTINE horizontal_diffusion_u_2( tendency, mu, config_flags, & REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msfux, & msfuy, & mu + REAL , DIMENSION( kms:kme) , INTENT(IN ) :: c1, c2 REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency @@ -2640,7 +2653,7 @@ SUBROUTINE horizontal_diffusion_u_2( tendency, mu, config_flags, & js_ext=0 je_ext=0 CALL cal_titau_11_22_33( config_flags, titau1, & - mu, tke, xkmh, defor11, & + mu, c1, c2, tke, xkmh, defor11, & nba_mij(ims,kms,jms,P_m11), & !JDM is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & @@ -2653,7 +2666,7 @@ SUBROUTINE horizontal_diffusion_u_2( tendency, mu, config_flags, & js_ext=0 je_ext=1 CALL cal_titau_12_21( config_flags, titau2, & - mu, xkmh, defor12, & + mu, c1, c2, xkmh, defor12, & nba_mij(ims,kms,jms,P_m12), & !JDM is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & @@ -2713,7 +2726,7 @@ END SUBROUTINE horizontal_diffusion_u_2 !======================================================================= !======================================================================= -SUBROUTINE horizontal_diffusion_v_2( tendency, mu, config_flags, & +SUBROUTINE horizontal_diffusion_v_2( tendency, mu, c1, c2, config_flags, & defor12, defor22, div, & nba_mij, n_nba_mij, & !JDM tke, & @@ -2761,6 +2774,9 @@ SUBROUTINE horizontal_diffusion_v_2( tendency, mu, config_flags, & REAL , INTENT(IN ) :: rdx, & rdy + REAL , DIMENSION( kms:kme ), INTENT(IN ) :: c1, & + c2 + ! Local data INTEGER :: i, j, k, ktf @@ -2827,7 +2843,7 @@ SUBROUTINE horizontal_diffusion_v_2( tendency, mu, config_flags, & js_ext=0 je_ext=0 CALL cal_titau_12_21( config_flags, titau1, & - mu, xkmh, defor12, & + mu, c1, c2, xkmh, defor12, & nba_mij(ims,kms,jms,P_m12), & !JDM is_ext,ie_ext,js_ext,je_ext, & ids, ide, jds, jde, kds, kde, & @@ -2840,7 +2856,7 @@ SUBROUTINE horizontal_diffusion_v_2( tendency, mu, config_flags, & js_ext=1 je_ext=0 CALL cal_titau_11_22_33( config_flags, titau2, & - mu, tke, xkmh, defor22, & + mu, c1, c2, tke, xkmh, defor22, & nba_mij(ims,kms,jms,P_m22), & !JDM is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & @@ -2899,7 +2915,7 @@ END SUBROUTINE horizontal_diffusion_v_2 !======================================================================= !======================================================================= -SUBROUTINE horizontal_diffusion_w_2( tendency, mu, config_flags, & +SUBROUTINE horizontal_diffusion_w_2( tendency, mu, c1, c2, config_flags, & defor13, defor23, div, & nba_mij, n_nba_mij, & !JDM tke, & @@ -2947,6 +2963,9 @@ SUBROUTINE horizontal_diffusion_w_2( tendency, mu, config_flags, & REAL , INTENT(IN ) :: rdx, & rdy + REAL , DIMENSION( kms:kme ), INTENT(IN ) :: c1, & + c2 + ! Local data INTEGER :: i, j, k, ktf @@ -3013,7 +3032,7 @@ SUBROUTINE horizontal_diffusion_w_2( tendency, mu, config_flags, & je_ext=0 CALL cal_titau_13_31( config_flags, titau1, defor13, & nba_mij(ims,kms,jms,P_m13), & !JDM - mu, xkmh, fnm, fnp, & + mu, c1, c2, xkmh, fnm, fnp, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -3026,7 +3045,7 @@ SUBROUTINE horizontal_diffusion_w_2( tendency, mu, config_flags, & je_ext=1 CALL cal_titau_23_32( config_flags, titau2, defor23, & nba_mij(ims,kms,jms,P_m23), & !JDM - mu, xkmh, fnm, fnp, & + mu, c1, c2, xkmh, fnm, fnp, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -3090,7 +3109,7 @@ END SUBROUTINE horizontal_diffusion_w_2 !======================================================================= !======================================================================= -SUBROUTINE horizontal_diffusion_s (tendency, mu, config_flags, var, & +SUBROUTINE horizontal_diffusion_s (tendency, mu, c1,c2, config_flags, var,& msftx, msfty, msfux, msfuy, & msfvx, msfvy, xkhh, rdx, rdy, & fnm, fnp, cf1, cf2, cf3, & @@ -3146,6 +3165,9 @@ SUBROUTINE horizontal_diffusion_s (tendency, mu, config_flags, var, & REAL , INTENT(IN ) :: rdx, & rdy + REAL , DIMENSION( kms:kme ), INTENT(IN ) :: c1, & + c2 + ! Local data INTEGER :: i, j, k, ktf @@ -3366,6 +3388,7 @@ SUBROUTINE horizontal_diffusion_s (tendency, mu, config_flags, var, & mrdx=msftx(i,j)*rdx mrdy=msfty(i,j)*rdy +! Jimy says that "mu" can stay outside, so no need to push full level mu so that it is coupled with H1avg 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))+ & @@ -3402,7 +3425,8 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & scalar_tendf, n_scalar, & tracer_tendf, n_tracer, & u_2, v_2, & - thp,u_base,v_base,t_base,qv_base,mu,tke, & + thp,u_base,v_base,t_base,qv_base, & + mu,c1,c2,tke, & config_flags,defor13,defor23,defor33, & nba_mij, n_nba_mij, & !JDM div, & @@ -3432,6 +3456,7 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & 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 ) :: c1, c2 REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: qv_base REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: u_base @@ -3523,6 +3548,7 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & !----------------------------------------------------------------------- CALL vertical_diffusion_u_2( ru_tendf, config_flags, mu, & + c1, c2, & defor13, xkmv, & nba_mij, n_nba_mij, & !JDM dnw, rdzw, fnm, fnp, & @@ -3532,6 +3558,7 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & CALL vertical_diffusion_v_2( rv_tendf, config_flags, mu, & + c1, c2, & defor23, xkmv, & nba_mij, n_nba_mij, & !JDM dnw, rdzw, fnm, fnp, & @@ -3540,6 +3567,7 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & its, ite, jts, jte, kts, kte ) CALL vertical_diffusion_w_2( rw_tendf, config_flags, mu, & + c1, c2, & defor33, tke(ims,kms,jms), & nba_mij, n_nba_mij, & !JDM div, xkmh, & !Mod from RR Oct2013 was xkmv @@ -3552,6 +3580,7 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & !***************************************** ! MODIFICA al flusso di momento alla parete ! + 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 @@ -3664,7 +3693,8 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & END IF - CALL vertical_diffusion_s( rt_tendf, config_flags, var_mix, mu, xkhv, & + CALL vertical_diffusion_s( rt_tendf, config_flags, var_mix, mu, & + c1, c2, xkhv, & dn, dnw, rdz, rdzw, fnm, fnp, & .false., & ids, ide, jds, jde, kds, kde, & @@ -3677,6 +3707,7 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & !MODIFICA al flusso di calore ! ! + k=kts 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 @@ -3714,7 +3745,7 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & If (km_opt .eq. 2) then CALL vertical_diffusion_s( tke_tendf(ims,kms,jms), & config_flags, tke(ims,kms,jms), & - mu, xkhv, & + mu, c1, c2, xkhv, & dn, dnw, rdz, rdzw, fnm, fnp, & .true., & ids, ide, jds, jde, kds, kde, & @@ -3751,7 +3782,7 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & CALL vertical_diffusion_s( moist_tendf(ims,kms,jms,im), & config_flags, var_mix, & - mu, xkhv, & + mu, c1, c2, xkhv, & dn, dnw, rdz, rdzw, fnm, fnp, & .false., & ids, ide, jds, jde, kds, kde, & @@ -3763,6 +3794,7 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & !MODIFICATIONS for water vapor flux ! ! + k=kts qflux: SELECT CASE( config_flags%isfflx ) CASE (0) ! do nothing @@ -3794,7 +3826,7 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & CALL vertical_diffusion_s( chem_tendf(ims,kms,jms,im), & config_flags, chem(ims,kms,jms,im), & - mu, xkhv, & + mu, c1, c2, xkhv, & dn, dnw, rdz, rdzw, fnm, fnp, & .false., & ids, ide, jds, jde, kds, kde, & @@ -3810,7 +3842,7 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & CALL vertical_diffusion_s( tracer_tendf(ims,kms,jms,im), & config_flags, tracer(ims,kms,jms,im), & - mu, xkhv, & + mu, c1, c2, xkhv, & dn, dnw, rdz, rdzw, fnm, fnp, & .false., & ids, ide, jds, jde, kds, kde, & @@ -3827,7 +3859,7 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & CALL vertical_diffusion_s( scalar_tendf(ims,kms,jms,im), & config_flags, scalar(ims,kms,jms,im), & - mu, xkhv, & + mu, c1, c2, xkhv, & dn, dnw, rdz, rdzw, fnm, fnp, & .false., & ids, ide, jds, jde, kds, kde, & @@ -3842,7 +3874,7 @@ END SUBROUTINE vertical_diffusion_2 !======================================================================= !======================================================================= -SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu, & +SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu, c1, c2, & defor13, xkmv, & nba_mij, n_nba_mij, & !JDM dnw, rdzw, fnm, fnp, & @@ -3879,6 +3911,7 @@ SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu, & :: nba_mij REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu + REAL , DIMENSION( kms:kme) , INTENT(IN ) :: c1, c2 ! LOCAL VARS @@ -3921,7 +3954,7 @@ SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu, & je_ext=0 CALL cal_titau_13_31( config_flags, titau3, defor13, & nba_mij(ims,kms,jms,P_m13), & !JDM - mu, xkmv, fnm, fnp, & + mu, c1, c2, xkmv, fnm, fnp, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -3956,7 +3989,7 @@ END SUBROUTINE vertical_diffusion_u_2 !======================================================================= !======================================================================= -SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu, & +SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu, c1, c2, & defor23, xkmv, & nba_mij, n_nba_mij, & !JDM dnw, rdzw, fnm, fnp, & @@ -3991,6 +4024,7 @@ SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu, & :: nba_mij REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu + REAL , DIMENSION( kms:kme) , INTENT(IN ) :: c1, c2 ! LOCAL VARS @@ -4033,7 +4067,7 @@ SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu, & je_ext=0 CALL cal_titau_23_32( config_flags, titau3, defor23, & nba_mij(ims,kms,jms,P_m23), & !JDM - mu, xkmv, fnm, fnp, & + mu, c1, c2, xkmv, fnm, fnp, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -4069,7 +4103,7 @@ END SUBROUTINE vertical_diffusion_v_2 !======================================================================= !======================================================================= -SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu, & +SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu, c1, c2, & defor33, tke, & nba_mij, n_nba_mij, & !JDM div, xkmh, & @@ -4106,6 +4140,7 @@ SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu, & :: nba_mij REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: mu + REAL , DIMENSION( kms:kme) , INTENT(IN ) :: c1, c2 ! LOCAL VARS @@ -4143,7 +4178,7 @@ SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu, & js_ext=0 je_ext=0 CALL cal_titau_11_22_33( config_flags, titau3, & - mu, tke, xkmh, defor33, & ! from RR 20131023 was xkmv + mu, c1, c2, tke, xkmh, defor33, & ! from RR 20131023 was xkmv nba_mij(ims,kms,jms,P_m33), & !JDM is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & @@ -4171,7 +4206,8 @@ END SUBROUTINE vertical_diffusion_w_2 !======================================================================= !======================================================================= -SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, mu, xkhv, & +SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, mu, & + c1, c2, xkhv, & dn, dnw, rdz, rdzw, fnm, fnp, & doing_tke, & ids, ide, jds, jde, kds, kde, & @@ -4201,6 +4237,7 @@ SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, mu, xkhv, & REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN) :: xkhv REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: mu + REAL , DIMENSION( kms:kme) , INTENT(IN) :: c1, c2 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & INTENT(IN ) :: var, & @@ -4299,7 +4336,7 @@ END SUBROUTINE vertical_diffusion_s !======================================================================= SUBROUTINE cal_titau_11_22_33( config_flags, titau, & - mu, tke, xkx, defor, & + mu, c1, c2, tke, xkx, defor, & mtau, & !JDM is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & @@ -4346,6 +4383,8 @@ SUBROUTINE cal_titau_11_22_33( config_flags, titau, & REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & :: mu + REAL, DIMENSION( kms:kme) , INTENT( IN ) & + :: c1, c2 ! Local variables. @@ -4427,7 +4466,7 @@ END SUBROUTINE cal_titau_11_22_33 !======================================================================= SUBROUTINE cal_titau_12_21( config_flags, titau, & - mu, xkx, defor, & + mu, c1, c2, xkx, defor, & mtau, & !JDM is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & @@ -4474,6 +4513,8 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, & REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & :: mu + REAL, DIMENSION( kms:kme) , INTENT( IN ) & + :: c1, c2 ! Local variables. @@ -4525,8 +4566,8 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, & 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) ) + 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 @@ -4582,7 +4623,7 @@ END SUBROUTINE cal_titau_12_21 SUBROUTINE cal_titau_13_31( config_flags, titau, & defor, & mtau, & !JDM - mu, xkx, fnm, fnp, & + mu, c1, c2, xkx, fnm, fnp, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -4631,6 +4672,8 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, & REAL, DIMENSION( ims:ime, jms:jme), INTENT( IN ) & :: mu + REAL, DIMENSION( kms:kme) , INTENT( IN ) & + :: c1, c2 ! Local variables. @@ -4682,7 +4725,7 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, & DO j = j_start, j_end DO i = i_start, i_end - muavg(i,j) = 0.5 * ( mu(i,j) + mu(i-1,j) ) + MUAVG(i,j) = 0.5 * ( MU(i,j) + MU(i-1,j) ) END DO END DO @@ -4741,7 +4784,7 @@ END SUBROUTINE cal_titau_13_31 SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & mtau, & !JDM - mu, xkx, fnm, fnp, & + mu, c1, c2, xkx, fnm, fnp, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -4790,6 +4833,8 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & :: mu + REAL, DIMENSION( kms:kme) , INTENT( IN ) & + :: c1, c2 ! Local variables. @@ -4841,7 +4886,7 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & DO j = j_start, j_end DO i = i_start, i_end - muavg(i,j) = 0.5 * ( mu(i,j) + mu(i,j-1) ) + MUAVG(i,j) = 0.5 * ( MU(i,j) + MU(i,j-1) ) END DO END DO @@ -5073,7 +5118,7 @@ END SUBROUTINE phy_bc SUBROUTINE tke_rhs( tendency, BN2, config_flags, & defor11, defor22, defor33, & defor12, defor13, defor23, & - u, v, w, div, tke, mu, & + u, v, w, div, tke, mu, c1, c2, & theta, p, p8w, t8w, z, fnm, fnp, & cf1, cf2, cf3, msftx, msfty, & xkmh, xkmv, xkhv, & @@ -5117,6 +5162,8 @@ SUBROUTINE tke_rhs( tendency, BN2, config_flags, & REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & :: mu + REAL, DIMENSION( kms:kme) , INTENT( IN ) & + :: c1, c2 REAL, DIMENSION ( ims:ime, jms:jme ), INTENT( IN ) & :: hfx, ust, qfx @@ -5134,7 +5181,8 @@ SUBROUTINE tke_rhs( tendency, BN2, config_flags, & CALL tke_shear( tendency, config_flags, & defor11, defor22, defor33, & defor12, defor13, defor23, & - u, v, w, tke, ust, mu, fnm, fnp, & + u, v, w, tke, ust, mu, & + c1, c2, fnm, fnp, & cf1, cf2, cf3, msftx, msfty, & xkmh, xkmv, & rdx, rdy, zx, zy, rdz, rdzw, dnw, dn, & @@ -5142,15 +5190,15 @@ SUBROUTINE tke_rhs( tendency, BN2, config_flags, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) - CALL tke_buoyancy( tendency, config_flags, mu, & + CALL tke_buoyancy( tendency, config_flags, mu, c1, c2, & 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, & + CALL tke_dissip( tendency, config_flags, mu, c1, c2, & + tke, bn2, theta, p8w, t8w, z, & dx, dy,rdz, rdzw, isotropic, & msftx, msfty, & ids, ide, jds, jde, kds, kde, & @@ -5190,6 +5238,7 @@ END SUBROUTINE tke_rhs !======================================================================= SUBROUTINE tke_buoyancy( tendency, config_flags, mu, & + c1, c2, & tke, xkhv, BN2, theta, dt, & hfx, qfx, qv, rho, & ids, ide, jds, jde, kds, kde, & @@ -5220,6 +5269,8 @@ SUBROUTINE tke_buoyancy( tendency, config_flags, mu, & REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & :: mu + REAL, DIMENSION( kms:kme) , INTENT( IN ) & + :: c1, c2 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT ( IN ) & :: qv, rho @@ -5320,7 +5371,8 @@ END SUBROUTINE tke_buoyancy !======================================================================= SUBROUTINE tke_dissip( tendency, config_flags, & - mu, tke, bn2, theta, p8w, t8w, z, & + mu, c1, c2, & + tke, bn2, theta, p8w, t8w, z, & dx, dy, rdz, rdzw, isotropic, & msftx, msfty, & ids, ide, jds, jde, kds, kde, & @@ -5363,6 +5415,8 @@ SUBROUTINE tke_dissip( tendency, config_flags, & REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & :: mu + REAL, DIMENSION( kms:kme) , INTENT( IN ) & + :: c1, c2 REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & :: msftx, msfty @@ -5443,7 +5497,8 @@ END SUBROUTINE tke_dissip SUBROUTINE tke_shear( tendency, config_flags, & defor11, defor22, defor33, & defor12, defor13, defor23, & - u, v, w, tke, ust, mu, fnm, fnp, & + u, v, w, tke, ust, mu, c1, c2, & + fnm, fnp, & cf1, cf2, cf3, msftx, msfty, & xkmh, xkmv, & rdx, rdy, zx, zy, rdz, rdzw, dn, dnw, & @@ -5521,6 +5576,8 @@ SUBROUTINE tke_shear( tendency, config_flags, & REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & :: mu + REAL, DIMENSION( kms:kme) , INTENT( IN ) & + :: c1, c2 REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & :: ust diff --git a/dyn_em/module_em.F b/dyn_em/module_em.F index 9383c663f7..5b8d101329 100644 --- a/dyn_em/module_em.F +++ b/dyn_em/module_em.F @@ -1,3 +1,31 @@ +#if ( HYBRID_COORD==1 ) +# define mut(...) (c1(k)*XXPCTXX(__VA_ARGS__)+c2(k)) +# define XXPCTXX(...) mut(__VA_ARGS__) + +# define muu(...) (c1(k)*XXPCUXX(__VA_ARGS__)+c2(k)) +# define XXPCUXX(...) muu(__VA_ARGS__) + +# define muv(...) (c1(k)*XXPCVXX(__VA_ARGS__)+c2(k)) +# define XXPCVXX(...) muv(__VA_ARGS__) + +# define MUT(...) (c1f(k)*XXPCTFXX(__VA_ARGS__)+c2f(k)) +# define XXPCTFXX(...) MUT(__VA_ARGS__) + +# define MUU(...) (c1h(k)*XXPCUHXX(__VA_ARGS__)+c2h(k)) +# define XXPCUHXX(...) MUU(__VA_ARGS__) + +# define MUV(...) (c1h(k)*XXPCVHXX(__VA_ARGS__)+c2h(k)) +# define XXPCVHXX(...) MUV(__VA_ARGS__) + +# define muold(...) (c1(k)*XXPCTOLDXX(__VA_ARGS__)+c2(k)) +# define XXPCTOLDXX(...) muold(__VA_ARGS__) + +# define munew(...) (c1(k)*XXPCTNEWXX(__VA_ARGS__)+c2(k)) +# define XXPCTNEWXX(...) munew(__VA_ARGS__) +#endif + + + !WRF:MODEL_LAYER:DYNAMICS ! @@ -34,7 +62,7 @@ MODULE module_em SUBROUTINE rk_step_prep ( config_flags, rk_step, & u, v, w, t, ph, mu, & - moist, & + c1h, c2h, c1f, c2f, moist, & ru, rv, rw, ww, php, alt, & muu, muv, & mub, mut, phb, pb, p, al, alb, & @@ -109,6 +137,7 @@ SUBROUTINE rk_step_prep ( config_flags, rk_step, & mut REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm, fnp, dnw + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h, c1f, c2f integer :: k @@ -151,12 +180,13 @@ SUBROUTINE rk_step_prep ( config_flags, rk_step, & CALL couple_momentum( muu, ru, u, msfuy, & muv, rv, v, msfvx, msfvx_inv, & mut, rw, w, msfty, & + c1h, c2h, c1f, c2f, & 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, & + CALL calc_ww_cp ( u, v, mu, mub, c1h, c2h, ww, & rdx, rdy, msftx, msfty, & msfux, msfuy, msfvx, msfvx_inv, & msfvy, dnw, & @@ -192,7 +222,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & 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, & + mu, mut, muu, muv, mub, c1h, c2h, c1f, c2f, & al, alt, p, pb, php, cqu, cqv, cqw, & u_base, v_base, t_base, qv_base, z_base, & msfux, msfuy, msfvx, msfvx_inv, & @@ -303,7 +333,11 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & v_base, & t_base, & qv_base, & - z_base + z_base, & + c1h, & + c2h, & + c1f, & + c2f REAL , INTENT(IN ) :: rdx, & rdy, & @@ -414,6 +448,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & IF( (rk_step == 3) .and. ( adv_opt == WENO_MOM ) ) THEN CALL advect_weno_u ( u, u , ru_tend, ru, rv, ww, & + c1h, c2h, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -425,6 +460,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & ELSE CALL advect_u ( u, u , ru_tend, ru, rv, ww, & + c1h, c2h, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -437,6 +473,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & IF( (rk_step == 3) .and. ( adv_opt == WENO_MOM ) ) THEN CALL advect_weno_v ( v, v , rv_tend, ru, rv, ww, & + c1h, c2h, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -448,6 +485,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & ELSE CALL advect_v ( v, v , rv_tend, ru, rv, ww, & + c1h, c2h, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -461,6 +499,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & IF (non_hydrostatic) THEN IF( (rk_step == 3) .and. ( adv_opt == WENO_MOM ) ) THEN CALL advect_weno_w ( w, w, rw_tend, ru, rv, ww, & + c1h, c2h, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -472,6 +511,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & ELSE CALL advect_w ( w, w, rw_tend, ru, rv, ww, & + c1h, c2h, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, & @@ -484,6 +524,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & ! theta flux divergence CALL advect_scalar ( t, t, t_tend, ru, rv, ww, & + c1h, c2h, & mut, time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, fnm, fnp, & @@ -508,6 +549,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & CALL rhs_ph( ph_tend, u, v, ww, ph, ph, phb, w, & mut, muu, muv, & + c1f, c2f, & fnm, fnp, & rdnw, cfn, cfn1, rdx, rdy, & msfux, msfuy, msfvx, & @@ -521,7 +563,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & CALL horizontal_pressure_gradient( ru_tend,rv_tend, & ph,alt,p,pb,al,php,cqu,cqv, & - muu,muv,mu,fnm,fnp,rdnw, & + muu,muv,mu,c1h,c2h,fnm,fnp,rdnw,& cf1,cf2,cf3,cfn,cfn1, & rdx,rdy,msfux,msfuy, & msfvx,msfvy,msftx,msfty, & @@ -533,20 +575,21 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & IF (non_hydrostatic) THEN CALL pg_buoy_w( rw_tend, p, cqw, mu, mub, & + c1f,c2f, & rdnw, rdn, g, msftx, msfty, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) ENDIF - 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 ) + CALL w_damp ( rw_tend, max_vert_cfl, & + max_horiz_cfl, & + u, v, ww, w, mut, c1f, c2f, 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 @@ -554,7 +597,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & ru_tend, rv_tend, rw_tend, & config_flags, & u_base, v_base, z_base, & - muu, muv, phb, ph, & + muu, muv, c1h, c2h, phb, ph, & msftx, msfty, msfux, msfuy, & msfvx, msfvy, & f, e, sina, cosa, fnm, fnp, & @@ -604,7 +647,8 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN - CALL horizontal_diffusion ('u', u, ru_tendf, mut, config_flags, & + CALL horizontal_diffusion ('u', u, ru_tendf, mut, & + c1h, c2h, config_flags, & msfux, msfuy, msfvx, msfvx_inv, & msfvy,msftx, msfty, & khdif, xkmhd, rdx, rdy, & @@ -612,7 +656,8 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) - CALL horizontal_diffusion ('v', v, rv_tendf, mut, config_flags, & + CALL horizontal_diffusion ('v', v, rv_tendf, mut, & + c1h, c2h, config_flags, & msfux, msfuy, msfvx, msfvx_inv, & msfvy,msftx, msfty, & khdif, xkmhd, rdx, rdy, & @@ -620,7 +665,8 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) - CALL horizontal_diffusion ('w', w, rw_tendf, mut, config_flags, & + CALL horizontal_diffusion ('w', w, rw_tendf, mut, & + c1f, c2f, config_flags, & msfux, msfuy, msfvx, msfvx_inv, & msfvy,msftx, msfty, & khdif, xkmhd, rdx, rdy, & @@ -630,6 +676,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & khdq = 3.*khdif CALL horizontal_diffusion_3dmp ( 'm', t, t_tendf, mut, & + c1h, c2h, & config_flags, t_init, & msfux, msfuy, msfvx, msfvx_inv, & msfvy, msftx, msfty, & @@ -641,14 +688,14 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN CALL vertical_diffusion_u ( u, ru_tendf, config_flags, & - u_base, & + u_base, c1h, c2h, & 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, & + v_base, c1h, c2h, & alt, muv, rdn, rdnw, kvdif, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -656,6 +703,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & IF (non_hydrostatic) & CALL vertical_diffusion ( 'w', w, rw_tendf, config_flags, & + c1f, c2f, & alt, mut, rdn, rdnw, kvdif, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -663,6 +711,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & kvdq = 3.*kvdif CALL vertical_diffusion_3dmp ( t, t_tendf, config_flags, t_init, & + c1h, c2h, & alt, mut, rdn, rdnw, kvdq , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -677,14 +726,14 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & IF ( diff_6th_opt .NE. 0 ) THEN CALL sixth_order_diffusion( 'u', u, ru_tendf, mut, dt, & - config_flags, & + config_flags, c1h, c2h, & 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, & + config_flags, c1h, c2h, & diff_6th_opt, diff_6th_factor, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -692,14 +741,14 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & IF (non_hydrostatic) & CALL sixth_order_diffusion( 'w', w, rw_tendf, mut, dt, & - config_flags, & + config_flags, c1f, c2f, & 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, & + config_flags, c1h, c2h, & diff_6th_opt, diff_6th_factor, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -711,6 +760,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & CALL rk_rayleigh_damp( ru_tendf, rv_tendf, & rw_tendf, t_tendf, & u, v, w, t, t_init, & + c1h, c2h, c1f, c2f, & mut, muu, muv, ph, phb, & u_base, v_base, t_base, z_base, & dampcoef, zdamp, & @@ -720,7 +770,7 @@ SUBROUTINE rk_tendency ( config_flags, rk_step, & IF( rad_nudge .eq. 1 ) & CALL theta_relaxation( t_tendf, t, t_init, & - mut, ph, phb, & + mut, c1h, c2h, ph, phb, & t_base, z_base, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -735,7 +785,7 @@ 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, & + mu_tend, mu_tendf, rk_step, c1, c2, & h_diabatic, mut, msftx, msfty, msfux, msfuy, & msfvx, msfvx_inv, msfvy, & ids,ide, jds,jde, kds,kde, & @@ -783,6 +833,7 @@ SUBROUTINE rk_addtend_dry ( ru_tend, rv_tend, rw_tend, ph_tend, t_tend, & msfvx_inv, & msfvy + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1, c2 ! Local INTEGER :: i, j, k @@ -860,7 +911,7 @@ SUBROUTINE rk_addtend_dry ( ru_tend, rv_tend, rw_tend, ph_tend, t_tend, & 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) + MU_TEND(i,j) = MU_TEND(i,j) + MU_TENDF(i,j) ENDDO ENDDO @@ -872,7 +923,7 @@ SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & tenddec, & rk_step, dt, & ru, rv, ww, mut, mub, mu_old, & - alt, & + c1h, c2h, alt, & scalar_old, scalar, & scalar_tends, advect_tend, & h_tendency, z_tendency, & @@ -927,6 +978,8 @@ SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & rdnw, & base + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h + REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfux, & msfuy, & msfvx, & @@ -994,7 +1047,8 @@ SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & advect_tend(ims,kms,jms), & h_tendency(ims,kms,jms), & z_tendency(ims,kms,jms), & - ru, rv, ww, mut, mub, mu_old, & + ru, rv, ww, c1h, c2h, & + mut, mub, mu_old, & time_step, config_flags, tenddec, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, fnm, fnp, & @@ -1010,7 +1064,8 @@ SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & advect_tend(ims,kms,jms), & h_tendency(ims,kms,jms), & z_tendency(ims,kms,jms), & - ru, rv, ww, mut, mub, mu_old, & + ru, rv, ww, c1h, c2h, & + mut, mub, mu_old, & config_flags, tenddec, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, fnm, fnp, & @@ -1024,7 +1079,8 @@ SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & CALL advect_scalar_weno ( scalar(ims,kms,jms,im), & scalar(ims,kms,jms,im), & advect_tend(ims,kms,jms), & - ru, rv, ww, mut, time_step, & + ru, rv, ww, c1h, c2h, & + mut, time_step, & config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, fnm, fnp, & @@ -1038,7 +1094,8 @@ SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & CALL advect_scalar_wenopd ( scalar(ims,kms,jms,im), & scalar_old(ims,kms,jms,im), & advect_tend(ims,kms,jms), & - ru, rv, ww, mut, mub, mu_old, & + ru, rv, ww, c1h, c2h, & + mut, mub, mu_old, & time_step, config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, fnm, fnp, & @@ -1052,7 +1109,8 @@ SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & CALL advect_scalar ( scalar(ims,kms,jms,im), & scalar(ims,kms,jms,im), & advect_tend(ims,kms,jms), & - ru, rv, ww, mut, time_step, & + ru, rv, ww, c1h, c2h, & + mut, time_step, & config_flags, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, fnm, fnp, & @@ -1081,7 +1139,7 @@ SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & CALL horizontal_diffusion ( 'm', scalar(ims,kms,jms,im), & scalar_tends(ims,kms,jms,im), mut, & - config_flags, & + c1h, c2h, config_flags, & msfux, msfuy, msfvx, msfvx_inv, & msfvy, msftx, msfty, & khdq , xkmhd, rdx, rdy, & @@ -1095,7 +1153,7 @@ SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & CALL vertical_diffusion_mp ( scalar(ims,kms,jms,im), & scalar_tends(ims,kms,jms,im), & - config_flags, base, & + config_flags, base, c1h, c2h, & alt, mut, rdn, rdnw, kvdq , & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -1105,7 +1163,7 @@ SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & CALL vertical_diffusion ( 'm', scalar(ims,kms,jms,im), & scalar_tends(ims,kms,jms,im), & - config_flags, & + config_flags, c1h, c2h, & alt, mut, rdn, rdnw, kvdq, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -1120,7 +1178,7 @@ SUBROUTINE rk_scalar_tend ( scs, sce, config_flags, & 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, & + mut, dt, config_flags, c1h,c2h,& diff_6th_opt, diff_6th_factor, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -1134,10 +1192,10 @@ END SUBROUTINE rk_scalar_tend !------------------------------------------------------------------------------- -SUBROUTINE q_diabatic_add ( scs, sce, & - dt, mu, & +SUBROUTINE q_diabatic_add ( scs, sce, & + dt, mut, c1, c2, & qv_diabatic, qc_diabatic, & - scalar_tends, & + scalar_tends, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -1152,7 +1210,9 @@ SUBROUTINE q_diabatic_add ( scs, sce, & its, ite, jts, jte, kts, kte REAL, DIMENSION( ims:ime, jms:jme ) , & - INTENT(IN ) :: mu + INTENT(IN ) :: mut + + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1, c2 REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), & INTENT(IN ) :: qv_diabatic, qc_diabatic @@ -1182,7 +1242,7 @@ SUBROUTINE q_diabatic_add ( scs, sce, & DO j = jts,MIN(jte,jde-1) DO k = kts,kte-1 DO i = its,MIN(ite,ide-1) - scalar_tends(i,k,j,im) = scalar_tends(i,k,j,im) + qv_diabatic(i,k,j)*mu(I,J) + scalar_tends(i,k,j,im) = scalar_tends(i,k,j,im) + qv_diabatic(i,k,j)*mut(I,J) ENDDO ENDDO ENDDO @@ -1192,7 +1252,7 @@ SUBROUTINE q_diabatic_add ( scs, sce, & DO j = jts,MIN(jte,jde-1) DO k = kts,kte-1 DO i = its,MIN(ite,ide-1) - scalar_tends(i,k,j,im) = scalar_tends(i,k,j,im) + qc_diabatic(i,k,j)*mu(I,J) + scalar_tends(i,k,j,im) = scalar_tends(i,k,j,im) + qc_diabatic(i,k,j)*mut(I,J) ENDDO ENDDO ENDDO @@ -1278,7 +1338,7 @@ SUBROUTINE rk_update_scalar( scs, sce, & advh_t, advz_t, & advect_tend, & h_tendency, z_tendency, & - msftx, msfty, & + msftx, msfty, c1, c2, & mu_old, mu_new, mu_base, & rk_step, dt, spec_zone, & config_flags, & @@ -1321,9 +1381,11 @@ SUBROUTINE rk_update_scalar( scs, sce, & msftx, & msfty + REAL, DIMENSION(kms:kme ), INTENT(IN ) :: c1, c2 + INTEGER :: i,j,k,im REAL :: sc_middle, msfsq - REAL, DIMENSION(its:ite) :: muold, r_munew + REAL, DIMENSION(its:ite) :: muold, munew REAL, DIMENSION(its:ite, kts:kte, jts:jte ) :: tendency @@ -1399,8 +1461,8 @@ SUBROUTINE rk_update_scalar( scs, sce, & 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)) + MUOLD(i) = MU_OLD(i,j) + MU_BASE(i,j) + MUNEW(i) = MU_NEW(i,j) + MU_BASE(i,j) ENDDO DO k = kts, min(kte,kde-1) @@ -1408,7 +1470,7 @@ SUBROUTINE rk_update_scalar( scs, sce, & 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) + + dt*tendency(i,k,j))/munew(i) ENDDO ENDDO @@ -1450,15 +1512,15 @@ SUBROUTINE rk_update_scalar( scs, sce, & 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)) + MUOLD(i) = MU_OLD(i,j) + MU_BASE(i,j) + MUNEW(i) = 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) + + dt*tendency(i,k,j))/munew(i) ENDDO ENDDO @@ -1469,8 +1531,8 @@ SUBROUTINE rk_update_scalar( scs, sce, & DO k = kts, min(kte,kde-1) DO i = its, min(ite,ide-1) - advh_t(i,k,j) = advh_t(i,k,j) + (dt*h_tendency(i,k,j)* msfty(i,j))*r_munew(i) - advz_t(i,k,j) = advz_t(i,k,j) + (dt*z_tendency(i,k,j)* msfty(i,j))*r_munew(i) + advh_t(i,k,j) = advh_t(i,k,j) + (dt*h_tendency(i,k,j)* msfty(i,j))/munew(i) + advz_t(i,k,j) = advz_t(i,k,j) + (dt*z_tendency(i,k,j)* msfty(i,j))/munew(i) ENDDO ENDDO @@ -1489,6 +1551,7 @@ END SUBROUTINE rk_update_scalar SUBROUTINE rk_update_scalar_pd( scs, sce, & scalar, sc_tend, & + c1, c2, & mu_old, mu_new, mu_base, & rk_step, dt, spec_zone, & config_flags, & @@ -1517,9 +1580,11 @@ SUBROUTINE rk_update_scalar_pd( scs, sce, & mu_new, & mu_base + REAL, DIMENSION(kms:kme ), INTENT(IN ) :: c1, c2 + INTEGER :: i,j,k,im REAL :: sc_middle, msfsq - REAL, DIMENSION(its:ite) :: muold, r_munew + REAL, DIMENSION(its:ite) :: muold, munew REAL, DIMENSION(its:ite, kts:kte, jts:jte ) :: tendency @@ -1582,15 +1647,15 @@ SUBROUTINE rk_update_scalar_pd( scs, sce, & 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)) + MUOLD(i) = MU_OLD(i,j) + MU_BASE(i,j) + MUNEW(i) = 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) + + dt*tendency(i,k,j))/munew(i) ENDDO ENDDO ENDDO @@ -1760,7 +1825,8 @@ end subroutine dump_data !----------------------------------------------------------------------- -SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & +SUBROUTINE calculate_phy_tend (config_flags,c1,c2, & + mut,muu,muv,pi3d, & RTHRATEN, & RUBLTEN,RVBLTEN,RTHBLTEN, & RQVBLTEN,RQCBLTEN,RQIBLTEN, & @@ -1789,9 +1855,12 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , & INTENT(IN ) :: pi3d + + REAL, DIMENSION( kms:kme ) , & + INTENT(IN ) :: c1, c2 REAL, DIMENSION( ims:ime, jms:jme ) , & - INTENT(IN ) :: mu, & + INTENT(IN ) :: mut, & muu, & muv @@ -1876,7 +1945,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO K=kts,ktf DO I=its,itf - RTHRATEN(I,K,J)=mu(I,J)*RTHRATEN(I,K,J) + RTHRATEN(I,K,J)=mut(I,J)*RTHRATEN(I,K,J) ENDDO ENDDO ENDDO @@ -1890,10 +1959,10 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO I=its,itf DO K=kts,ktf - RUCUTEN(I,K,J) =mu(I,J)*RUCUTEN(I,K,J) - RVCUTEN(I,K,J) =mu(I,J)*RVCUTEN(I,K,J) - RTHCUTEN(I,K,J)=mu(I,J)*RTHCUTEN(I,K,J) - RQVCUTEN(I,K,J)=mu(I,J)*RQVCUTEN(I,K,J) + RUCUTEN(I,K,J) =mut(I,J)*RUCUTEN(I,K,J) + RVCUTEN(I,K,J) =mut(I,J)*RVCUTEN(I,K,J) + RTHCUTEN(I,K,J)=mut(I,J)*RTHCUTEN(I,K,J) + RQVCUTEN(I,K,J)=mut(I,J)*RQVCUTEN(I,K,J) ENDDO ENDDO ENDDO @@ -1902,7 +1971,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO I=its,itf DO K=kts,ktf - RQCCUTEN(I,K,J)=mu(I,J)*RQCCUTEN(I,K,J) + RQCCUTEN(I,K,J)=mut(I,J)*RQCCUTEN(I,K,J) ENDDO ENDDO ENDDO @@ -1912,7 +1981,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO I=its,itf DO K=kts,ktf - RQRCUTEN(I,K,J)=mu(I,J)*RQRCUTEN(I,K,J) + RQRCUTEN(I,K,J)=mut(I,J)*RQRCUTEN(I,K,J) ENDDO ENDDO ENDDO @@ -1922,7 +1991,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO I=its,itf DO K=kts,ktf - RQICUTEN(I,K,J)=mu(I,J)*RQICUTEN(I,K,J) + RQICUTEN(I,K,J)=mut(I,J)*RQICUTEN(I,K,J) ENDDO ENDDO ENDDO @@ -1932,7 +2001,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO I=its,itf DO K=kts,ktf - RQSCUTEN(I,K,J)=mu(I,J)*RQSCUTEN(I,K,J) + RQSCUTEN(I,K,J)=mut(I,J)*RQSCUTEN(I,K,J) ENDDO ENDDO ENDDO @@ -1947,10 +2016,10 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO I=its,itf DO K=kts,ktf - RUSHTEN(I,K,J) =mu(I,J)*RUSHTEN(I,K,J) - RVSHTEN(I,K,J) =mu(I,J)*RVSHTEN(I,K,J) - RTHSHTEN(I,K,J)=mu(I,J)*RTHSHTEN(I,K,J) - RQVSHTEN(I,K,J)=mu(I,J)*RQVSHTEN(I,K,J) + RUSHTEN(I,K,J) =mut(I,J)*RUSHTEN(I,K,J) + RVSHTEN(I,K,J) =mut(I,J)*RVSHTEN(I,K,J) + RTHSHTEN(I,K,J)=mut(I,J)*RTHSHTEN(I,K,J) + RQVSHTEN(I,K,J)=mut(I,J)*RQVSHTEN(I,K,J) ENDDO ENDDO ENDDO @@ -1959,7 +2028,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO I=its,itf DO K=kts,ktf - RQCSHTEN(I,K,J)=mu(I,J)*RQCSHTEN(I,K,J) + RQCSHTEN(I,K,J)=mut(I,J)*RQCSHTEN(I,K,J) ENDDO ENDDO ENDDO @@ -1969,7 +2038,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO I=its,itf DO K=kts,ktf - RQRSHTEN(I,K,J)=mu(I,J)*RQRSHTEN(I,K,J) + RQRSHTEN(I,K,J)=mut(I,J)*RQRSHTEN(I,K,J) ENDDO ENDDO ENDDO @@ -1979,7 +2048,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO I=its,itf DO K=kts,ktf - RQISHTEN(I,K,J)=mu(I,J)*RQISHTEN(I,K,J) + RQISHTEN(I,K,J)=mut(I,J)*RQISHTEN(I,K,J) ENDDO ENDDO ENDDO @@ -1989,7 +2058,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO I=its,itf DO K=kts,ktf - RQSSHTEN(I,K,J)=mu(I,J)*RQSSHTEN(I,K,J) + RQSSHTEN(I,K,J)=mut(I,J)*RQSSHTEN(I,K,J) ENDDO ENDDO ENDDO @@ -1999,7 +2068,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO I=its,itf DO K=kts,ktf - RQGSHTEN(I,K,J)=mu(I,J)*RQGSHTEN(I,K,J) + RQGSHTEN(I,K,J)=mut(I,J)*RQGSHTEN(I,K,J) ENDDO ENDDO ENDDO @@ -2014,9 +2083,9 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & 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) + RUBLTEN(I,K,J) =mut(I,J)*RUBLTEN(I,K,J) + RVBLTEN(I,K,J) =mut(I,J)*RVBLTEN(I,K,J) + RTHBLTEN(I,K,J)=mut(I,J)*RTHBLTEN(I,K,J) ENDDO ENDDO ENDDO @@ -2025,7 +2094,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO K=kts,ktf DO I=its,itf - RQVBLTEN(I,K,J)=mu(I,J)*RQVBLTEN(I,K,J) + RQVBLTEN(I,K,J)=mut(I,J)*RQVBLTEN(I,K,J) ENDDO ENDDO ENDDO @@ -2035,7 +2104,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO K=kts,ktf DO I=its,itf - RQCBLTEN(I,K,J)=mu(I,J)*RQCBLTEN(I,K,J) + RQCBLTEN(I,K,J)=mut(I,J)*RQCBLTEN(I,K,J) ENDDO ENDDO ENDDO @@ -2045,7 +2114,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO K=kts,ktf DO I=its,itf - RQIBLTEN(I,K,J)=mu(I,J)*RQIBLTEN(I,K,J) + RQIBLTEN(I,K,J)=mut(I,J)*RQIBLTEN(I,K,J) ENDDO ENDDO ENDDO @@ -2066,7 +2135,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & ! 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) +! write(*,'(a,2f15.5)') 'mu, muu=',mut(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 @@ -2086,7 +2155,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & 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) + RTHNDGDTEN(I,K,J)=mut(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) @@ -2098,7 +2167,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO K=kts,ktf DO I=its,itf - RQVNDGDTEN(I,K,J)=mu(I,J)*RQVNDGDTEN(I,K,J) + RQVNDGDTEN(I,K,J)=mut(I,J)*RQVNDGDTEN(I,K,J) ENDDO ENDDO ENDDO @@ -2112,7 +2181,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO K=kts,ktf DO I=its,itf - scalar_tend(I,K,J,im)=mu(I,J)*scalar_tend(I,K,J,im) + scalar_tend(I,K,J,im)=mut(I,J)*scalar_tend(I,K,J,im) ENDDO ENDDO ENDDO @@ -2122,7 +2191,7 @@ SUBROUTINE calculate_phy_tend (config_flags,mu,muu,muv,pi3d, & DO J=jts,jtf DO K=kts,ktf DO I=its,itf - tracer_tend(I,K,J,im)=mu(I,J)*tracer_tend(I,K,J,im) + tracer_tend(I,K,J,im)=mut(I,J)*tracer_tend(I,K,J,im) ENDDO ENDDO ENDDO @@ -2204,7 +2273,8 @@ END SUBROUTINE bound_tke !Chiaying Lee RSMAS/UM !---------------------------------------------------------------------------------- subroutine trajectory ( grid,config_flags, & - dt,itimestep,ru_m, rv_m, ww_m, mut,muu,muv,& + dt,itimestep,ru_m, rv_m, ww_m, & + mut,muu,muv,c1h,c2h,c1f,c2f, & rdx, rdy, rdn, rdnw,rdzw, & traj_i,traj_j,traj_k, & traj_long,traj_lat, & @@ -2243,6 +2313,8 @@ subroutine trajectory ( grid,config_flags, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: rdn, & rdnw + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: c1h, c2h, c1f, c2f + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & INTENT(IN ) :: ru_m, & rv_m, & @@ -2256,7 +2328,7 @@ subroutine trajectory ( grid,config_flags, & real, dimension(ims:ime,kms:kme,jms:jme)::u,v,w real, dimension(ims:ime,jms:jme),intent(in)::msft,msfu,msfv real, dimension(ims:ime,jms:jme),intent(in)::muu,muv,mut - integer :: i_traj,j_traj,k_traj,tjk,k + integer :: i_traj,j_traj,k_traj,tjk,i,j,k real :: traj_u,traj_v,traj_w real :: rdx_grid,rdy_grid,rdz_grid real :: deltx, delty, deltz,ax @@ -2280,10 +2352,12 @@ subroutine trajectory ( grid,config_flags, & ! convert ru_m, rv_m and ww_m in u,v,w const1=1.0/2.0/sqrt(2.0) +do k=kms,kme-1 + u(:,k,:)=ru_m(:,k,:)/MUU(:,:)*msfu(:,:) + v(:,k,:)=rv_m(:,k,:)/MUV(:,:)*msfv(:,:) +enddo do k=kms,kme - u(:,k,:)=ru_m(:,k,:)/muu(:,:)*msfu(:,:) - v(:,k,:)=rv_m(:,k,:)/muv(:,:)*msfv(:,:) - w(:,k,:)=ww_m(:,k,:)/mut(:,:)*msft(:,:) + w(:,k,:)=ww_m(:,k,:)/MUT(:,:)*msft(:,:) enddo do tjk = 1,config_flags%num_traj eta_old = 0.0 diff --git a/dyn_em/module_first_rk_step_part1.F b/dyn_em/module_first_rk_step_part1.F index dd9b7c0f81..a29441e1ca 100644 --- a/dyn_em/module_first_rk_step_part1.F +++ b/dyn_em/module_first_rk_step_part1.F @@ -187,8 +187,9 @@ SUBROUTINE first_rk_step_part1 ( grid , config_flags & 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%mut, grid%muu, grid%muv, & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & + 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, & grid%rho,th_phy, p_phy, pi_phy, grid%u_phy, grid%v_phy, & p8w, t_phy, t8w, grid%z, grid%z_at_w, dz8w, & diff --git a/dyn_em/module_first_rk_step_part2.F b/dyn_em/module_first_rk_step_part2.F index 8f012328aa..ae7ae90fcc 100644 --- a/dyn_em/module_first_rk_step_part2.F +++ b/dyn_em/module_first_rk_step_part2.F @@ -251,7 +251,8 @@ SUBROUTINE first_rk_step_part2 ( grid , config_flags & 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, & + CALL calculate_phy_tend (config_flags,grid%c1h,grid%c2h, & + grid%mut,grid%muu,grid%muv,pi_phy, & grid%rthraten, & grid%rublten,grid%rvblten,grid%rthblten, & grid%rqvblten,grid%rqcblten,grid%rqiblten, & @@ -707,7 +708,7 @@ SUBROUTINE first_rk_step_part2 ( grid , config_flags & grid%defor33, & grid%defor12,grid%defor13,grid%defor23, & grid%u_2,grid%v_2,grid%w_2,grid%div, & - grid%tke_2,grid%mut, & + grid%tke_2,grid%mut,grid%c1h,grid%c2h, & th_phy,p_phy,p8w,t8w,grid%z,grid%fnm, & grid%fnp,grid%cf1,grid%cf2,grid%cf3, & grid%msftx,grid%msfty,grid%xkmh, & @@ -750,7 +751,8 @@ SUBROUTINE first_rk_step_part2 ( grid , config_flags & tracer_tend, num_tracer, & 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%mut, grid%c1h, grid%c2h, & + grid%tke_2, config_flags, & grid%defor13,grid%defor23,grid%defor33, & nba_mij, num_nba_mij, & !JDM grid%div, moist, chem, scalar,tracer, & @@ -782,7 +784,8 @@ SUBROUTINE first_rk_step_part2 ( grid , config_flags & scalar_tend, num_scalar, & tracer_tend, num_tracer, & grid%t_2, th_phy, & - grid%mut, grid%tke_2, config_flags, & + grid%mut, grid%c1h, grid%c2h, & + grid%tke_2, config_flags, & grid%defor11, grid%defor22, grid%defor12, & grid%defor13, grid%defor23, & nba_mij, num_nba_mij, & !JDM diff --git a/dyn_em/module_initialize_hill2d_x.F b/dyn_em/module_initialize_hill2d_x.F index d8fcfb46f4..adc88a2a55 100644 --- a/dyn_em/module_initialize_hill2d_x.F +++ b/dyn_em/module_initialize_hill2d_x.F @@ -1,3 +1,19 @@ +! sed -e "s/grid%mu/gridmu/g" -e "s/grid%Mu/gridMu/g" module_initialize_hill2d_x.F | cpp -DHYBRID_COORD | sed -e "s/gridmu/grid%mu/g" -e "s/gridMu/grid%Mu/g" >> module_initialize_hill2d_x.next +#if ( HYBRID_COORD==1 ) +# define gridmu_1(...) (grid%c1h(k)*XXPC1HXX(__VA_ARGS__)) +# define XXPC1HXX(...) grid%mu_1(__VA_ARGS__) + +# define gridMu_1(...) (grid%c1f(k)*XXPC1FXX(__VA_ARGS__)) +# define XXPC1FXX(...) grid%Mu_1(__VA_ARGS__) + +# define gridmub(...) (grid%c1h(k)*XXPCBHXX(__VA_ARGS__)+grid%c2h(k)) +# define XXPCBHXX(...) grid%mub(__VA_ARGS__) + +# define gridMub(...) (grid%c1f(k)*XXPCBFXX(__VA_ARGS__)+grid%c2f(k)) +# define XXPCBFXX(...) grid%Mub(__VA_ARGS__) +#endif + + !IDEAL:MODEL_LAYER:INITIALIZATION ! @@ -84,7 +100,7 @@ SUBROUTINE init_domain_rk ( grid & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & - i, j, k + i, j, k, kk ! Local data @@ -111,6 +127,11 @@ SUBROUTINE init_domain_rk ( grid & REAL :: xa1, xal1,pii,hm1 ! data for intercomparison setup from dale + REAL :: B1, B2, B3, B4, B5, sin_arg + + REAL :: Nsq, z, z1, z2 + INTEGER :: iter_loop + SELECT CASE ( model_data_order ) CASE ( DATA_ORDER_ZXY ) kds = grid%sd31 ; kde = grid%ed31 ; @@ -283,6 +304,109 @@ SUBROUTINE init_domain_rk ( grid & grid%p_top = interp_0( p_in, zk, config_flags%ztop, nl_in ) +! Fill in the hybrid coordinate coefficients + + DO k=1, kde + IF ( config_flags%hybrid_opt .EQ. 0 ) THEN + grid%c3f(k) = grid%znw(k) + ELSE IF ( config_flags%hybrid_opt .EQ. 1 ) THEN + grid%c3f(k) = grid%znw(k) + ELSE IF ( config_flags%hybrid_opt .EQ. 2 ) THEN + B1 = 2. * grid%etac**2 * ( 1. - grid%etac ) + B2 = -grid%etac * ( 4. - 3. * grid%etac - grid%etac**3 ) + B3 = 2. * ( 1. - grid%etac**3 ) + B4 = - ( 1. - grid%etac**2 ) + B5 = (1.-grid%etac)**4 + grid%c3f(k) = ( B1 + B2*grid%znw(k) + B3*grid%znw(k)**2 + B4*grid%znw(k)**3 ) / B5 + IF ( grid%znw(k) .LT. grid%etac ) THEN + grid%c3f(k) = 0. + END IF + IF ( k .EQ. kds ) THEN + grid%c3f(k) = 1. + ELSE IF ( k .EQ. kde ) THEN + grid%c3f(k) = 0. + END IF + ELSE IF ( config_flags%hybrid_opt .EQ. 3 ) THEN + IF ( grid%znw(k) .GE. grid%etac ) THEN + sin_arg = (1./(1.-grid%etac))*(grid%znw(k)-1.)+1 + grid%c3f(k) = (sin(sin_arg*3.14159265358/2.))**2 + ELSE + grid%c3f(k) = 0. + END IF + IF ( k .EQ. kds ) THEN + grid%c3f(k) = 1. + ELSE IF ( k .EQ. kds ) THEN + grid%c3f(kde) = 0. + END IF + ELSE + CALL wrf_error_fatal ( 'ERROR: --- hybrid_opt=0 ===> Standard WRF Coordinate; hybrid_opt>=1 ===> Hybrid Vertical Coordinate' ) + END IF + END DO + + DO k=1, kde + grid%c4f(k) = ( grid%znw(k) - grid%c3f(k) ) * ( p1000mb - grid%p_top ) + ENDDO + + ! Now on half levels, just add up and divide by 2 (for c3h). Use (eta-c3)*(p00-pt) for c4 on half levels. + + DO k=1, kde-1 + grid%c3h(k) = ( grid%c3f(k+1) + grid%c3f(k) ) * 0.5 + grid%c4h(k) = ( grid%znu(k) - grid%c3h(k) ) * ( p1000mb - grid%p_top ) + ENDDO + + ! c1 = d(B)/d(eta). We define c1f as c1 on FULL levels. For a vertical difference, + ! we need to use B and eta on half levels. The k-loop ends up referring to the + ! full levels, neglecting the top and bottom. + + DO k=kds+1, kde-1 + grid%c1f(k) = ( grid%c3h(k) - grid%c3h(k-1) ) / ( grid%znu(k) - grid%znu(k-1) ) + ENDDO + + ! The boundary conditions to get the coefficients: + ! 1) At k=kts: define d(B)/d(eta) = 1. This gives us the same value of B and d(B)/d(eta) + ! when doing the sigma-only B=eta. + ! 2) At k=kte: with the new vertical coordinate, define d(B)/d(eta) = 0. The curve B SMOOTHLY + ! goes to zero, and at the very top, B continues to SMOOTHLY go to zero. Note that for + ! almost all cases of non B=eta, B is ALREADY=ZERO at the top, so this is a reasonable BC to + ! assume. + ! 3) At k=kte: when trying to mimic the original vertical coordinate, since B = eta, then + ! d(B)/d(eta) = 1. + + grid%c1f(kds) = 1. + IF ( ( config_flags%hybrid_opt .EQ. 0 ) .OR. ( config_flags%hybrid_opt .EQ. 1 ) ) THEN + grid%c1f(kde) = 1. + ELSE + grid%c1f(kde) = 0. + END IF + + ! c2 = ( 1. - c1(k) ) * (p00 - pt). There is no vertical differencing, so we can do the + ! full kds to kde looping. + + DO k=kds, kde + grid%c2f(k) = ( 1. - grid%c1f(k) ) * ( p1000mb - grid%p_top ) + END DO + + ! Now on half levels for c1 and c2. The c1h will result from the full level c3 and full + ! level eta differences. The c2 value use the half level c1(k). + + DO k=1, kde-1 + grid%c1h(k) = ( grid%c3f(k+1) - grid%c3f(k) ) / ( grid%znw(k+1) - grid%znw(k) ) + grid%c2h(k) = ( 1. - grid%c1h(k) ) * ( p1000mb - grid%p_top ) + END DO + +#if 0 + DO k=1, kde + grid%c3f(k) = grid%znw(k) + grid%c4f(k) = 0. + grid%c3h(k) = grid%znu(k) + grid%c4h(k) = 0. + grid%c1f(k) = 1. + grid%c2f(k) = 0. + grid%c1h(k) = 1. + grid%c2h(k) = 0. + END DO +#endif + DO j=jts,jte DO i=its,ite ! flat surface !! grid%ht(i,j) = 0. @@ -299,13 +423,17 @@ SUBROUTINE init_domain_rk ( grid & 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 + 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 +#if !( HYBRID_COORD==1 ) p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top +#elif ( HYBRID_COORD==1 ) + p_level = grid%c3h(k)*(p_surf - grid%p_top) + grid%c4h(k) + grid%p_top +#endif 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 @@ -315,15 +443,20 @@ SUBROUTINE init_domain_rk ( grid & ! 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) + DO kk = 2,kte + k=kk - 1 + grid%phb(i,kk,j) = grid%phb(i,kk-1,j) - grid%dnw(kk-1)*grid%mub(i,j)*grid%alb(i,kk-1,j) ENDDO ENDDO ENDDO write(6,*) ' ptop is ',grid%p_top +#if !( HYBRID_COORD==1 ) write(6,*) ' base state grid%mub(1,1), p_surf is ',grid%mub(1,1),grid%mub(1,1)+grid%p_top +#elif ( HYBRID_COORD==1 ) + write(6,*) ' base state grid%MUB(1,1), p_surf is ',grid%MUB(1,1),grid%c3f(kts)*grid%MUB(1,1)+grid%c4f(kts)+grid%p_top +#endif ! calculate full state for each column - this includes moisture. @@ -342,16 +475,20 @@ SUBROUTINE init_domain_rk ( grid & ! 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) + 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 +#if !( HYBRID_COORD==1 ) p_level = grid%znu(k)*(pd_surf - grid%p_top) + grid%p_top +#elif ( HYBRID_COORD==1 ) + p_level = grid%c3h(k)*(pd_surf - grid%p_top) + grid%c4h(k) + grid%p_top +#endif 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 @@ -364,30 +501,31 @@ SUBROUTINE init_domain_rk ( grid & ! 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 + kk = kte-1 ! top level + k=kk+1 - qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV)) + qvf1 = 0.5*(moist(i,kk,j,P_QV)+moist(i,kk,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) + grid%p(i,kk,j) = - 0.5*(grid%Mu_1(i,j)+qvf1*grid%Mub(i,j))/grid%rdnw(kk)/qvf2 + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_1(i,kk,j)+t0)*qvf* & + (((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,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)) + do kk=kte-2,1,-1 + k = kk + 1 + qvf1 = 0.5*(moist(i,kk,j,P_QV)+moist(i,kk+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) + grid%p(i,kk,j) = grid%p(i,kk+1,j) - (grid%Mu_1(i,j) + qvf1*grid%Mub(i,j))/qvf2/grid%rdn(kk+1) + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_1(i,kk,j)+t0)*qvf* & + (((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,j) enddo ! this is the hydrostatic equation used in the model after the @@ -406,14 +544,58 @@ SUBROUTINE init_domain_rk ( grid & ENDDO 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),& + k=1 + write(6,*) ' grid%ph_1 k=1 calc ',grid%ph_1(2,k,2),& + grid%mu_1(2,2)+grid%mub(2,2),grid%mu_1(2,2), & + grid%alb(2,k,2),grid%rdnw(k) + k=2 + write(6,*) ' grid%ph_1 k=2 calc ',grid%ph_1(2,k,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) + grid%alb(2,k,2) endif ENDDO ENDDO +#if 0 +!=============== + +! Test for resting atmosphere + + DO iter_loop = 1, 100 + DO J = jts, min(jde-1,jte) + DO I = its, min(ide-1,ite) + DO K = 2, kte-1 + z1 = (grid%phb(i,k+1,j)+grid%ph_1(i,k+1,j))/g + z2 = (grid%phb(i,k ,j)+grid%ph_1(i,k ,j))/g + z=(z1+z2)/2. + IF ( z .LT. 10000 ) THEN + Nsq = 1.E-4 + ELSE + Nsq = 4.E-4 + END IF + grid%t_1(i,k,j)=(grid%t_1(i,k-1,j)+t0) * EXP(Nsq / g * (z1-z2)) - t0 + 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) + ENDDO + + DO k = 2,kte + grid%ph_1(i,k,j) = grid%ph_1(i,k-1,j) - (grid%dnw(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 + END DO +!=============== +#endif + k=1 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 @@ -469,7 +651,11 @@ SUBROUTINE init_domain_rk ( grid & p_surf = interp_0( p_in, zk, z_at_u, nl_in ) DO K = 1, kte +#if !( HYBRID_COORD==1 ) p_level = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top +#elif ( HYBRID_COORD==1 ) + p_level = grid%c3h(k)*(p_surf - grid%p_top) + grid%c4h(k) + grid%p_top +#endif 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 diff --git a/dyn_em/module_initialize_real.F b/dyn_em/module_initialize_real.F index 188135216e..6b6c043de6 100644 --- a/dyn_em/module_initialize_real.F +++ b/dyn_em/module_initialize_real.F @@ -1,3 +1,20 @@ +! sed -e "s/grid%mu/gridmu/g" -e "s/grid%Mu/gridMu/g" module_initialize_real.F | cpp -DHYBRID_COORD | sed -e "s/gridmu/grid%mu/g" -e "s/gridMu/grid%Mu/g" >> module_initialize_real.next +#if ( HYBRID_COORD==1 ) +# define gridmu0(...) (grid%c1h(k)*XXPC0HXX(__VA_ARGS__)+grid%c2h(k)) +# define XXPC0HXX(...) grid%mu0(__VA_ARGS__) + +# define gridmu_2(...) (grid%c1h(k)*XXPC2HXX(__VA_ARGS__)) +# define XXPC2HXX(...) grid%mu_2(__VA_ARGS__) + +# define gridmub(...) (grid%c1h(k)*XXPCBHXX(__VA_ARGS__)+grid%c2h(k)) +# define XXPCBHXX(...) grid%mub(__VA_ARGS__) + +# define gridMu_2(...) (grid%c1f(k)*XXPC2FXX(__VA_ARGS__)) +# define XXPC2FXX(...) grid%Mu_2(__VA_ARGS__) + +# define gridMub(...) (grid%c1f(k)*XXPCBFXX(__VA_ARGS__)+grid%c2f(k)) +# define XXPCBFXX(...) grid%Mub(__VA_ARGS__) +#endif !REAL:MODEL_LAYER:INITIALIZATION #ifndef VERT_UNIT @@ -89,7 +106,7 @@ SUBROUTINE init_domain_rk ( grid & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & ips, ipe, jps, jpe, kps, kpe, & - i, j, k + i, j, k, kk INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, & ipsx, ipex, jpsx, jpex, kpsx, kpex, & @@ -102,6 +119,7 @@ SUBROUTINE init_domain_rk ( grid & INTEGER :: error INTEGER :: im, num_3d_m, num_3d_s + REAL :: B1, B2, B3, B4, B5 REAL :: p_surf, p_level REAL :: cof1, cof2 REAL :: qvf , qvf1 , qvf2 , qtot, pd_surf @@ -1502,6 +1520,96 @@ SUBROUTINE init_domain_rk ( grid & its , ite , jts , jte , kts , kte ) END IF + ! For hybrid coord + + DO k=kts, kte + IF ( config_flags%hybrid_opt .EQ. 0 ) THEN + grid%c3f(k) = grid%znw(k) + ELSE IF ( config_flags%hybrid_opt .EQ. 1 ) THEN + grid%c3f(k) = grid%znw(k) + ELSE IF ( config_flags%hybrid_opt .EQ. 2 ) THEN + B1 = 2. * grid%etac**2 * ( 1. - grid%etac ) + B2 = -grid%etac * ( 4. - 3. * grid%etac - grid%etac**3 ) + B3 = 2. * ( 1. - grid%etac**3 ) + B4 = - ( 1. - grid%etac**2 ) + B5 = (1.-grid%etac)**4 + grid%c3f(k) = ( B1 + B2*grid%znw(k) + B3*grid%znw(k)**2 + B4*grid%znw(k)**3 ) / B5 + IF ( grid%znw(k) .LT. grid%etac ) THEN + grid%c3f(k) = 0. + END IF + IF ( k .EQ. kds ) THEN + grid%c3f(k) = 1. + ELSE IF ( k .EQ. kde ) THEN + grid%c3f(k) = 0. + END IF + ELSE IF ( config_flags%hybrid_opt .EQ. 3 ) THEN + grid%c3f(k) = grid%znw(k)*sin(0.5*3.14159*grid%znw(k))**2 + IF ( k .EQ. kds ) THEN + grid%c3f(k) = 1. + ELSE IF ( k .EQ. kds ) THEN + grid%c3f(kde) = 0. + END IF + ELSE + CALL wrf_message ( 'ERROR: --- hybrid_opt' ) + CALL wrf_message ( 'ERROR: --- hybrid_opt=0 ==> Standard WRF terrain-following coordinate' ) + CALL wrf_message ( 'ERROR: --- hybrid_opt=1 ==> Standard WRF terrain-following coordinate, hybrid c1, c2, c3, c4' ) + CALL wrf_message ( 'ERROR: --- hybrid_opt=2 ==> Hybrid, Klemp polynomial' ) + CALL wrf_message ( 'ERROR: --- hybrid_opt=3 ==> Hybrid, sin^2' ) + CALL wrf_error_fatal ( 'ERROR: --- Invalid option' ) + END IF + END DO + + ! c4 is a function of c3 and eta. + + DO k=1, kde + grid%c4f(k) = ( grid%znw(k) - grid%c3f(k) ) * ( p1000mb - grid%p_top ) + ENDDO + + ! Now on half levels, just add up and divide by 2 (for c3h). Use (eta-c3)*(p00-pt) for c4 on half levels. + + DO k=1, kde-1 + grid%znu(k) = ( grid%znw(k+1) + grid%znw(k) ) * 0.5 + grid%c3h(k) = ( grid%c3f(k+1) + grid%c3f(k) ) * 0.5 + grid%c4h(k) = ( grid%znu(k) - grid%c3h(k) ) * ( p1000mb - grid%p_top ) + ENDDO + + ! c1 = d(B)/d(eta). We define c1f as c1 on FULL levels. For a vertical difference, + ! we need to use B and eta on half levels. The k-loop ends up referring to the + ! full levels, neglecting the top and bottom. + + DO k=kds+1, kde-1 + grid%c1f(k) = ( grid%c3h(k) - grid%c3h(k-1) ) / ( grid%znu(k) - grid%znu(k-1) ) + ENDDO + + ! The boundary conditions to get the coefficients: + ! 1) At k=kts: define d(B)/d(eta) = 1. This gives us the same value of B and d(B)/d(eta) + ! when doing the sigma-only B=eta. + ! 2) At k=kte: define d(B)/d(eta) = 0. The curve B SMOOTHLY goes to zero, and at the very + ! top, B continues to SMOOTHLY go to zero. Note that for almost all cases of non B=eta, + ! B is ALREADY=ZERO at the top, so this is a reasonable BC to assume. + + grid%c1f(kds) = 1. + IF ( ( config_flags%hybrid_opt .EQ. 0 ) .OR. ( config_flags%hybrid_opt .EQ. 1 ) ) THEN + grid%c1f(kde) = 1. + ELSE + grid%c1f(kde) = 0. + END IF + + ! c2 = ( 1. - c1(k) ) * (p00 - pt). There is no vertical differencing, so we can do the + ! full kds to kde looping. + + DO k=kds, kde + grid%c2f(k) = ( 1. - grid%c1f(k) ) * ( p1000mb - grid%p_top ) + ENDDO + + ! Now on half levels for c1 and c2. The c1h will result from the full level c3 and full + ! level eta differences. The c2 value use the half level c1(k). + + DO k=1, kde-1 + grid%c1h(k) = ( grid%c3f(k+1) - grid%c3f(k) ) / ( grid%znw(k+1) - grid%znw(k) ) + grid%c2h(k) = ( 1. - grid%c1h(k) ) * ( p1000mb - grid%p_top ) + ENDDO + IF ( config_flags%interp_theta ) THEN ! The input field is temperature, we want potential temp. @@ -1520,6 +1628,7 @@ SUBROUTINE init_domain_rk ( grid & ! later after the vertical interpolations are complete. CALL p_dry ( grid%mu0 , grid%znw , grid%p_top , grid%pb , want_full_levels , & + grid%c3f , grid%c3h , grid%c4f , grid%c4h , & ids , ide , jds , jde , kds , kde , & ims , ime , jms , jme , kms , kme , & its , ite , jts , jte , kts , kte ) @@ -1590,6 +1699,7 @@ SUBROUTINE init_domain_rk ( grid & ! Now the rest of the variables on half-levels to inteprolate. CALL p_dry ( grid%mu0 , grid%znw , grid%p_top , grid%pb , want_half_levels , & + grid%c3f , grid%c3h , grid%c4f , grid%c4h , & ids , ide , jds , jde , kds , kde , & ims , ime , jms , jme , kms , kme , & its , ite , jts , jte , kts , kte ) @@ -1668,7 +1778,7 @@ SUBROUTINE init_domain_rk ( grid & its , ite , jts , jte , kts , kte ) interp_type = grid%interp_type - ! It is better to interpolate pressure in p regardless default options + ! It is better to interpolate pressure in p regardless of the default options interp_type = 1 CALL vert_interp ( grid%p_gc , grid%pd_gc , grid%p , grid%pb , & @@ -3040,8 +3150,13 @@ SUBROUTINE init_domain_rk ( grid & DO k = 1, kte-1 +#if !( HYBRID_COORD==1 ) grid%php(i,k,j) = grid%znw(k)*(p_surf - grid%p_top) + grid%p_top ! temporary, full lev base pressure - grid%pb(i,k,j) = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top + grid%pb(i,k,j) = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top +#elif ( HYBRID_COORD==1 ) + grid%php(i,k,j) = grid%c3f(k)*(p_surf - grid%p_top)+grid%c4f(k) + grid%p_top ! temporary, full lev base pressure + grid%pb(i,k,j) = grid%c3h(k)*(p_surf - grid%p_top)+grid%c4h(k) + grid%p_top +#endif temp = MAX ( tiso, t00 + A*LOG(grid%pb(i,k,j)/p00) ) IF ( grid%pb(i,k,j) .LT. p_strat ) THEN temp = tiso + A_strat * LOG ( grid%pb(i,k,j)/p_strat ) @@ -3053,12 +3168,12 @@ SUBROUTINE init_domain_rk ( grid & ! Base state mu is defined as base state surface pressure minus grid%p_top - grid%mub(i,j) = p_surf - grid%p_top + grid%MUB(i,j) = p_surf - grid%p_top ! Dry surface pressure is defined as the following (this mu is from the input file ! computed from the dry pressure). Here the dry pressure is just reconstituted. - pd_surf = grid%mu0(i,j) + grid%p_top + pd_surf = grid%MU0(i,j) + grid%p_top ! Integrate base geopotential, starting at terrain elevation. This assures that ! the base state is in exact hydrostatic balance with respect to the model equations. @@ -3066,14 +3181,21 @@ SUBROUTINE init_domain_rk ( grid & grid%phb(i,1,j) = grid%ht(i,j) * g IF (grid%hypsometric_opt == 1) THEN - DO k = 2,kte - grid%phb(i,k,j) = grid%phb(i,k-1,j) - grid%dnw(k-1)*grid%mub(i,j)*grid%alb(i,k-1,j) + DO kk = 2,kte + k = kk-1 + grid%phb(i,kk,j) = grid%phb(i,kk-1,j) - grid%dnw(kk-1)*grid%mub(i,j)*grid%alb(i,kk-1,j) END DO ELSE IF (grid%hypsometric_opt == 2) THEN DO k = 2,kte +#if !( HYBRID_COORD==1 ) pfu = grid%mub(i,j)*grid%znw(k) + grid%p_top pfd = grid%mub(i,j)*grid%znw(k-1) + grid%p_top phm = grid%mub(i,j)*grid%znu(k-1) + grid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = grid%c3f(k )*grid%MUB(i,j)+grid%c4f(k ) + grid%p_top + pfd = grid%c3f(k-1)*grid%MUB(i,j)+grid%c4f(k-1) + grid%p_top + phm = grid%c3h(k-1)*grid%MUB(i,j)+grid%c4h(k-1) + grid%p_top +#endif grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu) END DO ELSE @@ -3097,8 +3219,8 @@ SUBROUTINE init_domain_rk ( grid & IF ( ite .EQ. ide ) THEN i = ide DO j = jts, MIN(jde-1,jte) - grid%mub(i,j) = grid%mub(i-1,j) - grid%mu_2(i,j) = grid%mu_2(i-1,j) + grid%MUB(i,j) = grid%MUB(i-1,j) + grid%MU_2(i,j) = grid%MU_2(i-1,j) DO k = 1, kte-1 grid%pb(i,k,j) = grid%pb(i-1,k,j) grid%t_init(i,k,j) = grid%t_init(i-1,k,j) @@ -3113,8 +3235,8 @@ SUBROUTINE init_domain_rk ( grid & IF ( jte .EQ. jde ) THEN j = jde DO i = its, ite - grid%mub(i,j) = grid%mub(i,j-1) - grid%mu_2(i,j) = grid%mu_2(i,j-1) + grid%MUB(i,j) = grid%MUB(i,j-1) + grid%MU_2(i,j) = grid%MU_2(i,j-1) DO k = 1, kte-1 grid%pb(i,k,j) = grid%pb(i,k,j-1) grid%t_init(i,k,j) = grid%t_init(i,k,j-1) @@ -3126,12 +3248,12 @@ SUBROUTINE init_domain_rk ( grid & END DO END IF - ! Compute the perturbation dry pressure (grid%mub + grid%mu_2 + ptop = dry grid%psfc). + ! Compute the total column perturbation dry pressure (grid%mub + grid%mu_2 + ptop = dry grid%psfc). DO j = jts, min(jde-1,jte) DO i = its, min(ide-1,ite) IF ( skip_middle_points_t ( ids , ide , jds , jde , i , j , em_width , hold_ups ) ) CYCLE - grid%mu_2(i,j) = grid%mu0(i,j) - grid%mub(i,j) + grid%MU_2(i,j) = grid%MU0(i,j) - grid%MUB(i,j) END DO END DO @@ -3140,14 +3262,14 @@ SUBROUTINE init_domain_rk ( grid & IF ( ite .EQ. ide ) THEN i = ide DO j = jts, MIN(jde-1,jte) - grid%mu_2(i,j) = grid%mu_2(i-1,j) + grid%MU_2(i,j) = grid%MU_2(i-1,j) END DO END IF IF ( jte .EQ. jde ) THEN j = jde DO i = its, ite - grid%mu_2(i,j) = grid%mu_2(i,j-1) + grid%MU_2(i,j) = grid%MU_2(i,j-1) END DO END IF @@ -3175,38 +3297,40 @@ SUBROUTINE init_domain_rk ( grid & ! equation) down from the top to get the pressure perturbation. First get the pressure ! perturbation, moisture, and inverse density (total and perturbation) at the top-most level. - k = kte-1 + kk = kte-1 + k = kk+1 qtot=0. DO im = PARAM_FIRST_SCALAR, num_3d_m - qtot = qtot + moist(i,k,j,im) + qtot = qtot + moist(i,kk,j,im) ENDDO qvf2 = 1./(1.+qtot) qvf1 = qtot*qvf2 - grid%p(i,k,j) = - 0.5*(grid%mu_2(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_2(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) - grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j) + grid%p(i,kk,j) = - 0.5*(grid%Mu_2(i,j)+qvf1*grid%Mub(i,j))/grid%rdnw(kk)/qvf2 + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf& + *(((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,j) + grid%p_hyd(i,kk,j) = grid%p(i,kk,j) + grid%pb(i,kk,j) ! Now, integrate down the column to compute the pressure perturbation, and diagnose the two ! inverse density fields (total and perturbation). - DO k=kte-2,1,-1 + DO kk=kte-2,1,-1 + k = kk + 1 qtot=0. DO im = PARAM_FIRST_SCALAR, num_3d_m - qtot = qtot + 0.5*(moist(i,k,j,im)+moist(i,k+1,j,im)) + qtot = qtot + 0.5*(moist(i,kk,j,im)+moist(i,kk+1,j,im)) ENDDO qvf2 = 1./(1.+qtot) qvf1 = qtot*qvf2 - grid%p(i,k,j) = grid%p(i,k+1,j) - (grid%mu_2(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_2(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) - grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j) + grid%p(i,kk,j) = grid%p(i,kk+1,j) - (grid%Mu_2(i,j) + qvf1*grid%Mub(i,j))/qvf2/grid%rdn(kk+1) + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & + (((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,j) + grid%p_hyd(i,kk,j) = grid%p(i,kk,j) + grid%pb(i,kk,j) END DO #if 1 @@ -3214,11 +3338,12 @@ SUBROUTINE init_domain_rk ( grid & ! the model, grid%al (inverse density) is computed from the geopotential. IF (grid%hypsometric_opt == 1) THEN - DO k = 2,kte - grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) - & - grid%dnw(k-1) * ( (grid%mub(i,j)+grid%mu_2(i,j))*grid%al(i,k-1,j) & - + grid%mu_2(i,j)*grid%alb(i,k-1,j) ) - grid%ph0(i,k,j) = grid%ph_2(i,k,j) + grid%phb(i,k,j) + DO kk = 2,kte + k = kk - 1 + grid%ph_2(i,kk,j) = grid%ph_2(i,kk-1,j) - & + grid%dnw(kk-1) * ( (grid%mub(i,j)+grid%mu_2(i,j))*grid%al(i,kk-1,j) & + + grid%mu_2(i,j)*grid%alb(i,kk-1,j) ) + grid%ph0(i,kk,j) = grid%ph_2(i,kk,j) + grid%phb(i,kk,j) END DO ELSE IF (grid%hypsometric_opt == 2) THEN ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure. @@ -3227,9 +3352,15 @@ SUBROUTINE init_domain_rk ( grid & grid%ph_2(i,1,j) = grid%phb(i,1,j) DO k = 2,kte +#if !( HYBRID_COORD==1 ) pfu = grid%mu0(i,j)*grid%znw(k) + grid%p_top pfd = grid%mu0(i,j)*grid%znw(k-1) + grid%p_top phm = grid%mu0(i,j)*grid%znu(k-1) + grid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = grid%c3f(k )*grid%MU0(i,j)+grid%c4f(k ) + grid%p_top + pfd = grid%c3f(k-1)*grid%MU0(i,j)+grid%c4f(k-1) + grid%p_top + phm = grid%c3h(k-1)*grid%MU0(i,j)+grid%c4h(k-1) + grid%p_top +#endif grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu) END DO @@ -3254,11 +3385,31 @@ SUBROUTINE init_domain_rk ( grid & ENDDO ELSE IF (grid%hypsometric_opt == 2) THEN DO k=kts,kte-1 +#if !( HYBRID_COORD==1 ) pfu = (grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k+1)+grid%p_top pfd = (grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k) +grid%p_top phm = (grid%mub(i,j)+grid%mu_2(i,j))*grid%znu(k) +grid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = grid%c3f(k+1)*(grid%MUB(i,j)+grid%MU_2(i,j))+grid%c4f(k+1)+grid%p_top + pfd = grid%c3f(k )*(grid%MUB(i,j)+grid%MU_2(i,j))+grid%c4f(k )+grid%p_top + phm = grid%c3h(k )*(grid%MUB(i,j)+grid%MU_2(i,j))+grid%c4h(k )+grid%p_top +#endif + qvf=-1./(grid%mub(i,j)+grid%mu_2(i,j))*(grid%alb(i,k,j)*grid%mu_2(i,j) & + +grid%rdnw(k)*(grid%ph_2(i,k+1,j)-grid%ph_2(i,k,j))) grid%al(i,k,j) = (grid%ph_2(i,k+1,j)-grid%ph_2(i,k,j)+grid%phb(i,k+1,j)-grid%phb(i,k,j)) & /phm/LOG(pfd/pfu)-grid%alb(i,k,j) +#if 0 +if ( internal_time_loop .EQ. 1 ) THEN +if (i.eq.its .and. j.eq.its)then +if (k.eq.kts)then +print *,' k old al new al alb new alt dz (m) pres up Pres mid Pres down c3 k c3 k+1 c4 k c4 k+1' +print *,' =======================================================================================================================================================================================================================================' +endif +print *,' ',k,qvf,grid%al(i,k,j),grid%alb(i,k,j),grid%al(i,k,j)+grid%alb(i,k,j),(grid%ph_2(i,k+1,j)-grid%ph_2(i,k,j)+grid%phb(i,k+1,j)-grid%phb(i,k,j)),pfu,phm,pfd,grid%c3f(k),grid%c3f(k+1),grid%c4f(k),grid%c4f(k+1) +endif +endif +#endif + ENDDO END IF @@ -3329,7 +3480,7 @@ SUBROUTINE init_domain_rk ( grid & (1.+0.6*moist(i,1,j,P_QV)) dpmu = ( grid%php(i,1,j) + grid%p(i,1,j) ) * EXP ( g * dz500 / ( r_d * tvsfc ) ) dpmu = dpmu - ( grid%php(i,1,j) + grid%p(i,1,j) ) - grid%mu_2(i,j) = grid%mu_2(i,j) - dpmu + grid%MU_2(i,j) = grid%MU_2(i,j) - dpmu EXIT END IF @@ -3413,38 +3564,40 @@ SUBROUTINE init_domain_rk ( grid & ! equation) down from the top to get the pressure perturbation. First get the pressure ! perturbation, moisture, and inverse density (total and perturbation) at the top-most level. - k = kte-1 + kk = kte-1 + k=kk+1 qtot=0. DO im = PARAM_FIRST_SCALAR, num_3d_m - qtot = qtot + moist(i,k,j,im) + qtot = qtot + moist(i,kk,j,im) ENDDO qvf2 = 1./(1.+qtot) qvf1 = qtot*qvf2 - grid%p(i,k,j) = - 0.5*(grid%mu_2(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_2(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) - grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j) + grid%p(i,kk,j) = - 0.5*(grid%Mu_2(i,j)+qvf1*grid%Mub(i,j))/grid%rdnw(kk)/qvf2 + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf& + *(((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,j) + grid%p_hyd(i,kk,j) = grid%p(i,kk,j) + grid%pb(i,kk,j) ! Now, integrate down the column to compute the pressure perturbation, and diagnose the two ! inverse density fields (total and perturbation). - DO k=kte-2,1,-1 + DO kk=kte-2,1,-1 + k = kk + 1 qtot=0. DO im = PARAM_FIRST_SCALAR, num_3d_m - qtot = qtot + 0.5*(moist(i,k,j,im)+moist(i,k+1,j,im)) + qtot = qtot + 0.5*(moist(i,kk,j,im)+moist(i,kk+1,j,im)) ENDDO qvf2 = 1./(1.+qtot) qvf1 = qtot*qvf2 - grid%p(i,k,j) = grid%p(i,k+1,j) - (grid%mu_2(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_2(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) - grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j) + grid%p(i,kk,j) = grid%p(i,kk+1,j) - (grid%Mu_2(i,j) + qvf1*grid%Mub(i,j))/qvf2/grid%rdn(kk+1) + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & + (((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,j) + grid%p_hyd(i,kk,j) = grid%p(i,kk,j) + grid%pb(i,kk,j) END DO #if 1 @@ -3453,11 +3606,12 @@ SUBROUTINE init_domain_rk ( grid & IF (grid%hypsometric_opt == 1) THEN - DO k = 2,kte - grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) - & - grid%dnw(k-1) * ( (grid%mub(i,j)+grid%mu_2(i,j))*grid%al(i,k-1,j) & - + grid%mu_2(i,j)*grid%alb(i,k-1,j) ) - grid%ph0(i,k,j) = grid%ph_2(i,k,j) + grid%phb(i,k,j) + DO kk = 2,kte + k = kk-1 + grid%ph_2(i,kk,j) = grid%ph_2(i,kk-1,j) - & + grid%dnw(kk-1) * ( (grid%mub(i,j)+grid%mu_2(i,j))*grid%al(i,kk-1,j) & + + grid%mu_2(i,j)*grid%alb(i,kk-1,j) ) + grid%ph0(i,kk,j) = grid%ph_2(i,kk,j) + grid%phb(i,kk,j) END DO ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure. @@ -3468,9 +3622,15 @@ SUBROUTINE init_domain_rk ( grid & grid%ph_2(i,1,j) = grid%phb(i,1,j) DO k = 2,kte +#if !( HYBRID_COORD==1 ) pfu = grid%mu0(i,j)*grid%znw(k) + grid%p_top pfd = grid%mu0(i,j)*grid%znw(k-1) + grid%p_top phm = grid%mu0(i,j)*grid%znu(k-1) + grid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = grid%c3f(k )*grid%MU0(i,j)+grid%c4f(k ) + grid%p_top + pfd = grid%c3f(k-1)*grid%MU0(i,j)+grid%c4f(k-1) + grid%p_top + phm = grid%c3h(k-1)*grid%MU0(i,j)+grid%c4h(k-1) + grid%p_top +#endif grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu) END DO @@ -3495,9 +3655,15 @@ SUBROUTINE init_domain_rk ( grid & ENDDO ELSE IF (grid%hypsometric_opt == 2) THEN DO k=kts,kte-1 +#if !( HYBRID_COORD==1 ) pfu = (grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k+1)+grid%p_top pfd = (grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k) +grid%p_top phm = (grid%mub(i,j)+grid%mu_2(i,j))*grid%znu(k) +grid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = grid%c3f(k+1)*(grid%MUB(i,j)+grid%MU_2(i,j))+grid%c4f(k+1)+grid%p_top + pfd = grid%c3f(k )*(grid%MUB(i,j)+grid%MU_2(i,j))+grid%c4f(k )+grid%p_top + phm = grid%c3h(k )*(grid%MUB(i,j)+grid%MU_2(i,j))+grid%c4h(k )+grid%p_top +#endif grid%al(i,k,j) = (grid%ph_2(i,k+1,j)-grid%ph_2(i,k,j)+grid%phb(i,k+1,j)-grid%phb(i,k,j)) & /phm/LOG(pfd/pfu)-grid%alb(i,k,j) ENDDO @@ -3567,7 +3733,7 @@ SUBROUTINE init_domain_rk ( grid & (1.+0.6*moist(i,1,j,P_QV)) dpmu = ( grid%php(i,1,j) + grid%p(i,1,j) ) * EXP ( g * dz500 / ( r_d * tvsfc ) ) dpmu = dpmu - ( grid%php(i,1,j) + grid%p(i,1,j) ) - grid%mu_2(i,j) = grid%mu_2(i,j) - dpmu + grid%MU_2(i,j) = grid%MU_2(i,j) - dpmu EXIT END IF @@ -3852,7 +4018,7 @@ SUBROUTINE rebalance ( grid & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & ips, ipe, jps, jpe, kps, kpe, & - i, j, k + i, j, k, kk REAL :: temp, temp_int REAL :: pfu, pfd, phm @@ -3961,8 +4127,13 @@ SUBROUTINE rebalance ( grid & p_surf_int = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j) /a/r_d ) **0.5 ) DO k = 1, kte-1 +#if !( HYBRID_COORD==1 ) grid%pb(i,k,j) = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top pb_int = grid%znu(k)*(p_surf_int - grid%p_top) + grid%p_top +#elif ( HYBRID_COORD==1 ) + grid%pb(i,k,j) = grid%c3h(k)*(p_surf - grid%p_top) + grid%c4h(k) + grid%p_top + pb_int = grid%c3h(k)*(p_surf_int - grid%p_top) + grid%c4h(k) + grid%p_top +#endif temp = MAX ( tiso, t00 + A*LOG(grid%pb(i,k,j)/p00) ) IF ( grid%pb(i,k,j) .LT. p_strat ) THEN temp = tiso + A_strat * LOG ( grid%pb(i,k,j)/p_strat ) @@ -3981,12 +4152,12 @@ SUBROUTINE rebalance ( grid & ! Base state mu is defined as base state surface pressure minus grid%p_top - grid%mub(i,j) = p_surf - grid%p_top + grid%MUB(i,j) = p_surf - grid%p_top ! Dry surface pressure is defined as the following (this mu is from the input file ! computed from the dry pressure). Here the dry pressure is just reconstituted. - pd_surf = ( grid%mub(i,j) + grid%mu_2(i,j) ) + grid%p_top + pd_surf = ( grid%MUB(i,j) + grid%MU_2(i,j) ) + grid%p_top ! Integrate base geopotential, starting at terrain elevation. This assures that ! the base state is in exact hydrostatic balance with respect to the model equations. @@ -3994,14 +4165,21 @@ SUBROUTINE rebalance ( grid & grid%phb(i,1,j) = grid%ht_fine(i,j) * g IF (grid%hypsometric_opt == 1) THEN - DO k = 2,kte - grid%phb(i,k,j) = grid%phb(i,k-1,j) - grid%dnw(k-1)*grid%mub(i,j)*grid%alb(i,k-1,j) + DO kk = 2,kte + k = kk - 1 + grid%phb(i,kk,j) = grid%phb(i,kk-1,j) - grid%dnw(kk-1)*grid%mub(i,j)*grid%alb(i,kk-1,j) END DO ELSE IF (grid%hypsometric_opt == 2) THEN DO k = 2,kte +#if !( HYBRID_COORD==1 ) pfu = grid%mub(i,j)*grid%znw(k) + grid%p_top pfd = grid%mub(i,j)*grid%znw(k-1) + grid%p_top phm = grid%mub(i,j)*grid%znu(k-1) + grid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = grid%c3f(k )*grid%MUB(i,j)+grid%c4f(k ) + grid%p_top + pfd = grid%c3f(k-1)*grid%MUB(i,j)+grid%c4f(k-1) + grid%p_top + phm = grid%c3h(k-1)*grid%MUB(i,j)+grid%c4h(k-1) + grid%p_top +#endif grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu) END DO ELSE @@ -4033,43 +4211,46 @@ SUBROUTINE rebalance ( grid & ! equation) down from the top to get the pressure perturbation. First get the pressure ! perturbation, moisture, and inverse density (total and perturbation) at the top-most level. - k = kte-1 + kk = kte-1 + k = kk+1 - qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV)) + qvf1 = 0.5*(moist(i,kk,j,P_QV)+moist(i,kk,j,P_QV)) qvf2 = 1./(1.+qvf1) qvf1 = qvf1*qvf2 - grid%p(i,k,j) = - 0.5*(grid%mu_2(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_2(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) - grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j) + grid%p(i,kk,j) = - 0.5*(grid%Mu_2(i,j)+qvf1*grid%Mub(i,j))/grid%rdnw(kk)/qvf2 + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & + (((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,j) + grid%p_hyd(i,kk,j) = grid%p(i,kk,j) + grid%pb(i,kk,j) ! Now, integrate down the column to compute the pressure perturbation, and diagnose the two ! inverse density fields (total and perturbation). - DO k=kte-2,1,-1 - qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV)) + DO kk=kte-2,1,-1 + k = kk+1 + qvf1 = 0.5*(moist(i,kk,j,P_QV)+moist(i,kk+1,j,P_QV)) qvf2 = 1./(1.+qvf1) qvf1 = qvf1*qvf2 - grid%p(i,k,j) = grid%p(i,k+1,j) - (grid%mu_2(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_2(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) - grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j) + grid%p(i,kk,j) = grid%p(i,kk+1,j) - (grid%Mu_2(i,j) + qvf1*grid%Mub(i,j))/qvf2/grid%rdn(kk+1) + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & + (((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,j) + grid%p_hyd(i,kk,j) = grid%p(i,kk,j) + grid%pb(i,kk,j) END DO ! 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. IF (grid%hypsometric_opt == 1) THEN - DO k = 2,kte - grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) - & - grid%dnw(k-1) * ( (grid%mub(i,j)+grid%mu_2(i,j))*grid%al(i,k-1,j) & - + grid%mu_2(i,j)*grid%alb(i,k-1,j) ) - grid%ph0(i,k,j) = grid%ph_2(i,k,j) + grid%phb(i,k,j) + DO kk = 2,kte + k = kk-1 + grid%ph_2(i,kk,j) = grid%ph_2(i,kk-1,j) - & + grid%dnw(kk-1) * ( (grid%mub(i,j)+grid%mu_2(i,j))*grid%al(i,kk-1,j) & + + grid%mu_2(i,j)*grid%alb(i,kk-1,j) ) + grid%ph0(i,kk,j) = grid%ph_2(i,kk,j) + grid%phb(i,kk,j) END DO ELSE IF (grid%hypsometric_opt == 2) THEN @@ -4079,9 +4260,15 @@ SUBROUTINE rebalance ( grid & grid%ph_2(i,1,j) = grid%phb(i,1,j) DO k = 2,kte - pfu = ( grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k) + grid%p_top - pfd = ( grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k-1) + grid%p_top - phm = ( grid%mub(i,j)+grid%mu_2(i,j))*grid%znu(k-1) + grid%p_top +#if !( HYBRID_COORD==1 ) + pfu = (grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k) +grid%p_top + pfd = (grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k-1) +grid%p_top + phm = (grid%mub(i,j)+grid%mu_2(i,j))*grid%znu(k-1) +grid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = grid%c3f(k )*(grid%MUB(i,j)+grid%MU_2(i,j))+grid%c4f(k )+grid%p_top + pfd = grid%c3f(k-1)*(grid%MUB(i,j)+grid%MU_2(i,j))+grid%c4f(k-1)+grid%p_top + phm = grid%c3h(k-1)*(grid%MUB(i,j)+grid%MU_2(i,j))+grid%c4h(k-1)+grid%p_top +#endif grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu) END DO @@ -5479,6 +5666,7 @@ END SUBROUTINE lagrange_interp !--------------------------------------------------------------------- SUBROUTINE p_dry ( mu0 , eta , pdht , pdry , full_levs , & + c3f , c3h , c4f , c4h , & ids , ide , jds , jde , kds , kde , & ims , ime , jms , jme , kms , kme , & its , ite , jts , jte , kts , kte ) @@ -5495,6 +5683,7 @@ SUBROUTINE p_dry ( mu0 , eta , pdht , pdry , full_levs , & REAL , DIMENSION(ims:ime, jms:jme) , INTENT(IN) :: mu0 REAL , DIMENSION( kms:kme ) , INTENT(IN) :: eta + REAL , DIMENSION( kms:kme ) , INTENT(IN) :: c3f , c3h , c4f , c4h REAL :: pdht REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT) :: pdry @@ -5508,7 +5697,11 @@ SUBROUTINE p_dry ( mu0 , eta , pdht , pdry , full_levs , & DO k = kts , kte DO i = its , MIN (ide-1 , ite ) IF ( skip_middle_points_t ( ids , ide , jds , jde , i , j , em_width , hold_ups ) ) CYCLE - pdry(i,k,j) = eta(k) * mu0(i,j) + pdht +#if !( HYBRID_COORD==1 ) + pdry(i,k,j) = eta(k) * mu0(i,j) + pdht +#elif ( HYBRID_COORD==1 ) + pdry(i,k,j) = c3f(k) * MU0(i,j) + c4f(k) + pdht +#endif END DO END DO END DO @@ -5522,7 +5715,11 @@ SUBROUTINE p_dry ( mu0 , eta , pdht , pdry , full_levs , & DO k = kts , kte-1 DO i = its , MIN (ide-1 , ite ) IF ( skip_middle_points_t ( ids , ide , jds , jde , i , j , em_width , hold_ups ) ) CYCLE - pdry(i,k,j) = eta_h(k) * mu0(i,j) + pdht +#if !( HYBRID_COORD==1 ) + pdry(i,k,j) = eta_h(k) * mu0(i,j) + pdht +#elif ( HYBRID_COORD==1 ) + pdry(i,k,j) = c3h(k) * MU0(i,j) + c4h(k) + pdht +#endif END DO END DO END DO diff --git a/dyn_em/module_polarfft.F b/dyn_em/module_polarfft.F index a89bd532d1..2a2acc87f3 100644 --- a/dyn_em/module_polarfft.F +++ b/dyn_em/module_polarfft.F @@ -1,3 +1,13 @@ +#if ( HYBRID_COORD==1 ) +# define mub(...) (c1(k)*XXPCBXX(__VA_ARGS__)+c2(k)) +# define XXPCBXX(...) mub(__VA_ARGS__) + +# define mu(...) (c1(k)*XXPCXX(__VA_ARGS__)) +# define XXPCXX(...) mu(__VA_ARGS__) +#endif + + + MODULE module_polarfft USE module_model_constants @@ -7,7 +17,7 @@ MODULE module_polarfft CONTAINS SUBROUTINE couple_scalars_for_filter ( field & - ,mu,mub & + ,mu,mub,c1,c2 & ,ids,ide,jds,jde,kds,kde & ,ims,ime,jms,jme,kms,kme & ,ips,ipe,jps,jpe,kps,kpe ) @@ -17,6 +27,7 @@ SUBROUTINE couple_scalars_for_filter ( field & ,ips,ipe,jps,jpe,kps,kpe REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(INOUT) :: field REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: mu,mub + REAL , DIMENSION(kms:kme) , INTENT(IN) :: c1,c2 INTEGER :: i , j , k @@ -31,7 +42,7 @@ SUBROUTINE couple_scalars_for_filter ( field & END SUBROUTINE couple_scalars_for_filter SUBROUTINE uncouple_scalars_for_filter ( field & - ,mu,mub & + ,mu,mub,c1,c2 & ,ids,ide,jds,jde,kds,kde & ,ims,ime,jms,jme,kms,kme & ,ips,ipe,jps,jpe,kps,kpe ) @@ -41,6 +52,7 @@ SUBROUTINE uncouple_scalars_for_filter ( field & ,ips,ipe,jps,jpe,kps,kpe REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(INOUT) :: field REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: mu,mub + REAL , DIMENSION(kms:kme) , INTENT(IN) :: c1,c2 INTEGER :: i , j , k @@ -599,7 +611,7 @@ SUBROUTINE polar_filter_3d( f, xlat, piggyback, fft_filter_lat, dvlat, & ! Variables will stay in domain form since this routine is meaningless ! unless tile extent is the same as domain extent in E/W direction, i.e., ! the processor has access to all grid points in E/W direction. - ! There may be other ways of doing FFTs, but we haven't learned them yet... + ! There may be other ways of doing FFTs, but we have not learned them yet... ! Check to make sure we have full access to all E/W points IF ((its /= ids) .OR. (ite /= ide)) THEN @@ -885,7 +897,7 @@ SUBROUTINE filter_tracer ( tr3d_in , xlat , msftx , & DO j = MIN(j_lat_neg,jte) , jts , -1 ! i_kicker = MIN( MAX ( NINT(msftx(its,j)/2) , 1 ) , (ide - ids) / 2 ) i_kicker = MIN( MAX ( NINT(msftx(its,j)/mf_fft/2) , 1 ) , (ide - ids) / 2 ) -! WRITE (message,FMT='(a,i4,a,i4,f6.2,1x,f6.1,f6.1)') 'DAVE SOUTH j = ' , j, ', kicker = ',i_kicker,xlat(its,j),msftx(its,j),mf_fft +! WRITE (message,FMT='(a,i4,a,i4,f6.2,1x,f6.1,f6.1)') 'SOUTH j = ' , j, ', kicker = ',i_kicker,xlat(its,j),msftx(its,j),mf_fft ! CALL wrf_debug ( 0 , TRIM(message) ) DO i = its , MIN(ide-1,ite) sum = 0. @@ -915,7 +927,7 @@ SUBROUTINE filter_tracer ( tr3d_in , xlat , msftx , & DO j = MAX(j_lat_pos,jts) , MIN(jde-1,jte) ! i_kicker = MIN( MAX ( NINT(msftx(its,j)/2) , 1 ) , (ide - ids) / 2 ) i_kicker = MIN( MAX ( NINT(msftx(its,j)/mf_fft/2) , 1 ) , (ide - ids) / 2 ) -! WRITE (message,FMT='(a,i4,a,i4,f6.2,1x,f6.1,f6.1)') 'DAVE NORTH j = ' , j, ', kicker = ',i_kicker,xlat(its,j),msftx(its,j),mf_fft +! WRITE (message,FMT='(a,i4,a,i4,f6.2,1x,f6.1,f6.1)') 'NORTH j = ' , j, ', kicker = ',i_kicker,xlat(its,j),msftx(its,j),mf_fft ! CALL wrf_debug ( 0 , TRIM(message) ) DO i = its , MIN(ide-1,ite) count = 0 diff --git a/dyn_em/module_small_step_em.F b/dyn_em/module_small_step_em.F index b5eae64369..ca2efcd5f5 100644 --- a/dyn_em/module_small_step_em.F +++ b/dyn_em/module_small_step_em.F @@ -1,3 +1,58 @@ +#if ( HYBRID_COORD==1 ) +# define mu(...) (c1h(k)*XXPCXX(__VA_ARGS__)) +# define XXPCXX(...) mu(__VA_ARGS__) + +# define mut(...) (c1f(k)*XXPCTFXX(__VA_ARGS__)+c2f(k)) +# define XXPCTFXX(...) mut(__VA_ARGS__) + +# define Mut(...) (c1h(k)*XXPCTHXX(__VA_ARGS__)+c2h(k)) +# define XXPCTHXX(...) Mut(__VA_ARGS__) + +# define muu(...) (c1h(k)*XXPCUXX(__VA_ARGS__)+c2h(k)) +# define XXPCUXX(...) muu(__VA_ARGS__) + +# define muv(...) (c1h(k)*XXPCVXX(__VA_ARGS__)+c2h(k)) +# define XXPCVXX(...) muv(__VA_ARGS__) + +# define muave(...) (c1f(k)*XXPCAVEFXX(__VA_ARGS__)) +# define XXPCAVEFXX(...) muave(__VA_ARGS__) + +# define Muave(...) (c1h(k)*XXPCAVEHXX(__VA_ARGS__)) +# define XXPCAVEHXX(...) Muave(__VA_ARGS__) + +# define muus(...) (c1h(k)*XXPCUSXX(__VA_ARGS__)+c2h(k)) +# define XXPCUSXX(...) muus(__VA_ARGS__) + +# define muvs(...) (c1h(k)*XXPCVSXX(__VA_ARGS__)+c2h(k)) +# define XXPCVSXX(...) muvs(__VA_ARGS__) + +# define mu_tend(...) (c1h(k)*XXPCTENDXX(__VA_ARGS__)) +# define XXPCTENDXX(...) mu_tend(__VA_ARGS__) + +# define dmdt(...) (c1h(k)*XXDMDTXX(__VA_ARGS__)) +# define XXDMDTXX(...) dmdt(__VA_ARGS__) + +# define muts(...) (c1f(k)*XXPCTFSXX(__VA_ARGS__)+c2f(k)) +# define XXPCTFSXX(...) muts(__VA_ARGS__) + +# define Muts(...) (c1h(k)*XXPCTHSXX(__VA_ARGS__)+c2h(k)) +# define XXPCTHSXX(...) Muts(__VA_ARGS__) + +# define mudf_xy(...) (c1h(k)*XXMUDFXYXX(__VA_ARGS__)) +# define XXMUDFXYXX(...) mudf_xy(__VA_ARGS__) + +# define MUTHK (c1h(k)*MUT(i,j)+c2h(k)) + +# define MUTHKM1 (c1h(k-1)*MUT(i,j)+c2h(k-1)) + +# define MUTHMUTF_KK ((c1h(k)*MUT(i,j)+c2h(k))*(c1f(k)*MUT(i,j)+c2f(k))) + +# define MUTHMUTF_KM1K ((c1h(k-1)*MUT(i,j)+c2h(k-1))*(c1f(k)*MUT(i,j)+c2f(k))) + +# define MUTHMUTF_KKP1 ((c1h(k)*MUT(i,j)+c2h(k))*(c1f(k+1)*MUT(i,j)+c2f(k+1))) + +#endif + !WRF:MODEL_LAYER:DYNAMICS ! @@ -19,6 +74,8 @@ SUBROUTINE small_step_prep( u_1, u_2, v_1, v_2, w_1, w_2, & mub, mu_1, mu_2, & muu, muus, muv, muvs, & mut, muts, mudf, & + c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f, & u_save, v_save, w_save, & t_save, ph_save, mu_save, & ww, ww_save, & @@ -91,6 +148,9 @@ SUBROUTINE small_step_prep( u_1, u_2, v_1, v_2, w_1, w_2, & REAL, INTENT(IN) :: rdx,rdy + REAL, DIMENSION( kms:kme ),INTENT(IN ) :: c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f + ! local variables INTEGER :: i, j, k @@ -125,10 +185,10 @@ SUBROUTINE small_step_prep( u_1, u_2, v_1, v_2, w_1, w_2, & DO j=j_start, j_end DO i=i_start, i_end - mu_1(i,j)=mu_2(i,j) + MU_1(i,j)=MU_2(i,j) ww_save(i,kde,j) = 0. ww_save(i,1,j) = 0. - mudf(i,j) = 0. ! initialize external mode div damp to zero + MUDF(i,j) = 0. ! initialize external mode div damp to zero ENDDO ENDDO @@ -167,28 +227,23 @@ SUBROUTINE small_step_prep( u_1, u_2, v_1, v_2, w_1, w_2, & DO j=j_start, j_end DO i=i_start, i_end - muts(i,j)=mub(i,j)+mu_2(i,j) + MUTS(i,j)=MUB(i,j)+MU_2(i,j) ENDDO DO i=i_start, i_endu -! rk_step==1, WCS fix for tiling -! muus(i,j)=0.5*(mub(i,j)+mu_2(i,j)+mub(i-1,j)+mu_2(i-1,j)) - muus(i,j) = muu(i,j) + MUUS(i,j) = MUU(i,j) ENDDO ENDDO DO j=j_start, j_endv DO i=i_start, i_end -! rk_step==1, WCS fix for tiling -! muvs(i,j)=0.5*(mub(i,j)+mu_2(i,j)+mub(i,j-1)+mu_2(i,j-1)) - muvs(i,j) = muv(i,j) + MUVS(i,j) = MUV(i,j) ENDDO ENDDO DO j=j_start, j_end DO i=i_start, i_end - mu_save(i,j)=mu_2(i,j) - mu_2(i,j)=0. -! mu_2(i,j)=mu_2(i,j)-mu_2(i,j) + MU_SAVE(i,j)=MU_2(i,j) + MU_2(i,j)=0. ENDDO ENDDO @@ -196,23 +251,23 @@ SUBROUTINE small_step_prep( u_1, u_2, v_1, v_2, w_1, w_2, & DO j=j_start, j_end DO i=i_start, i_end - muts(i,j)=mub(i,j)+mu_1(i,j) + MUTS(i,j)=MUB(i,j)+MU_1(i,j) ENDDO DO i=i_start, i_endu - muus(i,j)=0.5*(mub(i,j)+mu_1(i,j)+mub(i-1,j)+mu_1(i-1,j)) + MUUS(i,j)=0.5*(MUB(i,j)+MU_1(i,j)+MUB(i-1,j)+MU_1(i-1,j)) ENDDO ENDDO DO j=j_start, j_endv DO i=i_start, i_end - muvs(i,j)=0.5*(mub(i,j)+mu_1(i,j)+mub(i,j-1)+mu_1(i,j-1)) + MUVS(i,j)=0.5*(MUB(i,j)+MU_1(i,j)+MUB(i,j-1)+MU_1(i,j-1)) ENDDO ENDDO DO j=j_start, j_end DO i=i_start, i_end - mu_save(i,j)=mu_2(i,j) - mu_2(i,j)=mu_1(i,j)-mu_2(i,j) + MU_SAVE(i,j)=MU_2(i,j) + MU_2(i,j)=MU_1(i,j)-MU_2(i,j) ENDDO ENDDO @@ -297,6 +352,8 @@ SUBROUTINE small_step_finish( u_2, u_1, v_2, v_1, w_2, w_1, & t_2, t_1, ph_2, ph_1, ww, ww1, & mu_2, mu_1, & mut, muts, muu, muus, muv, muvs, & + c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f, & u_save, v_save, w_save, & t_save, ph_save, mu_save, & msfux, msfuy, msfvx, msfvy, & @@ -349,6 +406,9 @@ SUBROUTINE small_step_finish( u_2, u_1, v_2, v_1, w_2, w_1, & msfvx, msfvy, & msftx, msfty + REAL, DIMENSION( kms:kme ),INTENT(IN ) :: c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f + ! local stuff @@ -443,7 +503,10 @@ END SUBROUTINE small_step_finish SUBROUTINE calc_p_rho( al, p, ph, & alt, t_2, t_1, c2a, pm1, & - mu, muts, znu, t0, & + mu, muts, & + c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f, & + znu, t0, & rdnw, dnw, smdiv, & non_hydrostatic, step, & ids, ide, jds, jde, kds, kde, & @@ -479,6 +542,9 @@ SUBROUTINE calc_p_rho( al, p, ph, & REAL, INTENT(IN ) :: t0, smdiv + REAL, DIMENSION( kms:kme ),INTENT(IN ) :: c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f + LOGICAL, INTENT(IN ) :: non_hydrostatic ! local variables @@ -536,7 +602,11 @@ SUBROUTINE calc_p_rho( al, p, ph, & DO j=j_start, j_end DO k=k_start, k_end DO i=i_start, i_end +#if ! ( HYBRID_COORD==1 ) p(i,k,j)=mu(i,j)*znu(k) +#else + p(i,k,j)=MU(i,j)*c3h(k) +#endif al(i,k,j)=alt(i,k,j)*(t_2(i,k,j)-mu(i,j)*t_1(i,k,j)) & /(muts(i,j)*(t0+t_1(i,k,j)))-p(i,k,j)/c2a(i,k,j) ph(i,k+1,j)=ph(i,k,j)-dnw(k)*(muts(i,j)*al (i,k,j) & @@ -574,7 +644,10 @@ END SUBROUTINE calc_p_rho !---------------------------------------------------------------------- SUBROUTINE calc_coef_w( a,alpha,gamma, & - mut, cqw, & + mut, & + c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f, & + cqw, & rdn, rdnw, c2a, & dts, g, epssm, top_lid, & ids,ide, jds,jde, kds,kde, & ! domain dims @@ -607,12 +680,16 @@ SUBROUTINE calc_coef_w( a,alpha,gamma, & dts, & g + REAL, DIMENSION( kms:kme ),INTENT(IN ) :: c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f + ! Local stack data. REAL, DIMENSION(ims:ime) :: cof REAL :: b, c + REAL :: muthmutf_kk, muthmutf_km1k, muthmutf_kkp1 - INTEGER :: i, j, k, i_start, i_end, j_start, j_end, k_start, k_end + INTEGER :: i, j, k, kk, i_start, i_end, j_start, j_end, k_start, k_end INTEGER :: ij, ijp, ijm, lid_flag ! @@ -635,32 +712,49 @@ SUBROUTINE calc_coef_w( a,alpha,gamma, & outer_j_loop: DO j = j_start, j_end + k = kde-1 DO i = i_start, i_end - cof(i) = (.5*dts*g*(1.+epssm)/mut(i,j))**2 + cof(i) = (.5*dts*g*(1.+epssm))**2 a(i, 2 ,j) = 0. - a(i,kde,j) =-2.*cof(i)*rdnw(kde-1)**2*c2a(i,kde-1,j)*lid_flag +#if ! ( HYBRID_COORD ) + MUTHMUTF_KK = mut(i,j)*mut(i,j) +#endif + a(i,kde,j) =-2.*cof(i)*rdnw(kde-1)**2*c2a(i,kde-1,j)*lid_flag/MUTHMUTF_KK gamma(i,1 ,j) = 0. ENDDO - DO k=3,kde-1 + DO kk=3,kde-1 + k=kk-1 DO i=i_start, i_end - a(i,k,j) = -cqw(i,k,j)*cof(i)*rdn(k)* rdnw(k-1)*c2a(i,k-1,j) +#if ! ( HYBRID_COORD ) + MUTHMUTF_KK = mut(i,j)*mut(i,j) +#endif + a(i,kk,j) = -cqw(i,kk,j)*cof(i)*rdn(kk)* rdnw(kk-1)*c2a(i,kk-1,j)/MUTHMUTF_KK ENDDO ENDDO DO k=2,kde-1 DO i=i_start, i_end - b = 1.+cqw(i,k,j)*cof(i)*rdn(k)*(rdnw(k )*c2a(i,k,j ) & - +rdnw(k-1)*c2a(i,k-1,j)) - c = -cqw(i,k,j)*cof(i)*rdn(k)*rdnw(k )*c2a(i,k,j ) +#if ! ( HYBRID_COORD ) + MUTHMUTF_KK = mut(i,j)*mut(i,j) + MUTHMUTF_KM1K = mut(i,j)*mut(i,j) + MUTHMUTF_KKP1 = mut(i,j)*mut(i,j) +#endif + b = 1.+cqw(i,k,j)*cof(i)*rdn(k)*(rdnw(k )*c2a(i,k, j)/MUTHMUTF_KK & + +rdnw(k-1)*c2a(i,k-1,j)/MUTHMUTF_KM1K ) + c = -cqw(i,k,j)*cof(i)*rdn(k)*rdnw(k )*c2a(i,k,j )/MUTHMUTF_KKP1 alpha(i,k,j) = 1./(b-a(i,k,j)*gamma(i,k-1,j)) gamma(i,k,j) = c*alpha(i,k,j) ENDDO ENDDO + k=kde DO i=i_start, i_end - b = 1.+2.*cof(i)*rdnw(kde-1)**2*c2a(i,kde-1,j) +#if ! ( HYBRID_COORD ) + MUTHMUTF_KM1K = mut(i,j)*mut(i,j) +#endif + b = 1.+2.*cof(i)*rdnw(kde-1)**2*c2a(i,kde-1,j)/MUTHMUTF_KM1K c = 0. alpha(i,kde,j) = 1./(b-a(i,kde,j)*gamma(i,kde-1,j)) gamma(i,kde,j) = c*alpha(i,kde,j) @@ -676,6 +770,8 @@ SUBROUTINE advance_uv ( u, ru_tend, v, rv_tend, & p, pb, & ph, php, alt, al, mu, & muu, cqu, muv, cqv, mudf, & + c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f, & msfux, msfuy, msfvx, & msfvx_inv, msfvy, & rdx, rdy, dts, & @@ -744,6 +840,9 @@ SUBROUTINE advance_uv ( u, ru_tend, v, rv_tend, & cf2, & cf3, & emdiv + + REAL, DIMENSION( kms:kme ),INTENT(IN ) :: c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f ! Local 3d array from the stack (note tile size) @@ -861,7 +960,7 @@ SUBROUTINE advance_uv ( u, ru_tend, v, rv_tend, & ENDDO DO i = i_start_up, i_end_up - mudf_xy(i)= -emdiv*dx*(mudf(i,j)-mudf(i-1,j))/msfuy(i,j) + MUDF_XY(i)= -emdiv*dx*(MUDF(i,j)-MUDF(i-1,j))/msfuy(i,j) ENDDO DO k = k_start, k_end @@ -950,7 +1049,7 @@ SUBROUTINE advance_uv ( u, ru_tend, v, rv_tend, & ENDDO DO i = i_start, i_end - mudf_xy(i)= -emdiv*dy*(mudf(i,j)-mudf(i,j-1))*msfvx_inv(i,j) + MUDF_XY(i)= -emdiv*dy*(MUDF(i,j)-MUDF(i,j-1))*msfvx_inv(i,j) ENDDO IF ( ( j >= j_start_vp) & @@ -1060,8 +1159,10 @@ END SUBROUTINE advance_uv !--------------------------------------------------------------------- SUBROUTINE advance_mu_t( ww, ww_1, u, u_1, v, v_1, & - mu, mut, muave, muts, muu, muv, & - mudf, uam, vam, wwam, t, t_1, & + mu, mut, muave, muts, muu, muv, mudf,& + c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f, & + uam, vam, wwam, t, t_1, & t_ave, ft, mu_tend, & rdx, rdy, dts, epssm, & dnw, fnm, fnp, rdnw, & @@ -1132,12 +1233,15 @@ SUBROUTINE advance_mu_t( ww, ww_1, u, u_1, v, v_1, & dts, & epssm + REAL, DIMENSION( kms:kme ),INTENT(IN ) :: c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f + ! Local arrays from the stack (note tile size) REAL, DIMENSION (its:ite, kts:kte) :: wdtn, dvdxi REAL, DIMENSION (its:ite) :: dmdt - INTEGER :: i,j,k, i_start, i_end, j_start, j_end, k_start, k_end + INTEGER :: i, j, k, kk, i_start, i_end, j_start, j_end, k_start, k_end INTEGER :: i_endu, j_endv REAL :: acc @@ -1176,7 +1280,7 @@ SUBROUTINE advance_mu_t( ww, ww_1, u, u_1, v, v_1, & DO j = j_start, j_end DO i=i_start, i_end - dmdt(i) = 0. + DMDT(i) = 0. ENDDO ! NOTE: mu is not coupled with the map scale factor. ! ww (omega) IS coupled with the map scale factor. @@ -1208,20 +1312,21 @@ SUBROUTINE advance_mu_t( ww, ww_1, u, u_1, v, v_1, & -(v(i,k,j )+muv(i,j )*v_1(i,k,j )*msfvx_inv(i,j )) ) & +rdx*( (u(i+1,k,j)+muu(i+1,j)*u_1(i+1,k,j)/msfuy(i+1,j)) & -(u(i,k,j )+muu(i ,j)*u_1(i,k,j )/msfuy(i ,j)) )) - dmdt(i) = dmdt(i) + dnw(k)*dvdxi(i,k) + DMDT(i) = DMDT(i) + dnw(k)*dvdxi(i,k) ENDDO ENDDO DO i=i_start, i_end - muave(i,j) = mu(i,j) - mu(i,j) = mu(i,j)+dts*(dmdt(i)+mu_tend(i,j)) - mudf(i,j) = (dmdt(i)+mu_tend(i,j)) ! save tendency for div damp filter - muts(i,j) = mut(i,j)+mu(i,j) - muave(i,j) =.5*((1.+epssm)*mu(i,j)+(1.-epssm)*muave(i,j)) + MUAVE(i,j) = MU(i,j) + MU(i,j) = MU(i,j)+dts*(DMDT(i)+MU_TEND(i,j)) + MUDF(i,j) = (DMDT(i)+MU_TEND(i,j)) ! save tendency for div damp filter + MUTS(i,j) = MUT(i,j)+MU(i,j) + MUAVE(i,j) =.5*((1.+epssm)*MU(i,j)+(1.-epssm)*MUAVE(i,j)) ENDDO - DO k=2,k_end + DO kk=2,k_end + k=kk-1 DO i=i_start, i_end - ww(i,k,j)=ww(i,k-1,j)-dnw(k-1)*(dmdt(i)+dvdxi(i,k-1)+mu_tend(i,j))/msfty(i,j) + ww(i,kk,j)=ww(i,kk-1,j)-dnw(kk-1)*(dmdt(i)+dvdxi(i,kk-1)+mu_tend(i,j))/msfty(i,j) ENDDO END DO @@ -1306,6 +1411,8 @@ END SUBROUTINE advance_mu_t SUBROUTINE advance_w( w, rw_tend, ww, w_save, u, v, & mu1, mut, muave, muts, & + c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f, & t_2ave, t_2, t_1, & ph, ph_1, phb, ph_tend, & ht, c2a, cqw, alt, alb, & @@ -1386,6 +1493,9 @@ SUBROUTINE advance_w( w, rw_tend, ww, w_save, u, v, & t0, & epssm + REAL, DIMENSION( kms:kme ),INTENT(IN ) :: c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f + ! Stack based 3d data, tile size. REAL, DIMENSION( its:ite ) :: mut_inv, msft_inv @@ -1394,6 +1504,7 @@ SUBROUTINE advance_w( w, rw_tend, ww, w_save, u, v, & REAL, DIMENSION (kts:kte) :: dampwt real :: htop,hbot,hdepth,hk real :: pi,dampmag + REAL :: muthk, muthkm1 ! ! @@ -1453,7 +1564,6 @@ SUBROUTINE advance_w( w, rw_tend, ww, w_save, u, v, & j_loop_w: DO j = j_start, j_end DO i=i_start, i_end - mut_inv(i) = 1./mut(i,j) msft_inv(i) = 1./msfty(i,j) ENDDO @@ -1461,8 +1571,8 @@ SUBROUTINE advance_w( w, rw_tend, ww, w_save, u, v, & DO i=i_start, i_end t_2ave(i,k,j)=.5*((1.+epssm)*t_2(i,k,j) & +(1.-epssm)*t_2ave(i,k,j)) - t_2ave(i,k,j)=(t_2ave(i,k,j) + muave(i,j)*t0) & - /(muts(i,j)*(t0+t_1(i,k,j))) + t_2ave(i,k,j)=(t_2ave(i,k,j) + Muave(i,j)*t0) & + /(Muts(i,j)*(t0+t_1(i,k,j))) wdwn(i,k+1)=.5*(ww(i,k+1,j)+ww(i,k,j))*rdnw(k) & *(ph_1(i,k+1,j)-ph_1(i,k,j)+phb(i,k+1,j)-phb(i,k,j)) rhs(i,k+1) = dts*(ph_tend(i,k+1,j) + .5*g*(1.-epssm)*w(i,k+1,j)) @@ -1492,7 +1602,7 @@ SUBROUTINE advance_w( w, rw_tend, ww, w_save, u, v, & ! partial d phi/dz] DO k=2,k_end+1 DO i=i_start, i_end - rhs(i,k) = ph(i,k,j) + msfty(i,j)*rhs(i,k)*mut_inv(i) + rhs(i,k) = ph(i,k,j) + msfty(i,j)*rhs(i,k)/mut(i,j) if(top_lid .and. k.eq.k_end+1)rhs(i,k)=0. ENDDO ENDDO @@ -1534,13 +1644,18 @@ SUBROUTINE advance_w( w, rw_tend, ww, w_save, u, v, & ! above surface, begin by adding delta t * previous (coupled) w tendency DO k=2,k_end DO i=i_start, i_end +#if ! ( HYBRID_COORD==1 ) + MUTHK = mut(i,j) + MUTHKM1 = mut(i,j) +#endif + w(i,k,j)=w(i,k,j)+dts*rw_tend(i,k,j) & + msft_inv(i)*cqw(i,k,j)*( & - +.5*dts*g*mut_inv(i)*rdn(k)* & - (c2a(i,k ,j)*rdnw(k ) & + +.5*dts*g*rdn(k)* & + (c2a(i,k ,j)*rdnw(k )/MUTHK & *((1.+epssm)*(rhs(i,k+1 )-rhs(i,k )) & +(1.-epssm)*(ph(i,k+1,j)-ph(i,k ,j))) & - -c2a(i,k-1,j)*rdnw(k-1) & + -c2a(i,k-1,j)*rdnw(k-1)/MUTHKM1 & *((1.+epssm)*(rhs(i,k )-rhs(i,k-1 )) & +(1.-epssm)*(ph(i,k ,j)-ph(i,k-1,j))))) & @@ -1554,9 +1669,12 @@ SUBROUTINE advance_w( w, rw_tend, ww, w_save, u, v, & K=k_end+1 DO i=i_start, i_end +#if ! ( HYBRID_COORD==1 ) + MUTHKM1 = mut(i,j) +#endif w(i,k,j)=w(i,k,j)+dts*rw_tend(i,k,j) & +msft_inv(i)*( & - -.5*dts*g*mut_inv(i)*rdnw(k-1)**2*2.*c2a(i,k-1,j) & + -.5*dts*g/MUTHKM1*rdnw(k-1)**2*2.*c2a(i,k-1,j) & *((1.+epssm)*(rhs(i,k )-rhs(i,k-1 )) & +(1.-epssm)*(ph(i,k,j)-ph(i,k-1,j))) & -dts*g*(2.*rdnw(k-1)* & @@ -1608,6 +1726,8 @@ END SUBROUTINE advance_w SUBROUTINE sumflux ( ru, rv, ww, & u_lin, v_lin, ww_lin, & muu, muv, & + c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f, & ru_m, rv_m, ww_m, epssm, & msfux, msfuy, msfvx, msfvx_inv, msfvy, & iteration , number_of_small_timesteps, & @@ -1641,6 +1761,9 @@ SUBROUTINE sumflux ( ru, rv, ww, & msfux, msfuy, & msfvx, msfvy, msfvx_inv + REAL, DIMENSION( kms:kme ),INTENT(IN ) :: c1h, c2h, c1f, c2f, & + c3h, c4h, c3f, c4f + INTEGER :: mini, minj, mink diff --git a/dyn_em/nest_init_utils.F b/dyn_em/nest_init_utils.F index 774b630ab3..43d0835ee5 100644 --- a/dyn_em/nest_init_utils.F +++ b/dyn_em/nest_init_utils.F @@ -1,3 +1,7 @@ +! careful adding any HYBRID_COORD stuff in here, adjust_tempqv has +! c3 and c4 to compute pressure with two reference pressures + + SUBROUTINE init_domain_constants_em ( parent , nest ) USE module_domain, ONLY : domain IMPLICIT NONE @@ -113,6 +117,14 @@ SUBROUTINE init_domain_constants_em ( parent , nest ) nest%z_base = parent%z_base nest%dzs = parent%dzs nest%zs = parent%zs + nest%c1h = parent%c1h + nest%c2h = parent%c2h + nest%c3h = parent%c3h + nest%c4h = parent%c4h + nest%c1f = parent%c1f + nest%c2f = parent%c2f + nest%c3f = parent%c3f + nest%c4f = parent%c4f END SUBROUTINE init_domain_constants_em @@ -755,7 +767,7 @@ SUBROUTINE copy_3d_field ( ter_interpolated , ter_input , & END SUBROUTINE copy_3d_field -SUBROUTINE adjust_tempqv ( mub, save_mub, znw, p_top, & +SUBROUTINE adjust_tempqv ( mub, save_mub, c3, c4, znw, p_top, & th, pp, qv, & ids , ide , jds , jde , kds , kde , & ims , ime , jms , jme , kms , kme , & @@ -777,6 +789,7 @@ SUBROUTINE adjust_tempqv ( mub, save_mub, znw, p_top, & ips , ipe , jps , jpe , kps , kpe REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN) :: mub, save_mub REAL , DIMENSION(kms:kme) , INTENT(IN) :: znw + REAL , DIMENSION(kms:kme) , INTENT(IN) :: c3, c4 REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(INOUT) :: th, pp, qv REAL , DIMENSION(ims:ime,kms:kme,jms:jme) :: p_old, p_new, rh @@ -791,7 +804,11 @@ SUBROUTINE adjust_tempqv ( mub, save_mub, znw, p_top, & DO j = jps , MIN(jpe, jde-1) DO k = kps , kpe-1 DO i = ips , MIN(ipe, ide-1) +#if !( HYBRID_COORD==1 ) p_old(i,k,j) = 0.5*(znw(k+1)+znw(k))*save_mub(i,j) + p_top + pp(i,k,j) +#elif ( HYBRID_COORD==1 ) + p_old(i,k,j) = c4(k) + c3(k)*save_mub(i,j) + p_top + pp(i,k,j) +#endif tc = (th(i,k,j)+300.)*(p_old(i,k,j)/1.e5)**(2./7.) - 273.15 es = 610.78*exp(17.0809*tc/(234.175+tc)) e = qv(i,k,j)*p_old(i,k,j)/(0.622+qv(i,k,j)) @@ -804,7 +821,11 @@ SUBROUTINE adjust_tempqv ( mub, save_mub, znw, p_top, & DO j = jps , MIN(jpe, jde-1) DO k = kps , kpe-1 DO i = ips , MIN(ipe, ide-1) +#if !( HYBRID_COORD==1 ) p_new(i,k,j) = 0.5*(znw(k+1)+znw(k))*mub(i,j) + p_top + pp(i,k,j) +#elif ( HYBRID_COORD==1 ) + p_new(i,k,j) = c4(k) + c3(k)*mub(i,j) + p_top + pp(i,k,j) +#endif ! 2*(g/cp-6.5e-3)*R_dry/g = -191.86e-3 dth1 = -191.86e-3*(th(i,k,j)+300.)/(p_new(i,k,j)+p_old(i,k,j))*(p_new(i,k,j)-p_old(i,k,j)) dth = -191.86e-3*(th(i,k,j)+0.5*dth1+300.)/(p_new(i,k,j)+p_old(i,k,j))*(p_new(i,k,j)-p_old(i,k,j)) diff --git a/dyn_em/solve_em.F b/dyn_em/solve_em.F index 4f65027504..0dc314edd9 100644 --- a/dyn_em/solve_em.F +++ b/dyn_em/solve_em.F @@ -169,7 +169,7 @@ SUBROUTINE solve_em ( grid , config_flags & LOGICAL :: fill_w_flag ! variables for flux-averaging code 20091223 - CHARACTER*256 :: message, message2 + CHARACTER*256 :: message, message2, message3 REAL :: old_dt TYPE(WRFU_Time) :: temp_time, CurrTime, restart_time INTEGER, PARAMETER :: precision = 100 @@ -582,7 +582,7 @@ SUBROUTINE solve_em ( grid , config_flags & 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%c1h, grid%c2h, grid%c1f, grid%c2f, 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, & @@ -846,6 +846,7 @@ SUBROUTINE solve_em ( grid , config_flags & ,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%c1h, grid%c2h, grid%c1f, grid%c2f & ,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 & @@ -928,7 +929,7 @@ SUBROUTINE solve_em ( grid , config_flags & CALL relax_bdy_dry ( config_flags, & grid%u_save, grid%v_save, ph_save, grid%t_save, & - w_save, mu_tend, & + w_save, mu_tend, grid%c1h, grid%c2h, grid%c1f, grid%c2f, & 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, & @@ -958,7 +959,8 @@ SUBROUTINE solve_em ( grid , config_flags & 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%c1h, grid%c2h, & + 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, & @@ -1032,7 +1034,7 @@ SUBROUTINE solve_em ( grid , config_flags & IF( config_flags%specified .and. config_flags%perturb_bdy==1 ) THEN CALL spec_bdy_dry_perturb ( config_flags, & grid%ru_tend, grid%rv_tend, t_tend, & - grid%mu_2, grid%mub, & + grid%mu_2, grid%mub, grid%c1h, grid%c2h, & grid%msfux, grid%msfvx, grid%msft, & grid%ru_tendf_stoch, grid%rv_tendf_stoch, grid%rt_tendf_stoch, & config_flags%spec_bdy_width, grid%spec_zone, & @@ -1049,7 +1051,7 @@ SUBROUTINE solve_em ( grid , config_flags & IF( config_flags%specified .and. config_flags%perturb_bdy==2 ) THEN CALL spec_bdy_dry_perturb ( config_flags, & grid%ru_tend, grid%rv_tend, t_tend, & - grid%mu_2, grid%mub, & + grid%mu_2, grid%mub, grid%c1h, grid%c2h, & grid%msfux, grid%msfvx, grid%msft, & grid%field_u_tend_perturb, grid%field_v_tend_perturb, grid%field_t_tend_perturb, & config_flags%spec_bdy_width, grid%spec_zone, & @@ -1109,6 +1111,8 @@ SUBROUTINE solve_em ( grid , config_flags & grid%mub, grid%mu_1, grid%mu_2, & grid%muu, muus, grid%muv, muvs, & grid%mut, grid%muts, grid%mudf, & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & + grid%c3h, grid%c4h, grid%c3f, grid%c4f, & grid%u_save, grid%v_save, w_save, & grid%t_save, ph_save, mu_save, & grid%ww, ww1, & @@ -1124,7 +1128,10 @@ SUBROUTINE solve_em ( grid , config_flags & 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%mu_2, grid%muts, & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & + grid%c3h, grid%c4h, grid%c3f, grid%c4f, & + grid%znu, t0, & grid%rdnw, grid%dnw, grid%smdiv, & config_flags%non_hydrostatic, 0, & ids, ide, jds, jde, kds, kde, & @@ -1135,8 +1142,10 @@ SUBROUTINE solve_em ( grid , config_flags & IF (config_flags%non_hydrostatic) THEN CALL calc_coef_w( a,alpha,gamma, & - grid%mut, cqw, & - grid%rdn, grid%rdnw, c2a, & + grid%mut, & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & + grid%c3h, grid%c4h, grid%c3f, grid%c4f, & + cqw, grid%rdn, grid%rdnw, c2a, & dts_rk, g, grid%epssm, & config_flags%top_lid, & ids, ide, jds, jde, kds, kde, & @@ -1290,8 +1299,9 @@ SUBROUTINE solve_em ( grid , config_flags & 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%mu_2, grid%muu, cqu, grid%muv, cqv, grid%mudf, & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & + grid%c3h, grid%c4h, grid%c3f, grid%c4f, & grid%msfux, grid%msfuy, grid%msfvx, & grid%msfvx_inv, grid%msfvy, & grid%rdx, grid%rdy, dts_rk, & @@ -1401,7 +1411,10 @@ SUBROUTINE solve_em ( grid , config_flags & 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%mudf, & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & + grid%c3h, grid%c4h, grid%c3f, grid%c4f, & + 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, & @@ -1506,6 +1519,8 @@ SUBROUTINE solve_em ( grid , config_flags & 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, & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & + grid%c3h, grid%c4h, grid%c3f, grid%c4f, & 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, & @@ -1571,6 +1586,8 @@ SUBROUTINE solve_em ( grid , config_flags & CALL sumflux ( grid%u_2, grid%v_2, grid%ww, & grid%u_save, grid%v_save, ww1, & grid%muu, grid%muv, & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & + grid%c3h, grid%c4h, grid%c3f, grid%c4f, & grid%ru_m, grid%rv_m, grid%ww_m, grid%epssm, & grid%msfux, grid% msfuy, grid%msfvx, & grid%msfvx_inv, grid%msfvy, & @@ -1587,7 +1604,8 @@ SUBROUTINE solve_em ( grid , config_flags & 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, & + mu_tend, grid%muts, & + grid%c1f, grid%c2f, dts_rk, & 'h' , config_flags, & grid%spec_zone, & ids,ide, jds,jde, kds,kde, & @@ -1624,7 +1642,10 @@ SUBROUTINE solve_em ( grid , config_flags & 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%mu_2, grid%muts, & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & + grid%c3h, grid%c4h, grid%c3f, grid%c4f, & + grid%znu, t0, & grid%rdnw, grid%dnw, grid%smdiv, & config_flags%non_hydrostatic, iteration, & ids, ide, jds, jde, kds, kde, & @@ -1741,6 +1762,8 @@ SUBROUTINE solve_em ( grid , config_flags & 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%c1h, grid%c2h, grid%c1f, grid%c2f, & + grid%c3h, grid%c4h, grid%c3f, grid%c4f, & 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, & @@ -1855,6 +1878,7 @@ SUBROUTINE solve_em ( grid , config_flags & CALL rk_update_scalar_pd( im, im, & moist_old(ims,kms,jms,im), & moist_tend(ims,kms,jms,im), & + grid%c1h, grid%c2h, & grid%mu_1, grid%mu_1, grid%mub, & rk_step, dt_rk, grid%spec_zone, & config_flags, & @@ -1917,6 +1941,7 @@ SUBROUTINE solve_em ( grid , config_flags & CALL rk_update_scalar_pd( im, im, & scalar_old(ims,kms,jms,im), & scalar_tend(ims,kms,jms,im), & + grid%c1h, grid%c2h, & grid%mu_1, grid%mu_1, grid%mub, & rk_step, dt_rk, grid%spec_zone, & config_flags, & @@ -1983,6 +2008,7 @@ SUBROUTINE solve_em ( grid , config_flags & CALL rk_update_scalar_pd( im, im, & chem_old(ims,kms,jms,im), & chem_tend(ims,kms,jms,im), & + grid%c1h, grid%c2h, & grid%mu_1, grid%mu_1, grid%mub, & rk_step, dt_rk, grid%spec_zone, & config_flags, & @@ -2044,6 +2070,7 @@ SUBROUTINE solve_em ( grid , config_flags & CALL rk_update_scalar_pd( im, im, & tracer_old(ims,kms,jms,im), & tracer_tend(ims,kms,jms,im), & + grid%c1h, grid%c2h, & grid%mu_1, grid%mu_1, grid%mub, & rk_step, dt_rk, grid%spec_zone, & config_flags, & @@ -2105,6 +2132,7 @@ SUBROUTINE solve_em ( grid , config_flags & CALL rk_update_scalar_pd( 1, 1, & grid%tke_1, & tke_tend(ims,kms,jms), & + grid%c1h, grid%c2h, & grid%mu_1, grid%mu_1, grid%mub, & rk_step, dt_rk, grid%spec_zone, & config_flags, & @@ -2208,6 +2236,7 @@ SUBROUTINE solve_em ( grid , config_flags & rk_step, dt_rk, & grid%ru_m, grid%rv_m, grid%ww_m, & grid%muts, grid%mub, grid%mu_1, & + grid%c1h, grid%c2h, & grid%alt, & moist_old(ims,kms,jms,im), & moist(ims,kms,jms,im), & @@ -2230,6 +2259,7 @@ SUBROUTINE solve_em ( grid , config_flags & IF( im.eq.p_qv .or. im.eq.p_qc )THEN CALL q_diabatic_add ( im, im, & dt_rk, grid%mut, & + grid%c1h, grid%c2h, & grid%qv_diabatic, & grid%qc_diabatic, & moist_tend(ims,kms,jms,im), & @@ -2249,6 +2279,7 @@ SUBROUTINE solve_em ( grid , config_flags & ( config_flags%specified .AND. config_flags%have_bcs_moist ) ) THEN CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im), & moist(ims,kms,jms,im), grid%mut, & + grid%c1h, grid%c2h, & 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), & @@ -2298,6 +2329,7 @@ SUBROUTINE solve_em ( grid , config_flags & advect_tend=advect_tend, & h_tendency=h_tendency, z_tendency=z_tendency, & msftx=grid%msftx,msfty=grid%msfty, & + c1=grid%c1h, c2=grid%c2h, & mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, & rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, & config_flags=config_flags, tenddec=tenddec, & @@ -2369,6 +2401,7 @@ SUBROUTINE solve_em ( grid , config_flags & rk_step, dt_rk, & grid%ru_m, grid%rv_m, grid%ww_m, & grid%muts, grid%mub, grid%mu_1, & + grid%c1h, grid%c2h, & grid%alt, & grid%tke_1, & grid%tke_2, & @@ -2403,6 +2436,7 @@ SUBROUTINE solve_em ( grid , config_flags & advect_tend=advect_tend, & h_tendency=h_tendency, z_tendency=z_tendency, & msftx=grid%msftx,msfty=grid%msfty, & + c1=grid%c1h, c2=grid%c2h, & mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, & rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, & config_flags=config_flags, tenddec=tenddec, & @@ -2456,6 +2490,7 @@ SUBROUTINE solve_em ( grid , config_flags & rk_step, dt_rk, & grid%ru_m, grid%rv_m, grid%ww_m, & grid%muts, grid%mub, grid%mu_1, & + grid%c1h, grid%c2h, & grid%alt, & chem_old(ims,kms,jms,ic), & chem(ims,kms,jms,ic), & @@ -2483,6 +2518,7 @@ SUBROUTINE solve_em ( grid , config_flags & 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, & + grid%c1h, grid%c2h, & 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), & @@ -2531,6 +2567,7 @@ SUBROUTINE solve_em ( grid , config_flags & advect_tend=advect_tend, & h_tendency=h_tendency, z_tendency=z_tendency, & msftx=grid%msftx,msfty=grid%msfty, & + c1=grid%c1h, c2=grid%c2h, & mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, & rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, & config_flags=config_flags, tenddec=tenddec, & @@ -2602,10 +2639,11 @@ SUBROUTINE solve_em ( grid , config_flags & rk_step, dt_rk, & grid%ru_m, grid%rv_m, grid%ww_m, & grid%muts, grid%mub, grid%mu_1, & + grid%c1h, grid%c2h, & grid%alt, & - tracer_old(ims,kms,jms,ic), & - tracer(ims,kms,jms,ic), & - tracer_tend(ims,kms,jms,ic), & + tracer_old(ims,kms,jms,ic), & + tracer(ims,kms,jms,ic), & + tracer_tend(ims,kms,jms,ic), & advect_tend,h_tendency,z_tendency,grid%rqvften, & grid%qv_base, .false., grid%fnm, grid%fnp, & grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, & @@ -2629,6 +2667,7 @@ SUBROUTINE solve_em ( grid , config_flags & IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_tracer' ) CALL relax_bdy_scalar ( tracer_tend(ims,kms,jms,ic), & tracer(ims,kms,jms,ic), grid%mut, & + grid%c1h, grid%c2h, & tracer_bxs(jms,kms,1,ic),tracer_bxe(jms,kms,1,ic), & tracer_bys(ims,kms,1,ic),tracer_bye(ims,kms,1,ic), & tracer_btxs(jms,kms,1,ic),tracer_btxe(jms,kms,1,ic), & @@ -2676,6 +2715,7 @@ SUBROUTINE solve_em ( grid , config_flags & advect_tend=advect_tend, & h_tendency=h_tendency, z_tendency=z_tendency, & msftx=grid%msftx,msfty=grid%msfty, & + c1=grid%c1h, c2=grid%c2h, & mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, & rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, & config_flags=config_flags, tenddec=tenddec, & @@ -2737,6 +2777,7 @@ SUBROUTINE solve_em ( grid , config_flags & rk_step, dt_rk, & grid%ru_m, grid%rv_m, grid%ww_m, & grid%muts, grid%mub, grid%mu_1, & + grid%c1h, grid%c2h, & grid%alt, & scalar_old(ims,kms,jms,is), & scalar(ims,kms,jms,is), & @@ -2762,6 +2803,7 @@ SUBROUTINE solve_em ( grid , config_flags & CALL relax_bdy_scalar ( scalar_tend(ims,kms,jms,is), & scalar(ims,kms,jms,is), grid%mut, & + grid%c1h, grid%c2h, & 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), & @@ -2811,6 +2853,7 @@ SUBROUTINE solve_em ( grid , config_flags & advect_tend=advect_tend, & h_tendency=h_tendency, z_tendency=z_tendency, & msftx=grid%msftx,msfty=grid%msfty, & + c1=grid%c1h, c2=grid%c2h, & mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub, & rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone, & config_flags=config_flags, tenddec=tenddec, & @@ -2924,6 +2967,7 @@ SUBROUTINE solve_em ( grid , config_flags & CALL calc_p_rho_phi( moist, num_3d_m, config_flags%hypsometric_opt, & grid%al, grid%alb, grid%mu_2, grid%muts, & + grid%c1h, grid%c2h, grid%c3h, grid%c4h, grid%c3f, grid%c4f, & grid%ph_2, grid%phb, grid%p, grid%pb, grid%t_2, & p0, t0, grid%p_top, grid%znu, grid%znw, grid%dnw, grid%rdnw, & grid%rdn, config_flags%non_hydrostatic, & @@ -2953,8 +2997,9 @@ SUBROUTINE solve_em ( grid , config_flags & CALL wrf_debug ( 200 , ' call filter moist ' ) DO im = PARAM_FIRST_SCALAR, num_3d_m IF ( config_flags%coupled_filtering ) THEN - CALL couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) & + CALL couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) & ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & ,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 ) @@ -2986,6 +3031,7 @@ SUBROUTINE solve_em ( grid , config_flags & IF ( config_flags%coupled_filtering ) THEN CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) & ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & ,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 ) @@ -2999,6 +3045,7 @@ SUBROUTINE solve_em ( grid , config_flags & IF ( config_flags%coupled_filtering ) THEN CALL couple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) & ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & ,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 ) @@ -3030,6 +3077,7 @@ SUBROUTINE solve_em ( grid , config_flags & IF ( config_flags%coupled_filtering ) THEN CALL uncouple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) & ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & ,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 ) @@ -3042,6 +3090,7 @@ SUBROUTINE solve_em ( grid , config_flags & IF ( config_flags%coupled_filtering ) THEN CALL couple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) & ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & ,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 ) @@ -3073,6 +3122,7 @@ SUBROUTINE solve_em ( grid , config_flags & IF ( config_flags%coupled_filtering ) THEN CALL uncouple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) & ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & ,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 ) @@ -3086,6 +3136,7 @@ SUBROUTINE solve_em ( grid , config_flags & IF ( config_flags%coupled_filtering ) THEN CALL couple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) & ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & ,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 ) @@ -3117,6 +3168,7 @@ SUBROUTINE solve_em ( grid , config_flags & IF ( config_flags%coupled_filtering ) THEN CALL uncouple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) & ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & ,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 ) @@ -3203,8 +3255,9 @@ SUBROUTINE solve_em ( grid , config_flags & 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, & + CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, & + grid%c1f, grid%c2f, 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, & @@ -3419,6 +3472,7 @@ SUBROUTINE solve_em ( grid , config_flags & call trajectory (grid,config_flags, & grid%dt,grid%itimestep,grid%ru_m, grid%rv_m, grid%ww_m,& grid%mut,grid%muu,grid%muv, & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & grid%rdx, grid%rdy, grid%rdn, grid%rdnw,grid%rdzw, & grid%traj_i,grid%traj_j,grid%traj_k, & grid%traj_long,grid%traj_lat, & @@ -3708,7 +3762,7 @@ SUBROUTINE solve_em ( grid , config_flags & & , QVOLG_CURR=scalar(ims,kms,jms,P_QVOLG), F_QVOLG=F_QVOLG & ! for nssl_2mom & , QVOLH_CURR=scalar(ims,kms,jms,P_QVOLH), F_QVOLH=F_QVOLH & ! for nssl_2mom & , qrcuten=grid%rqrcuten, qscuten=grid%rqscuten & - & , qicuten=grid%rqicuten,mu=grid%mut & + & , qicuten=grid%rqicuten,mu=grid%mut,c1=grid%c1h,c2h=grid%c2h & & , HAIL=config_flags%gsfcgce_hail & ! for gsfcgce & , ICE2=config_flags%gsfcgce_2ice & ! for gsfcgce ! & , ccntype=config_flags%milbrandt_ccntype & ! for milbrandt (2mom) @@ -3867,13 +3921,12 @@ SUBROUTINE solve_em ( grid , config_flags & CALL wrf_debug ( 200 , ' call filter moist' ) DO im = PARAM_FIRST_SCALAR, num_3d_m IF ( config_flags%coupled_filtering ) THEN - 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 couple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) & + ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & + ,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 IF CALL pxft ( grid=grid & @@ -3902,13 +3955,12 @@ SUBROUTINE solve_em ( grid , config_flags & ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex ) IF ( config_flags%coupled_filtering ) THEN - 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 uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im) & + ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & + ,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 IF ENDDO ENDIF @@ -3935,6 +3987,7 @@ SUBROUTINE solve_em ( grid , config_flags & CALL calc_p_rho_phi( moist, num_3d_m, config_flags%hypsometric_opt, & grid%al, grid%alb, grid%mu_2, grid%muts, & + grid%c1h, grid%c2h, grid%c3h, grid%c4h, grid%c3f, grid%c4f, & grid%ph_2, grid%phb, grid%p, grid%pb, grid%t_2, & p0, t0, grid%p_top, grid%znu, grid%znw, grid%dnw, grid%rdnw, & grid%rdn, config_flags%non_hydrostatic, & @@ -3955,8 +4008,9 @@ SUBROUTINE solve_em ( grid , config_flags & !$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, & + CALL diagnose_w( ph_tend, grid%ph_2, grid%ph_1, grid%w_2, grid%muts, & + grid%c1f, grid%c2f, 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, & @@ -3980,13 +4034,12 @@ SUBROUTINE solve_em ( grid , config_flags & IF ( num_3d_c >= PARAM_FIRST_SCALAR ) then chem_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_c IF ( config_flags%coupled_filtering ) THEN - 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 couple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) & + ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & + ,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 IF CALL pxft ( grid=grid & @@ -4015,26 +4068,24 @@ SUBROUTINE solve_em ( grid , config_flags & ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex ) IF ( config_flags%coupled_filtering ) THEN - 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 uncouple_scalars_for_filter ( FIELD=chem(ims,kms,jms,im) & + ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & + ,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 IF ENDDO chem_filter_loop ENDIF IF ( num_tracer >= PARAM_FIRST_SCALAR ) then tracer_filter_loop: DO im = PARAM_FIRST_SCALAR, num_tracer IF ( config_flags%coupled_filtering ) THEN - DO jj = jps, MIN(jpe,jde-1) - DO kk = kps, MIN(kpe,kde-1) - DO ii = ips, MIN(ipe,ide-1) - tracer(ii,kk,jj,im)=tracer(ii,kk,jj,im)*(grid%mu_2(ii,jj)+grid%mub(ii,jj)) - ENDDO - ENDDO - ENDDO + CALL couple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) & + ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & + ,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 IF CALL pxft ( grid=grid & @@ -4063,13 +4114,12 @@ SUBROUTINE solve_em ( grid , config_flags & ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex ) IF ( config_flags%coupled_filtering ) THEN - DO jj = jps, MIN(jpe,jde-1) - DO kk = kps, MIN(kpe,kde-1) - DO ii = ips, MIN(ipe,ide-1) - tracer(ii,kk,jj,im)=tracer(ii,kk,jj,im)/(grid%mu_2(ii,jj)+grid%mub(ii,jj)) - ENDDO - ENDDO - ENDDO + CALL uncouple_scalars_for_filter ( FIELD=tracer(ims,kms,jms,im) & + ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & + ,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 IF ENDDO tracer_filter_loop ENDIF @@ -4077,13 +4127,12 @@ SUBROUTINE solve_em ( grid , config_flags & IF ( num_3d_s >= PARAM_FIRST_SCALAR ) then scalar_filter_loop: DO im = PARAM_FIRST_SCALAR, num_3d_s IF ( config_flags%coupled_filtering ) THEN - 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 couple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) & + ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & + ,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 IF CALL pxft ( grid=grid & @@ -4112,13 +4161,12 @@ SUBROUTINE solve_em ( grid , config_flags & ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex ) IF ( config_flags%coupled_filtering ) THEN - 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 uncouple_scalars_for_filter ( FIELD=scalar(ims,kms,jms,im) & + ,MU=grid%mu_2 , MUB=grid%mub & + ,C1=grid%c1h , C2=grid%c2h & + ,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 IF ENDDO scalar_filter_loop ENDIF @@ -4290,7 +4338,7 @@ SUBROUTINE solve_em ( grid , config_flags & CALL wrf_debug ( 200 , ' call spec_bdy_final' ) - CALL spec_bdy_final ( grid%u_2, muus, grid%msfuy, & + CALL spec_bdy_final ( grid%u_2, muus, grid%c1h, grid%c2h, grid%msfuy, & grid%u_bxs, grid%u_bxe, grid%u_bys, grid%u_bye, & grid%u_btxs,grid%u_btxe,grid%u_btys,grid%u_btye, & 'u', config_flags, & @@ -4303,7 +4351,7 @@ SUBROUTINE solve_em ( grid , config_flags & grid%j_start(ij), grid%j_end(ij), & k_start , k_end ) - CALL spec_bdy_final ( grid%v_2, muvs, grid%msfvx, & + CALL spec_bdy_final ( grid%v_2, muvs, grid%c1h, grid%c2h, grid%msfvx, & grid%v_bxs, grid%v_bxe, grid%v_bys, grid%v_bye, & grid%v_btxs,grid%v_btxe,grid%v_btys,grid%v_btye, & 'v', config_flags, & @@ -4317,7 +4365,7 @@ SUBROUTINE solve_em ( grid , config_flags & k_start , k_end ) IF( config_flags%nested) THEN - CALL spec_bdy_final ( grid%w_2, grid%muts, grid%msfty, & + CALL spec_bdy_final ( grid%w_2, grid%muts, grid%c1f, grid%c2f, grid%msfty, & grid%w_bxs, grid%w_bxe, grid%w_bys, grid%w_bye, & grid%w_btxs,grid%w_btxe,grid%w_btys,grid%w_btye, & 'w', config_flags, & @@ -4331,7 +4379,7 @@ SUBROUTINE solve_em ( grid , config_flags & k_start , k_end ) ENDIF - CALL spec_bdy_final ( grid%t_2, grid%muts, grid%msfty, & + CALL spec_bdy_final ( grid%t_2, grid%muts, grid%c1h, grid%c2h, grid%msfty,& grid%t_bxs, grid%t_bxe, grid%t_bys, grid%t_bye, & grid%t_btxs,grid%t_btxe,grid%t_btys,grid%t_btye, & 't', config_flags, & @@ -4344,7 +4392,7 @@ SUBROUTINE solve_em ( grid , config_flags & grid%j_start(ij), grid%j_end(ij), & k_start , k_end ) - CALL spec_bdy_final ( grid%ph_2, grid%muts, grid%msfty, & + CALL spec_bdy_final ( grid%ph_2, grid%muts, grid%c1f, grid%c2f, grid%msfty, & grid%ph_bxs, grid%ph_bxe, grid%ph_bys, grid%ph_bye, & grid%ph_btxs,grid%ph_btxe,grid%ph_btys,grid%ph_btye, & 'h', config_flags, & @@ -4358,7 +4406,7 @@ SUBROUTINE solve_em ( grid , config_flags & k_start , k_end ) IF( config_flags%spec_bdy_final_mu .EQ. 1 ) THEN - CALL spec_bdy_final ( grid%mu_2, grid%muts, grid%msfty, & + CALL spec_bdy_final ( grid%mu_2, grid%muts, grid%c1h, grid%c2h, grid%msfty, & grid%mu_bxs, grid%mu_bxe, grid%mu_bys, grid%mu_bye, & grid%mu_btxs,grid%mu_btxe,grid%mu_btys,grid%mu_btye, & 'm', config_flags, & @@ -4376,7 +4424,8 @@ SUBROUTINE solve_em ( grid , config_flags & IF ( im .EQ. P_QV .OR. config_flags%nested .OR. & ( config_flags%specified .AND. config_flags%have_bcs_moist ) ) THEN - CALL spec_bdy_final ( moist(ims,kms,jms,im), grid%muts, grid%msfty, & + CALL spec_bdy_final ( moist(ims,kms,jms,im), grid%muts, & + grid%c1h, grid%c2h, grid%msfty, & 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), & @@ -4399,7 +4448,8 @@ SUBROUTINE solve_em ( grid , config_flags & chem_species_bdy_loop_3 : DO ic = PARAM_FIRST_SCALAR , num_3d_c IF( ( config_flags%nested ) ) THEN - CALL spec_bdy_final ( chem(ims,kms,jms,ic), grid%muts, grid%msfty, & + CALL spec_bdy_final ( chem(ims,kms,jms,ic), grid%muts, & + grid%c1h, grid%c2h, grid%msfty, & 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), & @@ -4422,7 +4472,8 @@ SUBROUTINE solve_em ( grid , config_flags & tracer_species_bdy_loop_3 : DO im = PARAM_FIRST_SCALAR , num_tracer IF( ( config_flags%nested ) ) THEN - CALL spec_bdy_final ( tracer(ims,kms,jms,im), grid%muts, grid%msfty, & + CALL spec_bdy_final ( tracer(ims,kms,jms,im), grid%muts, & + grid%c1h, grid%c2h, grid%msfty, & tracer_bxs(jms,kms,1,im),tracer_bxe(jms,kms,1,im), & tracer_bys(ims,kms,1,im),tracer_bye(ims,kms,1,im), & tracer_btxs(jms,kms,1,im),tracer_btxe(jms,kms,1,im), & @@ -4443,7 +4494,8 @@ SUBROUTINE solve_em ( grid , config_flags & scalar_species_bdy_loop_3 : DO is = PARAM_FIRST_SCALAR , num_3d_s IF( ( config_flags%nested ) ) THEN - CALL spec_bdy_final ( scalar(ims,kms,jms,is), grid%muts, grid%msfty, & + CALL spec_bdy_final ( scalar(ims,kms,jms,is), grid%muts, & + grid%c1h, grid%c2h, grid%msfty, & 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), & diff --git a/dyn_em/start_em.F b/dyn_em/start_em.F index 3d4a579d5e..336892905c 100644 --- a/dyn_em/start_em.F +++ b/dyn_em/start_em.F @@ -1,3 +1,44 @@ +! sed -e "s/grid%mu/gridmu/g" -e "s/grid%Mu/gridMu/g" start_em.F | cpp -DHYBRID_COORD | sed -e "s/gridmu/grid%mu/g" -e "s/gridMu/grid%Mu/g" >> start_em.next +#if ( HYBRID_COORD==1 ) +# define gridmu_1(...) (grid%c1h(k)*XXPC1HXX(__VA_ARGS__)) +# define XXPC1HXX(...) grid%mu_1(__VA_ARGS__) + +# define gridmu_2(...) (grid%c1h(k)*XXPC2HXX(__VA_ARGS__)) +# define XXPC2HXX(...) grid%mu_2(__VA_ARGS__) + +# define gridmub(...) (grid%c1h(k)*XXPCBHXX(__VA_ARGS__)+grid%c2h(k)) +# define XXPCBHXX(...) grid%mub(__VA_ARGS__) + +# define gridMu_2(...) (grid%c1f(k)*XXPC2FXX(__VA_ARGS__)) +# define XXPC2FXX(...) grid%Mu_2(__VA_ARGS__) + +# define gridMub(...) (grid%c1f(k)*XXPCBFXX(__VA_ARGS__)+grid%c2f(k)) +# define XXPCBFXX(...) grid%Mub(__VA_ARGS__) +#endif + + + + + + + + + + + + + + + + + + + + + + + + !------------------------------------------------------------------- SUBROUTINE start_domain_em ( grid, allowed_to_read & @@ -9,10 +50,12 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & USE module_domain, ONLY : domain, wrfu_timeinterval, get_ijk_from_grid, & domain_setgmtetc USE module_state_description + USE module_driver_constants + USE module_wrf_error USE module_model_constants - USE module_bc, ONLY : boundary_condition_check, set_physical_bc2d - USE module_bc_em - USE module_configure, ONLY : grid_config_rec_type + USE module_bc, ONLY : boundary_condition_check, set_physical_bc2d, set_physical_bc3d, bdyzone + USE module_bc_em, ONLY: lbc_fcx_gcx, set_w_surface + USE module_configure, ONLY : model_to_grid_config_rec, model_config_rec, grid_config_rec_type USE module_tiles, ONLY : set_tiles #ifdef DM_PARALLEL USE module_dm, ONLY : wrf_dm_min_real, wrf_dm_max_real, wrf_dm_maxval, & @@ -563,19 +606,22 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 ) DO k = 1, kte-1 +#if !( HYBRID_COORD==1 ) grid%pb(i,k,j) = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top +#elif ( HYBRID_COORD==1 ) + grid%pb(i,k,j) = grid%c3h(k)*(p_surf - grid%p_top) + grid%c4h(k) + grid%p_top +#endif temp = MAX ( tiso, t00 + A*LOG(grid%pb(i,k,j)/p00) ) IF ( grid%pb(i,k,j) .LT. p_strat ) THEN temp = tiso + A_strat * LOG ( grid%pb(i,k,j)/p_strat ) ENDIF grid%t_init(i,k,j) = temp*(p00/grid%pb(i,k,j))**(r_d/cp) - t0 -! grid%t_init(i,k,j) = (t00 + A*LOG(grid%pb(i,k,j)/p00))*(p00/grid%pb(i,k,j))**(r_d/cp) - t0 grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm END DO ! Base state mu is defined as base state surface pressure minus grid%p_top - grid%mub(i,j) = p_surf - grid%p_top + grid%MUB(i,j) = p_surf - grid%p_top ! Integrate base geopotential, starting at terrain elevation. This assures that ! the base state is in exact hydrostatic balance with respect to the model equations. @@ -584,14 +630,21 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & grid%phb(i,1,j) = grid%ht(i,j) * g IF ( config_flags%hypsometric_opt .EQ. 1 ) THEN - DO k = 2,kte - grid%phb(i,k,j) = grid%phb(i,k-1,j) - grid%dnw(k-1)*grid%mub(i,j)*grid%alb(i,k-1,j) + DO kk = 2,kte + k = kk - 1 + grid%phb(i,kk,j) = grid%phb(i,kk-1,j) - grid%dnw(kk-1)*grid%mub(i,j)*grid%alb(i,kk-1,j) END DO ELSE IF ( config_flags%hypsometric_opt .EQ. 2 ) THEN DO k = 2,kte +#if !( HYBRID_COORD==1 ) pfu = grid%mub(i,j)*grid%znw(k) + grid%p_top pfd = grid%mub(i,j)*grid%znw(k-1) + grid%p_top phm = grid%mub(i,j)*grid%znu(k-1) + grid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = grid%c3f(k )*grid%MUB(i,j) + grid%c4f(k ) + grid%p_top + pfd = grid%c3f(k-1)*grid%MUB(i,j) + grid%c4f(k-1) + grid%p_top + phm = grid%c3h(k-1)*grid%MUB(i,j) + grid%c4h(k-1) + grid%p_top +#endif grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu) END DO END IF @@ -630,7 +683,7 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & DO j = jts,min(jte,jde-1) DO i = its, min(ite,ide-1) IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN - grid%mu_1(i,j)=grid%mu_2(i,j) + grid%MU_1(i,j)=grid%MU_2(i,j) ENDIF ENDDO ENDDO @@ -644,7 +697,11 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & DO k = kts,kte-1 DO i = its, min(ite,ide-1) IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN +#if !( HYBRID_COORD==1 ) grid%pb(i,k,j) = grid%znu(k)*grid%mub(i,j)+grid%p_top +#elif ( HYBRID_COORD==1 ) + grid%pb(i,k,j) = grid%c3h(k )*grid%MUB(i,j) + grid%c4h(k ) + grid%p_top +#endif grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm ENDIF ENDDO @@ -656,7 +713,11 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & DO k = kts,kte-1 DO i = its, min(ite,ide-1) IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN +#if !( HYBRID_COORD==1 ) grid%pb(i,k,j) = grid%znu(k)*grid%mub(i,j)+grid%p_top +#elif ( HYBRID_COORD==1 ) + grid%pb(i,k,j) = grid%c3h(k )*grid%MUB(i,j) + grid%c4h(k ) + grid%p_top +#endif temp = MAX ( tiso, t00 + A*LOG(grid%pb(i,k,j)/p00) ) IF ( grid%pb(i,k,j) .LT. p_strat ) THEN temp = tiso + A_strat * LOG ( grid%pb(i,k,j)/p_strat ) @@ -677,14 +738,21 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & DO i = its, min(ite,ide-1) grid%phb(i,1,j) = grid%ht(i,j) * g IF ( config_flags%hypsometric_opt .EQ. 1 ) THEN - DO k = 2,kte - grid%phb(i,k,j) = grid%phb(i,k-1,j) - grid%dnw(k-1)*grid%mub(i,j)*grid%alb(i,k-1,j) + DO kk = 2,kte + k = kk - 1 + grid%phb(i,kk,j) = grid%phb(i,kk-1,j) - grid%dnw(kk-1)*grid%mub(i,j)*grid%alb(i,kk-1,j) END DO ELSE IF ( config_flags%hypsometric_opt .EQ. 2 ) THEN DO k = 2,kte +#if !( HYBRID_COORD==1 ) pfu = grid%mub(i,j)*grid%znw(k) + grid%p_top pfd = grid%mub(i,j)*grid%znw(k-1) + grid%p_top phm = grid%mub(i,j)*grid%znu(k-1) + grid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = grid%c3f(k )*grid%MUB(i,j) + grid%c4f(k ) + grid%p_top + pfd = grid%c3f(k-1)*grid%MUB(i,j) + grid%c4f(k-1) + grid%p_top + phm = grid%c3h(k-1)*grid%MUB(i,j) + grid%c4h(k-1) + grid%p_top +#endif grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu) END DO ENDIF @@ -698,7 +766,11 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & DO k = kts,kte-1 DO i = its, min(ite,ide-1) IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN +#if !( HYBRID_COORD==1 ) grid%pb(i,k,j) = grid%znu(k)*grid%mub(i,j)+grid%p_top +#elif ( HYBRID_COORD==1 ) + grid%pb(i,k,j) = grid%c3h(k )*grid%MUB(i,j) + grid%c4h(k ) + grid%p_top +#endif grid%alb(i,k,j) = -grid%rdnw(k)*(grid%phb(i,k+1,j)-grid%phb(i,k,j))/grid%mub(i,j) grid%t_init(i,k,j) = grid%alb(i,k,j)*(p1000mb/r_d)/((grid%pb(i,k,j)/p1000mb)**cvpm) - t0 ENDIF @@ -710,7 +782,11 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & DO k = kts,kte-1 DO i = its, min(ite,ide-1) IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN +#if !( HYBRID_COORD==1 ) grid%pb(i,k,j) = grid%znu(k)*grid%mub(i,j)+grid%p_top +#elif ( HYBRID_COORD==1 ) + grid%pb(i,k,j) = grid%c3h(k )*grid%MUB(i,j) + grid%c4h(k ) + grid%p_top +#endif grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm ENDIF ENDDO @@ -722,8 +798,9 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & DO j = jts,min(jte,jde-1) DO i = its, min(ite,ide-1) grid%phb(i,1,j) = grid%ht(i,j) * g - 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) + DO kk = 2,kte + k = kk - 1 + grid%phb(i,kk,j) = grid%phb(i,kk-1,j) - grid%dnw(kk-1)*grid%mub(i,j)*grid%alb(i,kk-1,j) END DO ENDDO ENDDO @@ -785,9 +862,15 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & DO j=jts,min(jte,jde-1) DO k=kts,kte-1 DO i=its,min(ite,ide-1) +#if !( HYBRID_COORD==1 ) pfu = (grid%mub(i,j)+grid%mu_1(i,j))*grid%znw(k+1)+grid%p_top pfd = (grid%mub(i,j)+grid%mu_1(i,j))*grid%znw(k) +grid%p_top phm = (grid%mub(i,j)+grid%mu_1(i,j))*grid%znu(k) +grid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = grid%c3f(k+1)*(grid%MUB(i,j)+grid%MU_1(i,j)) + grid%c4f(k+1) + grid%p_top + pfd = grid%c3f(k )*(grid%MUB(i,j)+grid%MU_1(i,j)) + grid%c4f(k ) + grid%p_top + phm = grid%c3h(k )*(grid%MUB(i,j)+grid%MU_1(i,j)) + grid%c4h(k ) + grid%p_top +#endif grid%al(i,k,j) = (grid%ph_1(i,k+1,j)-grid%ph_1(i,k,j)+grid%phb(i,k+1,j)-grid%phb(i,k,j)) & /phm/LOG(pfd/pfu)-grid%alb(i,k,j) ENDDO @@ -812,7 +895,11 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & DO j=jts,min(jte,jde-1) DO i=its,min(ite,ide-1) p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 ) +#if !( HYBRID_COORD==1 ) grid%p_hyd_w(i,1,j) = grid%p(i,1,j) + grid%znw(1)*(p_surf - grid%p_top) + grid%p_top +#elif ( HYBRID_COORD==1 ) + grid%p_hyd_w(i,1,j) = grid%p(i,1,j) + grid%c3f(1)*(p_surf - grid%p_top) + grid%c4f(1) + grid%p_top +#endif DO k=kts+1,kte grid%p_hyd_w(i,k,j) = ( 2.*(grid%p(i,k-1,j)+grid%pb(i,k-1,j)) - grid%p_hyd_w(i,k-1,j) ) ENDDO @@ -821,8 +908,12 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & ELSE DO j=jts,min(jte,jde-1) DO i=its,min(ite,ide-1) - p_surf = grid%mub(i,j)+grid%p_top + p_surf = grid%MUB(i,j)+grid%p_top +#if !( HYBRID_COORD==1 ) grid%p_hyd_w(i,1,j) = grid%p(i,1,j) + grid%znw(1)*(p_surf - grid%p_top) + grid%p_top +#elif ( HYBRID_COORD==1 ) + grid%p_hyd_w(i,1,j) = grid%p(i,1,j) + grid%c3f(1)*(p_surf - grid%p_top) + grid%c4f(1) + grid%p_top +#endif DO k=kts+1,kte grid%p_hyd_w(i,k,j) = ( 2.*(grid%p(i,k-1,j)+grid%pb(i,k-1,j)) - grid%p_hyd_w(i,k-1,j) ) ENDDO @@ -844,13 +935,13 @@ SUBROUTINE start_domain_em ( grid, allowed_to_read & ( ( config_flags%input_from_hires ) .OR. ( config_flags%input_from_file ) ) ) THEN DO j = jts, MIN(jte,jde-1) DO i = its, MIN(ite,ide-1) - grid%mu_2(i,j) = grid%mu_2(i,j) + grid%al(i,1,j) / ( grid%alt(i,1,j) * grid%alb(i,1,j) ) * & + grid%MU_2(i,j) = grid%MU_2(i,j) + grid%al(i,1,j) / ( grid%alt(i,1,j) * grid%alb(i,1,j) ) * & g * ( grid%ht(i,j) - grid%ht_fine(i,j) ) END DO END DO DO j = jts,min(jte,jde-1) DO i = its, min(ite,ide-1) - grid%mu_1(i,j)=grid%mu_2(i,j) + grid%MU_1(i,j)=grid%MU_2(i,j) ENDDO ENDDO @@ -2033,7 +2124,7 @@ SUBROUTINE rebalance_cycl ( grid & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & ips, ipe, jps, jpe, kps, kpe, & - i, j, k, ispe, ktf + i, j, k, kk, ispe, ktf SELECT CASE ( model_data_order ) CASE ( DATA_ORDER_ZXY ) @@ -2102,41 +2193,43 @@ SUBROUTINE rebalance_cycl ( grid & ! equation) down from the top to get the pressure perturbation. First get the pressure ! perturbation, moisture, and inverse density (total and perturbation) at the top-most level. - k = kte - 1 + kk = kte - 1 + k=kk+1 qtot = 0. DO ispe=PARAM_FIRST_SCALAR,n_moist - qtot = qtot + 0.5*(moist(i,k,j,ispe)+moist(i,k,j,ispe)) + qtot = qtot + 0.5*(moist(i,kk,j,ispe)+moist(i,kk,j,ispe)) ENDDO qvf2 = 1./(1.+qtot) qvf1 = qtot*qvf2 - grid%p(i,k,j) = - 0.5*(grid%mu_2(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_2(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) - grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j) + grid%p(i,kk,j) = - 0.5*(grid%Mu_2(i,j)+qvf1*grid%Mub(i,j))/grid%rdnw(kk)/qvf2 + qvf = 1.+rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & + (((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,j) + grid%p_hyd(i,kk,j) = grid%p(i,kk,j) + grid%pb(i,kk,j) ! Now, integrate down the column to compute the pressure perturbation, and diagnose the two ! inverse density fields (total and perturbation). - DO k=kte-2,kts,-1 + DO kk=kte-2,kts,-1 + k = kk + 1 - qtot = 0. + qtot = 0. DO ispe=PARAM_FIRST_SCALAR,n_moist - qtot = qtot + 0.5*( moist(i,k ,j,ispe) + moist(i,k+1,j,ispe) ) + qtot = qtot + 0.5*( moist(i,kk ,j,ispe) + moist(i,kk+1,j,ispe) ) ENDDO qvf2 = 1./(1.+qtot) qvf1 = qtot*qvf2 - grid%p(i,k,j) = grid%p(i,k+1,j) - (grid%mu_2(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_2(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) - grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j) + grid%p(i,kk,j) = grid%p(i,kk+1,j) - (grid%Mu_2(i,j) + & + qvf1*grid%Mub(i,j))/qvf2/grid%rdn(kk+1) + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & + (((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,j) + grid%p_hyd(i,kk,j) = grid%p(i,kk,j) + grid%pb(i,kk,j) ENDDO ! This is the hydrostatic equation used in the model after the @@ -2145,11 +2238,12 @@ SUBROUTINE rebalance_cycl ( grid & ! geopotential. IF (grid%hypsometric_opt == 1) THEN - DO k = 2,kte - grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) - & - grid%dnw(k-1) * ( (grid%mub(i,j)+grid%mu_2(i,j))*grid%al(i,k-1,j) & - + grid%mu_2(i,j)*grid%alb(i,k-1,j) ) - grid%ph0(i,k,j) = grid%ph_2(i,k,j) + grid%phb(i,k,j) + DO kk = 2,kte + k = kk - 1 + grid%ph_2(i,kk,j) = grid%ph_2(i,kk-1,j) - & + grid%dnw(kk-1) * ( (grid%mub(i,j)+grid%mu_2(i,j))*grid%al(i,kk-1,j) & + + grid%mu_2(i,j)*grid%alb(i,kk-1,j) ) + grid%ph0(i,kk,j) = grid%ph_2(i,kk,j) + grid%phb(i,kk,j) END DO ELSE IF (grid%hypsometric_opt == 2) THEN ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is @@ -2160,9 +2254,15 @@ SUBROUTINE rebalance_cycl ( grid & grid%ph_2(i,1,j) = grid%phb(i,1,j) DO k = 2,kte +#if !( HYBRID_COORD==1 ) pfu = ( grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k) + grid%p_top pfd = ( grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k-1) + grid%p_top phm = ( grid%mub(i,j)+grid%mu_2(i,j))*grid%znu(k-1) + grid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = grid%c3f(k )*(grid%MUB(i,j)+grid%MU_2(i,j)) + grid%c4f(k ) + grid%p_top + pfd = grid%c3f(k-1)*(grid%MUB(i,j)+grid%MU_2(i,j)) + grid%c4f(k-1) + grid%p_top + phm = grid%c3h(k-1)*(grid%MUB(i,j)+grid%MU_2(i,j)) + grid%c4h(k-1) + grid%p_top +#endif grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu) END DO @@ -2177,32 +2277,34 @@ SUBROUTINE rebalance_cycl ( grid & ELSE ! n_moist - k = kte - 1 + kk = kte - 1 + k = kk + 1 - qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k,j,P_QV)) + qvf1 = 0.5*(moist(i,kk,j,P_QV)+moist(i,kk,j,P_QV)) qvf2 = 1./(1.+qvf1) qvf1 = qvf1*qvf2 - grid%p(i,k,j) = - 0.5*(grid%mu_2(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_2(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) - grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j) + grid%p(i,kk,j) = - 0.5*(grid%Mu_2(i,j)+qvf1*grid%Mub(i,j))/grid%rdnw(kk)/qvf2 + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf & + *(((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,j) + grid%p_hyd(i,kk,j) = grid%p(i,kk,j) + grid%pb(i,kk,j) ! Now, integrate down the column to compute the pressure perturbation, and diagnose the two ! inverse density fields (total and perturbation). - DO k=kte-2,kts,-1 - qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV)) + DO kk=kte-2,kts,-1 + k = kk + 1 + qvf1 = 0.5*(moist(i,kk,j,P_QV)+moist(i,kk+1,j,P_QV)) qvf2 = 1./(1.+qvf1) qvf1 = qvf1*qvf2 - grid%p(i,k,j) = grid%p(i,k+1,j) - (grid%mu_2(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_2(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) - grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j) + grid%p(i,kk,j) = grid%p(i,kk+1,j) - (grid%Mu_2(i,j) + qvf1*grid%Mub(i,j))/qvf2/grid%rdn(kk+1) + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & + (((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,j) + grid%p_hyd(i,kk,j) = grid%p(i,kk,j) + grid%pb(i,kk,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. @@ -2224,9 +2326,15 @@ SUBROUTINE rebalance_cycl ( grid & grid%ph_2(i,1,j) = grid%phb(i,1,j) DO k = 2,kte +#if !( HYBRID_COORD==1 ) pfu = ( grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k) + grid%p_top pfd = ( grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k-1) + grid%p_top phm = ( grid%mub(i,j)+grid%mu_2(i,j))*grid%znu(k-1) + grid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = grid%c3f(k )*(grid%MUB(i,j)+grid%MU_2(i,j)) + grid%c4f(k ) + grid%p_top + pfd = grid%c3f(k-1)*(grid%MUB(i,j)+grid%MU_2(i,j)) + grid%c4f(k-1) + grid%p_top + phm = grid%c3h(k-1)*(grid%MUB(i,j)+grid%MU_2(i,j)) + grid%c4h(k-1) + grid%p_top +#endif grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu) END DO diff --git a/external/RSL_LITE/module_dm.F b/external/RSL_LITE/module_dm.F index cc438f96dc..5dd1d1d478 100644 --- a/external/RSL_LITE/module_dm.F +++ b/external/RSL_LITE/module_dm.F @@ -1,3 +1,21 @@ +! sed -e "s/grid%mu/gridmu/g" -e "s/grid%Mu/gridMu/g" module_dm.F | cpp -DDM_PARALLEL=1 -DHYBRID_COORD=1 -DEM_CORE=1 | sed -e "s/gridmu/grid%mu/g" -e "s/gridMu/grid%Mu/g" > module_dm.next +#if ( HYBRID_COORD==1 ) +# define gridmu_2(...) (grid%c1h(k)*XXPC2HXX(__VA_ARGS__)) +# define XXPC2HXX(...) grid%mu_2(__VA_ARGS__) + +# define gridmub(...) (grid%c1h(k)*XXPCBHXX(__VA_ARGS__)+grid%c2h(k)) +# define XXPCBHXX(...) grid%mub(__VA_ARGS__) + +# define gridMu_2(...) (grid%c1f(k)*XXPC2FXX(__VA_ARGS__)) +# define XXPC2FXX(...) grid%Mu_2(__VA_ARGS__) + +# define gridMub(...) (grid%c1f(k)*XXPCBFXX(__VA_ARGS__)+grid%c2f(k)) +# define XXPCBFXX(...) grid%Mub(__VA_ARGS__) +#endif + + + + #if NMM_CORE==1 #define copy_fcnm UpNear #define copy_fcn UpCopy @@ -4055,7 +4073,7 @@ SUBROUTINE force_domain_em_part2 ( grid, ngrid, pgrid, config_flags & TYPE(domain), POINTER :: pgrid !KAL added for vertical nesting #include "dummy_new_decl.inc" INTEGER nlev, msize - INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k + INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k,kk TYPE (grid_config_rec_type) :: config_flags REAL xv(2000) INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & @@ -4199,7 +4217,11 @@ SUBROUTINE force_domain_em_part2 ( grid, ngrid, pgrid, config_flags & DO i = ips,ipe DO k = 1, kpe-1 +#if !( HYBRID_COORD==1 ) grid%pb(i,k,j) = ngrid%znu(k)*grid%mub(i,j)+ngrid%p_top +#elif ( HYBRID_COORD==1 ) + grid%pb(i,k,j) = ngrid%c3h(k)*grid%mub(i,j) + ngrid%c4h(k) + ngrid%p_top +#endif ! If this is a real run, recalc t_init. @@ -4220,13 +4242,20 @@ SUBROUTINE force_domain_em_part2 ( grid, ngrid, pgrid, config_flags & grid%phb(i,1,j) = grid%ht(i,j) * g IF (grid%hypsometric_opt == 1) THEN DO k = 2,kpe - grid%phb(i,k,j) = grid%phb(i,k-1,j) - ngrid%dnw(k-1)*grid%mub(i,j)*grid%alb(i,k-1,j) + kk = k - 1 + grid%phb(i,kk,j) = grid%phb(i,kk-1,j) - ngrid%dnw(kk-1)*grid%mub(i,j)*grid%alb(i,kk-1,j) END DO ELSE IF (grid%hypsometric_opt == 2) THEN DO k = 2,kpe +#if !( HYBRID_COORD==1 ) pfu = grid%mub(i,j)*ngrid%znw(k) + ngrid%p_top pfd = grid%mub(i,j)*ngrid%znw(k-1) + ngrid%p_top phm = grid%mub(i,j)*ngrid%znu(k-1) + ngrid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = ngrid%c3f(k )*grid%MUB(i,j) + ngrid%c4f(k ) + ngrid%p_top + pfd = ngrid%c3f(k-1)*grid%MUB(i,j) + ngrid%c4f(k-1) + ngrid%p_top + phm = ngrid%c3h(k-1)*grid%MUB(i,j) + ngrid%c4h(k-1) + ngrid%p_top +#endif grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu) END DO ELSE @@ -4253,7 +4282,7 @@ SUBROUTINE force_domain_em_part2 ( grid, ngrid, pgrid, config_flags & qvf2 = 1./(1.+qvf1) qvf1 = qvf1*qvf2 - p(i,k,j) = - 0.5*(grid%mu_2(i,j)+qvf1*grid%mub(i,j))/ngrid%rdnw(k)/qvf2 + p(i,k,j) = - 0.5*(grid%Mu_2(i,j)+qvf1*grid%Mub(i,j))/ngrid%rdnw(k)/qvf2 qvf = 1. + rvovrd*moist(i,k,j,P_QV) al(i,k,j) = (r_d/p1000mb)*(grid%t_2(i,k,j)+t0)*qvf* & (((p(i,k,j)+grid%pb(i,k,j))/p1000mb)**cvpm) - grid%alb(i,k,j) @@ -4261,24 +4290,26 @@ SUBROUTINE force_domain_em_part2 ( grid, ngrid, pgrid, config_flags & ! Now, integrate down the column to compute the pressure perturbation, and diagnose the two ! inverse density fields (total and perturbation). - DO k=kpe-2,1,-1 - qvf1 = 0.5*(moist(i,k,j,P_QV)+moist(i,k+1,j,P_QV)) + DO kk=kpe-2,1,-1 + k = kk + 1 + qvf1 = 0.5*(moist(i,kk,j,P_QV)+moist(i,kk+1,j,P_QV)) qvf2 = 1./(1.+qvf1) qvf1 = qvf1*qvf2 - p(i,k,j) = p(i,k+1,j) - (grid%mu_2(i,j) + qvf1*grid%mub(i,j))/qvf2/ngrid%rdn(k+1) - qvf = 1. + rvovrd*moist(i,k,j,P_QV) - al(i,k,j) = (r_d/p1000mb)*(grid%t_2(i,k,j)+t0)*qvf* & - (((p(i,k,j)+grid%pb(i,k,j))/p1000mb)**cvpm) - grid%alb(i,k,j) + p(i,kk,j) = p(i,kk+1,j) - (grid%Mu_2(i,j) + qvf1*grid%Mub(i,j))/qvf2/ngrid%rdn(kk+1) + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + al(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & + (((p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) - grid%alb(i,kk,j) END DO ! 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. IF (grid%hypsometric_opt == 1) THEN - DO k = 2,kpe - grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) - & - ngrid%dnw(k-1) * ( (grid%mub(i,j)+grid%mu_2(i,j))*al(i,k-1,j) & - + grid%mu_2(i,j)*grid%alb(i,k-1,j) ) + DO kk = 2,kpe + k = kk - 1 + grid%ph_2(i,kk,j) = grid%ph_2(i,kk-1,j) - & + ngrid%dnw(kk-1) * ( (grid%mub(i,j)+grid%mu_2(i,j))*al(i,kk-1,j) & + + grid%mu_2(i,j)*grid%alb(i,kk-1,j) ) END DO ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure. @@ -4289,9 +4320,15 @@ SUBROUTINE force_domain_em_part2 ( grid, ngrid, pgrid, config_flags & grid%ph_2(i,1,j) = grid%phb(i,1,j) DO k = 2,kpe +#if !( HYBRID_COORD==1 ) pfu = ( grid%mub(i,j)+grid%mu_2(i,j))*ngrid%znw(k) + ngrid%p_top pfd = ( grid%mub(i,j)+grid%mu_2(i,j))*ngrid%znw(k-1) + ngrid%p_top phm = ( grid%mub(i,j)+grid%mu_2(i,j))*ngrid%znu(k-1) + ngrid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = ngrid%c3f(k )*( grid%MUB(i,j)+grid%MU_2(i,j) ) + ngrid%c4f(k ) + ngrid%p_top + pfd = ngrid%c3f(k-1)*( grid%MUB(i,j)+grid%MU_2(i,j) ) + ngrid%c4f(k-1) + ngrid%p_top + phm = ngrid%c3h(k-1)*( grid%MUB(i,j)+grid%MU_2(i,j) ) + ngrid%c4h(k-1) + ngrid%p_top +#endif grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + (grid%alb(i,k-1,j)+al(i,k-1,j))*phm*LOG(pfd/pfu) END DO @@ -4311,7 +4348,7 @@ SUBROUTINE force_domain_em_part2 ( grid, ngrid, pgrid, config_flags & DO j = jps, jpe DO i = ips,ipe DO k=kps,kpe - grid%ph_2(i,k,j) = grid%ph_2(i,k,j)*(grid%mub(i,j) + grid%mu_2(i,j)) + grid%ph_2(i,k,j) = grid%ph_2(i,k,j)*(grid%Mub(i,j) + grid%Mu_2(i,j)) END DO END DO END DO diff --git a/external/io_esmf/makefile b/external/io_esmf/makefile index c17499f11f..7667221d32 100644 --- a/external/io_esmf/makefile +++ b/external/io_esmf/makefile @@ -1,11 +1,8 @@ # these settings for compiling standalone on Compaq. Type "make -r" -#CPP = /lib/cpp -#FC = f90 -free .SUFFIXES: .F90 .o AR = ar -#RANLIB = ranlib RANLIB = echo OBJS = module_symbols_util.o \ diff --git a/main/Makefile b/main/Makefile index b8074657d7..3df8ced72d 100644 --- a/main/Makefile +++ b/main/Makefile @@ -14,7 +14,7 @@ include ../configure.wrf $(SOLVER)_wrf : wrf.o ../main/module_wrf_top.o $(RANLIB) $(RLFLAGS) $(LIBWRFLIB) - $(LD) -o wrf.exe $(LDFLAGS) wrf.o ../main/module_wrf_top.o $(LIBWRFLIB) $(LIB) + $(LD) -o wrf.exe $(LDFLAGS) wrf.o ../main/module_wrf_top.o $(LIBWRFLIB) $(LIB) $(SOLVER)_wrf_SST_ESMF : wrf_ESMFMod.o wrf_SST_ESMF.o ../main/module_wrf_top.o $(RANLIB) $(RLFLAGS) $(LIBWRFLIB) diff --git a/main/ndown_em.F b/main/ndown_em.F index af87151db2..01d979e1fb 100644 --- a/main/ndown_em.F +++ b/main/ndown_em.F @@ -792,25 +792,31 @@ END SUBROUTINE vert_cor ! u, theta, h, scalars coupled with my, v coupled with mx CALL couple ( nested_grid%mu_2 , nested_grid%mub , ubdy3dtemp1 , nested_grid%u_2 , & 'u' , nested_grid%msfuy , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( nested_grid%mu_2 , nested_grid%mub , vbdy3dtemp1 , nested_grid%v_2 , & 'v' , nested_grid%msfvx , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( nested_grid%mu_2 , nested_grid%mub , tbdy3dtemp1 , nested_grid%t_2 , & 't' , nested_grid%msfty , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( nested_grid%mu_2 , nested_grid%mub , pbdy3dtemp1 , nested_grid%ph_2 , & 'h' , nested_grid%msfty , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) DO nvmoist=PARAM_FIRST_SCALAR, num_moist CALL couple ( nested_grid%mu_2 , nested_grid%mub , qbdy3dtemp1 , nested_grid%moist(ims:ime,kms:kme,jms:jme,nvmoist) , & 't' , nested_grid%msfty , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) qbdy3dtemp1_coupled(:,:,:,nvmoist) = qbdy3dtemp1 END DO DO nvscalar=PARAM_FIRST_SCALAR, num_scalar CALL couple ( nested_grid%mu_2 , nested_grid%mub , sbdy3dtemp1 , nested_grid%scalar(ims:ime,kms:kme,jms:jme,nvscalar) , & 't' , nested_grid%msfty , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) sbdy3dtemp1_coupled(:,:,:,nvscalar) = sbdy3dtemp1 END DO @@ -906,25 +912,31 @@ END SUBROUTINE vert_cor ! u, theta, h, scalars coupled with my, v coupled with mx CALL couple ( nested_grid%mu_2 , nested_grid%mub , ubdy3dtemp2 , nested_grid%u_2 , & 'u' , nested_grid%msfuy , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( nested_grid%mu_2 , nested_grid%mub , vbdy3dtemp2 , nested_grid%v_2 , & 'v' , nested_grid%msfvx , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( nested_grid%mu_2 , nested_grid%mub , tbdy3dtemp2 , nested_grid%t_2 , & 't' , nested_grid%msfty , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( nested_grid%mu_2 , nested_grid%mub , pbdy3dtemp2 , nested_grid%ph_2 , & 'h' , nested_grid%msfty , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) DO nvmoist=PARAM_FIRST_SCALAR, num_moist CALL couple ( nested_grid%mu_2 , nested_grid%mub , qbdy3dtemp2 , nested_grid%moist(ims:ime,kms:kme,jms:jme,nvmoist) , & 't' , nested_grid%msfty , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) qbdy3dtemp2_coupled(:,:,:,nvmoist) = qbdy3dtemp2 END DO DO nvscalar=PARAM_FIRST_SCALAR, num_scalar CALL couple ( nested_grid%mu_2 , nested_grid%mub , sbdy3dtemp2 , nested_grid%scalar(ims:ime,kms:kme,jms:jme,nvscalar) , & 't' , nested_grid%msfty , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) sbdy3dtemp2_coupled(:,:,:,nvscalar) = sbdy3dtemp2 END DO @@ -1191,25 +1203,31 @@ END SUBROUTINE vert_cor ! u, theta, h, scalars coupled with my, v coupled with mx CALL couple ( nested_grid%mu_2 , nested_grid%mub , ubdy3dtemp2 , nested_grid%u_2 , & 'u' , nested_grid%msfuy , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( nested_grid%mu_2 , nested_grid%mub , vbdy3dtemp2 , nested_grid%v_2 , & 'v' , nested_grid%msfvx , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( nested_grid%mu_2 , nested_grid%mub , tbdy3dtemp2 , nested_grid%t_2 , & 't' , nested_grid%msfty , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( nested_grid%mu_2 , nested_grid%mub , pbdy3dtemp2 , nested_grid%ph_2 , & 'h' , nested_grid%msfty , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) DO nvmoist=PARAM_FIRST_SCALAR, num_moist CALL couple ( nested_grid%mu_2 , nested_grid%mub , qbdy3dtemp2 , nested_grid%moist(ims:ime,kms:kme,jms:jme,nvmoist) , & 't' , nested_grid%msfty , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) qbdy3dtemp2_coupled(:,:,:,nvmoist) = qbdy3dtemp2 END DO DO nvscalar=PARAM_FIRST_SCALAR, num_scalar CALL couple ( nested_grid%mu_2 , nested_grid%mub , sbdy3dtemp2 , nested_grid%scalar(ims:ime,kms:kme,jms:jme,nvscalar) , & 't' , nested_grid%msfty , & + nested_grid%c1h, nested_grid%c2h, nested_grid%c1f, nested_grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) sbdy3dtemp2_coupled(:,:,:,nvscalar) = sbdy3dtemp2 END DO diff --git a/main/real_em.F b/main/real_em.F index ee4e2a2ee4..f51ea6e870 100644 --- a/main/real_em.F +++ b/main/real_em.F @@ -833,14 +833,19 @@ SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max ) ! u, theta, h, scalars coupled with my; v coupled with mx CALL couple ( grid%mu_2 , grid%mub , ubdy3dtemp1 , grid%u_2 , 'u' , grid%msfuy , & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( grid%mu_2 , grid%mub , vbdy3dtemp1 , grid%v_2 , 'v' , grid%msfvx , & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( grid%mu_2 , grid%mub , tbdy3dtemp1 , grid%t_2 , 't' , grid%msfty , & + grid%c1h, grid%c2h, grid%c1h, grid%c2h, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( grid%mu_2 , grid%mub , pbdy3dtemp1 , grid%ph_2 , 'h' , grid%msfty , & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( grid%mu_2 , grid%mub , qbdy3dtemp1 , grid%moist(:,:,:,P_QV) , 't' , grid%msfty , & + grid%c1h, grid%c2h, grid%c1h, grid%c2h, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) DO j = jps , MIN(jde-1,jpe) @@ -851,8 +856,10 @@ SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max ) IF (config_flags%mp_physics.eq.THOMPSONAERO .AND. config_flags%use_aero_icbc) THEN CALL couple ( grid%mu_2 , grid%mub , qn1bdy3dtemp1 , grid%scalar(:,:,:,P_QNWFA) , 't' , grid%msfty , & + grid%c1h, grid%c2h, grid%c1h, grid%c2h, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( grid%mu_2 , grid%mub , qn2bdy3dtemp1 , grid%scalar(:,:,:,P_QNIFA) , 't' , grid%msfty , & + grid%c1h, grid%c2h, grid%c1h, grid%c2h, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) END IF @@ -980,14 +987,19 @@ SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max ) ! u, theta, h, scalars coupled with my; v coupled with mx CALL couple ( grid%mu_2 , grid%mub , ubdy3dtemp2 , grid%u_2 , 'u' , grid%msfuy , & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( grid%mu_2 , grid%mub , vbdy3dtemp2 , grid%v_2 , 'v' , grid%msfvx , & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( grid%mu_2 , grid%mub , tbdy3dtemp2 , grid%t_2 , 't' , grid%msfty , & + grid%c1h, grid%c2h, grid%c1h, grid%c2h, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( grid%mu_2 , grid%mub , pbdy3dtemp2 , grid%ph_2 , 'h' , grid%msfty , & + grid%c1h, grid%c2h, grid%c1f, grid%c2f, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( grid%mu_2 , grid%mub , qbdy3dtemp2 , grid%moist(:,:,:,P_QV) , 't' , grid%msfty , & + grid%c1h, grid%c2h, grid%c1h, grid%c2h, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) DO j = jps , jpe @@ -998,8 +1010,10 @@ SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max ) IF (config_flags%mp_physics.eq.THOMPSONAERO .AND. config_flags%use_aero_icbc) THEN CALL couple ( grid%mu_2 , grid%mub , qn1bdy3dtemp2 , grid%scalar(:,:,:,P_QNWFA) , 't' , grid%msfty , & + grid%c1h, grid%c2h, grid%c1h, grid%c2h, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) CALL couple ( grid%mu_2 , grid%mub , qn2bdy3dtemp2 , grid%scalar(:,:,:,P_QNIFA) , 't' , grid%msfty , & + grid%c1h, grid%c2h, grid%c1h, grid%c2h, & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe ) END IF diff --git a/phys/module_microphysics_driver.F b/phys/module_microphysics_driver.F index 2547e12c54..977acc9d97 100644 --- a/phys/module_microphysics_driver.F +++ b/phys/module_microphysics_driver.F @@ -57,7 +57,7 @@ SUBROUTINE microphysics_driver( & ,f_qnic,f_qnip,f_qnid & ,f_effr,f_ice_effr,f_tot_effr & ,f_qic_effr,f_qip_effr,f_qid_effr & - ,qrcuten, qscuten, qicuten, mu & + ,qrcuten, qscuten, qicuten, mu, c1, c2h & ,qt_curr,f_qt & ,mp_restart_state,tbpvs_state,tbpvs0_state & ! for etampnew or fer_mp_hires ,hail,ice2 & ! for mp_gsfcgce @@ -484,6 +484,9 @@ SUBROUTINE microphysics_driver( & REAL, DIMENSION( ims:ime, jms:jme ), & OPTIONAL, & INTENT(IN) :: mu + REAL, DIMENSION( kms:kme), & + OPTIONAL, & + INTENT(IN) :: c1, c2h ! YLIN ! Added RI_CURR similar to microphysics fields above REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), & @@ -947,6 +950,7 @@ SUBROUTINE microphysics_driver( & PRESENT (QNS_CURR) .AND. PRESENT (QNI_CURR).AND. & PRESENT (QNR_CURR) .AND. PRESENT (QNG_CURR).AND. & PRESENT (MU) .AND. PRESENT (QSCUTEN).AND. & + PRESENT (C1) .AND. PRESENT (C2H) .AND. & PRESENT (QRCUTEN) .AND. PRESENT (QICUTEN).AND. & PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. & PRESENT ( W ) ) THEN @@ -983,7 +987,7 @@ SUBROUTINE microphysics_driver( & ,qrcuten=qrcuten & ! hm ,qscuten=qscuten & ! hm ,qicuten=qicuten & ! hm - ,mu=mu & ! hm + ,mu=mu,c1=c1,c2=c2h & ! hm ,F_QNDROP=f_qndrop & ! hm for wrf-chem ,QNDROP=qndrop_curr & ! hm for wrf-chem ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde & diff --git a/phys/module_mp_morr_two_moment.F b/phys/module_mp_morr_two_moment.F index dd56351aa7..af1e76e6e5 100644 --- a/phys/module_mp_morr_two_moment.F +++ b/phys/module_mp_morr_two_moment.F @@ -1,3 +1,5 @@ +#define mu(...) (c1(k)*XXPCTXX(__VA_ARGS__)+c2(k)) +#define XXPCTXX(...) mu(__VA_ARGS__) !WRF:MODEL_LAYER:PHYSICS ! @@ -553,7 +555,7 @@ SUBROUTINE MP_MORR_TWO_MOMENT(ITIMESTEP, & RAINNC, RAINNCV, SR, & SNOWNC,SNOWNCV,GRAUPELNC,GRAUPELNCV, & ! hm added 7/13/13 refl_10cm, diagflag, do_radar_ref, & ! GT added for reflectivity calcs - qrcuten, qscuten, qicuten, mu & ! hm added + qrcuten, qscuten, qicuten, mu, c1, c2 & ! hm added ,F_QNDROP, qndrop & ! hm added, wrf-chem ,IDS,IDE, JDS,JDE, KDS,KDE & ! domain dims ,IMS,IME, JMS,JME, KMS,KME & ! memory dims @@ -688,6 +690,8 @@ SUBROUTINE MP_MORR_TWO_MOMENT(ITIMESTEP, & qrcuten, qscuten, qicuten REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN):: & mu + REAL, DIMENSION(kms:kme) , INTENT(IN):: & + c1, c2 LOGICAL, INTENT(IN), OPTIONAL :: F_QNDROP ! wrf-chem LOGICAL :: flag_qndrop ! wrf-chem diff --git a/share/mediation_integrate.F b/share/mediation_integrate.F index 73a09541b2..40fbeb5492 100644 --- a/share/mediation_integrate.F +++ b/share/mediation_integrate.F @@ -530,7 +530,7 @@ END SUBROUTINE wrf_tsin ! adjust temp and qv CALL adjust_tempqv ( nest%mub , nest%mub_save , & - nest%znw , nest%p_top , & + nest%c3h , nest%c4h , nest%znw , nest%p_top , & nest%t_2 , nest%p , nest%moist(ims,kms,jms,P_QV) , & ids , ide , jds , jde , kds , kde , & ims , ime , jms , jme , kms , kme , & diff --git a/share/module_bc.F b/share/module_bc.F index 7b494fff68..557e09e29b 100644 --- a/share/module_bc.F +++ b/share/module_bc.F @@ -1,3 +1,14 @@ +#if ( HYBRID_COORD==1 ) +#define mu_2(...) (c1(k)*XXPC2XX(__VA_ARGS__)) +#define XXPC2XX(...) mu_2(__VA_ARGS__) + +#define mub(...) (c1(k)*XXPCBXX(__VA_ARGS__)+c2(k)) +#define XXPCBXX(...) mub(__VA_ARGS__) + +#define mu(...) (c1(k)*XXPCXX(__VA_ARGS__)+c2(k)) +#define XXPCXX(...) mu(__VA_ARGS__) +#endif + !WRF:MODEL_LAYER:BOUNDARY ! @@ -1591,7 +1602,8 @@ END SUBROUTINE spec_bdytend !------------------------------------------------------------------------ SUBROUTINE spec_bdytend_perturb ( field_tend, & field_tend_perturb, & - mu_2, mub, variable_in, & + mu_2, mub, c1, c2, & + variable_in, & msf, config_flags, & spec_bdy_width, spec_zone, & kme_stoch, & ! stoch dims @@ -1620,6 +1632,7 @@ SUBROUTINE spec_bdytend_perturb ( field_tend, & REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: mu_2 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: mub REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: msf + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: c1, c2 TYPE( grid_config_rec_type ) config_flags @@ -2094,7 +2107,7 @@ SUBROUTINE spec_bdyupdate( field, & END SUBROUTINE spec_bdyupdate !------------------------------------------------------------------------ - SUBROUTINE spec_bdy_final ( field, mu, msf, & + SUBROUTINE spec_bdy_final ( field, mu, c1, c2, msf, & field_bdy_xs, field_bdy_xe, & field_bdy_ys, field_bdy_ye, & field_bdy_tend_xs, field_bdy_tend_xe, & @@ -2129,6 +2142,7 @@ SUBROUTINE spec_bdy_final ( field, mu, msf, & REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field REAL, DIMENSION( ims:ime , jms:jme), INTENT(IN ) :: mu, msf + REAL, DIMENSION( kms:kme ), INTENT(IN ) :: c1, c2 REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: field_bdy_xs, field_bdy_xe REAL, DIMENSION( ims:ime , kds:kde , spec_bdy_width ), INTENT(IN ) :: field_bdy_ys, field_bdy_ye REAL, DIMENSION( jms:jme , kds:kde , spec_bdy_width ), INTENT(IN ) :: field_bdy_tend_xs, field_bdy_tend_xe diff --git a/test/em_hill2d_x/input_sounding-U=10,N=0.01 b/test/em_hill2d_x/input_sounding-U=10,N=0.01 new file mode 100644 index 0000000000..7556e89b65 --- /dev/null +++ b/test/em_hill2d_x/input_sounding-U=10,N=0.01 @@ -0,0 +1,602 @@ + 1000.000 288.00 0.00 + 0.00 288.00 0.00 10.00 0.00 + 50.00 288.15 0.00 10.00 0.00 + 100.00 288.29 0.00 10.00 0.00 + 150.00 288.44 0.00 10.00 0.00 + 200.00 288.59 0.00 10.00 0.00 + 250.00 288.74 0.00 10.00 0.00 + 300.00 288.88 0.00 10.00 0.00 + 350.00 289.03 0.00 10.00 0.00 + 400.00 289.18 0.00 10.00 0.00 + 450.00 289.32 0.00 10.00 0.00 + 500.00 289.47 0.00 10.00 0.00 + 550.00 289.62 0.00 10.00 0.00 + 600.00 289.77 0.00 10.00 0.00 + 650.00 289.92 0.00 10.00 0.00 + 700.00 290.06 0.00 10.00 0.00 + 750.00 290.21 0.00 10.00 0.00 + 800.00 290.36 0.00 10.00 0.00 + 850.00 290.51 0.00 10.00 0.00 + 900.00 290.66 0.00 10.00 0.00 + 950.00 290.80 0.00 10.00 0.00 + 1000.00 290.95 0.00 10.00 0.00 + 1050.00 291.10 0.00 10.00 0.00 + 1100.00 291.25 0.00 10.00 0.00 + 1150.00 291.40 0.00 10.00 0.00 + 1200.00 291.55 0.00 10.00 0.00 + 1250.00 291.69 0.00 10.00 0.00 + 1300.00 291.84 0.00 10.00 0.00 + 1350.00 291.99 0.00 10.00 0.00 + 1400.00 292.14 0.00 10.00 0.00 + 1450.00 292.29 0.00 10.00 0.00 + 1500.00 292.44 0.00 10.00 0.00 + 1550.00 292.59 0.00 10.00 0.00 + 1600.00 292.74 0.00 10.00 0.00 + 1650.00 292.89 0.00 10.00 0.00 + 1700.00 293.04 0.00 10.00 0.00 + 1750.00 293.19 0.00 10.00 0.00 + 1800.00 293.34 0.00 10.00 0.00 + 1850.00 293.49 0.00 10.00 0.00 + 1900.00 293.63 0.00 10.00 0.00 + 1950.00 293.78 0.00 10.00 0.00 + 2000.00 293.93 0.00 10.00 0.00 + 2050.00 294.08 0.00 10.00 0.00 + 2100.00 294.23 0.00 10.00 0.00 + 2150.00 294.38 0.00 10.00 0.00 + 2200.00 294.53 0.00 10.00 0.00 + 2250.00 294.68 0.00 10.00 0.00 + 2300.00 294.84 0.00 10.00 0.00 + 2350.00 294.99 0.00 10.00 0.00 + 2400.00 295.14 0.00 10.00 0.00 + 2450.00 295.29 0.00 10.00 0.00 + 2500.00 295.44 0.00 10.00 0.00 + 2550.00 295.59 0.00 10.00 0.00 + 2600.00 295.74 0.00 10.00 0.00 + 2650.00 295.89 0.00 10.00 0.00 + 2700.00 296.04 0.00 10.00 0.00 + 2750.00 296.19 0.00 10.00 0.00 + 2800.00 296.34 0.00 10.00 0.00 + 2850.00 296.49 0.00 10.00 0.00 + 2900.00 296.64 0.00 10.00 0.00 + 2950.00 296.80 0.00 10.00 0.00 + 3000.00 296.95 0.00 10.00 0.00 + 3050.00 297.10 0.00 10.00 0.00 + 3100.00 297.25 0.00 10.00 0.00 + 3150.00 297.40 0.00 10.00 0.00 + 3200.00 297.55 0.00 10.00 0.00 + 3250.00 297.71 0.00 10.00 0.00 + 3300.00 297.86 0.00 10.00 0.00 + 3350.00 298.01 0.00 10.00 0.00 + 3400.00 298.16 0.00 10.00 0.00 + 3450.00 298.31 0.00 10.00 0.00 + 3500.00 298.47 0.00 10.00 0.00 + 3550.00 298.62 0.00 10.00 0.00 + 3600.00 298.77 0.00 10.00 0.00 + 3650.00 298.92 0.00 10.00 0.00 + 3700.00 299.07 0.00 10.00 0.00 + 3750.00 299.23 0.00 10.00 0.00 + 3800.00 299.38 0.00 10.00 0.00 + 3850.00 299.53 0.00 10.00 0.00 + 3900.00 299.69 0.00 10.00 0.00 + 3950.00 299.84 0.00 10.00 0.00 + 4000.00 299.99 0.00 10.00 0.00 + 4050.00 300.14 0.00 10.00 0.00 + 4100.00 300.30 0.00 10.00 0.00 + 4150.00 300.45 0.00 10.00 0.00 + 4200.00 300.60 0.00 10.00 0.00 + 4250.00 300.76 0.00 10.00 0.00 + 4300.00 300.91 0.00 10.00 0.00 + 4350.00 301.06 0.00 10.00 0.00 + 4400.00 301.22 0.00 10.00 0.00 + 4450.00 301.37 0.00 10.00 0.00 + 4500.00 301.53 0.00 10.00 0.00 + 4550.00 301.68 0.00 10.00 0.00 + 4600.00 301.83 0.00 10.00 0.00 + 4650.00 301.99 0.00 10.00 0.00 + 4700.00 302.14 0.00 10.00 0.00 + 4750.00 302.29 0.00 10.00 0.00 + 4800.00 302.45 0.00 10.00 0.00 + 4850.00 302.60 0.00 10.00 0.00 + 4900.00 302.76 0.00 10.00 0.00 + 4950.00 302.91 0.00 10.00 0.00 + 5000.00 303.07 0.00 10.00 0.00 + 5050.00 303.22 0.00 10.00 0.00 + 5100.00 303.38 0.00 10.00 0.00 + 5150.00 303.53 0.00 10.00 0.00 + 5200.00 303.69 0.00 10.00 0.00 + 5250.00 303.84 0.00 10.00 0.00 + 5300.00 304.00 0.00 10.00 0.00 + 5350.00 304.15 0.00 10.00 0.00 + 5400.00 304.31 0.00 10.00 0.00 + 5450.00 304.46 0.00 10.00 0.00 + 5500.00 304.62 0.00 10.00 0.00 + 5550.00 304.77 0.00 10.00 0.00 + 5600.00 304.93 0.00 10.00 0.00 + 5650.00 305.08 0.00 10.00 0.00 + 5700.00 305.24 0.00 10.00 0.00 + 5750.00 305.39 0.00 10.00 0.00 + 5800.00 305.55 0.00 10.00 0.00 + 5850.00 305.71 0.00 10.00 0.00 + 5900.00 305.86 0.00 10.00 0.00 + 5950.00 306.02 0.00 10.00 0.00 + 6000.00 306.17 0.00 10.00 0.00 + 6050.00 306.33 0.00 10.00 0.00 + 6100.00 306.49 0.00 10.00 0.00 + 6150.00 306.64 0.00 10.00 0.00 + 6200.00 306.80 0.00 10.00 0.00 + 6250.00 306.95 0.00 10.00 0.00 + 6300.00 307.11 0.00 10.00 0.00 + 6350.00 307.27 0.00 10.00 0.00 + 6400.00 307.42 0.00 10.00 0.00 + 6450.00 307.58 0.00 10.00 0.00 + 6500.00 307.74 0.00 10.00 0.00 + 6550.00 307.90 0.00 10.00 0.00 + 6600.00 308.05 0.00 10.00 0.00 + 6650.00 308.21 0.00 10.00 0.00 + 6700.00 308.37 0.00 10.00 0.00 + 6750.00 308.52 0.00 10.00 0.00 + 6800.00 308.68 0.00 10.00 0.00 + 6850.00 308.84 0.00 10.00 0.00 + 6900.00 309.00 0.00 10.00 0.00 + 6950.00 309.15 0.00 10.00 0.00 + 7000.00 309.31 0.00 10.00 0.00 + 7050.00 309.47 0.00 10.00 0.00 + 7100.00 309.63 0.00 10.00 0.00 + 7150.00 309.79 0.00 10.00 0.00 + 7200.00 309.94 0.00 10.00 0.00 + 7250.00 310.10 0.00 10.00 0.00 + 7300.00 310.26 0.00 10.00 0.00 + 7350.00 310.42 0.00 10.00 0.00 + 7400.00 310.58 0.00 10.00 0.00 + 7450.00 310.73 0.00 10.00 0.00 + 7500.00 310.89 0.00 10.00 0.00 + 7550.00 311.05 0.00 10.00 0.00 + 7600.00 311.21 0.00 10.00 0.00 + 7650.00 311.37 0.00 10.00 0.00 + 7700.00 311.53 0.00 10.00 0.00 + 7750.00 311.69 0.00 10.00 0.00 + 7800.00 311.85 0.00 10.00 0.00 + 7850.00 312.00 0.00 10.00 0.00 + 7900.00 312.16 0.00 10.00 0.00 + 7950.00 312.32 0.00 10.00 0.00 + 8000.00 312.48 0.00 10.00 0.00 + 8050.00 312.64 0.00 10.00 0.00 + 8100.00 312.80 0.00 10.00 0.00 + 8150.00 312.96 0.00 10.00 0.00 + 8200.00 313.12 0.00 10.00 0.00 + 8250.00 313.28 0.00 10.00 0.00 + 8300.00 313.44 0.00 10.00 0.00 + 8350.00 313.60 0.00 10.00 0.00 + 8400.00 313.76 0.00 10.00 0.00 + 8450.00 313.92 0.00 10.00 0.00 + 8500.00 314.08 0.00 10.00 0.00 + 8550.00 314.24 0.00 10.00 0.00 + 8600.00 314.40 0.00 10.00 0.00 + 8650.00 314.56 0.00 10.00 0.00 + 8700.00 314.72 0.00 10.00 0.00 + 8750.00 314.88 0.00 10.00 0.00 + 8800.00 315.04 0.00 10.00 0.00 + 8850.00 315.20 0.00 10.00 0.00 + 8900.00 315.36 0.00 10.00 0.00 + 8950.00 315.52 0.00 10.00 0.00 + 9000.00 315.69 0.00 10.00 0.00 + 9050.00 315.85 0.00 10.00 0.00 + 9100.00 316.01 0.00 10.00 0.00 + 9150.00 316.17 0.00 10.00 0.00 + 9200.00 316.33 0.00 10.00 0.00 + 9250.00 316.49 0.00 10.00 0.00 + 9300.00 316.65 0.00 10.00 0.00 + 9350.00 316.81 0.00 10.00 0.00 + 9400.00 316.98 0.00 10.00 0.00 + 9450.00 317.14 0.00 10.00 0.00 + 9500.00 317.30 0.00 10.00 0.00 + 9550.00 317.46 0.00 10.00 0.00 + 9600.00 317.62 0.00 10.00 0.00 + 9650.00 317.78 0.00 10.00 0.00 + 9700.00 317.95 0.00 10.00 0.00 + 9750.00 318.11 0.00 10.00 0.00 + 9800.00 318.27 0.00 10.00 0.00 + 9850.00 318.43 0.00 10.00 0.00 + 9900.00 318.60 0.00 10.00 0.00 + 9950.00 318.76 0.00 10.00 0.00 + 10000.00 318.92 0.00 10.00 0.00 + 10050.00 319.08 0.00 10.00 0.00 + 10100.00 319.25 0.00 10.00 0.00 + 10150.00 319.41 0.00 10.00 0.00 + 10200.00 319.57 0.00 10.00 0.00 + 10250.00 319.74 0.00 10.00 0.00 + 10300.00 319.90 0.00 10.00 0.00 + 10350.00 320.06 0.00 10.00 0.00 + 10400.00 320.22 0.00 10.00 0.00 + 10450.00 320.39 0.00 10.00 0.00 + 10500.00 320.55 0.00 10.00 0.00 + 10550.00 320.72 0.00 10.00 0.00 + 10600.00 320.88 0.00 10.00 0.00 + 10650.00 321.04 0.00 10.00 0.00 + 10700.00 321.21 0.00 10.00 0.00 + 10750.00 321.37 0.00 10.00 0.00 + 10800.00 321.53 0.00 10.00 0.00 + 10850.00 321.70 0.00 10.00 0.00 + 10900.00 321.86 0.00 10.00 0.00 + 10950.00 322.03 0.00 10.00 0.00 + 11000.00 322.19 0.00 10.00 0.00 + 11050.00 322.35 0.00 10.00 0.00 + 11100.00 322.52 0.00 10.00 0.00 + 11150.00 322.68 0.00 10.00 0.00 + 11200.00 322.85 0.00 10.00 0.00 + 11250.00 323.01 0.00 10.00 0.00 + 11300.00 323.18 0.00 10.00 0.00 + 11350.00 323.34 0.00 10.00 0.00 + 11400.00 323.51 0.00 10.00 0.00 + 11450.00 323.67 0.00 10.00 0.00 + 11500.00 323.84 0.00 10.00 0.00 + 11550.00 324.00 0.00 10.00 0.00 + 11600.00 324.17 0.00 10.00 0.00 + 11650.00 324.33 0.00 10.00 0.00 + 11700.00 324.50 0.00 10.00 0.00 + 11750.00 324.66 0.00 10.00 0.00 + 11800.00 324.83 0.00 10.00 0.00 + 11850.00 325.00 0.00 10.00 0.00 + 11900.00 325.16 0.00 10.00 0.00 + 11950.00 325.33 0.00 10.00 0.00 + 12000.00 325.49 0.00 10.00 0.00 + 12050.00 325.66 0.00 10.00 0.00 + 12100.00 325.83 0.00 10.00 0.00 + 12150.00 325.99 0.00 10.00 0.00 + 12200.00 326.16 0.00 10.00 0.00 + 12250.00 326.32 0.00 10.00 0.00 + 12300.00 326.49 0.00 10.00 0.00 + 12350.00 326.66 0.00 10.00 0.00 + 12400.00 326.82 0.00 10.00 0.00 + 12450.00 326.99 0.00 10.00 0.00 + 12500.00 327.16 0.00 10.00 0.00 + 12550.00 327.32 0.00 10.00 0.00 + 12600.00 327.49 0.00 10.00 0.00 + 12650.00 327.66 0.00 10.00 0.00 + 12700.00 327.82 0.00 10.00 0.00 + 12750.00 327.99 0.00 10.00 0.00 + 12800.00 328.16 0.00 10.00 0.00 + 12850.00 328.33 0.00 10.00 0.00 + 12900.00 328.49 0.00 10.00 0.00 + 12950.00 328.66 0.00 10.00 0.00 + 13000.00 328.83 0.00 10.00 0.00 + 13050.00 329.00 0.00 10.00 0.00 + 13100.00 329.16 0.00 10.00 0.00 + 13150.00 329.33 0.00 10.00 0.00 + 13200.00 329.50 0.00 10.00 0.00 + 13250.00 329.67 0.00 10.00 0.00 + 13300.00 329.84 0.00 10.00 0.00 + 13350.00 330.01 0.00 10.00 0.00 + 13400.00 330.17 0.00 10.00 0.00 + 13450.00 330.34 0.00 10.00 0.00 + 13500.00 330.51 0.00 10.00 0.00 + 13550.00 330.68 0.00 10.00 0.00 + 13600.00 330.85 0.00 10.00 0.00 + 13650.00 331.02 0.00 10.00 0.00 + 13700.00 331.19 0.00 10.00 0.00 + 13750.00 331.35 0.00 10.00 0.00 + 13800.00 331.52 0.00 10.00 0.00 + 13850.00 331.69 0.00 10.00 0.00 + 13900.00 331.86 0.00 10.00 0.00 + 13950.00 332.03 0.00 10.00 0.00 + 14000.00 332.20 0.00 10.00 0.00 + 14050.00 332.37 0.00 10.00 0.00 + 14100.00 332.54 0.00 10.00 0.00 + 14150.00 332.71 0.00 10.00 0.00 + 14200.00 332.88 0.00 10.00 0.00 + 14250.00 333.05 0.00 10.00 0.00 + 14300.00 333.22 0.00 10.00 0.00 + 14350.00 333.39 0.00 10.00 0.00 + 14400.00 333.56 0.00 10.00 0.00 + 14450.00 333.73 0.00 10.00 0.00 + 14500.00 333.90 0.00 10.00 0.00 + 14550.00 334.07 0.00 10.00 0.00 + 14600.00 334.24 0.00 10.00 0.00 + 14650.00 334.41 0.00 10.00 0.00 + 14700.00 334.58 0.00 10.00 0.00 + 14750.00 334.75 0.00 10.00 0.00 + 14800.00 334.92 0.00 10.00 0.00 + 14850.00 335.09 0.00 10.00 0.00 + 14900.00 335.26 0.00 10.00 0.00 + 14950.00 335.43 0.00 10.00 0.00 + 15000.00 335.61 0.00 10.00 0.00 + 15050.00 335.78 0.00 10.00 0.00 + 15100.00 335.95 0.00 10.00 0.00 + 15150.00 336.12 0.00 10.00 0.00 + 15200.00 336.29 0.00 10.00 0.00 + 15250.00 336.46 0.00 10.00 0.00 + 15300.00 336.63 0.00 10.00 0.00 + 15350.00 336.81 0.00 10.00 0.00 + 15400.00 336.98 0.00 10.00 0.00 + 15450.00 337.15 0.00 10.00 0.00 + 15500.00 337.32 0.00 10.00 0.00 + 15550.00 337.49 0.00 10.00 0.00 + 15600.00 337.67 0.00 10.00 0.00 + 15650.00 337.84 0.00 10.00 0.00 + 15700.00 338.01 0.00 10.00 0.00 + 15750.00 338.18 0.00 10.00 0.00 + 15800.00 338.35 0.00 10.00 0.00 + 15850.00 338.53 0.00 10.00 0.00 + 15900.00 338.70 0.00 10.00 0.00 + 15950.00 338.87 0.00 10.00 0.00 + 16000.00 339.05 0.00 10.00 0.00 + 16050.00 339.22 0.00 10.00 0.00 + 16100.00 339.39 0.00 10.00 0.00 + 16150.00 339.56 0.00 10.00 0.00 + 16200.00 339.74 0.00 10.00 0.00 + 16250.00 339.91 0.00 10.00 0.00 + 16300.00 340.08 0.00 10.00 0.00 + 16350.00 340.26 0.00 10.00 0.00 + 16400.00 340.43 0.00 10.00 0.00 + 16450.00 340.60 0.00 10.00 0.00 + 16500.00 340.78 0.00 10.00 0.00 + 16550.00 340.95 0.00 10.00 0.00 + 16600.00 341.13 0.00 10.00 0.00 + 16650.00 341.30 0.00 10.00 0.00 + 16700.00 341.47 0.00 10.00 0.00 + 16750.00 341.65 0.00 10.00 0.00 + 16800.00 341.82 0.00 10.00 0.00 + 16850.00 342.00 0.00 10.00 0.00 + 16900.00 342.17 0.00 10.00 0.00 + 16950.00 342.35 0.00 10.00 0.00 + 17000.00 342.52 0.00 10.00 0.00 + 17050.00 342.70 0.00 10.00 0.00 + 17100.00 342.87 0.00 10.00 0.00 + 17150.00 343.05 0.00 10.00 0.00 + 17200.00 343.22 0.00 10.00 0.00 + 17250.00 343.40 0.00 10.00 0.00 + 17300.00 343.57 0.00 10.00 0.00 + 17350.00 343.75 0.00 10.00 0.00 + 17400.00 343.92 0.00 10.00 0.00 + 17450.00 344.10 0.00 10.00 0.00 + 17500.00 344.27 0.00 10.00 0.00 + 17550.00 344.45 0.00 10.00 0.00 + 17600.00 344.62 0.00 10.00 0.00 + 17650.00 344.80 0.00 10.00 0.00 + 17700.00 344.97 0.00 10.00 0.00 + 17750.00 345.15 0.00 10.00 0.00 + 17800.00 345.33 0.00 10.00 0.00 + 17850.00 345.50 0.00 10.00 0.00 + 17900.00 345.68 0.00 10.00 0.00 + 17950.00 345.86 0.00 10.00 0.00 + 18000.00 346.03 0.00 10.00 0.00 + 18050.00 346.21 0.00 10.00 0.00 + 18100.00 346.38 0.00 10.00 0.00 + 18150.00 346.56 0.00 10.00 0.00 + 18200.00 346.74 0.00 10.00 0.00 + 18250.00 346.92 0.00 10.00 0.00 + 18300.00 347.09 0.00 10.00 0.00 + 18350.00 347.27 0.00 10.00 0.00 + 18400.00 347.45 0.00 10.00 0.00 + 18450.00 347.62 0.00 10.00 0.00 + 18500.00 347.80 0.00 10.00 0.00 + 18550.00 347.98 0.00 10.00 0.00 + 18600.00 348.16 0.00 10.00 0.00 + 18650.00 348.33 0.00 10.00 0.00 + 18700.00 348.51 0.00 10.00 0.00 + 18750.00 348.69 0.00 10.00 0.00 + 18800.00 348.87 0.00 10.00 0.00 + 18850.00 349.04 0.00 10.00 0.00 + 18900.00 349.22 0.00 10.00 0.00 + 18950.00 349.40 0.00 10.00 0.00 + 19000.00 349.58 0.00 10.00 0.00 + 19050.00 349.76 0.00 10.00 0.00 + 19100.00 349.94 0.00 10.00 0.00 + 19150.00 350.11 0.00 10.00 0.00 + 19200.00 350.29 0.00 10.00 0.00 + 19250.00 350.47 0.00 10.00 0.00 + 19300.00 350.65 0.00 10.00 0.00 + 19350.00 350.83 0.00 10.00 0.00 + 19400.00 351.01 0.00 10.00 0.00 + 19450.00 351.19 0.00 10.00 0.00 + 19500.00 351.37 0.00 10.00 0.00 + 19550.00 351.55 0.00 10.00 0.00 + 19600.00 351.72 0.00 10.00 0.00 + 19650.00 351.90 0.00 10.00 0.00 + 19700.00 352.08 0.00 10.00 0.00 + 19750.00 352.26 0.00 10.00 0.00 + 19800.00 352.44 0.00 10.00 0.00 + 19850.00 352.62 0.00 10.00 0.00 + 19900.00 352.80 0.00 10.00 0.00 + 19950.00 352.98 0.00 10.00 0.00 + 20000.00 353.16 0.00 10.00 0.00 + 20050.00 353.34 0.00 10.00 0.00 + 20100.00 353.52 0.00 10.00 0.00 + 20150.00 353.70 0.00 10.00 0.00 + 20200.00 353.88 0.00 10.00 0.00 + 20250.00 354.06 0.00 10.00 0.00 + 20300.00 354.24 0.00 10.00 0.00 + 20350.00 354.43 0.00 10.00 0.00 + 20400.00 354.61 0.00 10.00 0.00 + 20450.00 354.79 0.00 10.00 0.00 + 20500.00 354.97 0.00 10.00 0.00 + 20550.00 355.15 0.00 10.00 0.00 + 20600.00 355.33 0.00 10.00 0.00 + 20650.00 355.51 0.00 10.00 0.00 + 20700.00 355.69 0.00 10.00 0.00 + 20750.00 355.87 0.00 10.00 0.00 + 20800.00 356.06 0.00 10.00 0.00 + 20850.00 356.24 0.00 10.00 0.00 + 20900.00 356.42 0.00 10.00 0.00 + 20950.00 356.60 0.00 10.00 0.00 + 21000.00 356.78 0.00 10.00 0.00 + 21050.00 356.96 0.00 10.00 0.00 + 21100.00 357.15 0.00 10.00 0.00 + 21150.00 357.33 0.00 10.00 0.00 + 21200.00 357.51 0.00 10.00 0.00 + 21250.00 357.69 0.00 10.00 0.00 + 21300.00 357.88 0.00 10.00 0.00 + 21350.00 358.06 0.00 10.00 0.00 + 21400.00 358.24 0.00 10.00 0.00 + 21450.00 358.42 0.00 10.00 0.00 + 21500.00 358.61 0.00 10.00 0.00 + 21550.00 358.79 0.00 10.00 0.00 + 21600.00 358.97 0.00 10.00 0.00 + 21650.00 359.16 0.00 10.00 0.00 + 21700.00 359.34 0.00 10.00 0.00 + 21750.00 359.52 0.00 10.00 0.00 + 21800.00 359.71 0.00 10.00 0.00 + 21850.00 359.89 0.00 10.00 0.00 + 21900.00 360.07 0.00 10.00 0.00 + 21950.00 360.26 0.00 10.00 0.00 + 22000.00 360.44 0.00 10.00 0.00 + 22050.00 360.62 0.00 10.00 0.00 + 22100.00 360.81 0.00 10.00 0.00 + 22150.00 360.99 0.00 10.00 0.00 + 22200.00 361.18 0.00 10.00 0.00 + 22250.00 361.36 0.00 10.00 0.00 + 22300.00 361.54 0.00 10.00 0.00 + 22350.00 361.73 0.00 10.00 0.00 + 22400.00 361.91 0.00 10.00 0.00 + 22450.00 362.10 0.00 10.00 0.00 + 22500.00 362.28 0.00 10.00 0.00 + 22550.00 362.47 0.00 10.00 0.00 + 22600.00 362.65 0.00 10.00 0.00 + 22650.00 362.84 0.00 10.00 0.00 + 22700.00 363.02 0.00 10.00 0.00 + 22750.00 363.21 0.00 10.00 0.00 + 22800.00 363.39 0.00 10.00 0.00 + 22850.00 363.58 0.00 10.00 0.00 + 22900.00 363.76 0.00 10.00 0.00 + 22950.00 363.95 0.00 10.00 0.00 + 23000.00 364.13 0.00 10.00 0.00 + 23050.00 364.32 0.00 10.00 0.00 + 23100.00 364.51 0.00 10.00 0.00 + 23150.00 364.69 0.00 10.00 0.00 + 23200.00 364.88 0.00 10.00 0.00 + 23250.00 365.06 0.00 10.00 0.00 + 23300.00 365.25 0.00 10.00 0.00 + 23350.00 365.44 0.00 10.00 0.00 + 23400.00 365.62 0.00 10.00 0.00 + 23450.00 365.81 0.00 10.00 0.00 + 23500.00 366.00 0.00 10.00 0.00 + 23550.00 366.18 0.00 10.00 0.00 + 23600.00 366.37 0.00 10.00 0.00 + 23650.00 366.56 0.00 10.00 0.00 + 23700.00 366.74 0.00 10.00 0.00 + 23750.00 366.93 0.00 10.00 0.00 + 23800.00 367.12 0.00 10.00 0.00 + 23850.00 367.30 0.00 10.00 0.00 + 23900.00 367.49 0.00 10.00 0.00 + 23950.00 367.68 0.00 10.00 0.00 + 24000.00 367.87 0.00 10.00 0.00 + 24050.00 368.05 0.00 10.00 0.00 + 24100.00 368.24 0.00 10.00 0.00 + 24150.00 368.43 0.00 10.00 0.00 + 24200.00 368.62 0.00 10.00 0.00 + 24250.00 368.81 0.00 10.00 0.00 + 24300.00 368.99 0.00 10.00 0.00 + 24350.00 369.18 0.00 10.00 0.00 + 24400.00 369.37 0.00 10.00 0.00 + 24450.00 369.56 0.00 10.00 0.00 + 24500.00 369.75 0.00 10.00 0.00 + 24550.00 369.94 0.00 10.00 0.00 + 24600.00 370.12 0.00 10.00 0.00 + 24650.00 370.31 0.00 10.00 0.00 + 24700.00 370.50 0.00 10.00 0.00 + 24750.00 370.69 0.00 10.00 0.00 + 24800.00 370.88 0.00 10.00 0.00 + 24850.00 371.07 0.00 10.00 0.00 + 24900.00 371.26 0.00 10.00 0.00 + 24950.00 371.45 0.00 10.00 0.00 + 25000.00 371.64 0.00 10.00 0.00 + 25050.00 371.83 0.00 10.00 0.00 + 25100.00 372.02 0.00 10.00 0.00 + 25150.00 372.21 0.00 10.00 0.00 + 25200.00 372.40 0.00 10.00 0.00 + 25250.00 372.59 0.00 10.00 0.00 + 25300.00 372.78 0.00 10.00 0.00 + 25350.00 372.97 0.00 10.00 0.00 + 25400.00 373.16 0.00 10.00 0.00 + 25450.00 373.35 0.00 10.00 0.00 + 25500.00 373.54 0.00 10.00 0.00 + 25550.00 373.73 0.00 10.00 0.00 + 25600.00 373.92 0.00 10.00 0.00 + 25650.00 374.11 0.00 10.00 0.00 + 25700.00 374.30 0.00 10.00 0.00 + 25750.00 374.49 0.00 10.00 0.00 + 25800.00 374.68 0.00 10.00 0.00 + 25850.00 374.87 0.00 10.00 0.00 + 25900.00 375.06 0.00 10.00 0.00 + 25950.00 375.26 0.00 10.00 0.00 + 26000.00 375.45 0.00 10.00 0.00 + 26050.00 375.64 0.00 10.00 0.00 + 26100.00 375.83 0.00 10.00 0.00 + 26150.00 376.02 0.00 10.00 0.00 + 26200.00 376.21 0.00 10.00 0.00 + 26250.00 376.41 0.00 10.00 0.00 + 26300.00 376.60 0.00 10.00 0.00 + 26350.00 376.79 0.00 10.00 0.00 + 26400.00 376.98 0.00 10.00 0.00 + 26450.00 377.17 0.00 10.00 0.00 + 26500.00 377.37 0.00 10.00 0.00 + 26550.00 377.56 0.00 10.00 0.00 + 26600.00 377.75 0.00 10.00 0.00 + 26650.00 377.94 0.00 10.00 0.00 + 26700.00 378.14 0.00 10.00 0.00 + 26750.00 378.33 0.00 10.00 0.00 + 26800.00 378.52 0.00 10.00 0.00 + 26850.00 378.72 0.00 10.00 0.00 + 26900.00 378.91 0.00 10.00 0.00 + 26950.00 379.10 0.00 10.00 0.00 + 27000.00 379.30 0.00 10.00 0.00 + 27050.00 379.49 0.00 10.00 0.00 + 27100.00 379.68 0.00 10.00 0.00 + 27150.00 379.88 0.00 10.00 0.00 + 27200.00 380.07 0.00 10.00 0.00 + 27250.00 380.26 0.00 10.00 0.00 + 27300.00 380.46 0.00 10.00 0.00 + 27350.00 380.65 0.00 10.00 0.00 + 27400.00 380.85 0.00 10.00 0.00 + 27450.00 381.04 0.00 10.00 0.00 + 27500.00 381.23 0.00 10.00 0.00 + 27550.00 381.43 0.00 10.00 0.00 + 27600.00 381.62 0.00 10.00 0.00 + 27650.00 381.82 0.00 10.00 0.00 + 27700.00 382.01 0.00 10.00 0.00 + 27750.00 382.21 0.00 10.00 0.00 + 27800.00 382.40 0.00 10.00 0.00 + 27850.00 382.60 0.00 10.00 0.00 + 27900.00 382.79 0.00 10.00 0.00 + 27950.00 382.99 0.00 10.00 0.00 + 28000.00 383.18 0.00 10.00 0.00 + 28050.00 383.38 0.00 10.00 0.00 + 28100.00 383.57 0.00 10.00 0.00 + 28150.00 383.77 0.00 10.00 0.00 + 28200.00 383.97 0.00 10.00 0.00 + 28250.00 384.16 0.00 10.00 0.00 + 28300.00 384.36 0.00 10.00 0.00 + 28350.00 384.55 0.00 10.00 0.00 + 28400.00 384.75 0.00 10.00 0.00 + 28450.00 384.95 0.00 10.00 0.00 + 28500.00 385.14 0.00 10.00 0.00 + 28550.00 385.34 0.00 10.00 0.00 + 28600.00 385.54 0.00 10.00 0.00 + 28650.00 385.73 0.00 10.00 0.00 + 28700.00 385.93 0.00 10.00 0.00 + 28750.00 386.13 0.00 10.00 0.00 + 28800.00 386.32 0.00 10.00 0.00 + 28850.00 386.52 0.00 10.00 0.00 + 28900.00 386.72 0.00 10.00 0.00 + 28950.00 386.91 0.00 10.00 0.00 + 29000.00 387.11 0.00 10.00 0.00 + 29050.00 387.31 0.00 10.00 0.00 + 29100.00 387.51 0.00 10.00 0.00 + 29150.00 387.70 0.00 10.00 0.00 + 29200.00 387.90 0.00 10.00 0.00 + 29250.00 388.10 0.00 10.00 0.00 + 29300.00 388.30 0.00 10.00 0.00 + 29350.00 388.50 0.00 10.00 0.00 + 29400.00 388.69 0.00 10.00 0.00 + 29450.00 388.89 0.00 10.00 0.00 + 29500.00 389.09 0.00 10.00 0.00 + 29550.00 389.29 0.00 10.00 0.00 + 29600.00 389.49 0.00 10.00 0.00 + 29650.00 389.69 0.00 10.00 0.00 + 29700.00 389.88 0.00 10.00 0.00 + 29750.00 390.08 0.00 10.00 0.00 + 29800.00 390.28 0.00 10.00 0.00 + 29850.00 390.48 0.00 10.00 0.00 + 29900.00 390.68 0.00 10.00 0.00 + 29950.00 390.88 0.00 10.00 0.00 + 30000.00 391.08 0.00 10.00 0.00 diff --git a/test/em_hill2d_x/input_sounding-U=15,N=0.01 b/test/em_hill2d_x/input_sounding-U=15,N=0.01 new file mode 100644 index 0000000000..9fb0e788d0 --- /dev/null +++ b/test/em_hill2d_x/input_sounding-U=15,N=0.01 @@ -0,0 +1,602 @@ + 1000.000 288.00 0.00 + 0.00 288.00 0.00 15.00 0.00 + 50.00 288.15 0.00 15.00 0.00 + 100.00 288.29 0.00 15.00 0.00 + 150.00 288.44 0.00 15.00 0.00 + 200.00 288.59 0.00 15.00 0.00 + 250.00 288.74 0.00 15.00 0.00 + 300.00 288.88 0.00 15.00 0.00 + 350.00 289.03 0.00 15.00 0.00 + 400.00 289.18 0.00 15.00 0.00 + 450.00 289.32 0.00 15.00 0.00 + 500.00 289.47 0.00 15.00 0.00 + 550.00 289.62 0.00 15.00 0.00 + 600.00 289.77 0.00 15.00 0.00 + 650.00 289.92 0.00 15.00 0.00 + 700.00 290.06 0.00 15.00 0.00 + 750.00 290.21 0.00 15.00 0.00 + 800.00 290.36 0.00 15.00 0.00 + 850.00 290.51 0.00 15.00 0.00 + 900.00 290.66 0.00 15.00 0.00 + 950.00 290.80 0.00 15.00 0.00 + 1000.00 290.95 0.00 15.00 0.00 + 1050.00 291.10 0.00 15.00 0.00 + 1100.00 291.25 0.00 15.00 0.00 + 1150.00 291.40 0.00 15.00 0.00 + 1200.00 291.55 0.00 15.00 0.00 + 1250.00 291.69 0.00 15.00 0.00 + 1300.00 291.84 0.00 15.00 0.00 + 1350.00 291.99 0.00 15.00 0.00 + 1400.00 292.14 0.00 15.00 0.00 + 1450.00 292.29 0.00 15.00 0.00 + 1500.00 292.44 0.00 15.00 0.00 + 1550.00 292.59 0.00 15.00 0.00 + 1600.00 292.74 0.00 15.00 0.00 + 1650.00 292.89 0.00 15.00 0.00 + 1700.00 293.04 0.00 15.00 0.00 + 1750.00 293.19 0.00 15.00 0.00 + 1800.00 293.34 0.00 15.00 0.00 + 1850.00 293.49 0.00 15.00 0.00 + 1900.00 293.63 0.00 15.00 0.00 + 1950.00 293.78 0.00 15.00 0.00 + 2000.00 293.93 0.00 15.00 0.00 + 2050.00 294.08 0.00 15.00 0.00 + 2100.00 294.23 0.00 15.00 0.00 + 2150.00 294.38 0.00 15.00 0.00 + 2200.00 294.53 0.00 15.00 0.00 + 2250.00 294.68 0.00 15.00 0.00 + 2300.00 294.84 0.00 15.00 0.00 + 2350.00 294.99 0.00 15.00 0.00 + 2400.00 295.14 0.00 15.00 0.00 + 2450.00 295.29 0.00 15.00 0.00 + 2500.00 295.44 0.00 15.00 0.00 + 2550.00 295.59 0.00 15.00 0.00 + 2600.00 295.74 0.00 15.00 0.00 + 2650.00 295.89 0.00 15.00 0.00 + 2700.00 296.04 0.00 15.00 0.00 + 2750.00 296.19 0.00 15.00 0.00 + 2800.00 296.34 0.00 15.00 0.00 + 2850.00 296.49 0.00 15.00 0.00 + 2900.00 296.64 0.00 15.00 0.00 + 2950.00 296.80 0.00 15.00 0.00 + 3000.00 296.95 0.00 15.00 0.00 + 3050.00 297.10 0.00 15.00 0.00 + 3100.00 297.25 0.00 15.00 0.00 + 3150.00 297.40 0.00 15.00 0.00 + 3200.00 297.55 0.00 15.00 0.00 + 3250.00 297.71 0.00 15.00 0.00 + 3300.00 297.86 0.00 15.00 0.00 + 3350.00 298.01 0.00 15.00 0.00 + 3400.00 298.16 0.00 15.00 0.00 + 3450.00 298.31 0.00 15.00 0.00 + 3500.00 298.47 0.00 15.00 0.00 + 3550.00 298.62 0.00 15.00 0.00 + 3600.00 298.77 0.00 15.00 0.00 + 3650.00 298.92 0.00 15.00 0.00 + 3700.00 299.07 0.00 15.00 0.00 + 3750.00 299.23 0.00 15.00 0.00 + 3800.00 299.38 0.00 15.00 0.00 + 3850.00 299.53 0.00 15.00 0.00 + 3900.00 299.69 0.00 15.00 0.00 + 3950.00 299.84 0.00 15.00 0.00 + 4000.00 299.99 0.00 15.00 0.00 + 4050.00 300.14 0.00 15.00 0.00 + 4100.00 300.30 0.00 15.00 0.00 + 4150.00 300.45 0.00 15.00 0.00 + 4200.00 300.60 0.00 15.00 0.00 + 4250.00 300.76 0.00 15.00 0.00 + 4300.00 300.91 0.00 15.00 0.00 + 4350.00 301.06 0.00 15.00 0.00 + 4400.00 301.22 0.00 15.00 0.00 + 4450.00 301.37 0.00 15.00 0.00 + 4500.00 301.53 0.00 15.00 0.00 + 4550.00 301.68 0.00 15.00 0.00 + 4600.00 301.83 0.00 15.00 0.00 + 4650.00 301.99 0.00 15.00 0.00 + 4700.00 302.14 0.00 15.00 0.00 + 4750.00 302.29 0.00 15.00 0.00 + 4800.00 302.45 0.00 15.00 0.00 + 4850.00 302.60 0.00 15.00 0.00 + 4900.00 302.76 0.00 15.00 0.00 + 4950.00 302.91 0.00 15.00 0.00 + 5000.00 303.07 0.00 15.00 0.00 + 5050.00 303.22 0.00 15.00 0.00 + 5100.00 303.38 0.00 15.00 0.00 + 5150.00 303.53 0.00 15.00 0.00 + 5200.00 303.69 0.00 15.00 0.00 + 5250.00 303.84 0.00 15.00 0.00 + 5300.00 304.00 0.00 15.00 0.00 + 5350.00 304.15 0.00 15.00 0.00 + 5400.00 304.31 0.00 15.00 0.00 + 5450.00 304.46 0.00 15.00 0.00 + 5500.00 304.62 0.00 15.00 0.00 + 5550.00 304.77 0.00 15.00 0.00 + 5600.00 304.93 0.00 15.00 0.00 + 5650.00 305.08 0.00 15.00 0.00 + 5700.00 305.24 0.00 15.00 0.00 + 5750.00 305.39 0.00 15.00 0.00 + 5800.00 305.55 0.00 15.00 0.00 + 5850.00 305.71 0.00 15.00 0.00 + 5900.00 305.86 0.00 15.00 0.00 + 5950.00 306.02 0.00 15.00 0.00 + 6000.00 306.17 0.00 15.00 0.00 + 6050.00 306.33 0.00 15.00 0.00 + 6100.00 306.49 0.00 15.00 0.00 + 6150.00 306.64 0.00 15.00 0.00 + 6200.00 306.80 0.00 15.00 0.00 + 6250.00 306.95 0.00 15.00 0.00 + 6300.00 307.11 0.00 15.00 0.00 + 6350.00 307.27 0.00 15.00 0.00 + 6400.00 307.42 0.00 15.00 0.00 + 6450.00 307.58 0.00 15.00 0.00 + 6500.00 307.74 0.00 15.00 0.00 + 6550.00 307.90 0.00 15.00 0.00 + 6600.00 308.05 0.00 15.00 0.00 + 6650.00 308.21 0.00 15.00 0.00 + 6700.00 308.37 0.00 15.00 0.00 + 6750.00 308.52 0.00 15.00 0.00 + 6800.00 308.68 0.00 15.00 0.00 + 6850.00 308.84 0.00 15.00 0.00 + 6900.00 309.00 0.00 15.00 0.00 + 6950.00 309.15 0.00 15.00 0.00 + 7000.00 309.31 0.00 15.00 0.00 + 7050.00 309.47 0.00 15.00 0.00 + 7100.00 309.63 0.00 15.00 0.00 + 7150.00 309.79 0.00 15.00 0.00 + 7200.00 309.94 0.00 15.00 0.00 + 7250.00 310.10 0.00 15.00 0.00 + 7300.00 310.26 0.00 15.00 0.00 + 7350.00 310.42 0.00 15.00 0.00 + 7400.00 310.58 0.00 15.00 0.00 + 7450.00 310.73 0.00 15.00 0.00 + 7500.00 310.89 0.00 15.00 0.00 + 7550.00 311.05 0.00 15.00 0.00 + 7600.00 311.21 0.00 15.00 0.00 + 7650.00 311.37 0.00 15.00 0.00 + 7700.00 311.53 0.00 15.00 0.00 + 7750.00 311.69 0.00 15.00 0.00 + 7800.00 311.85 0.00 15.00 0.00 + 7850.00 312.00 0.00 15.00 0.00 + 7900.00 312.16 0.00 15.00 0.00 + 7950.00 312.32 0.00 15.00 0.00 + 8000.00 312.48 0.00 15.00 0.00 + 8050.00 312.64 0.00 15.00 0.00 + 8100.00 312.80 0.00 15.00 0.00 + 8150.00 312.96 0.00 15.00 0.00 + 8200.00 313.12 0.00 15.00 0.00 + 8250.00 313.28 0.00 15.00 0.00 + 8300.00 313.44 0.00 15.00 0.00 + 8350.00 313.60 0.00 15.00 0.00 + 8400.00 313.76 0.00 15.00 0.00 + 8450.00 313.92 0.00 15.00 0.00 + 8500.00 314.08 0.00 15.00 0.00 + 8550.00 314.24 0.00 15.00 0.00 + 8600.00 314.40 0.00 15.00 0.00 + 8650.00 314.56 0.00 15.00 0.00 + 8700.00 314.72 0.00 15.00 0.00 + 8750.00 314.88 0.00 15.00 0.00 + 8800.00 315.04 0.00 15.00 0.00 + 8850.00 315.20 0.00 15.00 0.00 + 8900.00 315.36 0.00 15.00 0.00 + 8950.00 315.52 0.00 15.00 0.00 + 9000.00 315.69 0.00 15.00 0.00 + 9050.00 315.85 0.00 15.00 0.00 + 9100.00 316.01 0.00 15.00 0.00 + 9150.00 316.17 0.00 15.00 0.00 + 9200.00 316.33 0.00 15.00 0.00 + 9250.00 316.49 0.00 15.00 0.00 + 9300.00 316.65 0.00 15.00 0.00 + 9350.00 316.81 0.00 15.00 0.00 + 9400.00 316.98 0.00 15.00 0.00 + 9450.00 317.14 0.00 15.00 0.00 + 9500.00 317.30 0.00 15.00 0.00 + 9550.00 317.46 0.00 15.00 0.00 + 9600.00 317.62 0.00 15.00 0.00 + 9650.00 317.78 0.00 15.00 0.00 + 9700.00 317.95 0.00 15.00 0.00 + 9750.00 318.11 0.00 15.00 0.00 + 9800.00 318.27 0.00 15.00 0.00 + 9850.00 318.43 0.00 15.00 0.00 + 9900.00 318.60 0.00 15.00 0.00 + 9950.00 318.76 0.00 15.00 0.00 + 10000.00 318.92 0.00 15.00 0.00 + 10050.00 319.08 0.00 15.00 0.00 + 10100.00 319.25 0.00 15.00 0.00 + 10150.00 319.41 0.00 15.00 0.00 + 10200.00 319.57 0.00 15.00 0.00 + 10250.00 319.74 0.00 15.00 0.00 + 10300.00 319.90 0.00 15.00 0.00 + 10350.00 320.06 0.00 15.00 0.00 + 10400.00 320.22 0.00 15.00 0.00 + 10450.00 320.39 0.00 15.00 0.00 + 10500.00 320.55 0.00 15.00 0.00 + 10550.00 320.72 0.00 15.00 0.00 + 10600.00 320.88 0.00 15.00 0.00 + 10650.00 321.04 0.00 15.00 0.00 + 10700.00 321.21 0.00 15.00 0.00 + 10750.00 321.37 0.00 15.00 0.00 + 10800.00 321.53 0.00 15.00 0.00 + 10850.00 321.70 0.00 15.00 0.00 + 10900.00 321.86 0.00 15.00 0.00 + 10950.00 322.03 0.00 15.00 0.00 + 11000.00 322.19 0.00 15.00 0.00 + 11050.00 322.35 0.00 15.00 0.00 + 11100.00 322.52 0.00 15.00 0.00 + 11150.00 322.68 0.00 15.00 0.00 + 11200.00 322.85 0.00 15.00 0.00 + 11250.00 323.01 0.00 15.00 0.00 + 11300.00 323.18 0.00 15.00 0.00 + 11350.00 323.34 0.00 15.00 0.00 + 11400.00 323.51 0.00 15.00 0.00 + 11450.00 323.67 0.00 15.00 0.00 + 11500.00 323.84 0.00 15.00 0.00 + 11550.00 324.00 0.00 15.00 0.00 + 11600.00 324.17 0.00 15.00 0.00 + 11650.00 324.33 0.00 15.00 0.00 + 11700.00 324.50 0.00 15.00 0.00 + 11750.00 324.66 0.00 15.00 0.00 + 11800.00 324.83 0.00 15.00 0.00 + 11850.00 325.00 0.00 15.00 0.00 + 11900.00 325.16 0.00 15.00 0.00 + 11950.00 325.33 0.00 15.00 0.00 + 12000.00 325.49 0.00 15.00 0.00 + 12050.00 325.66 0.00 15.00 0.00 + 12100.00 325.83 0.00 15.00 0.00 + 12150.00 325.99 0.00 15.00 0.00 + 12200.00 326.16 0.00 15.00 0.00 + 12250.00 326.32 0.00 15.00 0.00 + 12300.00 326.49 0.00 15.00 0.00 + 12350.00 326.66 0.00 15.00 0.00 + 12400.00 326.82 0.00 15.00 0.00 + 12450.00 326.99 0.00 15.00 0.00 + 12500.00 327.16 0.00 15.00 0.00 + 12550.00 327.32 0.00 15.00 0.00 + 12600.00 327.49 0.00 15.00 0.00 + 12650.00 327.66 0.00 15.00 0.00 + 12700.00 327.82 0.00 15.00 0.00 + 12750.00 327.99 0.00 15.00 0.00 + 12800.00 328.16 0.00 15.00 0.00 + 12850.00 328.33 0.00 15.00 0.00 + 12900.00 328.49 0.00 15.00 0.00 + 12950.00 328.66 0.00 15.00 0.00 + 13000.00 328.83 0.00 15.00 0.00 + 13050.00 329.00 0.00 15.00 0.00 + 13100.00 329.16 0.00 15.00 0.00 + 13150.00 329.33 0.00 15.00 0.00 + 13200.00 329.50 0.00 15.00 0.00 + 13250.00 329.67 0.00 15.00 0.00 + 13300.00 329.84 0.00 15.00 0.00 + 13350.00 330.01 0.00 15.00 0.00 + 13400.00 330.17 0.00 15.00 0.00 + 13450.00 330.34 0.00 15.00 0.00 + 13500.00 330.51 0.00 15.00 0.00 + 13550.00 330.68 0.00 15.00 0.00 + 13600.00 330.85 0.00 15.00 0.00 + 13650.00 331.02 0.00 15.00 0.00 + 13700.00 331.19 0.00 15.00 0.00 + 13750.00 331.35 0.00 15.00 0.00 + 13800.00 331.52 0.00 15.00 0.00 + 13850.00 331.69 0.00 15.00 0.00 + 13900.00 331.86 0.00 15.00 0.00 + 13950.00 332.03 0.00 15.00 0.00 + 14000.00 332.20 0.00 15.00 0.00 + 14050.00 332.37 0.00 15.00 0.00 + 14100.00 332.54 0.00 15.00 0.00 + 14150.00 332.71 0.00 15.00 0.00 + 14200.00 332.88 0.00 15.00 0.00 + 14250.00 333.05 0.00 15.00 0.00 + 14300.00 333.22 0.00 15.00 0.00 + 14350.00 333.39 0.00 15.00 0.00 + 14400.00 333.56 0.00 15.00 0.00 + 14450.00 333.73 0.00 15.00 0.00 + 14500.00 333.90 0.00 15.00 0.00 + 14550.00 334.07 0.00 15.00 0.00 + 14600.00 334.24 0.00 15.00 0.00 + 14650.00 334.41 0.00 15.00 0.00 + 14700.00 334.58 0.00 15.00 0.00 + 14750.00 334.75 0.00 15.00 0.00 + 14800.00 334.92 0.00 15.00 0.00 + 14850.00 335.09 0.00 15.00 0.00 + 14900.00 335.26 0.00 15.00 0.00 + 14950.00 335.43 0.00 15.00 0.00 + 15000.00 335.61 0.00 15.00 0.00 + 15050.00 335.78 0.00 15.00 0.00 + 15100.00 335.95 0.00 15.00 0.00 + 15150.00 336.12 0.00 15.00 0.00 + 15200.00 336.29 0.00 15.00 0.00 + 15250.00 336.46 0.00 15.00 0.00 + 15300.00 336.63 0.00 15.00 0.00 + 15350.00 336.81 0.00 15.00 0.00 + 15400.00 336.98 0.00 15.00 0.00 + 15450.00 337.15 0.00 15.00 0.00 + 15500.00 337.32 0.00 15.00 0.00 + 15550.00 337.49 0.00 15.00 0.00 + 15600.00 337.67 0.00 15.00 0.00 + 15650.00 337.84 0.00 15.00 0.00 + 15700.00 338.01 0.00 15.00 0.00 + 15750.00 338.18 0.00 15.00 0.00 + 15800.00 338.35 0.00 15.00 0.00 + 15850.00 338.53 0.00 15.00 0.00 + 15900.00 338.70 0.00 15.00 0.00 + 15950.00 338.87 0.00 15.00 0.00 + 16000.00 339.05 0.00 15.00 0.00 + 16050.00 339.22 0.00 15.00 0.00 + 16100.00 339.39 0.00 15.00 0.00 + 16150.00 339.56 0.00 15.00 0.00 + 16200.00 339.74 0.00 15.00 0.00 + 16250.00 339.91 0.00 15.00 0.00 + 16300.00 340.08 0.00 15.00 0.00 + 16350.00 340.26 0.00 15.00 0.00 + 16400.00 340.43 0.00 15.00 0.00 + 16450.00 340.60 0.00 15.00 0.00 + 16500.00 340.78 0.00 15.00 0.00 + 16550.00 340.95 0.00 15.00 0.00 + 16600.00 341.13 0.00 15.00 0.00 + 16650.00 341.30 0.00 15.00 0.00 + 16700.00 341.47 0.00 15.00 0.00 + 16750.00 341.65 0.00 15.00 0.00 + 16800.00 341.82 0.00 15.00 0.00 + 16850.00 342.00 0.00 15.00 0.00 + 16900.00 342.17 0.00 15.00 0.00 + 16950.00 342.35 0.00 15.00 0.00 + 17000.00 342.52 0.00 15.00 0.00 + 17050.00 342.70 0.00 15.00 0.00 + 17100.00 342.87 0.00 15.00 0.00 + 17150.00 343.05 0.00 15.00 0.00 + 17200.00 343.22 0.00 15.00 0.00 + 17250.00 343.40 0.00 15.00 0.00 + 17300.00 343.57 0.00 15.00 0.00 + 17350.00 343.75 0.00 15.00 0.00 + 17400.00 343.92 0.00 15.00 0.00 + 17450.00 344.10 0.00 15.00 0.00 + 17500.00 344.27 0.00 15.00 0.00 + 17550.00 344.45 0.00 15.00 0.00 + 17600.00 344.62 0.00 15.00 0.00 + 17650.00 344.80 0.00 15.00 0.00 + 17700.00 344.97 0.00 15.00 0.00 + 17750.00 345.15 0.00 15.00 0.00 + 17800.00 345.33 0.00 15.00 0.00 + 17850.00 345.50 0.00 15.00 0.00 + 17900.00 345.68 0.00 15.00 0.00 + 17950.00 345.86 0.00 15.00 0.00 + 18000.00 346.03 0.00 15.00 0.00 + 18050.00 346.21 0.00 15.00 0.00 + 18100.00 346.38 0.00 15.00 0.00 + 18150.00 346.56 0.00 15.00 0.00 + 18200.00 346.74 0.00 15.00 0.00 + 18250.00 346.92 0.00 15.00 0.00 + 18300.00 347.09 0.00 15.00 0.00 + 18350.00 347.27 0.00 15.00 0.00 + 18400.00 347.45 0.00 15.00 0.00 + 18450.00 347.62 0.00 15.00 0.00 + 18500.00 347.80 0.00 15.00 0.00 + 18550.00 347.98 0.00 15.00 0.00 + 18600.00 348.16 0.00 15.00 0.00 + 18650.00 348.33 0.00 15.00 0.00 + 18700.00 348.51 0.00 15.00 0.00 + 18750.00 348.69 0.00 15.00 0.00 + 18800.00 348.87 0.00 15.00 0.00 + 18850.00 349.04 0.00 15.00 0.00 + 18900.00 349.22 0.00 15.00 0.00 + 18950.00 349.40 0.00 15.00 0.00 + 19000.00 349.58 0.00 15.00 0.00 + 19050.00 349.76 0.00 15.00 0.00 + 19100.00 349.94 0.00 15.00 0.00 + 19150.00 350.11 0.00 15.00 0.00 + 19200.00 350.29 0.00 15.00 0.00 + 19250.00 350.47 0.00 15.00 0.00 + 19300.00 350.65 0.00 15.00 0.00 + 19350.00 350.83 0.00 15.00 0.00 + 19400.00 351.01 0.00 15.00 0.00 + 19450.00 351.19 0.00 15.00 0.00 + 19500.00 351.37 0.00 15.00 0.00 + 19550.00 351.55 0.00 15.00 0.00 + 19600.00 351.72 0.00 15.00 0.00 + 19650.00 351.90 0.00 15.00 0.00 + 19700.00 352.08 0.00 15.00 0.00 + 19750.00 352.26 0.00 15.00 0.00 + 19800.00 352.44 0.00 15.00 0.00 + 19850.00 352.62 0.00 15.00 0.00 + 19900.00 352.80 0.00 15.00 0.00 + 19950.00 352.98 0.00 15.00 0.00 + 20000.00 353.16 0.00 15.00 0.00 + 20050.00 353.34 0.00 15.00 0.00 + 20100.00 353.52 0.00 15.00 0.00 + 20150.00 353.70 0.00 15.00 0.00 + 20200.00 353.88 0.00 15.00 0.00 + 20250.00 354.06 0.00 15.00 0.00 + 20300.00 354.24 0.00 15.00 0.00 + 20350.00 354.43 0.00 15.00 0.00 + 20400.00 354.61 0.00 15.00 0.00 + 20450.00 354.79 0.00 15.00 0.00 + 20500.00 354.97 0.00 15.00 0.00 + 20550.00 355.15 0.00 15.00 0.00 + 20600.00 355.33 0.00 15.00 0.00 + 20650.00 355.51 0.00 15.00 0.00 + 20700.00 355.69 0.00 15.00 0.00 + 20750.00 355.87 0.00 15.00 0.00 + 20800.00 356.06 0.00 15.00 0.00 + 20850.00 356.24 0.00 15.00 0.00 + 20900.00 356.42 0.00 15.00 0.00 + 20950.00 356.60 0.00 15.00 0.00 + 21000.00 356.78 0.00 15.00 0.00 + 21050.00 356.96 0.00 15.00 0.00 + 21100.00 357.15 0.00 15.00 0.00 + 21150.00 357.33 0.00 15.00 0.00 + 21200.00 357.51 0.00 15.00 0.00 + 21250.00 357.69 0.00 15.00 0.00 + 21300.00 357.88 0.00 15.00 0.00 + 21350.00 358.06 0.00 15.00 0.00 + 21400.00 358.24 0.00 15.00 0.00 + 21450.00 358.42 0.00 15.00 0.00 + 21500.00 358.61 0.00 15.00 0.00 + 21550.00 358.79 0.00 15.00 0.00 + 21600.00 358.97 0.00 15.00 0.00 + 21650.00 359.16 0.00 15.00 0.00 + 21700.00 359.34 0.00 15.00 0.00 + 21750.00 359.52 0.00 15.00 0.00 + 21800.00 359.71 0.00 15.00 0.00 + 21850.00 359.89 0.00 15.00 0.00 + 21900.00 360.07 0.00 15.00 0.00 + 21950.00 360.26 0.00 15.00 0.00 + 22000.00 360.44 0.00 15.00 0.00 + 22050.00 360.62 0.00 15.00 0.00 + 22100.00 360.81 0.00 15.00 0.00 + 22150.00 360.99 0.00 15.00 0.00 + 22200.00 361.18 0.00 15.00 0.00 + 22250.00 361.36 0.00 15.00 0.00 + 22300.00 361.54 0.00 15.00 0.00 + 22350.00 361.73 0.00 15.00 0.00 + 22400.00 361.91 0.00 15.00 0.00 + 22450.00 362.10 0.00 15.00 0.00 + 22500.00 362.28 0.00 15.00 0.00 + 22550.00 362.47 0.00 15.00 0.00 + 22600.00 362.65 0.00 15.00 0.00 + 22650.00 362.84 0.00 15.00 0.00 + 22700.00 363.02 0.00 15.00 0.00 + 22750.00 363.21 0.00 15.00 0.00 + 22800.00 363.39 0.00 15.00 0.00 + 22850.00 363.58 0.00 15.00 0.00 + 22900.00 363.76 0.00 15.00 0.00 + 22950.00 363.95 0.00 15.00 0.00 + 23000.00 364.13 0.00 15.00 0.00 + 23050.00 364.32 0.00 15.00 0.00 + 23100.00 364.51 0.00 15.00 0.00 + 23150.00 364.69 0.00 15.00 0.00 + 23200.00 364.88 0.00 15.00 0.00 + 23250.00 365.06 0.00 15.00 0.00 + 23300.00 365.25 0.00 15.00 0.00 + 23350.00 365.44 0.00 15.00 0.00 + 23400.00 365.62 0.00 15.00 0.00 + 23450.00 365.81 0.00 15.00 0.00 + 23500.00 366.00 0.00 15.00 0.00 + 23550.00 366.18 0.00 15.00 0.00 + 23600.00 366.37 0.00 15.00 0.00 + 23650.00 366.56 0.00 15.00 0.00 + 23700.00 366.74 0.00 15.00 0.00 + 23750.00 366.93 0.00 15.00 0.00 + 23800.00 367.12 0.00 15.00 0.00 + 23850.00 367.30 0.00 15.00 0.00 + 23900.00 367.49 0.00 15.00 0.00 + 23950.00 367.68 0.00 15.00 0.00 + 24000.00 367.87 0.00 15.00 0.00 + 24050.00 368.05 0.00 15.00 0.00 + 24100.00 368.24 0.00 15.00 0.00 + 24150.00 368.43 0.00 15.00 0.00 + 24200.00 368.62 0.00 15.00 0.00 + 24250.00 368.81 0.00 15.00 0.00 + 24300.00 368.99 0.00 15.00 0.00 + 24350.00 369.18 0.00 15.00 0.00 + 24400.00 369.37 0.00 15.00 0.00 + 24450.00 369.56 0.00 15.00 0.00 + 24500.00 369.75 0.00 15.00 0.00 + 24550.00 369.94 0.00 15.00 0.00 + 24600.00 370.12 0.00 15.00 0.00 + 24650.00 370.31 0.00 15.00 0.00 + 24700.00 370.50 0.00 15.00 0.00 + 24750.00 370.69 0.00 15.00 0.00 + 24800.00 370.88 0.00 15.00 0.00 + 24850.00 371.07 0.00 15.00 0.00 + 24900.00 371.26 0.00 15.00 0.00 + 24950.00 371.45 0.00 15.00 0.00 + 25000.00 371.64 0.00 15.00 0.00 + 25050.00 371.83 0.00 15.00 0.00 + 25100.00 372.02 0.00 15.00 0.00 + 25150.00 372.21 0.00 15.00 0.00 + 25200.00 372.40 0.00 15.00 0.00 + 25250.00 372.59 0.00 15.00 0.00 + 25300.00 372.78 0.00 15.00 0.00 + 25350.00 372.97 0.00 15.00 0.00 + 25400.00 373.16 0.00 15.00 0.00 + 25450.00 373.35 0.00 15.00 0.00 + 25500.00 373.54 0.00 15.00 0.00 + 25550.00 373.73 0.00 15.00 0.00 + 25600.00 373.92 0.00 15.00 0.00 + 25650.00 374.11 0.00 15.00 0.00 + 25700.00 374.30 0.00 15.00 0.00 + 25750.00 374.49 0.00 15.00 0.00 + 25800.00 374.68 0.00 15.00 0.00 + 25850.00 374.87 0.00 15.00 0.00 + 25900.00 375.06 0.00 15.00 0.00 + 25950.00 375.26 0.00 15.00 0.00 + 26000.00 375.45 0.00 15.00 0.00 + 26050.00 375.64 0.00 15.00 0.00 + 26100.00 375.83 0.00 15.00 0.00 + 26150.00 376.02 0.00 15.00 0.00 + 26200.00 376.21 0.00 15.00 0.00 + 26250.00 376.41 0.00 15.00 0.00 + 26300.00 376.60 0.00 15.00 0.00 + 26350.00 376.79 0.00 15.00 0.00 + 26400.00 376.98 0.00 15.00 0.00 + 26450.00 377.17 0.00 15.00 0.00 + 26500.00 377.37 0.00 15.00 0.00 + 26550.00 377.56 0.00 15.00 0.00 + 26600.00 377.75 0.00 15.00 0.00 + 26650.00 377.94 0.00 15.00 0.00 + 26700.00 378.14 0.00 15.00 0.00 + 26750.00 378.33 0.00 15.00 0.00 + 26800.00 378.52 0.00 15.00 0.00 + 26850.00 378.72 0.00 15.00 0.00 + 26900.00 378.91 0.00 15.00 0.00 + 26950.00 379.10 0.00 15.00 0.00 + 27000.00 379.30 0.00 15.00 0.00 + 27050.00 379.49 0.00 15.00 0.00 + 27100.00 379.68 0.00 15.00 0.00 + 27150.00 379.88 0.00 15.00 0.00 + 27200.00 380.07 0.00 15.00 0.00 + 27250.00 380.26 0.00 15.00 0.00 + 27300.00 380.46 0.00 15.00 0.00 + 27350.00 380.65 0.00 15.00 0.00 + 27400.00 380.85 0.00 15.00 0.00 + 27450.00 381.04 0.00 15.00 0.00 + 27500.00 381.23 0.00 15.00 0.00 + 27550.00 381.43 0.00 15.00 0.00 + 27600.00 381.62 0.00 15.00 0.00 + 27650.00 381.82 0.00 15.00 0.00 + 27700.00 382.01 0.00 15.00 0.00 + 27750.00 382.21 0.00 15.00 0.00 + 27800.00 382.40 0.00 15.00 0.00 + 27850.00 382.60 0.00 15.00 0.00 + 27900.00 382.79 0.00 15.00 0.00 + 27950.00 382.99 0.00 15.00 0.00 + 28000.00 383.18 0.00 15.00 0.00 + 28050.00 383.38 0.00 15.00 0.00 + 28100.00 383.57 0.00 15.00 0.00 + 28150.00 383.77 0.00 15.00 0.00 + 28200.00 383.97 0.00 15.00 0.00 + 28250.00 384.16 0.00 15.00 0.00 + 28300.00 384.36 0.00 15.00 0.00 + 28350.00 384.55 0.00 15.00 0.00 + 28400.00 384.75 0.00 15.00 0.00 + 28450.00 384.95 0.00 15.00 0.00 + 28500.00 385.14 0.00 15.00 0.00 + 28550.00 385.34 0.00 15.00 0.00 + 28600.00 385.54 0.00 15.00 0.00 + 28650.00 385.73 0.00 15.00 0.00 + 28700.00 385.93 0.00 15.00 0.00 + 28750.00 386.13 0.00 15.00 0.00 + 28800.00 386.32 0.00 15.00 0.00 + 28850.00 386.52 0.00 15.00 0.00 + 28900.00 386.72 0.00 15.00 0.00 + 28950.00 386.91 0.00 15.00 0.00 + 29000.00 387.11 0.00 15.00 0.00 + 29050.00 387.31 0.00 15.00 0.00 + 29100.00 387.51 0.00 15.00 0.00 + 29150.00 387.70 0.00 15.00 0.00 + 29200.00 387.90 0.00 15.00 0.00 + 29250.00 388.10 0.00 15.00 0.00 + 29300.00 388.30 0.00 15.00 0.00 + 29350.00 388.50 0.00 15.00 0.00 + 29400.00 388.69 0.00 15.00 0.00 + 29450.00 388.89 0.00 15.00 0.00 + 29500.00 389.09 0.00 15.00 0.00 + 29550.00 389.29 0.00 15.00 0.00 + 29600.00 389.49 0.00 15.00 0.00 + 29650.00 389.69 0.00 15.00 0.00 + 29700.00 389.88 0.00 15.00 0.00 + 29750.00 390.08 0.00 15.00 0.00 + 29800.00 390.28 0.00 15.00 0.00 + 29850.00 390.48 0.00 15.00 0.00 + 29900.00 390.68 0.00 15.00 0.00 + 29950.00 390.88 0.00 15.00 0.00 + 30000.00 391.08 0.00 15.00 0.00 diff --git a/test/em_hill2d_x/input_sounding-layers-20mps b/test/em_hill2d_x/input_sounding-layers-20mps new file mode 100644 index 0000000000..22d523be75 --- /dev/null +++ b/test/em_hill2d_x/input_sounding-layers-20mps @@ -0,0 +1,602 @@ + 1000.000 288.00 0.00 + 0.00 288.00 0.00 0.00 0.00 + 50.00 288.15 0.00 0.00 0.00 + 100.00 288.29 0.00 0.00 0.00 + 150.00 288.44 0.00 0.00 0.00 + 200.00 288.59 0.00 0.00 0.00 + 250.00 288.73 0.00 0.00 0.00 + 300.00 288.88 0.00 0.00 0.00 + 350.00 289.03 0.00 0.00 0.00 + 400.00 289.18 0.00 0.00 0.00 + 450.00 289.32 0.00 0.00 0.00 + 500.00 289.47 0.00 0.00 0.00 + 550.00 289.62 0.00 0.00 0.00 + 600.00 289.77 0.00 0.00 0.00 + 650.00 289.91 0.00 0.00 0.00 + 700.00 290.06 0.00 0.00 0.00 + 750.00 290.21 0.00 0.00 0.00 + 800.00 290.36 0.00 0.00 0.00 + 850.00 290.51 0.00 0.00 0.00 + 900.00 290.65 0.00 0.00 0.00 + 950.00 290.80 0.00 0.00 0.00 + 1000.00 290.95 0.00 0.00 0.00 + 1050.00 291.10 0.00 0.00 0.00 + 1100.00 291.25 0.00 0.00 0.00 + 1150.00 291.40 0.00 0.00 0.00 + 1200.00 291.54 0.00 0.00 0.00 + 1250.00 291.69 0.00 0.00 0.00 + 1300.00 291.84 0.00 0.00 0.00 + 1350.00 291.99 0.00 0.00 0.00 + 1400.00 292.14 0.00 0.00 0.00 + 1450.00 292.29 0.00 0.00 0.00 + 1500.00 292.44 0.00 0.00 0.00 + 1550.00 292.59 0.00 0.00 0.00 + 1600.00 292.74 0.00 0.00 0.00 + 1650.00 292.89 0.00 0.00 0.00 + 1700.00 293.03 0.00 0.00 0.00 + 1750.00 293.18 0.00 0.00 0.00 + 1800.00 293.33 0.00 0.00 0.00 + 1850.00 293.48 0.00 0.00 0.00 + 1900.00 293.63 0.00 0.00 0.00 + 1950.00 293.78 0.00 0.00 0.00 + 2000.00 293.93 0.00 0.00 0.00 + 2050.00 294.08 0.00 0.00 0.00 + 2100.00 294.23 0.00 0.00 0.00 + 2150.00 294.38 0.00 0.00 0.00 + 2200.00 294.53 0.00 0.00 0.00 + 2250.00 294.68 0.00 0.00 0.00 + 2300.00 294.83 0.00 0.00 0.00 + 2350.00 294.98 0.00 0.00 0.00 + 2400.00 295.13 0.00 0.00 0.00 + 2450.00 295.28 0.00 0.00 0.00 + 2500.00 295.43 0.00 0.00 0.00 + 2550.00 295.59 0.00 0.00 0.00 + 2600.00 295.74 0.00 0.00 0.00 + 2650.00 295.89 0.00 0.00 0.00 + 2700.00 296.04 0.00 0.00 0.00 + 2750.00 296.19 0.00 0.00 0.00 + 2800.00 296.34 0.00 0.00 0.00 + 2850.00 296.49 0.00 0.00 0.00 + 2900.00 296.64 0.00 0.00 0.00 + 2950.00 296.79 0.00 0.00 0.00 + 3000.00 296.94 0.00 0.00 0.00 + 3050.00 297.10 0.00 0.00 0.00 + 3100.00 297.25 0.00 0.00 0.00 + 3150.00 297.40 0.00 0.00 0.00 + 3200.00 297.55 0.00 0.00 0.00 + 3250.00 297.70 0.00 0.00 0.00 + 3300.00 297.85 0.00 0.00 0.00 + 3350.00 298.01 0.00 0.00 0.00 + 3400.00 298.16 0.00 0.00 0.00 + 3450.00 298.31 0.00 0.00 0.00 + 3500.00 298.46 0.00 0.00 0.00 + 3550.00 298.61 0.00 0.00 0.00 + 3600.00 298.77 0.00 0.00 0.00 + 3650.00 298.92 0.00 0.00 0.00 + 3700.00 299.07 0.00 0.00 0.00 + 3750.00 299.22 0.00 0.00 0.00 + 3800.00 299.38 0.00 0.00 0.00 + 3850.00 299.53 0.00 0.00 0.00 + 3900.00 299.68 0.00 0.00 0.00 + 3950.00 299.83 0.00 0.00 0.00 + 4000.00 299.99 0.00 0.00 0.00 + 4050.00 300.14 0.00 0.00 0.00 + 4100.00 300.29 0.00 0.00 0.00 + 4150.00 300.45 0.00 0.00 0.00 + 4200.00 300.60 0.00 0.00 0.00 + 4250.00 300.75 0.00 0.00 0.00 + 4300.00 300.91 0.00 0.00 0.00 + 4350.00 301.06 0.00 0.00 0.00 + 4400.00 301.21 0.00 0.00 0.00 + 4450.00 301.37 0.00 0.00 0.00 + 4500.00 301.52 0.00 0.00 0.00 + 4550.00 301.67 0.00 0.00 0.00 + 4600.00 301.83 0.00 0.00 0.00 + 4650.00 301.98 0.00 0.00 0.00 + 4700.00 302.14 0.00 0.00 0.00 + 4750.00 302.29 0.00 0.00 0.00 + 4800.00 302.44 0.00 0.00 0.00 + 4850.00 302.60 0.00 0.00 0.00 + 4900.00 302.75 0.00 0.00 0.00 + 4950.00 302.91 0.00 0.00 0.00 + 5000.00 303.06 0.00 0.00 0.00 + 5050.00 303.22 0.00 0.00 0.00 + 5100.00 303.37 0.00 0.00 0.00 + 5150.00 303.52 0.00 0.00 0.00 + 5200.00 303.68 0.00 0.00 0.00 + 5250.00 303.83 0.00 0.00 0.00 + 5300.00 303.99 0.00 0.00 0.00 + 5350.00 304.14 0.00 0.00 0.00 + 5400.00 304.30 0.00 0.00 0.00 + 5450.00 304.45 0.00 0.00 0.00 + 5500.00 304.61 0.00 0.00 0.00 + 5550.00 304.76 0.00 0.00 0.00 + 5600.00 304.92 0.00 0.00 0.00 + 5650.00 305.08 0.00 0.00 0.00 + 5700.00 305.23 0.00 0.00 0.00 + 5750.00 305.39 0.00 0.00 0.00 + 5800.00 305.54 0.00 0.00 0.00 + 5850.00 305.70 0.00 0.00 0.00 + 5900.00 305.85 0.00 0.00 0.00 + 5950.00 306.01 0.00 0.00 0.00 + 6000.00 306.17 0.00 0.00 0.00 + 6050.00 306.32 0.00 0.25 0.00 + 6100.00 306.48 0.00 0.50 0.00 + 6150.00 306.63 0.00 0.75 0.00 + 6200.00 306.79 0.00 1.00 0.00 + 6250.00 306.95 0.00 1.25 0.00 + 6300.00 307.10 0.00 1.50 0.00 + 6350.00 307.26 0.00 1.75 0.00 + 6400.00 307.42 0.00 2.00 0.00 + 6450.00 307.57 0.00 2.25 0.00 + 6500.00 307.73 0.00 2.50 0.00 + 6550.00 307.89 0.00 2.75 0.00 + 6600.00 308.04 0.00 3.00 0.00 + 6650.00 308.20 0.00 3.25 0.00 + 6700.00 308.36 0.00 3.50 0.00 + 6750.00 308.52 0.00 3.75 0.00 + 6800.00 308.67 0.00 4.00 0.00 + 6850.00 308.83 0.00 4.25 0.00 + 6900.00 308.99 0.00 4.50 0.00 + 6950.00 309.15 0.00 4.75 0.00 + 7000.00 309.30 0.00 5.00 0.00 + 7050.00 309.46 0.00 5.25 0.00 + 7100.00 309.62 0.00 5.50 0.00 + 7150.00 309.78 0.00 5.75 0.00 + 7200.00 309.93 0.00 6.00 0.00 + 7250.00 310.09 0.00 6.25 0.00 + 7300.00 310.25 0.00 6.50 0.00 + 7350.00 310.41 0.00 6.75 0.00 + 7400.00 310.57 0.00 7.00 0.00 + 7450.00 310.73 0.00 7.25 0.00 + 7500.00 310.88 0.00 7.50 0.00 + 7550.00 311.04 0.00 7.75 0.00 + 7600.00 311.20 0.00 8.00 0.00 + 7650.00 311.36 0.00 8.25 0.00 + 7700.00 311.52 0.00 8.50 0.00 + 7750.00 311.68 0.00 8.75 0.00 + 7800.00 311.84 0.00 9.00 0.00 + 7850.00 312.00 0.00 9.25 0.00 + 7900.00 312.15 0.00 9.50 0.00 + 7950.00 312.31 0.00 9.75 0.00 + 8000.00 312.47 0.00 10.00 0.00 + 8050.00 312.63 0.00 10.25 0.00 + 8100.00 312.79 0.00 10.50 0.00 + 8150.00 312.95 0.00 10.75 0.00 + 8200.00 313.11 0.00 11.00 0.00 + 8250.00 313.27 0.00 11.25 0.00 + 8300.00 313.43 0.00 11.50 0.00 + 8350.00 313.59 0.00 11.75 0.00 + 8400.00 313.75 0.00 12.00 0.00 + 8450.00 313.91 0.00 12.25 0.00 + 8500.00 314.07 0.00 12.50 0.00 + 8550.00 314.23 0.00 12.75 0.00 + 8600.00 314.39 0.00 13.00 0.00 + 8650.00 314.55 0.00 13.25 0.00 + 8700.00 314.71 0.00 13.50 0.00 + 8750.00 314.87 0.00 13.75 0.00 + 8800.00 315.03 0.00 14.00 0.00 + 8850.00 315.19 0.00 14.25 0.00 + 8900.00 315.35 0.00 14.50 0.00 + 8950.00 315.51 0.00 14.75 0.00 + 9000.00 315.67 0.00 15.00 0.00 + 9050.00 315.84 0.00 15.25 0.00 + 9100.00 316.00 0.00 15.50 0.00 + 9150.00 316.16 0.00 15.75 0.00 + 9200.00 316.32 0.00 16.00 0.00 + 9250.00 316.48 0.00 16.25 0.00 + 9300.00 316.64 0.00 16.50 0.00 + 9350.00 316.80 0.00 16.75 0.00 + 9400.00 316.96 0.00 17.00 0.00 + 9450.00 317.13 0.00 17.25 0.00 + 9500.00 317.29 0.00 17.50 0.00 + 9550.00 317.45 0.00 17.75 0.00 + 9600.00 317.61 0.00 18.00 0.00 + 9650.00 317.77 0.00 18.25 0.00 + 9700.00 317.94 0.00 18.50 0.00 + 9750.00 318.10 0.00 18.75 0.00 + 9800.00 318.26 0.00 19.00 0.00 + 9850.00 318.42 0.00 19.25 0.00 + 9900.00 318.58 0.00 19.50 0.00 + 9950.00 318.75 0.00 19.75 0.00 + 10000.00 319.40 0.00 20.00 0.00 + 10050.00 320.05 0.00 20.00 0.00 + 10100.00 320.70 0.00 20.00 0.00 + 10150.00 321.36 0.00 20.00 0.00 + 10200.00 322.01 0.00 20.00 0.00 + 10250.00 322.67 0.00 20.00 0.00 + 10300.00 323.33 0.00 20.00 0.00 + 10350.00 323.99 0.00 20.00 0.00 + 10400.00 324.65 0.00 20.00 0.00 + 10450.00 325.31 0.00 20.00 0.00 + 10500.00 325.98 0.00 20.00 0.00 + 10550.00 326.64 0.00 20.00 0.00 + 10600.00 327.31 0.00 20.00 0.00 + 10650.00 327.98 0.00 20.00 0.00 + 10700.00 328.65 0.00 20.00 0.00 + 10750.00 329.32 0.00 20.00 0.00 + 10800.00 329.99 0.00 20.00 0.00 + 10850.00 330.66 0.00 20.00 0.00 + 10900.00 331.34 0.00 20.00 0.00 + 10950.00 332.01 0.00 20.00 0.00 + 11000.00 332.69 0.00 20.00 0.00 + 11050.00 333.37 0.00 20.00 0.00 + 11100.00 334.05 0.00 20.00 0.00 + 11150.00 334.73 0.00 20.00 0.00 + 11200.00 335.41 0.00 20.00 0.00 + 11250.00 336.10 0.00 20.00 0.00 + 11300.00 336.78 0.00 20.00 0.00 + 11350.00 337.47 0.00 20.00 0.00 + 11400.00 338.16 0.00 20.00 0.00 + 11450.00 338.85 0.00 20.00 0.00 + 11500.00 339.54 0.00 20.00 0.00 + 11550.00 340.24 0.00 20.00 0.00 + 11600.00 340.93 0.00 20.00 0.00 + 11650.00 341.63 0.00 20.00 0.00 + 11700.00 342.32 0.00 20.00 0.00 + 11750.00 343.02 0.00 20.00 0.00 + 11800.00 343.72 0.00 20.00 0.00 + 11850.00 344.42 0.00 20.00 0.00 + 11900.00 345.13 0.00 20.00 0.00 + 11950.00 345.83 0.00 20.00 0.00 + 12000.00 346.54 0.00 20.00 0.00 + 12050.00 347.24 0.00 20.00 0.00 + 12100.00 347.95 0.00 20.00 0.00 + 12150.00 348.66 0.00 20.00 0.00 + 12200.00 349.37 0.00 20.00 0.00 + 12250.00 350.09 0.00 20.00 0.00 + 12300.00 350.80 0.00 20.00 0.00 + 12350.00 351.52 0.00 20.00 0.00 + 12400.00 352.23 0.00 20.00 0.00 + 12450.00 352.95 0.00 20.00 0.00 + 12500.00 353.67 0.00 20.00 0.00 + 12550.00 354.40 0.00 20.00 0.00 + 12600.00 355.12 0.00 20.00 0.00 + 12650.00 355.84 0.00 20.00 0.00 + 12700.00 356.57 0.00 20.00 0.00 + 12750.00 357.30 0.00 20.00 0.00 + 12800.00 358.03 0.00 20.00 0.00 + 12850.00 358.76 0.00 20.00 0.00 + 12900.00 359.49 0.00 20.00 0.00 + 12950.00 360.22 0.00 20.00 0.00 + 13000.00 360.96 0.00 20.00 0.00 + 13050.00 361.70 0.00 20.00 0.00 + 13100.00 362.43 0.00 20.00 0.00 + 13150.00 363.17 0.00 20.00 0.00 + 13200.00 363.91 0.00 20.00 0.00 + 13250.00 364.66 0.00 20.00 0.00 + 13300.00 365.40 0.00 20.00 0.00 + 13350.00 366.15 0.00 20.00 0.00 + 13400.00 366.89 0.00 20.00 0.00 + 13450.00 367.64 0.00 20.00 0.00 + 13500.00 368.39 0.00 20.00 0.00 + 13550.00 369.14 0.00 20.00 0.00 + 13600.00 369.90 0.00 20.00 0.00 + 13650.00 370.65 0.00 20.00 0.00 + 13700.00 371.41 0.00 20.00 0.00 + 13750.00 372.17 0.00 20.00 0.00 + 13800.00 372.93 0.00 20.00 0.00 + 13850.00 373.69 0.00 20.00 0.00 + 13900.00 374.45 0.00 20.00 0.00 + 13950.00 375.22 0.00 20.00 0.00 + 14000.00 375.98 0.00 20.00 0.00 + 14050.00 376.75 0.00 20.00 0.00 + 14100.00 377.52 0.00 20.00 0.00 + 14150.00 378.29 0.00 20.00 0.00 + 14200.00 379.06 0.00 20.00 0.00 + 14250.00 379.83 0.00 20.00 0.00 + 14300.00 380.61 0.00 20.00 0.00 + 14350.00 381.39 0.00 20.00 0.00 + 14400.00 382.16 0.00 20.00 0.00 + 14450.00 382.94 0.00 20.00 0.00 + 14500.00 383.72 0.00 20.00 0.00 + 14550.00 384.51 0.00 20.00 0.00 + 14600.00 385.29 0.00 20.00 0.00 + 14650.00 386.08 0.00 20.00 0.00 + 14700.00 386.87 0.00 20.00 0.00 + 14750.00 387.66 0.00 20.00 0.00 + 14800.00 388.45 0.00 20.00 0.00 + 14850.00 389.24 0.00 20.00 0.00 + 14900.00 390.03 0.00 20.00 0.00 + 14950.00 390.83 0.00 20.00 0.00 + 15000.00 391.63 0.00 20.00 0.00 + 15050.00 392.43 0.00 20.00 0.00 + 15100.00 393.23 0.00 20.00 0.00 + 15150.00 394.03 0.00 20.00 0.00 + 15200.00 394.84 0.00 20.00 0.00 + 15250.00 395.64 0.00 20.00 0.00 + 15300.00 396.45 0.00 20.00 0.00 + 15350.00 397.26 0.00 20.00 0.00 + 15400.00 398.07 0.00 20.00 0.00 + 15450.00 398.88 0.00 20.00 0.00 + 15500.00 399.70 0.00 20.00 0.00 + 15550.00 400.51 0.00 20.00 0.00 + 15600.00 401.33 0.00 20.00 0.00 + 15650.00 402.15 0.00 20.00 0.00 + 15700.00 402.97 0.00 20.00 0.00 + 15750.00 403.79 0.00 20.00 0.00 + 15800.00 404.61 0.00 20.00 0.00 + 15850.00 405.44 0.00 20.00 0.00 + 15900.00 406.27 0.00 20.00 0.00 + 15950.00 407.10 0.00 20.00 0.00 + 16000.00 407.93 0.00 20.00 0.00 + 16050.00 408.76 0.00 20.00 0.00 + 16100.00 409.59 0.00 20.00 0.00 + 16150.00 410.43 0.00 20.00 0.00 + 16200.00 411.27 0.00 20.00 0.00 + 16250.00 412.11 0.00 20.00 0.00 + 16300.00 412.95 0.00 20.00 0.00 + 16350.00 413.79 0.00 20.00 0.00 + 16400.00 414.64 0.00 20.00 0.00 + 16450.00 415.48 0.00 20.00 0.00 + 16500.00 416.33 0.00 20.00 0.00 + 16550.00 417.18 0.00 20.00 0.00 + 16600.00 418.03 0.00 20.00 0.00 + 16650.00 418.88 0.00 20.00 0.00 + 16700.00 419.74 0.00 20.00 0.00 + 16750.00 420.60 0.00 20.00 0.00 + 16800.00 421.45 0.00 20.00 0.00 + 16850.00 422.31 0.00 20.00 0.00 + 16900.00 423.18 0.00 20.00 0.00 + 16950.00 424.04 0.00 20.00 0.00 + 17000.00 424.90 0.00 20.00 0.00 + 17050.00 425.77 0.00 20.00 0.00 + 17100.00 426.64 0.00 20.00 0.00 + 17150.00 427.51 0.00 20.00 0.00 + 17200.00 428.38 0.00 20.00 0.00 + 17250.00 429.26 0.00 20.00 0.00 + 17300.00 430.13 0.00 20.00 0.00 + 17350.00 431.01 0.00 20.00 0.00 + 17400.00 431.89 0.00 20.00 0.00 + 17450.00 432.77 0.00 20.00 0.00 + 17500.00 433.66 0.00 20.00 0.00 + 17550.00 434.54 0.00 20.00 0.00 + 17600.00 435.43 0.00 20.00 0.00 + 17650.00 436.32 0.00 20.00 0.00 + 17700.00 437.21 0.00 20.00 0.00 + 17750.00 438.10 0.00 20.00 0.00 + 17800.00 438.99 0.00 20.00 0.00 + 17850.00 439.89 0.00 20.00 0.00 + 17900.00 440.79 0.00 20.00 0.00 + 17950.00 441.69 0.00 20.00 0.00 + 18000.00 442.59 0.00 20.00 0.00 + 18050.00 443.49 0.00 20.00 0.00 + 18100.00 444.40 0.00 20.00 0.00 + 18150.00 445.30 0.00 20.00 0.00 + 18200.00 446.21 0.00 20.00 0.00 + 18250.00 447.12 0.00 20.00 0.00 + 18300.00 448.04 0.00 20.00 0.00 + 18350.00 448.95 0.00 20.00 0.00 + 18400.00 449.87 0.00 20.00 0.00 + 18450.00 450.78 0.00 20.00 0.00 + 18500.00 451.70 0.00 20.00 0.00 + 18550.00 452.63 0.00 20.00 0.00 + 18600.00 453.55 0.00 20.00 0.00 + 18650.00 454.48 0.00 20.00 0.00 + 18700.00 455.40 0.00 20.00 0.00 + 18750.00 456.33 0.00 20.00 0.00 + 18800.00 457.26 0.00 20.00 0.00 + 18850.00 458.20 0.00 20.00 0.00 + 18900.00 459.13 0.00 20.00 0.00 + 18950.00 460.07 0.00 20.00 0.00 + 19000.00 461.01 0.00 20.00 0.00 + 19050.00 461.95 0.00 20.00 0.00 + 19100.00 462.89 0.00 20.00 0.00 + 19150.00 463.84 0.00 20.00 0.00 + 19200.00 464.78 0.00 20.00 0.00 + 19250.00 465.73 0.00 20.00 0.00 + 19300.00 466.68 0.00 20.00 0.00 + 19350.00 467.64 0.00 20.00 0.00 + 19400.00 468.59 0.00 20.00 0.00 + 19450.00 469.55 0.00 20.00 0.00 + 19500.00 470.50 0.00 20.00 0.00 + 19550.00 471.46 0.00 20.00 0.00 + 19600.00 472.43 0.00 20.00 0.00 + 19650.00 473.39 0.00 20.00 0.00 + 19700.00 474.36 0.00 20.00 0.00 + 19750.00 475.33 0.00 20.00 0.00 + 19800.00 476.30 0.00 20.00 0.00 + 19850.00 477.27 0.00 20.00 0.00 + 19900.00 478.24 0.00 20.00 0.00 + 19950.00 479.22 0.00 20.00 0.00 + 20000.00 480.20 0.00 20.00 0.00 + 20050.00 481.18 0.00 20.00 0.00 + 20100.00 482.16 0.00 20.00 0.00 + 20150.00 483.14 0.00 20.00 0.00 + 20200.00 484.13 0.00 20.00 0.00 + 20250.00 485.12 0.00 20.00 0.00 + 20300.00 486.11 0.00 20.00 0.00 + 20350.00 487.10 0.00 20.00 0.00 + 20400.00 488.09 0.00 20.00 0.00 + 20450.00 489.09 0.00 20.00 0.00 + 20500.00 490.09 0.00 20.00 0.00 + 20550.00 491.09 0.00 20.00 0.00 + 20600.00 492.09 0.00 20.00 0.00 + 20650.00 493.09 0.00 20.00 0.00 + 20700.00 494.10 0.00 20.00 0.00 + 20750.00 495.11 0.00 20.00 0.00 + 20800.00 496.12 0.00 20.00 0.00 + 20850.00 497.13 0.00 20.00 0.00 + 20900.00 498.14 0.00 20.00 0.00 + 20950.00 499.16 0.00 20.00 0.00 + 21000.00 500.18 0.00 20.00 0.00 + 21050.00 501.20 0.00 20.00 0.00 + 21100.00 502.22 0.00 20.00 0.00 + 21150.00 503.25 0.00 20.00 0.00 + 21200.00 504.28 0.00 20.00 0.00 + 21250.00 505.30 0.00 20.00 0.00 + 21300.00 506.34 0.00 20.00 0.00 + 21350.00 507.37 0.00 20.00 0.00 + 21400.00 508.41 0.00 20.00 0.00 + 21450.00 509.44 0.00 20.00 0.00 + 21500.00 510.48 0.00 20.00 0.00 + 21550.00 511.52 0.00 20.00 0.00 + 21600.00 512.57 0.00 20.00 0.00 + 21650.00 513.61 0.00 20.00 0.00 + 21700.00 514.66 0.00 20.00 0.00 + 21750.00 515.71 0.00 20.00 0.00 + 21800.00 516.77 0.00 20.00 0.00 + 21850.00 517.82 0.00 20.00 0.00 + 21900.00 518.88 0.00 20.00 0.00 + 21950.00 519.94 0.00 20.00 0.00 + 22000.00 521.00 0.00 20.00 0.00 + 22050.00 522.06 0.00 20.00 0.00 + 22100.00 523.13 0.00 20.00 0.00 + 22150.00 524.19 0.00 20.00 0.00 + 22200.00 525.26 0.00 20.00 0.00 + 22250.00 526.33 0.00 20.00 0.00 + 22300.00 527.41 0.00 20.00 0.00 + 22350.00 528.49 0.00 20.00 0.00 + 22400.00 529.56 0.00 20.00 0.00 + 22450.00 530.64 0.00 20.00 0.00 + 22500.00 531.73 0.00 20.00 0.00 + 22550.00 532.81 0.00 20.00 0.00 + 22600.00 533.90 0.00 20.00 0.00 + 22650.00 534.99 0.00 20.00 0.00 + 22700.00 536.08 0.00 20.00 0.00 + 22750.00 537.18 0.00 20.00 0.00 + 22800.00 538.27 0.00 20.00 0.00 + 22850.00 539.37 0.00 20.00 0.00 + 22900.00 540.47 0.00 20.00 0.00 + 22950.00 541.57 0.00 20.00 0.00 + 23000.00 542.68 0.00 20.00 0.00 + 23050.00 543.79 0.00 20.00 0.00 + 23100.00 544.90 0.00 20.00 0.00 + 23150.00 546.01 0.00 20.00 0.00 + 23200.00 547.12 0.00 20.00 0.00 + 23250.00 548.24 0.00 20.00 0.00 + 23300.00 549.36 0.00 20.00 0.00 + 23350.00 550.48 0.00 20.00 0.00 + 23400.00 551.60 0.00 20.00 0.00 + 23450.00 552.73 0.00 20.00 0.00 + 23500.00 553.86 0.00 20.00 0.00 + 23550.00 554.99 0.00 20.00 0.00 + 23600.00 556.12 0.00 20.00 0.00 + 23650.00 557.26 0.00 20.00 0.00 + 23700.00 558.39 0.00 20.00 0.00 + 23750.00 559.53 0.00 20.00 0.00 + 23800.00 560.67 0.00 20.00 0.00 + 23850.00 561.82 0.00 20.00 0.00 + 23900.00 562.96 0.00 20.00 0.00 + 23950.00 564.11 0.00 20.00 0.00 + 24000.00 565.27 0.00 20.00 0.00 + 24050.00 566.42 0.00 20.00 0.00 + 24100.00 567.57 0.00 20.00 0.00 + 24150.00 568.73 0.00 20.00 0.00 + 24200.00 569.89 0.00 20.00 0.00 + 24250.00 571.06 0.00 20.00 0.00 + 24300.00 572.22 0.00 20.00 0.00 + 24350.00 573.39 0.00 20.00 0.00 + 24400.00 574.56 0.00 20.00 0.00 + 24450.00 575.73 0.00 20.00 0.00 + 24500.00 576.91 0.00 20.00 0.00 + 24550.00 578.09 0.00 20.00 0.00 + 24600.00 579.27 0.00 20.00 0.00 + 24650.00 580.45 0.00 20.00 0.00 + 24700.00 581.63 0.00 20.00 0.00 + 24750.00 582.82 0.00 20.00 0.00 + 24800.00 584.01 0.00 20.00 0.00 + 24850.00 585.20 0.00 20.00 0.00 + 24900.00 586.39 0.00 20.00 0.00 + 24950.00 587.59 0.00 20.00 0.00 + 25000.00 588.79 0.00 20.00 0.00 + 25050.00 589.99 0.00 20.00 0.00 + 25100.00 591.20 0.00 20.00 0.00 + 25150.00 592.40 0.00 20.00 0.00 + 25200.00 593.61 0.00 20.00 0.00 + 25250.00 594.82 0.00 20.00 0.00 + 25300.00 596.04 0.00 20.00 0.00 + 25350.00 597.25 0.00 20.00 0.00 + 25400.00 598.47 0.00 20.00 0.00 + 25450.00 599.69 0.00 20.00 0.00 + 25500.00 600.92 0.00 20.00 0.00 + 25550.00 602.14 0.00 20.00 0.00 + 25600.00 603.37 0.00 20.00 0.00 + 25650.00 604.60 0.00 20.00 0.00 + 25700.00 605.84 0.00 20.00 0.00 + 25750.00 607.08 0.00 20.00 0.00 + 25800.00 608.31 0.00 20.00 0.00 + 25850.00 609.56 0.00 20.00 0.00 + 25900.00 610.80 0.00 20.00 0.00 + 25950.00 612.05 0.00 20.00 0.00 + 26000.00 613.30 0.00 20.00 0.00 + 26050.00 614.55 0.00 20.00 0.00 + 26100.00 615.80 0.00 20.00 0.00 + 26150.00 617.06 0.00 20.00 0.00 + 26200.00 618.32 0.00 20.00 0.00 + 26250.00 619.58 0.00 20.00 0.00 + 26300.00 620.84 0.00 20.00 0.00 + 26350.00 622.11 0.00 20.00 0.00 + 26400.00 623.38 0.00 20.00 0.00 + 26450.00 624.65 0.00 20.00 0.00 + 26500.00 625.93 0.00 20.00 0.00 + 26550.00 627.20 0.00 20.00 0.00 + 26600.00 628.48 0.00 20.00 0.00 + 26650.00 629.77 0.00 20.00 0.00 + 26700.00 631.05 0.00 20.00 0.00 + 26750.00 632.34 0.00 20.00 0.00 + 26800.00 633.63 0.00 20.00 0.00 + 26850.00 634.92 0.00 20.00 0.00 + 26900.00 636.22 0.00 20.00 0.00 + 26950.00 637.52 0.00 20.00 0.00 + 27000.00 638.82 0.00 20.00 0.00 + 27050.00 640.12 0.00 20.00 0.00 + 27100.00 641.43 0.00 20.00 0.00 + 27150.00 642.74 0.00 20.00 0.00 + 27200.00 644.05 0.00 20.00 0.00 + 27250.00 645.36 0.00 20.00 0.00 + 27300.00 646.68 0.00 20.00 0.00 + 27350.00 648.00 0.00 20.00 0.00 + 27400.00 649.32 0.00 20.00 0.00 + 27450.00 650.65 0.00 20.00 0.00 + 27500.00 651.98 0.00 20.00 0.00 + 27550.00 653.31 0.00 20.00 0.00 + 27600.00 654.64 0.00 20.00 0.00 + 27650.00 655.98 0.00 20.00 0.00 + 27700.00 657.32 0.00 20.00 0.00 + 27750.00 658.66 0.00 20.00 0.00 + 27800.00 660.00 0.00 20.00 0.00 + 27850.00 661.35 0.00 20.00 0.00 + 27900.00 662.70 0.00 20.00 0.00 + 27950.00 664.05 0.00 20.00 0.00 + 28000.00 665.41 0.00 20.00 0.00 + 28050.00 666.76 0.00 20.00 0.00 + 28100.00 668.13 0.00 20.00 0.00 + 28150.00 669.49 0.00 20.00 0.00 + 28200.00 670.85 0.00 20.00 0.00 + 28250.00 672.22 0.00 20.00 0.00 + 28300.00 673.60 0.00 20.00 0.00 + 28350.00 674.97 0.00 20.00 0.00 + 28400.00 676.35 0.00 20.00 0.00 + 28450.00 677.73 0.00 20.00 0.00 + 28500.00 679.11 0.00 20.00 0.00 + 28550.00 680.50 0.00 20.00 0.00 + 28600.00 681.89 0.00 20.00 0.00 + 28650.00 683.28 0.00 20.00 0.00 + 28700.00 684.67 0.00 20.00 0.00 + 28750.00 686.07 0.00 20.00 0.00 + 28800.00 687.47 0.00 20.00 0.00 + 28850.00 688.87 0.00 20.00 0.00 + 28900.00 690.28 0.00 20.00 0.00 + 28950.00 691.69 0.00 20.00 0.00 + 29000.00 693.10 0.00 20.00 0.00 + 29050.00 694.51 0.00 20.00 0.00 + 29100.00 695.93 0.00 20.00 0.00 + 29150.00 697.35 0.00 20.00 0.00 + 29200.00 698.77 0.00 20.00 0.00 + 29250.00 700.20 0.00 20.00 0.00 + 29300.00 701.63 0.00 20.00 0.00 + 29350.00 703.06 0.00 20.00 0.00 + 29400.00 704.50 0.00 20.00 0.00 + 29450.00 705.93 0.00 20.00 0.00 + 29500.00 707.38 0.00 20.00 0.00 + 29550.00 708.82 0.00 20.00 0.00 + 29600.00 710.27 0.00 20.00 0.00 + 29650.00 711.72 0.00 20.00 0.00 + 29700.00 713.17 0.00 20.00 0.00 + 29750.00 714.62 0.00 20.00 0.00 + 29800.00 716.08 0.00 20.00 0.00 + 29850.00 717.54 0.00 20.00 0.00 + 29900.00 719.01 0.00 20.00 0.00 + 29950.00 720.47 0.00 20.00 0.00 + 30000.00 721.95 0.00 20.00 0.00 diff --git a/test/em_hill2d_x/namelist.input b/test/em_hill2d_x/namelist.input index 7c1a1b24d9..c0998b695b 100644 --- a/test/em_hill2d_x/namelist.input +++ b/test/em_hill2d_x/namelist.input @@ -77,6 +77,8 @@ h_sca_adv_order = 5, v_sca_adv_order = 3, non_hydrostatic = .true., + hybrid_opt = 2 + etac = 0.2 / &bdy_control diff --git a/test/em_hill2d_x/namelist.input-100m_hill-10mps-N^2=0.0001-30km_deep-20km_damping-dampcoef=0.1-etac=0.2 b/test/em_hill2d_x/namelist.input-100m_hill-10mps-N^2=0.0001-30km_deep-20km_damping-dampcoef=0.1-etac=0.2 new file mode 100644 index 0000000000..b8274c64c3 --- /dev/null +++ b/test/em_hill2d_x/namelist.input-100m_hill-10mps-N^2=0.0001-30km_deep-20km_damping-dampcoef=0.1-etac=0.2 @@ -0,0 +1,101 @@ + &time_control + run_days = 0, + run_hours = 5, + run_minutes = 0, + run_seconds = 0, + start_year = 0001, + start_month = 01, + start_day = 01, + start_hour = 00, + start_minute = 00, + start_second = 00, + end_year = 0001, + end_month = 01, + end_day = 01, + end_hour = 10, + end_minute = 00, + end_second = 00, + history_interval = 60, + frames_per_outfile = 1, + restart = .false., + restart_interval = 120, + io_form_history = 2 + io_form_restart = 2 + io_form_input = 2 + io_form_boundary = 2 + debug_level = 0 + / + + &domains + time_step = 20, + time_step_fract_num = 0, + time_step_fract_den = 1, + max_dom = 1, + s_we = 1, + e_we = 202, + s_sn = 1, + e_sn = 3, + s_vert = 1, + e_vert = 41, + dx = 2000, + dy = 2000, + ztop = 30000., + / + + &physics + mp_physics = 0, + ra_lw_physics = 0, + ra_sw_physics = 0, + radt = 0, + sf_sfclay_physics = 0, + sf_surface_physics = 0, + bl_pbl_physics = 0, + bldt = 0, + cu_physics = 0, + cudt = 0, + num_soil_layers = 5, + / + + &fdda + / + + &dynamics + rk_ord = 3, + diff_opt = 2, 2, 2, + km_opt = 1, 1, 1, + damp_opt = 3, + zdamp = 20000., + dampcoef = .1, + khdif = 00, + kvdif = 0, + smdiv = 0.1, + emdiv = 0.01, + epssm = 0.1, + time_step_sound = 6, + h_mom_adv_order = 5, + v_mom_adv_order = 3, + h_sca_adv_order = 5, + v_sca_adv_order = 3, + non_hydrostatic = .true., + / + + &bdy_control + periodic_x = .false., + symmetric_xs = .false., + symmetric_xe = .false., + open_xs = .true., + open_xe = .true., + periodic_y = .true., + symmetric_ys = .false., + symmetric_ye = .false., + open_ys = .false., + open_ye = .false., + / + + &grib2 + / + + &namelist_quilt + nio_tasks_per_group = 0, + nio_groups = 1, + / diff --git a/test/em_hill2d_x/namelist.input-700m_hill-15mps-n^2=0.0001-25km_deep-15km_damping-dampcoef=0.08-etac=0.2 b/test/em_hill2d_x/namelist.input-700m_hill-15mps-n^2=0.0001-25km_deep-15km_damping-dampcoef=0.08-etac=0.2 new file mode 100644 index 0000000000..ca92aecf29 --- /dev/null +++ b/test/em_hill2d_x/namelist.input-700m_hill-15mps-n^2=0.0001-25km_deep-15km_damping-dampcoef=0.08-etac=0.2 @@ -0,0 +1,101 @@ + &time_control + run_days = 0, + run_hours = 5, + run_minutes = 0, + run_seconds = 0, + start_year = 0001, + start_month = 01, + start_day = 01, + start_hour = 00, + start_minute = 00, + start_second = 00, + end_year = 0001, + end_month = 01, + end_day = 01, + end_hour = 10, + end_minute = 00, + end_second = 00, + history_interval = 60, + frames_per_outfile = 1, + restart = .false., + restart_interval = 120, + io_form_history = 2 + io_form_restart = 2 + io_form_input = 2 + io_form_boundary = 2 + debug_level = 0 + / + + &domains + time_step = 20, + time_step_fract_num = 0, + time_step_fract_den = 1, + max_dom = 1, + s_we = 1, + e_we = 202, + s_sn = 1, + e_sn = 3, + s_vert = 1, + e_vert = 41, + dx = 2000, + dy = 2000, + ztop = 25000., + / + + &physics + mp_physics = 0, + ra_lw_physics = 0, + ra_sw_physics = 0, + radt = 0, + sf_sfclay_physics = 0, + sf_surface_physics = 0, + bl_pbl_physics = 0, + bldt = 0, + cu_physics = 0, + cudt = 0, + num_soil_layers = 5, + / + + &fdda + / + + &dynamics + rk_ord = 3, + diff_opt = 2, 2, 2, + km_opt = 1, 1, 1, + damp_opt = 3, + zdamp = 15000., + dampcoef = .08, + khdif = 00, + kvdif = 0, + smdiv = 0.1, + emdiv = 0.01, + epssm = 0.1, + time_step_sound = 6, + h_mom_adv_order = 5, + v_mom_adv_order = 3, + h_sca_adv_order = 5, + v_sca_adv_order = 3, + non_hydrostatic = .true., + / + + &bdy_control + periodic_x = .false., + symmetric_xs = .false., + symmetric_xe = .false., + open_xs = .true., + open_xe = .true., + periodic_y = .true., + symmetric_ys = .false., + symmetric_ye = .false., + open_ys = .false., + open_ye = .false., + / + + &grib2 + / + + &namelist_quilt + nio_tasks_per_group = 0, + nio_groups = 1, + / diff --git a/test/em_hill2d_x/namelist.input-HILL b/test/em_hill2d_x/namelist.input-HILL new file mode 100644 index 0000000000..042729c4db --- /dev/null +++ b/test/em_hill2d_x/namelist.input-HILL @@ -0,0 +1,103 @@ + &time_control + run_days = 0, + run_hours = 10, + run_minutes = 0, + run_seconds = 0, + start_year = 0001, + start_month = 01, + start_day = 01, + start_hour = 00, + start_minute = 00, + start_second = 00, + end_year = 0001, + end_month = 01, + end_day = 01, + end_hour = 10, + end_minute = 00, + end_second = 00, + history_interval = 60, + frames_per_outfile = 1, + restart = .false., + restart_interval = 120, + io_form_history = 2 + io_form_restart = 2 + io_form_input = 2 + io_form_boundary = 2 + debug_level = 0 + hybrid_opt = HYBRID_OPT + / + + &domains + time_step = 20, + time_step_fract_num = 0, + time_step_fract_den = 1, + max_dom = 1, + s_we = 1, + e_we = 202, + s_sn = 1, + e_sn = 3, + s_vert = 1, + e_vert = 41, + dx = 2000, + dy = 2000, + ztop = 30000., + / + + &physics + mp_physics = 0, + ra_lw_physics = 0, + ra_sw_physics = 0, + radt = 0, + sf_sfclay_physics = 0, + sf_surface_physics = 0, + bl_pbl_physics = 0, + bldt = 0, + cu_physics = 0, + cudt = 0, + num_soil_layers = 5, + / + + &fdda + / + + &dynamics + etac = ETAC + rk_ord = 3, + diff_opt = 2, 2, 2, + km_opt = 1, 1, 1, + damp_opt = 3, + zdamp = 20000., + dampcoef = .1, + khdif = 00, + kvdif = 0, + smdiv = 0.1, + emdiv = 0.01, + epssm = 0.1, + time_step_sound = 6, + h_mom_adv_order = 5, + v_mom_adv_order = 3, + h_sca_adv_order = 5, + v_sca_adv_order = 3, + non_hydrostatic = .true., + / + + &bdy_control + periodic_x = .false., + symmetric_xs = .false., + symmetric_xe = .false., + open_xs = .true., + open_xe = .true., + periodic_y = .true., + symmetric_ys = .false., + symmetric_ye = .false., + open_ys = .false., + open_ye = .false., + / + + &grib2 + / + + &namelist_quilt + nio_tasks_per_group = 0, + nio_groups = 1, + / diff --git a/test/em_hill2d_x/namelist.input-HILL-51 b/test/em_hill2d_x/namelist.input-HILL-51 new file mode 100644 index 0000000000..cf4d29cbae --- /dev/null +++ b/test/em_hill2d_x/namelist.input-HILL-51 @@ -0,0 +1,103 @@ + &time_control + run_days = 0, + run_hours = 10, + run_minutes = 0, + run_seconds = 0, + start_year = 0001, + start_month = 01, + start_day = 01, + start_hour = 00, + start_minute = 00, + start_second = 00, + end_year = 0001, + end_month = 01, + end_day = 01, + end_hour = 10, + end_minute = 00, + end_second = 00, + history_interval = 60, + frames_per_outfile = 1, + restart = .false., + restart_interval = 120, + io_form_history = 2 + io_form_restart = 2 + io_form_input = 2 + io_form_boundary = 2 + debug_level = 0 + hybrid_opt = HYBRID_OPT + / + + &domains + time_step = 20, + time_step_fract_num = 0, + time_step_fract_den = 1, + max_dom = 1, + s_we = 1, + e_we = 202, + s_sn = 1, + e_sn = 3, + s_vert = 1, + e_vert = 51, + dx = 2000, + dy = 2000, + ztop = 25000., + / + + &physics + mp_physics = 0, + ra_lw_physics = 0, + ra_sw_physics = 0, + radt = 0, + sf_sfclay_physics = 0, + sf_surface_physics = 0, + bl_pbl_physics = 0, + bldt = 0, + cu_physics = 0, + cudt = 0, + num_soil_layers = 5, + / + + &fdda + / + + &dynamics + etac = ETAC + rk_ord = 3, + diff_opt = 2, 2, 2, + km_opt = 1, 1, 1, + damp_opt = 3, + zdamp = 15000., + dampcoef = .08, + khdif = 00, + kvdif = 0, + smdiv = 0.1, + emdiv = 0.01, + epssm = 0.1, + time_step_sound = 6, + h_mom_adv_order = 5, + v_mom_adv_order = 3, + h_sca_adv_order = 5, + v_sca_adv_order = 3, + non_hydrostatic = .true., + / + + &bdy_control + periodic_x = .false., + symmetric_xs = .false., + symmetric_xe = .false., + open_xs = .true., + open_xe = .true., + periodic_y = .true., + symmetric_ys = .false., + symmetric_ye = .false., + open_ys = .false., + open_ye = .false., + / + + &grib2 + / + + &namelist_quilt + nio_tasks_per_group = 0, + nio_groups = 1, + / diff --git a/test/em_hill2d_x/namelist.input-HILL-schar b/test/em_hill2d_x/namelist.input-HILL-schar new file mode 100644 index 0000000000..5d899c0f00 --- /dev/null +++ b/test/em_hill2d_x/namelist.input-HILL-schar @@ -0,0 +1,103 @@ + &time_control + run_days = 0, + run_hours = 20, + run_minutes = 0, + run_seconds = 0, + start_year = 0001, + start_month = 01, + start_day = 01, + start_hour = 00, + start_minute = 00, + start_second = 00, + end_year = 0001, + end_month = 01, + end_day = 01, + end_hour = 10, + end_minute = 00, + end_second = 00, + history_interval = 60, + frames_per_outfile = 1, + restart = .false., + restart_interval = 120, + io_form_history = 2 + io_form_restart = 2 + io_form_input = 2 + io_form_boundary = 2 + debug_level = 0 + hybrid_opt = HYBRID_OPT + / + + &domains + time_step = 10, + time_step_fract_num = 0, + time_step_fract_den = 1, + max_dom = 1, + s_we = 1, + e_we = 202, + s_sn = 1, + e_sn = 3, + s_vert = 1, + e_vert = 41, + dx = 1000, + dy = 1000, + ztop = 20000., + / + + &physics + mp_physics = 0, + ra_lw_physics = 0, + ra_sw_physics = 0, + radt = 0, + sf_sfclay_physics = 0, + sf_surface_physics = 0, + bl_pbl_physics = 0, + bldt = 0, + cu_physics = 0, + cudt = 0, + num_soil_layers = 5, + / + + &fdda + / + + &dynamics + etac = ETAC + rk_ord = 3, + diff_opt = 0, 2, 2, + km_opt = 1, 1, 1, + damp_opt = 0, + zdamp = 0., + dampcoef = .08, + khdif = 00, + kvdif = 0, + smdiv = 0.1, + emdiv = 0.01, + epssm = 0.1, + time_step_sound = 6, + h_mom_adv_order = 5, + v_mom_adv_order = 3, + h_sca_adv_order = 5, + v_sca_adv_order = 3, + non_hydrostatic = .true., + / + + &bdy_control + periodic_x = .false., + symmetric_xs = .false., + symmetric_xe = .false., + open_xs = .true., + open_xe = .true., + periodic_y = .true., + symmetric_ys = .false., + symmetric_ye = .false., + open_ys = .false., + open_ye = .false., + / + + &grib2 + / + + &namelist_quilt + nio_tasks_per_group = 0, + nio_groups = 1, + / diff --git a/test/em_hill2d_x/test.csh b/test/em_hill2d_x/test.csh new file mode 100755 index 0000000000..43a2e56fe2 --- /dev/null +++ b/test/em_hill2d_x/test.csh @@ -0,0 +1,81 @@ +#!/bin/csh + +set TEST = TEST_1_100m_EXP +set TEST = TEST_2_700m_EXP +set TEST = TEST_3_2000m_SCHAR + +if ( $TEST == TEST_1_100m_EXP ) then + + if ( -d $TEST ) then + rm -rf $TEST + endif + mkdir $TEST + + cp input_sounding-U=10,N=0.01 input_sounding + + foreach opt ( TF HYBRID ) + echo start $TEST $opt `date` + mkdir $TEST/$opt + + if ( $opt == TF ) then + m4 -DETAC=0.0 -DHYBRID_OPT=0 namelist.input-HILL > namelist.input + else if ( $opt == HYBRID ) then + m4 -DETAC=0.2 -DHYBRID_OPT=2 namelist.input-HILL > namelist.input + endif + ideal.exe >& print.ideal.${TEST}.$opt + wrf.exe >& print.wrf.${TEST}.$opt + mv print.ideal.${TEST}.$opt print.wrf.${TEST}.$opt wrfi* wrfo* ${TEST}/$opt + cp namelist.input input_sounding ${TEST}/$opt + end + +else if ( $TEST == TEST_2_700m_EXP ) then + + if ( -d $TEST ) then + rm -rf $TEST + endif + mkdir $TEST + + cp input_sounding-U=15,N=0.01 input_sounding + + foreach opt ( TF HYBRID ) + echo start $TEST $opt `date` + mkdir $TEST/$opt + + if ( $opt == TF ) then + m4 -DETAC=0.0 -DHYBRID_OPT=0 namelist.input-HILL-51 > namelist.input + else if ( $opt == HYBRID ) then + m4 -DETAC=0.1 -DHYBRID_OPT=2 namelist.input-HILL-51 > namelist.input + endif + ideal.exe >& print.ideal.${TEST}.$opt + wrf.exe >& print.wrf.${TEST}.$opt + mv print.ideal.${TEST}.$opt print.wrf.${TEST}.$opt wrfi* wrfo* ${TEST}/$opt + cp namelist.input input_sounding ${TEST}/$opt + end + +else if ( $TEST == TEST_3_2000m_SCHAR ) then + + if ( -d $TEST ) then + rm -rf $TEST + endif + mkdir $TEST + + cp input_sounding-layers-20mps input_sounding + + foreach opt ( TF HYBRID ) + echo start $TEST $opt `date` + mkdir $TEST/$opt + + if ( $opt == TF ) then + m4 -DETAC=0.0 -DHYBRID_OPT=0 namelist.input-HILL-schar > namelist.input + else if ( $opt == HYBRID ) then + m4 -DETAC=0.4 -DHYBRID_OPT=2 namelist.input-HILL-schar > namelist.input + endif + ideal.exe >& print.ideal.${TEST}.$opt + wrf.exe >& print.wrf.${TEST}.$opt + mv print.ideal.${TEST}.$opt print.wrf.${TEST}.$opt wrfi* wrfo* ${TEST}/$opt + cp namelist.input input_sounding ${TEST}/$opt + end + +endif + +echo COMPLETE $TEST `date` diff --git a/test/em_real/namelist.input b/test/em_real/namelist.input index f1ff2ee87a..20cdfc465a 100755 --- a/test/em_real/namelist.input +++ b/test/em_real/namelist.input @@ -1,7 +1,7 @@ &time_control - run_days = 0, - run_hours = 12, - run_minutes = 0, + run_days = 0, + run_hours = 24, + run_minutes = 0, run_seconds = 0, start_year = 2000, 2000, 2000, start_month = 01, 01, 01, @@ -16,9 +16,9 @@ end_minute = 00, 00, 00, end_second = 00, 00, 00, interval_seconds = 21600 - input_from_file = .true.,.true.,.true., - history_interval = 180, 60, 60, - frames_per_outfile = 1000, 1000, 1000, + input_from_file = .true.,.false.,.false. + history_interval = 30, 60, 60, + frames_per_outfile = 1, 1000, 1000, restart = .false., restart_interval = 5000, io_form_history = 2 @@ -26,6 +26,7 @@ io_form_input = 2 io_form_boundary = 2 debug_level = 0 + auxinput1_inname = "met_em.d." / &domains @@ -37,7 +38,7 @@ e_sn = 61, 97, 91, e_vert = 30, 30, 30, p_top_requested = 5000, - num_metgrid_levels = 27, + num_metgrid_levels = 26, num_metgrid_soil_levels = 4, dx = 30000, 10000, 3333.33, dy = 30000, 10000, 3333.33, @@ -52,26 +53,26 @@ / &physics - mp_physics = 3, 3, 3, - ra_lw_physics = 1, 1, 1, - ra_sw_physics = 1, 1, 1, - radt = 30, 30, 30, - sf_sfclay_physics = 1, 1, 1, - sf_surface_physics = 2, 2, 2, - bl_pbl_physics = 1, 1, 1, + mp_physics = 8, 8, 8, + ra_lw_physics = 4, 4, 4, + ra_sw_physics = 4, 4, 4, + radt = 30, 21, 21, + sf_sfclay_physics = 5, 5, 5, + sf_surface_physics = 3, 3, 3, + topo_wind = 1, 1, 1, + bl_pbl_physics = 5, 5, 5, bldt = 0, 0, 0, - cu_physics = 1, 1, 0, - cudt = 5, 5, 5, + cu_physics = 3, 3, 0, + sf_urban_physics = 0, 0, 0, + shcu_physics = 0, 0, 0, + cudt = 0, 0, 0, isfflx = 1, ifsnow = 1, icloud = 1, surface_input_source = 3, - num_soil_layers = 4, - num_land_cat = 21, - sf_urban_physics = 0, 0, 0, - / - - &fdda + num_soil_layers = 9, + num_land_cat = 28, + mp_zero_out = 0, / &dynamics @@ -83,12 +84,16 @@ base_temp = 290. damp_opt = 0, zdamp = 5000., 5000., 5000., - dampcoef = 0.2, 0.2, 0.2 + dampcoef = 0.05, 0.05, 0.05 khdif = 0, 0, 0, kvdif = 0, 0, 0, non_hydrostatic = .true., .true., .true., moist_adv_opt = 1, 1, 1, scalar_adv_opt = 1, 1, 1, + chem_adv_opt = 0, 0, 0, + tke_adv_opt = 0, 0, 0, + hybrid_opt = 0 + etac = 0.3 / &bdy_control From 232dbf46a1dd214de01ad0ceeaf778121fb42b8d Mon Sep 17 00:00:00 2001 From: David Gill Date: Tue, 19 Jul 2016 03:29:24 +0000 Subject: [PATCH 3/7] Add the hybrid vertical coordinate to the DFI option. This was tested with dfi_opt=3. For the expected bit-for-bit results (hybrid_opt=0), everything is as it should be. M share/dfi.F M test/em_real/namelist.input git-svn-id: https://svn-wrf-model.cgd.ucar.edu/branches/HYBRID_COORDINATE_root=4929_start=20160705@9455 b0b5d27b-6f0f-0410-a2a3-cb1e977edc3d --- share/dfi.F | 79 +++++++++++++++++++++++++------------ test/em_real/namelist.input | 26 +++++++++++- 2 files changed, 78 insertions(+), 27 deletions(-) diff --git a/share/dfi.F b/share/dfi.F index 41d8ebf2d1..468f753dd6 100644 --- a/share/dfi.F +++ b/share/dfi.F @@ -1,3 +1,23 @@ +! sed -e "s/grid%mu/gridmu/g" -e "s/grid%Mu/gridMu/g" dfi.F | cpp -DHYBRID_COORD | sed -e "s/gridmu/grid%mu/g" -e "s/gridMu/grid%Mu/g" >> dfi.next +#if ( HYBRID_COORD==1 ) +# define gridmu_2(...) (grid%c1h(k)*XXPC2HXX(__VA_ARGS__)) +# define XXPC2HXX(...) grid%mu_2(__VA_ARGS__) + +# define gridmub(...) (grid%c1h(k)*XXPCBHXX(__VA_ARGS__)+grid%c2h(k)) +# define XXPCBHXX(...) grid%mub(__VA_ARGS__) + +# define gridMu_2(...) (grid%c1f(k)*XXPC2FXX(__VA_ARGS__)) +# define XXPC2FXX(...) grid%Mu_2(__VA_ARGS__) + +# define gridMub(...) (grid%c1f(k)*XXPCBFXX(__VA_ARGS__)+grid%c2f(k)) +# define XXPCBFXX(...) grid%Mub(__VA_ARGS__) +#endif + + + + + + SUBROUTINE dfi_accumulate( grid ) USE module_domain, ONLY : domain @@ -25,7 +45,7 @@ SUBROUTINE dfi_accumulate( grid ) hn = grid%hcoeff(grid%itimestep+1) ! accumulate dynamic variables - grid%dfi_mu(:,:) = grid%dfi_mu(:,:) + grid%mu_2(:,:) * hn + grid%dfi_mu(:,:) = grid%dfi_mu(:,:) + grid%MU_2(:,:) * hn grid%dfi_u(:,:,:) = grid%dfi_u(:,:,:) + grid%u_2(:,:,:) * hn grid%dfi_v(:,:,:) = grid%dfi_v(:,:,:) + grid%v_2(:,:,:) * hn grid%dfi_w(:,:,:) = grid%dfi_w(:,:,:) + grid%w_2(:,:,:) * hn @@ -663,7 +683,7 @@ SUBROUTINE dfi_array_reset( grid ) ! divide by total DFI coefficient #if (EM_CORE == 1) - grid%mu_2(:,:) = grid%dfi_mu(:,:) / grid%hcoeff_tot + grid%MU_2(:,:) = grid%dfi_mu(:,:) / grid%hcoeff_tot grid%u_2(:,:,:) = grid%dfi_u(:,:,:) / grid%hcoeff_tot grid%v_2(:,:,:) = grid%dfi_v(:,:,:) / grid%hcoeff_tot grid%w_2(:,:,:) = grid%dfi_w(:,:,:) / grid%hcoeff_tot @@ -3300,7 +3320,7 @@ SUBROUTINE rebalance_dfi ( grid & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte, & ips, ipe, jps, jpe, kps, kpe, & - i, j, k, ispe, ktf + i, j, k, kk, ispe, ktf SELECT CASE ( model_data_order ) CASE ( DATA_ORDER_ZXY ) @@ -3367,50 +3387,53 @@ SUBROUTINE rebalance_dfi ( grid & ! Integrate the hydrostatic equation (from the RHS of the bigstep vertical momentum ! equation) down from the top to get the pressure perturbation. First get the pressure ! perturbation, moisture, and inverse density (total and perturbation) at the top-most level. - k = kte-1 + kk = kte-1 + k=kk+1 qtot = 0. DO ispe=PARAM_FIRST_SCALAR,n_moist - qtot = qtot + 0.5*(moist(i,k,j,ispe)+moist(i,k,j,ispe)) + qtot = qtot + 0.5*(moist(i,kk,j,ispe)+moist(i,kk,j,ispe)) ENDDO qvf2 = 1./(1.+qtot) qvf1 = qtot*qvf2 - grid%p(i,k,j) = - 0.5*(grid%mu_2(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_2(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) - grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j) + grid%p(i,kk,j) = - 0.5*(grid%Mu_2(i,j)+qvf1*grid%Mub(i,j))/grid%rdnw(k)/qvf2 + qvf = 1.+rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & + (((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,j) + grid%p_hyd(i,kk,j) = grid%p(i,kk,j) + grid%pb(i,kk,j) ! Now, integrate down the column to compute the pressure perturbation, and diagnose the two ! inverse density fields (total and perturbation). - DO k=kte-2,1,-1 + DO kk=kte-2,1,-1 + k = kk + 1 qtot = 0. DO ispe=PARAM_FIRST_SCALAR,n_moist - qtot = qtot + 0.5*( moist(i,k ,j,ispe) + moist(i,k+1,j,ispe) ) + qtot = qtot + 0.5*( moist(i,kk ,j,ispe) + moist(i,kk+1,j,ispe) ) ENDDO qvf2 = 1./(1.+qtot) qvf1 = qtot*qvf2 - grid%p(i,k,j) = grid%p(i,k+1,j) - (grid%mu_2(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_2(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) - grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j) + grid%p(i,kk,j) = grid%p(i,kk+1,j) - (grid%Mu_2(i,j) + & + qvf1*grid%Mub(i,j))/qvf2/grid%rdn(k+1) + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & + (((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) + grid%al(i,kk,j) = grid%alt(i,kk,j) - grid%alb(i,kk,j) + grid%p_hyd(i,kk,j) = grid%p(i,kk,j) + grid%pb(i,kk,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. IF (grid%hypsometric_opt == 1) THEN - DO k = 2,kte - grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) - & - grid%dnw(k-1) * ( (grid%mub(i,j)+grid%mu_2(i,j))*grid%al(i,k-1,j) & - + grid%mu_2(i,j)*grid%alb(i,k-1,j) ) - grid%ph0(i,k,j) = grid%ph_2(i,k,j) + grid%phb(i,k,j) + DO kk = 2,kte + k = kk - 1 + grid%ph_2(i,kk,j) = grid%ph_2(i,kk-1,j) - & + grid%dnw(kk-1) * ( (grid%mub(i,j)+grid%mu_2(i,j))*grid%al(i,kk-1,j) & + + grid%mu_2(i,j)*grid%alb(i,kk-1,j) ) + grid%ph0(i,kk,j) = grid%ph_2(i,kk,j) + grid%phb(i,kk,j) END DO ELSE IF (grid%hypsometric_opt == 2) THEN ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is @@ -3421,9 +3444,15 @@ SUBROUTINE rebalance_dfi ( grid & grid%ph_2(i,1,j) = grid%phb(i,1,j) DO k = 2,kte +#if !( HYBRID_COORD==1 ) pfu = ( grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k) + grid%p_top pfd = ( grid%mub(i,j)+grid%mu_2(i,j))*grid%znw(k-1) + grid%p_top phm = ( grid%mub(i,j)+grid%mu_2(i,j))*grid%znu(k-1) + grid%p_top +#elif ( HYBRID_COORD==1 ) + pfu = grid%c3f(k )*(grid%MUB(i,j)+grid%MU_2(i,j)) + grid%c4f(k ) + grid%p_top + pfd = grid%c3f(k-1)*(grid%MUB(i,j)+grid%MU_2(i,j)) + grid%c4f(k-1) + grid%p_top + phm = grid%c3h(k-1)*(grid%MUB(i,j)+grid%MU_2(i,j)) + grid%c4h(k-1) + grid%p_top +#endif grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + grid%alt(i,k-1,j)*phm*LOG(pfd/pfu) END DO diff --git a/test/em_real/namelist.input b/test/em_real/namelist.input index 20cdfc465a..88e2314197 100755 --- a/test/em_real/namelist.input +++ b/test/em_real/namelist.input @@ -1,6 +1,6 @@ &time_control run_days = 0, - run_hours = 24, + run_hours = 24 run_minutes = 0, run_seconds = 0, start_year = 2000, 2000, 2000, @@ -33,6 +33,7 @@ time_step = 180, time_step_fract_num = 0, time_step_fract_den = 1, + time_step_dfi = 120, max_dom = 1, e_we = 74, 112, 94, e_sn = 61, 97, 91, @@ -92,7 +93,7 @@ scalar_adv_opt = 1, 1, 1, chem_adv_opt = 0, 0, 0, tke_adv_opt = 0, 0, 0, - hybrid_opt = 0 + hybrid_opt = 2 etac = 0.3 / @@ -111,3 +112,24 @@ nio_tasks_per_group = 0, nio_groups = 1, / + + &dfi_control + dfi_opt = 0, + dfi_nfilter = 7, + dfi_cutoff_seconds = 3600, + dfi_write_filtered_input = .true. + dfi_write_dfi_history = .false. + dfi_bckstop_year = 2000, + dfi_bckstop_month = 01, + dfi_bckstop_day = 24, + dfi_bckstop_hour = 10, + dfi_bckstop_minute = 00, + dfi_bckstop_second = 00, + dfi_fwdstop_year = 2000, + dfi_fwdstop_month = 01, + dfi_fwdstop_day = 24, + dfi_fwdstop_hour = 13, + dfi_fwdstop_minute = 00, + dfi_fwdstop_second = 00, + / + From dc407db6504a2191cbc48d75a9dcc93ef31fb962 Mon Sep 17 00:00:00 2001 From: David Gill Date: Tue, 19 Jul 2016 04:59:58 +0000 Subject: [PATCH 4/7] Opps, forgot to swap a "k" for "kk". This is in the total pressure computation, where the moisture is added in (in the dfi_rebalance routine). I changed all of the "(i,k" to "(i,kk", but there was a rdnw(k) that was missed. M dfi.F git-svn-id: https://svn-wrf-model.cgd.ucar.edu/branches/HYBRID_COORDINATE_root=4929_start=20160705@9456 b0b5d27b-6f0f-0410-a2a3-cb1e977edc3d --- share/dfi.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/share/dfi.F b/share/dfi.F index 468f753dd6..a30db86d4a 100644 --- a/share/dfi.F +++ b/share/dfi.F @@ -3397,7 +3397,7 @@ SUBROUTINE rebalance_dfi ( grid & qvf2 = 1./(1.+qtot) qvf1 = qtot*qvf2 - grid%p(i,kk,j) = - 0.5*(grid%Mu_2(i,j)+qvf1*grid%Mub(i,j))/grid%rdnw(k)/qvf2 + grid%p(i,kk,j) = - 0.5*(grid%Mu_2(i,j)+qvf1*grid%Mub(i,j))/grid%rdnw(kk)/qvf2 qvf = 1.+rvovrd*moist(i,kk,j,P_QV) grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & (((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) From e3868675fb2cb9652c63e0db677387f60a5e3d0e Mon Sep 17 00:00:00 2001 From: David Gill Date: Tue, 19 Jul 2016 05:36:22 +0000 Subject: [PATCH 5/7] Geez, how many of these (k) arrays will I mess up? Also, missed the k -> kk index swap for rdn(k+1). M dfi.F git-svn-id: https://svn-wrf-model.cgd.ucar.edu/branches/HYBRID_COORDINATE_root=4929_start=20160705@9457 b0b5d27b-6f0f-0410-a2a3-cb1e977edc3d --- share/dfi.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/share/dfi.F b/share/dfi.F index a30db86d4a..f98d591439 100644 --- a/share/dfi.F +++ b/share/dfi.F @@ -3416,7 +3416,7 @@ SUBROUTINE rebalance_dfi ( grid & qvf2 = 1./(1.+qtot) qvf1 = qtot*qvf2 grid%p(i,kk,j) = grid%p(i,kk+1,j) - (grid%Mu_2(i,j) + & - qvf1*grid%Mub(i,j))/qvf2/grid%rdn(k+1) + qvf1*grid%Mub(i,j))/qvf2/grid%rdn(kk+1) qvf = 1. + rvovrd*moist(i,kk,j,P_QV) grid%alt(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & (((grid%p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) From 9e9d5bdbd663af93706d1f5ab240eb10b690585e Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Thu, 15 Sep 2016 17:21:32 -0600 Subject: [PATCH 6/7] Diffusion mods + MP Morrison + tweak DFI --- arch/configure_new.defaults | 6 +- dyn_em/module_diffusion_em.F | 1034 ++++++++++++--------------- dyn_em/module_first_rk_step_part2.F | 18 +- dyn_em/solve_em.F | 1 + phys/module_mp_morr_two_moment.F | 30 +- share/dfi.F | 28 +- 6 files changed, 526 insertions(+), 591 deletions(-) diff --git a/arch/configure_new.defaults b/arch/configure_new.defaults index 85dbc322d0..2924e41689 100644 --- a/arch/configure_new.defaults +++ b/arch/configure_new.defaults @@ -1354,9 +1354,9 @@ RLFLAGS = CC_TOOLS = gcc ########################################################### -#ARCH Fujitsu FX10 Linux SPARC64IXfx, mpifrtpx and mpifccpx compilers #serial smpar dmpar dm+sm +#ARCH Fujitsu FX10/FX100 Linux SPARC64IXfx/SPARC64Xlfx, mpifrtpx and mpifccpx compilers #serial smpar dmpar dm+sm # -DESCRIPTION = FUJITSU ($SFC/$SCC): FX10 SPARC64 IXfx +DESCRIPTION = FUJITSU ($SFC/$SCC): FX10/FX100 SPARC64 IXfx/Xlfx DMPARALLEL = # 1 OMPCPP = # -D_OPENMP OMP = # -Kopenmp @@ -1378,7 +1378,7 @@ CPLUSPLUSLIB = ESMF_LDFLAG = $(CPLUSPLUSLIB) FCOPTIM = -Kfast FCREDUCEDOPT = $(FCOPTIM) -FCNOOPT = -O1 +FCNOOPT = -O0 FCDEBUG = # -g $(FCNOOPT) FORMAT_FIXED = -Fixed FORMAT_FREE = -Free diff --git a/dyn_em/module_diffusion_em.F b/dyn_em/module_diffusion_em.F index f323e71f25..5b99c3f5bb 100644 --- a/dyn_em/module_diffusion_em.F +++ b/dyn_em/module_diffusion_em.F @@ -1,21 +1,18 @@ -#if ( HYBRID_COORD==1 ) +#if ( HYBRID_COORD==1 ) # define mu(...) (c1(k)*XXPCTXX(__VA_ARGS__)+c2(k)) # define XXPCTXX(...) mu(__VA_ARGS__) - -# define muavg(...) (c1(k)*XXPCAVGXX(__VA_ARGS__)+c2(k)) -# define XXPCAVGXX(...) muavg(__VA_ARGS__) #endif ! WRF:MODEL_LAYER:PHYSICS - + MODULE module_diffusion_em USE module_bc, only: set_physical_bc3d USE module_state_description, only: p_m23, p_m13, p_m22, p_m33, p_r23, p_r13, p_r12, p_m12, p_m11 USE module_big_step_utilities_em, only: grid_config_rec_type, param_first_scalar, p_qv, p_qi, p_qc - USE module_model_constants + USE module_model_constants CONTAINS @@ -25,7 +22,7 @@ MODULE module_diffusion_em SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & defor11, defor22, defor33, & defor12, defor13, defor23, & - nba_rij, n_nba_rij, & !JDM + nba_rij, n_nba_rij, & u_base, v_base, msfux, msfuy, & msfvx, msfvy, msftx, msfty, & rdx, rdy, dn, dnw, rdz, rdzw, & @@ -82,11 +79,11 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & :: u, v, w, zx, zy, rdz, rdzw REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & - :: defor11, defor22, defor33, defor12, defor13, defor23, div + :: defor11, defor22, defor33, defor12, defor13, defor23, div - INTEGER, INTENT( IN ) :: n_nba_rij !JDM + INTEGER, INTENT( IN ) :: n_nba_rij - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_rij), INTENT(INOUT) & !JDM + REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_rij), INTENT(INOUT) & :: nba_rij @@ -398,7 +395,7 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & END DO END DO -! End calculation of vertical divergence. +! End calculation of vertical divergence. !----------------------------------------------------------------------- ! Three-dimensional divergence is now finished and values are in array @@ -413,7 +410,7 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & ! (see e.g. Haltiner and Williams p. 441) !======================================================================= -! Calculate the final three deformations (defor12, defor13, defor23) at +! Calculate the final three deformations (defor12, defor13, defor23) at ! vorticity points. i_start = its @@ -423,7 +420,7 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & 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. & + 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 ) @@ -455,7 +452,7 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & 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 + ! 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 @@ -507,7 +504,7 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & END DO ! End calculation of du/dy. -!---------------------------------------------------------------------- +!---------------------------------------------------------------------- !----------------------------------------------------------------------- ! Add the first term to defor12 (du/dy+dv/dx) at vorticity points. @@ -517,7 +514,7 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & ! 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: +! Still need to add v^ terms: ! m^2 * (partial dv^/dX + partial dpsi/dx * partial dv^/dpsi) DO j = j_start, j_end @@ -612,11 +609,11 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & !JDM____________________________________________________________________ ! -! s12 = du/dy + dv/dx +! s12 = du/dy + dv/dx ! = (du/dy - dz/dy*du/dz) + (dv/dx - dz/dx*dv/dz) ! ______defor12______ ___tmp1___ ! -! r12 = du/dy - dv/dx +! r12 = du/dy - dv/dx ! = (du/dy - dz/dy*du/dz) - (dv/dx - dz/dx*dv/dz) ! ______defor12______ ___tmp1___ !_______________________________________________________________________ @@ -626,9 +623,9 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & DO k = kts, ktf DO i = i_start, i_end - nba_rij(i,k,j,P_r12) = defor12(i,k,j) - & - mm(i,j) * ( & - rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) ) + nba_rij(i,k,j,P_r12) = defor12(i,k,j) - & + mm(i,j) * ( & + rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) ) defor12(i,k,j) = defor12(i,k,j) + & mm(i,j) * ( & @@ -642,21 +639,21 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & !----------------------------------------------------------------------- ! 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) - nba_rij(ids,k,j,P_r12) = nba_rij(ids+1,k,j,P_r12) + nba_rij(ids,k,j,P_r12) = nba_rij(ids+1,k,j,P_r12) 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) - nba_rij(i,k,jds,P_r12) = nba_rij(i,k,jds+1,P_r12) + nba_rij(i,k,jds,P_r12) = nba_rij(i,k,jds+1,P_r12) END DO END DO END IF @@ -665,7 +662,7 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & DO j = jts, jte DO k = kts, kte defor12(ide,k,j) = defor12(ide-1,k,j) - nba_rij(ide,k,j,P_r12) = nba_rij(ide-1,k,j,P_r12) + nba_rij(ide,k,j,P_r12) = nba_rij(ide-1,k,j,P_r12) END DO END DO END IF @@ -674,7 +671,7 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & DO k = kts, kte DO i = its, ite defor12(i,k,jde) = defor12(i,k,jde-1) - nba_rij(i,k,jde,P_r12) = nba_rij(i,k,jde-1,P_r12) + nba_rij(i,k,jde,P_r12) = nba_rij(i,k,jde-1,P_r12) END DO END DO END IF @@ -696,7 +693,7 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & !----------------------------------------------------------------------- ! 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 @@ -704,7 +701,7 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & 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 @@ -877,25 +874,25 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & !JDM____________________________________________________________________ ! -! s13 = du/dz + dw/dx +! s13 = du/dz + dw/dx ! = du/dz + (dw/dx - dz/dx*dw/dz) ! = tmp1 + ______defor13______ ! -! r13 = du/dz - dw/dx -! = du/dz - (dw/dx - dz/dx*dw/dz) -! = tmp1 - ______defor13______ +! r13 = du/dz - dw/dx +! = du/dz - (dw/dx - dz/dx*dw/dz) +! = tmp1 - ______defor13______ !_______________________________________________________________________ DO j = j_start, j_end DO k = kts+1, ktf DO i = i_start, i_end - nba_rij(i,k,j,P_r13) = tmp1(i,k,j) - defor13(i,k,j) + nba_rij(i,k,j,P_r13) = tmp1(i,k,j) - defor13(i,k,j) defor13(i,k,j) = defor13(i,k,j) + tmp1(i,k,j) END DO END DO END DO - DO j = j_start, j_end !change for different surface B. C. + DO j = j_start, j_end !change for different surface B. C. DO i = i_start, i_end nba_rij(i,kts ,j,P_r13) = 0.0 nba_rij(i,ktf+1,j,P_r13) = 0.0 @@ -1054,20 +1051,20 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & !JDM___________________________________________________________________ ! -! s23 = dv/dz + dw/dy +! s23 = dv/dz + dw/dy ! = dv/dz + (dw/dy - dz/dy*dw/dz) ! tmp1 + ______defor23______ ! -! r23 = dv/dz - dw/dy -! = dv/dz - (dw/dy - dz/dy*dw/dz) -! = tmp1 - ______defor23______ +! r23 = dv/dz - dw/dy +! = dv/dz - (dw/dy - dz/dy*dw/dz) +! = tmp1 - ______defor23______ ! Add tmp1 to defor23. DO j = j_start, j_end DO k = kts+1, ktf DO i = i_start, i_end - nba_rij(i,k,j,P_r23) = tmp1(i,k,j) - defor23(i,k,j) + nba_rij(i,k,j,P_r23) = tmp1(i,k,j) - defor23(i,k,j) defor23(i,k,j) = defor23(i,k,j) + tmp1(i,k,j) END DO END DO @@ -1092,8 +1089,8 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & DO k = kts, kte defor13(ids,k,j) = defor13(ids+1,k,j) defor23(ids,k,j) = defor23(ids+1,k,j) - nba_rij(ids,k,j,P_r13) = nba_rij(ids+1,k,j,P_r13) - nba_rij(ids,k,j,P_r23) = nba_rij(ids+1,k,j,P_r23) + nba_rij(ids,k,j,P_r13) = nba_rij(ids+1,k,j,P_r13) + nba_rij(ids,k,j,P_r23) = nba_rij(ids+1,k,j,P_r23) END DO END DO END IF @@ -1103,8 +1100,8 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & DO i = its, ite defor13(i,k,jds) = defor13(i,k,jds+1) defor23(i,k,jds) = defor23(i,k,jds+1) - nba_rij(i,k,jds,P_r13) = nba_rij(i,k,jds+1,P_r13) - nba_rij(i,k,jds,P_r23) = nba_rij(i,k,jds+1,P_r23) + nba_rij(i,k,jds,P_r13) = nba_rij(i,k,jds+1,P_r13) + nba_rij(i,k,jds,P_r23) = nba_rij(i,k,jds+1,P_r23) END DO END DO END IF @@ -1114,8 +1111,8 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & DO k = kts, kte defor13(ide,k,j) = defor13(ide-1,k,j) defor23(ide,k,j) = defor23(ide-1,k,j) - nba_rij(ide,k,j,P_r13) = nba_rij(ide-1,k,j,P_r13) - nba_rij(ide,k,j,P_r23) = nba_rij(ide-1,k,j,P_r23) + nba_rij(ide,k,j,P_r13) = nba_rij(ide-1,k,j,P_r13) + nba_rij(ide,k,j,P_r23) = nba_rij(ide-1,k,j,P_r23) END DO END DO END IF @@ -1125,8 +1122,8 @@ SUBROUTINE cal_deform_and_div( config_flags, u, v, w, div, & DO i = its, ite defor13(i,k,jde) = defor13(i,k,jde-1) defor23(i,k,jde) = defor23(i,k,jde-1) - nba_rij(i,k,jde,P_r13) = nba_rij(i,k,jde-1,P_r13) - nba_rij(i,k,jde,P_r23) = nba_rij(i,k,jde-1,P_r23) + nba_rij(i,k,jde,P_r13) = nba_rij(i,k,jde-1,P_r13) + nba_rij(i,k,jde,P_r23) = nba_rij(i,k,jde-1,P_r23) END DO END DO END IF @@ -1233,13 +1230,13 @@ SUBROUTINE calculate_km_kh( config_flags, dt, & IMPLICIT NONE TYPE( grid_config_rec_type ), INTENT( IN ) & - :: config_flags + :: config_flags INTEGER, INTENT( IN ) & - :: n_moist, damp_opt, isotropic, & + :: n_moist, damp_opt, isotropic, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte + its, ite, jts, jte, kts, kte LOGICAL, INTENT( IN ) & :: warm_rain @@ -1254,7 +1251,7 @@ SUBROUTINE calculate_km_kh( config_flags, dt, & :: moist REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & - :: xkmv, xkmh, xkhv, xkhh, BN2 + :: xkmv, xkmh, xkhv, xkhh, BN2 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT( IN ) & :: defor11, defor22, defor33, defor12, defor13, defor23, & @@ -1301,7 +1298,7 @@ SUBROUTINE calculate_km_kh( config_flags, dt, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) - CASE (2) + CASE (2) CALL tke_km( config_flags, xkmh, xkmv, & xkhh, xkhv, BN2, tke, p8w, t8w, theta, & rdz, rdzw, dx, dy, dt, isotropic, & @@ -1309,7 +1306,7 @@ SUBROUTINE calculate_km_kh( config_flags, dt, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) - CASE (3) + CASE (3) CALL smag_km( config_flags, xkmh, xkmv, & xkhh, xkhv, BN2, div, & defor11, defor22, defor33, & @@ -1319,7 +1316,7 @@ SUBROUTINE calculate_km_kh( config_flags, dt, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) - CASE (4) + CASE (4) CALL smag2d_km( config_flags, xkmh, xkmv, & xkhh, xkhv, defor11, defor22, defor12, & rdzw, dx, dy, msftx, msfty, & @@ -1370,7 +1367,7 @@ SUBROUTINE cal_dampkm( config_flags,xkmh,xkhh,xkmv,xkhv, & REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: xkmh , & xkhh , & xkmv , & - xkhv + xkhv REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: rdz, & rdzw @@ -1509,7 +1506,7 @@ SUBROUTINE calculate_N2( config_flags, BN2, moist, & :: BN2 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: rdz, rdzw, theta, t, p, p8w, t8w + :: rdz, rdzw, theta, t, p, p8w, t8w REAL, DIMENSION( kms:kme ), INTENT( IN ) & :: dnw, dn @@ -1557,7 +1554,7 @@ SUBROUTINE calculate_N2( config_flags, BN2, moist, & 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 @@ -1575,7 +1572,7 @@ SUBROUTINE calculate_N2( config_flags, BN2, moist, & END DO END DO END IF - + DO j = jts, jte DO k = kts, kte DO i = its, ite @@ -1583,14 +1580,14 @@ SUBROUTINE calculate_N2( config_flags, BN2, moist, & 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 @@ -1600,7 +1597,7 @@ SUBROUTINE calculate_N2( config_flags, BN2, moist, & END DO END DO END DO - + DO j = j_start, j_end DO i = i_start, i_end tmp1sfc(i,j) = tmp1sfc(i,j) + & @@ -1627,7 +1624,7 @@ SUBROUTINE calculate_N2( config_flags, BN2, moist, & END DO END DO END DO - + DO j = j_start, j_end DO k = kts+1, ktf-1 DO i = i_start, i_end @@ -1695,14 +1692,14 @@ SUBROUTINE calculate_N2( config_flags, BN2, moist, & 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 DO ! end of MARTA/WCS change END SUBROUTINE calculate_N2 @@ -1727,7 +1724,7 @@ SUBROUTINE isotropic_km( config_flags, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte - REAL , INTENT(IN ) :: khdif,kvdif + REAL , INTENT(IN ) :: khdif,kvdif REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) :: xkmh, & xkmv, & @@ -1801,7 +1798,7 @@ SUBROUTINE smag_km( config_flags,xkmh,xkmv,xkhh,xkhv,BN2, & xkhh, & xkhv - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN ) :: & + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN ) :: & defor11, & defor22, & defor33, & @@ -1954,7 +1951,7 @@ SUBROUTINE smag2d_km( config_flags,xkmh,xkmv,xkhh,xkhv, & xkhh, & xkhv - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN ) :: & + REAL , DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT(IN ) :: & defor11, & defor22, & defor12 @@ -2137,7 +2134,7 @@ SUBROUTINE tke_km( config_flags, xkmh, xkmv, xkhh, xkhv, & 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) + 1.0 / rdz(i,k,j) + tmpdz = 1.0 / rdz(i,k+1,j) + 1.0 / rdz(i,k,j) dthrdn(i,k,j) = ( theta(i,k+1,j) - theta(i,k-1,j) ) / tmpdz END DO END DO @@ -2146,7 +2143,7 @@ SUBROUTINE tke_km( config_flags, xkmh, xkmv, xkhh, xkhv, & k = kts DO j = j_start, j_end DO i = i_start, i_end - tmpdz = 1.0 / rdzw(i,k+1,j) + 1.0 / rdzw(i,k,j) + tmpdz = 1.0 / rdzw(i,k+1,j) + 1.0 / 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 @@ -2289,17 +2286,16 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & chem_tendf, n_chem, & scalar_tendf, n_scalar, & tracer_tendf, n_tracer, & - thp, theta, mu, c1, c2, & - tke, config_flags, & + thp, theta, tke, config_flags, & defor11, defor22, defor12, & defor13, defor23, & - nba_mij, n_nba_mij, & !JDM + nba_mij, n_nba_mij, & div, & moist, chem, scalar,tracer, & msfux, msfuy, msfvx, msfvy, & msftx, msfty, xkmh, xkhh,km_opt, & rdx, rdy, rdz, rdzw, fnm, fnp, & - cf1, cf2, cf3, zx, zy, dn, dnw, & + cf1, cf2, cf3, zx, zy, dn, dnw, rho, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -2321,17 +2317,15 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & 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( 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( kms:kme) , INTENT(IN ) :: c1, c2 + msfty REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::rt_tendf,& ru_tendf,& @@ -2355,13 +2349,13 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & INTENT(IN ) :: moist REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_chem), & - INTENT(IN ) :: chem + INTENT(IN ) :: chem REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_scalar) , & - INTENT(IN ) :: scalar + INTENT(IN ) :: scalar REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_tracer) , & - INTENT(IN ) :: tracer + INTENT(IN ) :: tracer REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) ::defor11, & defor22, & @@ -2377,18 +2371,19 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & thp, & tke, & rdz, & - rdzw + rdzw, & + rho REAL , INTENT(IN ) :: rdx, & rdy - INTEGER, INTENT( IN ) :: n_nba_mij !JDM + INTEGER, INTENT( IN ) :: n_nba_mij - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & !JDM + REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & :: nba_mij ! LOCAL VARS - + INTEGER :: im, ic, is ! REAL , DIMENSION(its-1:ite+1, kts:kte, jts-1:jte+1) :: xkhh @@ -2399,41 +2394,41 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & !----------------------------------------------------------------------- ! Call diffusion subroutines. - CALL horizontal_diffusion_u_2( ru_tendf, mu, c1, c2, config_flags, & + CALL horizontal_diffusion_u_2( ru_tendf, config_flags, & defor11, defor12, div, & - nba_mij, n_nba_mij, & !JDM + nba_mij, n_nba_mij, & tke(ims,kms,jms), & msfux, msfuy, xkmh, rdx, rdy, fnm, fnp, & - zx, zy, rdzw, & + dnw, zx, zy, rdzw, rho, & 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, c1, c2, config_flags, & + CALL horizontal_diffusion_v_2( rv_tendf, config_flags, & defor12, defor22, div, & - nba_mij, n_nba_mij, & !JDM + nba_mij, n_nba_mij, & tke(ims,kms,jms), & msfvx, msfvy, xkmh, rdx, rdy, fnm, fnp, & - zx, zy, rdzw, & + dnw, zx, zy, rdzw, rho, & 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, c1, c2, config_flags, & + CALL horizontal_diffusion_w_2( rw_tendf, config_flags, & defor13, defor23, div, & - nba_mij, n_nba_mij, & !JDM + nba_mij, n_nba_mij, & tke(ims,kms,jms), & msftx, msfty, xkmh, rdx, rdy, fnm, fnp, & - zx, zy, rdz, & + dn, zx, zy, rdz, rho, & 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, c1, c2, config_flags, thp,& + CALL horizontal_diffusion_s ( rt_tendf, config_flags, thp, & msftx, msfty, msfux, msfuy, & msfvx, msfvy, xkhh, rdx, rdy, & fnm, fnp, cf1, cf2, cf3, & - zx, zy, rdz, rdzw, dnw, dn, & + zx, zy, rdz, rdzw, dnw, dn, rho, & .false., & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -2441,28 +2436,28 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & IF (km_opt .eq. 2) & CALL horizontal_diffusion_s ( tke_tendf(ims,kms,jms), & - mu, c1, c2, config_flags, & + 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, & + zx, zy, rdz, rdzw, dnw, dn, rho, & .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 + 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, c1, c2, config_flags, & + 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, & + zx, zy, rdz, rdzw, dnw, dn, rho, & .false., & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -2472,37 +2467,37 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & ENDIF - IF (n_chem .ge. PARAM_FIRST_SCALAR) THEN + 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, c1, c2, config_flags, & + 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 ) + msftx, msfty, msfux, msfuy, & + msfvx, msfvy, xkhh, rdx, rdy, & + fnm, fnp, cf1, cf2, cf3, & + zx, zy, rdz, rdzw, dnw, dn, rho,& + .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_tracer .ge. PARAM_FIRST_SCALAR) THEN + IF (n_tracer .ge. PARAM_FIRST_SCALAR) THEN tracer_loop: do ic = PARAM_FIRST_SCALAR, n_tracer CALL horizontal_diffusion_s( tracer_tendf(ims,kms,jms,ic), & - mu, c1, c2, config_flags, & + config_flags, & tracer(ims,kms,jms,ic), & msftx, msfty, msfux, msfuy, & msfvx, msfvy, xkhh, rdx, rdy, & fnm, fnp, cf1, cf2, cf3, & - zx, zy, rdz, rdzw, dnw, dn, & + zx, zy, rdz, rdzw, dnw, dn, rho, & .false., & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -2511,17 +2506,17 @@ SUBROUTINE horizontal_diffusion_2 ( rt_tendf, ru_tendf, rv_tendf, rw_tendf, & ENDDO tracer_loop ENDIF - IF (n_scalar .ge. PARAM_FIRST_SCALAR) THEN + 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, c1, c2, config_flags, & + 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, & + zx, zy, rdz, rdzw, dnw, dn, rho, & .false., & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -2536,13 +2531,13 @@ END SUBROUTINE horizontal_diffusion_2 !======================================================================= !======================================================================= -SUBROUTINE horizontal_diffusion_u_2( tendency, mu, c1, c2, config_flags, & +SUBROUTINE horizontal_diffusion_u_2( tendency, config_flags, & defor11, defor12, div, & - nba_mij, n_nba_mij, & !JDM + nba_mij, n_nba_mij, & tke, & msfux, msfuy, & xkmh, rdx, rdy, fnm, fnp, & - zx, zy, rdzw, & + dnw, zx, zy, rdzw, rho, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -2560,75 +2555,77 @@ SUBROUTINE horizontal_diffusion_u_2( tendency, mu, c1, c2, config_flags, & 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 ) :: msfux, & - msfuy, & - mu - REAL , DIMENSION( kms:kme) , INTENT(IN ) :: c1, c2 + msfuy 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 ) :: rdzw, & + rho + + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) ::defor11, & defor12, & - div, & - tke, & + div, & + tke, & xkmh, & zx, & zy - INTEGER, INTENT( IN ) :: n_nba_mij !JDM + INTEGER, INTENT( IN ) :: n_nba_mij - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & !JDM + REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & :: nba_mij 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 + 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, & + titau1, & + titau2, & + xkxavg, & rravg ! new -! zxavg, & +! zxavg, & ! zyavg REAL :: mrdx, mrdy, rcoup REAL :: tmpzy, tmpzeta_z + REAL :: tmpdz + 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+1 13 k+1 +! +! p | 11 O 11 | . | k | 12 O 12 | . | k ! -! w - 13 - - k 13 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-1 i i i+1 j-1 j j j+1 j+1 ! i_start = its @@ -2647,14 +2644,14 @@ SUBROUTINE horizontal_diffusion_u_2( tendency, mu, c1, c2, config_flags, & IF ( config_flags%periodic_x ) i_start = its IF ( config_flags%periodic_x ) i_end = ite -! titau1 = titau11 +! titau1 = titau11 is_ext=1 ie_ext=0 js_ext=0 je_ext=0 CALL cal_titau_11_22_33( config_flags, titau1, & - mu, c1, c2, tke, xkmh, defor11, & - nba_mij(ims,kms,jms,P_m11), & !JDM + tke, xkmh, defor11, & + nba_mij(ims,kms,jms,P_m11), rho, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -2666,15 +2663,15 @@ SUBROUTINE horizontal_diffusion_u_2( tendency, mu, c1, c2, config_flags, & js_ext=0 je_ext=1 CALL cal_titau_12_21( config_flags, titau2, & - mu, c1, c2, xkmh, defor12, & - nba_mij(ims,kms,jms,P_m12), & !JDM + xkmh, defor12, & + nba_mij(ims,kms,jms,P_m12), rho, & 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 +! titau2avg = titau12avg DO j = j_start, j_end DO k = kts+1,ktf @@ -2690,7 +2687,7 @@ SUBROUTINE horizontal_diffusion_u_2( tendency, mu, c1, c2, config_flags, & ! 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 + titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy ENDDO ENDDO @@ -2711,12 +2708,14 @@ SUBROUTINE horizontal_diffusion_u_2( tendency, mu, c1, c2, config_flags, & 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)) & - ) ) + + tmpdz = (1./rdzw(i,k,j)+1./rdzw(i-1,k,j))/2. + tendency(i,k,j)=tendency(i,k,j) + g*tmpdz/dnw(k) * & + (mrdx*(titau1(i,k,j ) - titau1(i-1,k,j)) + & + mrdy*(titau2(i,k,j+1) - titau2(i ,k,j)) - & + msfuy(i,j)*(titau1avg(i,k+1,j)-titau1avg(i,k,j))/tmpdz - & + msfuy(i,j)*(titau2avg(i,k+1,j)-titau2avg(i,k,j))/tmpdz & + ) ENDDO ENDDO ENDDO @@ -2726,13 +2725,13 @@ END SUBROUTINE horizontal_diffusion_u_2 !======================================================================= !======================================================================= -SUBROUTINE horizontal_diffusion_v_2( tendency, mu, c1, c2, config_flags, & +SUBROUTINE horizontal_diffusion_v_2( tendency, config_flags, & defor12, defor22, div, & - nba_mij, n_nba_mij, & !JDM + nba_mij, n_nba_mij, & tke, & msfvx, msfvy, & xkmh, rdx, rdy, fnm, fnp, & - zx, zy, rdzw, & + dnw, zx, zy, rdzw, rho, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -2750,10 +2749,10 @@ SUBROUTINE horizontal_diffusion_v_2( tendency, mu, c1, c2, config_flags, & 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 ) :: msfvx, & - msfvy, & - mu + msfvy REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency @@ -2764,25 +2763,23 @@ SUBROUTINE horizontal_diffusion_v_2( tendency, mu, c1, c2, config_flags, & xkmh, & zx, & zy, & - rdzw + rdzw, & + rho - INTEGER, INTENT( IN ) :: n_nba_mij !JDM + INTEGER, INTENT( IN ) :: n_nba_mij - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & !JDM + REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & :: nba_mij REAL , INTENT(IN ) :: rdx, & rdy - REAL , DIMENSION( kms:kme ), INTENT(IN ) :: c1, & - c2 - ! 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 + INTEGER :: is_ext,ie_ext,js_ext,je_ext REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau1avg, & titau2avg, & @@ -2795,30 +2792,30 @@ SUBROUTINE horizontal_diffusion_v_2( tendency, mu, c1, c2, config_flags, & ! zyavg REAL :: mrdx, mrdy, rcoup - + REAL :: tmpdz 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+1 23 k+1 +! +! p + 22 O 22 + . + k + 21 O 21 + . + k ! -! w - 23 - - k 23 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 +! j-1 j j j+1 i-1 i i i+1 i+1 ! i_start = its @@ -2842,13 +2839,13 @@ SUBROUTINE horizontal_diffusion_v_2( tendency, mu, c1, c2, config_flags, & ie_ext=1 js_ext=0 je_ext=0 - CALL cal_titau_12_21( config_flags, titau1, & - mu, c1, c2, xkmh, defor12, & - nba_mij(ims,kms,jms,P_m12), & !JDM - 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 ) + CALL cal_titau_12_21( config_flags, titau1, & + xkmh, defor12, & + nba_mij(ims,kms,jms,P_m12),rho, & + 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 @@ -2856,8 +2853,8 @@ SUBROUTINE horizontal_diffusion_v_2( tendency, mu, c1, c2, config_flags, & js_ext=1 je_ext=0 CALL cal_titau_11_22_33( config_flags, titau2, & - mu, c1, c2, tke, xkmh, defor22, & - nba_mij(ims,kms,jms,P_m22), & !JDM + tke, xkmh, defor22, & + nba_mij(ims,kms,jms,P_m22),rho, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -2895,16 +2892,16 @@ SUBROUTINE horizontal_diffusion_v_2( tendency, mu, c1, c2, config_flags, & 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)) & - ) & - ) + tmpdz = (1./rdzw(i,k,j)+1./rdzw(i,k,j-1))/2. + tendency(i,k,j)=tendency(i,k,j) + g*tmpdz/dnw(k) * & + (mrdx*(titau2(i,k,j ) - titau2(i,k,j-1)) + & + mrdy*(titau1(i+1,k,j) - titau1(i ,k,j)) - & + msfvy(i,j)*(titau1avg(i,k+1,j)-titau1avg(i,k,j))/tmpdz - & + msfvy(i,j)*(titau2avg(i,k+1,j)-titau2avg(i,k,j))/tmpdz & + ) ENDDO ENDDO @@ -2915,13 +2912,13 @@ END SUBROUTINE horizontal_diffusion_v_2 !======================================================================= !======================================================================= -SUBROUTINE horizontal_diffusion_w_2( tendency, mu, c1, c2, config_flags, & +SUBROUTINE horizontal_diffusion_w_2( tendency, config_flags, & defor13, defor23, div, & - nba_mij, n_nba_mij, & !JDM + nba_mij, n_nba_mij, & tke, & msftx, msfty, & xkmh, rdx, rdy, fnm, fnp, & - zx, zy, rdz, & + dn, zx, zy, rdz, rho, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -2939,10 +2936,10 @@ SUBROUTINE horizontal_diffusion_w_2( tendency, mu, c1, c2, config_flags, & REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnp + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dn REAL , DIMENSION( ims:ime, jms:jme) , INTENT(IN ) :: msftx, & - msfty, & - mu + msfty REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: tendency @@ -2953,25 +2950,23 @@ SUBROUTINE horizontal_diffusion_w_2( tendency, mu, c1, c2, config_flags, & xkmh, & zx, & zy, & - rdz + rdz, & + rho - INTEGER, INTENT( IN ) :: n_nba_mij !JDM + INTEGER, INTENT( IN ) :: n_nba_mij - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & !JDM + REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & :: nba_mij REAL , INTENT(IN ) :: rdx, & rdy - REAL , DIMENSION( kms:kme ), INTENT(IN ) :: c1, & - c2 - ! 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 + INTEGER :: is_ext,ie_ext,js_ext,je_ext REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau1avg, & titau2avg, & @@ -2991,23 +2986,23 @@ SUBROUTINE horizontal_diffusion_w_2( tendency, mu, c1, c2, config_flags, & !----------------------------------------------------------------------- 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 u p u p v p v +! +! w - - - k+1 w - - - k+1 ! -! p . | 33 | . k p . + 33 + . k +! p . | 33 | . k p . + 33 + . k ! -! w - 31 O 31 - k w - 32 O 32 - k +! w - 31 O 31 - k w - 32 O 32 - k ! -! p . | 33 | . k-1 p . | 33 | . k-1 +! p . | 33 | . k-1 p . | 33 | . k-1 ! -! w - - - k-1 w - - - k-1 +! w - - - k-1 w - - - k-1 ! -! i-1 i i i+1 j-1 j j j+1 +! i-1 i i i+1 j-1 j j j+1 ! i_start = its i_end = MIN(ite,ide-1) @@ -3031,8 +3026,8 @@ SUBROUTINE horizontal_diffusion_w_2( tendency, mu, c1, c2, config_flags, & js_ext=0 je_ext=0 CALL cal_titau_13_31( config_flags, titau1, defor13, & - nba_mij(ims,kms,jms,P_m13), & !JDM - mu, c1, c2, xkmh, fnm, fnp, & + nba_mij(ims,kms,jms,P_m13), & + xkmh, fnm, fnp, rho, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -3044,8 +3039,8 @@ SUBROUTINE horizontal_diffusion_w_2( tendency, mu, c1, c2, config_flags, & js_ext=0 je_ext=1 CALL cal_titau_23_32( config_flags, titau2, defor23, & - nba_mij(ims,kms,jms,P_m23), & !JDM - mu, c1, c2, xkmh, fnm, fnp, & + nba_mij(ims,kms,jms,P_m23), & + xkmh, fnm, fnp, rho, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -3089,17 +3084,13 @@ SUBROUTINE horizontal_diffusion_w_2( tendency, mu, c1, c2, config_flags, & 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) & - ) & + tendency(i,k,j)=tendency(i,k,j) + g/(dn(k)*rdz(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 @@ -3109,11 +3100,11 @@ END SUBROUTINE horizontal_diffusion_w_2 !======================================================================= !======================================================================= -SUBROUTINE horizontal_diffusion_s (tendency, mu, c1,c2, config_flags, var,& +SUBROUTINE horizontal_diffusion_s (tendency, config_flags, var, & msftx, msfty, msfux, msfuy, & msfvx, msfvy, xkhh, rdx, rdy, & fnm, fnp, cf1, cf2, cf3, & - zx, zy, rdz, rdzw, dnw, dn, & + zx, zy, rdz, rdzw, dnw, dn, rho, & doing_tke, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -3146,17 +3137,13 @@ SUBROUTINE horizontal_diffusion_s (tendency, mu, c1,c2, config_flags, var,& 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 + rdzw, & + rho REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: var, & zx, & @@ -3165,9 +3152,6 @@ SUBROUTINE horizontal_diffusion_s (tendency, mu, c1,c2, config_flags, var,& REAL , INTENT(IN ) :: rdx, & rdy - REAL , DIMENSION( kms:kme ), INTENT(IN ) :: c1, & - c2 - ! Local data INTEGER :: i, j, k, ktf @@ -3179,9 +3163,6 @@ SUBROUTINE horizontal_diffusion_s (tendency, mu, c1,c2, config_flags, var,& H1, & H2, & xkxavg -! new -! zxavg, & -! zyavg REAL , DIMENSION( its:ite, kts:kte, jts:jte) :: tmptendf @@ -3193,23 +3174,23 @@ SUBROUTINE horizontal_diffusion_s (tendency, mu, c1,c2, config_flags, var,& !----------------------------------------------------------------------- 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 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 +! t . 1 O 1 . k t . 2 O 2 . k ! -! w - 3 - k w - 3 - k +! w - 3 - k w - 3 - k ! -! t . | . | . k-1 t . + . + . k-1 +! t . | . | . k-1 t . + . + . k-1 ! -! w - - - k-1 w - - - k-1 +! w - - - k-1 w - - - k-1 ! -! t i-1 i i i+1 j-1 j j j+1 +! t i-1 i i i+1 j-1 j j j+1 ! ktes1=kte-1 @@ -3248,9 +3229,7 @@ SUBROUTINE horizontal_diffusion_s (tendency, mu, c1,c2, config_flags, var,& 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)) + xkxavg(i,k,j)=0.5*(xkhh(i-1,k,j)+xkhh(i,k,j))*0.5*(rho(i-1,k,j)+rho(i,k,j)) ENDDO ENDDO ENDDO @@ -3299,9 +3278,7 @@ SUBROUTINE horizontal_diffusion_s (tendency, mu, c1,c2, config_flags, var,& 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)) + xkxavg(i,k,j)=0.5*(xkhh(i,k,j-1)+xkhh(i,k,j))*0.5*(rho(i,k,j-1)+rho(i,k,j)) ENDDO ENDDO ENDDO @@ -3309,7 +3286,6 @@ SUBROUTINE horizontal_diffusion_s (tendency, mu, c1,c2, config_flags, var,& 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 @@ -3371,7 +3347,7 @@ SUBROUTINE horizontal_diffusion_s (tendency, mu, c1,c2, config_flags, var,& ENDDO ENDDO ENDDO - + DO j = j_start, j_end DO i = i_start, i_end H1avg(i,kts ,j)=0. @@ -3388,21 +3364,16 @@ SUBROUTINE horizontal_diffusion_s (tendency, mu, c1,c2, config_flags, var,& mrdx=msftx(i,j)*rdx mrdy=msfty(i,j)*rdy -! Jimy says that "mu" can stay outside, so no need to push full level mu so that it is coupled with H1avg - 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) & - ) - + tendency(i,k,j)=tendency(i,k,j) + g/(dnw(k)*rdzw(i,k,j)) * & + (mrdx*(H1(i+1,k,j)-H1(i ,k,j)) + & + mrdy*(H2(i,k,j+1)-H2(i,k,j )) - & + msfty(i,j)*(H1avg(i,k+1,j)-H1avg(i,k,j))*rdzw(i,k,j) - & + msfty(i,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 @@ -3425,10 +3396,9 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & scalar_tendf, n_scalar, & tracer_tendf, n_tracer, & u_2, v_2, & - thp,u_base,v_base,t_base,qv_base, & - mu,c1,c2,tke, & + thp,u_base,v_base,t_base,qv_base,tke, & config_flags,defor13,defor23,defor33, & - nba_mij, n_nba_mij, & !JDM + nba_mij, n_nba_mij, & div, & moist,chem,scalar,tracer, & xkmv,xkhv,xkmh,km_opt, & ! xkmh added @@ -3455,8 +3425,6 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & 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 ) :: c1, c2 REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: qv_base REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: u_base @@ -3467,7 +3435,7 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & rv_tendf,& rw_tendf,& tke_tendf,& - rt_tendf + rt_tendf REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist), & INTENT(INOUT) :: moist_tendf @@ -3504,12 +3472,12 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & v_2, & rdzw - INTEGER, INTENT( IN ) :: n_nba_mij !JDM + INTEGER, INTENT( IN ) :: n_nba_mij - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & !JDM + REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & :: nba_mij - REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: rho + REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(IN ) :: rho REAL , DIMENSION( ims:ime, jms:jme), INTENT(INOUT) :: hfx, & qfx REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: ust @@ -3547,31 +3515,28 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & ! !----------------------------------------------------------------------- - CALL vertical_diffusion_u_2( ru_tendf, config_flags, mu, & - c1, c2, & + CALL vertical_diffusion_u_2( ru_tendf, config_flags, & defor13, xkmv, & - nba_mij, n_nba_mij, & !JDM - dnw, rdzw, fnm, fnp, & + nba_mij, n_nba_mij, & + dnw, rdzw, fnm, fnp, rho, & 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, & - c1, c2, & + CALL vertical_diffusion_v_2( rv_tendf, config_flags, & defor23, xkmv, & - nba_mij, n_nba_mij, & !JDM - dnw, rdzw, fnm, fnp, & + nba_mij, n_nba_mij, & + dnw, rdzw, fnm, fnp, rho, & 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, & - c1, c2, & + CALL vertical_diffusion_w_2( rw_tendf, config_flags, & defor33, tke(ims,kms,jms), & - nba_mij, n_nba_mij, & !JDM - div, xkmh, & !Mod from RR Oct2013 was xkmv - dn, rdz, & + nba_mij, n_nba_mij, & + div, xkmh, & + dn, rdz, fnm, fnp, rho, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -3580,7 +3545,6 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & !***************************************** ! MODIFICA al flusso di momento alla parete ! - 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 @@ -3596,12 +3560,12 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & 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)) + + tao_xz=cd0*V0_u*u_2(i,kts,j)*(rho(i,kts,j)+rho(i-1,kts,j))/2. + ru_tendf(i,kts,j)=ru_tendf(i,kts,j) + g*tao_xz/dnw(kts) IF ( (config_flags%m_opt .EQ. 1) .OR. (config_flags%sfs_opt .GT. 0) ) THEN nba_mij(i,kts,j,P_m13) = -tao_xz - ENDIF + ENDIF ENDDO ENDDO ! @@ -3614,9 +3578,9 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & 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)) + + tao_yz=cd0*V0_v*v_2(i,kts,j)*(rho(i,kts,j)+rho(i,kts,j-1))/2. + rv_tendf(i,kts,j)=rv_tendf(i,kts,j) + g*tao_yz/dnw(kts) IF ( (config_flags%m_opt .EQ. 1) .OR. (config_flags%sfs_opt .GT. 0) ) THEN nba_mij(i,kts,j,P_m23) = -tao_yz ENDIF @@ -3634,15 +3598,15 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & 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)) + + tao_xz=ustar*ustar*u_2(i,kts,j)*(rho(i,kts,j)+rho(i-1,kts,j))/(2.*V0_u) + ru_tendf(i,kts,j)=ru_tendf(i,kts,j) + g*tao_xz/dnw(kts) IF ( (config_flags%m_opt .EQ. 1) .OR. (config_flags%sfs_opt .GT. 0) ) THEN nba_mij(i,kts,j,P_m13) = -tao_xz ENDIF ENDDO ENDDO - + DO j = j_start, jte DO i = i_start, i_end V0_v=0. @@ -3653,9 +3617,9 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & 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)) + + tao_yz=ustar*ustar*v_2(i,kts,j)*(rho(i,kts,j)+rho(i,kts,j-1))/(2.*V0_v) + rv_tendf(i,kts,j)=rv_tendf(i,kts,j) + g*tao_yz/dnw(kts) IF ( (config_flags%m_opt .EQ. 1) .OR. (config_flags%sfs_opt .GT. 0) ) THEN nba_mij(i,kts,j,P_m23) = -tao_yz ENDIF @@ -3693,9 +3657,8 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & END IF - CALL vertical_diffusion_s( rt_tendf, config_flags, var_mix, mu, & - c1, c2, xkhv, & - dn, dnw, rdz, rdzw, fnm, fnp, & + CALL vertical_diffusion_s( rt_tendf, config_flags, var_mix, xkhv, & + dn, dnw, rdz, rdzw, fnm, fnp, rho, & .false., & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -3707,17 +3670,16 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & !MODIFICA al flusso di calore ! ! - k=kts 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 - cpm = cp * (1. + 0.8 * moist(i,kts,j,P_QV)) - hfx(i,j)=heat_flux*cp*rho(i,1,j) ! provided for output only + cpm = cp * (1. + 0.8 * moist(i,kts,j,P_QV)) + hfx(i,j)=heat_flux*cp*rho(i,kts,j) ! provided for output only rt_tendf(i,kts,j)=rt_tendf(i,kts,j) & - +mu(i,j)*heat_flux*rdzw(i,kts,j) + -g*heat_flux*rho(i,kts,j)/dnw(kts) ENDDO ENDDO @@ -3726,9 +3688,9 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & DO i = i_start, i_end cpm = cp * (1. + 0.8 * moist(i,kts,j,P_QV)) - heat_flux = hfx(i,j)/cpm/rho(i,1,j) + heat_flux = hfx(i,j)/cpm rt_tendf(i,kts,j)=rt_tendf(i,kts,j) & - +mu(i,j)*heat_flux*rdzw(i,kts,j) + -g*heat_flux/dnw(kts) ENDDO ENDDO @@ -3745,15 +3707,15 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & If (km_opt .eq. 2) then CALL vertical_diffusion_s( tke_tendf(ims,kms,jms), & config_flags, tke(ims,kms,jms), & - mu, c1, c2, xkhv, & - dn, dnw, rdz, rdzw, fnm, fnp, & + xkhv, & + dn, dnw, rdz, rdzw, fnm, fnp, rho, & .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 + + IF (n_moist .ge. PARAM_FIRST_SCALAR) THEN moist_loop: do im = PARAM_FIRST_SCALAR, n_moist @@ -3782,8 +3744,8 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & CALL vertical_diffusion_s( moist_tendf(ims,kms,jms,im), & config_flags, var_mix, & - mu, c1, c2, xkhv, & - dn, dnw, rdz, rdzw, fnm, fnp, & + xkhv, & + dn, dnw, rdz, rdzw, fnm, fnp, rho, & .false., & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -3794,17 +3756,16 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & !MODIFICATIONS for water vapor flux ! ! - k=kts qflux: SELECT CASE( config_flags%isfflx ) CASE (0) ! do nothing - CASE (1,2) ! with surface moisture flux + 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)/(1.+moist(i,kts,j,P_QV)) + moist_flux = qfx(i,j) moist_tendf(i,kts,j,im)=moist_tendf(i,kts,j,im) & - +mu(i,j)*moist_flux*rdzw(i,kts,j) + -g*moist_flux/dnw(kts) ENDDO ENDDO ENDIF @@ -3820,30 +3781,30 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & ENDIF - IF (n_chem .ge. PARAM_FIRST_SCALAR) THEN + 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, c1, c2, xkhv, & - dn, dnw, rdz, rdzw, fnm, fnp, & - .false., & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & + xkhv, & + dn, dnw, rdz, rdzw, fnm, fnp, rho, & + .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_tracer .ge. PARAM_FIRST_SCALAR) THEN + IF (n_tracer .ge. PARAM_FIRST_SCALAR) THEN tracer_loop: do im = PARAM_FIRST_SCALAR, n_tracer CALL vertical_diffusion_s( tracer_tendf(ims,kms,jms,im), & config_flags, tracer(ims,kms,jms,im), & - mu, c1, c2, xkhv, & - dn, dnw, rdz, rdzw, fnm, fnp, & + xkhv, & + dn, dnw, rdz, rdzw, fnm, fnp, rho, & .false., & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -3853,14 +3814,14 @@ SUBROUTINE vertical_diffusion_2 ( ru_tendf, rv_tendf, rw_tendf, rt_tendf, & ENDIF - IF (n_scalar .ge. PARAM_FIRST_SCALAR) THEN + 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, c1, c2, xkhv, & - dn, dnw, rdz, rdzw, fnm, fnp, & + xkhv, & + dn, dnw, rdz, rdzw, fnm, fnp, rho, & .false., & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -3874,10 +3835,10 @@ END SUBROUTINE vertical_diffusion_2 !======================================================================= !======================================================================= -SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu, c1, c2, & +SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, & defor13, xkmv, & - nba_mij, n_nba_mij, & !JDM - dnw, rdzw, fnm, fnp, & + nba_mij, n_nba_mij, & + dnw, rdzw, fnm, fnp, rho, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -3903,22 +3864,20 @@ SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu, c1, c2, & REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & INTENT(IN ) ::defor13, & xkmv, & - rdzw + rdzw, & + rho - INTEGER, INTENT( IN ) :: n_nba_mij !JDM + INTEGER, INTENT( IN ) :: n_nba_mij - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & !JDM + REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & :: nba_mij - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu - REAL , DIMENSION( kms:kme) , INTENT(IN ) :: c1, c2 - ! 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 + INTEGER :: is_ext,ie_ext,js_ext,je_ext REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau3 @@ -3930,7 +3889,7 @@ SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu, c1, c2, & !----------------------------------------------------------------------- ktf=MIN(kte,kde-1) - + i_start = its i_end = ite j_start = jts @@ -3953,8 +3912,8 @@ SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu, c1, c2, & js_ext=0 je_ext=0 CALL cal_titau_13_31( config_flags, titau3, defor13, & - nba_mij(ims,kms,jms,P_m13), & !JDM - mu, c1, c2, xkmv, fnm, fnp, & + nba_mij(ims,kms,jms,P_m13), & + xkmv, fnm, fnp, rho, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -3964,7 +3923,7 @@ SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu, c1, c2, & DO k=kts+1,ktf DO i = i_start, i_end - rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j)) + rdzu = -g/(dnw(k)) tendency(i,k,j)=tendency(i,k,j)-rdzu*(titau3(i,k+1,j)-titau3(i,k,j)) ENDDO @@ -3977,8 +3936,8 @@ SUBROUTINE vertical_diffusion_u_2( tendency, config_flags, mu, c1, c2, & 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)) + + rdzu = -g/dnw(k) tendency(i,k,j)=tendency(i,k,j)-rdzu*(titau3(i,k+1,j)) ENDDO ENDDO @@ -3989,10 +3948,10 @@ END SUBROUTINE vertical_diffusion_u_2 !======================================================================= !======================================================================= -SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu, c1, c2, & +SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, & defor23, xkmv, & - nba_mij, n_nba_mij, & !JDM - dnw, rdzw, fnm, fnp, & + nba_mij, n_nba_mij, & + dnw, rdzw, fnm, fnp, rho, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -4016,22 +3975,20 @@ SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu, c1, c2, & REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & INTENT(IN ) ::defor23, & xkmv, & - rdzw + rdzw, & + rho - INTEGER, INTENT( IN ) :: n_nba_mij !JDM + INTEGER, INTENT( IN ) :: n_nba_mij - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & !JDM + REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & :: nba_mij - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mu - REAL , DIMENSION( kms:kme) , INTENT(IN ) :: c1, c2 - ! 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 + INTEGER :: is_ext,ie_ext,js_ext,je_ext REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau3 @@ -4043,7 +4000,7 @@ SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu, c1, c2, & !----------------------------------------------------------------------- ktf=MIN(kte,kde-1) - + i_start = its i_end = MIN(ite,ide-1) j_start = jts @@ -4066,8 +4023,8 @@ SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu, c1, c2, & js_ext=0 je_ext=0 CALL cal_titau_23_32( config_flags, titau3, defor23, & - nba_mij(ims,kms,jms,P_m23), & !JDM - mu, c1, c2, xkmv, fnm, fnp, & + nba_mij(ims,kms,jms,P_m23), & + xkmv, fnm, fnp, rho, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -4077,7 +4034,7 @@ SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu, c1, c2, & DO k = kts+1,ktf DO i = i_start, i_end - rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1)) + rdzv = - g / dnw(k) tendency(i,k,j)=tendency(i,k,j)-rdzv*(titau3(i,k+1,j)-titau3(i,k,j)) ENDDO @@ -4090,10 +4047,10 @@ SUBROUTINE vertical_diffusion_v_2( tendency, config_flags, mu, c1, c2, & 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)) - + + rdzv = - g / dnw(k) + tendency(i,k,j)=tendency(i,k,j)-rdzv*(titau3(i,k+1,j)) + ENDDO ENDDO ! ******** MODIF... @@ -4103,11 +4060,11 @@ END SUBROUTINE vertical_diffusion_v_2 !======================================================================= !======================================================================= -SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu, c1, c2, & +SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, & defor33, tke, & - nba_mij, n_nba_mij, & !JDM + nba_mij, n_nba_mij, & div, xkmh, & - dn, rdz, & + dn, rdz, fnm, fnp, rho, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte ) @@ -4123,7 +4080,7 @@ SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu, c1, c2, & ims, ime, jms, jme, kms, kme, & its, ite, jts, jte, kts, kte - REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dn + REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: dn, fnm, fnp REAL , DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::tendency @@ -4132,22 +4089,20 @@ SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu, c1, c2, & tke, & div, & xkmh, & - rdz + rdz, & + rho - INTEGER, INTENT( IN ) :: n_nba_mij !JDM + INTEGER, INTENT( IN ) :: n_nba_mij - REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & !JDM + REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_nba_mij), INTENT(INOUT) & :: nba_mij - REAL , DIMENSION( ims:ime, jms:jme), INTENT(IN ) :: mu - REAL , DIMENSION( kms:kme) , INTENT(IN ) :: c1, c2 - ! 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 + INTEGER :: is_ext,ie_ext,js_ext,je_ext REAL , DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1) :: titau3 @@ -4155,7 +4110,7 @@ SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu, c1, c2, & !----------------------------------------------------------------------- ktf=MIN(kte,kde-1) - + i_start = its i_end = MIN(ite,ide-1) j_start = jts @@ -4178,8 +4133,8 @@ SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu, c1, c2, & js_ext=0 je_ext=0 CALL cal_titau_11_22_33( config_flags, titau3, & - mu, c1, c2, tke, xkmh, defor33, & ! from RR 20131023 was xkmv - nba_mij(ims,kms,jms,P_m33), & !JDM + tke, xkmh, defor33, & + nba_mij(ims,kms,jms,P_m33), rho, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -4196,7 +4151,7 @@ SUBROUTINE vertical_diffusion_w_2(tendency, config_flags, mu, c1, c2, & 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)) + tendency(i,k,j)=tendency(i,k,j)+ g*(titau3(i,k,j)-titau3(i,k-1,j))/dn(k) ENDDO ENDDO ENDDO @@ -4206,9 +4161,8 @@ END SUBROUTINE vertical_diffusion_w_2 !======================================================================= !======================================================================= -SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, mu, & - c1, c2, xkhv, & - dn, dnw, rdz, rdzw, fnm, fnp, & +SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, xkhv, & + dn, dnw, rdz, rdzw, fnm, fnp, rho, & doing_tke, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -4236,13 +4190,11 @@ SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, mu, & REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN) :: xkhv - REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN) :: mu - REAL , DIMENSION( kms:kme) , INTENT(IN) :: c1, c2 - REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , & INTENT(IN ) :: var, & rdz, & - rdzw + rdzw, & + rho ! LOCAL VARS INTEGER :: i, j, k, ktf @@ -4259,7 +4211,7 @@ SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, mu, & !----------------------------------------------------------------------- ktf=MIN(kte,kde-1) - + i_start = its i_end = MIN(ite,ide-1) j_start = jts @@ -4294,9 +4246,8 @@ SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, mu, & 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) + xkxavg(i,k,j)=xkxavg(i,k,j)*(fnm(k)*rho(i,k,j)+fnp(k)*rho(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 @@ -4305,8 +4256,6 @@ SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, mu, & 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 @@ -4314,7 +4263,7 @@ SUBROUTINE vertical_diffusion_s( tendency, config_flags, var, mu, & 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) + + g * (H3(i,k+1,j)-H3(i,k,j))/dnw(k) ENDDO ENDDO ENDDO @@ -4336,8 +4285,8 @@ END SUBROUTINE vertical_diffusion_s !======================================================================= SUBROUTINE cal_titau_11_22_33( config_flags, titau, & - mu, c1, c2, tke, xkx, defor, & - mtau, & !JDM + tke, xkx, defor, & + mtau, rho, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -4370,21 +4319,16 @@ SUBROUTINE cal_titau_11_22_33( config_flags, titau, & its, ite, jts, jte, kts, kte INTEGER, INTENT( IN ) & - :: is_ext, ie_ext, js_ext, je_ext + :: is_ext, ie_ext, js_ext, je_ext REAL, DIMENSION( its-1:ite+1, kts:kte, jts-1:jte+1 ), INTENT( INOUT ) & - :: titau + :: titau REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: defor, xkx, tke - - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & !JDM - :: mtau + :: defor, xkx, tke, rho - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: mu - REAL, DIMENSION( kms:kme) , INTENT( IN ) & - :: c1, c2 + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: mtau ! Local variables. @@ -4413,9 +4357,9 @@ SUBROUTINE cal_titau_11_22_33( config_flags, titau, & IF ( config_flags%periodic_x ) i_end = ite i_start = i_start - is_ext - i_end = i_end + ie_ext + i_end = i_end + ie_ext j_start = j_start - js_ext - j_end = j_end + je_ext + j_end = j_end + je_ext IF ( config_flags%sfs_opt .GT. 0 ) THEN ! USE NBA MODEL SFS STRESSES @@ -4423,13 +4367,13 @@ SUBROUTINE cal_titau_11_22_33( config_flags, titau, & DO k = kts, ktf DO i = i_start, i_end - titau(i,k,j) = mu(i,j) * mtau(i,k,j) + titau(i,k,j) = rho(i,k,j) * mtau(i,k,j) END DO END DO - END DO + END DO - ELSE !NOT NBA + ELSE !NOT NBA IF ( config_flags%m_opt .EQ. 1 ) THEN ! ASSIGN STRESS TO MTAU FOR OUTPUT @@ -4437,28 +4381,28 @@ SUBROUTINE cal_titau_11_22_33( config_flags, titau, & 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) - mtau(i,k,j) = - xkx(i,k,j) * defor(i,k,j) - + titau(i,k,j) = - rho(i,k,j) * xkx(i,k,j) * defor(i,k,j) + mtau(i,k,j) = - xkx(i,k,j) * defor(i,k,j) + END DO END DO END DO - ELSE !NO STRESS OUTPUT + ELSE !NO STRESS OUTPUT 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) + titau(i,k,j) = - rho(i,k,j) * xkx(i,k,j) * defor(i,k,j) END DO END DO END DO - ENDIF + ENDIF - ENDIF + ENDIF END SUBROUTINE cal_titau_11_22_33 @@ -4466,8 +4410,8 @@ END SUBROUTINE cal_titau_11_22_33 !======================================================================= SUBROUTINE cal_titau_12_21( config_flags, titau, & - mu, c1, c2, xkx, defor, & - mtau, & !JDM + xkx, defor, & + mtau, rho, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -4500,21 +4444,16 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, & its, ite, jts, jte, kts, kte INTEGER, INTENT( IN ) & - :: is_ext, ie_ext, js_ext, je_ext + :: 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 + :: titau - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & !JDM - :: mtau + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + :: defor, xkx, rho - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: mu - REAL, DIMENSION( kms:kme) , INTENT( IN ) & - :: c1, c2 + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: mtau ! Local variables. @@ -4522,10 +4461,7 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, & :: 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 + :: xkxavg ! End declarations. !----------------------------------------------------------------------- @@ -4551,50 +4487,44 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, & IF ( config_flags%periodic_x ) i_end = ite i_start = i_start - is_ext - i_end = i_end + ie_ext + i_end = i_end + ie_ext j_start = j_start - js_ext - j_end = j_end + je_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) ) + xkxavg(i,k,j) = xkxavg(i,k,j) * .25 * ( rho(i-1,k,j ) + rho(i,k,j ) + & + rho(i-1,k,j-1) + rho(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 IF ( config_flags%sfs_opt .GT. 0 ) THEN ! USE NBA MODEL SFS STRESSES - + DO j = j_start, j_end DO k = kts, ktf DO i = i_start, i_end - titau(i,k,j) = muavg(i,j) * mtau(i,k,j) + titau(i,k,j) = rho(i,k,j) * mtau(i,k,j) END DO END DO END DO ELSE ! NOT NBA - + IF ( config_flags%m_opt .EQ. 1 ) THEN ! ASSIGN STRESS TO MTAU FOR OUTPUT 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) - mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) + titau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) + mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rho(i,k,j) END DO END DO @@ -4606,7 +4536,7 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, & 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) + titau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) END DO END DO @@ -4614,16 +4544,16 @@ SUBROUTINE cal_titau_12_21( config_flags, titau, & ENDIF - ENDIF + ENDIF END SUBROUTINE cal_titau_12_21 !======================================================================= SUBROUTINE cal_titau_13_31( config_flags, titau, & - defor, & - mtau, & !JDM - mu, c1, c2, xkx, fnm, fnp, & + defor, & + mtau, & + xkx, fnm, fnp, rho, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -4656,24 +4586,19 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, & its, ite, jts, jte, kts, kte INTEGER, INTENT( IN ) & - :: is_ext, ie_ext, js_ext, je_ext + :: 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 + :: titau - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & !JDM - :: mtau + REAL, DIMENSION( ims:ime, kms:kme, jms:jme), INTENT( IN ) & + :: defor, xkx, rho - REAL, DIMENSION( ims:ime, jms:jme), INTENT( IN ) & - :: mu - REAL, DIMENSION( kms:kme) , INTENT( IN ) & - :: c1, c2 + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: mtau ! Local variables. @@ -4681,10 +4606,7 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, & :: 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 + :: xkxavg ! End declarations. !----------------------------------------------------------------------- @@ -4710,46 +4632,42 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, & IF ( config_flags%periodic_x ) i_end = ite i_start = i_start - is_ext - i_end = i_end + ie_ext + i_end = i_end + ie_ext j_start = j_start - js_ext - j_end = j_end + je_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) ) ) + xkxavg(i,k,j) = xkxavg(i,k,j) * 0.5 * ( fnm(k) * ( rho(i-1,k ,j) + rho(i,k ,j) ) + & + fnp(k) * ( rho(i-1,k-1,j) + rho(i,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 - IF ( config_flags%sfs_opt .GT. 0 ) THEN ! USE NBA MODEL SFS STRESSES - + DO j = j_start, j_end DO k = kts+1, ktf DO i = i_start, i_end - titau(i,k,j) = muavg(i,j) * mtau(i,k,j) + titau(i,k,j) = rho(i,k,j) * mtau(i,k,j) ENDDO ENDDO ENDDO ELSE ! NOT NBA - + IF ( config_flags%m_opt .EQ. 1 ) THEN ! ASSIGN STRESS TO MTAU FOR OUTPUT 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) - mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) - + titau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) + mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rho(i,k,j) + ENDDO ENDDO ENDDO @@ -4760,15 +4678,15 @@ SUBROUTINE cal_titau_13_31( config_flags, titau, & 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) + titau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) ENDDO ENDDO ENDDO - ENDIF + ENDIF - ENDIF + ENDIF DO j = j_start, j_end DO i = i_start, i_end @@ -4783,8 +4701,8 @@ END SUBROUTINE cal_titau_13_31 !======================================================================= SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & - mtau, & !JDM - mu, c1, c2, xkx, fnm, fnp, & + mtau, & + xkx, fnm, fnp, rho, & is_ext, ie_ext, js_ext, je_ext, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & @@ -4817,24 +4735,19 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & its, ite, jts, jte, kts, kte INTEGER, INTENT( IN ) & - :: is_ext,ie_ext,js_ext,je_ext + :: 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( 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, kms:kme, jms:jme ), INTENT( INOUT ) & !JDM - :: mtau + :: defor, xkx, rho - REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & - :: mu - REAL, DIMENSION( kms:kme) , INTENT( IN ) & - :: c1, c2 + REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & + :: mtau ! Local variables. @@ -4842,10 +4755,7 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & :: 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 + :: xkxavg ! End declarations. !----------------------------------------------------------------------- @@ -4871,32 +4781,28 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 ) i_start = i_start - is_ext - i_end = i_end + ie_ext + i_end = i_end + ie_ext j_start = j_start - js_ext - j_end = j_end + je_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) ) ) + xkxavg(i,k,j) = xkxavg(i,k,j) * 0.5 * ( fnm(k) * ( rho(i,k ,j) + rho(i,k ,j-1) ) + & + fnp(k) * ( rho(i,k-1,j) + rho(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 - + IF ( config_flags%sfs_opt .GT. 0 ) THEN ! USE NBA MODEL SFS STRESSES DO j = j_start, j_end DO k = kts+1, ktf DO i = i_start, i_end - titau(i,k,j) = muavg(i,j) * mtau(i,k,j) + titau(i,k,j) = rho(i,k,j) * mtau(i,k,j) END DO END DO @@ -4910,8 +4816,8 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & 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) - mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) + titau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) + mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) / rho(i,k,j) END DO END DO @@ -4923,15 +4829,15 @@ SUBROUTINE cal_titau_23_32( config_flags, titau, defor, & 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) + titau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j) END DO END DO END DO - ENDIF + ENDIF - ENDIF + ENDIF DO j = j_start, j_end DO i = i_start, i_end @@ -4946,7 +4852,7 @@ END SUBROUTINE cal_titau_23_32 !======================================================================= SUBROUTINE phy_bc ( config_flags,div,defor11,defor22,defor33, & - defor12,defor13,defor23,xkmh,xkmv,xkhh,xkhv,tke, & + defor12,defor13,defor23,xkmh,xkmv,xkhh,xkhv,tke,rho, & RUBLTEN, RVBLTEN, & RUCUTEN, RVCUTEN, & RUSHTEN, RVSHTEN, & @@ -4984,7 +4890,8 @@ SUBROUTINE phy_bc ( config_flags,div,defor11,defor22,defor33, & xkhh, & xkhv, & tke, & - div + div, & + rho ! End declarations. !----------------------------------------------------------------------- @@ -5037,7 +4944,7 @@ SUBROUTINE phy_bc ( config_flags,div,defor11,defor22,defor33, & ENDIF - ! move out of the conditional, below; horiz coeffs needed for + ! move out of the conditional, below; horiz coeffs needed for ! all diff_opt cases. JM CALL set_physical_bc3d( xkmh , 't', config_flags, & @@ -5108,9 +5015,14 @@ SUBROUTINE phy_bc ( config_flags,div,defor11,defor22,defor33, & ips, ipe, jps, jpe, kps, kpe, & its, ite, jts, jte, kts, kte ) + CALL set_physical_bc3d( rho , '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 -END SUBROUTINE phy_bc +END SUBROUTINE phy_bc !======================================================================= !======================================================================= @@ -5195,7 +5107,7 @@ SUBROUTINE tke_rhs( tendency, BN2, config_flags, & hfx, qfx, qv, rho, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) + its, ite, jts, jte, kts, kte ) CALL tke_dissip( tendency, config_flags, mu, c1, c2, & tke, bn2, theta, p8w, t8w, z, & @@ -5223,7 +5135,7 @@ SUBROUTINE tke_rhs( tendency, BN2, config_flags, & 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 @@ -5265,7 +5177,7 @@ SUBROUTINE tke_buoyancy( tendency, config_flags, mu, & :: tendency REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & - :: xkhv, tke, BN2, theta + :: xkhv, tke, BN2, theta REAL, DIMENSION( ims:ime, jms:jme ), INTENT( IN ) & :: mu @@ -5276,7 +5188,7 @@ SUBROUTINE tke_buoyancy( tendency, config_flags, mu, & :: qv, rho REAL, DIMENSION(ims:ime, jms:jme ), INTENT ( IN ) :: hfx, qfx - + ! Local variables. INTEGER & @@ -5312,7 +5224,7 @@ SUBROUTINE tke_buoyancy( tendency, config_flags, mu, & 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 @@ -5334,18 +5246,18 @@ SUBROUTINE tke_buoyancy( tendency, config_flags, mu, & ! LES mods K=KTS DO j = j_start, j_end - DO i = i_start, i_end - heat_flux = heat_flux0 + 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 + 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 + 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) @@ -5353,7 +5265,7 @@ SUBROUTINE tke_buoyancy( tendency, config_flags, mu, & mu(i,j)*((xkhv(i,k,j)*BN2(i,k,j))- (g/theta(i,k,j))*heat_flux)/2. ENDDO - ENDDO + ENDDO CASE DEFAULT CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' ) @@ -5406,10 +5318,10 @@ SUBROUTINE tke_dissip( tendency, config_flags, & 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 @@ -5428,7 +5340,7 @@ SUBROUTINE tke_dissip( tendency, config_flags, & REAL, DIMENSION( its:ite, kts:kte, jts:jte ) & :: l_scale - REAL, DIMENSION( its:ite ) & + REAL, DIMENSION( its:ite ) & :: sumtke, sumtkez INTEGER & @@ -5474,7 +5386,7 @@ SUBROUTINE tke_dissip( tendency, config_flags, & 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. +! 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 @@ -5515,14 +5427,14 @@ SUBROUTINE tke_shear( tendency, config_flags, & ! kinetic energy by stresses due to sheared wind. ! References: Klemp and Wilhelmson (JAS 1978) -! Deardorff (B-L Meteor 1980) +! Deardorff (B-L Meteor 1980) ! Chen and Dudhia (NCAR WRF physics report 2000) ! Key: ! avg temporary working array -! cf1 -! cf2 +! cf1 +! cf2 ! cf3 ! defor11 deformation term ( du/dx + du/dx ) ! defor12 deformation term ( dv/dx + du/dy ); same as defor21 @@ -5570,7 +5482,7 @@ SUBROUTINE tke_shear( tendency, config_flags, & REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) & :: tendency - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( IN ) & + 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 @@ -5587,7 +5499,7 @@ SUBROUTINE tke_shear( tendency, config_flags, & INTEGER & :: i, j, k, ktf, ktes1, ktes2, & i_start, i_end, j_start, j_end, & - is_ext, ie_ext, js_ext, je_ext + is_ext, ie_ext, js_ext, je_ext REAL & :: mtau @@ -5606,7 +5518,7 @@ SUBROUTINE tke_shear( tendency, config_flags, & ktf = MIN( kte, kde-1 ) ktes1 = kte-1 ktes2 = kte-2 - + i_start = its i_end = MIN( ite, ide-1 ) j_start = jts @@ -5639,7 +5551,7 @@ SUBROUTINE tke_shear( tendency, config_flags, & ! 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). +! the one used). ! For defor11. @@ -5654,7 +5566,7 @@ SUBROUTINE tke_shear( tendency, config_flags, & ! For defor22. - DO j = j_start, j_end + 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 * & @@ -5665,7 +5577,7 @@ SUBROUTINE tke_shear( tendency, config_flags, & ! For defor33. - DO j = j_start, j_end + 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 * & @@ -5735,9 +5647,9 @@ SUBROUTINE tke_shear( tendency, config_flags, & uflux: SELECT CASE( config_flags%isfflx ) CASE (0) ! Assume cd a constant, specified in namelist - cd0 = config_flags%tke_drag_coefficient ! drag coefficient set + cd0 = config_flags%tke_drag_coefficient ! drag coefficient set ! in namelist.input - DO j = j_start, j_end + 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) @@ -5809,9 +5721,9 @@ SUBROUTINE tke_shear( tendency, config_flags, & vflux: SELECT CASE( config_flags%isfflx ) CASE (0) ! Assume cd a constant, specified in namelist - cd0 = config_flags%tke_drag_coefficient ! constant drag coefficient + cd0 = config_flags%tke_drag_coefficient ! constant drag coefficient ! set in namelist.input - DO j = j_start, j_end + 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) @@ -5825,7 +5737,7 @@ SUBROUTINE tke_shear( tendency, config_flags, & CASE (1,2) ! ustar computed from surface routine - DO j = j_start, j_end + 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 @@ -6083,7 +5995,7 @@ SUBROUTINE compute_diff_metrics( config_flags, ph, phb, z, rdz, rdzw, & END IF END IF - + ! Calculate z at p points. DO j = j_start, j_end diff --git a/dyn_em/module_first_rk_step_part2.F b/dyn_em/module_first_rk_step_part2.F index ae7ae90fcc..a57106f9df 100644 --- a/dyn_em/module_first_rk_step_part2.F +++ b/dyn_em/module_first_rk_step_part2.F @@ -329,14 +329,14 @@ SUBROUTINE first_rk_step_part2 ( grid , config_flags & 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, & + CALL set_physical_bc3d( grid%zx , 'e', 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, & + CALL set_physical_bc3d( grid%zy , 'f', config_flags, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & ips, ipe, jps, jpe, kps, kpe, & @@ -349,7 +349,13 @@ SUBROUTINE first_rk_step_part2 ( grid , config_flags & 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%ust, '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) @@ -474,7 +480,7 @@ SUBROUTINE first_rk_step_part2 ( grid , config_flags & 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%tke_2,grid%rho, & grid%rublten, grid%rvblten, & grid%rucuten, grid%rvcuten, & grid%rushten, grid%rvshten, & @@ -751,7 +757,6 @@ SUBROUTINE first_rk_step_part2 ( grid , config_flags & tracer_tend, num_tracer, & grid%u_2, grid%v_2, & grid%t_2,grid%u_base,grid%v_base,grid%t_base,grid%qv_base, & - grid%mut, grid%c1h, grid%c2h, & grid%tke_2, config_flags, & grid%defor13,grid%defor23,grid%defor33, & nba_mij, num_nba_mij, & !JDM @@ -784,7 +789,6 @@ SUBROUTINE first_rk_step_part2 ( grid , config_flags & scalar_tend, num_scalar, & tracer_tend, num_tracer, & grid%t_2, th_phy, & - grid%mut, grid%c1h, grid%c2h, & grid%tke_2, config_flags, & grid%defor11, grid%defor22, grid%defor12, & grid%defor13, grid%defor23, & @@ -795,7 +799,7 @@ SUBROUTINE first_rk_step_part2 ( grid , config_flags & 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, & + grid%zx, grid%zy, grid%dn, grid%dnw, grid%rho, & ids, ide, jds, jde, kds, kde, & ims, ime, jms, jme, kms, kme, & grid%i_start(ij), grid%i_end(ij), & diff --git a/dyn_em/solve_em.F b/dyn_em/solve_em.F index 0dc314edd9..1fdcd1d23e 100644 --- a/dyn_em/solve_em.F +++ b/dyn_em/solve_em.F @@ -3458,6 +3458,7 @@ SUBROUTINE solve_em ( grid , config_flags & !********************************************************** END DO Runge_Kutta_loop +! grid%dmudt=grid%mu_2 - grid%mu_1 IF ( config_flags%traj_opt .EQ. UM_TRAJECTORY ) THEN #ifdef DM_PARALLEL diff --git a/phys/module_mp_morr_two_moment.F b/phys/module_mp_morr_two_moment.F index af1e76e6e5..eb5919c521 100644 --- a/phys/module_mp_morr_two_moment.F +++ b/phys/module_mp_morr_two_moment.F @@ -74,11 +74,15 @@ ! from the calculation of PSMLT and PGMLT ! 2) redundant initialization of PSMLT (non answer-changing) +! CHANGES FOR WRFV3.8.1 +! 1) changes and cleanup of code comments +! 2) correction to universal gas constant (very small change) + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! THIS SCHEME IS A BULK DOUBLE-MOMENT SCHEME THAT PREDICTS MIXING ! RATIOS AND NUMBER CONCENTRATIONS OF FIVE HYDROMETEOR SPECIES: -! CLOUD DROPLETS, CLOUD (SMALL) ICE, RAIN, SNOW, AND GRAUPEL. +! CLOUD DROPLETS, CLOUD (SMALL) ICE, RAIN, SNOW, AND GRAUPEL/HAIL. MODULE MODULE_MP_MORR_TWO_MOMENT USE module_wrf_error @@ -94,13 +98,13 @@ MODULE MODULE_MP_MORR_TWO_MOMENT IMPLICIT NONE REAL, PARAMETER :: PI = 3.1415926535897932384626434 - REAL, PARAMETER :: SQRTPI = 0.9189385332046727417803297 + REAL, PARAMETER :: xxx = 0.9189385332046727417803297 PUBLIC :: MP_MORR_TWO_MOMENT PUBLIC :: POLYSVP PRIVATE :: GAMMA, DERF1 - PRIVATE :: PI, SQRTPI + PRIVATE :: PI, xxx PRIVATE :: MORR_TWO_MOMENT_MICRO !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -145,7 +149,7 @@ MODULE MODULE_MP_MORR_TWO_MOMENT ! LOCAL SUB-GRID AND/OR GRID-SCALE VERTICAL VELOCITY ! AT THE GRID POINT -! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0) +! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0) IN NON-WRF-CHEM VERSION OF CODE INTEGER, PRIVATE :: IBASE @@ -153,6 +157,8 @@ MODULE MODULE_MP_MORR_TWO_MOMENT ! ISUB = 0, INCLUDE SUB-GRID W (RECOMMENDED FOR LOWER RESOLUTION) ! ISUB = 1, EXCLUDE SUB-GRID W, ONLY USE GRID-SCALE W +! NOTE: ONLY USED FOR PREDICTED DROPLET CONCENTRATION (INUM = 0) IN NON-WRF-CHEM VERSION OF CODE + INTEGER, PRIVATE :: ISUB ! SWITCH FOR GRAUPEL/NO GRAUPEL @@ -424,6 +430,10 @@ SUBROUTINE MORR_TWO_MOMENT_INIT(hail_opt) ! RAS LAMMAXG = 1./20.E-6 LAMMING = 1./2000.E-6 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! note: these parameters only used by the non-wrf-chem version of the +! scheme with predicted droplet number + ! CCN SPECTRA FOR IACT = 1 ! MARITIME @@ -448,7 +458,9 @@ SUBROUTINE MORR_TWO_MOMENT_INIT(hail_opt) ! RAS RHOA = 1777. MAP = 0.132 MA = 0.0284 - RR = 8.3187 +! hm fix 6/23/16 +! RR = 8.3187 + RR = 8.3145 BACT = VI*OSM*EPSM*MW*RHOA/(MAP*RHOW) ! AEROSOL SIZE DISTRIBUTION PARAMETERS CURRENTLY SET FOR MPACE @@ -468,6 +480,7 @@ SUBROUTINE MORR_TWO_MOMENT_INIT(hail_opt) ! RAS NANEW2 = 1.8E6 F12 = 0.5*EXP(2.5*(LOG(SIG2))**2) F22 = 1.+0.25*LOG(SIG2) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! CONSTANTS FOR EFFICIENCY @@ -925,12 +938,11 @@ SUBROUTINE MORR_TWO_MOMENT_MICRO(QC3DTEN,QI3DTEN,QNI3DTEN,QR3DTEN, & !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! THIS PROGRAM IS THE MAIN TWO-MOMENT MICROPHYSICS SUBROUTINE DESCRIBED BY -! MORRISON ET AL. 2005 JAS; MORRISON AND PINTO 2005 JAS. -! ADDITIONAL CHANGES ARE DESCRIBED IN DETAIL BY MORRISON, THOMPSON, TATARSKII (MWR, SUBMITTED) +! MORRISON ET AL. 2005 JAS AND MORRISON ET AL. 2009 MWR ! THIS SCHEME IS A BULK DOUBLE-MOMENT SCHEME THAT PREDICTS MIXING ! RATIOS AND NUMBER CONCENTRATIONS OF FIVE HYDROMETEOR SPECIES: -! CLOUD DROPLETS, CLOUD (SMALL) ICE, RAIN, SNOW, AND GRAUPEL. +! CLOUD DROPLETS, CLOUD (SMALL) ICE, RAIN, SNOW, AND GRAUPEL/HAIL. ! CODE STRUCTURE: MAIN SUBROUTINE IS 'MORR_TWO_MOMENT'. ALSO INCLUDED IN THIS FILE IS ! 'FUNCTION POLYSVP', 'FUNCTION DERF1', AND @@ -4320,7 +4332,7 @@ REAL FUNCTION GAMMA(X) DO I=1,6 SUM=SUM/YSQ+C(I) END DO - SUM=SUM/Y-Y+SQRTPI + SUM=SUM/Y-Y+xxx SUM=SUM+(Y-HALF)*LOG(Y) RES=EXP(SUM) ELSE diff --git a/share/dfi.F b/share/dfi.F index f98d591439..156b516e33 100644 --- a/share/dfi.F +++ b/share/dfi.F @@ -434,17 +434,14 @@ END SUBROUTINE start_domain !tgs After start_domain moist and scalar arrays are fully dimentioned, !and initial values should be restored here if grid%dfi_savehydmeteors .EQ. 1: IF ( grid%dfi_savehydmeteors .EQ. 1 ) then - n_moist = num_moist ! print *,'FWD n_moist,PARAM_FIRST_SCALAR,P_QV,P_QC,P_QR,P_QI,P_QS,P_QG', & ! n_moist,PARAM_FIRST_SCALAR,P_QV,P_QC,P_QR,P_QI,P_QS,P_QG ! print *,'FWD num_scalar,P_QNC,P_QNI,P_QNR,P_QNWFA,P_QNIFA',P_QNC,P_QNI,P_QNR,P_QNWFA,P_QNIFA + n_moist = num_moist DO nm=PARAM_FIRST_SCALAR+1,n_moist grid%moist(:,:,:,nm)=grid%dfi_moist(:,:,:,nm) ENDDO - n_scalar = num_scalar - 1 - DO ns=PARAM_FIRST_SCALAR,n_scalar - grid%scalar(:,:,:,ns) = grid%dfi_scalar(:,:,:,ns) - ENDDO + grid%scalar(:,:,:,:) = grid%dfi_scalar(:,:,:,:) ENDIF END SUBROUTINE dfi_fwd_init @@ -771,7 +768,6 @@ SUBROUTINE dfi_array_reset( grid ) ! print *,'In dfi_array_reset - restore initial hydrometeors' ! grid%moist(:,:,:,:) = grid%dfi_moist(:,:,:,:) !tgs n_moist = num_moist - n_scalar = num_scalar-1 if (grid%dfi_stage .EQ. DFI_BCK) then !tgs - backward integration changed only QV n_moist = P_QV @@ -780,9 +776,7 @@ SUBROUTINE dfi_array_reset( grid ) DO nm=PARAM_FIRST_SCALAR+1,n_moist grid%moist(:,:,:,nm)=grid%dfi_moist(:,:,:,nm) ENDDO - DO ns=PARAM_FIRST_SCALAR,n_scalar - grid%scalar(:,:,:,ns) = grid%dfi_scalar(:,:,:,ns) - ENDDO + grid%scalar(:,:,:,:) = grid%dfi_scalar(:,:,:,:) if(grid%dfi_stage .EQ. DFI_FWD) then !tgs change QV to restore initial RH field after the diabatic DFI @@ -1064,13 +1058,13 @@ SUBROUTINE dfi_save_arrays( grid ) ! save hydrometeor and scalar fields IF ( grid%dfi_savehydmeteors .EQ. 1 ) then !tgs ! print *,'In dfi_save_arrays - save initial hydrometeors' - n_moist = num_moist ! print *,'SAVE n_moist,PARAM_FIRST_SCALAR,P_QV,P_QC,P_QR,P_QI,P_QS,P_QG', & ! n_moist,PARAM_FIRST_SCALAR,P_QV,P_QC,P_QR,P_QI,P_QS,P_QG + n_moist = num_moist DO nm=PARAM_FIRST_SCALAR+1,n_moist grid%dfi_moist(:,:,:,nm)=max(0.,grid%moist(:,:,:,nm)) ENDDO - grid%dfi_scalar(:,:,:,:) = max(0.,grid%scalar(:,:,:,:)) + grid%dfi_scalar(:,:,:,:) = max(0.,grid%scalar(:,:,:,:)) ENDIF if(grid%dfi_stage .EQ. DFI_BCK) then @@ -3310,6 +3304,7 @@ SUBROUTINE rebalance_dfi ( grid & REAL :: p_surf , pd_surf, p_surf_int , pb_int , ht_hold REAL :: qvf , qvf1 , qvf2, qtot REAL :: pfu, pfd, phm + REAL :: z0, z1, z2, w1, w2 ! Local domain indices and counters. @@ -3460,7 +3455,18 @@ SUBROUTINE rebalance_dfi ( grid & grid%ph_2(i,k,j) = grid%ph_2(i,k,j) - grid%phb(i,k,j) END DO + DO k = 1,kte + grid%ph0(i,k,j) = grid%ph_2(i,k,j) + grid%phb(i,k,j) + END DO + END IF +! update surface pressure PSFC: + z0 = grid%ph0(i,1,j)/g + z1 = 0.5*(grid%ph0(i,1,j)+grid%ph0(i,2,j))/g + z2 = 0.5*(grid%ph0(i,2,j)+grid%ph0(i,3,j))/g + w1 = (z0 - z2)/(z1 - z2) + w2 = 1. - w1 + grid%psfc(i,j) = w1*(grid%p(i,1,j)+grid%pb(i,1,j))+w2*(grid%p(i,2,j)+grid%pb(i,2,j)) ENDDO !i ENDDO !j From fbc5b48adc711f9b0abc8a9c90528d470463a785 Mon Sep 17 00:00:00 2001 From: Dave Gill Date: Thu, 15 Sep 2016 17:37:59 -0600 Subject: [PATCH 7/7] Fix the big step calc_ww_cp (k) that should be (k-1) --- dyn_em/module_big_step_utilities_em.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dyn_em/module_big_step_utilities_em.F b/dyn_em/module_big_step_utilities_em.F index 4307ad7769..f92e19bceb 100644 --- a/dyn_em/module_big_step_utilities_em.F +++ b/dyn_em/module_big_step_utilities_em.F @@ -812,7 +812,7 @@ SUBROUTINE calc_ww_cp ( u, v, mup, mub, c1h, c2h, ww, & ! +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)*c1h(k)*dmdt(i) - divv(i,k-1) + ww(i,k,j)=ww(i,k-1,j) - dnw(k-1)*c1h(k-1)*dmdt(i) - divv(i,k-1) ENDDO ENDDO