<p><b>duda</b> 2012-02-27 17:35:39 -0700 (Mon, 27 Feb 2012)</p><p>BRANCH COMMIT<br>
<br>
Update to r1537 of the trunk.<br>
</p><hr noshade><pre><font color="gray">
Property changes on: branches/omp_blocks/block_decomp
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp:754-986
/branches/ocean_projects/split_explicit_mrp:1134-1138
/branches/ocean_projects/split_explicit_timestepping:1044-1097
/branches/ocean_projects/vert_adv_mrp:704-745
/branches/omp_blocks/ddt_reorg:1301-1414
/branches/source_renaming:1082-1113
/branches/time_manager:924-962
/trunk/mpas:1374-1422
+ /branches/cam_mpas_nh:1260-1270
/branches/ocean_projects/ale_split_exp:1437-1483
/branches/ocean_projects/gmvar:1214-1494
/branches/ocean_projects/imp_vert_mix_mrp:754-986
/branches/ocean_projects/split_explicit_mrp:1134-1138
/branches/ocean_projects/split_explicit_timestepping:1044-1097
/branches/ocean_projects/vert_adv_mrp:704-745
/branches/omp_blocks/ddt_reorg:1301-1414
/branches/source_renaming:1082-1113
/branches/time_manager:924-962
/trunk/mpas:1374-1422,1449-1538
Modified: branches/omp_blocks/block_decomp/Makefile
===================================================================
--- branches/omp_blocks/block_decomp/Makefile 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/Makefile 2012-02-28 00:35:39 UTC (rev 1539)
@@ -14,234 +14,185 @@
dummy:
- @( echo "try one of:"; \
- echo " make xlf"; \
- echo " make pgi"; \
- echo " make ifort"; \
- echo " make gfortran"; \
- )
+ ( make error )
-xlf-serial:
+xlf:
( make all \
- "FC = xlf90" \
- "CC = xlc" \
- "SFC = xlf90" \
- "SCC = xlc" \
- "FFLAGS = -qrealsize=8 -g -C " \
- "CFLAGS = -g" \
- "LDFLAGS = -g -C" \
+ "FC_PARALLEL = mpxlf90" \
+ "CC_PARALLEL = mpcc" \
+ "FC_SERIAL = xlf90" \
+ "CC_SERIAL = xlc" \
+ "FFLAGS_OPT = -O3 -qrealsize=8" \
+ "CFLAGS_OPT = -O3" \
+ "LDFLAGS_OPT = -O3" \
"CORE = $(CORE)" \
+ "DEBUG = $(DEBUG)" \
+ "SERIAL = $(SERIAL)" \
+ "USE_PAPI = $(USE_PAPI)" \
"CPPFLAGS = $(MODEL_FORMULATION) $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
-
-xlf:
- ( make all \
- "FC = mpxlf90" \
- "CC = mpcc" \
- "SFC = xlf90" \
- "SCC = xlc" \
- "FFLAGS = -O3 -qrealsize=8" \
- "CFLAGS = -O3" \
- "LDFLAGS = -O3" \
- "CORE = $(CORE)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
ftn:
( make all \
- "FC = ftn" \
- "CC = cc" \
- "SFC = ftn" \
- "SCC = cc" \
- "FFLAGS = -i4 -r8 -gopt -O2 -Mvect=nosse -Kieee -convert big_endian" \
- "CFLAGS = -fast" \
- "LDFLAGS = " \
+ "FC_PARALLEL = ftn" \
+ "CC_PARALLEL = cc" \
+ "FC_SERIAL = ftn" \
+ "CC_SERIAL = cc" \
+ "FFLAGS_OPT = -i4 -r8 -gopt -O2 -Mvect=nosse -Kieee -convert big_endian" \
+ "CFLAGS_OPT = -fast" \
+ "LDFLAGS_OPT = " \
"CORE = $(CORE)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "DEBUG = $(DEBUG)" \
+ "SERIAL = $(SERIAL)" \
+ "USE_PAPI = $(USE_PAPI)" \
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
pgi:
( make all \
- "FC = mpif90" \
- "CC = mpicc" \
- "SFC = pgf90" \
- "SCC = pgcc" \
- "FFLAGS = -r8 -O3 -byteswapio -Mfree" \
- "CFLAGS = -O3" \
- "LDFLAGS = -O3" \
+ "FC_PARALLEL = mpif90" \
+ "CC_PARALLEL = mpicc" \
+ "FC_SERIAL = pgf90" \
+ "CC_SERIAL = pgcc" \
+ "FFLAGS_OPT = -r8 -O3 -byteswapio -Mfree" \
+ "CFLAGS_OPT = -O3" \
+ "LDFLAGS_OPT = -O3" \
+ "FFLAGS_DEBUG = -r8 -O0 -g -Mbounds -Mchkptr -byteswapio -Mfree" \
+ "CFLAGS_DEBUG = -O0 -g" \
+ "LDFLAGS_DEBUG = -O0 -g -Mbounds -Mchkptr" \
"CORE = $(CORE)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "DEBUG = $(DEBUG)" \
+ "SERIAL = $(SERIAL)" \
+ "USE_PAPI = $(USE_PAPI)" \
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
pgi-nersc:
( make all \
- "FC = ftn" \
- "CC = cc" \
- "SFC = ftn" \
- "SCC = cc" \
- "FFLAGS = -r8 -O3 -byteswapio -Mfree" \
- "CFLAGS = -O3" \
- "LDFLAGS = -O3" \
+ "FC_PARALLEL = ftn" \
+ "CC_PARALLEL = cc" \
+ "FC_SERIAL = ftn" \
+ "CC_SERIAL = cc" \
+ "FFLAGS_OPT = -r8 -O3 -byteswapio -Mfree" \
+ "CFLAGS_OPT = -O3" \
+ "LDFLAGS_OPT = -O3" \
"CORE = $(CORE)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "DEBUG = $(DEBUG)" \
+ "SERIAL = $(SERIAL)" \
+ "USE_PAPI = $(USE_PAPI)" \
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
pgi-llnl:
( make all \
- "FC = mpipgf90" \
- "CC = pgcc" \
- "SFC = pgf90" \
- "SCC = pgcc" \
- "FFLAGS = -i4 -r8 -g -O2 -byteswapio" \
- "CFLAGS = -fast" \
- "LDFLAGS = " \
+ "FC_PARALLEL = mpipgf90" \
+ "CC_PARALLEL = pgcc" \
+ "FC_SERIAL = pgf90" \
+ "CC_SERIAL = pgcc" \
+ "FFLAGS_OPT = -i4 -r8 -g -O2 -byteswapio" \
+ "CFLAGS_OPT = -fast" \
+ "LDFLAGS_OPT = " \
"CORE = $(CORE)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
-
-pgi-serial:
- ( make all \
- "FC = pgf90" \
- "CC = pgcc" \
- "SFC = pgf90" \
- "SCC = pgcc" \
- "FFLAGS = -r8 -O0 -g -Mbounds -Mchkptr -byteswapio -Mfree" \
- "CFLAGS = -O0 -g" \
- "LDFLAGS = -O0 -g -Mbounds -Mchkptr" \
- "CORE = $(CORE)" \
+ "DEBUG = $(DEBUG)" \
+ "SERIAL = $(SERIAL)" \
+ "USE_PAPI = $(USE_PAPI)" \
"CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
-ifort-serial:
+ifort:
( make all \
- "FC = ifort" \
- "CC = gcc" \
- "SFC = ifort" \
- "SCC = gcc" \
- "FFLAGS = -real-size 64 -O3 -convert big_endian -FR" \
- "CFLAGS = -O3 -m64" \
- "LDFLAGS = -O3" \
+ "FC_PARALLEL = mpif90" \
+ "CC_PARALLEL = gcc" \
+ "FC_SERIAL = ifort" \
+ "CC_SERIAL = gcc" \
+ "FFLAGS_OPT = -real-size 64 -O3 -convert big_endian -FR" \
+ "CFLAGS_OPT = -O3 -m64" \
+ "LDFLAGS_OPT = -O3" \
+ "FFLAGS_DEBUG = -real-size 64 -g -convert big_endian -FR -CU -CB -check all" \
+ "CFLAGS_DEBUG = -g -m64" \
+ "LDFLAGS_DEBUG = -g" \
"CORE = $(CORE)" \
+ "DEBUG = $(DEBUG)" \
+ "SERIAL = $(SERIAL)" \
+ "USE_PAPI = $(USE_PAPI)" \
"CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE -m64 $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
-ifort-papi:
- ( make all \
- "FC = mpif90" \
- "CC = gcc" \
- "SFC = ifort" \
- "SCC = gcc" \
- "FFLAGS = -real-size 64 -O3 -convert big_endian -FR" \
- "CFLAGS = -O3 -m64" \
- "LDFLAGS = -O3" \
- "CORE = $(CORE)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -D_PAPI -D_MPI -DUNDERSCORE -m64 $(FILE_OFFSET) $(ZOLTAN_DEFINE)" \
- "PAPILIBS = -L$(PAPI)/lib -lpapi" )
-
-ifort-papi-serial:
- ( make all \
- "FC = ifort" \
- "CC = gcc" \
- "SFC = ifort" \
- "SCC = gcc" \
- "FFLAGS = -real-size 64 -O3 -convert big_endian -FR" \
- "CFLAGS = -O3 -m64" \
- "LDFLAGS = -O3" \
- "CORE = $(CORE)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -D_PAPI -DUNDERSCORE -m64 $(FILE_OFFSET) $(ZOLTAN_DEFINE)" \
- "PAPILIBS = -L$(PAPI)/lib -lpapi" )
-
-ifort:
- ( make all \
- "FC = mpif90" \
- "CC = gcc" \
- "SFC = ifort" \
- "SCC = gcc" \
- "FFLAGS = -real-size 64 -O3 -convert big_endian -FR" \
- "CFLAGS = -O3 -m64" \
- "LDFLAGS = -O3" \
- "CORE = $(CORE)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE -m64 $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
-
gfortran:
( make all \
- "FC = mpif90" \
- "CC = mpicc" \
- "SFC = gfortran" \
- "SCC = gcc" \
- "FFLAGS = -O3 -m64 -ffree-line-length-none -fdefault-real-8 -fconvert=big-endian -ffree-form" \
- "CFLAGS = -O3 -m64" \
- "LDFLAGS = -O3 -m64" \
+ "FC_PARALLEL = mpif90" \
+ "CC_PARALLEL = mpicc" \
+ "FC_SERIAL = gfortran" \
+ "CC_SERIAL = gcc" \
+ "FFLAGS_OPT = -O3 -m64 -ffree-line-length-none -fdefault-real-8 -fconvert=big-endian -ffree-form" \
+ "CFLAGS_OPT = -O3 -m64" \
+ "LDFLAGS_OPT = -O3 -m64" \
+ "FFLAGS_DEBUG = -g -m64 -ffree-line-length-none -fdefault-real-8 -fconvert=big-endian -ffree-form -fbounds-check" \
+ "CFLAGS_DEBUG = -g -m64" \
+ "LDFLAGS_DEBUG = -g -m64" \
"CORE = $(CORE)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE -m64 $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
-
-gfortran-serial:
- ( make all \
- "FC = gfortran" \
- "CC = gcc" \
- "SFC = gfortran" \
- "SCC = gcc" \
- "FFLAGS = -O3 -m64 -ffree-line-length-none -fdefault-real-8 -fconvert=big-endian -ffree-form" \
- "CFLAGS = -O3 -m64" \
- "LDFLAGS = -O3 -m64" \
- "CORE = $(CORE)" \
+ "DEBUG = $(DEBUG)" \
+ "SERIAL = $(SERIAL)" \
+ "USE_PAPI = $(USE_PAPI)" \
"CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE -m64 $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
g95:
( make all \
- "FC = mpif90" \
- "CC = mpicc" \
- "SFC = g95" \
- "SCC = gcc" \
- "FFLAGS = -O3 -ffree-line-length-huge -r8 -fendian=big" \
- "CFLAGS = -O3" \
- "LDFLAGS = -O3" \
+ "FC_PARALLEL = mpif90" \
+ "CC_PARALLEL = mpicc" \
+ "FC_SERIAL = g95" \
+ "CC_SERIAL = gcc" \
+ "FFLAGS_OPT = -O3 -ffree-line-length-huge -r8 -fendian=big" \
+ "CFLAGS_OPT = -O3" \
+ "LDFLAGS_OPT = -O3" \
"CORE = $(CORE)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
-
-g95-serial:
- ( make all \
- "FC = g95" \
- "CC = gcc" \
- "SFC = g95" \
- "SCC = gcc" \
- "FFLAGS = -O3 -ffree-line-length-huge -r8 -fendian=big" \
- "CFLAGS = -O3" \
- "LDFLAGS = -O3" \
- "CORE = $(CORE)" \
+ "DEBUG = $(DEBUG)" \
+ "SERIAL = $(SERIAL)" \
+ "USE_PAPI = $(USE_PAPI)" \
"CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
pathscale-nersc:
( make all \
- "FC = ftn" \
- "CC = cc" \
- "SFC = ftn" \
- "SCC = cc" \
- "FFLAGS = -r8 -O3 -freeform -extend-source" \
- "CFLAGS = -O3" \
- "LDFLAGS = -O3" \
+ "FC_PARALLEL = ftn" \
+ "CC_PARALLEL = cc" \
+ "FC_SERIAL = ftn" \
+ "CC_SERIAL = cc" \
+ "FFLAGS_OPT = -r8 -O3 -freeform -extend-source" \
+ "CFLAGS_OPT = -O3" \
+ "LDFLAGS_OPT = -O3" \
"CORE = $(CORE)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "DEBUG = $(DEBUG)" \
+ "SERIAL = $(SERIAL)" \
+ "USE_PAPI = $(USE_PAPI)" \
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
cray-nersc:
( make all \
- "FC = ftn" \
- "CC = cc" \
- "SFC = ftn" \
- "SCC = cc" \
- "FFLAGS = -default64 -O3 -f free" \
- "CFLAGS = -O3" \
- "LDFLAGS = -O3" \
+ "FC_PARALLEL = ftn" \
+ "CC_PARALLEL = cc" \
+ "FC_SERIAL = ftn" \
+ "CC_SERIAL = cc" \
+ "FFLAGS_OPT = -default64 -O3 -f free" \
+ "CFLAGS_OPT = -O3" \
+ "LDFLAGS_OPT = -O3" \
"CORE = $(CORE)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "DEBUG = $(DEBUG)" \
+ "SERIAL = $(SERIAL)" \
+ "USE_PAPI = $(USE_PAPI)" \
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
intel-nersc:
( make all \
- "FC = ftn" \
- "CC = cc" \
- "SFC = ftn" \
- "SCC = cc" \
- "FFLAGS = -real-size 64 -O3 -FR" \
- "CFLAGS = -O3" \
- "LDFLAGS = -O3" \
+ "FC_PARALLEL = ftn" \
+ "CC_PARALLEL = cc" \
+ "FC_SERIAL = ftn" \
+ "CC_SERIAL = cc" \
+ "FFLAGS_OPT = -real-size 64 -O3 -FR" \
+ "CFLAGS_OPT = -O3" \
+ "LDFLAGS_OPT = -O3" \
"CORE = $(CORE)" \
- "CPPFLAGS = $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
+ "DEBUG = $(DEBUG)" \
+ "SERIAL = $(SERIAL)" \
+ "USE_PAPI = $(USE_PAPI)" \
+ "CPPFLAGS = $(MODEL_FORMULATION) -DUNDERSCORE $(FILE_OFFSET) $(ZOLTAN_DEFINE)" )
-CPPINCLUDES = -I../inc -I$(NETCDF)/include -I$(PAPI)/include
-FCINCLUDES = -I../inc -I$(NETCDF)/include -I$(PAPI)/include
-LIBS = -L$(NETCDF)/lib -lnetcdf $(PAPILIBS)
+CPPINCLUDES = -I../inc -I$(NETCDF)/include
+FCINCLUDES = -I../inc -I$(NETCDF)/include
+LIBS = -L$(NETCDF)/lib -lnetcdf
RM = rm -f
CPP = cpp -C -P -traditional
@@ -268,34 +219,109 @@
ifdef CORE
+ifeq "$(DEBUG)" "true"
+
+ifndef FFLAGS_DEBUG
+ FFLAGS=$(FFLAGS_OPT)
+ CFLAGS=$(CFLAGS_OPT)
+ LDFLAGS=$(LDFLAGS_OPT)
+ DEBUG_MESSAGE="Debug flags are not defined for this compile group. Defaulting to Optimized flags"
+else # FFLAGS_DEBUG IF
+ FFLAGS=$(FFLAGS_DEBUG)
+ CFLAGS=$(CFLAGS_DEBUG)
+ LDFLAGS=$(LDFLAGS_DEBUG)
+ DEBUG_MESSAGE="Debugging is on."
+endif # FFLAGS_DEBUG IF
+
+else # DEBUG IF
+ FFLAGS=$(FFLAGS_OPT)
+ CFLAGS=$(CFLAGS_OPT)
+ LDFLAGS=$(LDFLAGS_OPT)
+ DEBUG_MESSAGE="Debugging is off."
+endif # DEBUG IF
+
+ifeq "$(SERIAL)" "true"
+ FC=$(FC_SERIAL)
+ CC=$(CC_SERIAL)
+ SFC=$(FC_SERIAL)
+ SCC=$(CC_SERIAL)
+ SERIAL_MESSAGE="Serial version is on."
+else # SERIAL IF
+ FC=$(FC_PARALLEL)
+ CC=$(CC_PARALLEL)
+ SFC=$(FC_SERIAL)
+ SCC=$(CC_SERIAL)
+ CPPFLAGS += -D_MPI
+ SERIAL_MESSAGE="Parallel version is on."
+endif # SERIAL IF
+
+ifeq "$(USE_PAPI)" "true"
+ CPPINCLUDES += -I$(PAPI)/include -D_PAPI
+ FCINCLUDES += -I$(PAPI)/include
+ LIBS += -L$(PAPI)/lib -lpapi
+ PAPI_MESSAGE="Papi libraries are on."
+else # USE_PAPI IF
+ PAPI_MESSAGE="Papi libraries are off."
+endif # USE_PAPI IF
+
all: mpas_main
mpas_main:
cd src; make FC="$(FC)" \
- CC="$(CC)" \
- CFLAGS="$(CFLAGS)" \
- FFLAGS="$(FFLAGS)" \
- LDFLAGS="$(LDFLAGS)" \
- RM="$(RM)" \
- CPP="$(CPP)" \
- CPPFLAGS="$(CPPFLAGS)" \
- LIBS="$(LIBS)" \
- CPPINCLUDES="$(CPPINCLUDES)" \
- FCINCLUDES="$(FCINCLUDES)" \
- CORE="$(CORE)"
+ CC="$(CC)" \
+ SFC="$(SFC)" \
+ SCC="$(SCC)" \
+ CFLAGS="$(CFLAGS)" \
+ FFLAGS="$(FFLAGS)" \
+ LDFLAGS="$(LDFLAGS)" \
+ RM="$(RM)" \
+ CPP="$(CPP)" \
+ CPPFLAGS="$(CPPFLAGS)" \
+ LIBS="$(LIBS)" \
+ CPPINCLUDES="$(CPPINCLUDES)" \
+ FCINCLUDES="$(FCINCLUDES)" \
+ CORE="$(CORE)"
if [ ! -e $(CORE)_model.exe ]; then ln -s src/$(CORE)_model.exe .; fi
-
+ @echo ""
+ @echo $(DEBUG_MESSAGE)
+ @echo $(SERIAL_MESSAGE)
+ @echo $(PAPI_MESSAGE)
clean:
cd src; make clean RM="$(RM)" CORE="$(CORE)"
$(RM) $(CORE)_model.exe
+error: errmsg
-else
+else # CORE IF
-all: errmsg
+all: error
clean: errmsg
-errmsg:
+error: errmsg
@echo "************ ERROR ************"
@echo "No CORE specified. Quitting."
@echo "************ ERROR ************"
+ @echo ""
-endif
+endif # CORE IF
+
+errmsg:
+ @echo ""
+ @echo "Usage: make target CORE=[core] [options]"
+ @echo ""
+ @echo "Example targets:"
+ @echo " ifort"
+ @echo " gfortran"
+ @echo " xlf"
+ @echo " pgi"
+ @echo ""
+ @echo "Availabe Cores:"
+ @cd src; ls -d core_* | grep ".*" | sed "s/core_/ /g"
+ @echo ""
+ @echo "Available Options:"
+ @echo " SERIAL=true - builds serial version. Default is parallel version."
+ @echo " DEBUG=true - builds debug version. Default is optimized version."
+ @echo " USE_PAPI=true - builds version using PAPI for timers and hardware counters. Default is off."
+ @echo ""
+ @echo "Ensure that NETCDF (and PAPI if USE_PAPI=true) are environment variables"
+ @echo "that point to the absolute paths for the libraries."
+ @echo ""
+
Copied: branches/omp_blocks/block_decomp/graphics/ncl/atm_cells.ncl (from rev 1538, trunk/mpas/graphics/ncl/atm_cells.ncl)
===================================================================
--- branches/omp_blocks/block_decomp/graphics/ncl/atm_cells.ncl (rev 0)
+++ branches/omp_blocks/block_decomp/graphics/ncl/atm_cells.ncl 2012-02-28 00:35:39 UTC (rev 1539)
@@ -0,0 +1,145 @@
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+
+begin
+
+ r2d = 57.2957795 ; radians to degrees
+
+ maxedges = 8
+
+ wks = gsn_open_wks("pdf","atm_cells")
+ gsn_define_colormap(wks,"BlAqGrYeOrReVi200")
+
+ fname = getenv("FNAME")
+ f = addfile(fname,"r")
+
+ nEdgesOnCell = f->nEdgesOnCell(:)
+ verticesOnCell = f->verticesOnCell(:,:)
+ verticesOnEdge = f->verticesOnEdge(:,:)
+ x = f->lonCell(:) * r2d
+ y = f->latCell(:) * r2d
+ lonCell = f->lonCell(:) * r2d
+ latCell = f->latCell(:) * r2d
+ lonVertex = f->lonVertex(:) * r2d
+ latVertex = f->latVertex(:) * r2d
+
+ res = True
+ res@gsnPaperOrientation = "portrait"
+
+ res@sfXArray = x
+ res@sfYArray = y
+
+ res@cnFillOn = True
+ res@cnFillMode = "RasterFill"
+ res@cnLinesOn = False
+ res@cnLineLabelsOn = False
+ res@cnInfoLabelOn = False
+
+ res@lbLabelAutoStride = True
+ res@lbBoxLinesOn = False
+
+ res@mpProjection = "CylindricalEquidistant"
+; res@mpProjection = "Orthographic"
+ res@mpDataBaseVersion = "MediumRes"
+ res@mpCenterLatF = 0.
+ res@mpCenterLonF = 0.
+ res@mpGridAndLimbOn = False
+ res@mpOutlineOn = False
+ res@mpFillOn = False
+ res@mpPerimOn = False
+ res@gsnFrame = False
+
+ ;
+ ; The purpose of this section is simply to set up a graphic ('map')
+ ; that uses the projection specified above, and over which we
+ ; can draw polygons
+ ;
+ h = f->areaCell(:)
+ sizes = dimsizes(h)
+ nCells = sizes(0)
+ xpoly = new((/maxedges/), "double")
+ ypoly = new((/maxedges/), "double")
+ res@cnConstFLabelOn = False
+ res@lbLabelBarOn = False
+ map = gsn_csm_contour_map(wks,h,res)
+
+ t = stringtointeger(getenv("T"))
+
+ ;
+ ; Set the field to be plotted here
+ ;
+ pres = True
+ h = f->qv(t,:,0)
+ minfld = min(h)
+ maxfld = max(h)
+ fldrange = maxfld - minfld
+ do iCell=0,nCells-1
+ do i=0,nEdgesOnCell(iCell)-1
+ xpoly(i) = lonVertex(verticesOnCell(iCell,i)-1)
+ ypoly(i) = latVertex(verticesOnCell(iCell,i)-1)
+ if (i .gt. 0) then
+ if (abs(xpoly(i) - xpoly(0)) .gt. 180.0) then
+ if (xpoly(i) .gt. xpoly(0)) then
+ xpoly(i) = xpoly(i) - 360.0
+ else
+ xpoly(i) = xpoly(i) + 360.0
+ end if
+ end if
+ end if
+ end do
+ pres@gsFillColor = doubletointeger(198*(h(iCell) - minfld)/fldrange+2)
+ gsn_polygon(wks,map,xpoly(0:nEdgesOnCell(iCell)-1),ypoly(0:nEdgesOnCell(iCell)-1),pres);
+ end do
+
+
+ ;
+ ; Draw label bar
+ ;
+
+ xcb = new((/4/), "float")
+ ycb = new((/4/), "float")
+
+ tres = True
+ tres@txAngleF = 90.0
+ tres@txFontHeightF = 0.015
+ do i=2,200
+ xcb(0) = 0.125 + i*0.75/198
+ ycb(0) = 0.11
+
+ xcb(1) = 0.125 + (i+1)*0.75/198
+ ycb(1) = 0.11
+
+ xcb(2) = 0.125 + (i+1)*0.75/198
+ ycb(2) = 0.16
+
+ xcb(3) = 0.125 + i*0.75/198
+ ycb(3) = 0.16
+
+ tres@gsFillColor = i
+
+ gsn_polygon_ndc(wks,xcb,ycb,tres);
+
+ j = (i-2) % 20
+ if ((j .eq. 0) .or. (i .eq. 200)) then
+ ff = minfld + int2flt(i-2) * fldrange / 198.0
+ label = sprintf("%5.3g", ff)
+ gsn_text_ndc(wks, label, xcb(0), 0.060, tres)
+ end if
+
+ end do
+
+ mres = True
+ mres@mpCenterLatF = 0.
+ mres@mpCenterLonF = 0.
+ mres@mpGridAndLimbOn = False
+ mres@mpOutlineOn = True
+ mres@mpFillOn = False
+ mres@mpPerimOn = False
+ mres@gsnFrame = False
+ mapo = gsn_csm_map(wks,mres)
+
+ frame(wks)
+
+end
+
Copied: branches/omp_blocks/block_decomp/graphics/ncl/atm_contours.ncl (from rev 1538, trunk/mpas/graphics/ncl/atm_contours.ncl)
===================================================================
--- branches/omp_blocks/block_decomp/graphics/ncl/atm_contours.ncl (rev 0)
+++ branches/omp_blocks/block_decomp/graphics/ncl/atm_contours.ncl 2012-02-28 00:35:39 UTC (rev 1539)
@@ -0,0 +1,152 @@
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+
+begin
+
+ ;
+ ; Which field to plot
+ ;
+ plotfield = "h"
+; plotfield = "ke"
+; plotfield = "vorticity"
+
+ ;
+ ; Whether to plot wind vectors
+ ;
+; winds = True
+ winds = False
+
+ ;
+ ; Whether to do color-filled plot (filled=True) or
+ ; to plot contours of height field (filled=False)
+ ;
+; filled = True
+ filled = False
+
+ ;
+ ; The (lat,lon) the plot is to be centered over
+ ;
+ cenLat = 0.0
+ cenLon = 0.0
+
+ ;
+ ; Projection to use for plot
+ ;
+; projection = "Orthographic"
+ projection = "CylindricalEquidistant"
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+ r2d = 57.2957795 ; radians to degrees
+
+ maxedges = 7
+
+ wks = gsn_open_wks("pdf","atm_contours")
+ gsn_define_colormap(wks,"gui_default")
+
+ fname = getenv("FNAME")
+ f = addfile(fname,"r")
+
+ lonCell = f->lonCell(:) * r2d
+ latCell = f->latCell(:) * r2d
+ lonVertex = f->lonVertex(:) * r2d
+ latVertex = f->latVertex(:) * r2d
+ lonEdge = f->lonEdge(:) * r2d
+ latEdge = f->latEdge(:) * r2d
+ verticesOnCell = f->verticesOnCell(:,:)
+ alpha = f->angleEdge(:)
+
+ res = True
+ res@gsnMaximize = True
+ res@gsnSpreadColors = True
+
+ if (plotfield .eq. "h" .or. plotfield .eq. "ke") then
+ res@sfXArray = lonCell
+ res@sfYArray = latCell
+ end if
+ if (plotfield .eq. "vorticity") then
+ res@sfXArray = lonVertex
+ res@sfYArray = latVertex
+ end if
+
+ res@cnFillMode = "AreaFill"
+
+ if (filled) then
+ res@cnFillOn = True
+ res@cnLinesOn = False
+ res@cnLineLabelsOn = False
+ else
+ res@cnFillOn = False
+ res@cnLinesOn = True
+ res@cnLineLabelsOn = True
+ end if
+
+; res@cnLevelSpacingF = 50.0
+ res@cnInfoLabelOn = True
+
+ res@lbLabelAutoStride = True
+ res@lbBoxLinesOn = False
+
+ res@mpProjection = projection
+ res@mpDataBaseVersion = "MediumRes"
+ res@mpCenterLatF = cenLat
+ res@mpCenterLonF = cenLon
+ res@mpGridAndLimbOn = True
+ res@mpGridAndLimbDrawOrder = "PreDraw"
+ res@mpGridLineColor = "Background"
+ res@mpOutlineOn = True
+ res@mpDataBaseVersion = "Ncarg4_1"
+ res@mpDataSetName = "Earth..3"
+ res@mpOutlineBoundarySets = "Geophysical"
+ res@mpFillOn = False
+ res@mpPerimOn = True
+ res@gsnFrame = False
+ res@cnLineThicknessF = 2.0
+ res@cnLineColor = "NavyBlue"
+
+ t = stringtointeger(getenv("T"))
+ if (plotfield .eq. "h") then
+; fld = f->xice(t,:)
+; fld = f->sst(t,:)
+; fld = f->surface_pressure(t,:)
+; fld = f->pressure_base(t,:,25) + f->pressure_p(t,:,25)
+ fld = f->theta(t,:,25)
+ end if
+ if (plotfield .eq. "ke") then
+ fld = f->ke(t,:,0)
+ end if
+ if (plotfield .eq. "vorticity") then
+ fld = f->vorticity(t,:,0)
+ end if
+ res@cnLineDashPattern = 0
+ map = gsn_csm_contour_map(wks,fld,res)
+
+ if (winds) then
+ u = f->u(t,:,0)
+ v = f->v(t,:,0)
+ esizes = dimsizes(u)
+ u_earth = new(dimsizes(u),float)
+ v_earth = new(dimsizes(u),float)
+ lat_edge = new(dimsizes(u),float)
+ lon_edge = new(dimsizes(u),float)
+ do i=0,esizes(0)-1
+ u_earth(i) = doubletofloat(u(i)*cos(alpha(i)) - v(i)*sin(alpha(i)))
+ v_earth(i) = doubletofloat(u(i)*sin(alpha(i)) + v(i)*cos(alpha(i)))
+ lat_edge(i) = doubletofloat(latEdge(i))
+ lon_edge(i) = doubletofloat(lonEdge(i))
+ end do
+
+ wmsetp("VCH",0.0010)
+ wmsetp("VRN",0.010)
+ wmsetp("VRS",100.0)
+ wmsetp("VCW",0.10)
+
+ wmvectmap(wks, lat_edge, lon_edge, u_earth, v_earth)
+ end if
+
+ frame(wks)
+
+end
+
Copied: branches/omp_blocks/block_decomp/graphics/ncl/atm_mesh.ncl (from rev 1538, trunk/mpas/graphics/ncl/atm_mesh.ncl)
===================================================================
--- branches/omp_blocks/block_decomp/graphics/ncl/atm_mesh.ncl (rev 0)
+++ branches/omp_blocks/block_decomp/graphics/ncl/atm_mesh.ncl 2012-02-28 00:35:39 UTC (rev 1539)
@@ -0,0 +1,80 @@
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+
+begin
+
+ r2d = 57.2957795 ; radians to degrees
+
+ wks = gsn_open_wks("pdf","atm_mesh")
+
+ colors = (/"white","black","lightskyblue1","lightskyblue1","bisque"/)
+; colors = (/"white","black","white","white","grey90"/)
+ gsn_define_colormap(wks,colors)
+
+ fname = getenv("FNAME")
+ f = addfile(fname,"r")
+
+ xVertex = f->xVertex(:)
+ yVertex = f->yVertex(:)
+ zVertex = f->zVertex(:)
+ verticesOnCell = f->verticesOnCell(:,:)
+ verticesOnEdge = f->verticesOnEdge(:,:)
+ x = f->lonCell(:) * r2d
+ y = f->latCell(:) * r2d
+ lonCell = f->lonCell(:) * r2d
+ latCell = f->latCell(:) * r2d
+ lonVertex = f->lonVertex(:) * r2d
+ latVertex = f->latVertex(:) * r2d
+ lonEdge = f->lonEdge(:) * r2d
+ latEdge = f->latEdge(:) * r2d
+
+ res = True
+ res@gsnMaximize = True
+
+ res@mpProjection = "Orthographic"
+ res@mpDataBaseVersion = "MediumRes"
+ res@mpCenterLatF = 50.
+ res@mpCenterLonF = -100.
+ res@mpCenterRotF = -100.
+ res@mpGridAndLimbOn = False
+ res@mpOutlineOn = True
+ res@mpFillOn = True
+ res@mpPerimOn = False
+ res@gsnFrame = False
+ res@mpOceanFillColor = 3
+ res@mpInlandWaterFillColor = 3
+ res@mpLandFillColor = 4
+
+ map = gsn_csm_map(wks,res)
+
+ lres = True
+ lres@gsLineThicknessF = 0.10
+
+ esizes = dimsizes(latEdge)
+ ecx = new((/esizes(0),2/),double)
+ ecy = new((/esizes(0),2/),double)
+ do j=0,esizes(0)-1
+ ecy(j,0) = latVertex(verticesOnEdge(j,0)-1)
+ ecx(j,0) = lonVertex(verticesOnEdge(j,0)-1)
+ ecy(j,1) = latVertex(verticesOnEdge(j,1)-1)
+ ecx(j,1) = lonVertex(verticesOnEdge(j,1)-1)
+ end do
+
+ do j=0,esizes(0)-1
+ if (abs(ecx(j,0) - ecx(j,1)) .gt. 180.0) then
+ if (ecx(j,0) .gt. ecx(j,1)) then
+ ecx(j,0) = ecx(j,0) - 360.0
+ else
+ ecx(j,1) = ecx(j,1) - 360.0
+ end if
+ end if
+ end do
+
+ do j=0,esizes(0)-1
+ gsn_polyline(wks,map,ecx(j,:),ecy(j,:),lres)
+ end do
+
+ frame(wks)
+
+end
+
Copied: branches/omp_blocks/block_decomp/graphics/ncl/atm_xsec.ncl (from rev 1538, trunk/mpas/graphics/ncl/atm_xsec.ncl)
===================================================================
--- branches/omp_blocks/block_decomp/graphics/ncl/atm_xsec.ncl (rev 0)
+++ branches/omp_blocks/block_decomp/graphics/ncl/atm_xsec.ncl 2012-02-28 00:35:39 UTC (rev 1539)
@@ -0,0 +1,373 @@
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+
+begin
+ r2d = 57.2957795 ; radians to degrees
+ pi = 3.14159265
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ ;
+ ; Which field to plot
+ ;
+; plotfield = "w"
+ plotfield = "theta"
+; plotfield = "ke"
+; plotfield = "vorticity"
+
+
+ ;
+ ; Whether to plot horizontal wind vectors
+ ;
+; horiz_winds = True
+ horiz_winds = False
+
+ ;
+ ; Whether to do color-filled plot (filled=True) or
+ ; to plot contours of height field (filled=False)
+ ;
+ filled = True
+; filled = False
+
+ ;
+ ; Starting and ending locations (in degrees)
+ ; Exercise caution when setting these: setting start_lon=90.0 and end_lon=-90.0
+ ; would create a cross-section including the prime meridian, whereas setting
+ ; start_lon=90.0 and end_lon=270.0 would create a cross-section containing
+ ; the date line, for example.
+ ;
+ ;
+ start_lat = 40.0
+ start_lon = -140.0
+ end_lat = 40.0
+ end_lon = -80.0
+
+ ;
+ ; The number of points along the cross section
+ ;
+ nsec = 250
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+ wks = gsn_open_wks("pdf","atm_xsec")
+ gsn_define_colormap(wks,"BlAqGrYeOrReVi200")
+
+ fname = getenv("FNAME")
+ f = addfile(fname,"r")
+
+ lonCell = f->lonCell(:) * r2d
+ latCell = f->latCell(:) * r2d
+ xCell = f->xCell(:)
+ yCell = f->yCell(:)
+ zCell = f->zCell(:)
+ lonVertex = f->lonVertex(:) * r2d
+ latVertex = f->latVertex(:) * r2d
+ xVertex = f->xVertex(:)
+ yVertex = f->yVertex(:)
+ zVertex = f->zVertex(:)
+ lonEdge = f->lonEdge(:) * r2d
+ latEdge = f->latEdge(:) * r2d
+ xEdge = f->xEdge(:)
+ yEdge = f->yEdge(:)
+ zEdge = f->zEdge(:)
+ zgrid = f->zgrid(:,:) / 1000.0
+ verticesOnCell = f->verticesOnCell(:,:)
+ edgesOnCell = f->edgesOnCell(:,:)
+ nCellsOnCell = f->nEdgesOnCell(:)
+ cellsOnCell = f->cellsOnCell(:,:)
+ alpha = f->angleEdge(:)
+
+ dims = dimsizes(latCell)
+ nCells = dims(0)
+
+ start_lat = start_lat / r2d
+ start_lon = start_lon / r2d
+ end_lat = end_lat / r2d
+ end_lon = end_lon / r2d
+
+ radius = 6371220.0
+ xsec_latitude = start_lat
+ xsec_longitude = start_lon
+ xsec_lat_inc = (end_lat - start_lat) / (int2flt(nsec) - 1.0)
+ xsec_lon_inc = (end_lon - start_lon) / (int2flt(nsec) - 1.0)
+
+ xsecx = new((/nsec/),float)
+ xsecy = new((/nsec/),float)
+ xsecz = new((/nsec/),float)
+ xsec_cell_id = new((/nsec/),integer)
+ xsec_edge_id = new((/nsec/),integer)
+ xsec_vtx_id = new((/nsec/),integer)
+ xsec_id = new((/nsec/),integer)
+
+ ; Compute (x,y,z) coordinates for points on cross section
+ do i=0,nsec-1
+ xsecx(i) = radius * cos(xsec_longitude) * cos(xsec_latitude)
+ xsecy(i) = radius * sin(xsec_longitude) * cos(xsec_latitude)
+ xsecz(i) = radius * sin(xsec_latitude)
+ xsec_latitude = xsec_latitude + xsec_lat_inc
+ xsec_longitude = xsec_longitude + xsec_lon_inc
+ end do
+
+ ; Find cell containing first cross section point
+ dmin = 2.0 * radius
+ cellmin = -1
+ do i=0,nCells-1
+ d = sqrt((xCell(i) - xsecx(0))^2.0 + (yCell(i) - xsecy(0))^2.0 + (zCell(i) - xsecz(0))^2.0)
+ if (d .lt. dmin) then
+ cellmin = i
+ dmin = doubletofloat(d)
+ end if
+ end do
+ xsec_cell_id(0) = cellmin
+
+ ; For the remaining cross section points, find the grid cell containing them
+ do j=1,nsec-1
+ moved = 1
+ do while (moved .ne. 0)
+ moved = 0
+ d = sqrt((xCell(cellmin) - xsecx(j))^2.0 + (yCell(cellmin) - xsecy(j))^2.0 + (zCell(cellmin) - xsecz(j))^2.0)
+ do k=0,nCellsOnCell(cellmin)-1
+ dn = sqrt((xCell(cellsOnCell(cellmin,k)-1) - xsecx(j))^2.0 + (yCell(cellsOnCell(cellmin,k)-1) - xsecy(j))^2.0 + (zCell(cellsOnCell(cellmin,k)-1) - xsecz(j))^2.0)
+ if (dn .lt. d) then
+ d = dn
+ nearest = (/cellsOnCell(cellmin,k)/)-1
+ moved = 1
+ end if
+ end do
+ if (moved .eq. 1) then
+ cellmin = nearest
+ end if
+ end do
+ xsec_cell_id(j) = cellmin
+ end do
+
+ ; For all cross section points, find the nearest vertex and edge
+ do i=0,nsec-1
+ iVtx = verticesOnCell(xsec_cell_id(i),0) - 1
+ iEdge = edgesOnCell(xsec_cell_id(i),0) - 1
+ xsec_edge_id(i) = iEdge
+ xsec_vtx_id(i) = iVtx
+ de = sqrt((xEdge(iEdge) - xsecx(i))^2.0 + (yEdge(iEdge) - xsecy(i))^2.0 + (zEdge(iEdge) - xsecz(i))^2.0)
+ dv = sqrt((xVertex(iVtx) - xsecx(i))^2.0 + (yVertex(iVtx) - xsecy(i))^2.0 + (zVertex(iVtx) - xsecz(i))^2.0)
+ do j=1,nCellsOnCell(xsec_cell_id(i))-1
+ iVtx = verticesOnCell(xsec_cell_id(i),j) - 1
+ iEdge = edgesOnCell(xsec_cell_id(i),j) - 1
+ de_test = sqrt((xEdge(iEdge) - xsecx(i))^2.0 + (yEdge(iEdge) - xsecy(i))^2.0 + (zEdge(iEdge) - xsecz(i))^2.0)
+ dv_test = sqrt((xVertex(iVtx) - xsecx(i))^2.0 + (yVertex(iVtx) - xsecy(i))^2.0 + (zVertex(iVtx) - xsecz(i))^2.0)
+ if (de_test .lt. de) then
+ de = de_test
+ xsec_edge_id(i) = iEdge
+ end if
+ if (dv_test .lt. dv) then
+ dv = dv_test
+ xsec_vtx_id(i) = iVtx
+ end if
+ end do
+ end do
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ; At this point, xsec_cell_id(:), xsec_edge_id(:), and xsec_vtx_id(:) contains the cell, edge,
+ ; and vertex IDs of the nearest points to those along the cross section
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+ res = True
+ res@gsnMaximize = False
+ res@gsnSpreadColors = True
+
+ res@cnFillMode = "AreaFill"
+
+ if (filled) then
+ res@cnFillOn = True
+ res@cnLinesOn = False
+ res@cnLineLabelsOn = False
+ else
+ res@cnFillOn = False
+ res@cnLinesOn = True
+ res@cnLineLabelsOn = True
+ end if
+
+ res@cnLevelSpacingF = 0.01
+ res@cnInfoLabelOn = True
+
+ res@lbLabelAutoStride = True
+ res@lbBoxLinesOn = False
+
+ res@gsnFrame = False
+
+
+ ;
+ ; Select field to be plotted, and set generic array xsec_id(:) to contain IDs of
+ ; locations (cell, edge, or vertex) in that field containg cross section points
+ ;
+
+ t = stringtointeger(getenv("T"))
+ if (plotfield .eq. "w") then
+ fld1 = f->w(t,:,:)
+ ldims = dimsizes(fld1)
+ fld = new((/ldims(0),ldims(1)-1/),"double")
+ ; Average w to center of layers
+ do i=0,ldims(0)-1
+ do j=0,ldims(1)-2
+ fld(i,j) = 0.5*(fld1(i,j)+fld1(i,j+1))
+ end do
+ end do
+ nVertLevels = ldims(1)
+ nVertLevels = nVertLevels-1
+ xsec_id(:) = xsec_cell_id(:)
+ end if
+ if (plotfield .eq. "theta") then
+ fld = f->theta(t,:,:)
+ ldims = dimsizes(fld)
+ nVertLevels = ldims(1)
+ xsec_id(:) = xsec_cell_id(:)
+ end if
+ if (plotfield .eq. "ke") then
+ fld = f->ke(t,:,:)
+ ldims = dimsizes(fld)
+ nVertLevels = ldims(1)
+ xsec_id(:) = xsec_cell_id(:)
+ end if
+ if (plotfield .eq. "vorticity") then
+ fld = f->vorticity(t,:,:)
+ ldims = dimsizes(fld)
+ nVertLevels = ldims(1)
+ xsec_id(:) = xsec_vtx_id(:)
+ end if
+ res@cnLineDashPattern = 0
+
+ height1 = new((/nVertLevels+1,nsec/),float)
+ height = new((/nVertLevels+1,nsec+1/),float)
+ x = new((/nVertLevels+1,nsec+1/),float)
+
+ ; Extract field from along cross section into plotting array
+ arr = new((/nVertLevels,nsec/),float)
+ do i=0,nsec-1
+ do j=0,nVertLevels-1
+; arr(j,i) = 0.5*doubletofloat(fld(xsec_id(i),j)+fld(xsec_id(i),j+1))
+ arr(j,i) = doubletofloat(fld(xsec_id(i),j))
+ height1(j,i) = doubletofloat(zgrid(xsec_id(i),j))
+ end do
+ j = nVertLevels
+ height1(j,i) = doubletofloat(zgrid(xsec_id(i),j))
+ end do
+
+ do j=0,nVertLevels
+ x(j,nsec) = int2flt(nsec) + 0.5
+ x(j,0) = 0.5
+ height(j,0) = height1(j,0)
+ height(j,nsec) = height1(j,nsec-1)
+ end do
+
+ do i=1,nsec-1
+ do j=0,nVertLevels
+ height(j,i) = 0.5*(height1(j,i) + height1(j,i-1))
+ x(j,i) = int2flt(i) + 0.5
+ end do
+ end do
+
+ xpoly = new((/5/), "float")
+ ypoly = new((/5/), "float")
+
+ minfld = min(arr)
+ maxfld = max(arr)
+ fldrange = maxfld - minfld
+
+ res@trYMinF = min(zgrid)
+ res@trYMaxF = max(zgrid)
+ res@trXMinF = int2flt(0)
+ res@trXMaxF = int2flt(nsec+1)
+
+ res@tiYAxisString = "z(km)"
+ res@tiYAxisFontHeightF = 0.017
+ res@tiXAxisString = "cell"
+ res@tiXAxisFontHeightF = 0.017
+
+ map = gsn_csm_xy(wks,x,height,res)
+
+ do i=0,nsec-1
+ do j=0,nVertLevels-1
+ xpoly(0) = x(j,i)
+ xpoly(1) = x(j,i+1)
+ xpoly(2) = x(j+1,i+1)
+ xpoly(3) = x(j+1,i)
+ xpoly(4) = x(j,i)
+
+ ypoly(0) = height(j,i)
+ ypoly(1) = height(j,i+1)
+ ypoly(2) = height(j+1,i+1)
+ ypoly(3) = height(j+1,i)
+ ypoly(4) = height(j,i)
+
+ res@gsFillColor = doubletointeger(195*(arr(j,i) - minfld)/fldrange+2)
+ gsn_polygon(wks,map,xpoly,ypoly,res);
+ end do
+ end do
+
+ if (horiz_winds) then
+ u = f->u(t,:,:)
+ v = f->v(t,:,:)
+ esizes = dimsizes(u)
+ nVertLevels = esizes(1)
+ u_earth = new((/nVertLevels,nsec/),float)
+ v_earth = new((/nVertLevels,nsec/),float)
+ x_edge = new((/nVertLevels,nsec/),float)
+ y_edge = new((/nVertLevels,nsec/),float)
+ do i=0,nsec-1
+ do j=0,nVertLevels-1
+ u_earth(j,i) = doubletofloat(u(xsec_edge_id(i),j)*cos(alpha(xsec_edge_id(i))) - v(xsec_edge_id(i),j)*sin(alpha(xsec_edge_id(i))))
+ v_earth(j,i) = doubletofloat(u(xsec_edge_id(i),j)*sin(alpha(xsec_edge_id(i))) + v(xsec_edge_id(i),j)*cos(alpha(xsec_edge_id(i))))
+ x_edge(j,i) = i
+ y_edge(j,i) = j
+ end do
+ end do
+
+ wmsetp("VCH",0.0010)
+ wmsetp("VRN",0.010)
+ wmsetp("VRS",50.0)
+ wmsetp("VCW",0.10)
+
+ wmvect(wks, x_edge, y_edge, u_earth, v_earth)
+ end if
+
+ ;
+ ; Draw label bar
+ ;
+
+ xcb = new((/4/), "float")
+ ycb = new((/4/), "float")
+
+ tres = True
+ tres@txAngleF = 90.0
+ tres@txFontHeightF = 0.013
+ do i=2,200
+ xcb(0) = 0.125 + i*0.75/198
+ ycb(0) = 0.08
+
+ xcb(1) = 0.125 + (i+1)*0.75/198
+ ycb(1) = 0.08
+
+ xcb(2) = 0.125 + (i+1)*0.75/198
+ ycb(2) = 0.10
+
+ xcb(3) = 0.125 + i*0.75/198
+ ycb(3) = 0.10
+
+ tres@gsFillColor = i
+
+ gsn_polygon_ndc(wks,xcb,ycb,tres);
+
+ j = (i-2) % 20
+ if ((j .eq. 0) .or. (i .eq. 200)) then
+ ff = minfld + int2flt(i-2) * fldrange / 198.0
+ label = sprintf("%8.3g", ff)
+ gsn_text_ndc(wks, label, xcb(0), 0.050, tres)
+ end if
+
+ end do
+
+ frame(wks)
+
+end
+
Modified: branches/omp_blocks/block_decomp/namelist.input
===================================================================
--- branches/omp_blocks/block_decomp/namelist.input 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/namelist.input 2012-02-28 00:35:39 UTC (rev 1539)
@@ -1 +1 @@
-link namelist.input.ocean
\ No newline at end of file
+link namelist.input.sw
\ No newline at end of file
Modified: branches/omp_blocks/block_decomp/namelist.input.init_nhyd_atmos
===================================================================
--- branches/omp_blocks/block_decomp/namelist.input.init_nhyd_atmos 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/namelist.input.init_nhyd_atmos 2012-02-28 00:35:39 UTC (rev 1539)
@@ -15,7 +15,7 @@
&data_sources
config_geog_data_path = '/mmm/users/wrfhelp/WPS_GEOG/'
config_met_prefix = 'CFSR'
- config_sst_prefix = 'SST'
+ config_sfc_prefix = 'SST'
config_fg_interval = 21600
/
@@ -29,7 +29,6 @@
config_static_interp = .false.
config_vertical_grid = .true.
config_met_interp = .true.
- config_physics_init = .true.
config_input_sst = .false.
/
Modified: branches/omp_blocks/block_decomp/namelist.input.nhyd_atmos
===================================================================
--- branches/omp_blocks/block_decomp/namelist.input.nhyd_atmos 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/namelist.input.nhyd_atmos 2012-02-28 00:35:39 UTC (rev 1539)
@@ -1,5 +1,4 @@
&nhyd_model
- config_test_case = 0
config_time_integration = 'SRK3'
config_dt = 450.0
config_start_time = '2010-10-23_00:00:00'
Modified: branches/omp_blocks/block_decomp/namelist.input.nhyd_atmos_mtn_wave
===================================================================
--- branches/omp_blocks/block_decomp/namelist.input.nhyd_atmos_mtn_wave 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/namelist.input.nhyd_atmos_mtn_wave 2012-02-28 00:35:39 UTC (rev 1539)
@@ -1,42 +1,43 @@
&nhyd_model
- config_test_case = 6
config_time_integration = 'SRK3'
- config_dt = 6.
- config_ntimesteps = 3000
- config_output_interval = 100
+ config_dt = 6.0
+ config_start_time = '0000-01-01_00:00:00'
+ config_run_duration = '05:00:00'
config_number_of_sub_steps = 6
config_h_mom_eddy_visc2 = 10.
config_h_mom_eddy_visc4 = 0.
- config_v_mom_eddy_visc2 = 10.
+ config_v_mom_eddy_visc2 = 10.0
config_h_theta_eddy_visc2 = 10.
config_h_theta_eddy_visc4 = 0.
config_v_theta_eddy_visc2 = 10.
+ config_horiz_mixing = '2d_fixed'
config_theta_adv_order = 3
config_w_adv_order = 3
+ config_u_vadv_order = 3
+ config_w_vadv_order = 3
+ config_theta_vadv_order = 3
+ config_coef_3rd_order = 0.25
config_scalar_advection = .false.
- config_positive_definite = .false.
- config_monotonic = .false.
- config_mix_full = .false.
- config_horiz_mixing = '2d_fixed'
- config_coef_3rd_order = 0.25
- config_epssm = 0.2
+ config_epssm = 0.1
+ config_smdiv = 0.1
config_newpx = .false.
/
-
&damping
- config_zd = 22000.0
- config_xnutr = 0.0
+ config_zd = 10500.0
+ config_xnutr = 0.1
/
&dimensions
- config_nvertlevels = 26
+ config_nvertlevels = 70
/
&io
- config_input_name = 'grid.nc'
+ config_input_name = 'mtn_wave_init.nc'
config_output_name = 'output.nc'
config_restart_name = 'restart.nc'
+ config_output_interval = '00:30:00'
+ config_frames_per_outfile = 0
/
&decomposition
@@ -47,10 +48,32 @@
/
&restart
- config_restart_interval = 3000
+ config_restart_interval = '1_00:00:00'
config_do_restart = .false.
- config_restart_time = 1036800.0
/
&physics
+ config_frac_seaice = .false.
+ config_sfc_albedo = .false.
+ config_sst_update = .false.
+ config_sstdiurn_update = .false.
+ config_deepsoiltemp_update = .false.
+
+ config_n_microp = 5
+
+ config_radtlw_interval = '00:00:00'
+ config_radtsw_interval = '00:00:00'
+ config_conv_interval = 'none'
+ config_pbl_interval = 'none'
+
+ config_microp_scheme = 'off'
+ config_conv_shallow_scheme = 'off'
+ config_conv_deep_scheme = 'off'
+ config_eddy_scheme = 'off'
+ config_lsm_scheme = 'off'
+ config_pbl_scheme = 'off'
+ config_radt_cld_scheme = 'off'
+ config_radt_lw_scheme = 'off'
+ config_radt_sw_scheme = 'off'
+ config_sfclayer_scheme = 'off'
/
Modified: branches/omp_blocks/block_decomp/namelist.input.nhyd_atmos_squall
===================================================================
--- branches/omp_blocks/block_decomp/namelist.input.nhyd_atmos_squall 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/namelist.input.nhyd_atmos_squall 2012-02-28 00:35:39 UTC (rev 1539)
@@ -1,36 +1,43 @@
&nhyd_model
- config_test_case = 4
config_time_integration = 'SRK3'
- config_dt = 6.
- config_ntimesteps = 600
- config_output_interval = 100
+ config_dt = 3.0
+ config_start_time = '0000-01-01_00:00:00'
+ config_run_duration = '02:00:00'
config_number_of_sub_steps = 6
config_h_mom_eddy_visc2 = 500.
config_h_mom_eddy_visc4 = 0.
config_v_mom_eddy_visc2 = 500.0
config_h_theta_eddy_visc2 = 500.
- config_h_theta_eddy_visc4 = 00.
- config_v_theta_eddy_visc2 = 500.0
- config_theta_adv_order = 2
- config_scalar_adv_order = 2
- config_positive_definite = .false.
- config_monotonic = .false.
- config_newpx = .false.
+ config_h_theta_eddy_visc4 = 0.
+ config_v_theta_eddy_visc2 = 500.
+ config_horiz_mixing = '2d_fixed'
+ config_theta_adv_order = 3
+ config_w_adv_order = 3
+ config_u_vadv_order = 3
+ config_w_vadv_order = 3
+ config_theta_vadv_order = 3
+ config_coef_3rd_order = 0.25
+ config_epssm = 0.1
+ config_smdiv = 0.1
+ config_mix_full = .false.
+ config_monotonic = .true.
/
&damping
- config_zd = 22000.0
+ config_zd = 20000.0
config_xnutr = 0.0
/
&dimensions
- config_nvertlevels = 26
+ config_nvertlevels = 40
/
&io
- config_input_name = 'grid.nc'
+ config_input_name = 'supercell_init.nc'
config_output_name = 'output.nc'
config_restart_name = 'restart.nc'
+ config_output_interval = '00:30:00'
+ config_frames_per_outfile = 0
/
&decomposition
@@ -41,10 +48,34 @@
/
&restart
- config_restart_interval = 3000
+ config_restart_interval = '1_00:00:00'
config_do_restart = .false.
- config_restart_time = 1036800.0
/
&physics
+ config_frac_seaice = .false.
+ config_sfc_albedo = .false.
+ config_sst_update = .false.
+ config_sstdiurn_update = .false.
+ config_deepsoiltemp_update = .false.
+
+ config_n_microp = 1
+
+ config_radtlw_interval = '00:30:00'
+ config_radtsw_interval = '00:30:00'
+ config_conv_interval = 'none'
+ config_pbl_interval = 'none'
+
+ config_microp_scheme = 'kessler'
+ config_conv_shallow_scheme = 'off'
+ config_conv_deep_scheme = 'off'
+ config_eddy_scheme = 'off'
+ config_lsm_scheme = 'off'
+ config_pbl_scheme = 'off'
+ config_radt_cld_scheme = 'off'
+ config_radt_lw_scheme = 'off'
+ config_radt_sw_scheme = 'off'
+ config_sfclayer_scheme = 'off'
/
+
+
Modified: branches/omp_blocks/block_decomp/namelist.input.ocean
===================================================================
--- branches/omp_blocks/block_decomp/namelist.input.ocean 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/namelist.input.ocean 2012-02-28 00:35:39 UTC (rev 1539)
@@ -1,8 +1,8 @@
&sw_model
config_test_case = 0
- config_time_integration = 'split_explicit'
+ config_time_integration = 'RK4'
config_rk_filter_btr_mode = .false.
- config_dt = 10.0
+ config_dt = 100.0
config_start_time = '0000-01-01_00:00:00'
config_run_duration = '2000_00:00:00'
config_stats_interval = 1920
@@ -26,6 +26,7 @@
/
&grid
config_vert_grid_type = 'zlevel'
+ config_pressure_type = 'pressure'
config_rho0 = 1000
/
&split_explicit_ts
@@ -37,12 +38,7 @@
config_n_btr_cor_iter = 2
config_u_correction = .true.
config_filter_btr_mode = .false.
- config_btr_mom_decay = .false.
- config_btr_mom_decay_time = 3600.0
- config_btr_mom_eddy_visc2 = 0.0
config_btr_subcycle_loop_factor = 2
- config_SSH_from = 'avg_flux'
- config_new_btr_variables_from = 'btr_avg'
config_btr_gam1_uWt1 = 0.5
config_btr_gam2_SSHWt1 = 1.0
config_btr_gam3_uWt2 = 1.0
@@ -52,7 +48,7 @@
config_h_mom_eddy_visc2 = 1.0e5
config_h_mom_eddy_visc4 = 0.0
config_visc_vorticity_term = .true.
- config_h_tracer_eddy_diff2 = 1.0e4
+ config_h_tracer_eddy_diff2 = 1.0e5
config_h_tracer_eddy_diff4 = 0.0
/
&vmix
@@ -64,11 +60,11 @@
config_bottom_drag_coeff = 1.0e-3
/
&vmix_const
- config_vert_visc = 2.5e-5
- config_vert_diff = 2.5e-5
+ config_vert_visc = 1.0e-5
+ config_vert_diff = 1.0e-5
/
&vmix_rich
- config_bkrd_vert_visc = 1.0e-4
+ config_bkrd_vert_visc = 1.0e-5
config_bkrd_vert_diff = 1.0e-5
config_rich_mix = 0.005
/
Property changes on: branches/omp_blocks/block_decomp/src
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/ocean_projects/rayleigh/src:1298-1311
/branches/omp_blocks/ddt_reorg/src:1301-1414
/trunk/mpas/src:1374-1422
+ /branches/cam_mpas_nh/src:1260-1270
/branches/ocean_projects/ale_split_exp/src:1437-1483
/branches/ocean_projects/gmvar/src:1214-1494
/branches/ocean_projects/imp_vert_mix_mrp/src:754-986
/branches/ocean_projects/rayleigh/src:1298-1311
/branches/ocean_projects/split_explicit_mrp/src:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src:1044-1097
/branches/ocean_projects/vert_adv_mrp/src:704-745
/branches/omp_blocks/ddt_reorg/src:1301-1414
/branches/source_renaming/src:1082-1113
/branches/time_manager/src:924-962
/trunk/mpas/src:1374-1422,1449-1538
Modified: branches/omp_blocks/block_decomp/src/core_atmos_physics/Makefile
===================================================================
--- branches/omp_blocks/block_decomp/src/core_atmos_physics/Makefile 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_atmos_physics/Makefile 2012-02-28 00:35:39 UTC (rev 1539)
@@ -63,13 +63,15 @@
# DEPENDENCIES:
mpas_atmphys_driver_cloudines.o: \
- mpas_atmphys_driver_cloudiness.o \
+ mpas_atmphys_driver_cloudiness.o \
mpas_atmphys_vars.o
mpas_atmphys_driver_convection_deep.o: \
mpas_atmphys_constants.o \
+ mpas_atmphys_utilities.o \
mpas_atmphys_vars.o \
- ./physics_wrf/module_cu_kfeta.o
+ ./physics_wrf/module_cu_kfeta.o \
+ ./physics_wrf/module_cu_tiedtke.o
mpas_atmphys_driver_lsm.o: \
mpas_atmphys_constants.o \
@@ -84,22 +86,22 @@
./physics_wrf/module_bl_ysu.o
mpas_atmphys_driver_radiation_lw.o: \
- mpas_atmphys_driver_radiation_sw.o \
+ mpas_atmphys_driver_radiation_sw.o \
mpas_atmphys_camrad_init.o \
mpas_atmphys_constants.o \
mpas_atmphys_manager.o \
mpas_atmphys_rrtmg_lwinit.o \
mpas_atmphys_vars.o \
- ./physics_wrf/module_ra_cam.o \
+ ./physics_wrf/module_ra_cam.o \
./physics_wrf/module_ra_rrtmg_lw.o
mpas_atmphys_driver_radiation_sw.o: \
- mpas_atmphys_camrad_init.o \
+ mpas_atmphys_camrad_init.o \
mpas_atmphys_constants.o \
mpas_atmphys_manager.o \
mpas_atmphys_rrtmg_swinit.o \
mpas_atmphys_vars.o \
- ./physics_wrf/module_ra_cam.o \
+ ./physics_wrf/module_ra_cam.o \
./physics_wrf/module_ra_rrtmg_sw.o
mpas_atmphys_driver_sfclayer.o: \
Modified: branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_control.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_control.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_control.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -68,8 +68,9 @@
endif
!deep convection scheme:
- if(.not. (config_conv_deep_scheme .eq. 'off' .or. &
- config_conv_deep_scheme .eq. 'kain_fritsch')) then
+ if(.not. (config_conv_deep_scheme .eq. 'off' .or. &
+ config_conv_deep_scheme .eq. 'kain_fritsch' .or. &
+ config_conv_deep_scheme .eq. 'tiedtke' )) then
write(mpas_err_message,'(A,A10)') 'illegal value for config_deep_conv_scheme: ', &
trim(config_conv_deep_scheme)
@@ -77,6 +78,13 @@
endif
+!ldf (2012-01-19): Tiedtke is still under testing. do not use right now.
+ if(config_conv_deep_scheme .eq. 'tiedtke') then
+ write(mpas_err_message,'(A,A10)') 'Tiedtke is being tested. Do not use right now. Thanks '
+ call physics_error_fatal(mpas_err_message)
+ endif
+!ldf end.
+
!pbl scheme:
if(.not. (config_pbl_scheme .eq. 'off' .or. &
config_pbl_scheme .eq. 'ysu')) then
Modified: branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_driver.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_driver.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_driver.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -115,7 +115,8 @@
!call to convection scheme:
if(config_conv_deep_scheme .ne. 'off') then
call allocate_convection_deep
- call driver_convection_deep(itimestep,block%mesh,block%diag_physics,block%tend_physics)
+ call driver_convection_deep(itimestep,block%mesh,block%sfc_input,block%diag_physics, &
+ block%tend_physics)
call deallocate_convection_deep
endif
Modified: branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_driver_convection_deep.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_driver_convection_deep.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_driver_convection_deep.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -3,10 +3,12 @@
use mpas_grid_types
use mpas_atmphys_constants
+ use mpas_atmphys_utilities
use mpas_atmphys_vars
!wrf physics:
use module_cu_kfeta
+ use module_cu_tiedtke
implicit none
private
@@ -28,21 +30,31 @@
if(.not.allocated(rthcuten_p) ) allocate(rthcuten_p(ims:ime,kms:kme,jms:jme))
if(.not.allocated(rqvcuten_p) ) allocate(rqvcuten_p(ims:ime,kms:kme,jms:jme))
if(.not.allocated(rqccuten_p) ) allocate(rqccuten_p(ims:ime,kms:kme,jms:jme))
- if(.not.allocated(rqrcuten_p) ) allocate(rqrcuten_p(ims:ime,kms:kme,jms:jme))
if(.not.allocated(rqicuten_p) ) allocate(rqicuten_p(ims:ime,kms:kme,jms:jme))
- if(.not.allocated(rqscuten_p) ) allocate(rqscuten_p(ims:ime,kms:kme,jms:jme))
- if(.not.allocated(cubot_p) ) allocate(cubot_p(ims:ime,jms:jme) )
- if(.not.allocated(cutop_p) ) allocate(cutop_p(ims:ime,jms:jme) )
if(.not.allocated(pratec_p) ) allocate(pratec_p(ims:ime,jms:jme) )
if(.not.allocated(raincv_p) ) allocate(raincv_p(ims:ime,jms:jme) )
convection_select: select case(conv_deep_scheme)
case ("kain_fritsch")
- if(.not.allocated(area_p) ) allocate(area_p(ims:ime,jms:jme) )
- if(.not.allocated(nca_p) ) allocate(nca_p(ims:ime,jms:jme) )
- if(.not.allocated(w0avg_p)) allocate(w0avg_p(ims:ime,kms:kme,jms:jme))
+ if(.not.allocated(area_p) ) allocate(area_p(ims:ime,jms:jme) )
+ if(.not.allocated(nca_p) ) allocate(nca_p(ims:ime,jms:jme) )
+ if(.not.allocated(w0avg_p) ) allocate(w0avg_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(cubot_p) ) allocate(cubot_p(ims:ime,jms:jme) )
+ if(.not.allocated(cutop_p) ) allocate(cutop_p(ims:ime,jms:jme) )
+ if(.not.allocated(rqrcuten_p) ) allocate(rqrcuten_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(rqscuten_p) ) allocate(rqscuten_p(ims:ime,kms:kme,jms:jme) )
+
+ case ("tiedtke")
+ if(.not.allocated(znu_p) ) allocate(znu_p(kms:kme) )
+ if(.not.allocated(qfx_p) ) allocate(qfx_p(ims:ime,jms:jme) )
+ if(.not.allocated(xland_p) ) allocate(xland_p(ims:ime,jms:jme) )
+ if(.not.allocated(rqvdynten_p) ) allocate(rqvdynten_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(rqvdynblten_p)) allocate(rqvdynblten_p(ims:ime,kms:kme,jms:jme))
+ if(.not.allocated(rucuten_p) ) allocate(rucuten_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(rvcuten_p) ) allocate(rvcuten_p(ims:ime,kms:kme,jms:jme) )
+
case default
end select convection_select
@@ -57,21 +69,31 @@
if(allocated(rthcuten_p) ) deallocate(rthcuten_p )
if(allocated(rqvcuten_p) ) deallocate(rqvcuten_p )
if(allocated(rqccuten_p) ) deallocate(rqccuten_p )
- if(allocated(rqrcuten_p) ) deallocate(rqrcuten_p )
if(allocated(rqicuten_p) ) deallocate(rqicuten_p )
- if(allocated(rqscuten_p) ) deallocate(rqscuten_p )
- if(allocated(cubot_p) ) deallocate(cubot_p )
- if(allocated(cutop_p) ) deallocate(cutop_p )
if(allocated(pratec_p) ) deallocate(pratec_p )
if(allocated(raincv_p) ) deallocate(raincv_p )
convection_select: select case(conv_deep_scheme)
case ("kain_fritsch")
- if(allocated(area_p) ) deallocate(area_p )
- if(allocated(nca_p) ) deallocate(nca_p )
- if(allocated(w0avg_p)) deallocate(w0avg_p)
+ if(allocated(area_p) ) deallocate(area_p )
+ if(allocated(nca_p) ) deallocate(nca_p )
+ if(allocated(w0avg_p) ) deallocate(w0avg_p )
+ if(allocated(cubot_p) ) deallocate(cubot_p )
+ if(allocated(cutop_p) ) deallocate(cutop_p )
+ if(allocated(rqrcuten_p) ) deallocate(rqrcuten_p )
+ if(allocated(rqscuten_p) ) deallocate(rqscuten_p )
+
+ case ("tiedtke")
+ if(allocated(znu_p) ) deallocate(znu_p )
+ if(allocated(qfx_p) ) deallocate(qfx_p )
+ if(allocated(xland_p) ) deallocate(xland_p )
+ if(allocated(rqvdynten_p) ) deallocate(rqvdynten_p )
+ if(allocated(rqvdynblten_p)) deallocate(rqvdynblten_p)
+ if(allocated(rucuten_p) ) deallocate(rucuten_p )
+ if(allocated(rvcuten_p) ) deallocate(rvcuten_p )
+
case default
end select convection_select
@@ -108,6 +130,12 @@
call kf_lutab(svp1,svp2,svp3,svpt0)
write(0,*) ' end kain-kritsch initialization'
+ case ("tiedtke")
+ write(0,*) ' enter tiedtke initialization:'
+ write(mpas_err_message,'(A,A10)') &
+ 'Tiedtke is being tested. Do not use right now. Thanks '
+ call physics_error_fatal(mpas_err_message)
+
case default
end select convection_select
@@ -117,13 +145,14 @@
end subroutine init_convection_deep
!=============================================================================================
- subroutine driver_convection_deep(itimestep,mesh,diag_physics,tend_physics)
+ subroutine driver_convection_deep(itimestep,mesh,sfc_input,diag_physics,tend_physics)
!=============================================================================================
!input and output arguments:
!---------------------------
integer,intent(in):: itimestep
type(mesh_type),intent(in):: mesh
+ type(sfc_input_type),intent(in):: sfc_input
type(diag_physics_type),intent(inout):: diag_physics
type(tend_physics_type),intent(inout):: tend_physics
@@ -137,7 +166,8 @@
logical:: warm_rain,adapt_step_flag
real(kind=RKIND):: curr_secs
real(kind=RKIND):: cudt
-
+ real(kind=RKIND):: cudtacttime
+
!=============================================================================================
write(0,*)
write(0,*) '--- enter convection_driver: dt_cu=',dt_cu
@@ -145,14 +175,15 @@
!initialize instantaneous precipitation, and copy convective tendencies from the dynamics to
!the physics grid:
- call convection_from_MPAS(dt_dyn,mesh,diag_physics,tend_physics)
+ call convection_from_MPAS(dt_dyn,mesh,sfc_input,diag_physics,tend_physics)
!... convert the convection time-step to minutes:
cudt = dt_cu/60.
!... call to convection schemes:
-!dx = sqrt(maxval(mesh % areaCell % array))
-
+ curr_secs = -1
+ cudtacttime = -1
+ adapt_step_flag = .false.
do j = jts, jte
do i = its, ite
cu_act_flag(i,j) = .false.
@@ -162,15 +193,10 @@
convection_select: select case(conv_deep_scheme)
case ("kain_fritsch")
-
- !initialization:
- curr_secs = -1
- adapt_step_flag = .false.
write(0,*) '--- enter subroutine kf_eta_cps:'
call kf_eta_cps ( &
dt = dt_dyn , ktau = itimestep , &
-! dx = dx , cudt = dt_cu , &
- areaCell = area_p , cudt = dt_cu , &
+ areaCell = area_p , cudt = cudt , &
curr_secs = curr_secs , adapt_step_flag = adapt_step_flag , &
rho = rho_p , raincv = raincv_p , &
pratec = pratec_p , nca = nca_p , &
@@ -198,28 +224,14 @@
ims = ims , ime = ime , jms = jms , jme = jme , kms = kds , kme = kme , &
its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
)
- 201 format(i3,i6,1x,l1,5(1x,e15.8))
- write(0,*) '--- end subroutine kf_eta_cps:'
-! write(0,*)
-! write(0,*) '--- deep convection:'
-! do j = jts,jte
-! do i = its,ite
-! if(nca_p(i,j).gt.0. .and. raincv_p(i,j).gt.0.) then
-! write(0,201) j,i,cu_act_flag(i,j),nca_p(i,j),raincv_p(i,j), &
-! raincv_p(i,j)/dt_dyn,pratec_p(i,j)
-! endif
-! enddo
-! enddo
-! write(0,*) '--- shallow convection:'
-! do j = jts,jte
-! do i = its,ite
-! if(nca_p(i,j).gt.0. .and. raincv_p(i,j).eq.0.) then
-! write(0,201) j,i,cu_act_flag(i,j),nca_p(i,j),raincv_p(i,j), &
-! raincv_p(i,j)/dt_dyn,pratec_p(i,j)
-! endif
-! enddo
-! enddo
+ write(0,*) '--- end subroutine kf_eta_cps'
+ case("tiedtke")
+ write(0,*) '--- enter subroutine cu_tiedtke:'
+ write(mpas_err_message,'(A,A10)') &
+ 'Tiedtke is being tested. Do not use right now. Thanks '
+ call physics_error_fatal(mpas_err_message)
+
case default
end select convection_select
@@ -234,42 +246,51 @@
end subroutine driver_convection_deep
!=============================================================================================
- subroutine convection_from_MPAS(dt_dyn,mesh,diag_physics,tend_physics)
+ subroutine convection_from_MPAS(dt_dyn,mesh,sfc_input,diag_physics,tend_physics)
!=============================================================================================
!input arguments:
type(mesh_type),intent(in):: mesh
+ type(sfc_input_type),intent(in) :: sfc_input
type(diag_physics_type),intent(in):: diag_physics
type(tend_physics_type),intent(in):: tend_physics
real(kind=RKIND),intent(in):: dt_dyn
+!local variables:
+ real(kind=RKIND):: tem
+ real(kind=RKIND),dimension(:),allocatable:: zw
+
!---------------------------------------------------------------------------------------------
+ write(0,*)
+ write(0,*) '--- enter subroutine convection_from_MPAS:'
do j = jts,jte
do i = its,ite
- cubot_p(i,j) = diag_physics % cubot % array(i)
- cutop_p(i,j) = diag_physics % cutop % array(i)
raincv_p(i,j) = diag_physics % raincv % array(i)
pratec_p(i,j) = diag_physics % cuprec % array(i)
- do k = kts, kte
+ do k = kts,kte
rthcuten_p(i,k,j) = tend_physics % rthcuten % array(k,i)
rqvcuten_p(i,k,j) = tend_physics % rqvcuten % array(k,i)
rqccuten_p(i,k,j) = tend_physics % rqccuten % array(k,i)
- rqrcuten_p(i,k,j) = tend_physics % rqrcuten % array(k,i)
rqicuten_p(i,k,j) = tend_physics % rqicuten % array(k,i)
- rqscuten_p(i,k,j) = tend_physics % rqscuten % array(k,i)
enddo
enddo
enddo
-
+
convection_select: select case(conv_deep_scheme)
case ("kain_fritsch")
-
+
do j = jts,jte
do i = its,ite
- !area of grid-cell:
- area_p(i,j) = mesh % areaCell % array(i)
+ area_p(i,j) = mesh % areaCell % array(i)
+ cubot_p(i,j) = diag_physics % cubot % array(i)
+ cutop_p(i,j) = diag_physics % cutop % array(i)
+ do k = kts,kte
+ rqrcuten_p(i,k,j) = tend_physics % rqrcuten % array(k,i)
+ rqscuten_p(i,k,j) = tend_physics % rqscuten % array(k,i)
+ enddo
+
!decreases the characteristic time period that convection remains active. When nca_p
!becomes less than the convective timestep, convective tendencies and precipitation
!are reset to zero (note that this is also done in subroutine kf_eta_cps).
@@ -294,18 +315,49 @@
endif
endif
- do k = kts, kte
+ do k = kts,kte
w0avg_p(i,k,j) = diag_physics % w0avg % array(k,i)
enddo
enddo
enddo
+ case ("tiedtke")
+ if(.not.allocated(zw)) allocate(zw(kms:kme))
+ zw(kts) = 0.
+ do k = kts,kte
+ tem = 1./mesh % rdzw % array(k)
+ zw(k+1) = zw(k) + tem
+ znu_p(k) = 0.5*(zw(k+1)+zw(k))
+ write(0,*) k,zw(k+1),znu_p(k)
+ enddo
+ if(allocated(zw)) deallocate(zw)
+
+ do j = jts,jte
+ do i = its,ite
+ xland_p(i,j) = sfc_input % xland % array(i)
+ qfx_p(i,j) = diag_physics % qfx % array(i)
+ enddo
+
+ do k = kts,kte
+ do i = its,ite
+ rqvdynblten_p(i,k,j) = tend_physics % rqvblten % array(k,i)
+ rqvdynten_p(i,k,j) = tend_physics % rqvdynten % array(k,i)
+ rucuten_p(i,k,j) = tend_physics % rucuten % array(k,i)
+ rvcuten_p(i,k,j) = tend_physics % rvcuten % array(k,i)
+ enddo
+ enddo
+ enddo
+ write(0,*) '--- max rqvdynblten = ',maxval(rqvdynblten_p(:,:,:))
+ write(0,*) '--- min rqvdynblten = ',minval(rqvdynblten_p(:,:,:))
+ write(0,*) '--- max rqvdynten = ',maxval(rqvdynten_p(:,:,:))
+ write(0,*) '--- min rqvdynten = ',minval(rqvdynten_p(:,:,:))
+
case default
end select convection_select
end subroutine convection_from_MPAS
-
+
!=============================================================================================
subroutine convection_to_MPAS(diag_physics,tend_physics)
!=============================================================================================
@@ -319,15 +371,11 @@
do i = its,ite
diag_physics % raincv % array(i) = raincv_p(i,j)
diag_physics % cuprec % array(i) = pratec_p(i,j)
- diag_physics % cubot % array(i) = cubot_p(i,j)
- diag_physics % cutop % array(i) = cutop_p(i,j)
do k = kts, kte
tend_physics % rthcuten % array(k,i) = rthcuten_p(i,k,j)
tend_physics % rqvcuten % array(k,i) = rqvcuten_p(i,k,j)
tend_physics % rqccuten % array(k,i) = rqccuten_p(i,k,j)
- tend_physics % rqrcuten % array(k,i) = rqrcuten_p(i,k,j)
tend_physics % rqicuten % array(k,i) = rqicuten_p(i,k,j)
- tend_physics % rqscuten % array(k,i) = rqscuten_p(i,k,j)
enddo
enddo
enddo
@@ -337,13 +385,27 @@
case ("kain_fritsch")
do j = jts,jte
do i = its,ite
+ diag_physics % cubot % array(i) = cubot_p(i,j)
+ diag_physics % cutop % array(i) = cutop_p(i,j)
diag_physics % nca % array(i) = nca_p(i,j)
do k = kts, kte
diag_physics % w0avg % array(k,i) = w0avg_p(i,k,j)
+ tend_physics % rqrcuten % array(k,i) = rqrcuten_p(i,k,j)
+ tend_physics % rqscuten % array(k,i) = rqscuten_p(i,k,j)
enddo
enddo
enddo
+ case ("tiedtke")
+ do j = jts,jte
+ do k = kts,kte
+ do i = its,ite
+ tend_physics % rucuten % array(k,i) = rucuten_p(i,k,j)
+ tend_physics % rvcuten % array(k,i) = rvcuten_p(i,k,j)
+ enddo
+ enddo
+ enddo
+
case default
end select convection_select
Modified: branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_initialize_real.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_initialize_real.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_initialize_real.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -6,7 +6,7 @@
config_input_sst, &
config_nsoillevels, &
config_start_time, &
- config_sst_prefix
+ config_sfc_prefix
use mpas_grid_types
use init_atm_hinterp
use init_atm_llxy
@@ -52,10 +52,10 @@
interp_list(3) = 0
!open intermediate file:
- call read_met_init(trim(config_sst_prefix),.false.,config_start_time(1:13),istatus)
+ call read_met_init(trim(config_sfc_prefix),.false.,config_start_time(1:13),istatus)
if(istatus /= 0) &
- write(0,*) 'Error reading ',trim(config_sst_prefix)//':'//config_start_time(1:13)
- write(0,*) 'Processing ',trim(config_sst_prefix)//':'//config_start_time(1:13)
+ write(0,*) 'Error reading ',trim(config_sfc_prefix)//':'//config_start_time(1:13)
+ write(0,*) 'Processing ',trim(config_sfc_prefix)//':'//config_start_time(1:13)
!scan through all the fields in the file:
call read_next_met_field(field,istatus)
@@ -89,6 +89,22 @@
knownj = 1.0_RKIND, &
lat1 = real(field % startlat,RKIND), &
lon1 = real(field % startlon,RKIND))
+ else if (field % iproj == PROJ_GAUSS) then
+ call map_set(PROJ_GAUSS, proj, &
+ nlat = nint(field % deltalat), &
+ loninc = real(field % deltalon,RKIND), &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
+! nxmax = nint(360.0 / field % deltalon), &
+ else if (field % iproj == PROJ_PS) then
+ call map_set(PROJ_PS, proj, &
+ dx = real(field % dx,RKIND), &
+ truelat1 = real(field % truelat1,RKIND), &
+ stdlon = real(field % xlonc,RKIND), &
+ knowni = real(field % nx / 2.0,RKIND), &
+ knownj = real(field % ny / 2.0,RKIND), &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
end if
!Interpolate field to each MPAS grid cell:
Modified: branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_manager.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_manager.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_manager.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -290,7 +290,7 @@
if(ierr /= 0) &
call physics_error_fatal('subroutine physics_run_init: error defining dt_pbl')
- elseif(trim(config_conv_interval) == "none") then
+ elseif(trim(config_pbl_interval) == "none") then
dt_pbl = config_dt
else
Modified: branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_vars.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_vars.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_atmos_physics/mpas_atmphys_vars.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -43,6 +43,9 @@
real(kind=RKIND),public:: xice_threshold
+ real(kind=RKIND),dimension(:),allocatable:: &
+ znu_p
+
real(kind=RKIND),dimension(:,:),allocatable:: &
area_p !grid cell area [m2]
@@ -138,23 +141,37 @@
logical,dimension(:,:),allocatable:: &
cu_act_flag
real(kind=RKIND),dimension(:,:),allocatable:: &
- cubot_p, &!lowest convective level [-]
- cutop_p, &!highest convective level [-]
- nca_p, &!counter for cloud relaxation time [-]
rainc_p, &!
raincv_p, &!
pratec_p !
- real(kind=RKIND),dimension(:,:,:),allocatable:: &
- w0avg_p !
real(kind=RKIND),dimension(:,:,:),allocatable:: &
rthcuten_p, &!
rqvcuten_p, &!
rqccuten_p, &!
+ rqicuten_p !
+
+!... kain fritsch specific arrays:
+ real(kind=RKIND),dimension(:,:),allocatable:: &
+ cubot_p, &!lowest convective level [-]
+ cutop_p, &!highest convective level [-]
+ nca_p !counter for cloud relaxation time [-]
+ real(kind=RKIND),dimension(:,:,:),allocatable:: &
+ w0avg_p !
+
+ real(kind=RKIND),dimension(:,:,:),allocatable:: &
rqrcuten_p, &!
- rqicuten_p, &!
- rqscuten_p
+ rqscuten_p !
+!... tiedtke specific arrays:
+ real(kind=RKIND),dimension(:,:,:),allocatable:: &
+ rqvdynten_p, &!
+ rqvdynblten_p !
+
+ real(kind=RKIND),dimension(:,:,:),allocatable:: &
+ rucuten_p, &!
+ rvcuten_p !
+
!=============================================================================================
!... variables and arrays related to parameterization of pbl:
!=============================================================================================
Modified: branches/omp_blocks/block_decomp/src/core_atmos_physics/physics_wrf/Makefile
===================================================================
--- branches/omp_blocks/block_decomp/src/core_atmos_physics/physics_wrf/Makefile 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_atmos_physics/physics_wrf/Makefile 2012-02-28 00:35:39 UTC (rev 1539)
@@ -6,28 +6,35 @@
echo "****** compile physics_wrf ******"
OBJS = \
- libmassv.o \
- module_bl_ysu.o \
- module_cu_kfeta.o \
- module_mp_kessler.o \
- module_mp_thompson.o \
- module_mp_wsm6.o \
- module_ra_cam.o \
- module_ra_cam_support.o \
- module_ra_rrtmg_lw.o \
- module_ra_rrtmg_sw.o \
- module_sf_bem.o \
- module_sf_bep.o \
- module_sf_bep_bem.o \
- module_sf_noahdrv.o \
- module_sf_noahlsm.o \
- module_sf_sfclay.o \
+ libmassv.o \
+ module_bl_ysu.o \
+ module_cam_shr_kind_mod.o \
+ module_cam_support.o \
+ module_cu_kfeta.o \
+ module_cu_tiedtke.o \
+ module_mp_kessler.o \
+ module_mp_thompson.o \
+ module_mp_wsm6.o \
+ module_ra_cam.o \
+ module_ra_cam_support.o \
+ module_ra_rrtmg_lw.o \
+ module_ra_rrtmg_sw.o \
+ module_sf_bem.o \
+ module_sf_bep.o \
+ module_sf_bep_bem.o \
+ module_sf_noahdrv.o \
+ module_sf_noahlsm.o \
+ module_sf_sfclay.o \
module_sf_urban.o
physics_wrf: $(OBJS)
ar -ru ./../libphys.a $(OBJS)
# DEPENDENCIES:
+module_cam_support.o: \
+ module_cam_shr_kind_mod.o \
+ ../mpas_atmphys_utilities.o
+
module_mp_thompson.o: \
../mpas_atmphys_utilities.o
@@ -35,6 +42,7 @@
libmassv.o
module_ra_cam.o: \
+ module_cam_support.o \
module_ra_cam_support.o \
../mpas_atmphys_utilities.o
@@ -48,11 +56,11 @@
module_sf_urban.o
module_sf_bep_bem.o: \
- module_sf_bem.o \
+ module_sf_bem.o \
module_sf_urban.o
module_sf_noahdrv.o: \
- module_sf_bem.o \
+ module_sf_bem.o \
module_sf_bep.o \
module_sf_bep_bem.o \
module_sf_noahlsm.o \
Modified: branches/omp_blocks/block_decomp/src/core_atmos_physics/physics_wrf/module_cam_support.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_atmos_physics/physics_wrf/module_cam_support.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_atmos_physics/physics_wrf/module_cam_support.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -7,7 +7,7 @@
! Author: William.Gustafson@pnl.gov, Nov 2009
!------------------------------------------------------------------------
#if (defined(non_hydrostatic_core) || defined(hydrostatic_core))
- use module_physics_utilities
+ use mpas_atmphys_utilities
#else
use module_state_description, only: param_num_moist
#endif
Copied: branches/omp_blocks/block_decomp/src/core_atmos_physics/physics_wrf/module_cu_tiedtke.F (from rev 1538, trunk/mpas/src/core_atmos_physics/physics_wrf/module_cu_tiedtke.F)
===================================================================
--- branches/omp_blocks/block_decomp/src/core_atmos_physics/physics_wrf/module_cu_tiedtke.F (rev 0)
+++ branches/omp_blocks/block_decomp/src/core_atmos_physics/physics_wrf/module_cu_tiedtke.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -0,0 +1,3114 @@
+!-----------------------------------------------------------------------
+!
+!WRF:MODEL_LAYER:PHYSICS
+!
+!####################TIEDTKE SCHEME#########################
+! Taken from the IPRC iRAM - Yuqing Wang, University of Hawaii
+! Added by Chunxi Zhang and Yuqing Wang to WRF3.2, May, 2010
+! refenrence: Tiedtke (1989, MWR, 117, 1779-1800)
+! Nordeng, T.E., (1995), CAPE closure and organized entrainment/detrainment
+! Yuqing Wang et al. (2003,J. Climate, 16, 1721-1738) for improvements
+! for cloud top detrainment
+! (2004, Mon. Wea. Rev., 132, 274-296), improvements for PBL clouds
+! (2007,Mon. Wea. Rev., 135, 567-585), diurnal cycle of precipitation
+! This scheme is on testing
+!###########################################################
+MODULE module_cu_tiedtke
+!
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+! epsl--- allowed minimum value for floating calculation
+!---------------------------------------------------------------
+ real,parameter :: epsl = 1.0e-20
+ real,parameter :: t000 = 273.15
+ real,parameter :: hgfr = 233.15 ! defined in param.f in explct
+!-------------------------------------------------------------
+! Ends the parameters set
+!++++++++++++++++++++++++++++
+ REAL,PRIVATE :: G,CPV
+ REAL :: API,A,EOMEGA,RD,RV,CPD,RCPD,VTMPC1,VTMPC2, &
+ RHOH2O,ALV,ALS,ALF,CLW,TMELT,SOLC,STBO,DAYL,YEARL, &
+ C1ES,C2ES,C3LES,C3IES,C4LES,C4IES,C5LES,C5IES,ZRG
+
+ REAL :: ENTRPEN,ENTRSCV,ENTRMID,ENTRDD,CMFCTOP,RHM,RHC, &
+ CMFCMAX,CMFCMIN,CMFDEPS,RHCDD,CPRCON,CRIRH,ZBUO0, &
+ fdbk,ZTAU
+
+ INTEGER :: nentr
+
+ REAL :: CVDIFTS, CEVAPCU1, CEVAPCU2,ZDNOPRC
+
+
+ PARAMETER(A=6371.22E03, &
+ ALV=2.5008E6, &
+ ALS=2.8345E6, &
+ ALF=ALS-ALV, &
+ CPD=1005.46, &
+ CPV=1869.46, & ! CPV in module is 1846.4
+ RCPD=1.0/CPD, &
+ RHOH2O=1.0E03, &
+ TMELT=273.16, &
+ G=9.806, & ! G=9.806
+ ZRG=1.0/G, &
+ RD=287.05, &
+ RV=461.51, &
+ C1ES=610.78, &
+ C2ES=C1ES*RD/RV, &
+ C3LES=17.269, &
+ C4LES=35.86, &
+ C5LES=C3LES*(TMELT-C4LES), &
+ C3IES=21.875, &
+ C4IES=7.66, &
+ C5IES=C3IES*(TMELT-C4IES), &
+ API=3.141593, & ! API=2.0*ASIN(1.)
+ VTMPC1=RV/RD-1.0, &
+ VTMPC2=CPV/CPD-1.0, &
+ CVDIFTS=1.0, &
+ CEVAPCU1=1.93E-6*261., &
+ CEVAPCU2=1.E3/(38.3*0.293) )
+
+
+! SPECIFY PARAMETERS FOR MASSFLUX-SCHEME
+! --------------------------------------
+! These are tunable parameters
+!
+! ENTRPEN: AVERAGE ENTRAINMENT RATE FOR PENETRATIVE CONVECTION
+! -------
+!
+ PARAMETER(ENTRPEN=1.0E-4)
+!
+! ENTRSCV: AVERAGE ENTRAINMENT RATE FOR SHALLOW CONVECTION
+! -------
+!
+ PARAMETER(ENTRSCV=1.2E-3)
+!
+! ENTRMID: AVERAGE ENTRAINMENT RATE FOR MIDLEVEL CONVECTION
+! -------
+!
+ PARAMETER(ENTRMID=1.0E-4)
+!
+! ENTRDD: AVERAGE ENTRAINMENT RATE FOR DOWNDRAFTS
+! ------
+!
+ PARAMETER(ENTRDD =2.0E-4)
+!
+! CMFCTOP: RELATIVE CLOUD MASSFLUX AT LEVEL ABOVE NONBUOYANCY LEVEL
+! -------
+!
+ PARAMETER(CMFCTOP=0.26)
+!
+! CMFCMAX: MAXIMUM MASSFLUX VALUE ALLOWED FOR UPDRAFTS ETC
+! -------
+!
+ PARAMETER(CMFCMAX=1.0)
+!
+! CMFCMIN: MINIMUM MASSFLUX VALUE (FOR SAFETY)
+! -------
+!
+ PARAMETER(CMFCMIN=1.E-10)
+!
+! CMFDEPS: FRACTIONAL MASSFLUX FOR DOWNDRAFTS AT LFS
+! -------
+!
+ PARAMETER(CMFDEPS=0.30)
+!
+! CPRCON: COEFFICIENTS FOR DETERMINING CONVERSION FROM CLOUD WATER
+!
+ PARAMETER(CPRCON = 2.0E-3/G)
+!
+! ZDNOPRC: The pressure depth below which no precipitation
+!
+ PARAMETER(ZDNOPRC = 1.5E4)
+!--------------------
+ PARAMETER(nentr=1) ! Old entrainment rate parameterization ! chn1,2,4
+! PARAMETER(nentr=2) ! New entrainment rate parameterization ! chn3
+!
+!--------------------
+ PARAMETER(RHC=0.80,RHM=1.0,ZBUO0=0.50)
+!--------------------
+ PARAMETER(CRIRH=0.80,fdbk = 1.0,ZTAU = 3600.0)
+!--------------------
+ LOGICAL :: LMFPEN,LMFMID,LMFSCV,LMFDD,LMFDUDV
+ PARAMETER(LMFPEN=.TRUE.,LMFMID=.TRUE.,LMFSCV=.TRUE.,LMFDD=.TRUE.,LMFDUDV=.TRUE.)
+!--------------------
+!#################### END of Variables definition##########################
+!-----------------------------------------------------------------------
+!
+CONTAINS
+!-----------------------------------------------------------------------
+ SUBROUTINE CU_TIEDTKE( &
+ DT,ITIMESTEP,STEPCU &
+ ,RAINCV,PRATEC,QFX,ZNU &
+ ,U3D,V3D,W,T3D,QV3D,QC3D,QI3D,PI3D,RHO3D &
+ ,QVFTEN,QVPBLTEN &
+ ,DZ8W,PCPS,P8W,XLAND,CU_ACT_FLAG &
+ ,CUDT, CURR_SECS, ADAPT_STEP_FLAG &
+ ,CUDTACTTIME &
+ ,ids,ide, jds,jde, kds,kde &
+ ,ims,ime, jms,jme, kms,kme &
+ ,its,ite, jts,jte, kts,kte &
+ ,RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN &
+ ,RUCUTEN, RVCUTEN &
+ ,F_QV ,F_QC ,F_QR ,F_QI ,F_QS &
+ )
+
+!-------------------------------------------------------------------
+ IMPLICIT NONE
+!-------------------------------------------------------------------
+!-- U3D 3D u-velocity interpolated to theta points (m/s)
+!-- V3D 3D v-velocity interpolated to theta points (m/s)
+!-- TH3D 3D potential temperature (K)
+!-- T3D temperature (K)
+!-- QV3D 3D water vapor mixing ratio (Kg/Kg)
+!-- QC3D 3D cloud mixing ratio (Kg/Kg)
+!-- QI3D 3D ice mixing ratio (Kg/Kg)
+!-- RHO3D 3D air density (kg/m^3)
+!-- P8w 3D hydrostatic pressure at full levels (Pa)
+!-- Pcps 3D hydrostatic pressure at half levels (Pa)
+!-- PI3D 3D exner function (dimensionless)
+!-- RTHCUTEN Theta tendency due to
+! cumulus scheme precipitation (K/s)
+!-- RUCUTEN U wind tendency due to
+! cumulus scheme precipitation (K/s)
+!-- RVCUTEN V wind tendency due to
+! cumulus scheme precipitation (K/s)
+!-- RQVCUTEN Qv tendency due to
+! cumulus scheme precipitation (kg/kg/s)
+!-- RQRCUTEN Qr tendency due to
+! cumulus scheme precipitation (kg/kg/s)
+!-- RQCCUTEN Qc tendency due to
+! cumulus scheme precipitation (kg/kg/s)
+!-- RQSCUTEN Qs tendency due to
+! cumulus scheme precipitation (kg/kg/s)
+!-- RQICUTEN Qi tendency due to
+! cumulus scheme precipitation (kg/kg/s)
+!-- RAINC accumulated total cumulus scheme precipitation (mm)
+!-- RAINCV cumulus scheme precipitation (mm)
+!-- PRATEC precipitiation rate from cumulus scheme (mm/s)
+!-- dz8w dz between full levels (m)
+!-- QFX upward moisture flux at the surface (kg/m^2/s)
+!-- DT time step (s)
+!-- ids start index for i in domain
+!-- ide end index for i in domain
+!-- jds start index for j in domain
+!-- jde end index for j in domain
+!-- kds start index for k in domain
+!-- kde end index for k in domain
+!-- ims start index for i in memory
+!-- ime end index for i in memory
+!-- jms start index for j in memory
+!-- jme end index for j in memory
+!-- kms start index for k in memory
+!-- kme end index for k in memory
+!-- its start index for i in tile
+!-- ite end index for i in tile
+!-- jts start index for j in tile
+!-- jte end index for j in tile
+!-- kts start index for k in tile
+!-- kte end index for k in tile
+!-------------------------------------------------------------------
+ INTEGER, INTENT(IN) :: ids,ide, jds,jde, kds,kde, &
+ ims,ime, jms,jme, kms,kme, &
+ its,ite, jts,jte, kts,kte, &
+ ITIMESTEP, &
+ STEPCU
+
+ REAL, INTENT(IN) :: &
+ DT
+
+
+ REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: &
+ XLAND
+
+ REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: &
+ RAINCV, PRATEC
+
+ LOGICAL, DIMENSION(IMS:IME,JMS:JME), INTENT(INOUT) :: &
+ CU_ACT_FLAG
+
+
+ REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: &
+ DZ8W, &
+ P8w, &
+ Pcps, &
+ PI3D, &
+ QC3D, &
+ QVFTEN, &
+ QVPBLTEN, &
+ QI3D, &
+ QV3D, &
+ RHO3D, &
+ T3D, &
+ U3D, &
+ V3D, &
+ W
+
+!--------------------------- OPTIONAL VARS ----------------------------
+
+ REAL, DIMENSION(ims:ime, kms:kme, jms:jme), &
+ OPTIONAL, INTENT(INOUT) :: &
+ RQCCUTEN, &
+ RQICUTEN, &
+ RQVCUTEN, &
+ RTHCUTEN, &
+ RUCUTEN, &
+ RVCUTEN
+
+!
+! Flags relating to the optional tendency arrays declared above
+! Models that carry the optional tendencies will provdide the
+! optional arguments at compile time; these flags all the model
+! to determine at run-time whether a particular tracer is in
+! use or not.
+!
+ LOGICAL, OPTIONAL :: &
+ F_QV &
+ ,F_QC &
+ ,F_QR &
+ ,F_QI &
+ ,F_QS
+
+! Adaptive time-step variables
+ REAL, INTENT(IN ) :: CUDT
+ REAL, INTENT(IN ) :: CURR_SECS
+ LOGICAL,INTENT(IN ) , OPTIONAL :: ADAPT_STEP_FLAG
+ REAL, INTENT (INOUT) :: CUDTACTTIME
+
+!--------------------------- LOCAL VARS ------------------------------
+
+ REAL, DIMENSION(ims:ime, jms:jme) :: &
+ QFX
+
+ REAL :: &
+ DELT, &
+ RDELT
+
+ REAL , DIMENSION(its:ite) :: &
+ RCS, &
+ RN, &
+ EVAP
+ INTEGER , DIMENSION(its:ite) :: SLIMSK
+
+
+ REAL , DIMENSION(its:ite, kts:kte+1) :: &
+ PRSI
+
+ REAL , DIMENSION(its:ite, kts:kte) :: &
+ DEL, &
+ DOT, &
+ PHIL, &
+ PRSL, &
+ Q1, &
+ Q2, &
+ Q3, &
+ Q1B, &
+ Q1BL, &
+ Q11, &
+ Q12, &
+ T1, &
+ U1, &
+ V1, &
+ ZI, &
+ ZL, &
+ OMG, &
+ GHT
+
+ INTEGER, DIMENSION(its:ite) :: &
+ KBOT, &
+ KTOP
+
+ INTEGER :: &
+ I, &
+ IM, &
+ J, &
+ K, &
+ KM, &
+ KP, &
+ KX
+
+
+ LOGICAL :: run_param , doing_adapt_dt , decided
+
+!-------other local variables----
+ INTEGER,DIMENSION( its:ite ) :: KTYPE
+ REAL, DIMENSION( kts:kte ) :: sig1 ! half sigma levels
+ REAL, DIMENSION( kms:kme ) :: ZNU
+ INTEGER :: zz
+!-----------------------------------------------------------------------
+!
+!*** CHECK TO SEE IF THIS IS A CONVECTION TIMESTEP
+!
+
+! Initialization for adaptive time step.
+
+ doing_adapt_dt = .FALSE.
+ IF ( PRESENT(adapt_step_flag) ) THEN
+ IF ( adapt_step_flag ) THEN
+ doing_adapt_dt = .TRUE.
+ IF ( cudtacttime .EQ. 0. ) THEN
+ cudtacttime = curr_secs + cudt*60.
+ END IF
+ END IF
+ END IF
+
+! Do we run through this scheme or not?
+
+! Test 1: If this is the initial model time, then yes.
+! ITIMESTEP=1
+! Test 2: If the user asked for the cumulus to be run every time step, then yes.
+! CUDT=0 or STEPCU=1
+! Test 3: If not adaptive dt, and this is on the requested cumulus frequency, then yes.
+! MOD(ITIMESTEP,STEPCU)=0
+! Test 4: If using adaptive dt and the current time is past the last requested activate cumulus time, then yes.
+! CURR_SECS >= CUDTACTTIME
+
+! If we do run through the scheme, we set the flag run_param to TRUE and we set the decided flag
+! to TRUE. The decided flag says that one of these tests was able to say "yes", run the scheme.
+! We only proceed to other tests if the previous tests all have left decided as FALSE.
+
+! If we set run_param to TRUE and this is adaptive time stepping, we set the time to the next
+! cumulus run.
+
+ decided = .FALSE.
+ run_param = .FALSE.
+ IF ( ( .NOT. decided ) .AND. &
+ ( itimestep .EQ. 1 ) ) THEN
+ run_param = .TRUE.
+ decided = .TRUE.
+ END IF
+
+ IF ( ( .NOT. decided ) .AND. &
+ ( ( cudt .EQ. 0. ) .OR. ( stepcu .EQ. 1 ) ) ) THEN
+ run_param = .TRUE.
+ decided = .TRUE.
+ END IF
+
+ IF ( ( .NOT. decided ) .AND. &
+ ( .NOT. doing_adapt_dt ) .AND. &
+ ( MOD(itimestep,stepcu) .EQ. 0 ) ) THEN
+ run_param = .TRUE.
+ decided = .TRUE.
+ END IF
+
+ IF ( ( .NOT. decided ) .AND. &
+ ( doing_adapt_dt ) .AND. &
+ ( curr_secs .GE. cudtacttime ) ) THEN
+ run_param = .TRUE.
+ decided = .TRUE.
+ cudtacttime = curr_secs + cudt*60
+ END IF
+
+!-----------------------------------------------------------------------
+ IF(run_param) THEN
+
+ DO J=JTS,JTE
+ DO I=ITS,ITE
+ CU_ACT_FLAG(I,J)=.TRUE.
+ ENDDO
+ ENDDO
+
+ IM=ITE-ITS+1
+ KX=KTE-KTS+1
+ DELT=DT*STEPCU
+ RDELT=1./DELT
+
+!------------- J LOOP (OUTER) --------------------------------------------------
+
+ DO J=jts,jte
+
+! --------------- compute zi and zl -----------------------------------------
+ DO i=its,ite
+ ZI(I,KTS)=0.0
+ ENDDO
+
+ DO k=kts+1,kte
+ KM=k-1
+ DO i=its,ite
+ ZI(I,K)=ZI(I,KM)+dz8w(i,km,j)
+ ENDDO
+ ENDDO
+
+ DO k=kts+1,kte
+ KM=k-1
+ DO i=its,ite
+ ZL(I,KM)=(ZI(I,K)+ZI(I,KM))*0.5
+ ENDDO
+ ENDDO
+
+ DO i=its,ite
+ ZL(I,KTE)=2.*ZI(I,KTE)-ZL(I,KTE-1)
+ ENDDO
+
+! --------------- end compute zi and zl -------------------------------------
+ DO i=its,ite
+ SLIMSK(i)=int(ABS(XLAND(i,j)-2.))
+ ENDDO
+
+ DO k=kts,kte
+ kp=k+1
+ DO i=its,ite
+ DOT(i,k)=-0.5*g*rho3d(i,k,j)*(w(i,k,j)+w(i,kp,j))
+ ENDDO
+ ENDDO
+
+ DO k=kts,kte
+ zz = kte+1-k
+ DO i=its,ite
+ U1(i,zz)=U3D(i,k,j)
+ V1(i,zz)=V3D(i,k,j)
+ T1(i,zz)=T3D(i,k,j)
+ Q1(i,zz)= QV3D(i,k,j)
+ if(itimestep == 1) then
+ Q1B(i,zz)=0.
+ Q1BL(i,zz)=0.
+ else
+ Q1B(i,zz)=QVFTEN(i,k,j)
+ Q1BL(i,zz)=QVPBLTEN(i,k,j)
+ endif
+ Q2(i,zz)=QC3D(i,k,j)
+ Q3(i,zz)=QI3D(i,k,j)
+ OMG(i,zz)=DOT(i,k)
+ GHT(i,zz)=ZL(i,k)
+ PRSL(i,zz) = Pcps(i,k,j)
+ ENDDO
+ ENDDO
+
+ DO k=kts,kte+1
+ zz = kte+2-k
+ DO i=its,ite
+ PRSI(i,zz) = P8w(i,k,j)
+ ENDDO
+ ENDDO
+
+ DO k=kts,kte
+ zz = kte+1-k
+ sig1(zz) = ZNU(k)
+ ENDDO
+
+!###############before call TIECNV, we need EVAP########################
+! EVAP is the vapor flux at the surface
+!########################################################################
+!
+ DO i=its,ite
+ EVAP(i) = QFX(i,j)
+ ENDDO
+!########################################################################
+ CALL TIECNV(U1,V1,T1,Q1,Q2,Q3,Q1B,Q1BL,GHT,OMG,PRSL,PRSI,EVAP, &
+ RN,SLIMSK,KTYPE,IM,KX,KX+1,sig1,DELT)
+
+ DO I=ITS,ITE
+ RAINCV(I,J)=RN(I)/STEPCU
+ PRATEC(I,J)=RN(I)/(STEPCU * DT)
+ ENDDO
+
+ DO K=KTS,KTE
+ zz = kte+1-k
+ DO I=ITS,ITE
+ RTHCUTEN(I,K,J)=(T1(I,zz)-T3D(I,K,J))/PI3D(I,K,J)*RDELT
+ RQVCUTEN(I,K,J)=(Q1(I,zz)-QV3D(I,K,J))*RDELT
+ RUCUTEN(I,K,J) =(U1(I,zz)-U3D(I,K,J))*RDELT
+ RVCUTEN(I,K,J) =(V1(I,zz)-V3D(I,K,J))*RDELT
+ ENDDO
+ ENDDO
+
+ IF(PRESENT(RQCCUTEN))THEN
+ IF ( F_QC ) THEN
+ DO K=KTS,KTE
+ zz = kte+1-k
+ DO I=ITS,ITE
+ RQCCUTEN(I,K,J)=(Q2(I,zz)-QC3D(I,K,J))*RDELT
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+ IF(PRESENT(RQICUTEN))THEN
+ IF ( F_QI ) THEN
+ DO K=KTS,KTE
+ zz = kte+1-k
+ DO I=ITS,ITE
+ RQICUTEN(I,K,J)=(Q3(I,zz)-QI3D(I,K,J))*RDELT
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+
+ ENDDO
+
+ ENDIF
+
+ END SUBROUTINE CU_TIEDTKE
+
+!====================================================================
+ SUBROUTINE tiedtkeinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN, &
+ RUCUTEN,RVCUTEN, &
+ RESTART,P_QC,P_QI,P_FIRST_SCALAR, &
+ allowed_to_read, &
+ ids, ide, jds, jde, kds, kde, &
+ ims, ime, jms, jme, kms, kme, &
+ its, ite, jts, jte, kts, kte)
+!--------------------------------------------------------------------
+ IMPLICIT NONE
+!--------------------------------------------------------------------
+ LOGICAL , INTENT(IN) :: allowed_to_read,restart
+ INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
+ ims, ime, jms, jme, kms, kme, &
+ its, ite, jts, jte, kts, kte
+ INTEGER , INTENT(IN) :: P_FIRST_SCALAR, P_QI, P_QC
+
+ REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: &
+ RTHCUTEN, &
+ RQVCUTEN, &
+ RQCCUTEN, &
+ RQICUTEN, &
+ RUCUTEN,RVCUTEN
+
+ INTEGER :: i, j, k, itf, jtf, ktf
+
+ jtf=min0(jte,jde-1)
+ ktf=min0(kte,kde-1)
+ itf=min0(ite,ide-1)
+
+ IF(.not.restart)THEN
+ DO j=jts,jtf
+ DO k=kts,ktf
+ DO i=its,itf
+ RTHCUTEN(i,k,j)=0.
+ RQVCUTEN(i,k,j)=0.
+ RUCUTEN(i,k,j)=0.
+ RVCUTEN(i,k,j)=0.
+ ENDDO
+ ENDDO
+ ENDDO
+
+ IF (P_QC .ge. P_FIRST_SCALAR) THEN
+ DO j=jts,jtf
+ DO k=kts,ktf
+ DO i=its,itf
+ RQCCUTEN(i,k,j)=0.
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+ IF (P_QI .ge. P_FIRST_SCALAR) THEN
+ DO j=jts,jtf
+ DO k=kts,ktf
+ DO i=its,itf
+ RQICUTEN(i,k,j)=0.
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ ENDIF
+
+ END SUBROUTINE tiedtkeinit
+
+! ------------------------------------------------------------------------
+
+!------------This is the combined version for tiedtke---------------
+!----------------------------------------------------------------
+! In this module only the mass flux convection scheme of the ECMWF is included
+!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+!#############################################################
+!
+! LEVEL 1 SUBROUTINEs
+!
+!#############################################################
+!********************************************************
+! subroutine TIECNV
+!********************************************************
+ SUBROUTINE TIECNV(pu,pv,pt,pqv,pqc,pqi,pqvf,pqvbl,poz,pomg, &
+ pap,paph,evap,zprecc,lndj,KTYPE,lq,km,km1,sig1,dt)
+!-----------------------------------------------------------------
+! This is the interface between the meso-scale model and the mass
+! flux convection module
+!-----------------------------------------------------------------
+ implicit none
+
+ real pu(lq,km),pv(lq,km),pt(lq,km),pqv(lq,km),pqvf(lq,km)
+ real poz(lq,km),pomg(lq,km),evap(lq),zprecc(lq),pqvbl(lq,km)
+
+ REAL PUM1(lq,km), PVM1(lq,km), &
+ PTTE(lq,km), PQTE(lq,km), PVOM(lq,km), PVOL(lq,km), &
+ PVERV(lq,km), PGEO(lq,km), PAP(lq,km), PAPH(lq,km1)
+ REAL PQHFL(lq), ZQQ(lq,km), PAPRC(lq), PAPRS(lq), &
+ PRSFC(lq), PSSFC(lq), PAPRSM(lq), PCTE(lq,km)
+ REAL ZTP1(lq,km), ZQP1(lq,km), ZTU(lq,km), ZQU(lq,km), &
+ ZLU(lq,km), ZLUDE(lq,km), ZMFU(lq,km), ZMFD(lq,km), &
+ ZQSAT(lq,km), pqc(lq,km), pqi(lq,km), ZRAIN(lq)
+
+ REAL sig(km1),sig1(km)
+ INTEGER ICBOT(lq), ICTOP(lq), KTYPE(lq), lndj(lq)
+ REAL dt
+ LOGICAL LOCUM(lq)
+
+ real PSHEAT,PSRAIN,PSEVAP,PSMELT,PSDISS,TT
+ real ZTMST,ZTPP1,fliq,fice,ZTC,ZALF
+ integer i,j,k,lq,lp,km,km1
+! real TLUCUA
+! external TLUCUA
+
+ ZTMST=dt
+! Masv flux diagnostics.
+
+ PSHEAT=0.0
+ PSRAIN=0.0
+ PSEVAP=0.0
+ PSMELT=0.0
+ PSDISS=0.0
+ DO 8 j=1,lq
+ ZRAIN(j)=0.0
+ LOCUM(j)=.FALSE.
+ PRSFC(j)=0.0
+ PSSFC(j)=0.0
+ PAPRC(j)=0.0
+ PAPRS(j)=0.0
+ PAPRSM(j)=0.0
+ PQHFL(j)=evap(j)
+ 8 CONTINUE
+
+! CONVERT MODEL VARIABLES FOR MFLUX SCHEME
+
+ DO 10 k=1,km
+ DO 10 j=1,lq
+ PTTE(j,k)=0.0
+ PCTE(j,k)=0.0
+ PVOM(j,k)=0.0
+ PVOL(j,k)=0.0
+ ZTP1(j,k)=pt(j,k)
+ ZQP1(j,k)=pqv(j,k)/(1.0+pqv(j,k))
+ PUM1(j,k)=pu(j,k)
+ PVM1(j,k)=pv(j,k)
+ PVERV(j,k)=pomg(j,k)
+ PGEO(j,k)=G*poz(j,k)
+ TT=ZTP1(j,k)
+ ZQSAT(j,k)=TLUCUA(TT)/PAP(j,k)
+ ZQSAT(j,k)=MIN(0.5,ZQSAT(j,k))
+ ZQSAT(j,k)=ZQSAT(j,k)/(1.-VTMPC1*ZQSAT(j,k))
+ PQTE(j,k)=pqvf(j,k)+pqvbl(j,k)
+ ZQQ(j,k)=PQTE(j,k)
+ 10 CONTINUE
+!
+!-----------------------------------------------------------------------
+!* 2. CALL 'CUMASTR'(MASTER-ROUTINE FOR CUMULUS PARAMETERIZATION)
+!
+ CALL CUMASTR_NEW &
+ (lq, km, km1, km-1, ZTP1, &
+ ZQP1, PUM1, PVM1, PVERV, ZQSAT, &
+ PQHFL, ZTMST, PAP, PAPH, PGEO, &
+ PTTE, PQTE, PVOM, PVOL, PRSFC, &
+ PSSFC, PAPRC, PAPRSM, PAPRS, LOCUM, &
+ KTYPE, ICBOT, ICTOP, ZTU, ZQU, &
+ ZLU, ZLUDE, ZMFU, ZMFD, ZRAIN, &
+ PSRAIN, PSEVAP, PSHEAT, PSDISS, PSMELT, &
+ PCTE, sig1, lndj)
+!
+! TO INCLUDE THE CLOUD WATER AND CLOUD ICE DETRAINED FROM CONVECTION
+!
+ IF(fdbk.ge.1.0e-9) THEN
+ DO 20 K=1,km
+ DO 20 j=1,lq
+ If(PCTE(j,k).GT.0.0) then
+ ZTPP1=pt(j,k)+PTTE(j,k)*ZTMST
+ if(ZTPP1.ge.t000) then
+ fliq=1.0
+ ZALF=0.0
+ else if(ZTPP1.le.hgfr) then
+ fliq=0.0
+ ZALF=ALF
+ else
+ ZTC=ZTPP1-t000
+ fliq=0.0059+0.9941*exp(-0.003102*ZTC*ZTC)
+ ZALF=ALF
+ endif
+ fice=1.0-fliq
+ pqc(j,k)=pqc(j,k)+fliq*PCTE(j,k)*ZTMST
+ pqi(j,k)=pqi(j,k)+fice*PCTE(j,k)*ZTMST
+ PTTE(j,k)=PTTE(j,k)-ZALF*RCPD*fliq*PCTE(j,k)
+ Endif
+ 20 CONTINUE
+ ENDIF
+!
+ DO 75 k=1,km
+ DO 75 j=1,lq
+ pt(j,k)=ZTP1(j,k)+PTTE(j,k)*ZTMST
+ ZQP1(j,k)=ZQP1(j,k)+(PQTE(j,k)-ZQQ(j,k))*ZTMST
+ pqv(j,k)=ZQP1(j,k)/(1.0-ZQP1(j,k))
+ 75 CONTINUE
+ DO 85 j=1,lq
+ zprecc(j)=amax1(0.0,(PRSFC(j)+PSSFC(j))*ZTMST)
+ 85 CONTINUE
+ IF (LMFDUDV) THEN
+ DO 100 k=1,km
+ DO 100 j=1,lq
+ pu(j,k)=pu(j,k)+PVOM(j,k)*ZTMST
+ pv(j,k)=pv(j,k)+PVOL(j,k)*ZTMST
+ 100 CONTINUE
+ ENDIF
+!
+ RETURN
+ END SUBROUTINE TIECNV
+
+!#############################################################
+!
+! LEVEL 2 SUBROUTINEs
+!
+!#############################################################
+!***********************************************************
+! SUBROUTINE CUMASTR_NEW
+!***********************************************************
+ SUBROUTINE CUMASTR_NEW &
+ (KLON, KLEV, KLEVP1, KLEVM1, PTEN, &
+ PQEN, PUEN, PVEN, PVERV, PQSEN, &
+ PQHFL, ZTMST, PAP, PAPH, PGEO, &
+ PTTE, PQTE, PVOM, PVOL, PRSFC, &
+ PSSFC, PAPRC, PAPRSM, PAPRS, LDCUM, &
+ KTYPE, KCBOT, KCTOP, PTU, PQU, &
+ PLU, PLUDE, PMFU, PMFD, PRAIN, &
+ PSRAIN, PSEVAP, PSHEAT, PSDISS, PSMELT,&
+ PCTE, sig1, lndj)
+!
+!***CUMASTR* MASTER ROUTINE FOR CUMULUS MASSFLUX-SCHEME
+! M.TIEDTKE E.C.M.W.F. 1986/1987/1989
+!***PURPOSE
+! -------
+! THIS ROUTINE COMPUTES THE PHYSICAL TENDENCIES OF THE
+! PROGNOSTIC VARIABLES T,Q,U AND V DUE TO CONVECTIVE PROCESSES.
+! PROCESSES CONSIDERED ARE: CONVECTIVE FLUXES, FORMATION OF
+! PRECIPITATION, EVAPORATION OF FALLING RAIN BELOW CLOUD BASE,
+! SATURATED CUMULUS DOWNDRAFTS.
+!***INTERFACE.
+! ----------
+! *CUMASTR* IS CALLED FROM *MSSFLX*
+! THE ROUTINE TAKES ITS INPUT FROM THE LONG-TERM STORAGE
+! T,Q,U,V,PHI AND P AND MOISTURE TENDENCIES.
+! IT RETURNS ITS OUTPUT TO THE SAME SPACE
+! 1.MODIFIED TENDENCIES OF MODEL VARIABLES
+! 2.RATES OF CONVECTIVE PRECIPITATION
+! (USED IN SUBROUTINE SURF)
+! 3.CLOUD BASE, CLOUD TOP AND PRECIP FOR RADIATION
+! (USED IN SUBROUTINE CLOUD)
+!***METHOD
+! ------
+! PARAMETERIZATION IS DONE USING A MASSFLUX-SCHEME.
+! (1) DEFINE CONSTANTS AND PARAMETERS
+! (2) SPECIFY VALUES (T,Q,QS...) AT HALF LEVELS AND
+! INITIALIZE UPDRAFT- AND DOWNDRAFT-VALUES IN 'CUINI'
+! (3) CALCULATE CLOUD BASE IN 'CUBASE'
+! AND SPECIFY CLOUD BASE MASSFLUX FROM PBL MOISTURE BUDGET
+! (4) DO CLOUD ASCENT IN 'CUASC' IN ABSENCE OF DOWNDRAFTS
+! (5) DO DOWNDRAFT CALCULATIONS:
+! (A) DETERMINE VALUES AT LFS IN 'CUDLFS'
+! (B) DETERMINE MOIST DESCENT IN 'CUDDRAF'
+! (C) RECALCULATE CLOUD BASE MASSFLUX CONSIDERING THE
+! EFFECT OF CU-DOWNDRAFTS
+! (6) DO FINAL CLOUD ASCENT IN 'CUASC'
+! (7) DO FINAL ADJUSMENTS TO CONVECTIVE FLUXES IN 'CUFLX',
+! DO EVAPORATION IN SUBCLOUD LAYER
+! (8) CALCULATE INCREMENTS OF T AND Q IN 'CUDTDQ'
+! (9) CALCULATE INCREMENTS OF U AND V IN 'CUDUDV'
+!***EXTERNALS.
+! ----------
+! CUINI: INITIALIZES VALUES AT VERTICAL GRID USED IN CU-PARAMETR.
+! CUBASE: CLOUD BASE CALCULATION FOR PENETR.AND SHALLOW CONVECTION
+! CUASC: CLOUD ASCENT FOR ENTRAINING PLUME
+! CUDLFS: DETERMINES VALUES AT LFS FOR DOWNDRAFTS
+! CUDDRAF:DOES MOIST DESCENT FOR CUMULUS DOWNDRAFTS
+! CUFLX: FINAL ADJUSTMENTS TO CONVECTIVE FLUXES (ALSO IN PBL)
+! CUDQDT: UPDATES TENDENCIES FOR T AND Q
+! CUDUDV: UPDATES TENDENCIES FOR U AND V
+!***SWITCHES.
+! --------
+! LMFPEN=.T. PENETRATIVE CONVECTION IS SWITCHED ON
+! LMFSCV=.T. SHALLOW CONVECTION IS SWITCHED ON
+! LMFMID=.T. MIDLEVEL CONVECTION IS SWITCHED ON
+! LMFDD=.T. CUMULUS DOWNDRAFTS SWITCHED ON
+! LMFDUDV=.T. CUMULUS FRICTION SWITCHED ON
+!***
+! MODEL PARAMETERS (DEFINED IN SUBROUTINE CUPARAM)
+! ------------------------------------------------
+! ENTRPEN ENTRAINMENT RATE FOR PENETRATIVE CONVECTION
+! ENTRSCV ENTRAINMENT RATE FOR SHALLOW CONVECTION
+! ENTRMID ENTRAINMENT RATE FOR MIDLEVEL CONVECTION
+! ENTRDD ENTRAINMENT RATE FOR CUMULUS DOWNDRAFTS
+! CMFCTOP RELATIVE CLOUD MASSFLUX AT LEVEL ABOVE NONBUOYANCY
+! LEVEL
+! CMFCMAX MAXIMUM MASSFLUX VALUE ALLOWED FOR
+! CMFCMIN MINIMUM MASSFLUX VALUE (FOR SAFETY)
+! CMFDEPS FRACTIONAL MASSFLUX FOR DOWNDRAFTS AT LFS
+! CPRCON COEFFICIENT FOR CONVERSION FROM CLOUD WATER TO RAIN
+!***REFERENCE.
+! ----------
+! PAPER ON MASSFLUX SCHEME (TIEDTKE,1989)
+!-----------------------------------------------------------------
+!-------------------------------------------------------------------
+ IMPLICIT NONE
+!-------------------------------------------------------------------
+ INTEGER KLON, KLEV, KLEVP1
+ INTEGER KLEVM1
+ REAL ZTMST
+ REAL PSRAIN, PSEVAP, PSHEAT, PSDISS, PSMELT, ZCONS2
+ INTEGER JK,JL,IKB
+ REAL ZQUMQE, ZDQMIN, ZMFMAX, ZALVDCP, ZQALV
+ REAL ZHSAT, ZGAM, ZZZ, ZHHAT, ZBI, ZRO, ZDZ, ZDHDZ, ZDEPTH
+ REAL ZFAC, ZRH, ZPBMPT, DEPT, ZHT, ZEPS
+ INTEGER ICUM, ITOPM2
+ REAL PTEN(KLON,KLEV), PQEN(KLON,KLEV), &
+ PUEN(KLON,KLEV), PVEN(KLON,KLEV), &
+ PTTE(KLON,KLEV), PQTE(KLON,KLEV), &
+ PVOM(KLON,KLEV), PVOL(KLON,KLEV), &
+ PQSEN(KLON,KLEV), PGEO(KLON,KLEV), &
+ PAP(KLON,KLEV), PAPH(KLON,KLEVP1),&
+ PVERV(KLON,KLEV), PQHFL(KLON)
+ REAL PTU(KLON,KLEV), PQU(KLON,KLEV), &
+ PLU(KLON,KLEV), PLUDE(KLON,KLEV), &
+ PMFU(KLON,KLEV), PMFD(KLON,KLEV), &
+ PAPRC(KLON), PAPRS(KLON), &
+ PAPRSM(KLON), PRAIN(KLON), &
+ PRSFC(KLON), PSSFC(KLON)
+ REAL ZTENH(KLON,KLEV), ZQENH(KLON,KLEV),&
+ ZGEOH(KLON,KLEV), ZQSENH(KLON,KLEV),&
+ ZTD(KLON,KLEV), ZQD(KLON,KLEV), &
+ ZMFUS(KLON,KLEV), ZMFDS(KLON,KLEV), &
+ ZMFUQ(KLON,KLEV), ZMFDQ(KLON,KLEV), &
+ ZDMFUP(KLON,KLEV), ZDMFDP(KLON,KLEV),&
+ ZMFUL(KLON,KLEV), ZRFL(KLON), &
+ ZUU(KLON,KLEV), ZVU(KLON,KLEV), &
+ ZUD(KLON,KLEV), ZVD(KLON,KLEV)
+ REAL ZENTR(KLON), ZHCBASE(KLON), &
+ ZMFUB(KLON), ZMFUB1(KLON), &
+ ZDQPBL(KLON), ZDQCV(KLON)
+ REAL ZSFL(KLON), ZDPMEL(KLON,KLEV), &
+ PCTE(KLON,KLEV), ZCAPE(KLON), &
+ ZHEAT(KLON), ZHHATT(KLON,KLEV), &
+ ZHMIN(KLON), ZRELH(KLON)
+ REAL sig1(KLEV)
+ INTEGER ILAB(KLON,KLEV), IDTOP(KLON), &
+ ICTOP0(KLON), ILWMIN(KLON)
+ INTEGER KCBOT(KLON), KCTOP(KLON), &
+ KTYPE(KLON), IHMIN(KLON), &
+ KTOP0, lndj(KLON)
+ LOGICAL LDCUM(KLON)
+ LOGICAL LODDRAF(KLON), LLO1
+!-------------------------------------------
+! 1. SPECIFY CONSTANTS AND PARAMETERS
+!-------------------------------------------
+ 100 CONTINUE
+ ZCONS2=1./(G*ZTMST)
+!--------------------------------------------------------------
+!* 2. INITIALIZE VALUES AT VERTICAL GRID POINTS IN 'CUINI'
+!--------------------------------------------------------------
+ 200 CONTINUE
+ CALL CUINI &
+ (KLON, KLEV, KLEVP1, KLEVM1, PTEN, &
+ PQEN, PQSEN, PUEN, PVEN, PVERV, &
+ PGEO, PAPH, ZGEOH, ZTENH, ZQENH, &
+ ZQSENH, ILWMIN, PTU, PQU, ZTD, &
+ ZQD, ZUU, ZVU, ZUD, ZVD, &
+ PMFU, PMFD, ZMFUS, ZMFDS, ZMFUQ, &
+ ZMFDQ, ZDMFUP, ZDMFDP, ZDPMEL, PLU, &
+ PLUDE, ILAB)
+!----------------------------------
+!* 3.0 CLOUD BASE CALCULATIONS
+!----------------------------------
+ 300 CONTINUE
+!* (A) DETERMINE CLOUD BASE VALUES IN 'CUBASE'
+! -------------------------------------------
+ CALL CUBASE &
+ (KLON, KLEV, KLEVP1, KLEVM1, ZTENH, &
+ ZQENH, ZGEOH, PAPH, PTU, PQU, &
+ PLU, PUEN, PVEN, ZUU, ZVU, &
+ LDCUM, KCBOT, ILAB)
+!* (B) DETERMINE TOTAL MOISTURE CONVERGENCE AND
+!* THEN DECIDE ON TYPE OF CUMULUS CONVECTION
+! -----------------------------------------
+ JK=1
+ DO 310 JL=1,KLON
+ ZDQCV(JL) =PQTE(JL,JK)*(PAPH(JL,JK+1)-PAPH(JL,JK))
+ ZDQPBL(JL)=0.0
+ IDTOP(JL)=0
+ 310 CONTINUE
+ DO 320 JK=2,KLEV
+ DO 315 JL=1,KLON
+ ZDQCV(JL)=ZDQCV(JL)+PQTE(JL,JK)*(PAPH(JL,JK+1)-PAPH(JL,JK))
+ IF(JK.GE.KCBOT(JL)) ZDQPBL(JL)=ZDQPBL(JL)+PQTE(JL,JK) &
+ *(PAPH(JL,JK+1)-PAPH(JL,JK))
+ 315 CONTINUE
+ 320 CONTINUE
+ DO 340 JL=1,KLON
+ KTYPE(JL)=0
+ IF(ZDQCV(JL).GT.MAX(0.,1.1*PQHFL(JL)*G)) THEN
+ KTYPE(JL)=1
+ ELSE
+ KTYPE(JL)=2
+ ENDIF
+!* (C) DETERMINE MOISTURE SUPPLY FOR BOUNDARY LAYER
+!* AND DETERMINE CLOUD BASE MASSFLUX IGNORING
+!* THE EFFECTS OF DOWNDRAFTS AT THIS STAGE
+! ------------------------------------------
+ IKB=KCBOT(JL)
+ ZQUMQE=PQU(JL,IKB)+PLU(JL,IKB)-ZQENH(JL,IKB)
+ ZDQMIN=MAX(0.01*ZQENH(JL,IKB),1.E-10)
+ IF(ZDQPBL(JL).GT.0..AND.ZQUMQE.GT.ZDQMIN.AND.LDCUM(JL)) THEN
+ ZMFUB(JL)=ZDQPBL(JL)/(G*MAX(ZQUMQE,ZDQMIN))
+ ELSE
+ ZMFUB(JL)=0.01
+ LDCUM(JL)=.FALSE.
+ ENDIF
+ ZMFMAX=(PAPH(JL,IKB)-PAPH(JL,IKB-1))*ZCONS2
+ ZMFUB(JL)=MIN(ZMFUB(JL),ZMFMAX)
+!------------------------------------------------------
+!* 4.0 DETERMINE CLOUD ASCENT FOR ENTRAINING PLUME
+!------------------------------------------------------
+ 400 CONTINUE
+!* (A) ESTIMATE CLOUD HEIGHT FOR ENTRAINMENT/DETRAINMENT
+!* CALCULATIONS IN CUASC (MAX.POSSIBLE CLOUD HEIGHT
+!* FOR NON-ENTRAINING PLUME, FOLLOWING A.-S.,1974)
+! -------------------------------------------------------------
+ IKB=KCBOT(JL)
+ ZHCBASE(JL)=CPD*PTU(JL,IKB)+ZGEOH(JL,IKB)+ALV*PQU(JL,IKB)
+ ICTOP0(JL)=KCBOT(JL)-1
+ 340 CONTINUE
+ ZALVDCP=ALV/CPD
+ ZQALV=1./ALV
+ DO 420 JK=KLEVM1,3,-1
+ DO 420 JL=1,KLON
+ ZHSAT=CPD*ZTENH(JL,JK)+ZGEOH(JL,JK)+ALV*ZQSENH(JL,JK)
+ ZGAM=C5LES*ZALVDCP*ZQSENH(JL,JK)/ &
+ ((1.-VTMPC1*ZQSENH(JL,JK))*(ZTENH(JL,JK)-C4LES)**2)
+ ZZZ=CPD*ZTENH(JL,JK)*0.608
+ ZHHAT=ZHSAT-(ZZZ+ZGAM*ZZZ)/(1.+ZGAM*ZZZ*ZQALV)* &
+ MAX(ZQSENH(JL,JK)-ZQENH(JL,JK),0.)
+ ZHHATT(JL,JK)=ZHHAT
+ IF(JK.LT.ICTOP0(JL).AND.ZHCBASE(JL).GT.ZHHAT) ICTOP0(JL)=JK
+ 420 CONTINUE
+ DO 430 JL=1,KLON
+ JK=KCBOT(JL)
+ ZHSAT=CPD*ZTENH(JL,JK)+ZGEOH(JL,JK)+ALV*ZQSENH(JL,JK)
+ ZGAM=C5LES*ZALVDCP*ZQSENH(JL,JK)/ &
+ ((1.-VTMPC1*ZQSENH(JL,JK))*(ZTENH(JL,JK)-C4LES)**2)
+ ZZZ=CPD*ZTENH(JL,JK)*0.608
+ ZHHAT=ZHSAT-(ZZZ+ZGAM*ZZZ)/(1.+ZGAM*ZZZ*ZQALV)* &
+ MAX(ZQSENH(JL,JK)-ZQENH(JL,JK),0.)
+ ZHHATT(JL,JK)=ZHHAT
+ 430 CONTINUE
+!
+! Find lowest possible org. detrainment level
+!
+ DO 440 JL = 1, KLON
+ ZHMIN(JL) = 0.
+ IF( LDCUM(JL).AND.KTYPE(JL).EQ.1 ) THEN
+ IHMIN(JL) = KCBOT(JL)
+ ELSE
+ IHMIN(JL) = -1
+ END IF
+ 440 CONTINUE
+!
+ ZBI = 1./(25.*G)
+ DO 450 JK = KLEV, 1, -1
+ DO 450 JL = 1, KLON
+ LLO1 = LDCUM(JL).AND.KTYPE(JL).EQ.1.AND.IHMIN(JL).EQ.KCBOT(JL)
+ IF (LLO1.AND.JK.LT.KCBOT(JL).AND.JK.GE.ICTOP0(JL)) THEN
+ IKB = KCBOT(JL)
+ ZRO = RD*ZTENH(JL,JK)/(G*PAPH(JL,JK))
+ ZDZ = (PAPH(JL,JK)-PAPH(JL,JK-1))*ZRO
+ ZDHDZ=(CPD*(PTEN(JL,JK-1)-PTEN(JL,JK))+ALV*(PQEN(JL,JK-1)- &
+ PQEN(JL,JK))+(PGEO(JL,JK-1)-PGEO(JL,JK)))*G/(PGEO(JL, &
+ JK-1)-PGEO(JL,JK))
+ ZDEPTH = ZGEOH(JL,JK) - ZGEOH(JL,IKB)
+ ZFAC = SQRT(1.+ZDEPTH*ZBI)
+ ZHMIN(JL) = ZHMIN(JL) + ZDHDZ*ZFAC*ZDZ
+ ZRH = -ALV*(ZQSENH(JL,JK)-ZQENH(JL,JK))*ZFAC
+ IF (ZHMIN(JL).GT.ZRH) IHMIN(JL) = JK
+ END IF
+ 450 CONTINUE
+ DO 460 JL = 1, KLON
+ IF (LDCUM(JL).AND.KTYPE(JL).EQ.1) THEN
+ IF (IHMIN(JL).LT.ICTOP0(JL)) IHMIN(JL) = ICTOP0(JL)
+ END IF
+ if(nentr.eq.1) then
+ IF(KTYPE(JL).EQ.1) THEN
+ ZENTR(JL)=ENTRPEN
+ ELSE
+ ZENTR(JL)=ENTRSCV
+ ENDIF
+ if(lndj(JL).eq.1) ZENTR(JL)=ZENTR(JL)*1.1
+ else
+ ZDEPTH=ZRG*(ZGEOH(JL,ICTOP0(JL))-ZGEOH(JL,KCBOT(JL)))
+ ZENTR(JL)=MAX(ENTRPEN,1.5/MAX(500.0,ZDEPTH))
+ if(lndj(JL).eq.1) ZENTR(JL)=ZENTR(JL)*1.1
+ endif
+ 460 CONTINUE
+!* (B) DO ASCENT IN 'CUASC'IN ABSENCE OF DOWNDRAFTS
+!----------------------------------------------------------
+ CALL CUASC_NEW &
+ (KLON, KLEV, KLEVP1, KLEVM1, ZTENH, &
+ ZQENH, PUEN, PVEN, PTEN, PQEN, &
+ PQSEN, PGEO, ZGEOH, PAP, PAPH, &
+ PQTE, PVERV, ILWMIN, LDCUM, ZHCBASE, &
+ KTYPE, ILAB, PTU, PQU, PLU, &
+ ZUU, ZVU, PMFU, ZMFUB, ZENTR, &
+ ZMFUS, ZMFUQ, ZMFUL, PLUDE, ZDMFUP, &
+ KCBOT, KCTOP, ICTOP0, ICUM, ZTMST, &
+ IHMIN, ZHHATT, ZQSENH)
+ IF(ICUM.EQ.0) GO TO 1000
+!* (C) CHECK CLOUD DEPTH AND CHANGE ENTRAINMENT RATE ACCORDINGLY
+! CALCULATE PRECIPITATION RATE (FOR DOWNDRAFT CALCULATION)
+!------------------------------------------------------------------
+ DO 480 JL=1,KLON
+ ZPBMPT=PAPH(JL,KCBOT(JL))-PAPH(JL,KCTOP(JL))
+ IF(LDCUM(JL)) ICTOP0(JL)=KCTOP(JL)
+ IF(LDCUM(JL).AND.KTYPE(JL).EQ.1.AND.ZPBMPT.LT.ZDNOPRC) KTYPE(JL)=2
+ IF(KTYPE(JL).EQ.2.and.nentr.eq.1) then
+ ZENTR(JL)=ENTRSCV
+ if(lndj(JL).eq.1) ZENTR(JL)=ZENTR(JL)*1.1
+ endif
+ if(nentr.eq.2) then
+ ZDEPTH=ZRG*(ZGEOH(JL,KCTOP(JL))-ZGEOH(JL,KCBOT(JL)))
+ ZENTR(JL)=MAX(ENTRPEN,1.5/MAX(500.0,ZDEPTH))
+ if(lndj(JL).eq.1) ZENTR(JL)=ZENTR(JL)*1.1
+ endif
+ ZRFL(JL)=ZDMFUP(JL,1)
+ 480 CONTINUE
+ DO 490 JK=2,KLEV
+ DO 490 JL=1,KLON
+ ZRFL(JL)=ZRFL(JL)+ZDMFUP(JL,JK)
+ 490 CONTINUE
+!-----------------------------------------
+!* 5.0 CUMULUS DOWNDRAFT CALCULATIONS
+!-----------------------------------------
+ 500 CONTINUE
+ IF(LMFDD) THEN
+!* (A) DETERMINE LFS IN 'CUDLFS'
+!--------------------------------------
+ CALL CUDLFS &
+ (KLON, KLEV, KLEVP1, ZTENH, ZQENH, &
+ PUEN, PVEN, ZGEOH, PAPH, PTU, &
+ PQU, ZUU, ZVU, LDCUM, KCBOT, &
+ KCTOP, ZMFUB, ZRFL, ZTD, ZQD, &
+ ZUD, ZVD, PMFD, ZMFDS, ZMFDQ, &
+ ZDMFDP, IDTOP, LODDRAF)
+!* (B) DETERMINE DOWNDRAFT T,Q AND FLUXES IN 'CUDDRAF'
+!------------------------------------------------------------
+ CALL CUDDRAF &
+ (KLON, KLEV, KLEVP1, ZTENH, ZQENH, &
+ PUEN, PVEN, ZGEOH, PAPH, ZRFL, &
+ LODDRAF, ZTD, ZQD, ZUD, ZVD, &
+ PMFD, ZMFDS, ZMFDQ, ZDMFDP)
+!* (C) RECALCULATE CONVECTIVE FLUXES DUE TO EFFECT OF
+! DOWNDRAFTS ON BOUNDARY LAYER MOISTURE BUDGET
+!-----------------------------------------------------------
+ END IF
+!
+!-- 5.1 Recalculate cloud base massflux from a cape closure
+! for deep convection (ktype=1) and by PBL equilibrium
+! taking downdrafts into account for shallow convection
+! (ktype=2)
+! implemented by Y. WANG based on ECHAM4 in Nov. 2001.
+!
+ DO 510 JL=1,KLON
+ ZHEAT(JL)=0.0
+ ZCAPE(JL)=0.0
+ ZRELH(JL)=0.0
+ ZMFUB1(JL)=ZMFUB(JL)
+ 510 CONTINUE
+!
+ DO 511 JL=1,KLON
+ IF(LDCUM(JL).AND.KTYPE(JL).EQ.1) THEN
+ KTOP0=MAX(12,KCTOP(JL))
+ DO JK=2,KLEV
+ IF(JK.LE.KCBOT(JL).AND.JK.GT.KCTOP(JL)) THEN
+ ZRO=PAPH(JL,JK)/(RD*ZTENH(JL,JK))
+ ZDZ=(PAPH(JL,JK)-PAPH(JL,JK-1))/(G*ZRO)
+ ZHEAT(JL)=ZHEAT(JL)+((PTEN(JL,JK-1)-PTEN(JL,JK) &
+ +G*ZDZ/CPD)/ZTENH(JL,JK)+0.608*(PQEN(JL,JK-1)- &
+ PQEN(JL,JK)))*(PMFU(JL,JK)+PMFD(JL,JK))*G/ZRO
+ ZCAPE(JL)=ZCAPE(JL)+G*((PTU(JL,JK)*(1.+.608*PQU(JL,JK) &
+ -PLU(JL,JK)))/(ZTENH(JL,JK)*(1.+.608*ZQENH(JL,JK))) &
+ -1.0)*ZDZ
+ ENDIF
+ IF(JK.LE.KCBOT(JL).AND.JK.GT.KTOP0) THEN
+ dept=(PAPH(JL,JK)-PAPH(JL,JK-1))/(PAPH(JL,KCBOT(JL))- &
+ PAPH(JL,KTOP0))
+ ZRELH(JL)=ZRELH(JL)+dept*PQEN(JL,JK)/PQSEN(JL,JK)
+ ENDIF
+ ENDDO
+!
+ IF(ZRELH(JL).GE.CRIRH) THEN
+ IKB=KCBOT(JL)
+! ZHT=MAX(0.0,(ZCAPE(JL)-300.0))/(ZTAU*ZHEAT(JL))
+ ZHT=MAX(0.0,(ZCAPE(JL)-0.0))/(ZTAU*ZHEAT(JL))
+ ZMFUB1(JL)=MAX(ZMFUB(JL)*ZHT,0.01)
+ ZMFMAX=(PAPH(JL,IKB)-PAPH(JL,IKB-1))*ZCONS2
+ ZMFUB1(JL)=MIN(ZMFUB1(JL),ZMFMAX)
+ ELSE
+ ZMFUB1(JL)=0.01
+ ZMFUB(JL)=0.01
+ LDCUM(JL)=.FALSE.
+ ENDIF
+ ENDIF
+ 511 CONTINUE
+!
+!* 5.2 RECALCULATE CONVECTIVE FLUXES DUE TO EFFECT OF
+! DOWNDRAFTS ON BOUNDARY LAYER MOISTURE BUDGET
+!--------------------------------------------------------
+ DO 512 JL=1,KLON
+ IF(KTYPE(JL).NE.1) THEN
+ IKB=KCBOT(JL)
+ IF(PMFD(JL,IKB).LT.0.0.AND.LODDRAF(JL)) THEN
+ ZEPS=CMFDEPS
+ ELSE
+ ZEPS=0.
+ ENDIF
+ ZQUMQE=PQU(JL,IKB)+PLU(JL,IKB)- &
+ ZEPS*ZQD(JL,IKB)-(1.-ZEPS)*ZQENH(JL,IKB)
+ ZDQMIN=MAX(0.01*ZQENH(JL,IKB),1.E-10)
+ ZMFMAX=(PAPH(JL,IKB)-PAPH(JL,IKB-1))*ZCONS2
+ IF(ZDQPBL(JL).GT.0..AND.ZQUMQE.GT.ZDQMIN.AND.LDCUM(JL) &
+ .AND.ZMFUB(JL).LT.ZMFMAX) THEN
+ ZMFUB1(JL)=ZDQPBL(JL)/(G*MAX(ZQUMQE,ZDQMIN))
+ ELSE
+ ZMFUB1(JL)=ZMFUB(JL)
+ ENDIF
+ LLO1=(KTYPE(JL).EQ.2).AND.ABS(ZMFUB1(JL) &
+ -ZMFUB(JL)).LT.0.2*ZMFUB(JL)
+ IF(.NOT.LLO1) ZMFUB1(JL)=ZMFUB(JL)
+ ZMFUB1(JL)=MIN(ZMFUB1(JL),ZMFMAX)
+ END IF
+ 512 CONTINUE
+ DO 530 JK=1,KLEV
+ DO 530 JL=1,KLON
+ IF(LDCUM(JL)) THEN
+ ZFAC=ZMFUB1(JL)/MAX(ZMFUB(JL),1.E-10)
+ PMFD(JL,JK)=PMFD(JL,JK)*ZFAC
+ ZMFDS(JL,JK)=ZMFDS(JL,JK)*ZFAC
+ ZMFDQ(JL,JK)=ZMFDQ(JL,JK)*ZFAC
+ ZDMFDP(JL,JK)=ZDMFDP(JL,JK)*ZFAC
+ ELSE
+ PMFD(JL,JK)=0.0
+ ZMFDS(JL,JK)=0.0
+ ZMFDQ(JL,JK)=0.0
+ ZDMFDP(JL,JK)=0.0
+ ENDIF
+ 530 CONTINUE
+ DO 538 JL=1,KLON
+ IF(LDCUM(JL)) THEN
+ ZMFUB(JL)=ZMFUB1(JL)
+ ELSE
+ ZMFUB(JL)=0.0
+ ENDIF
+ 538 CONTINUE
+!
+!---------------------------------------------------------------
+!* 6.0 DETERMINE FINAL CLOUD ASCENT FOR ENTRAINING PLUME
+!* FOR PENETRATIVE CONVECTION (TYPE=1),
+!* FOR SHALLOW TO MEDIUM CONVECTION (TYPE=2)
+!* AND FOR MID-LEVEL CONVECTION (TYPE=3).
+!---------------------------------------------------------------
+ 600 CONTINUE
+ CALL CUASC_NEW &
+ (KLON, KLEV, KLEVP1, KLEVM1, ZTENH, &
+ ZQENH, PUEN, PVEN, PTEN, PQEN, &
+ PQSEN, PGEO, ZGEOH, PAP, PAPH, &
+ PQTE, PVERV, ILWMIN, LDCUM, ZHCBASE,&
+ KTYPE, ILAB, PTU, PQU, PLU, &
+ ZUU, ZVU, PMFU, ZMFUB, ZENTR, &
+ ZMFUS, ZMFUQ, ZMFUL, PLUDE, ZDMFUP, &
+ KCBOT, KCTOP, ICTOP0, ICUM, ZTMST, &
+ IHMIN, ZHHATT, ZQSENH)
+!----------------------------------------------------------
+!* 7.0 DETERMINE FINAL CONVECTIVE FLUXES IN 'CUFLX'
+!----------------------------------------------------------
+ 700 CONTINUE
+ CALL CUFLX &
+ (KLON, KLEV, KLEVP1, PQEN, PQSEN, &
+ ZTENH, ZQENH, PAPH, ZGEOH, KCBOT, &
+ KCTOP, IDTOP, KTYPE, LODDRAF, LDCUM, &
+ PMFU, PMFD, ZMFUS, ZMFDS, ZMFUQ, &
+ ZMFDQ, ZMFUL, PLUDE, ZDMFUP, ZDMFDP, &
+ ZRFL, PRAIN, PTEN, ZSFL, ZDPMEL, &
+ ITOPM2, ZTMST, sig1)
+!----------------------------------------------------------------
+!* 8.0 UPDATE TENDENCIES FOR T AND Q IN SUBROUTINE CUDTDQ
+!----------------------------------------------------------------
+ 800 CONTINUE
+ CALL CUDTDQ &
+ (KLON, KLEV, KLEVP1, ITOPM2, PAPH, &
+ LDCUM, PTEN, PTTE, PQTE, ZMFUS, &
+ ZMFDS, ZMFUQ, ZMFDQ, ZMFUL, ZDMFUP, &
+ ZDMFDP, ZTMST, ZDPMEL, PRAIN, ZRFL, &
+ ZSFL, PSRAIN, PSEVAP, PSHEAT, PSMELT, &
+ PRSFC, PSSFC, PAPRC, PAPRSM, PAPRS, &
+ PQEN, PQSEN, PLUDE, PCTE)
+!----------------------------------------------------------------
+!* 9.0 UPDATE TENDENCIES FOR U AND U IN SUBROUTINE CUDUDV
+!----------------------------------------------------------------
+ 900 CONTINUE
+ IF(LMFDUDV) THEN
+ CALL CUDUDV &
+ (KLON, KLEV, KLEVP1, ITOPM2, KTYPE, &
+ KCBOT, PAPH, LDCUM, PUEN, PVEN, &
+ PVOM, PVOL, ZUU, ZUD, ZVU, &
+ ZVD, PMFU, PMFD, PSDISS)
+ END IF
+ 1000 CONTINUE
+ RETURN
+ END SUBROUTINE CUMASTR_NEW
+!
+
+!#############################################################
+!
+! LEVEL 3 SUBROUTINEs
+!
+!#############################################################
+!**********************************************
+! SUBROUTINE CUINI
+!**********************************************
+!
+ SUBROUTINE CUINI &
+ (KLON, KLEV, KLEVP1, KLEVM1, PTEN, &
+ PQEN, PQSEN, PUEN, PVEN, PVERV, &
+ PGEO, PAPH, PGEOH, PTENH, PQENH, &
+ PQSENH, KLWMIN, PTU, PQU, PTD, &
+ PQD, PUU, PVU, PUD, PVD, &
+ PMFU, PMFD, PMFUS, PMFDS, PMFUQ, &
+ PMFDQ, PDMFUP, PDMFDP, PDPMEL, PLU, &
+ PLUDE, KLAB)
+! M.TIEDTKE E.C.M.W.F. 12/89
+!***PURPOSE
+! -------
+! THIS ROUTINE INTERPOLATES LARGE-SCALE FIELDS OF T,Q ETC.
+! TO HALF LEVELS (I.E. GRID FOR MASSFLUX SCHEME),
+! AND INITIALIZES VALUES FOR UPDRAFTS AND DOWNDRAFTS
+!***INTERFACE
+! ---------
+! THIS ROUTINE IS CALLED FROM *CUMASTR*.
+!***METHOD.
+! --------
+! FOR EXTRAPOLATION TO HALF LEVELS SEE TIEDTKE(1989)
+!***EXTERNALS
+! ---------
+! *CUADJTQ* TO SPECIFY QS AT HALF LEVELS
+! ----------------------------------------------------------------
+!-------------------------------------------------------------------
+ IMPLICIT NONE
+!-------------------------------------------------------------------
+ INTEGER KLON, KLEV, KLEVP1
+ INTEGER klevm1
+ INTEGER JK,JL,IK, ICALL
+ REAL ZDP, ZZS
+ REAL PTEN(KLON,KLEV), PQEN(KLON,KLEV), &
+ PUEN(KLON,KLEV), PVEN(KLON,KLEV), &
+ PQSEN(KLON,KLEV), PVERV(KLON,KLEV), &
+ PGEO(KLON,KLEV), PGEOH(KLON,KLEV), &
+ PAPH(KLON,KLEVP1), PTENH(KLON,KLEV), &
+ PQENH(KLON,KLEV), PQSENH(KLON,KLEV)
+ REAL PTU(KLON,KLEV), PQU(KLON,KLEV), &
+ PTD(KLON,KLEV), PQD(KLON,KLEV), &
+ PUU(KLON,KLEV), PUD(KLON,KLEV), &
+ PVU(KLON,KLEV), PVD(KLON,KLEV), &
+ PMFU(KLON,KLEV), PMFD(KLON,KLEV), &
+ PMFUS(KLON,KLEV), PMFDS(KLON,KLEV), &
+ PMFUQ(KLON,KLEV), PMFDQ(KLON,KLEV), &
+ PDMFUP(KLON,KLEV), PDMFDP(KLON,KLEV), &
+ PLU(KLON,KLEV), PLUDE(KLON,KLEV)
+ REAL ZWMAX(KLON), ZPH(KLON), &
+ PDPMEL(KLON,KLEV)
+ INTEGER KLAB(KLON,KLEV), KLWMIN(KLON)
+ LOGICAL LOFLAG(KLON)
+!------------------------------------------------------------
+!* 1. SPECIFY LARGE SCALE PARAMETERS AT HALF LEVELS
+!* ADJUST TEMPERATURE FIELDS IF STATICLY UNSTABLE
+!* FIND LEVEL OF MAXIMUM VERTICAL VELOCITY
+! -----------------------------------------------------------
+ 100 CONTINUE
+ ZDP=0.5
+ DO 130 JK=2,KLEV
+ DO 110 JL=1,KLON
+ PGEOH(JL,JK)=PGEO(JL,JK)+(PGEO(JL,JK-1)-PGEO(JL,JK))*ZDP
+ PTENH(JL,JK)=(MAX(CPD*PTEN(JL,JK-1)+PGEO(JL,JK-1), &
+ CPD*PTEN(JL,JK)+PGEO(JL,JK))-PGEOH(JL,JK))*RCPD
+ PQSENH(JL,JK)=PQSEN(JL,JK-1)
+ ZPH(JL)=PAPH(JL,JK)
+ LOFLAG(JL)=.TRUE.
+ 110 CONTINUE
+ IK=JK
+ ICALL=0
+ CALL CUADJTQ(KLON,KLEV,IK,ZPH,PTENH,PQSENH,LOFLAG,ICALL)
+ DO 120 JL=1,KLON
+ PQENH(JL,JK)=MIN(PQEN(JL,JK-1),PQSEN(JL,JK-1)) &
+ +(PQSENH(JL,JK)-PQSEN(JL,JK-1))
+ PQENH(JL,JK)=MAX(PQENH(JL,JK),0.)
+ 120 CONTINUE
+ 130 CONTINUE
+ DO 140 JL=1,KLON
+ PTENH(JL,KLEV)=(CPD*PTEN(JL,KLEV)+PGEO(JL,KLEV)- &
+ PGEOH(JL,KLEV))*RCPD
+ PQENH(JL,KLEV)=PQEN(JL,KLEV)
+ PTENH(JL,1)=PTEN(JL,1)
+ PQENH(JL,1)=PQEN(JL,1)
+ PGEOH(JL,1)=PGEO(JL,1)
+ KLWMIN(JL)=KLEV
+ ZWMAX(JL)=0.
+ 140 CONTINUE
+ DO 160 JK=KLEVM1,2,-1
+ DO 150 JL=1,KLON
+ ZZS=MAX(CPD*PTENH(JL,JK)+PGEOH(JL,JK), &
+ CPD*PTENH(JL,JK+1)+PGEOH(JL,JK+1))
+ PTENH(JL,JK)=(ZZS-PGEOH(JL,JK))*RCPD
+ 150 CONTINUE
+ 160 CONTINUE
+ DO 190 JK=KLEV,3,-1
+ DO 180 JL=1,KLON
+ IF(PVERV(JL,JK).LT.ZWMAX(JL)) THEN
+ ZWMAX(JL)=PVERV(JL,JK)
+ KLWMIN(JL)=JK
+ END IF
+ 180 CONTINUE
+ 190 CONTINUE
+!-----------------------------------------------------------
+!* 2.0 INITIALIZE VALUES FOR UPDRAFTS AND DOWNDRAFTS
+!-----------------------------------------------------------
+ 200 CONTINUE
+ DO 230 JK=1,KLEV
+ IK=JK-1
+ IF(JK.EQ.1) IK=1
+ DO 220 JL=1,KLON
+ PTU(JL,JK)=PTENH(JL,JK)
+ PTD(JL,JK)=PTENH(JL,JK)
+ PQU(JL,JK)=PQENH(JL,JK)
+ PQD(JL,JK)=PQENH(JL,JK)
+ PLU(JL,JK)=0.
+ PUU(JL,JK)=PUEN(JL,IK)
+ PUD(JL,JK)=PUEN(JL,IK)
+ PVU(JL,JK)=PVEN(JL,IK)
+ PVD(JL,JK)=PVEN(JL,IK)
+ PMFU(JL,JK)=0.
+ PMFD(JL,JK)=0.
+ PMFUS(JL,JK)=0.
+ PMFDS(JL,JK)=0.
+ PMFUQ(JL,JK)=0.
+ PMFDQ(JL,JK)=0.
+ PDMFUP(JL,JK)=0.
+ PDMFDP(JL,JK)=0.
+ PDPMEL(JL,JK)=0.
+ PLUDE(JL,JK)=0.
+ KLAB(JL,JK)=0
+ 220 CONTINUE
+ 230 CONTINUE
+ RETURN
+ END SUBROUTINE CUINI
+
+!**********************************************
+! SUBROUTINE CUBASE
+!**********************************************
+ SUBROUTINE CUBASE &
+ (KLON, KLEV, KLEVP1, KLEVM1, PTENH, &
+ PQENH, PGEOH, PAPH, PTU, PQU, &
+ PLU, PUEN, PVEN, PUU, PVU, &
+ LDCUM, KCBOT, KLAB)
+! THIS ROUTINE CALCULATES CLOUD BASE VALUES (T AND Q)
+! FOR CUMULUS PARAMETERIZATION
+! M.TIEDTKE E.C.M.W.F. 7/86 MODIF. 12/89
+!***PURPOSE.
+! --------
+! TO PRODUCE CLOUD BASE VALUES FOR CU-PARAMETRIZATION
+!***INTERFACE
+! ---------
+! THIS ROUTINE IS CALLED FROM *CUMASTR*.
+! INPUT ARE ENVIRONM. VALUES OF T,Q,P,PHI AT HALF LEVELS.
+! IT RETURNS CLOUD BASE VALUES AND FLAGS AS FOLLOWS;
+! KLAB=1 FOR SUBCLOUD LEVELS
+! KLAB=2 FOR CONDENSATION LEVEL
+!***METHOD.
+! --------
+! LIFT SURFACE AIR DRY-ADIABATICALLY TO CLOUD BASE
+! (NON ENTRAINING PLUME,I.E.CONSTANT MASSFLUX)
+!***EXTERNALS
+! ---------
+! *CUADJTQ* FOR ADJUSTING T AND Q DUE TO CONDENSATION IN ASCENT
+! ----------------------------------------------------------------
+!-------------------------------------------------------------------
+ IMPLICIT NONE
+!-------------------------------------------------------------------
+ INTEGER KLON, KLEV, KLEVP1
+ INTEGER klevm1
+ INTEGER JL,JK,IS,IK,ICALL,IKB
+ REAL ZBUO,ZZ
+ REAL PTENH(KLON,KLEV), PQENH(KLON,KLEV), &
+ PGEOH(KLON,KLEV), PAPH(KLON,KLEVP1)
+ REAL PTU(KLON,KLEV), PQU(KLON,KLEV), &
+ PLU(KLON,KLEV)
+ REAL PUEN(KLON,KLEV), PVEN(KLON,KLEV), &
+ PUU(KLON,KLEV), PVU(KLON,KLEV)
+ REAL ZQOLD(KLON,KLEV), ZPH(KLON)
+ INTEGER KLAB(KLON,KLEV), KCBOT(KLON)
+ LOGICAL LDCUM(KLON), LOFLAG(KLON)
+!***INPUT VARIABLES:
+! PTENH [ZTENH] - Environment Temperature on half levels. (CUINI)
+! PQENH [ZQENH] - Env. specific humidity on half levels. (CUINI)
+! PGEOH [ZGEOH] - Geopotential on half levels, (MSSFLX)
+! PAPH - Pressure of half levels. (MSSFLX)
+!***VARIABLES MODIFIED BY CUBASE:
+! LDCUM - Logical denoting profiles. (CUBASE)
+! KTYPE - Convection type - 1: Penetrative (CUMASTR)
+! 2: Stratocumulus (CUMASTR)
+! 3: Mid-level (CUASC)
+! PTU - Cloud Temperature.
+! PQU - Cloud specific Humidity.
+! PLU - Cloud Liquid Water (Moisture condensed out)
+! KCBOT - Cloud Base Level. (CUBASE)
+! KLAB [ILAB] - Level Label - 1: Sub-cloud layer (CUBASE)
+!------------------------------------------------
+! 1. INITIALIZE VALUES AT LIFTING LEVEL
+!------------------------------------------------
+ 100 CONTINUE
+ DO 110 JL=1,KLON
+ KLAB(JL,KLEV)=1
+ KCBOT(JL)=KLEVM1
+ LDCUM(JL)=.FALSE.
+ PUU(JL,KLEV)=PUEN(JL,KLEV)*(PAPH(JL,KLEVP1)-PAPH(JL,KLEV))
+ PVU(JL,KLEV)=PVEN(JL,KLEV)*(PAPH(JL,KLEVP1)-PAPH(JL,KLEV))
+ 110 CONTINUE
+!-------------------------------------------------------
+! 2.0 DO ASCENT IN SUBCLOUD LAYER,
+! CHECK FOR EXISTENCE OF CONDENSATION LEVEL,
+! ADJUST T,Q AND L ACCORDINGLY IN *CUADJTQ*,
+! CHECK FOR BUOYANCY AND SET FLAGS
+!-------------------------------------------------------
+ DO 200 JK=1,KLEV
+ DO 200 JL=1,KLON
+ ZQOLD(JL,JK)=0.0
+ 200 CONTINUE
+ DO 290 JK=KLEVM1,2,-1
+ IS=0
+ DO 210 JL=1,KLON
+ IF(KLAB(JL,JK+1).EQ.1) THEN
+ IS=IS+1
+ LOFLAG(JL)=.TRUE.
+ ELSE
+ LOFLAG(JL)=.FALSE.
+ ENDIF
+ ZPH(JL)=PAPH(JL,JK)
+ 210 CONTINUE
+ IF(IS.EQ.0) GO TO 290
+ DO 220 JL=1,KLON
+ IF(LOFLAG(JL)) THEN
+ PQU(JL,JK)=PQU(JL,JK+1)
+ PTU(JL,JK)=(CPD*PTU(JL,JK+1)+PGEOH(JL,JK+1) &
+ -PGEOH(JL,JK))*RCPD
+ ZBUO=PTU(JL,JK)*(1.+VTMPC1*PQU(JL,JK))- &
+ PTENH(JL,JK)*(1.+VTMPC1*PQENH(JL,JK))+ZBUO0
+ IF(ZBUO.GT.0.) KLAB(JL,JK)=1
+ ZQOLD(JL,JK)=PQU(JL,JK)
+ END IF
+ 220 CONTINUE
+ IK=JK
+ ICALL=1
+ CALL CUADJTQ(KLON,KLEV,IK,ZPH,PTU,PQU,LOFLAG,ICALL)
+ DO 240 JL=1,KLON
+ IF(LOFLAG(JL).AND.PQU(JL,JK).NE.ZQOLD(JL,JK)) THEN
+ KLAB(JL,JK)=2
+ PLU(JL,JK)=PLU(JL,JK)+ZQOLD(JL,JK)-PQU(JL,JK)
+ ZBUO=PTU(JL,JK)*(1.+VTMPC1*PQU(JL,JK))- &
+ PTENH(JL,JK)*(1.+VTMPC1*PQENH(JL,JK))+ZBUO0
+ IF(ZBUO.GT.0.) THEN
+ KCBOT(JL)=JK
+ LDCUM(JL)=.TRUE.
+ END IF
+ END IF
+ 240 CONTINUE
+! CALCULATE AVERAGES OF U AND V FOR SUBCLOUD ARA,.
+! THE VALUES WILL BE USED TO DEFINE CLOUD BASE VALUES.
+ IF(LMFDUDV) THEN
+ DO 250 JL=1,KLON
+ IF(JK.GE.KCBOT(JL)) THEN
+ PUU(JL,KLEV)=PUU(JL,KLEV)+ &
+ PUEN(JL,JK)*(PAPH(JL,JK+1)-PAPH(JL,JK))
+ PVU(JL,KLEV)=PVU(JL,KLEV)+ &
+ PVEN(JL,JK)*(PAPH(JL,JK+1)-PAPH(JL,JK))
+ END IF
+ 250 CONTINUE
+ END IF
+ 290 CONTINUE
+ IF(LMFDUDV) THEN
+ DO 310 JL=1,KLON
+ IF(LDCUM(JL)) THEN
+ IKB=KCBOT(JL)
+ ZZ=1./(PAPH(JL,KLEVP1)-PAPH(JL,IKB))
+ PUU(JL,KLEV)=PUU(JL,KLEV)*ZZ
+ PVU(JL,KLEV)=PVU(JL,KLEV)*ZZ
+ ELSE
+ PUU(JL,KLEV)=PUEN(JL,KLEVM1)
+ PVU(JL,KLEV)=PVEN(JL,KLEVM1)
+ END IF
+ 310 CONTINUE
+ END IF
+ RETURN
+ END SUBROUTINE CUBASE
+
+!
+!**********************************************
+! SUBROUTINE CUASC_NEW
+!**********************************************
+ SUBROUTINE CUASC_NEW &
+ (KLON, KLEV, KLEVP1, KLEVM1, PTENH, &
+ PQENH, PUEN, PVEN, PTEN, PQEN, &
+ PQSEN, PGEO, PGEOH, PAP, PAPH, &
+ PQTE, PVERV, KLWMIN, LDCUM, PHCBASE,&
+ KTYPE, KLAB, PTU, PQU, PLU, &
+ PUU, PVU, PMFU, PMFUB, PENTR, &
+ PMFUS, PMFUQ, PMFUL, PLUDE, PDMFUP, &
+ KCBOT, KCTOP, KCTOP0, KCUM, ZTMST, &
+ KHMIN, PHHATT, PQSENH)
+! THIS ROUTINE DOES THE CALCULATIONS FOR CLOUD ASCENTS
+! FOR CUMULUS PARAMETERIZATION
+! M.TIEDTKE E.C.M.W.F. 7/86 MODIF. 12/89
+! Y.WANG IPRC 11/01 MODIF.
+!***PURPOSE.
+! --------
+! TO PRODUCE CLOUD ASCENTS FOR CU-PARAMETRIZATION
+! (VERTICAL PROFILES OF T,Q,L,U AND V AND CORRESPONDING
+! FLUXES AS WELL AS PRECIPITATION RATES)
+!***INTERFACE
+! ---------
+! THIS ROUTINE IS CALLED FROM *CUMASTR*.
+!***METHOD.
+! --------
+! LIFT SURFACE AIR DRY-ADIABATICALLY TO CLOUD BASE
+! AND THEN CALCULATE MOIST ASCENT FOR
+! ENTRAINING/DETRAINING PLUME.
+! ENTRAINMENT AND DETRAINMENT RATES DIFFER FOR
+! SHALLOW AND DEEP CUMULUS CONVECTION.
+! IN CASE THERE IS NO PENETRATIVE OR SHALLOW CONVECTION
+! CHECK FOR POSSIBILITY OF MID LEVEL CONVECTION
+! (CLOUD BASE VALUES CALCULATED IN *CUBASMC*)
+!***EXTERNALS
+! ---------
+! *CUADJTQ* ADJUST T AND Q DUE TO CONDENSATION IN ASCENT
+! *CUENTR_NEW* CALCULATE ENTRAINMENT/DETRAINMENT RATES
+! *CUBASMC* CALCULATE CLOUD BASE VALUES FOR MIDLEVEL CONVECTION
+!***REFERENCE
+! ---------
+! (TIEDTKE,1989)
+!***INPUT VARIABLES:
+! PTENH [ZTENH] - Environ Temperature on half levels. (CUINI)
+! PQENH [ZQENH] - Env. specific humidity on half levels. (CUINI)
+! PUEN - Environment wind u-component. (MSSFLX)
+! PVEN - Environment wind v-component. (MSSFLX)
+! PTEN - Environment Temperature. (MSSFLX)
+! PQEN - Environment Specific Humidity. (MSSFLX)
+! PQSEN - Environment Saturation Specific Humidity. (MSSFLX)
+! PGEO - Geopotential. (MSSFLX)
+! PGEOH [ZGEOH] - Geopotential on half levels, (MSSFLX)
+! PAP - Pressure in Pa. (MSSFLX)
+! PAPH - Pressure of half levels. (MSSFLX)
+! PQTE - Moisture convergence (Delta q/Delta t). (MSSFLX)
+! PVERV - Large Scale Vertical Velocity (Omega). (MSSFLX)
+! KLWMIN [ILWMIN] - Level of Minimum Omega. (CUINI)
+! KLAB [ILAB] - Level Label - 1: Sub-cloud layer.
+! 2: Condensation Level (Cloud Base)
+! PMFUB [ZMFUB] - Updraft Mass Flux at Cloud Base. (CUMASTR)
+!***VARIABLES MODIFIED BY CUASC:
+! LDCUM - Logical denoting profiles. (CUBASE)
+! KTYPE - Convection type - 1: Penetrative (CUMASTR)
+! 2: Stratocumulus (CUMASTR)
+! 3: Mid-level (CUASC)
+! PTU - Cloud Temperature.
+! PQU - Cloud specific Humidity.
+! PLU - Cloud Liquid Water (Moisture condensed out)
+! PUU [ZUU] - Cloud Momentum U-Component.
+! PVU [ZVU] - Cloud Momentum V-Component.
+! PMFU - Updraft Mass Flux.
+! PENTR [ZENTR] - Entrainment Rate. (CUMASTR ) (CUBASMC)
+! PMFUS [ZMFUS] - Updraft Flux of Dry Static Energy. (CUBASMC)
+! PMFUQ [ZMFUQ] - Updraft Flux of Specific Humidity.
+! PMFUL [ZMFUL] - Updraft Flux of Cloud Liquid Water.
+! PLUDE - Liquid Water Returned to Environment by Detrainment.
+! PDMFUP [ZMFUP] -
+! KCBOT - Cloud Base Level. (CUBASE)
+! KCTOP -
+! KCTOP0 [ICTOP0] - Estimate of Cloud Top. (CUMASTR)
+! KCUM [ICUM] -
+!-------------------------------------------------------------------
+ IMPLICIT NONE
+!-------------------------------------------------------------------
+ INTEGER KLON, KLEV, KLEVP1
+ INTEGER klevm1,kcum
+ REAL ZTMST,ZCONS2,ZDZ,ZDRODZ
+ INTEGER JL,JK,IKB,IK,IS,IKT,ICALL
+ REAL ZMFMAX,ZFAC,ZMFTEST,ZDPRHO,ZMSE,ZNEVN,ZODMAX
+ REAL ZQEEN,ZSEEN,ZSCDE,ZGA,ZDT,ZSCOD
+ REAL ZQUDE,ZQCOD, ZMFUSK, ZMFUQK,ZMFULK
+ REAL ZBUO, ZPRCON, ZLNEW, ZZ, ZDMFEU, ZDMFDU
+ REAL ZBUOYZ,ZZDMF
+ REAL PTENH(KLON,KLEV), PQENH(KLON,KLEV), &
+ PUEN(KLON,KLEV), PVEN(KLON,KLEV), &
+ PTEN(KLON,KLEV), PQEN(KLON,KLEV), &
+ PGEO(KLON,KLEV), PGEOH(KLON,KLEV), &
+ PAP(KLON,KLEV), PAPH(KLON,KLEVP1), &
+ PQSEN(KLON,KLEV), PQTE(KLON,KLEV), &
+ PVERV(KLON,KLEV), PQSENH(KLON,KLEV)
+ REAL PTU(KLON,KLEV), PQU(KLON,KLEV), &
+ PUU(KLON,KLEV), PVU(KLON,KLEV), &
+ PMFU(KLON,KLEV), ZPH(KLON), &
+ PMFUB(KLON), PENTR(KLON), &
+ PMFUS(KLON,KLEV), PMFUQ(KLON,KLEV), &
+ PLU(KLON,KLEV), PLUDE(KLON,KLEV), &
+ PMFUL(KLON,KLEV), PDMFUP(KLON,KLEV)
+ REAL ZDMFEN(KLON), ZDMFDE(KLON), &
+ ZMFUU(KLON), ZMFUV(KLON), &
+ ZPBASE(KLON), ZQOLD(KLON), &
+ PHHATT(KLON,KLEV), ZODETR(KLON,KLEV), &
+ ZOENTR(KLON,KLEV), ZBUOY(KLON)
+ REAL PHCBASE(KLON)
+ INTEGER KLWMIN(KLON), KTYPE(KLON), &
+ KLAB(KLON,KLEV), KCBOT(KLON), &
+ KCTOP(KLON), KCTOP0(KLON), &
+ KHMIN(KLON)
+ LOGICAL LDCUM(KLON), LOFLAG(KLON)
+!--------------------------------
+!* 1. SPECIFY PARAMETERS
+!--------------------------------
+ 100 CONTINUE
+ ZCONS2=1./(G*ZTMST)
+!---------------------------------
+! 2. SET DEFAULT VALUES
+!---------------------------------
+ 200 CONTINUE
+ DO 210 JL=1,KLON
+ ZMFUU(JL)=0.
+ ZMFUV(JL)=0.
+ ZBUOY(JL)=0.
+ IF(.NOT.LDCUM(JL)) KTYPE(JL)=0
+ 210 CONTINUE
+ DO 230 JK=1,KLEV
+ DO 230 JL=1,KLON
+ PLU(JL,JK)=0.
+ PMFU(JL,JK)=0.
+ PMFUS(JL,JK)=0.
+ PMFUQ(JL,JK)=0.
+ PMFUL(JL,JK)=0.
+ PLUDE(JL,JK)=0.
+ PDMFUP(JL,JK)=0.
+ ZOENTR(JL,JK)=0.
+ ZODETR(JL,JK)=0.
+ IF(.NOT.LDCUM(JL).OR.KTYPE(JL).EQ.3) KLAB(JL,JK)=0
+ IF(.NOT.LDCUM(JL).AND.PAPH(JL,JK).LT.4.E4) KCTOP0(JL)=JK
+ 230 CONTINUE
+!------------------------------------------------
+! 3.0 INITIALIZE VALUES AT LIFTING LEVEL
+!------------------------------------------------
+ DO 310 JL=1,KLON
+ KCTOP(JL)=KLEVM1
+ IF(.NOT.LDCUM(JL)) THEN
+ KCBOT(JL)=KLEVM1
+ PMFUB(JL)=0.
+ PQU(JL,KLEV)=0.
+ END IF
+ PMFU(JL,KLEV)=PMFUB(JL)
+ PMFUS(JL,KLEV)=PMFUB(JL)*(CPD*PTU(JL,KLEV)+PGEOH(JL,KLEV))
+ PMFUQ(JL,KLEV)=PMFUB(JL)*PQU(JL,KLEV)
+ IF(LMFDUDV) THEN
+ ZMFUU(JL)=PMFUB(JL)*PUU(JL,KLEV)
+ ZMFUV(JL)=PMFUB(JL)*PVU(JL,KLEV)
+ END IF
+ 310 CONTINUE
+!
+!-- 3.1 Find organized entrainment at cloud base
+!
+ DO 322 JL=1,KLON
+ LDCUM(JL)=.FALSE.
+ IF (KTYPE(JL).EQ.1) THEN
+ IKB = KCBOT(JL)
+ ZBUOY(JL)=G*((PTU(JL,IKB)-PTENH(JL,IKB))/PTENH(JL,IKB)+ &
+ 0.608*(PQU(JL,IKB)-PQENH(JL,IKB)))
+ IF (ZBUOY(JL).GT.0.) THEN
+ ZDZ = (PGEO(JL,IKB-1)-PGEO(JL,IKB))*ZRG
+ ZDRODZ = -LOG(PTEN(JL,IKB-1)/PTEN(JL,IKB))/ZDZ - &
+ G/(RD*PTENH(JL,IKB))
+ ZOENTR(JL,IKB-1)=ZBUOY(JL)*0.5/(1.+ZBUOY(JL)*ZDZ) &
+ +ZDRODZ
+ ZOENTR(JL,IKB-1) = MIN(ZOENTR(JL,IKB-1),1.E-3)
+ ZOENTR(JL,IKB-1) = MAX(ZOENTR(JL,IKB-1),0.)
+ END IF
+ END IF
+ 322 CONTINUE
+!
+!-----------------------------------------------------------------
+! 4. DO ASCENT: SUBCLOUD LAYER (KLAB=1) ,CLOUDS (KLAB=2)
+! BY DOING FIRST DRY-ADIABATIC ASCENT AND THEN
+! BY ADJUSTING T,Q AND L ACCORDINGLY IN *CUADJTQ*,
+! THEN CHECK FOR BUOYANCY AND SET FLAGS ACCORDINGLY
+!-----------------------------------------------------------------
+ 400 CONTINUE
+ DO 480 JK=KLEVM1,2,-1
+! SPECIFY CLOUD BASE VALUES FOR MIDLEVEL CONVECTION
+! IN *CUBASMC* IN CASE THERE IS NOT ALREADY CONVECTION
+! ---------------------------------------------------------------------
+ IK=JK
+ IF(LMFMID.AND.IK.LT.KLEVM1.AND.IK.GT.KLEV-13) THEN
+ CALL CUBASMC &
+ (KLON, KLEV, KLEVM1, IK, PTEN, &
+ PQEN, PQSEN, PUEN, PVEN, PVERV, &
+ PGEO, PGEOH, LDCUM, KTYPE, KLAB, &
+ PMFU, PMFUB, PENTR, KCBOT, PTU, &
+ PQU, PLU, PUU, PVU, PMFUS, &
+ PMFUQ, PMFUL, PDMFUP, ZMFUU, ZMFUV)
+ ENDIF
+ IS=0
+ DO 410 JL=1,KLON
+ ZQOLD(JL)=0.0
+ IS=IS+KLAB(JL,JK+1)
+ IF(KLAB(JL,JK+1).EQ.0) KLAB(JL,JK)=0
+ LOFLAG(JL)=KLAB(JL,JK+1).GT.0
+ ZPH(JL)=PAPH(JL,JK)
+ IF(KTYPE(JL).EQ.3.AND.JK.EQ.KCBOT(JL)) THEN
+ ZMFMAX=(PAPH(JL,JK)-PAPH(JL,JK-1))*ZCONS2
+ IF(PMFUB(JL).GT.ZMFMAX) THEN
+ ZFAC=ZMFMAX/PMFUB(JL)
+ PMFU(JL,JK+1)=PMFU(JL,JK+1)*ZFAC
+ PMFUS(JL,JK+1)=PMFUS(JL,JK+1)*ZFAC
+ PMFUQ(JL,JK+1)=PMFUQ(JL,JK+1)*ZFAC
+ ZMFUU(JL)=ZMFUU(JL)*ZFAC
+ ZMFUV(JL)=ZMFUV(JL)*ZFAC
+ PMFUB(JL)=ZMFMAX
+ END IF
+ END IF
+ 410 CONTINUE
+ IF(IS.EQ.0) GO TO 480
+!
+!* SPECIFY ENTRAINMENT RATES IN *CUENTR_NEW*
+! -------------------------------------
+ IK=JK
+ CALL CUENTR_NEW &
+ (KLON, KLEV, KLEVP1, IK, PTENH,&
+ PAPH, PAP, PGEOH, KLWMIN, LDCUM,&
+ KTYPE, KCBOT, KCTOP0, ZPBASE, PMFU, &
+ PENTR, ZDMFEN, ZDMFDE, ZODETR, KHMIN)
+!
+! DO ADIABATIC ASCENT FOR ENTRAINING/DETRAINING PLUME
+! -------------------------------------------------------
+! Do adiabatic ascent for entraining/detraining plume
+! the cloud ensemble entrains environmental values
+! in turbulent detrainment cloud ensemble values are detrained
+! in organized detrainment the dry static energy and
+! moisture that are neutral compared to the
+! environmental air are detrained
+!
+ DO 420 JL=1,KLON
+ IF(LOFLAG(JL)) THEN
+ IF(JK.LT.KCBOT(JL)) THEN
+ ZMFTEST=PMFU(JL,JK+1)+ZDMFEN(JL)-ZDMFDE(JL)
+ ZMFMAX=MIN(ZMFTEST,(PAPH(JL,JK)-PAPH(JL,JK-1))*ZCONS2)
+ ZDMFEN(JL)=MAX(ZDMFEN(JL)-MAX(ZMFTEST-ZMFMAX,0.),0.)
+ END IF
+ ZDMFDE(JL)=MIN(ZDMFDE(JL),0.75*PMFU(JL,JK+1))
+ PMFU(JL,JK)=PMFU(JL,JK+1)+ZDMFEN(JL)-ZDMFDE(JL)
+ IF (JK.LT.kcbot(jl)) THEN
+ zdprho = (pgeoh(jl,jk)-pgeoh(jl,jk+1))*zrg
+ zoentr(jl,jk) = zoentr(jl,jk)*zdprho*pmfu(jl,jk+1)
+ zmftest = pmfu(jl,jk) + zoentr(jl,jk)-zodetr(jl,jk)
+ zmfmax = MIN(zmftest,(paph(jl,jk)-paph(jl,jk-1))*zcons2)
+ zoentr(jl,jk) = MAX(zoentr(jl,jk)-MAX(zmftest-zmfmax,0.),0.)
+ END IF
+!
+! limit organized detrainment to not allowing for too deep clouds
+!
+ IF (ktype(jl).EQ.1.AND.jk.LT.kcbot(jl).AND.jk.LE.khmin(jl)) THEN
+ zmse = cpd*ptu(jl,jk+1) + alv*pqu(jl,jk+1) + pgeoh(jl,jk+1)
+ ikt = kctop0(jl)
+ znevn=(pgeoh(jl,ikt)-pgeoh(jl,jk+1))*(zmse-phhatt(jl, &
+ jk+1))*zrg
+ IF (znevn.LE.0.) znevn = 1.
+ zdprho = (pgeoh(jl,jk)-pgeoh(jl,jk+1))*zrg
+ zodmax = ((phcbase(jl)-zmse)/znevn)*zdprho*pmfu(jl,jk+1)
+ zodmax = MAX(zodmax,0.)
+ zodetr(jl,jk) = MIN(zodetr(jl,jk),zodmax)
+ END IF
+ zodetr(jl,jk) = MIN(zodetr(jl,jk),0.75*pmfu(jl,jk))
+ pmfu(jl,jk) = pmfu(jl,jk) + zoentr(jl,jk) - zodetr(jl,jk)
+ ZQEEN=PQENH(JL,JK+1)*ZDMFEN(JL)
+ zqeen=zqeen + pqenh(jl,jk+1)*zoentr(jl,jk)
+ ZSEEN=(CPD*PTENH(JL,JK+1)+PGEOH(JL,JK+1))*ZDMFEN(JL)
+ zseen=zseen+(cpd*ptenh(jl,jk+1)+pgeoh(jl,jk+1))* &
+ zoentr(jl,jk)
+ ZSCDE=(CPD*PTU(JL,JK+1)+PGEOH(JL,JK+1))*ZDMFDE(JL)
+! find moist static energy that give nonbuoyant air
+ zga = alv*pqsenh(jl,jk+1)/(rv*(ptenh(jl,jk+1)**2))
+ zdt = (plu(jl,jk+1)-0.608*(pqsenh(jl,jk+1)-pqenh(jl, &
+ jk+1)))/(1./ptenh(jl,jk+1)+0.608*zga)
+ zscod = cpd*ptenh(jl,jk+1) + pgeoh(jl,jk+1) + cpd*zdt
+ zscde = zscde + zodetr(jl,jk)*zscod
+ zqude = pqu(jl,jk+1)*zdmfde(jl)
+ zqcod = pqsenh(jl,jk+1) + zga*zdt
+ zqude = zqude + zodetr(jl,jk)*zqcod
+ plude(jl,jk) = plu(jl,jk+1)*zdmfde(jl)
+ plude(jl,jk) = plude(jl,jk)+plu(jl,jk+1)*zodetr(jl,jk)
+ zmfusk = pmfus(jl,jk+1) + zseen - zscde
+ zmfuqk = pmfuq(jl,jk+1) + zqeen - zqude
+ zmfulk = pmful(jl,jk+1) - plude(jl,jk)
+ plu(jl,jk) = zmfulk*(1./MAX(cmfcmin,pmfu(jl,jk)))
+ pqu(jl,jk) = zmfuqk*(1./MAX(cmfcmin,pmfu(jl,jk)))
+ ptu(jl,jk)=(zmfusk*(1./MAX(cmfcmin,pmfu(jl,jk)))- &
+ pgeoh(jl,jk))*rcpd
+ ptu(jl,jk) = MAX(100.,ptu(jl,jk))
+ ptu(jl,jk) = MIN(400.,ptu(jl,jk))
+ zqold(jl) = pqu(jl,jk)
+ END IF
+ 420 CONTINUE
+!* DO CORRECTIONS FOR MOIST ASCENT
+!* BY ADJUSTING T,Q AND L IN *CUADJTQ*
+!------------------------------------------------
+ IK=JK
+ ICALL=1
+!
+ CALL CUADJTQ(KLON,KLEV,IK,ZPH,PTU,PQU,LOFLAG,ICALL)
+!
+ DO 440 JL=1,KLON
+ IF(LOFLAG(JL).AND.PQU(JL,JK).NE.ZQOLD(JL)) THEN
+ KLAB(JL,JK)=2
+ PLU(JL,JK)=PLU(JL,JK)+ZQOLD(JL)-PQU(JL,JK)
+ ZBUO=PTU(JL,JK)*(1.+VTMPC1*PQU(JL,JK)-PLU(JL,JK))- &
+ PTENH(JL,JK)*(1.+VTMPC1*PQENH(JL,JK))
+ IF(KLAB(JL,JK+1).EQ.1) ZBUO=ZBUO+ZBUO0
+ IF(ZBUO.GT.0..AND.PMFU(JL,JK).GT.0.01*PMFUB(JL).AND. &
+ JK.GE.KCTOP0(JL)) THEN
+ KCTOP(JL)=JK
+ LDCUM(JL)=.TRUE.
+ IF(ZPBASE(JL)-PAPH(JL,JK).GE.ZDNOPRC) THEN
+ ZPRCON=CPRCON
+ ELSE
+ ZPRCON=0.
+ ENDIF
+ ZLNEW=PLU(JL,JK)/(1.+ZPRCON*(PGEOH(JL,JK)-PGEOH(JL,JK+1)))
+ PDMFUP(JL,JK)=MAX(0.,(PLU(JL,JK)-ZLNEW)*PMFU(JL,JK))
+ PLU(JL,JK)=ZLNEW
+ ELSE
+ KLAB(JL,JK)=0
+ PMFU(JL,JK)=0.
+ END IF
+ END IF
+ IF(LOFLAG(JL)) THEN
+ PMFUL(JL,JK)=PLU(JL,JK)*PMFU(JL,JK)
+ PMFUS(JL,JK)=(CPD*PTU(JL,JK)+PGEOH(JL,JK))*PMFU(JL,JK)
+ PMFUQ(JL,JK)=PQU(JL,JK)*PMFU(JL,JK)
+ END IF
+ 440 CONTINUE
+!
+ IF(LMFDUDV) THEN
+!
+ DO 460 JL=1,KLON
+ zdmfen(jl) = zdmfen(jl) + zoentr(jl,jk)
+ zdmfde(jl) = zdmfde(jl) + zodetr(jl,jk)
+ IF(LOFLAG(JL)) THEN
+ IF(KTYPE(JL).EQ.1.OR.KTYPE(JL).EQ.3) THEN
+ IF(ZDMFEN(JL).LE.1.E-20) THEN
+ ZZ=3.
+ ELSE
+ ZZ=2.
+ ENDIF
+ ELSE
+ IF(ZDMFEN(JL).LE.1.0E-20) THEN
+ ZZ=1.
+ ELSE
+ ZZ=0.
+ ENDIF
+ END IF
+ ZDMFEU=ZDMFEN(JL)+ZZ*ZDMFDE(JL)
+ ZDMFDU=ZDMFDE(JL)+ZZ*ZDMFDE(JL)
+ ZDMFDU=MIN(ZDMFDU,0.75*PMFU(JL,JK+1))
+ ZMFUU(JL)=ZMFUU(JL)+ &
+ ZDMFEU*PUEN(JL,JK)-ZDMFDU*PUU(JL,JK+1)
+ ZMFUV(JL)=ZMFUV(JL)+ &
+ ZDMFEU*PVEN(JL,JK)-ZDMFDU*PVU(JL,JK+1)
+ IF(PMFU(JL,JK).GT.0.) THEN
+ PUU(JL,JK)=ZMFUU(JL)*(1./PMFU(JL,JK))
+ PVU(JL,JK)=ZMFUV(JL)*(1./PMFU(JL,JK))
+ END IF
+ END IF
+ 460 CONTINUE
+!
+ END IF
+!
+! Compute organized entrainment
+! for use at next level
+!
+ DO 470 jl = 1, klon
+ IF (loflag(jl).AND.ktype(jl).EQ.1) THEN
+ zbuoyz=g*((ptu(jl,jk)-ptenh(jl,jk))/ptenh(jl,jk)+ &
+ 0.608*(pqu(jl,jk)-pqenh(jl,jk))-plu(jl,jk))
+ zbuoyz = MAX(zbuoyz,0.0)
+ zdz = (pgeo(jl,jk-1)-pgeo(jl,jk))*zrg
+ zdrodz = -LOG(pten(jl,jk-1)/pten(jl,jk))/zdz - &
+ g/(rd*ptenh(jl,jk))
+ zbuoy(jl) = zbuoy(jl) + zbuoyz*zdz
+ zoentr(jl,jk-1) = zbuoyz*0.5/(1.+zbuoy(jl))+zdrodz
+ zoentr(jl,jk-1) = MIN(zoentr(jl,jk-1),1.E-3)
+ zoentr(jl,jk-1) = MAX(zoentr(jl,jk-1),0.)
+ END IF
+ 470 CONTINUE
+!
+ 480 CONTINUE
+! -----------------------------------------------------------------
+! 5. DETERMINE CONVECTIVE FLUXES ABOVE NON-BUOYANCY LEVEL
+! -----------------------------------------------------------------
+! (NOTE: CLOUD VARIABLES LIKE T,Q AND L ARE NOT
+! AFFECTED BY DETRAINMENT AND ARE ALREADY KNOWN
+! FROM PREVIOUS CALCULATIONS ABOVE)
+ 500 CONTINUE
+ DO 510 JL=1,KLON
+ IF(KCTOP(JL).EQ.KLEVM1) LDCUM(JL)=.FALSE.
+ KCBOT(JL)=MAX(KCBOT(JL),KCTOP(JL))
+ 510 CONTINUE
+ IS=0
+ DO 520 JL=1,KLON
+ IF(LDCUM(JL)) THEN
+ IS=IS+1
+ ENDIF
+ 520 CONTINUE
+ KCUM=IS
+ IF(IS.EQ.0) GO TO 800
+ DO 530 JL=1,KLON
+ IF(LDCUM(JL)) THEN
+ JK=KCTOP(JL)-1
+ ZZDMF=CMFCTOP
+ ZDMFDE(JL)=(1.-ZZDMF)*PMFU(JL,JK+1)
+ PLUDE(JL,JK)=ZDMFDE(JL)*PLU(JL,JK+1)
+ PMFU(JL,JK)=PMFU(JL,JK+1)-ZDMFDE(JL)
+ PMFUS(JL,JK)=(CPD*PTU(JL,JK)+PGEOH(JL,JK))*PMFU(JL,JK)
+ PMFUQ(JL,JK)=PQU(JL,JK)*PMFU(JL,JK)
+ PMFUL(JL,JK)=PLU(JL,JK)*PMFU(JL,JK)
+ PLUDE(JL,JK-1)=PMFUL(JL,JK)
+ PDMFUP(JL,JK)=0.
+ END IF
+ 530 CONTINUE
+ IF(LMFDUDV) THEN
+ DO 540 JL=1,KLON
+ IF(LDCUM(JL)) THEN
+ JK=KCTOP(JL)-1
+ PUU(JL,JK)=PUU(JL,JK+1)
+ PVU(JL,JK)=PVU(JL,JK+1)
+ END IF
+ 540 CONTINUE
+ END IF
+ 800 CONTINUE
+ RETURN
+ END SUBROUTINE CUASC_NEW
+!
+
+!**********************************************
+! SUBROUTINE CUDLFS
+!**********************************************
+ SUBROUTINE CUDLFS &
+ (KLON, KLEV, KLEVP1, PTENH, PQENH, &
+ PUEN, PVEN, PGEOH, PAPH, PTU, &
+ PQU, PUU, PVU, LDCUM, KCBOT, &
+ KCTOP, PMFUB, PRFL, PTD, PQD, &
+ PUD, PVD, PMFD, PMFDS, PMFDQ, &
+ PDMFDP, KDTOP, LDDRAF)
+! THIS ROUTINE CALCULATES LEVEL OF FREE SINKING FOR
+! CUMULUS DOWNDRAFTS AND SPECIFIES T,Q,U AND V VALUES
+! M.TIEDTKE E.C.M.W.F. 12/86 MODIF. 12/89
+!***PURPOSE.
+! --------
+! TO PRODUCE LFS-VALUES FOR CUMULUS DOWNDRAFTS
+! FOR MASSFLUX CUMULUS PARAMETERIZATION
+!***INTERFACE
+! ---------
+! THIS ROUTINE IS CALLED FROM *CUMASTR*.
+! INPUT ARE ENVIRONMENTAL VALUES OF T,Q,U,V,P,PHI
+! AND UPDRAFT VALUES T,Q,U AND V AND ALSO
+! CLOUD BASE MASSFLUX AND CU-PRECIPITATION RATE.
+! IT RETURNS T,Q,U AND V VALUES AND MASSFLUX AT LFS.
+!***METHOD.
+! --------
+! CHECK FOR NEGATIVE BUOYANCY OF AIR OF EQUAL PARTS OF
+! MOIST ENVIRONMENTAL AIR AND CLOUD AIR.
+!***EXTERNALS
+! ---------
+! *CUADJTQ* FOR CALCULATING WET BULB T AND Q AT LFS
+! ----------------------------------------------------------------
+!-------------------------------------------------------------------
+ IMPLICIT NONE
+!-------------------------------------------------------------------
+ INTEGER KLON, KLEV, KLEVP1
+ INTEGER JL,KE,JK,IS,IK,ICALL
+ REAL ZTTEST, ZQTEST, ZBUO, ZMFTOP
+ REAL PTENH(KLON,KLEV), PQENH(KLON,KLEV), &
+ PUEN(KLON,KLEV), PVEN(KLON,KLEV), &
+ PGEOH(KLON,KLEV), PAPH(KLON,KLEVP1), &
+ PTU(KLON,KLEV), PQU(KLON,KLEV), &
+ PUU(KLON,KLEV), PVU(KLON,KLEV), &
+ PMFUB(KLON), PRFL(KLON)
+ REAL PTD(KLON,KLEV), PQD(KLON,KLEV), &
+ PUD(KLON,KLEV), PVD(KLON,KLEV), &
+ PMFD(KLON,KLEV), PMFDS(KLON,KLEV), &
+ PMFDQ(KLON,KLEV), PDMFDP(KLON,KLEV)
+ REAL ZTENWB(KLON,KLEV), ZQENWB(KLON,KLEV), &
+ ZCOND(KLON), ZPH(KLON)
+ INTEGER KCBOT(KLON), KCTOP(KLON), &
+ KDTOP(KLON)
+ LOGICAL LDCUM(KLON), LLo2(KLON), &
+ LDDRAF(KLON)
+!-----------------------------------------------
+! 1. SET DEFAULT VALUES FOR DOWNDRAFTS
+!-----------------------------------------------
+ 100 CONTINUE
+ DO 110 JL=1,KLON
+ LDDRAF(JL)=.FALSE.
+ KDTOP(JL)=KLEVP1
+ 110 CONTINUE
+ IF(.NOT.LMFDD) GO TO 300
+!------------------------------------------------------------
+! 2. DETERMINE LEVEL OF FREE SINKING BY
+! DOING A SCAN FROM TOP TO BASE OF CUMULUS CLOUDS
+! FOR EVERY POINT AND PROCEED AS FOLLOWS:
+! (1) DETEMINE WET BULB ENVIRONMENTAL T AND Q
+! (2) DO MIXING WITH CUMULUS CLOUD AIR
+! (3) CHECK FOR NEGATIVE BUOYANCY
+! THE ASSUMPTION IS THAT AIR OF DOWNDRAFTS IS MIXTURE
+! OF 50% CLOUD AIR + 50% ENVIRONMENTAL AIR AT WET BULB
+! TEMPERATURE (I.E. WHICH BECAME SATURATED DUE TO
+! EVAPORATION OF RAIN AND CLOUD WATER)
+!------------------------------------------------------------------
+ 200 CONTINUE
+ KE=KLEV-3
+ DO 290 JK=3,KE
+! 2.1 CALCULATE WET-BULB TEMPERATURE AND MOISTURE
+! FOR ENVIRONMENTAL AIR IN *CUADJTQ*
+! -----------------------------------------------------
+ 210 CONTINUE
+ IS=0
+ DO 212 JL=1,KLON
+ ZTENWB(JL,JK)=PTENH(JL,JK)
+ ZQENWB(JL,JK)=PQENH(JL,JK)
+ ZPH(JL)=PAPH(JL,JK)
+ LLO2(JL)=LDCUM(JL).AND.PRFL(JL).GT.0..AND..NOT.LDDRAF(JL).AND. &
+ (JK.LT.KCBOT(JL).AND.JK.GT.KCTOP(JL))
+ IF(LLO2(JL))THEN
+ IS=IS+1
+ ENDIF
+ 212 CONTINUE
+ IF(IS.EQ.0) GO TO 290
+ IK=JK
+ ICALL=2
+ CALL CUADJTQ(KLON,KLEV,IK,ZPH,ZTENWB,ZQENWB,LLO2,ICALL)
+! 2.2 DO MIXING OF CUMULUS AND ENVIRONMENTAL AIR
+! AND CHECK FOR NEGATIVE BUOYANCY.
+! THEN SET VALUES FOR DOWNDRAFT AT LFS.
+! -----------------------------------------------------
+ 220 CONTINUE
+ DO 222 JL=1,KLON
+ IF(LLO2(JL)) THEN
+ ZTTEST=0.5*(PTU(JL,JK)+ZTENWB(JL,JK))
+ ZQTEST=0.5*(PQU(JL,JK)+ZQENWB(JL,JK))
+ ZBUO=ZTTEST*(1.+VTMPC1*ZQTEST)- &
+ PTENH(JL,JK)*(1.+VTMPC1*PQENH(JL,JK))
+ ZCOND(JL)=PQENH(JL,JK)-ZQENWB(JL,JK)
+ ZMFTOP=-CMFDEPS*PMFUB(JL)
+ IF(ZBUO.LT.0..AND.PRFL(JL).GT.10.*ZMFTOP*ZCOND(JL)) THEN
+ KDTOP(JL)=JK
+ LDDRAF(JL)=.TRUE.
+ PTD(JL,JK)=ZTTEST
+ PQD(JL,JK)=ZQTEST
+ PMFD(JL,JK)=ZMFTOP
+ PMFDS(JL,JK)=PMFD(JL,JK)*(CPD*PTD(JL,JK)+PGEOH(JL,JK))
+ PMFDQ(JL,JK)=PMFD(JL,JK)*PQD(JL,JK)
+ PDMFDP(JL,JK-1)=-0.5*PMFD(JL,JK)*ZCOND(JL)
+ PRFL(JL)=PRFL(JL)+PDMFDP(JL,JK-1)
+ END IF
+ END IF
+ 222 CONTINUE
+ IF(LMFDUDV) THEN
+ DO 224 JL=1,KLON
+ IF(PMFD(JL,JK).LT.0.) THEN
+ PUD(JL,JK)=0.5*(PUU(JL,JK)+PUEN(JL,JK-1))
+ PVD(JL,JK)=0.5*(PVU(JL,JK)+PVEN(JL,JK-1))
+ END IF
+ 224 CONTINUE
+ END IF
+ 290 CONTINUE
+ 300 CONTINUE
+ RETURN
+ END SUBROUTINE CUDLFS
+!
+
+!**********************************************
+! SUBROUTINE CUDDRAF
+!**********************************************
+ SUBROUTINE CUDDRAF &
+ (KLON, KLEV, KLEVP1, PTENH, PQENH, &
+ PUEN, PVEN, PGEOH, PAPH, PRFL, &
+ LDDRAF, PTD, PQD, PUD, PVD, &
+ PMFD, PMFDS, PMFDQ, PDMFDP)
+! THIS ROUTINE CALCULATES CUMULUS DOWNDRAFT DESCENT
+! M.TIEDTKE E.C.M.W.F. 12/86 MODIF. 12/89
+!***PURPOSE.
+! --------
+! TO PRODUCE THE VERTICAL PROFILES FOR CUMULUS DOWNDRAFTS
+! (I.E. T,Q,U AND V AND FLUXES)
+!***INTERFACE
+! ---------
+! THIS ROUTINE IS CALLED FROM *CUMASTR*.
+! INPUT IS T,Q,P,PHI,U,V AT HALF LEVELS.
+! IT RETURNS FLUXES OF S,Q AND EVAPORATION RATE
+! AND U,V AT LEVELS WHERE DOWNDRAFT OCCURS
+!***METHOD.
+! --------
+! CALCULATE MOIST DESCENT FOR ENTRAINING/DETRAINING PLUME BY
+! A) MOVING AIR DRY-ADIABATICALLY TO NEXT LEVEL BELOW AND
+! B) CORRECTING FOR EVAPORATION TO OBTAIN SATURATED STATE.
+!***EXTERNALS
+! ---------
+! *CUADJTQ* FOR ADJUSTING T AND Q DUE TO EVAPORATION IN
+! SATURATED DESCENT
+!***REFERENCE
+! ---------
+! (TIEDTKE,1989)
+! ----------------------------------------------------------------
+!-------------------------------------------------------------------
+ IMPLICIT NONE
+!-------------------------------------------------------------------
+ INTEGER KLON, KLEV, KLEVP1
+ INTEGER JK,IS,JL,ITOPDE, IK, ICALL
+ REAL ZENTR,ZSEEN, ZQEEN, ZSDDE, ZQDDE,ZMFDSK, ZMFDQK
+ REAL ZBUO, ZDMFDP, ZMFDUK, ZMFDVK
+ REAL PTENH(KLON,KLEV), PQENH(KLON,KLEV), &
+ PUEN(KLON,KLEV), PVEN(KLON,KLEV), &
+ PGEOH(KLON,KLEV), PAPH(KLON,KLEVP1)
+ REAL PTD(KLON,KLEV), PQD(KLON,KLEV), &
+ PUD(KLON,KLEV), PVD(KLON,KLEV), &
+ PMFD(KLON,KLEV), PMFDS(KLON,KLEV), &
+ PMFDQ(KLON,KLEV), PDMFDP(KLON,KLEV), &
+ PRFL(KLON)
+ REAL ZDMFEN(KLON), ZDMFDE(KLON), &
+ ZCOND(KLON), ZPH(KLON)
+ LOGICAL LDDRAF(KLON), LLO2(KLON)
+!--------------------------------------------------------------
+! 1. CALCULATE MOIST DESCENT FOR CUMULUS DOWNDRAFT BY
+! (A) CALCULATING ENTRAINMENT RATES, ASSUMING
+! LINEAR DECREASE OF MASSFLUX IN PBL
+! (B) DOING MOIST DESCENT - EVAPORATIVE COOLING
+! AND MOISTENING IS CALCULATED IN *CUADJTQ*
+! (C) CHECKING FOR NEGATIVE BUOYANCY AND
+! SPECIFYING FINAL T,Q,U,V AND DOWNWARD FLUXES
+! ----------------------------------------------------------------
+ 100 CONTINUE
+ DO 180 JK=3,KLEV
+ IS=0
+ DO 110 JL=1,KLON
+ ZPH(JL)=PAPH(JL,JK)
+ LLO2(JL)=LDDRAF(JL).AND.PMFD(JL,JK-1).LT.0.
+ IF(LLO2(JL)) THEN
+ IS=IS+1
+ ENDIF
+ 110 CONTINUE
+ IF(IS.EQ.0) GO TO 180
+ DO 122 JL=1,KLON
+ IF(LLO2(JL)) THEN
+ ZENTR=ENTRDD*PMFD(JL,JK-1)*RD*PTENH(JL,JK-1)/ &
+ (G*PAPH(JL,JK-1))*(PAPH(JL,JK)-PAPH(JL,JK-1))
+ ZDMFEN(JL)=ZENTR
+ ZDMFDE(JL)=ZENTR
+ END IF
+ 122 CONTINUE
+ ITOPDE=KLEV-2
+ IF(JK.GT.ITOPDE) THEN
+ DO 124 JL=1,KLON
+ IF(LLO2(JL)) THEN
+ ZDMFEN(JL)=0.
+ ZDMFDE(JL)=PMFD(JL,ITOPDE)* &
+ (PAPH(JL,JK)-PAPH(JL,JK-1))/ &
+ (PAPH(JL,KLEVP1)-PAPH(JL,ITOPDE))
+ END IF
+ 124 CONTINUE
+ END IF
+ DO 126 JL=1,KLON
+ IF(LLO2(JL)) THEN
+ PMFD(JL,JK)=PMFD(JL,JK-1)+ZDMFEN(JL)-ZDMFDE(JL)
+ ZSEEN=(CPD*PTENH(JL,JK-1)+PGEOH(JL,JK-1))*ZDMFEN(JL)
+ ZQEEN=PQENH(JL,JK-1)*ZDMFEN(JL)
+ ZSDDE=(CPD*PTD(JL,JK-1)+PGEOH(JL,JK-1))*ZDMFDE(JL)
+ ZQDDE=PQD(JL,JK-1)*ZDMFDE(JL)
+ ZMFDSK=PMFDS(JL,JK-1)+ZSEEN-ZSDDE
+ ZMFDQK=PMFDQ(JL,JK-1)+ZQEEN-ZQDDE
+ PQD(JL,JK)=ZMFDQK*(1./MIN(-CMFCMIN,PMFD(JL,JK)))
+ PTD(JL,JK)=(ZMFDSK*(1./MIN(-CMFCMIN,PMFD(JL,JK)))- &
+ PGEOH(JL,JK))*RCPD
+ PTD(JL,JK)=MIN(400.,PTD(JL,JK))
+ PTD(JL,JK)=MAX(100.,PTD(JL,JK))
+ ZCOND(JL)=PQD(JL,JK)
+ END IF
+ 126 CONTINUE
+ IK=JK
+ ICALL=2
+ CALL CUADJTQ(KLON,KLEV,IK,ZPH,PTD,PQD,LLO2,ICALL)
+ DO 150 JL=1,KLON
+ IF(LLO2(JL)) THEN
+ ZCOND(JL)=ZCOND(JL)-PQD(JL,JK)
+ ZBUO=PTD(JL,JK)*(1.+VTMPC1*PQD(JL,JK))- &
+ PTENH(JL,JK)*(1.+VTMPC1*PQENH(JL,JK))
+ IF(ZBUO.GE.0..OR.PRFL(JL).LE.(PMFD(JL,JK)*ZCOND(JL))) THEN
+ PMFD(JL,JK)=0.
+ ENDIF
+ PMFDS(JL,JK)=(CPD*PTD(JL,JK)+PGEOH(JL,JK))*PMFD(JL,JK)
+ PMFDQ(JL,JK)=PQD(JL,JK)*PMFD(JL,JK)
+ ZDMFDP=-PMFD(JL,JK)*ZCOND(JL)
+ PDMFDP(JL,JK-1)=ZDMFDP
+ PRFL(JL)=PRFL(JL)+ZDMFDP
+ END IF
+ 150 CONTINUE
+ IF(LMFDUDV) THEN
+ DO 160 JL=1,KLON
+ IF(LLO2(JL).AND.PMFD(JL,JK).LT.0.) THEN
+ ZMFDUK=PMFD(JL,JK-1)*PUD(JL,JK-1)+ &
+ ZDMFEN(JL)*PUEN(JL,JK-1)-ZDMFDE(JL)*PUD(JL,JK-1)
+ ZMFDVK=PMFD(JL,JK-1)*PVD(JL,JK-1)+ &
+ ZDMFEN(JL)*PVEN(JL,JK-1)-ZDMFDE(JL)*PVD(JL,JK-1)
+ PUD(JL,JK)=ZMFDUK*(1./MIN(-CMFCMIN,PMFD(JL,JK)))
+ PVD(JL,JK)=ZMFDVK*(1./MIN(-CMFCMIN,PMFD(JL,JK)))
+ END IF
+ 160 CONTINUE
+ END IF
+ 180 CONTINUE
+ RETURN
+ END SUBROUTINE CUDDRAF
+!
+
+!**********************************************
+! SUBROUTINE CUFLX
+!**********************************************
+ SUBROUTINE CUFLX &
+ (KLON, KLEV, KLEVP1, PQEN, PQSEN, &
+ PTENH, PQENH, PAPH, PGEOH, KCBOT, &
+ KCTOP, KDTOP, KTYPE, LDDRAF, LDCUM, &
+ PMFU, PMFD, PMFUS, PMFDS, PMFUQ, &
+ PMFDQ, PMFUL, PLUDE, PDMFUP, PDMFDP, &
+ PRFL, PRAIN, PTEN, PSFL, PDPMEL, &
+ KTOPM2, ZTMST, sig1)
+! M.TIEDTKE E.C.M.W.F. 7/86 MODIF. 12/89
+!***PURPOSE
+! -------
+! THIS ROUTINE DOES THE FINAL CALCULATION OF CONVECTIVE
+! FLUXES IN THE CLOUD LAYER AND IN THE SUBCLOUD LAYER
+!***INTERFACE
+! ---------
+! THIS ROUTINE IS CALLED FROM *CUMASTR*.
+!***EXTERNALS
+! ---------
+! NONE
+! ----------------------------------------------------------------
+!-------------------------------------------------------------------
+ IMPLICIT NONE
+!-------------------------------------------------------------------
+ INTEGER KLON, KLEV, KLEVP1
+ INTEGER KTOPM2, ITOP, JL, JK, IKB
+ REAL ZTMST, ZCONS1, ZCONS2, ZCUCOV, ZTMELP2
+ REAL ZZP, ZFAC, ZSNMLT, ZRFL, CEVAPCU, ZRNEW
+ REAL ZRMIN, ZRFLN, ZDRFL, ZDPEVAP
+ REAL PQEN(KLON,KLEV), PQSEN(KLON,KLEV), &
+ PTENH(KLON,KLEV), PQENH(KLON,KLEV), &
+ PAPH(KLON,KLEVP1), PGEOH(KLON,KLEV)
+ REAL PMFU(KLON,KLEV), PMFD(KLON,KLEV), &
+ PMFUS(KLON,KLEV), PMFDS(KLON,KLEV), &
+ PMFUQ(KLON,KLEV), PMFDQ(KLON,KLEV), &
+ PDMFUP(KLON,KLEV), PDMFDP(KLON,KLEV), &
+ PMFUL(KLON,KLEV), PLUDE(KLON,KLEV), &
+ PRFL(KLON), PRAIN(KLON)
+ REAL PTEN(KLON,KLEV), PDPMEL(KLON,KLEV), &
+ PSFL(KLON), ZPSUBCL(KLON)
+ REAL sig1(KLEV)
+ INTEGER KCBOT(KLON), KCTOP(KLON), &
+ KDTOP(KLON), KTYPE(KLON)
+ LOGICAL LDDRAF(KLON), LDCUM(KLON)
+!* SPECIFY CONSTANTS
+ ZCONS1=CPD/(ALF*G*ZTMST)
+ ZCONS2=1./(G*ZTMST)
+ ZCUCOV=0.05
+ ZTMELP2=TMELT+2.
+!* 1.0 DETERMINE FINAL CONVECTIVE FLUXES
+!---------------------------------------------
+ 100 CONTINUE
+ ITOP=KLEV
+ DO 110 JL=1,KLON
+ PRFL(JL)=0.
+ PSFL(JL)=0.
+ PRAIN(JL)=0.
+! SWITCH OFF SHALLOW CONVECTION
+ IF(.NOT.LMFSCV.AND.KTYPE(JL).EQ.2)THEN
+ LDCUM(JL)=.FALSE.
+ LDDRAF(JL)=.FALSE.
+ ENDIF
+ ITOP=MIN(ITOP,KCTOP(JL))
+ IF(.NOT.LDCUM(JL).OR.KDTOP(JL).LT.KCTOP(JL)) LDDRAF(JL)=.FALSE.
+ IF(.NOT.LDCUM(JL)) KTYPE(JL)=0
+ 110 CONTINUE
+ KTOPM2=ITOP-2
+ DO 120 JK=KTOPM2,KLEV
+ DO 115 JL=1,KLON
+ IF(LDCUM(JL).AND.JK.GE.KCTOP(JL)-1) THEN
+ PMFUS(JL,JK)=PMFUS(JL,JK)-PMFU(JL,JK)* &
+ (CPD*PTENH(JL,JK)+PGEOH(JL,JK))
+ PMFUQ(JL,JK)=PMFUQ(JL,JK)-PMFU(JL,JK)*PQENH(JL,JK)
+ IF(LDDRAF(JL).AND.JK.GE.KDTOP(JL)) THEN
+ PMFDS(JL,JK)=PMFDS(JL,JK)-PMFD(JL,JK)* &
+ (CPD*PTENH(JL,JK)+PGEOH(JL,JK))
+ PMFDQ(JL,JK)=PMFDQ(JL,JK)-PMFD(JL,JK)*PQENH(JL,JK)
+ ELSE
+ PMFD(JL,JK)=0.
+ PMFDS(JL,JK)=0.
+ PMFDQ(JL,JK)=0.
+ PDMFDP(JL,JK-1)=0.
+ END IF
+ ELSE
+ PMFU(JL,JK)=0.
+ PMFD(JL,JK)=0.
+ PMFUS(JL,JK)=0.
+ PMFDS(JL,JK)=0.
+ PMFUQ(JL,JK)=0.
+ PMFDQ(JL,JK)=0.
+ PMFUL(JL,JK)=0.
+ PDMFUP(JL,JK-1)=0.
+ PDMFDP(JL,JK-1)=0.
+ PLUDE(JL,JK-1)=0.
+ END IF
+ 115 CONTINUE
+ 120 CONTINUE
+ DO 130 JK=KTOPM2,KLEV
+ DO 125 JL=1,KLON
+ IF(LDCUM(JL).AND.JK.GT.KCBOT(JL)) THEN
+ IKB=KCBOT(JL)
+ ZZP=((PAPH(JL,KLEVP1)-PAPH(JL,JK))/ &
+ (PAPH(JL,KLEVP1)-PAPH(JL,IKB)))
+ IF(KTYPE(JL).EQ.3) THEN
+ ZZP=ZZP**2
+ ENDIF
+ PMFU(JL,JK)=PMFU(JL,IKB)*ZZP
+ PMFUS(JL,JK)=PMFUS(JL,IKB)*ZZP
+ PMFUQ(JL,JK)=PMFUQ(JL,IKB)*ZZP
+ PMFUL(JL,JK)=PMFUL(JL,IKB)*ZZP
+ END IF
+!* 2. CALCULATE RAIN/SNOW FALL RATES
+!* CALCULATE MELTING OF SNOW
+!* CALCULATE EVAPORATION OF PRECIP
+!----------------------------------------------
+ IF(LDCUM(JL)) THEN
+ PRAIN(JL)=PRAIN(JL)+PDMFUP(JL,JK)
+ IF(PTEN(JL,JK).GT.TMELT) THEN
+ PRFL(JL)=PRFL(JL)+PDMFUP(JL,JK)+PDMFDP(JL,JK)
+ IF(PSFL(JL).GT.0..AND.PTEN(JL,JK).GT.ZTMELP2) THEN
+ ZFAC=ZCONS1*(PAPH(JL,JK+1)-PAPH(JL,JK))
+ ZSNMLT=MIN(PSFL(JL),ZFAC*(PTEN(JL,JK)-ZTMELP2))
+ PDPMEL(JL,JK)=ZSNMLT
+ PSFL(JL)=PSFL(JL)-ZSNMLT
+ PRFL(JL)=PRFL(JL)+ZSNMLT
+ END IF
+ ELSE
+ PSFL(JL)=PSFL(JL)+PDMFUP(JL,JK)+PDMFDP(JL,JK)
+ END IF
+ END IF
+ 125 CONTINUE
+ 130 CONTINUE
+ DO 230 JL=1,KLON
+ PRFL(JL)=MAX(PRFL(JL),0.)
+ PSFL(JL)=MAX(PSFL(JL),0.)
+ ZPSUBCL(JL)=PRFL(JL)+PSFL(JL)
+ 230 CONTINUE
+ DO 240 JK=KTOPM2,KLEV
+ DO 235 JL=1,KLON
+ IF(LDCUM(JL).AND.JK.GE.KCBOT(JL).AND. &
+ ZPSUBCL(JL).GT.1.E-20) THEN
+ ZRFL=ZPSUBCL(JL)
+ CEVAPCU=CEVAPCU1*SQRT(CEVAPCU2*SQRT(sig1(JK)))
+ ZRNEW=(MAX(0.,SQRT(ZRFL/ZCUCOV)- &
+ CEVAPCU*(PAPH(JL,JK+1)-PAPH(JL,JK))* &
+ MAX(0.,PQSEN(JL,JK)-PQEN(JL,JK))))**2*ZCUCOV
+ ZRMIN=ZRFL-ZCUCOV*MAX(0.,0.8*PQSEN(JL,JK)-PQEN(JL,JK)) &
+ *ZCONS2*(PAPH(JL,JK+1)-PAPH(JL,JK))
+ ZRNEW=MAX(ZRNEW,ZRMIN)
+ ZRFLN=MAX(ZRNEW,0.)
+ ZDRFL=MIN(0.,ZRFLN-ZRFL)
+ PDMFUP(JL,JK)=PDMFUP(JL,JK)+ZDRFL
+ ZPSUBCL(JL)=ZRFLN
+ END IF
+ 235 CONTINUE
+ 240 CONTINUE
+ DO 250 JL=1,KLON
+ ZDPEVAP=ZPSUBCL(JL)-(PRFL(JL)+PSFL(JL))
+ PRFL(JL)=PRFL(JL)+ZDPEVAP*PRFL(JL)* &
+ (1./MAX(1.E-20,PRFL(JL)+PSFL(JL)))
+ PSFL(JL)=PSFL(JL)+ZDPEVAP*PSFL(JL)* &
+ (1./MAX(1.E-20,PRFL(JL)+PSFL(JL)))
+ 250 CONTINUE
+ RETURN
+ END SUBROUTINE CUFLX
+!
+
+!**********************************************
+! SUBROUTINE CUDTDQ
+!**********************************************
+ SUBROUTINE CUDTDQ &
+ (KLON, KLEV, KLEVP1, KTOPM2, PAPH, &
+ LDCUM, PTEN, PTTE, PQTE, PMFUS, &
+ PMFDS, PMFUQ, PMFDQ, PMFUL, PDMFUP, &
+ PDMFDP, ZTMST, PDPMEL, PRAIN, PRFL, &
+ PSFL, PSRAIN, PSEVAP, PSHEAT, PSMELT, &
+ PRSFC, PSSFC, PAPRC, PAPRSM, PAPRS, &
+ PQEN, PQSEN, PLUDE, PCTE)
+!**** *CUDTDQ* - UPDATES T AND Q TENDENCIES, PRECIPITATION RATES
+! DOES GLOBAL DIAGNOSTICS
+! M.TIEDTKE E.C.M.W.F. 7/86 MODIF. 12/89
+!***INTERFACE.
+! ----------
+! *CUDTDQ* IS CALLED FROM *CUMASTR*
+! ----------------------------------------------------------------
+!-------------------------------------------------------------------
+ IMPLICIT NONE
+!-------------------------------------------------------------------
+ INTEGER KLON, KLEV, KLEVP1
+ INTEGER KTOPM2,JL, JK
+ REAL ZTMST, PSRAIN, PSEVAP, PSHEAT, PSMELT, ZDIAGT, ZDIAGW
+ REAL ZALV, RHK, RHCOE, PLDFD, ZDTDT, ZDQDT
+ REAL PTTE(KLON,KLEV), PQTE(KLON,KLEV), &
+ PTEN(KLON,KLEV), PLUDE(KLON,KLEV), &
+ PGEO(KLON,KLEV), PAPH(KLON,KLEVP1), &
+ PAPRC(KLON), PAPRS(KLON), &
+ PAPRSM(KLON), PCTE(KLON,KLEV), &
+ PRSFC(KLON), PSSFC(KLON)
+ REAL PMFUS(KLON,KLEV), PMFDS(KLON,KLEV), &
+ PMFUQ(KLON,KLEV), PMFDQ(KLON,KLEV), &
+ PMFUL(KLON,KLEV), PQSEN(KLON,KLEV), &
+ PDMFUP(KLON,KLEV), PDMFDP(KLON,KLEV),&
+ PRFL(KLON), PRAIN(KLON), &
+ PQEN(KLON,KLEV)
+ REAL PDPMEL(KLON,KLEV), PSFL(KLON)
+ REAL ZSHEAT(KLON), ZMELT(KLON)
+ LOGICAL LDCUM(KLON)
+!--------------------------------
+!* 1.0 SPECIFY PARAMETERS
+!--------------------------------
+ 100 CONTINUE
+ ZDIAGT=ZTMST
+ ZDIAGW=ZDIAGT/RHOH2O
+!--------------------------------------------------
+!* 2.0 INCREMENTATION OF T AND Q TENDENCIES
+!--------------------------------------------------
+ 200 CONTINUE
+ DO 210 JL=1,KLON
+ ZMELT(JL)=0.
+ ZSHEAT(JL)=0.
+ 210 CONTINUE
+ DO 250 JK=KTOPM2,KLEV
+ IF(JK.LT.KLEV) THEN
+ DO 220 JL=1,KLON
+ IF(LDCUM(JL)) THEN
+ IF(PTEN(JL,JK).GT.TMELT) THEN
+ ZALV=ALV
+ ELSE
+ ZALV=ALS
+ ENDIF
+ RHK=MIN(1.0,PQEN(JL,JK)/PQSEN(JL,JK))
+ RHCOE=MAX(0.0,(RHK-RHC)/(RHM-RHC))
+ pldfd=MAX(0.0,RHCOE*fdbk*PLUDE(JL,JK))
+ ZDTDT=(G/(PAPH(JL,JK+1)-PAPH(JL,JK)))*RCPD* &
+ (PMFUS(JL,JK+1)-PMFUS(JL,JK)+ &
+ PMFDS(JL,JK+1)-PMFDS(JL,JK)-ALF*PDPMEL(JL,JK) &
+ -ZALV*(PMFUL(JL,JK+1)-PMFUL(JL,JK)-pldfd- &
+ (PDMFUP(JL,JK)+PDMFDP(JL,JK))))
+ PTTE(JL,JK)=PTTE(JL,JK)+ZDTDT
+ ZDQDT=(G/(PAPH(JL,JK+1)-PAPH(JL,JK)))*&
+ (PMFUQ(JL,JK+1)-PMFUQ(JL,JK)+ &
+ PMFDQ(JL,JK+1)-PMFDQ(JL,JK)+ &
+ PMFUL(JL,JK+1)-PMFUL(JL,JK)-pldfd- &
+ (PDMFUP(JL,JK)+PDMFDP(JL,JK)))
+ PQTE(JL,JK)=PQTE(JL,JK)+ZDQDT
+ PCTE(JL,JK)=(G/(PAPH(JL,JK+1)-PAPH(JL,JK)))*pldfd
+ ZSHEAT(JL)=ZSHEAT(JL)+ZALV*(PDMFUP(JL,JK)+PDMFDP(JL,JK))
+ ZMELT(JL)=ZMELT(JL)+PDPMEL(JL,JK)
+ END IF
+ 220 CONTINUE
+ ELSE
+ DO 230 JL=1,KLON
+ IF(LDCUM(JL)) THEN
+ IF(PTEN(JL,JK).GT.TMELT) THEN
+ ZALV=ALV
+ ELSE
+ ZALV=ALS
+ ENDIF
+ RHK=MIN(1.0,PQEN(JL,JK)/PQSEN(JL,JK))
+ RHCOE=MAX(0.0,(RHK-RHC)/(RHM-RHC))
+ pldfd=MAX(0.0,RHCOE*fdbk*PLUDE(JL,JK))
+ ZDTDT=-(G/(PAPH(JL,JK+1)-PAPH(JL,JK)))*RCPD* &
+ (PMFUS(JL,JK)+PMFDS(JL,JK)+ALF*PDPMEL(JL,JK)-ZALV* &
+ (PMFUL(JL,JK)+PDMFUP(JL,JK)+PDMFDP(JL,JK)+pldfd))
+ PTTE(JL,JK)=PTTE(JL,JK)+ZDTDT
+ ZDQDT=-(G/(PAPH(JL,JK+1)-PAPH(JL,JK)))* &
+ (PMFUQ(JL,JK)+PMFDQ(JL,JK)+pldfd+ &
+ (PMFUL(JL,JK)+PDMFUP(JL,JK)+PDMFDP(JL,JK)))
+ PQTE(JL,JK)=PQTE(JL,JK)+ZDQDT
+ PCTE(JL,JK)=(G/(PAPH(JL,JK+1)-PAPH(JL,JK)))*pldfd
+ ZSHEAT(JL)=ZSHEAT(JL)+ZALV*(PDMFUP(JL,JK)+PDMFDP(JL,JK))
+ ZMELT(JL)=ZMELT(JL)+PDPMEL(JL,JK)
+ END IF
+ 230 CONTINUE
+ END IF
+ 250 CONTINUE
+!---------------------------------------------------------
+! 3. UPDATE SURFACE FIELDS AND DO GLOBAL BUDGETS
+!---------------------------------------------------------
+ 300 CONTINUE
+ DO 310 JL=1,KLON
+ PRSFC(JL)=PRFL(JL)
+ PSSFC(JL)=PSFL(JL)
+ PAPRC(JL)=PAPRC(JL)+ZDIAGW*(PRFL(JL)+PSFL(JL))
+ PAPRS(JL)=PAPRSM(JL)+ZDIAGW*PSFL(JL)
+ PSHEAT=PSHEAT+ZSHEAT(JL)
+ PSRAIN=PSRAIN+PRAIN(JL)
+ PSEVAP=PSEVAP-(PRFL(JL)+PSFL(JL))
+ PSMELT=PSMELT+ZMELT(JL)
+ 310 CONTINUE
+ PSEVAP=PSEVAP+PSRAIN
+ RETURN
+ END SUBROUTINE CUDTDQ
+
+!
+!**********************************************
+! SUBROUTINE CUDUDV
+!**********************************************
+ SUBROUTINE CUDUDV &
+ (KLON, KLEV, KLEVP1, KTOPM2, KTYPE, &
+ KCBOT, PAPH, LDCUM, PUEN, PVEN, &
+ PVOM, PVOL, PUU, PUD, PVU, &
+ PVD, PMFU, PMFD, PSDISS)
+!**** *CUDUDV* - UPDATES U AND V TENDENCIES,
+! DOES GLOBAL DIAGNOSTIC OF DISSIPATION
+! M.TIEDTKE E.C.M.W.F. 7/86 MODIF. 12/89
+!***INTERFACE.
+! ----------
+! *CUDUDV* IS CALLED FROM *CUMASTR*
+! ----------------------------------------------------------------
+!-------------------------------------------------------------------
+ IMPLICIT NONE
+!-------------------------------------------------------------------
+ INTEGER KLON, KLEV, KLEVP1
+ INTEGER KTOPM2, JK, IK, JL, IKB
+ REAL PSDISS,ZZP, ZDUDT ,ZDVDT, ZSUM
+ REAL PUEN(KLON,KLEV), PVEN(KLON,KLEV), &
+ PVOL(KLON,KLEV), PVOM(KLON,KLEV), &
+ PAPH(KLON,KLEVP1)
+ REAL PUU(KLON,KLEV), PUD(KLON,KLEV), &
+ PVU(KLON,KLEV), PVD(KLON,KLEV), &
+ PMFU(KLON,KLEV), PMFD(KLON,KLEV)
+ REAL ZMFUU(KLON,KLEV), ZMFDU(KLON,KLEV), &
+ ZMFUV(KLON,KLEV), ZMFDV(KLON,KLEV), &
+ ZDISS(KLON)
+ INTEGER KTYPE(KLON), KCBOT(KLON)
+ LOGICAL LDCUM(KLON)
+!------------------------------------------------------------
+!* 1.0 CALCULATE FLUXES AND UPDATE U AND V TENDENCIES
+! -----------------------------------------------------------
+ 100 CONTINUE
+ DO 120 JK=KTOPM2,KLEV
+ IK=JK-1
+ DO 110 JL=1,KLON
+ IF(LDCUM(JL)) THEN
+ ZMFUU(JL,JK)=PMFU(JL,JK)*(PUU(JL,JK)-PUEN(JL,IK))
+ ZMFUV(JL,JK)=PMFU(JL,JK)*(PVU(JL,JK)-PVEN(JL,IK))
+ ZMFDU(JL,JK)=PMFD(JL,JK)*(PUD(JL,JK)-PUEN(JL,IK))
+ ZMFDV(JL,JK)=PMFD(JL,JK)*(PVD(JL,JK)-PVEN(JL,IK))
+ END IF
+ 110 CONTINUE
+ 120 CONTINUE
+ DO 140 JK=KTOPM2,KLEV
+ DO 130 JL=1,KLON
+ IF(LDCUM(JL).AND.JK.GT.KCBOT(JL)) THEN
+ IKB=KCBOT(JL)
+ ZZP=((PAPH(JL,KLEVP1)-PAPH(JL,JK))/ &
+ (PAPH(JL,KLEVP1)-PAPH(JL,IKB)))
+ IF(KTYPE(JL).EQ.3) THEN
+ ZZP=ZZP**2
+ ENDIF
+ ZMFUU(JL,JK)=ZMFUU(JL,IKB)*ZZP
+ ZMFUV(JL,JK)=ZMFUV(JL,IKB)*ZZP
+ ZMFDU(JL,JK)=ZMFDU(JL,IKB)*ZZP
+ ZMFDV(JL,JK)=ZMFDV(JL,IKB)*ZZP
+ END IF
+ 130 CONTINUE
+ 140 CONTINUE
+ DO 150 JL=1,KLON
+ ZDISS(JL)=0.
+ 150 CONTINUE
+ DO 190 JK=KTOPM2,KLEV
+ IF(JK.LT.KLEV) THEN
+ DO 160 JL=1,KLON
+ IF(LDCUM(JL)) THEN
+ ZDUDT=(G/(PAPH(JL,JK+1)-PAPH(JL,JK)))* &
+ (ZMFUU(JL,JK+1)-ZMFUU(JL,JK)+ &
+ ZMFDU(JL,JK+1)-ZMFDU(JL,JK))
+ ZDVDT=(G/(PAPH(JL,JK+1)-PAPH(JL,JK)))* &
+ (ZMFUV(JL,JK+1)-ZMFUV(JL,JK)+ &
+ ZMFDV(JL,JK+1)-ZMFDV(JL,JK))
+ ZDISS(JL)=ZDISS(JL)+ &
+ PUEN(JL,JK)*(ZMFUU(JL,JK+1)-ZMFUU(JL,JK)+ &
+ ZMFDU(JL,JK+1)-ZMFDU(JL,JK))+ &
+ PVEN(JL,JK)*(ZMFUV(JL,JK+1)-ZMFUV(JL,JK)+ &
+ ZMFDV(JL,JK+1)-ZMFDV(JL,JK))
+ PVOM(JL,JK)=PVOM(JL,JK)+ZDUDT
+ PVOL(JL,JK)=PVOL(JL,JK)+ZDVDT
+ END IF
+ 160 CONTINUE
+ ELSE
+ DO 170 JL=1,KLON
+ IF(LDCUM(JL)) THEN
+ ZDUDT=-(G/(PAPH(JL,JK+1)-PAPH(JL,JK)))* &
+ (ZMFUU(JL,JK)+ZMFDU(JL,JK))
+ ZDVDT=-(G/(PAPH(JL,JK+1)-PAPH(JL,JK)))* &
+ (ZMFUV(JL,JK)+ZMFDV(JL,JK))
+ ZDISS(JL)=ZDISS(JL)- &
+ (PUEN(JL,JK)*(ZMFUU(JL,JK)+ZMFDU(JL,JK))+ &
+ PVEN(JL,JK)*(ZMFUV(JL,JK)+ZMFDV(JL,JK)))
+ PVOM(JL,JK)=PVOM(JL,JK)+ZDUDT
+ PVOL(JL,JK)=PVOL(JL,JK)+ZDVDT
+ END IF
+ 170 CONTINUE
+ END IF
+ 190 CONTINUE
+ ZSUM=SSUM(KLON,ZDISS(1),1)
+ PSDISS=PSDISS+ZSUM
+ RETURN
+ END SUBROUTINE CUDUDV
+!
+
+!#################################################################
+!
+! LEVEL 4 SUBROUTINES
+!
+!#################################################################
+!**************************************************************
+! SUBROUTINE CUBASMC
+!**************************************************************
+ SUBROUTINE CUBASMC &
+ (KLON, KLEV, KLEVM1, KK, PTEN, &
+ PQEN, PQSEN, PUEN, PVEN, PVERV, &
+ PGEO, PGEOH, LDCUM, KTYPE, KLAB, &
+ PMFU, PMFUB, PENTR, KCBOT, PTU, &
+ PQU, PLU, PUU, PVU, PMFUS, &
+ PMFUQ, PMFUL, PDMFUP, PMFUU, PMFUV)
+! M.TIEDTKE E.C.M.W.F. 12/89
+!***PURPOSE.
+! --------
+! THIS ROUTINE CALCULATES CLOUD BASE VALUES
+! FOR MIDLEVEL CONVECTION
+!***INTERFACE
+! ---------
+! THIS ROUTINE IS CALLED FROM *CUASC*.
+! INPUT ARE ENVIRONMENTAL VALUES T,Q ETC
+! IT RETURNS CLOUDBASE VALUES FOR MIDLEVEL CONVECTION
+!***METHOD.
+! -------
+! S. TIEDTKE (1989)
+!***EXTERNALS
+! ---------
+! NONE
+! ----------------------------------------------------------------
+!-------------------------------------------------------------------
+ IMPLICIT NONE
+!-------------------------------------------------------------------
+ INTEGER KLON, KLEV, KLEVP1
+ INTEGER KLEVM1,KK, JL
+ REAL zzzmb
+ REAL PTEN(KLON,KLEV), PQEN(KLON,KLEV), &
+ PUEN(KLON,KLEV), PVEN(KLON,KLEV), &
+ PQSEN(KLON,KLEV), PVERV(KLON,KLEV), &
+ PGEO(KLON,KLEV), PGEOH(KLON,KLEV)
+ REAL PTU(KLON,KLEV), PQU(KLON,KLEV), &
+ PUU(KLON,KLEV), PVU(KLON,KLEV), &
+ PLU(KLON,KLEV), PMFU(KLON,KLEV), &
+ PMFUB(KLON), PENTR(KLON), &
+ PMFUS(KLON,KLEV), PMFUQ(KLON,KLEV), &
+ PMFUL(KLON,KLEV), PDMFUP(KLON,KLEV), &
+ PMFUU(KLON), PMFUV(KLON)
+ INTEGER KTYPE(KLON), KCBOT(KLON), &
+ KLAB(KLON,KLEV)
+ LOGICAL LDCUM(KLON)
+!--------------------------------------------------------
+!* 1. CALCULATE ENTRAINMENT AND DETRAINMENT RATES
+! -------------------------------------------------------
+ 100 CONTINUE
+ DO 150 JL=1,KLON
+ IF( .NOT. LDCUM(JL).AND.KLAB(JL,KK+1).EQ.0.0.AND. &
+ PQEN(JL,KK).GT.0.90*PQSEN(JL,KK)) THEN
+ PTU(JL,KK+1)=(CPD*PTEN(JL,KK)+PGEO(JL,KK)-PGEOH(JL,KK+1)) &
+ *RCPD
+ PQU(JL,KK+1)=PQEN(JL,KK)
+ PLU(JL,KK+1)=0.
+ ZZZMB=MAX(CMFCMIN,-PVERV(JL,KK)/G)
+ ZZZMB=MIN(ZZZMB,CMFCMAX)
+ PMFUB(JL)=ZZZMB
+ PMFU(JL,KK+1)=PMFUB(JL)
+ PMFUS(JL,KK+1)=PMFUB(JL)*(CPD*PTU(JL,KK+1)+PGEOH(JL,KK+1))
+ PMFUQ(JL,KK+1)=PMFUB(JL)*PQU(JL,KK+1)
+ PMFUL(JL,KK+1)=0.
+ PDMFUP(JL,KK+1)=0.
+ KCBOT(JL)=KK
+ KLAB(JL,KK+1)=1
+ KTYPE(JL)=3
+ PENTR(JL)=ENTRMID
+ IF(LMFDUDV) THEN
+ PUU(JL,KK+1)=PUEN(JL,KK)
+ PVU(JL,KK+1)=PVEN(JL,KK)
+ PMFUU(JL)=PMFUB(JL)*PUU(JL,KK+1)
+ PMFUV(JL)=PMFUB(JL)*PVU(JL,KK+1)
+ END IF
+ END IF
+ 150 CONTINUE
+ RETURN
+ END SUBROUTINE CUBASMC
+
+!
+!**************************************************************
+! SUBROUTINE CUADJTQ
+!**************************************************************
+ SUBROUTINE CUADJTQ(KLON,KLEV,KK,PP,PT,PQ,LDFLAG,KCALL)
+! M.TIEDTKE E.C.M.W.F. 12/89
+! D.SALMOND CRAY(UK)) 12/8/91
+!***PURPOSE.
+! --------
+! TO PRODUCE T,Q AND L VALUES FOR CLOUD ASCENT
+!***INTERFACE
+! ---------
+! THIS ROUTINE IS CALLED FROM SUBROUTINES:
+! *CUBASE* (T AND Q AT CONDENSTION LEVEL)
+! *CUASC* (T AND Q AT CLOUD LEVELS)
+! *CUINI* (ENVIRONMENTAL T AND QS VALUES AT HALF LEVELS)
+! INPUT ARE UNADJUSTED T AND Q VALUES,
+! IT RETURNS ADJUSTED VALUES OF T AND Q
+! NOTE: INPUT PARAMETER KCALL DEFINES CALCULATION AS
+! KCALL=0 ENV. T AND QS IN*CUINI*
+! KCALL=1 CONDENSATION IN UPDRAFTS (E.G. CUBASE, CUASC)
+! KCALL=2 EVAPORATION IN DOWNDRAFTS (E.G. CUDLFS,CUDDRAF
+!***EXTERNALS
+! ---------
+! 3 LOOKUP TABLES ( TLUCUA, TLUCUB, TLUCUC )
+! FOR CONDENSATION CALCULATIONS.
+! THE TABLES ARE INITIALISED IN *SETPHYS*.
+! ----------------------------------------------------------------
+!-------------------------------------------------------------------
+ IMPLICIT NONE
+!-------------------------------------------------------------------
+ INTEGER KLON, KLEV
+ INTEGER KK, KCALL, ISUM, JL
+ REAL ZQSAT, ZCOR, ZCOND1, TT
+ REAL PT(KLON,KLEV), PQ(KLON,KLEV), &
+ ZCOND(KLON), ZQP(KLON), &
+ PP(KLON)
+ LOGICAL LDFLAG(KLON)
+!------------------------------------------------------------------
+! 2. CALCULATE CONDENSATION AND ADJUST T AND Q ACCORDINGLY
+!------------------------------------------------------------------
+ 200 CONTINUE
+ IF (KCALL.EQ.1 ) THEN
+ ISUM=0
+ DO 210 JL=1,KLON
+ ZCOND(JL)=0.
+ IF(LDFLAG(JL)) THEN
+ ZQP(JL)=1./PP(JL)
+ TT=PT(JL,KK)
+ ZQSAT=TLUCUA(TT)*ZQP(JL)
+ ZQSAT=MIN(0.5,ZQSAT)
+ ZCOR=1./(1.-VTMPC1*ZQSAT)
+ ZQSAT=ZQSAT*ZCOR
+ ZCOND(JL)=(PQ(JL,KK)-ZQSAT)/(1.+ZQSAT*ZCOR*TLUCUB(TT))
+ ZCOND(JL)=MAX(ZCOND(JL),0.)
+ PT(JL,KK)=PT(JL,KK)+TLUCUC(TT)*ZCOND(JL)
+ PQ(JL,KK)=PQ(JL,KK)-ZCOND(JL)
+ IF(ZCOND(JL).NE.0.0) ISUM=ISUM+1
+ END IF
+ 210 CONTINUE
+ IF(ISUM.EQ.0) GO TO 230
+ DO 220 JL=1,KLON
+ IF(LDFLAG(JL).AND.ZCOND(JL).NE.0.) THEN
+ TT=PT(JL,KK)
+ ZQSAT=TLUCUA(TT)*ZQP(JL)
+ ZQSAT=MIN(0.5,ZQSAT)
+ ZCOR=1./(1.-VTMPC1*ZQSAT)
+ ZQSAT=ZQSAT*ZCOR
+ ZCOND1=(PQ(JL,KK)-ZQSAT)/(1.+ZQSAT*ZCOR*TLUCUB(TT))
+ PT(JL,KK)=PT(JL,KK)+TLUCUC(TT)*ZCOND1
+ PQ(JL,KK)=PQ(JL,KK)-ZCOND1
+ END IF
+ 220 CONTINUE
+ 230 CONTINUE
+ END IF
+ IF(KCALL.EQ.2) THEN
+ ISUM=0
+ DO 310 JL=1,KLON
+ ZCOND(JL)=0.
+ IF(LDFLAG(JL)) THEN
+ TT=PT(JL,KK)
+ ZQP(JL)=1./PP(JL)
+ ZQSAT=TLUCUA(TT)*ZQP(JL)
+ ZQSAT=MIN(0.5,ZQSAT)
+ ZCOR=1./(1.-VTMPC1*ZQSAT)
+ ZQSAT=ZQSAT*ZCOR
+ ZCOND(JL)=(PQ(JL,KK)-ZQSAT)/(1.+ZQSAT*ZCOR*TLUCUB(TT))
+ ZCOND(JL)=MIN(ZCOND(JL),0.)
+ PT(JL,KK)=PT(JL,KK)+TLUCUC(TT)*ZCOND(JL)
+ PQ(JL,KK)=PQ(JL,KK)-ZCOND(JL)
+ IF(ZCOND(JL).NE.0.0) ISUM=ISUM+1
+ END IF
+ 310 CONTINUE
+ IF(ISUM.EQ.0) GO TO 330
+ DO 320 JL=1,KLON
+ IF(LDFLAG(JL).AND.ZCOND(JL).NE.0.) THEN
+ TT=PT(JL,KK)
+ ZQSAT=TLUCUA(TT)*ZQP(JL)
+ ZQSAT=MIN(0.5,ZQSAT)
+ ZCOR=1./(1.-VTMPC1*ZQSAT)
+ ZQSAT=ZQSAT*ZCOR
+ ZCOND1=(PQ(JL,KK)-ZQSAT)/(1.+ZQSAT*ZCOR*TLUCUB(TT))
+ PT(JL,KK)=PT(JL,KK)+TLUCUC(TT)*ZCOND1
+ PQ(JL,KK)=PQ(JL,KK)-ZCOND1
+ END IF
+ 320 CONTINUE
+ 330 CONTINUE
+ END IF
+ IF(KCALL.EQ.0) THEN
+ ISUM=0
+ DO 410 JL=1,KLON
+ TT=PT(JL,KK)
+ ZQP(JL)=1./PP(JL)
+ ZQSAT=TLUCUA(TT)*ZQP(JL)
+ ZQSAT=MIN(0.5,ZQSAT)
+ ZCOR=1./(1.-VTMPC1*ZQSAT)
+ ZQSAT=ZQSAT*ZCOR
+ ZCOND(JL)=(PQ(JL,KK)-ZQSAT)/(1.+ZQSAT*ZCOR*TLUCUB(TT))
+ PT(JL,KK)=PT(JL,KK)+TLUCUC(TT)*ZCOND(JL)
+ PQ(JL,KK)=PQ(JL,KK)-ZCOND(JL)
+ IF(ZCOND(JL).NE.0.0) ISUM=ISUM+1
+ 410 CONTINUE
+ IF(ISUM.EQ.0) GO TO 430
+ DO 420 JL=1,KLON
+ TT=PT(JL,KK)
+ ZQSAT=TLUCUA(TT)*ZQP(JL)
+ ZQSAT=MIN(0.5,ZQSAT)
+ ZCOR=1./(1.-VTMPC1*ZQSAT)
+ ZQSAT=ZQSAT*ZCOR
+ ZCOND1=(PQ(JL,KK)-ZQSAT)/(1.+ZQSAT*ZCOR*TLUCUB(TT))
+ PT(JL,KK)=PT(JL,KK)+TLUCUC(TT)*ZCOND1
+ PQ(JL,KK)=PQ(JL,KK)-ZCOND1
+ 420 CONTINUE
+ 430 CONTINUE
+ END IF
+ IF(KCALL.EQ.4) THEN
+ DO 510 JL=1,KLON
+ TT=PT(JL,KK)
+ ZQP(JL)=1./PP(JL)
+ ZQSAT=TLUCUA(TT)*ZQP(JL)
+ ZQSAT=MIN(0.5,ZQSAT)
+ ZCOR=1./(1.-VTMPC1*ZQSAT)
+ ZQSAT=ZQSAT*ZCOR
+ ZCOND(JL)=(PQ(JL,KK)-ZQSAT)/(1.+ZQSAT*ZCOR*TLUCUB(TT))
+ PT(JL,KK)=PT(JL,KK)+TLUCUC(TT)*ZCOND(JL)
+ PQ(JL,KK)=PQ(JL,KK)-ZCOND(JL)
+ 510 CONTINUE
+ DO 520 JL=1,KLON
+ TT=PT(JL,KK)
+ ZQSAT=TLUCUA(TT)*ZQP(JL)
+ ZQSAT=MIN(0.5,ZQSAT)
+ ZCOR=1./(1.-VTMPC1*ZQSAT)
+ ZQSAT=ZQSAT*ZCOR
+ ZCOND1=(PQ(JL,KK)-ZQSAT)/(1.+ZQSAT*ZCOR*TLUCUB(TT))
+ PT(JL,KK)=PT(JL,KK)+TLUCUC(TT)*ZCOND1
+ PQ(JL,KK)=PQ(JL,KK)-ZCOND1
+ 520 CONTINUE
+ END IF
+ RETURN
+ END SUBROUTINE CUADJTQ
+
+!
+!**********************************************************
+! SUBROUTINE CUENTR_NEW
+!**********************************************************
+ SUBROUTINE CUENTR_NEW &
+ (KLON, KLEV, KLEVP1, KK, PTENH, &
+ PAPH, PAP, PGEOH, KLWMIN, LDCUM, &
+ KTYPE, KCBOT, KCTOP0, ZPBASE, PMFU, &
+ PENTR, ZDMFEN, ZDMFDE, ZODETR, KHMIN)
+! M.TIEDTKE E.C.M.W.F. 12/89
+! Y.WANG IPRC 11/01
+!***PURPOSE.
+! --------
+! THIS ROUTINE CALCULATES ENTRAINMENT/DETRAINMENT RATES
+! FOR UPDRAFTS IN CUMULUS PARAMETERIZATION
+!***INTERFACE
+! ---------
+! THIS ROUTINE IS CALLED FROM *CUASC*.
+! INPUT ARE ENVIRONMENTAL VALUES T,Q ETC
+! AND UPDRAFT VALUES T,Q ETC
+! IT RETURNS ENTRAINMENT/DETRAINMENT RATES
+!***METHOD.
+! --------
+! S. TIEDTKE (1989), NORDENG(1996)
+!***EXTERNALS
+! ---------
+! NONE
+! ----------------------------------------------------------------
+!-------------------------------------------------------------------
+ IMPLICIT NONE
+!-------------------------------------------------------------------
+ INTEGER KLON, KLEV, KLEVP1
+ INTEGER KK, JL, IKLWMIN,IKB, IKT, IKH
+ REAL ZRRHO, ZDPRHO, ZPMID, ZENTR, ZZMZK, ZTMZK, ARG, ZORGDE
+ REAL PTENH(KLON,KLEV), &
+ PAP(KLON,KLEV), PAPH(KLON,KLEVP1), &
+ PMFU(KLON,KLEV), PGEOH(KLON,KLEV), &
+ PENTR(KLON), ZPBASE(KLON), &
+ ZDMFEN(KLON), ZDMFDE(KLON), &
+ ZODETR(KLON,KLEV)
+ INTEGER KLWMIN(KLON), KTYPE(KLON), &
+ KCBOT(KLON), KCTOP0(KLON), &
+ KHMIN(KLON)
+ LOGICAL LDCUM(KLON),LLO1,LLO2
+!---------------------------------------------------------
+!* 1. CALCULATE ENTRAINMENT AND DETRAINMENT RATES
+!---------------------------------------------------------
+!* 1.1 SPECIFY ENTRAINMENT RATES FOR SHALLOW CLOUDS
+!----------------------------------------------------------
+!* 1.2 SPECIFY ENTRAINMENT RATES FOR DEEP CLOUDS
+!-------------------------------------------------------
+ DO jl = 1, klon
+ zpbase(jl) = paph(jl,kcbot(jl))
+ zrrho = (rd*ptenh(jl,kk+1))/paph(jl,kk+1)
+ zdprho = (paph(jl,kk+1)-paph(jl,kk))*zrg
+ zpmid = 0.5*(zpbase(jl)+paph(jl,kctop0(jl)))
+ zentr = pentr(jl)*pmfu(jl,kk+1)*zdprho*zrrho
+ llo1 = kk.LT.kcbot(jl).AND.ldcum(jl)
+ if(llo1) then
+ zdmfde(jl) = zentr
+ else
+ zdmfde(jl) = 0.0
+ endif
+ llo2 = llo1.AND.ktype(jl).EQ.2.AND.((zpbase(jl)-paph(jl,kk)) &
+ .LT.ZDNOPRC.OR.paph(jl,kk).GT.zpmid)
+ if(llo2) then
+ zdmfen(jl) = zentr
+ else
+ zdmfen(jl) = 0.0
+ endif
+ iklwmin = MAX(klwmin(jl),kctop0(jl)+2)
+ llo2 = llo1.AND.ktype(jl).EQ.3.AND.(kk.GE.iklwmin.OR.pap(jl,kk) &
+ .GT.zpmid)
+ IF (llo2) zdmfen(jl) = zentr
+ llo2 = llo1.AND.ktype(jl).EQ.1
+! Turbulent entrainment
+ IF (llo2) zdmfen(jl) = zentr
+! Organized detrainment, detrainment starts at khmin
+ ikb = kcbot(jl)
+ zodetr(jl,kk) = 0.
+ IF (llo2.AND.kk.LE.khmin(jl).AND.kk.GE.kctop0(jl)) THEN
+ ikt = kctop0(jl)
+ ikh = khmin(jl)
+ IF (ikh.GT.ikt) THEN
+ zzmzk = -(pgeoh(jl,ikh)-pgeoh(jl,kk))*zrg
+ ztmzk = -(pgeoh(jl,ikh)-pgeoh(jl,ikt))*zrg
+ arg = 3.1415*(zzmzk/ztmzk)*0.5
+ zorgde = TAN(arg)*3.1415*0.5/ztmzk
+ zdprho = (paph(jl,kk+1)-paph(jl,kk))*(zrg*zrrho)
+ zodetr(jl,kk) = MIN(zorgde,1.E-3)*pmfu(jl,kk+1)*zdprho
+ END IF
+ END IF
+ ENDDO
+!
+ RETURN
+ END SUBROUTINE CUENTR_NEW
+!
+
+!**********************************************************
+! FUNCTION SSUM, TLUCUA, TLUCUB, TLUCUC
+!**********************************************************
+ REAL FUNCTION SSUM ( N, X, IX )
+!
+! COMPUTES SSUM = SUM OF [X(I)]
+! FOR N ELEMENTS OF X WITH SKIP INCREMENT IX FOR VECTOR X
+!
+ IMPLICIT NONE
+ REAL X(*)
+ REAL ZSUM
+ INTEGER N, IX, JX, JL
+!
+ JX = 1
+ ZSUM = 0.0
+ DO JL = 1, N
+ ZSUM = ZSUM + X(JX)
+ JX = JX + IX
+ enddo
+!
+ SSUM=ZSUM
+!
+ RETURN
+ END FUNCTION SSUM
+
+ REAL FUNCTION TLUCUA(TT)
+!
+! Set up lookup tables for cloud ascent calculations.
+!
+ IMPLICIT NONE
+ REAL ZCVM3,ZCVM4,TT !,TLUCUA
+!
+ IF(TT-TMELT.GT.0.) THEN
+ ZCVM3=C3LES
+ ZCVM4=C4LES
+ ELSE
+ ZCVM3=C3IES
+ ZCVM4=C4IES
+ END IF
+ TLUCUA=C2ES*EXP(ZCVM3*(TT-TMELT)*(1./(TT-ZCVM4)))
+!
+ RETURN
+ END FUNCTION TLUCUA
+!
+ REAL FUNCTION TLUCUB(TT)
+!
+! Set up lookup tables for cloud ascent calculations.
+!
+ IMPLICIT NONE
+ REAL Z5ALVCP,Z5ALSCP,ZCVM4,ZCVM5,TT !,TLUCUB
+!
+ Z5ALVCP=C5LES*ALV/CPD
+ Z5ALSCP=C5IES*ALS/CPD
+ IF(TT-TMELT.GT.0.) THEN
+ ZCVM4=C4LES
+ ZCVM5=Z5ALVCP
+ ELSE
+ ZCVM4=C4IES
+ ZCVM5=Z5ALSCP
+ END IF
+ TLUCUB=ZCVM5*(1./(TT-ZCVM4))**2
+!
+ RETURN
+ END FUNCTION TLUCUB
+!
+ REAL FUNCTION TLUCUC(TT)
+!
+! Set up lookup tables for cloud ascent calculations.
+!
+ IMPLICIT NONE
+ REAL ZALVDCP,ZALSDCP,TT,ZLDCP !,TLUCUC
+!
+ ZALVDCP=ALV/CPD
+ ZALSDCP=ALS/CPD
+ IF(TT-TMELT.GT.0.) THEN
+ ZLDCP=ZALVDCP
+ ELSE
+ ZLDCP=ZALSDCP
+ END IF
+ TLUCUC=ZLDCP
+!
+ RETURN
+ END FUNCTION TLUCUC
+!
+
+END MODULE module_cu_tiedtke
Modified: branches/omp_blocks/block_decomp/src/core_init_nhyd_atmos/Registry
===================================================================
--- branches/omp_blocks/block_decomp/src/core_init_nhyd_atmos/Registry 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_init_nhyd_atmos/Registry 2012-02-28 00:35:39 UTC (rev 1539)
@@ -1,33 +1,32 @@
%
% namelist type namelist_record name default_value
%
-namelist integer nhyd_model config_test_case 5
+namelist integer nhyd_model config_test_case 7
namelist integer nhyd_model config_calendar_type MPAS_GREGORIAN
namelist character nhyd_model config_start_time none
namelist character nhyd_model config_stop_time none
-namelist integer nhyd_model config_theta_adv_order 2
-namelist real nhyd_model config_coef_3rd_order 1.0
+namelist integer nhyd_model config_theta_adv_order 3
+namelist real nhyd_model config_coef_3rd_order 0.25
namelist integer dimensions config_nvertlevels 26
namelist integer dimensions config_nsoillevels 4
namelist integer dimensions config_nfglevels 27
namelist integer dimensions config_nfgsoillevels 4
namelist integer dimensions config_months 12
-namelist character data_sources config_geog_data_path /data3/mp/wrfhelp/WPS_GEOG/
+namelist character data_sources config_geog_data_path /mmm/users/wrfhelp/WPS_GEOG/
namelist character data_sources config_met_prefix FILE
-namelist character data_sources config_sst_prefix FILE
+namelist character data_sources config_sfc_prefix FILE
namelist integer data_sources config_fg_interval 21600
-namelist real vertical_grid config_ztop 24000.0
+namelist real vertical_grid config_ztop 28000.0
namelist integer vertical_grid config_nsmterrain 2
-namelist logical vertical_grid config_smooth_surfaces true
+namelist logical vertical_grid config_smooth_surfaces false
namelist logical preproc_stages config_static_interp true
namelist logical preproc_stages config_vertical_grid true
namelist logical preproc_stages config_met_interp true
-namelist logical preproc_stages config_physics_init false
namelist logical preproc_stages config_input_sst false
namelist logical preproc_stages config_frac_seaice false
namelist character io config_input_name grid.nc
namelist character io config_sfc_update_name sfc_update.nc
-namelist character io config_output_name output.nc
+namelist character io config_output_name init.nc
namelist character io config_restart_name restart.nc
namelist integer io config_frames_per_outfile 0
namelist character decomposition config_block_decomp_file_prefix graph.info.part.
@@ -147,8 +146,6 @@
var persistent real fzp ( nVertLevels ) 0 io fzp mesh - -
var persistent real zx ( nVertLevelsP1 nEdges ) 0 io zx mesh - -
var persistent real zz ( nVertLevelsP1 nCells ) 0 io zz mesh - -
-var persistent real zf ( nVertLevelsP1 TWO nEdges ) 0 io zf mesh - -
-var persistent real zf3 ( nVertLevelsP1 TWO nEdges ) 0 io zf3 mesh - -
var persistent real zb ( nVertLevelsP1 TWO nEdges ) 0 io zb mesh - -
var persistent real zb3 ( nVertLevelsP1 TWO nEdges ) 0 io zb3 mesh - -
Modified: branches/omp_blocks/block_decomp/src/core_init_nhyd_atmos/mpas_init_atm_test_cases.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_init_nhyd_atmos/mpas_init_atm_test_cases.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_init_nhyd_atmos/mpas_init_atm_test_cases.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -35,6 +35,28 @@
type (block_type), pointer :: block_ptr
+
+ !
+ ! Do some quick checks to make sure compile options are compatible with the chosen test case
+ !
+ if (config_test_case == 6) then
+#ifndef ROTATED_GRID
+ write(0,*) '*** ERROR ***'
+ write(0,*) 'To initialize and run the mountain wave test case (case 6),'
+ write(0,*) ' you must compile with -DROTATE_GRID added to the specification'
+ write(0,*) ' of MODEL_FORMULATION at the top of the Makefile.'
+ call mpas_dmpar_abort(domain % dminfo)
+#endif
+ else
+#ifdef ROTATED_GRID
+ write(0,*) '*** ERROR ***'
+ write(0,*) 'Only test case 6 should use code compiled with -DROTATE_GRID specified in the Makefile.'
+ call mpas_dmpar_abort(domain % dminfo)
+#endif
+ end if
+
+
+
if ((config_test_case == 1) .or. (config_test_case == 2) .or. (config_test_case == 3)) then
write(0,*) ' Jablonowski and Williamson baroclinic wave test case '
@@ -83,8 +105,7 @@
do while (associated(block_ptr))
call init_atm_test_case_gfs(domain % dminfo, block_ptr % mesh, block_ptr % fg, block_ptr % state % time_levs(1) % state, &
block_ptr % diag, config_test_case, block_ptr % parinfo)
- if(config_physics_init) &
- call physics_initialize_real(block_ptr % mesh, block_ptr % fg)
+ if (config_met_interp) call physics_initialize_real(block_ptr % mesh, block_ptr % fg)
block_ptr => block_ptr % next
end do
@@ -93,7 +114,7 @@
write(0,*) ' real-data surface (SST) update test case '
block_ptr => domain % blocklist
do while (associated(block_ptr))
- call init_atm_test_case_sst(domain, domain % dminfo, block_ptr % mesh, block_ptr % fg, block_ptr % state % time_levs(1) % state, &
+ call init_atm_test_case_sfc(domain, domain % dminfo, block_ptr % mesh, block_ptr % fg, block_ptr % state % time_levs(1) % state, &
block_ptr % diag, config_test_case, block_ptr % parinfo)
block_ptr => block_ptr % next
end do
@@ -154,7 +175,7 @@
real (kind=RKIND), dimension(:), pointer :: surface_pressure
real (kind=RKIND), dimension(:,:), pointer :: zgrid, zx, zz, hx
real (kind=RKIND), dimension(:,:), pointer :: pressure, ppb, pb, rho_zz, rb, rr, tb, rtb, p, pp, dss, t, rt
- real (kind=RKIND), dimension(:,:,:), pointer :: zf, zf3, zb, zb3
+ real (kind=RKIND), dimension(:,:,:), pointer :: zb, zb3
real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
!.. initialization of moisture:
@@ -232,8 +253,6 @@
CellsOnEdge => grid % CellsOnEdge % array
deriv_two => grid % deriv_two % array
- zf => grid % zf % array
- zf3 => grid % zf3% array
zb => grid % zb % array
zb3 => grid % zb3% array
@@ -778,13 +797,6 @@
zb3(k,1,iEdge)= z_edge3*dvEdge(iEdge)/AreaCell(cell1)
zb3(k,2,iEdge)= z_edge3*dvEdge(iEdge)/AreaCell(cell2)
- if (k /= 1) then
- zf(k,1,iEdge) = ( fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb(k,1,iEdge)
- zf(k,2,iEdge) = ( fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb(k,2,iEdge)
- zf3(k,1,iEdge)= ( fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb3(k,1,iEdge)
- zf3(k,2,iEdge)= ( fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb3(k,2,iEdge)
- end if
-
end do
end do
@@ -799,14 +811,16 @@
do k = 2, grid%nVertLevels
flux = (fzm(k)*diag % ru % array(k,iEdge)+fzp(k)*diag % ru % array(k-1,iEdge))
- diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + zf(k,2,iEdge)*flux
- diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - zf(k,1,iEdge)*flux
+ diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + (fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb(k,2,iEdge)*flux
+ diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - (fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb(k,1,iEdge)*flux
if (config_theta_adv_order ==3) then
diag % rw % array(k,cell2) = diag % rw % array(k,cell2) &
- - sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
+ - sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order* &
+ (fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb3(k,2,iEdge)*flux
diag % rw % array(k,cell1) = diag % rw % array(k,cell1) &
- + sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
+ + sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order* &
+ (fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb3(k,1,iEdge)*flux
end if
end do
@@ -1487,8 +1501,6 @@
diag % rw % array = 0.
state % w % array = 0.
- grid % zf % array = 0.
- grid % zf3% array = 0.
grid % zb % array = 0.
grid % zb3% array = 0.
@@ -1554,7 +1566,7 @@
real (kind=RKIND), dimension(:), pointer :: rdzw, dzu, rdzu, fzm, fzp
real (kind=RKIND), dimension(:,:), pointer :: zgrid, zx, zz, hx, cqw
real (kind=RKIND), dimension(:,:), pointer :: ppb, pb, rho_zz, rb, rr, tb, rtb, p, pp, dss, t, rt, u, ru
- real (kind=RKIND), dimension(:,:,:), pointer :: scalars, deriv_two, zf, zf3, zb, zb3
+ real (kind=RKIND), dimension(:,:,:), pointer :: scalars, deriv_two, zb, zb3
!This is temporary variable here. It just need when calculate tangential velocity v.
integer :: eoe, j
@@ -1621,8 +1633,6 @@
nCellsSolve = grid % nCellsSolve
zgrid => grid % zgrid % array
- zf => grid % zf % array
- zf3 => grid % zf3 % array
zb => grid % zb % array
zb3 => grid % zb3 % array
rdzw => grid % rdzw % array
@@ -1889,7 +1899,11 @@
+zgrid(k,cell2)+zgrid(k+1,cell2))
u(k,i) = um
if(i == 1 ) grid % u_init % array(k) = u(k,i) - us
- u(k,i) = cos(grid % angleEdge % array(i)) * (u(k,i) - us)
+#ifdef ROTATED_GRID
+ u(k,i) = sin(grid % angleEdge % array(i)) * (u(k,i) - us)
+#else
+ u(k,i) = cos(grid % angleEdge % array(i)) * (u(k,i) - us)
+#endif
end do
end if
end do
@@ -2054,13 +2068,6 @@
zb3(k,1,iEdge)= z_edge3*dvEdge(iEdge)/AreaCell(cell1)
zb3(k,2,iEdge)= z_edge3*dvEdge(iEdge)/AreaCell(cell2)
- if (k /= 1) then
- zf(k,1,iEdge) = ( fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1) )*zb(k,1,iEdge)
- zf(k,2,iEdge) = ( fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2) )*zb(k,2,iEdge)
- zf3(k,1,iEdge)= ( fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1) )*zb3(k,1,iEdge)
- zf3(k,2,iEdge)= ( fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2) )*zb3(k,2,iEdge)
- end if
-
end do
end if
@@ -2082,14 +2089,16 @@
if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve ) then
do k = 2, grid%nVertLevels
flux = (fzm(k)*ru(k,iEdge)+fzp(k)*ru(k-1,iEdge))
- diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + zf(k,2,iEdge)*flux
- diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - zf(k,1,iEdge)*flux
+ diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + (fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb(k,2,iEdge)*flux
+ diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - (fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb(k,1,iEdge)*flux
if (config_theta_adv_order ==3) then
diag % rw % array(k,cell2) = diag % rw % array(k,cell2) &
- - sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
+ - sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order* &
+ (fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb3(k,2,iEdge)*flux
diag % rw % array(k,cell1) = diag % rw % array(k,cell1) &
- + sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
+ + sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order* &
+ (fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb3(k,1,iEdge)*flux
end if
end do
@@ -2183,7 +2192,7 @@
real (kind=RKIND), dimension(:,:), pointer :: pressure, ppb, pb, rho_zz, rb, rr, tb, rtb, p, pp, dss, t, rt
real (kind=RKIND), dimension(:), pointer :: destField1d
real (kind=RKIND), dimension(:,:), pointer :: destField2d
- real (kind=RKIND), dimension(:,:,:), pointer :: zf, zf3, zb, zb3
+ real (kind=RKIND), dimension(:,:,:), pointer :: zb, zb3
real (kind=RKIND), dimension(:,:,:), pointer :: scalars
real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
@@ -2276,8 +2285,6 @@
cellsOnCell => grid % cellsOnCell % array
deriv_two => grid % deriv_two % array
- zf => grid % zf % array
- zf3 => grid % zf3% array
zb => grid % zb % array
zb3 => grid % zb3% array
@@ -3182,7 +3189,7 @@
parinfo % cellsToSend, parinfo % cellsToRecv)
! dzmina = minval(hs(:)-hx(k-1,:))
- dzmina = minval(zw(k)+ah(k)*hs(:)-zw(k-1)-ah(k-1)*hx(k-1,:))
+ dzmina = minval(zw(k)+ah(k)*hs(1:grid%nCellsSolve)-zw(k-1)-ah(k-1)*hx(k-1,1:grid%nCellsSolve))
call mpas_dmpar_min_real(dminfo, dzmina, dzmina_global)
! write(0,*) ' k,i, dzmina, dzmin, zw(k)-zw(k-1) ', k,i, dzmina, dzmin, zw(k)-zw(k-1)
if (dzmina_global >= dzmin*(zw(k)-zw(k-1))) then
@@ -3289,13 +3296,6 @@
zb3(k,1,iEdge)= z_edge3*dvEdge(iEdge)/AreaCell(cell1)
zb3(k,2,iEdge)= z_edge3*dvEdge(iEdge)/AreaCell(cell2)
- if (k /= 1) then
- zf(k,1,iEdge) = ( fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1) )*zb(k,1,iEdge)
- zf(k,2,iEdge) = ( fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2) )*zb(k,2,iEdge)
- zf3(k,1,iEdge)= ( fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1) )*zb3(k,1,iEdge)
- zf3(k,2,iEdge)= ( fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2) )*zb3(k,2,iEdge)
- end if
-
end do
end if
@@ -3883,7 +3883,7 @@
if (field % iproj == PROJ_PS) then
call map_set(PROJ_PS, proj, &
- dx = real(field % dx * 1000.0,RKIND), &
+ dx = real(field % dx,RKIND), &
truelat1 = real(field % truelat1,RKIND), &
stdlon = real(field % xlonc,RKIND), &
knowni = real(field % nx / 2.0,RKIND), &
@@ -4239,14 +4239,16 @@
if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve ) then
do k = 2, grid%nVertLevels
flux = (fzm(k)*diag % ru % array(k,iEdge)+fzp(k)*diag % ru % array(k-1,iEdge))
- diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + zf(k,2,iEdge)*flux
- diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - zf(k,1,iEdge)*flux
+ diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + (fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb(k,2,iEdge)*flux
+ diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - (fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb(k,1,iEdge)*flux
if (config_theta_adv_order ==3) then
diag % rw % array(k,cell2) = diag % rw % array(k,cell2) &
- - sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
+ - sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order* &
+ (fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb3(k,2,iEdge)*flux
diag % rw % array(k,cell1) = diag % rw % array(k,cell1) &
- + sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
+ + sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order* &
+ (fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb3(k,1,iEdge)*flux
end if
end do
@@ -4286,7 +4288,7 @@
end subroutine init_atm_test_case_gfs
- subroutine init_atm_test_case_sst(domain, dminfo, grid, fg, state, diag, test_case, parinfo)
+ subroutine init_atm_test_case_sfc(domain, dminfo, grid, fg, state, diag, test_case, parinfo)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Real-data test case using SST data
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -4346,12 +4348,12 @@
curr_time = mpas_get_clock_time(fg_clock, MPAS_NOW)
do while (curr_time <= stop_time)
call mpas_get_time(curr_time, dateTimeString=timeString)
- write(0,*) 'Processing ',trim(config_met_prefix)//':'//timeString(1:13)
+ write(0,*) 'Processing ',trim(config_sfc_prefix)//':'//timeString(1:13)
! Open intermediate file
- call read_met_init(trim(config_met_prefix), .false., timeString(1:13), istatus)
+ call read_met_init(trim(config_sfc_prefix), .false., timeString(1:13), istatus)
if (istatus /= 0) then
- write(0,*) 'Error reading ',trim(config_met_prefix)//':'//timeString(1:13)
+ write(0,*) 'Error reading ',trim(config_sfc_prefix)//':'//timeString(1:13)
exit
end if
@@ -4359,6 +4361,11 @@
call read_next_met_field(field, istatus)
do while (istatus == 0)
+ !initialization of sea-surface temperature (SST) and sea-ice fraction (XICE) arrays,
+ !prior to reading the input data:
+ fg % sst % array (1:grid%nCells) = 0.0
+ fg % xice % array (1:grid%nCells) = 0.0
+
if (index(field % field, 'SKINTEMP') /= 0 .or. index(field % field, 'SST') /= 0) then
! Interpolation routines use real(kind=RKIND), so copy from default real array
@@ -4389,6 +4396,15 @@
lat1 = real(field % startlat,RKIND), &
lon1 = real(field % startlon,RKIND))
! nxmax = nint(360.0 / field % deltalon), &
+ else if (field % iproj == PROJ_PS) then
+ call map_set(PROJ_PS, proj, &
+ dx = real(field % dx,RKIND), &
+ truelat1 = real(field % truelat1,RKIND), &
+ stdlon = real(field % xlonc,RKIND), &
+ knowni = real(field % nx / 2.0,RKIND), &
+ knownj = real(field % ny / 2.0,RKIND), &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
end if
! Interpolate SST/SKINTEMP field to each MPAS grid cell
@@ -4413,10 +4429,8 @@
deallocate(slab_r8)
deallocate(field % slab)
- exit
- end if
- if (index(field % field, 'SEAICE') /= 0) then
+ else if (index(field % field, 'SEAICE') /= 0) then
! Interpolation routines use real(kind=RKIND), so copy from default real array
allocate(slab_r8(field % nx, field % ny))
@@ -4446,6 +4460,15 @@
lat1 = real(field % startlat,RKIND), &
lon1 = real(field % startlon,RKIND))
! nxmax = nint(360.0 / field % deltalon), &
+ else if (field % iproj == PROJ_PS) then
+ call map_set(PROJ_PS, proj, &
+ dx = real(field % dx,RKIND), &
+ truelat1 = real(field % truelat1,RKIND), &
+ stdlon = real(field % xlonc,RKIND), &
+ knowni = real(field % nx / 2.0,RKIND), &
+ knownj = real(field % ny / 2.0,RKIND), &
+ lat1 = real(field % startlat,RKIND), &
+ lon1 = real(field % startlon,RKIND))
end if
! Interpolate SEAICE/SKINTEMP field to each MPAS grid cell
@@ -4466,15 +4489,18 @@
call latlon_to_ij(proj, lat, lon, x, y)
end if
fg % xice % array(iCell) = interp_sequence(x, y, 1, slab_r8, 1, field % nx, 1, field % ny, 1, 1, -1.e30_RKIND, interp_list, 1)
+ if (fg % xice % array(iCell) == -1.e30_RKIND) fg % xice % array(iCell) = 0.0_RKIND
end do
deallocate(slab_r8)
deallocate(field % slab)
- exit
+
+ else
+
+ deallocate(field % slab)
end if
- deallocate(field % slab)
call read_next_met_field(field, istatus)
end do
@@ -4495,63 +4521,9 @@
call mpas_output_state_finalize(sfc_update_obj, dminfo)
- end subroutine init_atm_test_case_sst
+ end subroutine init_atm_test_case_sfc
-#if 0
- real function four_pt(nx, ny, array, xx, yy)
- implicit none
-
- integer, intent(in) :: nx, ny
- real (kind=4), dimension(nx, ny), intent(in) :: array
- real (kind=4), intent(in) :: xx, yy
-
- integer :: min_x, max_x, min_y, max_y
-
- min_x = floor(xx)
- min_y = floor(yy)
- max_x = ceiling(xx)
- max_y = ceiling(yy)
-
- if (min_x == 0) min_x = max_x
- if (max_x == nx+1) max_x = min_x
- if (min_y == 0) min_y = max_y
- if (max_y == ny+1) max_y = min_y
-
- if ((min_x < 1) .or. (max_x > nx) .or. (min_y < 1) .or. (max_y > ny)) then
- write(0,*) '(x,y) location out of bounds'
- four_pt = 0.0
- return
- end if
-
- if (min_x == max_x) then
- if (min_y == max_y) then
- four_pt = array(min_x,min_y)
- else
- four_pt = array(min_x,min_y)*(real(max_y)-yy) + &
- array(min_x,max_y)*(yy-real(min_y))
- end if
- else if (min_y == max_y) then
- if (min_x == max_x) then
- four_pt = array(min_x,min_y)
- else
- four_pt = array(min_x,min_y)*(real(max_x)-xx) + &
- array(max_x,min_y)*(xx-real(min_x))
- end if
- else
- four_pt = (yy - min_y) * (array(min_x,max_y)*(real(max_x)-xx) + &
- array(max_x,max_y)*(xx-real(min_x))) + &
- (max_y - yy) * (array(min_x,min_y)*(real(max_x)-xx) + &
- array(max_x,min_y)*(xx-real(min_x)));
- end if
-
- return
-
- end function four_pt
-#endif
-
-!----------------------------------------------------------------------------------------------------------
-
integer function nearest_cell(target_lat, target_lon, &
start_cell, &
nCells, maxEdges, nEdgesOnCell, cellsOnCell, latCell, lonCell)
Modified: branches/omp_blocks/block_decomp/src/core_nhyd_atmos/Registry
===================================================================
--- branches/omp_blocks/block_decomp/src/core_nhyd_atmos/Registry 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_nhyd_atmos/Registry 2012-02-28 00:35:39 UTC (rev 1539)
@@ -1,9 +1,9 @@
%
% namelist type namelist_record name default_value
%
-namelist integer nhyd_model config_test_case 5
+namelist integer nhyd_model config_test_case 0
namelist character nhyd_model config_time_integration SRK3
-namelist real nhyd_model config_dt 172.8
+namelist real nhyd_model config_dt 600.0
namelist integer nhyd_model config_calendar_type MPAS_GREGORIAN
namelist character nhyd_model config_start_time 0000-01-01_00:00:00
namelist character nhyd_model config_stop_time none
@@ -17,20 +17,19 @@
namelist real nhyd_model config_h_theta_eddy_visc4 0.0
namelist real nhyd_model config_v_theta_eddy_visc2 0.0
namelist integer nhyd_model config_number_of_sub_steps 4
-namelist integer nhyd_model config_w_adv_order 2
-namelist integer nhyd_model config_theta_adv_order 2
-namelist integer nhyd_model config_scalar_adv_order 2
-namelist integer nhyd_model config_u_vadv_order 2
-namelist integer nhyd_model config_w_vadv_order 2
-namelist integer nhyd_model config_theta_vadv_order 2
-namelist integer nhyd_model config_scalar_vadv_order 2
-namelist real nhyd_model config_coef_3rd_order 1.0
+namelist integer nhyd_model config_w_adv_order 3
+namelist integer nhyd_model config_theta_adv_order 3
+namelist integer nhyd_model config_scalar_adv_order 3
+namelist integer nhyd_model config_u_vadv_order 3
+namelist integer nhyd_model config_w_vadv_order 3
+namelist integer nhyd_model config_theta_vadv_order 3
+namelist integer nhyd_model config_scalar_vadv_order 3
+namelist real nhyd_model config_coef_3rd_order 0.25
namelist logical nhyd_model config_scalar_advection true
namelist logical nhyd_model config_positive_definite false
namelist logical nhyd_model config_monotonic true
namelist logical nhyd_model config_mix_full true
-namelist real nhyd_model config_len_disp 0.
-namelist integer nhyd_model config_mp_physics 0.
+namelist real nhyd_model config_len_disp 120000.0
namelist real nhyd_model config_epssm 0.1
namelist real nhyd_model config_smdiv 0.1
namelist logical nhyd_model config_newpx false
@@ -39,7 +38,7 @@
namelist real damping config_zd 22000.0
namelist real damping config_xnutr 0.0
namelist integer dimensions config_nvertlevels 26
-namelist character io config_input_name grid.nc
+namelist character io config_input_name init.nc
namelist character io config_sfc_update_name sfc_update.nc
namelist character io config_output_name output.nc
namelist character io config_restart_name restart.nc
@@ -149,10 +148,10 @@
var persistent real fzp ( nVertLevels ) 0 iro fzp mesh - -
var persistent real zx ( nVertLevelsP1 nEdges ) 0 iro zx mesh - -
var persistent real zz ( nVertLevelsP1 nCells ) 0 iro zz mesh - -
-var persistent real zf ( nVertLevelsP1 TWO nEdges ) 0 iro zf mesh - -
-var persistent real zf3 ( nVertLevelsP1 TWO nEdges ) 0 iro zf3 mesh - -
var persistent real zb ( nVertLevelsP1 TWO nEdges ) 0 iro zb mesh - -
var persistent real zb3 ( nVertLevelsP1 TWO nEdges ) 0 iro zb3 mesh - -
+var persistent real pzm ( nVertLevels nCells ) 0 r pzm mesh - -
+var persistent real pzp ( nVertLevels nCells ) 0 r pzp mesh - -
% coefficients for the vertical tridiagonal solve
% Note: these could be local but...
@@ -337,14 +336,14 @@
namelist logical physics config_sstdiurn_update false
namelist logical physics config_deepsoiltemp_update false
-namelist integer physics config_n_physics 01
-namelist integer physics config_n_microp 01
-namelist integer physics config_n_conv 01
-namelist integer physics config_n_pbl 01
-namelist integer physics config_n_lsm 01
-namelist integer physics config_n_eddy 01
-namelist integer physics config_n_radt_lw 01
-namelist integer physics config_n_radt_sw 01
+namelist integer physics config_n_physics 1
+namelist integer physics config_n_microp 1
+namelist integer physics config_n_conv 1
+namelist integer physics config_n_pbl 1
+namelist integer physics config_n_lsm 1
+namelist integer physics config_n_eddy 1
+namelist integer physics config_n_radt_lw 1
+namelist integer physics config_n_radt_sw 1
namelist character physics config_radtlw_interval none
namelist character physics config_radtsw_interval none
@@ -414,38 +413,47 @@
%... PARAMETERIZATION OF CONVECTION:
%--------------------------------------------------------------------------------------------------
-% cubot : lowest level of convection (-)
-% cutop : highest level of convection (-)
% cuprec : convective precipitation rate (mm/s)
% rainc : accumulated time-step convective precipitation (mm)
% raincv : time-step convective precipitation (mm)
% rthcuten : tendency of potential temperature due to cumulus convection (K s-1)
% rqvcuten : tendency of water vapor mixing ratio due to cumulus convection (kg/kg s-1)
% rqccuten : tendency of cloud water mixing ratio due to cumulus convection (kg/kg s-1)
-% rqrcuten : tendency of rain mixing ratio due to cumulus convection (kg/kg s-1)
% rqicuten : tendency of cloud ice mixing ratio due to cumulus convection (kg/kg s-1)
-% rqscuten : tendency of snow mixing ratio due to cumulus convection (kg/kg s-1)
-var persistent real cubot ( nCells Time ) 1 ro cubot diag_physics - -
-var persistent real cutop ( nCells Time ) 1 ro cutop diag_physics - -
-var persistent real cuprec ( nCells Time ) 1 ro cuprec diag_physics - -
-var persistent real rainc ( nCells Time ) 1 ro rainc diag_physics - -
-var persistent real raincv ( nCells Time ) 1 ro raincv diag_physics - -
+var persistent real cuprec ( nCells Time ) 1 ro cuprec diag_physics - -
+var persistent real rainc ( nCells Time ) 1 ro rainc diag_physics - -
+var persistent real raincv ( nCells Time ) 1 ro raincv diag_physics - -
-var persistent real rthcuten ( nVertLevels nCells Time ) 1 ro rthcuten tend_physics - -
-var persistent real rqvcuten ( nVertLevels nCells Time ) 1 ro rqvcuten tend_physics - -
-var persistent real rqccuten ( nVertLevels nCells Time ) 1 ro rqccuten tend_physics - -
-var persistent real rqrcuten ( nVertLevels nCells Time ) 1 ro rqrcuten tend_physics - -
-var persistent real rqicuten ( nVertLevels nCells Time ) 1 ro rqicuten tend_physics - -
-var persistent real rqscuten ( nVertLevels nCells Time ) 1 ro rqscuten tend_physics - -
+var persistent real rthcuten ( nVertLevels nCells Time ) 1 ro rthcuten tend_physics - -
+var persistent real rqvcuten ( nVertLevels nCells Time ) 1 ro rqvcuten tend_physics - -
+var persistent real rqccuten ( nVertLevels nCells Time ) 1 ro rqccuten tend_physics - -
+var persistent real rqicuten ( nVertLevels nCells Time ) 1 ro rqicuten tend_physics - -
-%... KAIN_FRITSCH ONLY:
+%... KAIN_FRITSCH:
+% cubot : lowest level of convection (-)
+% cutop : highest level of convection (-)
% nca : relaxation time for KF parameterization of convection (s)
% wavg0 : average vertical velocity (KF scheme only) (m s-1)
+% rqrcuten : tendency of rain mixing ratio due to cumulus convection (kg/kg s-1)
+% rqscuten : tendency of snow mixing ratio due to cumulus convection (kg/kg s-1)
-var persistent real nca ( nCells Time ) 1 ro nca diag_physics - -
-var persistent real w0avg ( nVertLevels nCells Time ) 1 ro w0avg diag_physics - -
+var persistent real nca ( nCells Time ) 1 ro nca diag_physics - -
+var persistent real cubot ( nCells Time ) 1 ro cubot diag_physics - -
+var persistent real cutop ( nCells Time ) 1 ro cutop diag_physics - -
+var persistent real w0avg ( nVertLevels nCells Time ) 1 ro w0avg diag_physics - -
+var persistent real rqrcuten ( nVertLevels nCells Time ) 1 ro rqrcuten tend_physics - -
+var persistent real rqscuten ( nVertLevels nCells Time ) 1 ro rqscuten tend_physics - -
+%... TIEDTKE:
+% rucuten : tendency of zonal wind due to cumulus convection (m/s-1)
+% rvcuten : tendency of meridional wind due to cumulus convection (m/s-1)
+% rqvdynten : tendency of water vapor due to horizontal and vertical advections (kg/kg/s-1)
+
+var persistent real rqvdynten ( nVertLevels nCells Time ) 1 ro rqvdynten tend_physics - -
+var persistent real rucuten ( nVertLevels nCells Time ) 1 ro rucuten tend_physics - -
+var persistent real rvcuten ( nVertLevels nCells Time ) 1 ro rvcuten tend_physics - -
+
%--------------------------------------------------------------------------------------------------
%... PARAMETERIZATION OF PLANETARY BOUNDARY LAYER PROCESSES:
%--------------------------------------------------------------------------------------------------
Modified: branches/omp_blocks/block_decomp/src/core_nhyd_atmos/mpas_atm_mpas_core.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_nhyd_atmos/mpas_atm_mpas_core.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_nhyd_atmos/mpas_atm_mpas_core.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -334,6 +334,12 @@
if (mpas_is_alarm_ringing(clock, restartAlarmID, ierr=ierr)) then
call mpas_reset_clock_alarm(clock, restartAlarmID, ierr=ierr)
+ block_ptr => domain % blocklist
+ do while (associated(block_ptr))
+ call atm_compute_restart_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % diag, block_ptr % mesh)
+ block_ptr => block_ptr % next
+ end do
+
! Write one restart time per file
call mpas_output_state_init(restart_obj, domain, "RESTART", trim(timeStamp))
call mpas_output_state_for_domain(restart_obj, domain, 1)
@@ -389,7 +395,7 @@
subroutine atm_compute_output_diagnostics(state, diag, grid)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Compute diagnostic fields for a domain
+ ! Compute diagnostic fields for a domain to be written to history files
!
! Input: state - contains model prognostic fields
! grid - contains grid metadata
@@ -418,6 +424,37 @@
end subroutine atm_compute_output_diagnostics
+ subroutine atm_compute_restart_diagnostics(state, diag, grid)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Compute diagnostic fields for a domain to be written to restart files
+ !
+ ! Input: state - contains model prognostic fields
+ ! grid - contains grid metadata
+ !
+ ! Output: state - upon returning, diagnostic fields will have be computed
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ use mpas_grid_types
+
+ implicit none
+
+ type (state_type), intent(inout) :: state
+ type (diag_type), intent(inout) :: diag
+ type (mesh_type), intent(in) :: grid
+
+ integer :: i, eoe
+ integer :: iCell, k
+
+ do iCell=1,grid%nCells
+ do k=1,grid%nVertLevels
+ diag % theta % array(k,iCell) = state % theta_m % array(k,iCell) / (1.0 + 1.61 * state % scalars % array(state % index_qv,k,iCell))
+ diag % rho % array(k,iCell) = state % rho_zz % array(k,iCell) * grid % zz % array(k,iCell)
+ end do
+ end do
+
+ end subroutine atm_compute_restart_diagnostics
+
+
subroutine atm_do_timestep(domain, dt, itimestep)
use mpas_grid_types
@@ -560,12 +597,14 @@
type (mesh_type), intent(inout) :: mesh
- integer :: iEdge, iCell1, iCell2, k
+ integer :: iEdge, iCell1, iCell2, k, iCell, nz, nz1
real (kind=RKIND) :: d1, d2, d3
- real (kind=RKIND), dimension(:,:), pointer :: cpr, cpl, zgrid
+ real (kind=RKIND), dimension(:,:), pointer :: cpr, cpl, zgrid, pzp, pzm
cpr => mesh % cpr % array
cpl => mesh % cpl % array
+ pzp => mesh % pzp % array
+ pzm => mesh % pzm % array
zgrid => mesh % zgrid % array
!**** coefficient arrays for new pressure gradient calculation
@@ -575,28 +614,70 @@
if (config_newpx) then
do iEdge=1,mesh%nEdges
+
iCell1 = mesh % cellsOnEdge % array(1,iEdge)
iCell2 = mesh % cellsOnEdge % array(2,iEdge)
d1 = .25*(zgrid(1,iCell2)+zgrid(2,iCell2)-zgrid(1,iCell1)-zgrid(2,iCell1))
d2 = d1+.5*(zgrid(3,iCell2)-zgrid(1,iCell2))
d3 = d2+.5*(zgrid(4,iCell2)-zgrid(2,iCell2))
- cpr(1,iEdge) = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
- cpr(2,iEdge) = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
- cpr(3,iEdge) = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
+! cpr(1,iEdge) = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
+! cpr(2,iEdge) = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
+! cpr(3,iEdge) = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
+ cpr(1,iEdge) = d2/(d2-d1)
+ cpr(2,iEdge) = -d1/(d2-d1)
+ cpr(3,iEdge) = 0.
+
d1 = .25*(zgrid(1,iCell1)+zgrid(2,iCell1)-zgrid(1,iCell2)-zgrid(2,iCell2))
d2 = d1+.5*(zgrid(3,iCell1)-zgrid(1,iCell1))
d3 = d2+.5*(zgrid(4,iCell1)-zgrid(2,iCell1))
- cpl(1,iEdge) = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
- cpl(2,iEdge) = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
- cpl(3,iEdge) = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
+! cpl(1,iEdge) = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
+! cpl(2,iEdge) = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
+! cpl(3,iEdge) = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
+ cpl(1,iEdge) = d2/(d2-d1)
+ cpl(2,iEdge) = -d1/(d2-d1)
+ cpl(3,iEdge) = 0.
+
end do
+
! write(6,*) 'cpr1 = ',cpr(1,1),' cpl1 = ',cpl(1,1)
! write(6,*) 'cpr2 = ',cpr(2,1),' cpl2 = ',cpl(2,1)
! write(6,*) 'cpr3 = ',cpr(3,1),' cpl3 = ',cpl(3,1)
+ else
+
+! Coefficients for computing vertical pressure gradient dp/dz
+! dp/dz (k,iCell) = pzp(k,iCell) * (p(k+1,iCell) - p(k,iCell)) +pzm(k,iCell) * (p(k,iCell) - p(k-1,iCell))
+
+ nz1 = mesh % nVertLevels
+ nz = nz1 + 1
+
+ do iCell=1, mesh % nCells
+
+ d1 = zgrid(3,iCell)-zgrid(1,iCell)
+ d2 = zgrid(4,iCell)-zgrid(2,iCell)
+ d3 = d1+d2
+ pzm(1,iCell) = 2.*d3/(d1*d2)
+ pzp(1,iCell) = -2.*d1/(d2*d3)
+
+ do k=2,nz1-1
+ pzp(k,iCell) = 2.*(zgrid(k+1,iCell)-zgrid(k-1,iCell))/ &
+ & ((zgrid(k+2,iCell)-zgrid(k ,iCell))* &
+ & (zgrid(k+2,iCell)-zgrid(k ,iCell) &
+ & +zgrid(k+1,iCell)-zgrid(k-1,iCell)))
+ pzm(k,iCell) = 2.*(zgrid(k+2,iCell)-zgrid(k ,iCell))/ &
+ & ((zgrid(k+1,iCell)-zgrid(k-1,iCell))* &
+ & (zgrid(k+2,iCell)-zgrid(k ,iCell) &
+ & +zgrid(k+1,iCell)-zgrid(k-1,iCell)))
+ end do
+
+ pzp(nz1,iCell) = 0.
+ pzm(nz1,iCell) = 2./(zgrid(nz,iCell)-zgrid(nz1-1,iCell))
+
+ end do
+
end if
end subroutine atm_compute_pgf_coefs
Modified: branches/omp_blocks/block_decomp/src/core_nhyd_atmos/mpas_atm_test_cases.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_nhyd_atmos/mpas_atm_test_cases.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_nhyd_atmos/mpas_atm_test_cases.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -141,7 +141,7 @@
real (kind=RKIND), dimension(:), pointer :: surface_pressure
real (kind=RKIND), dimension(:,:), pointer :: zgrid, zx, zz, hx
real (kind=RKIND), dimension(:,:), pointer :: pressure, ppb, pb, rho_zz, rb, rr, tb, rtb, p, pp, dss, t, rt
- real (kind=RKIND), dimension(:,:,:), pointer :: zf, zf3, zb, zb3
+ real (kind=RKIND), dimension(:,:,:), pointer :: zb, zb3
real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
!.. initialization of moisture:
@@ -219,8 +219,6 @@
CellsOnEdge => grid % CellsOnEdge % array
deriv_two => grid % deriv_two % array
- zf => grid % zf % array
- zf3 => grid % zf3% array
zb => grid % zb % array
zb3 => grid % zb3% array
@@ -765,13 +763,6 @@
zb3(k,1,iEdge)= z_edge3*dvEdge(iEdge)/AreaCell(cell1)
zb3(k,2,iEdge)= z_edge3*dvEdge(iEdge)/AreaCell(cell2)
- if (k /= 1) then
- zf(k,1,iEdge) = ( fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb(k,1,iEdge)
- zf(k,2,iEdge) = ( fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb(k,2,iEdge)
- zf3(k,1,iEdge)= ( fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb3(k,1,iEdge)
- zf3(k,2,iEdge)= ( fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb3(k,2,iEdge)
- end if
-
end do
end do
@@ -786,14 +777,16 @@
do k = 2, grid%nVertLevels
flux = (fzm(k)*diag % ru % array(k,iEdge)+fzp(k)*diag % ru % array(k-1,iEdge))
- diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + zf(k,2,iEdge)*flux
- diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - zf(k,1,iEdge)*flux
+ diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + (fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb(k,2,iEdge)*flux
+ diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - (fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb(k,1,iEdge)*flux
if (config_theta_adv_order ==3) then
diag % rw % array(k,cell2) = diag % rw % array(k,cell2) &
- - sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
+ - sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order* &
+ (fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb3(k,2,iEdge)*flux
diag % rw % array(k,cell1) = diag % rw % array(k,cell1) &
- + sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
+ + sign(1.0_RKIND,diag % ru % array(k,iEdge))*config_coef_3rd_order* &
+ (fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb3(k,1,iEdge)*flux
end if
end do
@@ -1474,8 +1467,6 @@
diag % rw % array = 0.
state % w % array = 0.
- grid % zf % array = 0.
- grid % zf3% array = 0.
grid % zb % array = 0.
grid % zb3% array = 0.
@@ -1541,7 +1532,7 @@
real (kind=RKIND), dimension(:), pointer :: rdzw, dzu, rdzu, fzm, fzp
real (kind=RKIND), dimension(:,:), pointer :: zgrid, zx, zz, hx, cqw
real (kind=RKIND), dimension(:,:), pointer :: ppb, pb, rho_zz, rb, rr, tb, rtb, p, pp, dss, t, rt, u, ru
- real (kind=RKIND), dimension(:,:,:), pointer :: scalars, deriv_two, zf, zf3, zb, zb3
+ real (kind=RKIND), dimension(:,:,:), pointer :: scalars, deriv_two, zb, zb3
!This is temporary variable here. It just need when calculate tangential velocity v.
integer :: eoe, j
@@ -1608,8 +1599,6 @@
nCellsSolve = grid % nCellsSolve
zgrid => grid % zgrid % array
- zf => grid % zf % array
- zf3 => grid % zf3 % array
zb => grid % zb % array
zb3 => grid % zb3 % array
rdzw => grid % rdzw % array
@@ -1876,7 +1865,11 @@
+zgrid(k,cell2)+zgrid(k+1,cell2))
u(k,i) = um
if(i == 1 ) grid % u_init % array(k) = u(k,i) - us
+#ifdef ROTATED_GRID
+ u(k,i) = sin(grid % angleEdge % array(i)) * (u(k,i) - us)
+#else
u(k,i) = cos(grid % angleEdge % array(i)) * (u(k,i) - us)
+#endif
end do
end if
end do
@@ -2041,13 +2034,6 @@
zb3(k,1,iEdge)= z_edge3*dvEdge(iEdge)/AreaCell(cell1)
zb3(k,2,iEdge)= z_edge3*dvEdge(iEdge)/AreaCell(cell2)
- if (k /= 1) then
- zf(k,1,iEdge) = ( fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1) )*zb(k,1,iEdge)
- zf(k,2,iEdge) = ( fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2) )*zb(k,2,iEdge)
- zf3(k,1,iEdge)= ( fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1) )*zb3(k,1,iEdge)
- zf3(k,2,iEdge)= ( fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2) )*zb3(k,2,iEdge)
- end if
-
end do
end if
@@ -2069,14 +2055,16 @@
if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve ) then
do k = 2, grid%nVertLevels
flux = (fzm(k)*ru(k,iEdge)+fzp(k)*ru(k-1,iEdge))
- diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + zf(k,2,iEdge)*flux
- diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - zf(k,1,iEdge)*flux
+ diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + (fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb(k,2,iEdge)*flux
+ diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - (fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb(k,1,iEdge)*flux
if (config_theta_adv_order ==3) then
diag % rw % array(k,cell2) = diag % rw % array(k,cell2) &
- - sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order*zf3(k,2,iEdge)*flux
+ - sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order* &
+ (fzm(k)*zz(k,cell2)+fzp(k)*zz(k-1,cell2))*zb3(k,2,iEdge)*flux
diag % rw % array(k,cell1) = diag % rw % array(k,cell1) &
- + sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order*zf3(k,1,iEdge)*flux
+ + sign(1.0_RKIND,ru(k,iEdge))*config_coef_3rd_order* &
+ (fzm(k)*zz(k,cell1)+fzp(k)*zz(k-1,cell1))*zb3(k,1,iEdge)*flux
end if
end do
Modified: branches/omp_blocks/block_decomp/src/core_nhyd_atmos/mpas_atm_time_integration.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_nhyd_atmos/mpas_atm_time_integration.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_nhyd_atmos/mpas_atm_time_integration.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -93,8 +93,6 @@
logical, parameter :: debug = .false.
! logical, parameter :: debug = .true.
logical, parameter :: debug_mass_conservation = .true.
-! logical, parameter :: do_microphysics = .true.
- logical, parameter :: do_microphysics = .false.
integer :: index_qc
real (kind=RKIND) :: domain_mass, scalar_mass, scalar_min, scalar_max
@@ -415,13 +413,6 @@
end do
#endif
-! if(do_microphysics) then
-! block => domain % blocklist
-! do while (associated(block))
-! call atm_qd_kessler( block % state % time_levs(1) % state, block % state % time_levs(2) % state, block % mesh, dt )
-! block => block % next
-! end do
-! end if
! if(debug) then
101 format(' local min, max scalar',i4,2(1x,e17.10))
@@ -674,14 +665,16 @@
type (tend_type) :: tend
type (diag_type) :: diag
type (mesh_type) :: grid
- integer :: iCell, iEdge, k, cell1, cell2
+ !SHP-w
+ integer :: iCell, iEdge, k, cell1, cell2, coef_3rd_order
integer, dimension(:,:), pointer :: cellsOnEdge
- real (kind=RKIND), dimension(:,:,:), pointer :: zf, zf3
real (kind=RKIND), dimension(:), pointer :: fzm, fzp, dvEdge, areaCell
real (kind=RKIND) :: flux
+ !SHP-w
+ coef_3rd_order = config_coef_3rd_order
+ if(config_theta_adv_order /=3) coef_3rd_order = 0
- zf => grid % zf % array
- zf3 => grid % zf3 % array
+ !SHP-w
fzm => grid % fzm % array
fzp => grid % fzp % array
dvEdge => grid % dvEdge % array
@@ -708,18 +701,15 @@
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
+ !SHP-w
do k = 2, grid%nVertLevels
flux = fzm(k) * tend % u % array(k,iEdge) + fzp(k) * tend % u % array(k-1,iEdge)
- tend % w % array(k,cell2) = tend % w % array(k,cell2) + zf(k,2,iEdge)*flux
- tend % w % array(k,cell1) = tend % w % array(k,cell1) - zf(k,1,iEdge)*flux
-!3rd order stencil
- if (config_theta_adv_order == 3) then
- tend % w % array(k,cell2) = tend % w % array(k,cell2) + sign(1.0_RKIND,tend % u % array(k,iEdge)) &
- *config_coef_3rd_order*zf3(k,2,iEdge)*flux
- tend % w % array(k,cell1) = tend % w % array(k,cell1) - sign(1.0_RKIND,tend % u % array(k,iEdge)) &
- *config_coef_3rd_order*zf3(k,1,iEdge)*flux
- end if
-
+ tend % w % array(k,cell2) = tend % w % array(k,cell2) &
+ + (grid % zb % array(k,2,iEdge) + coef_3rd_order*sign(1.0_RKIND,tend % u % array(k,iEdge))*grid %zb3 % array(k,2,iEdge))*flux &
+ * (fzm(k) * grid % zz % array(k,cell2) + fzp(k) * grid % zz % array(k-1,cell2))
+ tend % w % array(k,cell1) = tend % w % array(k,cell1) &
+ - (grid % zb % array(k,1,iEdge) + coef_3rd_order*sign(1.0_RKIND,tend % u % array(k,iEdge))*grid %zb3 % array(k,1,iEdge))*flux &
+ * (fzm(k) * grid % zz % array(k,cell1) + fzp(k) * grid % zz % array(k-1,cell1))
end do
end do
@@ -749,7 +739,7 @@
zgrid, cofwr, cofwz, w, h_divergence
real (kind=RKIND), dimension(:), pointer :: fzm, fzp, rdzw, dcEdge, AreaCell, cofrz, dvEdge
- real (kind=RKIND), dimension(:,:), pointer :: cpr, cpl
+ real (kind=RKIND), dimension(:,:), pointer :: cpr, cpl, pzp, pzm
real (kind=RKIND) :: smdiv, c2, rcv
real (kind=RKIND), dimension( grid % nVertLevels ) :: du
@@ -797,6 +787,9 @@
gamma_tri => diag % gamma_tri % array
dss => grid % dss % array
+ pzp => grid % pzp % array
+ pzm => grid % pzm % array
+
tend_ru => tend % u % array
tend_rho => tend % rho_zz % array
tend_rt => tend % theta_m % array
@@ -883,23 +876,54 @@
else
k = 1
- dpzx(k) = .5*zx(k,iEdge)*(cf1*(zz(k ,cell2)*rtheta_pp_old(k ,cell2) &
- +zz(k ,cell1)*rtheta_pp_old(k ,cell1)) &
- +cf2*(zz(k+1,cell2)*rtheta_pp_old(k+1,cell2) &
- +zz(k+1,cell1)*rtheta_pp_old(k+1,cell1)) &
- +cf3*(zz(k+2,cell2)*rtheta_pp_old(k+2,cell2) &
- +zz(k+2,cell1)*rtheta_pp_old(k+2,cell1)))
- do k=2,grid % nVertLevels
- dpzx(k)=.5*zx(k,iEdge)*(fzm(k)*(zz(k ,cell2)*rtheta_pp_old(k ,cell2) &
- +zz(k ,cell1)*rtheta_pp_old(k ,cell1)) &
- +fzp(k)*(zz(k-1,cell2)*rtheta_pp_old(k-1,cell2) &
- +zz(k-1,cell1)*rtheta_pp_old(k-1,cell1)))
+! dpzx(k) = .5*zx(k,iEdge)*(cf1*(zz(k ,cell2)*rtheta_pp_old(k ,cell2) &
+! +zz(k ,cell1)*rtheta_pp_old(k ,cell1)) &
+! +cf2*(zz(k+1,cell2)*rtheta_pp_old(k+1,cell2) &
+! +zz(k+1,cell1)*rtheta_pp_old(k+1,cell1)) &
+! +cf3*(zz(k+2,cell2)*rtheta_pp_old(k+2,cell2) &
+! +zz(k+2,cell1)*rtheta_pp_old(k+2,cell1)))
+
+ dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
+ *(pzm(k,cell2)*(zz(k+1,cell2)*rtheta_pp_old(k+1,cell2) &
+ -zz(k ,cell2)*rtheta_pp_old(k ,cell2)) &
+ +pzm(k,cell1)*(zz(k+1,cell1)*rtheta_pp_old(k+1,cell1) &
+ -zz(k ,cell1)*rtheta_pp_old(k ,cell1)) &
+ +pzp(k,cell2)*(zz(k+2,cell2)*rtheta_pp_old(k+2,cell2) &
+ -zz(k ,cell2)*rtheta_pp_old(k ,cell2)) &
+ +pzp(k,cell1)*(zz(k+2,cell1)*rtheta_pp_old(k+2,cell1) &
+ -zz(k ,cell1)*rtheta_pp_old(k ,cell1)))
+
+ do k=2,grid % nVertLevels-1
+! dpzx(k)=.5*zx(k,iEdge)*(fzm(k)*(zz(k ,cell2)*rtheta_pp_old(k ,cell2) &
+! +zz(k ,cell1)*rtheta_pp_old(k ,cell1)) &
+! +fzp(k)*(zz(k-1,cell2)*rtheta_pp_old(k-1,cell2) &
+! +zz(k-1,cell1)*rtheta_pp_old(k-1,cell1)))
+ dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
+ *(pzp(k,cell2)*(zz(k+1,cell2)*rtheta_pp_old(k+1,cell2) &
+ -zz(k ,cell2)*rtheta_pp_old(k ,cell2)) &
+ +pzm(k,cell2)*(zz(k ,cell2)*rtheta_pp_old(k ,cell2) &
+ -zz(k-1,cell2)*rtheta_pp_old(k-1,cell2)) &
+ +pzp(k,cell1)*(zz(k+1,cell1)*rtheta_pp_old(k+1,cell1) &
+ -zz(k ,cell1)*rtheta_pp_old(k ,cell1)) &
+ +pzm(k,cell1)*(zz(k ,cell1)*rtheta_pp_old(k ,cell1) &
+ -zz(k-1,cell1)*rtheta_pp_old(k-1,cell1)))
end do
- dpzx(nVertLevels + 1) = 0.
+ k=grid % nVertLevels
+ dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
+ *(pzm(k,cell2)*(zz(k ,cell2)*rtheta_pp_old(k ,cell2) &
+ -zz(k-1,cell2)*rtheta_pp_old(k-1,cell2)) &
+ +pzm(k,cell1)*(zz(k ,cell1)*rtheta_pp_old(k ,cell1) &
+ -zz(k-1,cell1)*rtheta_pp_old(k-1,cell1)))
+
+! dpzx(nVertLevels + 1) = 0.
+
do k=1,nVertLevels
- pgrad = (rtheta_pp_old(k,cell2)-rtheta_pp_old(k,cell1))/dcEdge(iEdge) &
- - rdzw(k)*(dpzx(k+1)-dpzx(k))
+! pgrad = (rtheta_pp_old(k,cell2)-rtheta_pp_old(k,cell1))/dcEdge(iEdge) &
+! - rdzw(k)*(dpzx(k+1)-dpzx(k))
+ pgrad = ((rtheta_pp_old(k,cell2)*zz(k,cell2) &
+ -rtheta_pp_old(k,cell1)*zz(k,cell1))/dcEdge(iEdge) &
+ -dpzx(k))/(.5*(zz(k,cell2)+zz(k,cell1)))
pgrad = 0.5*c2*(exner(k,cell1)+exner(k,cell2))*pgrad
du(k) = dts*(tend_ru(k,iEdge) - cqu(k,iEdge) * pgrad)
! + (0.05/6.)*dcEdge(iEdge)*(h_divergence(k,cell2)-h_divergence(k,cell1))
@@ -987,11 +1011,11 @@
end do ! end of loop over cells
- end subroutine atm_advance_acoustic_step
+ end subroutine atm_advance_acoustic_step
!------------------------
- subroutine atm_recover_large_step_variables( s, diag, tend, grid, dt, ns, rk_step )
+ subroutine atm_recover_large_step_variables( s, diag, tend, grid, dt, ns, rk_step )
implicit none
type (state_type) :: s
@@ -1171,7 +1195,7 @@
enddo
- end subroutine atm_recover_large_step_variables
+ end subroutine atm_recover_large_step_variables
!---------------------------------------------------------------------------------------
@@ -1841,7 +1865,7 @@
real (kind=RKIND), dimension(:), pointer :: rdzu, rdzw, fzm, fzp, qv_init
real (kind=RKIND), dimension(:,:), pointer :: t_init
- real (kind=RKIND), dimension(:,:), pointer :: cpr, cpl
+ real (kind=RKIND), dimension(:,:), pointer :: cpr, cpl, pzp, pzm
integer :: kr, kl
real (kind=RKIND), allocatable, dimension(:,:) :: rv, divergence_ru, qtot
@@ -1907,7 +1931,10 @@
pressure_b => diag % pressure_base % array
h_divergence => diag % h_divergence % array
+ pzp => grid % pzp % array
+ pzm => grid % pzm % array
+
weightsOnEdge => grid % weightsOnEdge % array
cellsOnEdge => grid % cellsOnEdge % array
verticesOnEdge => grid % verticesOnEdge % array
@@ -2046,16 +2073,69 @@
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
- k = 1
- dpzx(k) = .5*zx(k,iEdge)*(cf1*(pp(k ,cell2)+pp(k ,cell1)) &
- +cf2*(pp(k+1,cell2)+pp(k+1,cell1)) &
- +cf3*(pp(k+2,cell2)+pp(k+2,cell1)))
- do k=2,nVertLevels
- dpzx(k) = .5*zx(k,iEdge)*(fzm(k)*(pp(k ,cell2)+pp(k ,cell1)) &
- +fzp(k)*(pp(k-1,cell2)+pp(k-1,cell1)))
- end do
- dpzx(nVertLevels+1) = 0.
+ if(newpx) then
+ k = 1
+ pr = cpr(k,iEdge)*pp(k,cell2)+cpr(k+1,iEdge)*pp(k+1,cell2)+cpr(k+2,iEdge)*pp(k+2,cell2)
+ pl = cpl(k,iEdge)*pp(k,cell1)+cpl(k+1,iEdge)*pp(k+1,cell1)+cpl(k+2,iEdge)*pp(k+2,cell1)
+ tend_u(k,iEdge) = - cqu(k,iEdge)*2./(zz(k,cell1)+zz(k,cell2))*(pr-pl)/dcEdge(iEdge)
+
+ do k=2,nVertLevels
+
+ kr = min(nVertLevels,k+ nint(.5-sign(0.5_RKIND,zx(k,iEdge)+zx(k+1,iEdge))))
+ kl = min(nVertLevels,2*k+1-kr)
+
+ pr = pp(k,cell2)+.5*(zgrid(k ,cell1)+zgrid(k +1,cell1)-zgrid(k ,cell2)-zgrid(k +1,cell2)) &
+ /(zgrid(kr+1,cell2)-zgrid(kr-1,cell2))*( pp(kr,cell2)-pp (kr-1,cell2))
+ pl = pp(k,cell1)+.5*(zgrid(k ,cell2)+zgrid(k +1,cell2)-zgrid(k ,cell1)-zgrid(k +1,cell1)) &
+ /(zgrid(kl+1,cell1)-zgrid(kl-1,cell1))*( pp(kl,cell1)-pp (kl-1,cell1))
+ tend_u(k,iEdge) = - cqu(k,iEdge)*2./(zz(k,cell1)+zz(k,cell2))*(pr-pl)/dcEdge(iEdge)
+
+ end do
+
+ else
+ k = 1
+!! dpzx(k) = .5*zx(k,iEdge)*(cf1*(pp(k ,cell2)+pp(k ,cell1)) &
+!! +cf2*(pp(k+1,cell2)+pp(k+1,cell1)) &
+!! +cf3*(pp(k+2,cell2)+pp(k+2,cell1)))
+
+ dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
+ *(pzm(k,cell2)*(pp(k+1,cell2)-pp(k,cell2)) &
+ +pzm(k,cell1)*(pp(k+1,cell1)-pp(k,cell1)) &
+ +pzp(k,cell2)*(pp(k+2,cell2)-pp(k,cell2)) &
+ +pzp(k,cell1)*(pp(k+2,cell1)-pp(k,cell1)))
+
+ do k = 2, nVertLevels-1
+
+!! dpzx(k) = .5*zx(k,iEdge)*(fzm(k)*(pp(k ,cell2)+pp(k ,cell1)) &
+!! +fzp(k)*(pp(k-1,cell2)+pp(k-1,cell1)))
+
+ dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
+ *(pzp(k,cell2)*(pp(k+1,cell2)-pp(k ,cell2)) &
+ +pzm(k,cell2)*(pp(k ,cell2)-pp(k-1,cell2)) &
+ +pzp(k,cell1)*(pp(k+1,cell1)-pp(k ,cell1)) &
+ +pzm(k,cell1)*(pp(k ,cell1)-pp(k-1,cell1)))
+
+ end do
+
+ k = nVertLevels
+ dpzx(k) = .25*(zx(k,iEdge)+zx(k+1,iEdge)) &
+ *(pzm(k,cell2)*(pp(k ,cell2)-pp(k-1,cell2)) &
+ +pzm(k,cell1)*(pp(k ,cell1)-pp(k-1,cell1)))
+
+!! dpzx(nVertLevels+1) = 0.
+
+ do k=1,nVertLevels
+
+!! tend_u(k,iEdge) = - cqu(k,iEdge)*( (pp(k,cell2)/zz(k,cell2) - pp(k,cell1)/zz(k,cell1)) &
+!! / dcEdge(iEdge) - rdzw(k)*(dpzx(k+1)-dpzx(k)) )
+
+ tend_u(k,iEdge) = - cqu(k,iEdge)*((pp(k,cell2)-pp(k,cell1))/dcEdge(iEdge) &
+ - dpzx(k) ) / (.5*(zz(k,cell2)+zz(k,cell1)))
+ end do
+
+ end if
+
wduz(1) = 0.
k = 2
wduz(k) = 0.5*( rw(k,cell1)+rw(k,cell2) )*(fzm(k)*u(k,iEdge)+fzp(k)*u(k-1,iEdge))
@@ -2068,8 +2148,8 @@
wduz(nVertLevels+1) = 0.
do k=1,nVertLevels
- tend_u(k,iEdge) = - cqu(k,iEdge)*( (pp(k,cell2)/zz(k,cell2) - pp(k,cell1)/zz(k,cell1)) &
- / dcEdge(iEdge) - rdzw(k)*(dpzx(k+1)-dpzx(k)) )
+! tend_u(k,iEdge) = - cqu(k,iEdge)*( (pp(k,cell2)/zz(k,cell2) - pp(k,cell1)/zz(k,cell1)) &
+! / dcEdge(iEdge) - rdzw(k)*(dpzx(k+1)-dpzx(k)) )
tend_u(k,iEdge) = tend_u(k,iEdge) - rdzw(k)*(wduz(k+1)-wduz(k))
end do
@@ -2281,7 +2361,11 @@
cell2 = cellsOnEdge(2,iEdge)
do k=1,nVertLevels
+#ifdef ROTATED_GRID
+ u_mix(k) = u(k,iEdge) - grid % u_init % array(k) * sin( grid % angleEdge % array(iEdge) )
+#else
u_mix(k) = u(k,iEdge) - grid % u_init % array(k) * cos( grid % angleEdge % array(iEdge) )
+#endif
end do
do k=2,nVertLevels-1
@@ -2592,7 +2676,7 @@
do k=2,nVertLevels
tend_w(k,iCell) = tend_w(k,iCell)/areaCell(iCell) -rdzu(k)*(wdwz(k+1)-wdwz(k)) &
-!SHP-w
+!SHP-buoy
- cqw(k,iCell)*( rdzu(k)*(pp(k,iCell)-pp(k-1,iCell)) &
+ gravity* &
( fzm(k)*(rb(k,iCell)*(qtot(k,iCell)) + &
@@ -3254,9 +3338,14 @@
type (diag_type), intent(inout) :: diag
type (mesh_type), intent(inout) :: grid
- integer :: k,iCell,iEdge,i,iCell1,iCell2, cell1, cell2
+ !SHP-w
+ integer :: k,iCell,iEdge,i,iCell1,iCell2, cell1, cell2, coef_3rd_order
real (kind=RKIND) :: p0, rcv, flux
+ !SHP-w
+ coef_3rd_order = config_coef_3rd_order
+ if(config_theta_adv_order /=3) coef_3rd_order = 0
+
rcv = rgas / (cp-rgas)
p0 = 1.e5 ! this should come from somewhere else...
@@ -3300,27 +3389,22 @@
* (grid % fzp % array(k) * grid % zz % array(k-1,iCell) + grid % fzm % array(k) * grid % zz % array(k,iCell))
end do
end do
+
+ !SHP-w
! next, the piece that depends on ru
do iEdge=1,grid%nEdges
cell1 = grid % CellsOnEdge % array(1,iEdge)
cell2 = grid % CellsOnEdge % array(2,iEdge)
do k = 2, grid % nVertLevels
flux = (grid % fzm % array(k) * diag % ru % array(k,iEdge)+grid % fzp % array(k) * diag % ru % array(k-1,iEdge))
- diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + grid % zb % array(k,2,iEdge)*flux &
+ diag % rw % array(k,cell2) = diag % rw % array(k,cell2) &
+ + (grid % zb % array(k,2,iEdge) + coef_3rd_order * sign(1.0_RKIND,flux) * grid % zb3 % array(k,2,iEdge))*flux &
* (grid % fzp % array(k) * grid % zz % array(k-1,cell2) + grid % fzm % array(k) * grid % zz % array(k,cell2))
- diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - grid % zb % array(k,1,iEdge)*flux &
+ diag % rw % array(k,cell1) = diag % rw % array(k,cell1) &
+ - (grid % zb % array(k,1,iEdge) + coef_3rd_order * sign(1.0_RKIND,flux) * grid % zb3 % array(k,1,iEdge))*flux &
* (grid % fzp % array(k) * grid % zz % array(k-1,cell1) + grid % fzm % array(k) * grid % zz % array(k,cell1))
-!3rd order! stencil
- if (config_theta_adv_order ==3) then
- diag % rw % array(k,cell2) = diag % rw % array(k,cell2) + sign(1.0_RKIND,flux)*config_coef_3rd_order &
- * grid % zb3 % array(k,2,iEdge)*flux &
- * (grid % fzp % array(k) * grid % zz % array(k-1,cell2) + grid % fzm % array(k) * grid % zz % array(k,cell2))
- diag % rw % array(k,cell1) = diag % rw % array(k,cell1) - sign(1.0_RKIND,flux)*config_coef_3rd_order &
- * grid % zb3 % array(k,1,iEdge)*flux &
- * (grid % fzp % array(k) * grid % zz % array(k-1,cell1) + grid % fzm % array(k) * grid % zz % array(k,cell1))
- end if
- enddo
- enddo
+ end do
+ end do
! end WCS bug fix
@@ -3360,161 +3444,5 @@
end subroutine atm_init_coupled_diagnostics
-! ------------------------
- subroutine atm_qd_kessler( state_old, state_new, diag, tend, grid, dt )
-
- implicit none
-
- type (state_type), intent(inout) :: state_old, state_new
- type (diag_type), intent(inout) :: diag
- type (tend_type), intent(inout) :: tend
- type (mesh_type), intent(inout) :: grid
- real (kind=RKIND), intent(in) :: dt
-
- real (kind=RKIND), dimension( grid % nVertLevels ) :: t, rho, p, dzu, qv, qc, qr, qc1, qr1
-
- integer :: k,iEdge,i,iCell,nz1
- real (kind=RKIND) :: p0,rcv
-
-
- write(0,*) ' in qd_kessler '
-
- p0 = 1.e+05
- rcv = rgas/(cp-rgas)
- nz1 = grid % nVertLevels
-
- do iCell = 1, grid % nCellsSolve
-
- do k = 1, grid % nVertLevels
-
- tend % rt_diabatic_tend % array(k,iCell) = state_new % theta_m % array(k,iCell)
-
- t(k) = state_new % theta_m % array(k,iCell)/(1. + 1.61*state_new % scalars % array(state_new % index_qv,k,iCell))
- rho(k) = grid % zz % array(k,iCell)*state_new % rho_zz % array(k,iCell)
- p(k) = diag % exner % array(k,iCell)
- qv(k) = max(0.0_RKIND,state_new % scalars % array(state_new % index_qv,k,iCell))
- qc(k) = max(0.0_RKIND,state_new % scalars % array(state_new % index_qc,k,iCell))
- qr(k) = max(0.0_RKIND,state_new % scalars % array(state_new % index_qr,k,iCell))
- qc1(k) = max(0.0_RKIND,state_old % scalars % array(state_old % index_qc,k,iCell))
- qr1(k) = max(0.0_RKIND,state_old % scalars % array(state_old % index_qr,k,iCell))
- dzu(k) = grid % dzu % array(k)
-
- end do
-
- call atm_kessler( t,qv,qc,qc1,qr,qr1,rho,p,dt,dzu,nz1, 1)
-
- do k = 1, grid % nVertLevels
-
- state_new % theta_m % array(k,iCell) = t(k)*(1.+1.61*qv(k))
- tend % rt_diabatic_tend % array(k,iCell) = state_new % rho_zz % array(k,iCell) * &
- (state_new % theta_m % array(k,iCell) - tend % rt_diabatic_tend % array(k,iCell))/dt
- diag % rtheta_p % array(k,iCell) = state_new % rho_zz % array(k,iCell) * state_new % theta_m % array(k,iCell) &
- - diag % rtheta_base % array(k,iCell)
- state_new % scalars % array(state_new % index_qv,k,iCell) = qv(k)
- state_new % scalars % array(state_new % index_qc,k,iCell) = qc(k)
- state_new % scalars % array(state_new % index_qr,k,iCell) = qr(k)
-
- diag % exner % array(k,iCell) = &
- ( grid % zz % array(k,iCell)*(rgas/p0) * ( &
- diag % rtheta_p % array(k,iCell) &
- + diag % rtheta_base % array(k,iCell) ) )**rcv
-
- diag % pressure_p % array(k,iCell) = &
- grid % zz % array(k,iCell) * rgas * ( &
- diag % exner % array(k,iCell)*diag % rtheta_p % array(k,iCell) &
- +diag % rtheta_base % array(k,iCell) * &
- (diag % exner % array(k,iCell) - diag % exner_base % array(k,iCell)) )
- end do
-
- end do
-
- write(0,*) ' exiting qd_kessler '
-
- end subroutine atm_qd_kessler
-
-!-----------------------------------------------------------------------
- subroutine atm_kessler( t1t, qv1t, qc1t, qc1, qr1t, qr1, &
- rho, pii, dt, dzu, nz1, nx )
-!-----------------------------------------------------------------------
-!
- implicit none
- integer :: nx, nz1
- real (kind=RKIND) :: t1t (nz1,nx), qv1t(nz1,nx), qc1t(nz1,nx), &
- qr1t(nz1,nx), qc1 (nz1,nx), qr1 (nz1,nx), &
- rho (nz1,nx), pii (nz1,nx), dzu(nz1)
- integer, parameter :: mz=200
- real (kind=RKIND) :: qrprod(mz), prod (mz), rcgs( mz), rcgsi (mz) &
- ,ern (mz), vt (mz), vtden(mz), gam (mz) &
- ,r (mz), rhalf(mz), velqr(mz), buoycy(mz) &
- ,pk (mz), pc (mz), f0 (mz), qvs (mz)
-
- real (kind=RKIND) :: c1, c2, c3, c4, f5, mxfall, dtfall, fudge, dt, velu, veld, artemp, artot
- real (kind=RKIND) :: cp, product, ackess, ckess, fvel, f2x, xk, xki, psl
- integer :: nfall
- integer :: i,k,n
-
- ackess = 0.001
- ckess = 2.2
- fvel = 36.34
- f2x = 17.27
- f5 = 237.3*f2x*2.5e6/1003.
- xk = .2875
- xki = 1./xk
- psl = 1000.
-
- do k=1,nz1
- r(k) = 0.001*rho(k,1)
- rhalf(k) = sqrt(rho(1,1)/rho(k,1))
- pk(k) = pii(k,1)
- pc(k) = 3.8/(pk(k)**xki*psl)
- f0(k) = 2.5e6/(1003.*pk(k))
- end do
-!
- do i=1,nx
- do k=1,nz1
- qrprod(k) = qc1t(k,i) &
- -(qc1t(k,i)-dt*max(ackess*(qc1(k,i)-.001), &
- 0.0_RKIND))/(1.+dt*ckess*qr1(k,i)**.875)
- velqr(k) = (qr1(k,i)*r(k))**1.1364*rhalf(k)
- qvs(k) = pc(k)*exp(f2x*(pk(k)*t1t(k,i)-273.) &
- /(pk(k)*t1t(k,i)- 36.))
- end do
- velu = (qr1(2,i)*r(2))**1.1364*rhalf(2)
- veld = (qr1(1,i)*r(1))**1.1364*rhalf(1)
- qr1t(1,i) = qr1t(1,i)+dt*(velu-veld)*fvel/(r(1)*dzu(2))
- do k=2,nz1-1
- qr1t(k,i) = qr1t(k,i)+dt*fvel/r(k) &
- *.5*((velqr(k+1)-velqr(k ))/dzu(k+1) &
- +(velqr(k )-velqr(k-1))/dzu(k ))
- end do
- qr1t(nz1,i) = qr1t(nz1,i)-dt*fvel*velqr(nz1-1) &
- /(r(nz1)*dzu(nz1)*(1.+1.))
- artemp = 36340.*(.5*(velqr(2)+velqr(1))+veld-velu)
- artot = artot+dt*artemp
- do k=1,nz1
- qc1t(k,i) = max(qc1t(k,i)-qrprod(k),0.0_RKIND)
- qr1t(k,i) = max(qr1t(k,i)+qrprod(k),0.0_RKIND)
- prod(k) = (qv1t(k,i)-qvs(k))/(1.+qvs(k)*f5 &
- /(pk(k)*t1t(k,i)-36.)**2)
- end do
- do k=1,nz1
- ern(k) = min(dt*(((1.6+124.9*(r(k)*qr1t(k,i))**.2046) &
- *(r(k)*qr1t(k,i))**.525)/(2.55e6*pc(k) &
- /(3.8 *qvs(k))+5.4e5))*(dim(qvs(k),qv1t(k,i)) &
- /(r(k)*qvs(k))), &
- max(-prod(k)-qc1t(k,i),0.0_RKIND),qr1t(k,i))
- end do
- do k=1,nz1
- buoycy(k) = f0(k)*(max(prod(k),-qc1t(k,i))-ern(k))
- qv1t(k,i) = max(qv1t(k,i) &
- -max(prod(k),-qc1t(k,i))+ern(k),0.0_RKIND)
- qc1t(k,i) = qc1t(k,i)+max(prod(k),-qc1t(k,i))
- qr1t(k,i) = qr1t(k,i)-ern(k)
- t1t (k,i) = t1t (k,i)+buoycy(k)
- end do
- end do
-
- end subroutine atm_kessler
-
end module atm_time_integration
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean:754-986
/branches/ocean_projects/rayleigh/src/core_ocean:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean:1301-1414
/branches/source_renaming/src/core_ocean:1082-1113
/branches/time_manager/src/core_ocean:924-962
/trunk/mpas/src/core_ocean:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean:754-986
/branches/ocean_projects/rayleigh/src/core_ocean:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean:1301-1414
/branches/source_renaming/src/core_ocean:1082-1113
/branches/time_manager/src/core_ocean:924-962
/trunk/mpas/src/core_ocean:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/Registry
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/Registry 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/Registry 2012-02-28 00:35:39 UTC (rev 1539)
@@ -23,6 +23,7 @@
namelist logical restart config_do_restart false
namelist character restart config_restart_interval none
namelist character grid config_vert_grid_type isopycnal
+namelist character grid config_pressure_type pressure
namelist real grid config_rho0 1028
namelist integer split_explicit_ts config_n_ts_iter 2
namelist integer split_explicit_ts config_n_bcl_iter_beg 2
@@ -33,8 +34,6 @@
namelist logical split_explicit_ts config_u_correction true
namelist logical split_explicit_ts config_filter_btr_mode false
namelist integer split_explicit_ts config_btr_subcycle_loop_factor 2
-namelist character split_explicit_ts config_SSH_from avg_flux
-namelist character split_explicit_ts config_new_btr_variables_from btr_avg
namelist real split_explicit_ts config_btr_gam1_uWt1 0.5
namelist real split_explicit_ts config_btr_gam2_SSHWt1 1.0
namelist real split_explicit_ts config_btr_gam3_uWt2 1.0
@@ -172,12 +171,9 @@
var persistent integer maxLevelEdgeBot ( nEdges ) 0 - maxLevelEdgeBot mesh - -
var persistent integer maxLevelVertexTop ( nVertices ) 0 - maxLevelVertexTop mesh - -
var persistent integer maxLevelVertexBot ( nVertices ) 0 - maxLevelVertexBot mesh - -
+var persistent real referenceBottomDepth ( nVertLevels ) 0 iro referenceBottomDepth mesh - -
+var persistent real referenceBottomDepthTopOfCell ( nVertLevelsP1 ) 0 - referenceBottomDepthTopOfCell mesh - -
var persistent real hZLevel ( nVertLevels ) 0 iro hZLevel mesh - -
-var persistent real zMidZLevel ( nVertLevels ) 0 - zMidZLevel mesh - -
-var persistent real zTopZLevel ( nVertLevelsP1 ) 0 - zTopZLevel mesh - -
-var persistent real hMeanTopZLevel ( nVertLevels ) 0 - hMeanTopZLevel mesh - -
-var persistent real hRatioZLevelK ( nVertLevels ) 0 - hRatioZLevelK mesh - -
-var persistent real hRatioZLevelKm1 ( nVertLevels ) 0 - hRatioZLevelKm1 mesh - -
% Boundary conditions: read from input, saved in restart and written to output
var persistent integer boundaryEdge ( nVertLevels nEdges ) 0 iro boundaryEdge mesh - -
@@ -192,7 +188,7 @@
% Prognostic variables: read from input, saved in restart, and written to output
var persistent real u ( nVertLevels nEdges Time ) 2 ir u state - -
-var persistent real h ( nVertLevels nCells Time ) 2 ir h state - -
+var persistent real h ( nVertLevels nCells Time ) 2 iro h state - -
var persistent real rho ( nVertLevels nCells Time ) 2 iro rho state - -
var persistent real temperature ( nVertLevels nCells Time ) 2 iro temperature state tracers dynamics
var persistent real salinity ( nVertLevels nCells Time ) 2 iro salinity state tracers dynamics
@@ -214,12 +210,9 @@
var persistent real FBtr ( nEdges Time ) 2 - FBtr state - -
var persistent real GBtrForcing ( nEdges Time ) 2 - GBtrForcing state - -
var persistent real uBcl ( nVertLevels nEdges Time ) 2 - uBcl state - -
-var persistent real circulationBtr ( nVertices Time ) 2 - circulationBtr state - -
-var persistent real divergenceBtr ( nCells Time ) 2 - divergenceBtr state - -
-var persistent real vorticityBtr ( nVertices Time ) 2 - vorticityBtr state - -
-var persistent real u_diffusionBtr ( nEdges Time ) 2 - u_diffusionBtr state - -
% Diagnostic fields: only written to output
+var persistent real zMid ( nVertLevels nCells Time ) 2 io zMid state - -
var persistent real v ( nVertLevels nEdges Time ) 2 - v state - -
var persistent real divergence ( nVertLevels nCells Time ) 2 o divergence state - -
var persistent real vorticity ( nVertLevels nVertices Time ) 2 o vorticity state - -
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/Registry
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/Registry:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/Registry:754-986
/branches/ocean_projects/performance/src/core_ocean/Registry:1120-1372
/branches/ocean_projects/rayleigh/src/core_ocean/Registry:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/Registry:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/Registry:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/Registry:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/Registry:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/Registry:1301-1414
/branches/source_renaming/src/core_ocean/Registry:1082-1113
/branches/time_manager/src/core_ocean/Registry:924-962
/trunk/mpas/src/core_ocean/Registry:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/Registry:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/Registry:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/Registry:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/Registry:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/Registry:754-986
/branches/ocean_projects/performance/src/core_ocean/Registry:1120-1372
/branches/ocean_projects/rayleigh/src/core_ocean/Registry:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/Registry:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/Registry:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/Registry:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/Registry:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/Registry:1301-1414
/branches/source_renaming/src/core_ocean/Registry:1082-1113
/branches/time_manager/src/core_ocean/Registry:924-962
/trunk/mpas/src/core_ocean/Registry:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_advection.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_advection.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_advection.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_advection.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_advection.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_advection.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_advection.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_advection.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_advection.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_advection.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_advection.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_advection.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_advection.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_advection.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_advection.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_advection.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_advection.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_advection.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_advection.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_advection.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_advection.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_advection.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_advection.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_advection.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_advection.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_advection.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_advection.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_advection.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_equation_of_state.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_equation_of_state.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_equation_of_state.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -154,7 +154,7 @@
linearEos = .false.
jmEos = .false.
- if(config_vert_grid_type.eq.'zlevel') then
+ if(config_vert_grid_type.ne.'isopycnal') then
eosON = .true.
if (config_eos_type.eq.'linear') then
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_equation_of_state.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_equation_of_state.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_equation_of_state.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_equation_of_state.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_equation_of_state.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_equation_of_state.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_equation_of_state.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_equation_of_state.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_equation_of_state.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_equation_of_state.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_equation_of_state.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_equation_of_state.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_equation_of_state.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_equation_of_state.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_equation_of_state.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_equation_of_state.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_equation_of_state.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_equation_of_state.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_equation_of_state.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_equation_of_state.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_equation_of_state.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_equation_of_state.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_equation_of_state.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_equation_of_state.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_equation_of_state.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_equation_of_state.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_equation_of_state_jm.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_equation_of_state_jm.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_equation_of_state_jm.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -95,7 +95,7 @@
real (kind=RKIND), dimension(:), pointer :: &
- zMidZLevel, pRefEOS
+ referenceBottomDepth, pRefEOS
real (kind=RKIND), dimension(:,:), intent(inout) :: &
rho
real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
@@ -196,7 +196,7 @@
nCells = grid % nCells
maxLevelCell => grid % maxLevelCell % array
nVertLevels = grid % nVertLevels
- zMidZLevel => grid % zMidZLevel % array
+ referenceBottomDepth => grid % referenceBottomDepth % array
! Jackett and McDougall
@@ -205,20 +205,24 @@
smin = 0.0 ! valid salinity, in psu
smax = 42.0
- ! This could be put in a startup routine.
- ! Note I am using zMidZlevel, so pressure on top level does
- ! not include SSH contribution. I am not sure if that matters.
-
! This function computes pressure in bars from depth in meters
! using a mean density derived from depth-dependent global
! average temperatures and salinities from Levitus 1994, and
! integrating using hydrostatic balance.
allocate(pRefEOS(nVertLevels),p(nVertLevels),p2(nVertLevels))
- do k = 1,nVertLevels
- depth = -zMidZLevel(k)
- pRefEOS(k) = 0.059808*(exp(-0.025*depth) - 1.0) &
- + 0.100766*depth + 2.28405e-7*depth**2
+
+ ! This could be put in the init routine.
+ ! Note I am using referenceBottomDepth, so pressure on top level does
+ ! not include SSH contribution. I am not sure if that matters, but
+ ! POP does it the same way.
+ depth = 0.5*referenceBottomDepth(1)
+ pRefEOS(1) = 0.059808*(exp(-0.025*depth) - 1.0) &
+ + 0.100766*depth + 2.28405e-7*depth**2
+ do k = 2,nVertLevels
+ depth = 0.5*(referenceBottomDepth(k)+referenceBottomDepth(k-1))
+ pRefEOS(k) = 0.059808*(exp(-0.025*depth) - 1.0) &
+ + 0.100766*depth + 2.28405e-7*depth**2
enddo
! If k_displaced=0, in-situ density is returned (no displacement)
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_equation_of_state_jm.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_equation_of_state_jm.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_equation_of_state_jm.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_equation_of_state_jm.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_equation_of_state_jm.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_equation_of_state_jm.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_equation_of_state_jm.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_equation_of_state_jm.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_equation_of_state_linear.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_equation_of_state_linear.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_equation_of_state_linear.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_equation_of_state_linear.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_equation_of_state_linear.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_equation_of_state_linear.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_equation_of_state_linear.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_equation_of_state_linear.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_global_diagnostics.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_global_diagnostics.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_global_diagnostics.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -430,7 +430,7 @@
write (fileID,'(100es24.14)') averages(1:nVariables)
close (fileID)
open(fileID,file='stats_time.txt',ACCESS='append')
- write (fileID,'(i5,10x,a,100es24.14)') timeIndex, &
+ write (fileID,'(i10,10x,a,100es24.14)') timeIndex, &
state % xtime % scalar, dt, &
CFLNumberGlobal
close (fileID)
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_global_diagnostics.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_global_diagnostics.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_global_diagnostics.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_global_diagnostics.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_global_diagnostics.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_global_diagnostics.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_global_diagnostics.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_global_diagnostics.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_global_diagnostics.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_global_diagnostics.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_global_diagnostics.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_global_diagnostics.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_global_diagnostics.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_global_diagnostics.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_global_diagnostics.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_global_diagnostics.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_global_diagnostics.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_global_diagnostics.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_global_diagnostics.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_global_diagnostics.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_global_diagnostics.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_global_diagnostics.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_global_diagnostics.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_global_diagnostics.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_global_diagnostics.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_global_diagnostics.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_global_diagnostics.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_global_diagnostics.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_mpas_core.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_mpas_core.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_mpas_core.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -98,24 +98,33 @@
call ocn_compute_max_level(domain)
- if (config_vert_grid_type.eq.'isopycnal') then
- print *, ' Using isopycnal coordinates'
- elseif (config_vert_grid_type.eq.'zlevel') then
- print *, ' Using z-level coordinates'
- call ocn_init_z_level(domain)
- else
- print *, ' Incorrect choice of config_vert_grid_type:',&
- config_vert_grid_type
+ call ocn_init_z_level(domain)
+
+ print *, ' Vertical grid type is: ',config_vert_grid_type
+
+ if (config_vert_grid_type.ne.'isopycnal'.and. &
+ config_vert_grid_type.ne.'zlevel'.and. &
+ config_vert_grid_type.ne.'zstar1'.and. &
+ config_vert_grid_type.ne.'zstar'.and. &
+ config_vert_grid_type.ne.'zstarWeights') then
+ print *, ' Incorrect choice of config_vert_grid_type.'
call mpas_dmpar_abort(dminfo)
endif
- if (trim(config_new_btr_variables_from) == 'btr_avg' &
- .and.trim(config_time_integration) == 'unsplit_explicit') then
- print *, ' unsplit_explicit option must use',&
- ' config_new_btr_variables_from==last_subcycle'
+ print *, ' Pressure type is: ',config_pressure_type
+ if (config_pressure_type.ne.'pressure'.and. &
+ config_pressure_type.ne.'MontgomeryPotential') then
+ print *, ' Incorrect choice of config_pressure_type.'
call mpas_dmpar_abort(dminfo)
endif
+ if (config_filter_btr_mode.and. &
+ config_vert_grid_type.ne.'zlevel')then
+ print *, 'filter_btr_mode has only been tested with'// &
+ ' config_vert_grid_type=zlevel.'
+ call mpas_dmpar_abort(dminfo)
+ endif
+
!
! Initialize core
!
@@ -223,6 +232,8 @@
call ocn_diagnostic_solve(dt, block % state % time_levs(1) % state, mesh)
call mpas_timer_stop("diagnostic solve", initDiagSolveTimer)
+ call ocn_wtop(block % state % time_levs(1) % state,block % state % time_levs(1) % state, mesh)
+
call ocn_compute_mesh_scaling(mesh)
call mpas_rbf_interp_initialize(mesh)
@@ -239,6 +250,8 @@
! The reconstructed velocity on land will have values not exactly
! -1e34 due to the interpolation of reconstruction.
+ block % mesh % areaCell % array(block % mesh % nCells+1) = -1.0e34
+
do iEdge=1,block % mesh % nEdges
! mrp 101115 note: in order to include flux boundary conditions, the following
! line will need to change. Right now, set boundary edges between land and
@@ -261,7 +274,7 @@
! :block % mesh % nVertLevels,iCell) = -1e34
! mrp 110516, added just to test for conservation of tracers
-! block % state % time_levs(1) % state % tracers % array(block % state % time_levs(1) % state % index_tracer1,:,iCell) = 1.0
+ block % state % time_levs(1) % state % tracers % array(block % state % time_levs(1) % state % index_tracer1,:,iCell) = 1.0
end do
@@ -480,76 +493,54 @@
end subroutine mpas_timestep!}}}
-subroutine ocn_init_z_level(domain)!{{{
-! Initialize maxLevel and bouncary grid variables.
+ subroutine ocn_init_z_level(domain)!{{{
+ ! Initialize maxLevel and bouncary grid variables.
- use mpas_grid_types
- use mpas_configure
+ use mpas_grid_types
+ use mpas_configure
- implicit none
+ implicit none
- type (domain_type), intent(inout) :: domain
+ type (domain_type), intent(inout) :: domain
- integer :: i, iCell, iEdge, iVertex, k
- type (block_type), pointer :: block
+ integer :: i, iCell, iEdge, iVertex, k
+ type (block_type), pointer :: block
- integer :: iTracer, cell, cell1, cell2
- real (kind=RKIND) :: uhSum, hSum, sshEdge
- real (kind=RKIND), dimension(:), pointer :: &
- hZLevel, zMidZLevel, zTopZLevel, &
- hMeanTopZLevel, hRatioZLevelK, hRatioZLevelKm1
- real (kind=RKIND), dimension(:,:), pointer :: h
- integer :: nVertLevels
+ integer :: iTracer, cell, cell1, cell2
+ real (kind=RKIND) :: uhSum, hSum, hEdge1
+ real (kind=RKIND), dimension(:), pointer :: &
+ referenceBottomDepth, referenceBottomDepthTopOfCell
+ real (kind=RKIND), dimension(:,:), pointer :: h
+ integer :: nVertLevels
- ! Initialize z-level grid variables from h, read in from input file.
- block => domain % blocklist
- do while (associated(block))
+ ! Initialize z-level grid variables from h, read in from input file.
+ block => domain % blocklist
+ do while (associated(block))
- h => block % state % time_levs(1) % state % h % array
- hZLevel => block % mesh % hZLevel % array
- zMidZLevel => block % mesh % zMidZLevel % array
- zTopZLevel => block % mesh % zTopZLevel % array
- nVertLevels = block % mesh % nVertLevels
- hMeanTopZLevel => block % mesh % hMeanTopZLevel % array
- hRatioZLevelK => block % mesh % hRatioZLevelK % array
- hRatioZLevelKm1 => block % mesh % hRatioZLevelKm1 % array
+ h => block % state % time_levs(1) % state % h % array
+ referenceBottomDepth => block % mesh % referenceBottomDepth % array
+ referenceBottomDepthTopOfCell => block % mesh % referenceBottomDepthTopOfCell % array
+ nVertLevels = block % mesh % nVertLevels
- ! These should eventually be in an input file. For now
- ! I just read them in from h(:,1).
- ! Upon restart, the correct hZLevel should be in restart.nc
- if (.not. config_do_restart) hZLevel = h(:,1)
+ ! mrp 120208 right now hZLevel is in the grid.nc file.
+ ! We would like to transition to using referenceBottomDepth
+ ! as the defining variable instead, and will transition soon.
+ ! When the transition is done, hZLevel can be removed from
+ ! registry and the following four lines deleted.
+ referenceBottomDepth(1) = block % mesh % hZLevel % array(1)
+ do k = 2,nVertLevels
+ referenceBottomDepth(k) = referenceBottomDepth(k-1) + block % mesh % hZLevel % array(k)
+ end do
- ! hZLevel should be in the grid.nc and restart.nc file,
- ! and h for k=1 must be specified there as well.
-
- zTopZLevel(1) = 0.0
- do k = 1,nVertLevels
- zMidZLevel(k) = zTopZLevel(k)-0.5*hZLevel(k)
- zTopZLevel(k+1) = zTopZLevel(k)- hZLevel(k)
- end do
+ ! TopOfCell needed where zero depth for the very top may be referenced.
+ referenceBottomDepthTopOfCell(1) = 0.0
+ do k = 1,nVertLevels
+ referenceBottomDepthTopOfCell(k+1) = referenceBottomDepth(k)
+ end do
- hMeanTopZLevel(1) = 0.0
- hRatioZLevelK(1) = 0.0
- hRatioZLevelKm1(1) = 0.0
- do k = 2,nVertLevels
- hMeanTopZLevel(k) = 0.5*(hZLevel(k-1) + hZLevel(k))
- hRatioZLevelK(k) = 0.5*hZLevel(k)/hMeanTopZLevel(k)
- hRatioZLevelKm1(k) = 0.5*hZLevel(k-1)/hMeanTopZLevel(k)
- end do
-
- ! mrp 110601 For now, h is the variable saved in the restart file
- ! I am computing SSH here. In the future, could make smaller
- ! restart files for z-Level runs by saving SSH only.
- do iCell=1,block % mesh % nCells
-
- block % state % time_levs(1) % state % ssh % array(iCell) &
- = block % state % time_levs(1) % state % h % array(1,iCell) &
- - block % mesh % hZLevel % array(1)
- enddo
-
! Compute barotropic velocity at first timestep
! This is only done upon start-up.
- if (trim(config_time_integration) == 'unsplit_explicit') then
+ if (trim(config_time_integration) == 'unsplit_explicit') then
block % state % time_levs(1) % state % uBtr % array(:) = 0.0
block % state % time_levs(1) % state % uBcl % array(:,:) &
@@ -560,9 +551,7 @@
if (config_filter_btr_mode) then
do iCell=1,block % mesh % nCells
block % state % time_levs(1) % state % h % array(1,iCell) &
- = block % mesh % hZLevel % array(1)
-
- block % state % time_levs(1) % state % ssh % array(iCell) = 0.0
+ = block % mesh % referenceBottomDepth % array(1)
enddo
endif
@@ -570,21 +559,30 @@
cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
- sshEdge = 0.5*( &
- block % state % time_levs(1) % state % ssh % array(cell1) &
- + block % state % time_levs(1) % state % ssh % array(cell2) )
-
! uBtr = sum(u)/sum(h) on each column
- uhSum = (sshEdge + block % mesh % hZLevel % array(1)) &
- * block % state % time_levs(1) % state % u % array(1,iEdge)
- hSum = sshEdge + block % mesh % hZLevel % array(1)
+ ! ocn_diagnostic_solve has not yet been called, so compute hEdge
+ ! just for this edge.
+ ! hSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize hSum with a
+ ! nonzero value to avoid a NaN.
+ hEdge1 = 0.5*( &
+ block % state % time_levs(1) % state % h % array(1,cell1) &
+ + block % state % time_levs(1) % state % h % array(1,cell2) )
+ uhSum = hEdge1*block % state % time_levs(1) % state % u % array(1,iEdge)
+ hSum = hEdge1
+
do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
+ ! ocn_diagnostic_solve has not yet been called, so compute hEdge
+ ! just for this edge.
+ hEdge1 = 0.5*( &
+ block % state % time_levs(1) % state % h % array(k,cell1) &
+ + block % state % time_levs(1) % state % h % array(k,cell2) )
+
uhSum = uhSum &
- + block % mesh % hZLevel % array(k) &
- *block % state % time_levs(1) % state % u % array(k,iEdge)
- hSum = hSum &
- + block % mesh % hZLevel % array(k)
+ + hEdge1*block % state % time_levs(1) % state % u % array(k,iEdge)
+ hSum = hSum + hEdge1
+
enddo
block % state % time_levs(1) % state % uBtr % array(iEdge) = uhSum/hsum
@@ -612,38 +610,11 @@
endif
-!print *, '11 u ',minval(domain % blocklist % state % time_levs(1) % state % u % array(:,1:domain % blocklist % mesh % nEdgesSolve)), &
-! maxval(domain % blocklist % state % time_levs(1) % state % u % array(:,1:domain % blocklist % mesh % nEdgesSolve))
-!print *, '11 uBtr ',minval(domain % blocklist % state % time_levs(1) % state % uBtr % array(1:domain % blocklist % mesh % nEdgesSolve)), &
-! maxval(domain % blocklist % state % time_levs(1) % state % uBtr % array(1:domain % blocklist % mesh % nEdgesSolve))
-!print *, '11 uBcl ',minval(domain % blocklist % state % time_levs(1) % state % uBcl % array(:,1:domain % blocklist % mesh % nEdgesSolve)), &
-! maxval(domain % blocklist % state % time_levs(1) % state % uBcl % array(:,1:domain % blocklist % mesh % nEdgesSolve))
-
-
-! mrp temp testing - is uBcl vert sum zero?
-! do iEdge=1,block % mesh % nEdges
-! uhSum = (sshEdge + block % mesh % hZLevel % array(1)) * block % state % time_levs(1) % state % uBcl % array(1,iEdge)
-! hSum = sshEdge + block % mesh % hZLevel % array(1)
-
-! do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
-! uhSum = uhSum + block % mesh % hZLevel % array(k) * block % state % time_levs(1) % state % uBcl % array(k,iEdge)
-! hSum = hSum + block % mesh % hZLevel % array(k)
-! enddo
-! block % state % time_levs(1) % state % FBtr % array(iEdge) = uhSum/hSum
-
-! enddo ! iEdge
-
-!print *, 'uBcl vert sum IC',minval(block % state % time_levs(1) % state % FBtr % array(1:block % mesh % nEdgesSolve)), &
-! maxval(block % state % time_levs(1) % state % FBtr % array(1:block % mesh % nEdgesSolve))
-
-! mrp temp testing - is uBcl vert sum zero? end
-
block => block % next
+ end do
- end do
+ end subroutine ocn_init_z_level!}}}
-end subroutine ocn_init_z_level!}}}
-
subroutine ocn_compute_max_level(domain)!{{{
! Initialize maxLevel and bouncary grid variables.
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_mpas_core.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_mpas_core.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_mpas_core.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_mpas_core.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_mpas_core.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_mpas_core.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_mpas_core.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_mpas_core.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_mpas_core.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_mpas_core.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_mpas_core.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_mpas_core.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_mpas_core.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_mpas_core.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_mpas_core.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_mpas_core.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_mpas_core.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_mpas_core.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_mpas_core.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_mpas_core.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_mpas_core.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_mpas_core.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_mpas_core.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_mpas_core.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_mpas_core.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_mpas_core.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_mpas_core.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_mpas_core.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_restoring.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_restoring.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_restoring.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_restoring.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_restoring.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_restoring.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_restoring.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_restoring.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_restoring.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_restoring.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_restoring.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_restoring.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_restoring.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_restoring.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_restoring.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_restoring.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_restoring.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_restoring.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_restoring.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_restoring.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_restoring.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_restoring.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_restoring.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_restoring.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_restoring.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_restoring.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_restoring.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_restoring.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tendency.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tendency.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tendency.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -137,8 +137,6 @@
! See Ringler et al. (2010) jcp paper, eqn 19, 21, and fig. 3.
! for explanation of divergence operator.
!
- ! for z-level, only compute height tendency for top layer.
-
call mpas_timer_start("hadv", .false., thickHadvTimer)
call ocn_thick_hadv_tend(grid, u, h_edge, tend_h, err)
call mpas_timer_stop("hadv", thickHadvTimer)
@@ -146,7 +144,6 @@
!
! height tendency: vertical advection term -d/dz(hw)
!
- ! Vertical advection computed for top layer of a z grid only.
call mpas_timer_start("vadv", .false., thickVadvTimer)
call ocn_thick_vadv_tend(grid, wtop, tend_h, err)
call mpas_timer_stop("vadv", thickVadvTimer)
@@ -186,7 +183,8 @@
type (mesh_type), intent(in) :: grid
real (kind=RKIND), dimension(:,:), pointer :: &
- h_edge, u, pressure, tend_u, vorticity, ke, ke_edge, pv_edge, &
+ h_edge, h, u, rho, zMid, pressure, &
+ tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
MontPot, wTop, divergence, vertViscTopOfEdge
real (kind=RKIND), dimension(:,:), pointer :: u_src
@@ -196,7 +194,9 @@
call mpas_timer_start("ocn_tend_u")
u => s % u % array
+ rho => s % rho % array
wTop => s % wTop % array
+ zMid => s % zMid % array
h_edge => s % h_edge % array
vorticity => s % vorticity % array
divergence => s % divergence % array
@@ -229,17 +229,17 @@
! velocity tendency: vertical advection term -w du/dz
!
call mpas_timer_start("vadv", .false., velVadvTimer)
- call ocn_vel_vadv_tend(grid, u, wtop, tend_u, err)
+ call ocn_vel_vadv_tend(grid, u, h_edge, wtop, tend_u, err)
call mpas_timer_stop("vadv", velVadvTimer)
!
! velocity tendency: pressure gradient
!
call mpas_timer_start("pressure grad", .false., velPgradTimer)
- if (config_vert_grid_type.eq.'isopycnal') then
- call ocn_vel_pressure_grad_tend(grid, MontPot, tend_u, err)
- elseif (config_vert_grid_type.eq.'zlevel') then
- call ocn_vel_pressure_grad_tend(grid, pressure, tend_u, err)
+ if (config_pressure_type.eq.'MontgomeryPotential') then
+ call ocn_vel_pressure_grad_tend(grid, MontPot, zMid, rho, tend_u, err)
+ else
+ call ocn_vel_pressure_grad_tend(grid, pressure, zMid, rho, tend_u, err)
end if
call mpas_timer_stop("pressure grad", velPgradTimer)
@@ -322,7 +322,7 @@
vertDiffTopOfCell => d % vertDiffTopOfCell % array
tend_tr => tend % tracers % array
-
+
!
! initialize tracer tendency (RHS of tracer equation) to zero.
!
@@ -346,7 +346,7 @@
!
call mpas_timer_start("vadv", .false., tracerVadvTimer)
- call ocn_tracer_vadv_tend(grid, wtop, tracers, tend_tr, err)
+ call ocn_tracer_vadv_tend(grid, h, wtop, tracers, tend_tr, err)
call mpas_timer_stop("vadv", tracerVadvTimer)
!
@@ -437,10 +437,10 @@
real (kind=RKIND), dimension(:), pointer :: &
h_s, fVertex, dvEdge, dcEdge, areaCell, areaTriangle, &
- hZLevel
+ referenceBottomDepth, ssh
real (kind=RKIND), dimension(:,:), pointer :: &
weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure,&
- circulation, vorticity, ke, ke_edge, MontPot, &
+ circulation, vorticity, ke, ke_edge, MontPot, wTop, zMid, &
pv_edge, pv_vertex, pv_cell, gradPVn, gradPVt, divergence, &
rho, temperature, salinity, kev, kevc
real (kind=RKIND), dimension(:,:,:), pointer :: tracers, deriv_two
@@ -466,6 +466,8 @@
rho => s % rho % array
MontPot => s % MontPot % array
pressure => s % pressure % array
+ zMid => s % zMid % array
+ ssh => s % ssh % array
tracers => s % tracers % array
weightsOnEdge => grid % weightsOnEdge % array
@@ -483,7 +485,7 @@
areaTriangle => grid % areaTriangle % array
h_s => grid % h_s % array
fVertex => grid % fVertex % array
- hZLevel => grid % hZLevel % array
+ referenceBottomDepth => grid % referenceBottomDepth % array
deriv_two => grid % deriv_two % array
maxLevelCell => grid % maxLevelCell % array
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
@@ -505,100 +507,88 @@
! mrp 101115 note: in order to include flux boundary conditions, we will need to
! assign h_edge for maxLevelEdgeTop:maxLevelEdgeBot in the following section
- ! mrp 110516 efficiency note: For z-level, only do this on level 1. h_edge for all
- ! lower levels is defined by hZlevel.
+ ! initialize h_edge to avoid divide by zero and NaN problems.
+ h_edge = -1.0e34
-! coef_3rd_order = 0.
-! if (config_thickness_adv_order == 3) coef_3rd_order = 1.0
-! if (config_thickness_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
-
-! if (config_thickness_adv_order == 2) then
- do iEdge=1,nEdges*hadv2nd
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
- do k=1,maxLevelEdgeTop(iEdge)
- h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
- end do
+ do iEdge=1,nEdges*hadv2nd
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ do k=1,maxLevelEdgeTop(iEdge)
+ h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
end do
+ end do
-! else if (config_thickness_adv_order == 3) then
+ do iEdge=1,nEdges*hadv3rd
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
- do iEdge=1,nEdges*hadv3rd
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
+ do k=1,maxLevelEdgeTop(iEdge)
- do k=1,maxLevelEdgeTop(iEdge)
+ d2fdx2_cell1 = 0.0
+ d2fdx2_cell2 = 0.0
- d2fdx2_cell1 = 0.0
- d2fdx2_cell2 = 0.0
+ boundaryMask = abs(transfer(.not.(boundaryCell(k,cell1) == 0 .and. boundaryCell(k,cell2) == 0), boundaryMask))
- boundaryMask = abs(transfer(.not.(boundaryCell(k,cell1) == 0 .and. boundaryCell(k,cell2) == 0), boundaryMask))
+ d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1) * boundaryMask
+ d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2) * boundaryMask
- d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1) * boundaryMask
- d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2) * boundaryMask
+ !-- all edges of cell 1
+ do i=1, nEdgesOnCell(cell1) * boundaryMask
+ d2fdx2_cell1 = d2fdx2_cell1 + &
+ deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (i,cell1))
+ end do
- !-- all edges of cell 1
- do i=1, nEdgesOnCell(cell1) * boundaryMask
- d2fdx2_cell1 = d2fdx2_cell1 + &
- deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (i,cell1))
- end do
+ !-- all edges of cell 2
+ do i=1, nEdgesOnCell(cell2) * boundaryMask
+ d2fdx2_cell2 = d2fdx2_cell2 + &
+ deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
+ end do
- !-- all edges of cell 2
- do i=1, nEdgesOnCell(cell2) * boundaryMask
- d2fdx2_cell2 = d2fdx2_cell2 + &
- deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
- end do
+ velMask = 2*(abs(transfer(u(k,iEdge) <= 0, velMask))) - 1
- velMask = 2*(abs(transfer(u(k,iEdge) <= 0, velMask))) - 1
+ h_edge(k,iEdge) = 0.5*(h(k,cell1) + h(k,cell2)) - (dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
+ + velMask * (dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
- h_edge(k,iEdge) = 0.5*(h(k,cell1) + h(k,cell2)) - (dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
- + velMask * (dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
+ end do ! do k
+ end do ! do iEdge
- end do ! do k
- end do ! do iEdge
+ do iEdge=1,nEdges*hadv4th
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
-! else if (config_thickness_adv_order == 4) then
+ do k=1,maxLevelEdgeTop(iEdge)
- do iEdge=1,nEdges*hadv4th
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
+ d2fdx2_cell1 = 0.0
+ d2fdx2_cell2 = 0.0
- do k=1,maxLevelEdgeTop(iEdge)
+ boundaryMask = abs(transfer(.not.(boundaryCell(k,cell1) == 0 .and. boundaryCell(k,cell2) == 0), boundaryMask))
- d2fdx2_cell1 = 0.0
- d2fdx2_cell2 = 0.0
+ d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1) * boundaryMask
+ d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2) * boundaryMask
- boundaryMask = abs(transfer(.not.(boundaryCell(k,cell1) == 0 .and. boundaryCell(k,cell2) == 0), boundaryMask))
+ !-- all edges of cell 1
+ do i=1, nEdgesOnCell(cell1) * boundaryMask
+ d2fdx2_cell1 = d2fdx2_cell1 + &
+ deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (i,cell1))
+ end do
- d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1) * boundaryMask
- d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2) * boundaryMask
+ !-- all edges of cell 2
+ do i=1, nEdgesOnCell(cell2) * boundaryMask
+ d2fdx2_cell2 = d2fdx2_cell2 + &
+ deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
+ end do
- !-- all edges of cell 1
- do i=1, nEdgesOnCell(cell1) * boundaryMask
- d2fdx2_cell1 = d2fdx2_cell1 + &
- deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (i,cell1))
- end do
+ h_edge(k,iEdge) = &
+ 0.5*(h(k,cell1) + h(k,cell2)) &
+ -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.
- !-- all edges of cell 2
- do i=1, nEdgesOnCell(cell2) * boundaryMask
- d2fdx2_cell2 = d2fdx2_cell2 + &
- deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
- end do
+ end do ! do k
+ end do ! do iEdge
- h_edge(k,iEdge) = &
- 0.5*(h(k,cell1) + h(k,cell2)) &
- -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.
-
- end do ! do k
- end do ! do iEdge
-
-! endif ! if(config_thickness_adv_order == 2)
-
!
! set the velocity and height at dummy address
! used -1e34 so error clearly occurs if these values are used.
!
-!mrp 110516 change to zero, change back later:
u(:,nEdges+1) = -1e34
h(:,nCells+1) = -1e34
tracers(s % index_temperature,:,nCells+1) = -1e34
@@ -782,7 +772,7 @@
!
! For an isopycnal model, density should remain constant.
! For zlevel, calculate in-situ density
- if (config_vert_grid_type.eq.'zlevel') then
+ if (config_vert_grid_type.ne.'isopycnal') then
call mpas_timer_start("equation of state", .false., diagEOSTimer)
call ocn_equation_of_state_rho(s, grid, 0, 'relative', err)
! mrp 110324 In order to visualize rhoDisplaced, include the following
@@ -795,7 +785,7 @@
! This section must be after computing rho
!
! dwj: 10/25/2011 - Need to explore isopycnal vs zlevel flags
- if (config_vert_grid_type.eq.'isopycnal') then
+ if (config_pressure_type.eq.'MontgomeryPotential') then
! For Isopycnal model.
! Compute pressure at top of each layer, and then
@@ -822,32 +812,52 @@
end do
deallocate(pTop)
- elseif (config_vert_grid_type.eq.'zlevel') then
+ else
- ! For z-level model.
- ! Compute pressure at middle of each level.
- ! At k=1, where p is pressure at a depth of hZLevel(1)/2, not
- ! pressure at middle of layer including SSH.
-
do iCell=1,nCells
- ! compute pressure for z-level coordinates
+ ! pressure for generalized coordinates
! assume atmospheric pressure at the surface is zero for now.
-
pressure(1,iCell) = rho(1,iCell)*gravity &
- * (h(1,iCell)-0.5*hZLevel(1))
+ * 0.5*h(1,iCell)
do k=2,maxLevelCell(iCell)
pressure(k,iCell) = pressure(k-1,iCell) &
- + 0.5*gravity*( rho(k-1,iCell)*hZLevel(k-1) &
- + rho(k ,iCell)*hZLevel(k ))
+ + 0.5*gravity*( rho(k-1,iCell)*h(k-1,iCell) &
+ + rho(k ,iCell)*h(k ,iCell))
end do
+ ! Compute zMid, the z-coordinate of the middle of the layer.
+ ! This is used for the rho g grad z momentum term.
+ ! Note the negative sign, since referenceBottomDepth is positive
+ ! and z-coordinates are negative below the surface.
+ k = maxLevelCell(iCell)
+ zMid(k:nVertLevels,iCell) = -referenceBottomDepth(k) + 0.5*h(k,iCell)
+
+ do k=maxLevelCell(iCell)-1, 1, -1
+ zMid(k,iCell) = zMid(k+1,iCell) &
+ + 0.5*( h(k+1,iCell) &
+ + h(k ,iCell))
+ end do
+
end do
endif
- call ocn_wtop(s,grid)
+ !
+ ! Sea Surface Height
+ !
+ do iCell=1,nCells
+ ! Start at the bottom where we know the depth, and go up.
+ ! The bottom depth for this cell is
+ ! referenceBottomDepth(maxLevelCell(iCell)).
+ ! Note the negative sign, since referenceBottomDepth is positive
+ ! and z-coordinates are negative below the surface.
+ ssh(iCell) = -referenceBottomDepth(maxLevelCell(iCell)) &
+ + sum(h(1:maxLevelCell(iCell),iCell))
+
+ end do
+
end subroutine ocn_diagnostic_solve!}}}
!***********************************************************************
@@ -863,7 +873,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_wtop(s, grid)!{{{
+ subroutine ocn_wtop(s1,s2, grid)!{{{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Compute diagnostic fields used in the tendency computations
!
@@ -874,21 +884,22 @@
implicit none
- type (state_type), intent(inout) :: s
+ type (state_type), intent(inout) :: s1
+ type (state_type), intent(inout) :: s2
type (mesh_type), intent(in) :: grid
! mrp 110512 could clean this out, remove pointers?
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
- real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, rho0Inv, invAreaCell
+ real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, rho0Inv, hSum
integer :: nCells, nEdges, nVertices, nVertLevels, vertexDegree
real (kind=RKIND), dimension(:), pointer :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- hZLevel
- real (kind=RKIND), dimension(:,:), pointer :: u,wTop
- real (kind=RKIND), dimension(:,:), allocatable:: div_u
+ h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
+ real (kind=RKIND), dimension(:,:), pointer :: u,h,wTop, h_edge
+ real (kind=RKIND), dimension(:,:), allocatable:: div_hu
+ real (kind=RKIND), dimension(:), allocatable:: div_hu_btr, h_tend_col, h_weights
integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, &
verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex, &
@@ -897,13 +908,13 @@
maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &
maxLevelVertexBot, maxLevelVertexTop
+ h => s1 % h % array
+ h_edge => s1 % h_edge % array
+ u => s2 % u % array
+ wTop => s2 % wTop % array
- u => s % u % array
- wTop => s % wTop % array
-
areaCell => grid % areaCell % array
cellsOnEdge => grid % cellsOnEdge % array
- hZLevel => grid % hZLevel % array
maxLevelCell => grid % maxLevelCell % array
maxLevelEdgeBot => grid % maxLevelEdgeBot % array
dvEdge => grid % dvEdge % array
@@ -912,7 +923,33 @@
nEdges = grid % nEdges
nVertLevels = grid % nVertLevels
+ allocate(div_hu(nVertLevels,nCells+1), div_hu_btr(nCells+1), &
+ h_tend_col(nVertLevels), h_weights(nVertLevels))
+
!
+ ! Compute div(h^{edge} u) for each cell
+ ! See Ringler et al. (2010) jcp paper, eqn 19, 21, and fig. 3.
+ !
+ div_hu(:,:) = 0.0
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ do k=1,maxLevelEdgeBot(iEdge)
+ flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge)
+ div_hu(k,cell1) = div_hu(k,cell1) + flux
+ div_hu(k,cell2) = div_hu(k,cell2) - flux
+ end do
+ end do
+
+ do iCell=1,nCells
+ div_hu_btr(iCell) = 0.0
+ do k=1,maxLevelCell(iCell)
+ div_hu(k,iCell) = div_hu(k,iCell) / areaCell(iCell)
+ div_hu_btr(iCell) = div_hu_btr(iCell) + div_hu(k,iCell)
+ end do
+ end do
+
+ !
! vertical velocity through layer interface
!
!dwj: 10/25/2011 - Need to explore isopycnal vs zlevel flags
@@ -922,38 +959,93 @@
elseif (config_vert_grid_type.eq.'zlevel') then
- !
- ! Compute div(u) for each cell
- ! See Ringler et al. (2010) jcp paper, eqn 19, 21, and fig. 3.
- !
- allocate(div_u(nVertLevels,nCells+1))
- div_u(:,:) = 0.0
- do iEdge=1,nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
- do k=2,maxLevelEdgeBot(iEdge)
- flux = u(k,iEdge) * dvEdge(iEdge)
- div_u(k,cell1) = div_u(k,cell1) + flux
- div_u(k,cell2) = div_u(k,cell2) - flux
- end do
- end do
+ do iCell=1,nCells
+ ! Vertical velocity through layer interface at top and
+ ! bottom is zero.
+ wTop(1,iCell) = 0.0
+ wTop(maxLevelCell(iCell)+1,iCell) = 0.0
+ do k=maxLevelCell(iCell),2,-1
+ wTop(k,iCell) = wTop(k+1,iCell) - div_hu(k,iCell)
+ end do
+ end do
+ elseif (config_vert_grid_type.eq.'zstar1') then
+
+ ! This is a testing setting. The computation is similar to zstar,
+ ! but the weights are all in the top layer, so is a bit-for-bit
+ ! match with zlevel.
+
do iCell=1,nCells
+
+ h_tend_col = 0.0
+ h_tend_col(1) = - div_hu_btr(iCell)
+
! Vertical velocity through layer interface at top and
! bottom is zero.
wTop(1,iCell) = 0.0
wTop(maxLevelCell(iCell)+1,iCell) = 0.0
- invAreaCell = 1.0 / areaCell(iCell)
do k=maxLevelCell(iCell),2,-1
- wTop(k,iCell) = wTop(k+1,iCell) &
- - div_u(k,iCell)*invAreaCell*hZLevel(k)
+ wTop(k,iCell) = wTop(k+1,iCell) - div_hu(k,iCell) - h_tend_col(k)
end do
end do
- deallocate(div_u)
+ elseif (config_vert_grid_type.eq.'zstar') then
+
+ ! Distribute the change in total column height due to the external
+ ! mode, div_hu_btr, among all the layers. Distribute in proportion
+ ! to the layer thickness.
+
+ do iCell=1,nCells
+
+ hSum = 0.0
+ do k=1,maxLevelCell(iCell)
+ h_tend_col(k) = - h(k,iCell)*div_hu_btr(iCell)
+ hSum = hSum + h(k,iCell)
+ end do
+ h_tend_col = h_tend_col / hSum
+
+ ! Vertical velocity through layer interface at top and
+ ! bottom is zero.
+ wTop(1,iCell) = 0.0
+ wTop(maxLevelCell(iCell)+1,iCell) = 0.0
+ do k=maxLevelCell(iCell),2,-1
+ wTop(k,iCell) = wTop(k+1,iCell) - div_hu(k,iCell) - h_tend_col(k)
+ end do
+ end do
+
+ elseif (config_vert_grid_type.eq.'zstarWeights') then
+
+ ! This is a test with other weights, not meant to be permanent.
+
+ h_weights = 0.0
+ h_weights(1:5) = 1.0
+ do k=1,10
+ h_weights(5+k) = 1.0-k*0.1
+ end do
+
+ do iCell=1,nCells
+
+ hSum = 0.0
+ do k=1,maxLevelCell(iCell)
+ h_tend_col(k) = - h_weights(k)*h(k,iCell)*div_hu_btr(iCell)
+ hSum = hSum + h_weights(k)*h(k,iCell)
+ end do
+ h_tend_col = h_tend_col / hSum
+
+ ! Vertical velocity through layer interface at top and
+ ! bottom is zero.
+ wTop(1,iCell) = 0.0
+ wTop(maxLevelCell(iCell)+1,iCell) = 0.0
+ do k=maxLevelCell(iCell),2,-1
+ wTop(k,iCell) = wTop(k+1,iCell) - div_hu(k,iCell) - h_tend_col(k)
+ end do
+ end do
+
endif
+ deallocate(div_hu, div_hu_btr, h_tend_col, h_weights)
+
end subroutine ocn_wtop!}}}
!***********************************************************************
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tendency.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tendency.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tendency.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tendency.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tendency.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tendency.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tendency.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tendency.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tendency.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tendency.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tendency.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tendency.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tendency.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tendency.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tendency.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tendency.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tendency.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tendency.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tendency.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tendency.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tendency.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tendency.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tendency.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tendency.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tendency.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tendency.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tendency.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tendency.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_thick_hadv.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_thick_hadv.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_thick_hadv.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -104,7 +104,7 @@
integer :: iEdge, nEdges, cell1, cell2, nVertLevels, k
integer :: iCell, nCells
- integer, dimension(:), pointer :: maxLevelEdgeTop
+ integer, dimension(:), pointer :: maxLevelEdgeBot, MaxLevelCell
integer, dimension(:,:), pointer :: cellsOnEdge
real (kind=RKIND) :: flux, invAreaCell1, invAreaCell2
@@ -124,47 +124,27 @@
nCells = grid % nCells
nVertLevels = grid % nVertLevels
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeBot => grid % maxLevelEdgeBot % array
cellsOnEdge => grid % cellsOnEdge % array
dvEdge => grid % dvEdge % array
areaCell => grid % areaCell % array
- !dwj: 10/25/2011 - Need to explore isopycnal vs zlevel flags
- if (config_vert_grid_type.eq.'isopycnal') then
-
- do iEdge=1,nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
-
- invAreaCell1 = 1.0 / areaCell(cell1)
- invAreaCell2 = 1.0 / areaCell(cell2)
-
- do k=1,nVertLevels
- flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge)
- tend(k,cell1) = tend(k,cell1) - flux * invAreaCell1
- tend(k,cell2) = tend(k,cell2) + flux * invAreaCell2
- end do
+ do iEdge=1,nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ do k=1,maxLevelEdgeBot(iEdge)
+ flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge)
+ tend(k,cell1) = tend(k,cell1) - flux
+ tend(k,cell2) = tend(k,cell2) + flux
end do
-
- elseif (config_vert_grid_type.eq.'zlevel') then
-
- do iEdge=1,nEdges
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
-
- invAreaCell1 = 1.0 / areaCell(cell1)
- invAreaCell2 = 1.0 / areaCell(cell2)
-
- do k=1,min(1,maxLevelEdgeTop(iEdge))
- flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge)
- tend(k,cell1) = tend(k,cell1) - flux * invAreaCell1
- tend(k,cell2) = tend(k,cell2) + flux * invAreaCell2
- end do
+ end do
+ do iCell=1,nCells
+ do k=1,maxLevelCell(iCell)
+ tend(k,iCell) = tend(k,iCell) / areaCell(iCell)
end do
+ end do
- endif ! config_vert_grid_type
-
-
!--------------------------------------------------------------------
end subroutine ocn_thick_hadv_tend!}}}
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_thick_hadv.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_thick_hadv.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_thick_hadv.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_thick_hadv.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_thick_hadv.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_thick_hadv.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_thick_hadv.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_thick_hadv.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_thick_hadv.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_thick_hadv.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_thick_hadv.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_thick_hadv.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_thick_hadv.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_thick_hadv.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_thick_hadv.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_thick_hadv.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_thick_hadv.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_thick_hadv.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_thick_hadv.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_thick_hadv.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_thick_hadv.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_thick_hadv.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_thick_hadv.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_thick_hadv.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_thick_hadv.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_thick_hadv.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_thick_hadv.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_thick_hadv.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_thick_vadv.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_thick_vadv.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_thick_vadv.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -98,7 +98,8 @@
!
!-----------------------------------------------------------------
- integer :: iCell, nCells
+ integer :: iCell, nCells, nVertLevels, k
+ integer, dimension(:), pointer :: MaxLevelCell
!-----------------------------------------------------------------
!
@@ -110,16 +111,17 @@
err = 0
+ maxLevelCell => grid % maxLevelCell % array
+
nCells = grid % nCells
+ nVertLevels = grid % nVertLevels
- ! dwj 10/25/2011 - Need to explore isopycnal vs zlevel flags
- if (config_vert_grid_type.eq.'zlevel') then
- do iCell=1,nCells
- tend(1,iCell) = tend(1,iCell) + wTop(2,iCell)
- end do
- endif ! coordinate type
+ do iCell=1,nCells
+ do k=1,maxLevelCell(iCell)
+ tend(k,iCell) = tend(k,iCell) + wTop(k+1,iCell) - wTop(k,iCell)
+ end do
+ end do
-
!--------------------------------------------------------------------
end subroutine ocn_thick_vadv_tend!}}}
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_thick_vadv.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_thick_vadv.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_thick_vadv.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_thick_vadv.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_thick_vadv.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_thick_vadv.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_thick_vadv.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_thick_vadv.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_thick_vadv.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_thick_vadv.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_thick_vadv.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_thick_vadv.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_thick_vadv.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_thick_vadv.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_thick_vadv.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_thick_vadv.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_thick_vadv.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_thick_vadv.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_thick_vadv.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_thick_vadv.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_thick_vadv.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_thick_vadv.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_thick_vadv.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_thick_vadv.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_thick_vadv.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_thick_vadv.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_thick_vadv.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_thick_vadv.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_time_integration.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_time_integration.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_time_integration.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_time_integration.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_time_integration.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_time_integration.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_time_integration.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_time_integration.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_time_integration.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_time_integration.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_time_integration.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_time_integration.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_time_integration.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_time_integration.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_time_integration.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_time_integration.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_time_integration.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_time_integration.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_time_integration.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_time_integration.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_time_integration.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_time_integration.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_time_integration.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_time_integration.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_time_integration.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_time_integration.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_time_integration_rk4.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_time_integration_rk4.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_time_integration_rk4.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -166,6 +166,10 @@
call mpas_timer_start("RK4-tendency computations")
block => domain % blocklist
do while (associated(block))
+
+ ! mrp 111206 put ocn_wtop call at top for ALE
+ call ocn_wtop(provis, provis, block % mesh)
+
if (.not.config_implicit_vertical_mix) then
call ocn_vmix_coefs(block % mesh, provis, block % diagnostics, err)
end if
@@ -366,8 +370,8 @@
integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
real (kind=RKIND), dimension(:), pointer :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+ h_s, dvEdge, dcEdge, areaCell, areaTriangle, &
+ meshScalingDel2, meshScalingDel4
real (kind=RKIND), dimension(:,:), pointer :: &
weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
@@ -422,11 +426,6 @@
areaCell => grid % areaCell % array
areaTriangle => grid % areaTriangle % array
h_s => grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
- fVertex => grid % fVertex % array
- fEdge => grid % fEdge % array
- zMidZLevel => grid % zMidZLevel % array
- zTopZLevel => grid % zTopZLevel % array
maxLevelCell => grid % maxLevelCell % array
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
maxLevelVertexBot => grid % maxLevelVertexBot % array
@@ -443,15 +442,12 @@
do iEdge=1,grid % nEdges
- ! I am using hZLevel here. This assumes that SSH is zero everywhere already,
- ! which should be the case if the barotropic mode is filtered.
- ! The more general case is to use sshEdge or h_edge.
- uhSum = (grid % hZLevel % array(1)) * tend_u(1,iEdge)
- hSum = grid % hZLevel % array(1)
+ uhSum = (h_edge(1,iEdge)) * tend_u(1,iEdge)
+ hSum = h_edge(1,iEdge)
do k=2,grid % maxLevelEdgeTop % array(iEdge)
- uhSum = uhSum + grid % hZLevel % array(k) * tend_u(k,iEdge)
- hSum = hSum + grid % hZLevel % array(k)
+ uhSum = uhSum + h_edge(k,iEdge) * tend_u(k,iEdge)
+ hSum = hSum + h_edge(k,iEdge)
enddo
vertSum = uhSum/hSum
@@ -489,8 +485,8 @@
integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
real (kind=RKIND), dimension(:), pointer :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+ h_s, dvEdge, dcEdge, areaCell, areaTriangle, &
+ meshScalingDel2, meshScalingDel4
real (kind=RKIND), dimension(:,:), pointer :: &
weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
@@ -544,11 +540,6 @@
areaCell => grid % areaCell % array
areaTriangle => grid % areaTriangle % array
h_s => grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
- fVertex => grid % fVertex % array
- fEdge => grid % fEdge % array
- zMidZLevel => grid % zMidZLevel % array
- zTopZLevel => grid % zTopZLevel % array
maxLevelCell => grid % maxLevelCell % array
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
maxLevelVertexBot => grid % maxLevelVertexBot % array
@@ -563,15 +554,12 @@
do iEdge=1,grid % nEdges
- ! I am using hZLevel here. This assumes that SSH is zero everywhere already,
- ! which should be the case if the barotropic mode is filtered.
- ! The more general case is to use sshedge or h_edge.
- uhSum = (grid % hZLevel % array(1)) * u(1,iEdge)
- hSum = grid % hZLevel % array(1)
+ uhSum = (h_edge(1,iEdge)) * u(1,iEdge)
+ hSum = h_edge(1,iEdge)
do k=2,grid % maxLevelEdgeTop % array(iEdge)
- uhSum = uhSum + grid % hZLevel % array(k) * u(k,iEdge)
- hSum = hSum + grid % hZLevel % array(k)
+ uhSum = uhSum + h_edge(k,iEdge) * u(k,iEdge)
+ hSum = hSum + h_edge(k,iEdge)
enddo
vertSum = uhSum/hSum
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_time_integration_rk4.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_time_integration_rk4.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_time_integration_rk4.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration_rk4.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_time_integration_rk4.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_time_integration_rk4.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_time_integration_rk4.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_time_integration_rk4.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_time_integration_rk4.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_time_integration_rk4.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_time_integration_rk4.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_time_integration_rk4.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_time_integration_rk4.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_time_integration_rk4.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_time_integration_rk4.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_time_integration_rk4.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_time_integration_rk4.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_time_integration_rk4.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration_rk4.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_time_integration_rk4.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_time_integration_rk4.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_time_integration_rk4.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_time_integration_rk4.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_time_integration_rk4.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_time_integration_rk4.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_time_integration_rk4.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_time_integration_rk4.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_time_integration_rk4.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_time_integration_split.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_time_integration_split.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_time_integration_split.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -58,7 +58,7 @@
! ocn_time_integration_split
!
!> \brief MPAS ocean split explicit time integration scheme
-!> \author Doug Jacobsen
+!> \author Mark Petersen
!> \date 26 September 2011
!> \version SVN:$Id:$
!> \details
@@ -86,25 +86,19 @@
type (dm_info) :: dminfo
integer :: iCell, i,k,j, iEdge, cell1, cell2, split_explicit_step, split, &
eoe, oldBtrSubcycleTime, newBtrSubcycleTime, uPerpTime, BtrCorIter, &
- n_bcl_iter(config_n_ts_iter), &
- vertex1, vertex2, iVertex, sshSwapFlag
-
+ n_bcl_iter(config_n_ts_iter)
type (block_type), pointer :: block
- real (kind=RKIND) :: uhSum, hSum, sshEdge, flux, &
- uPerp, uCorr, tracerTemp, coef, FBtr_coeff, sshCell1, sshCell2
- real (kind=RKIND), dimension(:), pointer :: sshNew
-
+ real (kind=RKIND) :: uhSum, hSum, flux, sshEdge, &
+ CoriolisTerm, uCorr, temp, temp_h, coef, FBtr_coeff, sshCell1, sshCell2
integer :: num_tracers, ucorr_coef, err
real (kind=RKIND), dimension(:,:), pointer :: &
u, h, h_edge, ke_edge, vertViscTopOfEdge, vertDiffTopOfCell
real (kind=RKIND), dimension(:,:,:), pointer :: tracers
integer, dimension(:), pointer :: &
maxLevelCell, maxLevelEdgeTop
- real (kind=RKIND), dimension(:), allocatable:: A,C,uTemp, hNew
+ real (kind=RKIND), dimension(:), allocatable:: uTemp
real (kind=RKIND), dimension(:,:), allocatable:: tracersTemp
- sshSwapFlag = 1
-
call mpas_timer_start("se timestep", .false., timer_main)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -116,41 +110,45 @@
block => domain % blocklist
do while (associated(block))
- do iEdge=1,block % mesh % nEdges
+ ! Initialize * variables that are used to compute baroclinic tendencies below.
+ do iEdge=1,block % mesh % nEdges
+ do k=1,block % mesh % nVertLevels !maxLevelEdgeTop % array(iEdge)
- ! The baroclinic velocity needs be recomputed at the beginning of a
- ! timestep because the implicit vertical mixing is conducted on the
- ! total u. We keep uBtr from the previous timestep.
- block % state % time_levs(1) % state % uBcl % array(:,iEdge) &
- = block % state % time_levs(1) % state % u % array(:,iEdge) &
- - block % state % time_levs(1) % state % uBtr % array(iEdge)
+ ! The baroclinic velocity needs be recomputed at the beginning of a
+ ! timestep because the implicit vertical mixing is conducted on the
+ ! total u. We keep uBtr from the previous timestep.
+ block % state % time_levs(1) % state % uBcl % array(k,iEdge) &
+ = block % state % time_levs(1) % state % u % array(k,iEdge) &
+ - block % state % time_levs(1) % state % uBtr % array( iEdge)
- block % state % time_levs(2) % state % u % array(:,iEdge) &
- = block % state % time_levs(1) % state % u % array(:,iEdge)
+ block % state % time_levs(2) % state % u % array(k,iEdge) &
+ = block % state % time_levs(1) % state % u % array(k,iEdge)
- block % state % time_levs(2) % state % uBcl % array(:,iEdge) &
- = block % state % time_levs(1) % state % uBcl % array(:,iEdge)
+ block % state % time_levs(2) % state % uBcl % array(k,iEdge) &
+ = block % state % time_levs(1) % state % uBcl % array(k,iEdge)
- enddo ! iEdge
+ block % state % time_levs(2) % state % h_edge % array(k,iEdge) &
+ = block % state % time_levs(1) % state % h_edge % array(k,iEdge)
- ! Initialize * variables that are used compute baroclinic tendencies below.
- block % state % time_levs(2) % state % ssh % array(:) &
- = block % state % time_levs(1) % state % ssh % array(:)
+ end do
+ end do
- block % state % time_levs(2) % state % h_edge % array(:,:) &
- = block % state % time_levs(1) % state % h_edge % array(:,:)
+ block % state % time_levs(2) % state % ssh % array(:) &
+ = block % state % time_levs(1) % state % ssh % array(:)
- do iCell=1,block % mesh % nCells ! couple tracers to h
- ! change to maxLevelCell % array(iCell) ?
- do k=1,block % mesh % nVertLevels
+ do iCell=1,block % mesh % nCells
+ do k=1,block % mesh % maxLevelCell % array(iCell)
- block % state % time_levs(2) % state % tracers % array(:,k,iCell) &
- = block % state % time_levs(1) % state % tracers % array(:,k,iCell)
- end do
+ block % state % time_levs(2) % state % h % array(k,iCell) &
+ = block % state % time_levs(1) % state % h % array(k,iCell)
- end do
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) &
+ = block % state % time_levs(1) % state % tracers % array(:,k,iCell)
- block => block % next
+ end do
+ end do
+
+ block => block % next
end do
call mpas_timer_stop("se prep", timer_prep)
@@ -162,873 +160,765 @@
n_bcl_iter(config_n_ts_iter) = config_n_bcl_iter_end
do split_explicit_step = 1, config_n_ts_iter
- ! --- update halos for diagnostic variables
+ ! --- update halos for diagnostic variables
- call mpas_timer_start("se halo diag", .false., timer_halo_diagnostic)
- block => domain % blocklist
- do while (associated(block))
+ call mpas_timer_start("se halo diag", .false., timer_halo_diagnostic)
+ block => domain % blocklist
+ do while (associated(block))
- call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % pv_edge % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nEdges, &
- block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+ call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, &
+ block % state % time_levs(2) % state % pv_edge % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nEdges, &
+ block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- if (config_h_mom_eddy_visc4 > 0.0) then
- call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nCells, &
- block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nVertices, &
- block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
- end if
+ if (config_h_mom_eddy_visc4 > 0.0) then
+ call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, &
+ block % state % time_levs(2) % state % divergence % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+ call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, &
+ block % state % time_levs(2) % state % vorticity % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nVertices, &
+ block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
+ end if
- block => block % next
- end do
- call mpas_timer_stop("se halo diag", timer_halo_diagnostic)
+ block => block % next
+ end do
+ call mpas_timer_stop("se halo diag", timer_halo_diagnostic)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !
- ! Stage 1: Baroclinic velocity (3D) prediction, explicit with long timestep
- !
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! Stage 1: Baroclinic velocity (3D) prediction, explicit with long timestep
+ !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! compute velocity tendencies, T(u*,w*,p*)
- call mpas_timer_start("se bcl vel", .false., timer_bcl_vel)
+ ! compute velocity tendencies, T(u*,w*,p*)
+ call mpas_timer_start("se bcl vel", .false., timer_bcl_vel)
- block => domain % blocklist
- do while (associated(block))
- if (.not.config_implicit_vertical_mix) then
- call ocn_vmix_coefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
- end if
- call ocn_tend_u(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
- block => block % next
- end do
+ block => domain % blocklist
+ do while (associated(block))
+ if (.not.config_implicit_vertical_mix) then
+ call ocn_vmix_coefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
+ end if
+ call ocn_tend_u(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
+ block => block % next
+ end do
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! BEGIN baroclinic iterations on linear Coriolis term
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- do j=1,n_bcl_iter(split_explicit_step)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! BEGIN baroclinic iterations on linear Coriolis term
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ do j=1,n_bcl_iter(split_explicit_step)
- ! Use this G coefficient to avoid an if statement within the iEdge loop.
- if (trim(config_time_integration) == 'unsplit_explicit') then
- split = 0
- elseif (trim(config_time_integration) == 'split_explicit') then
- split = 1
- endif
+ ! Use this G coefficient to avoid an if statement within the iEdge loop.
+ if (trim(config_time_integration) == 'unsplit_explicit') then
+ split = 0
+ elseif (trim(config_time_integration) == 'split_explicit') then
+ split = 1
+ endif
- block => domain % blocklist
- do while (associated(block))
- allocate(uTemp(block % mesh % nVertLevels))
+ block => domain % blocklist
+ do while (associated(block))
+ allocate(uTemp(block % mesh % nVertLevels))
- ! Put f*uBcl^{perp} in uNew as a work variable
- call ocn_fuperp(block % state % time_levs(2) % state , block % mesh)
+ ! Put f*uBcl^{perp} in uNew as a work variable
+ call ocn_fuperp(block % state % time_levs(2) % state , block % mesh)
- do iEdge=1,block % mesh % nEdges
- cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
- cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+ do iEdge=1,block % mesh % nEdges
+ cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+ cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
- uTemp = 0.0 ! could put this after with uTemp(maxleveledgetop+1:nvertlevels)=0
- do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
+ uTemp = 0.0 ! could put this after with uTemp(maxleveledgetop+1:nvertlevels)=0
+ do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
- ! uBclNew = uBclOld + dt*(-f*uBclPerp + T(u*,w*,p*) + g*grad(SSH*) )
- ! Here uNew is a work variable containing -fEdge(iEdge)*uBclPerp(k,iEdge)
- uTemp(k) = block % state % time_levs(1) % state % uBcl % array(k,iEdge) &
+ ! uBclNew = uBclOld + dt*(-f*uBclPerp + T(u*,w*,p*) + g*grad(SSH*) )
+ ! Here uNew is a work variable containing -fEdge(iEdge)*uBclPerp(k,iEdge)
+ uTemp(k) = block % state % time_levs(1) % state % uBcl % array(k,iEdge) &
+ dt * (block % tend % u % array (k,iEdge) &
+ block % state % time_levs(2) % state % u % array (k,iEdge) & ! this is f*uBcl^{perp}
+ split * gravity * ( block % state % time_levs(2) % state % ssh % array(cell2) &
- block % state % time_levs(2) % state % ssh % array(cell1) ) &
/block % mesh % dcEdge % array(iEdge) )
- enddo
+ enddo
- ! Compute GBtrForcing, the vertically averaged forcing
- sshEdge = 0.5*( block % state % time_levs(1) % state % ssh % array(cell1) &
- + block % state % time_levs(1) % state % ssh % array(cell2) )
+ ! hSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize hSum with a
+ ! nonzero value to avoid a NaN.
+ uhSum = block % state % time_levs(2) % state % h_edge % array(1,iEdge) * uTemp(1)
+ hSum = block % state % time_levs(2) % state % h_edge % array(1,iEdge)
- uhSum = (sshEdge + block % mesh % hZLevel % array(1)) * uTemp(1)
- hSum = sshEdge + block % mesh % hZLevel % array(1)
+ do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
+ uhSum = uhSum + block % state % time_levs(2) % state % h_edge % array(k,iEdge) * uTemp(k)
+ hSum = hSum + block % state % time_levs(2) % state % h_edge % array(k,iEdge)
+ enddo
+ block % state % time_levs(1) % state % GBtrForcing % array(iEdge) = split*uhSum/hSum/dt
- do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
- uhSum = uhSum + block % mesh % hZLevel % array(k) * uTemp(k)
- hSum = hSum + block % mesh % hZLevel % array(k)
- enddo
- block % state % time_levs(1) % state % GBtrForcing % array(iEdge) = split*uhSum/hSum/dt
+ do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
+ ! These two steps are together here:
+ !{\bf u}'_{k,n+1} = {\bf u}'_{k,n} - \Delta t {\overline {\bf G}}
+ !{\bf u}'_{k,n+1/2} = \frac{1}{2}\left({\bf u}^{'}_{k,n} +{\bf u}'_{k,n+1}\right)
+ ! so that uBclNew is at time n+1/2
+ block % state % time_levs(2) % state % uBcl % array(k,iEdge) &
+ = 0.5*( &
+ block % state % time_levs(1) % state % uBcl % array(k,iEdge) &
+ + uTemp(k) - dt * block % state % time_levs(1) % state % GBtrForcing % array(iEdge))
+ enddo
+
+ enddo ! iEdge
- do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
- ! These two steps are together here:
- !{\bf u}'_{k,n+1} = {\bf u}'_{k,n} - \Delta t {\overline {\bf G}}
- !{\bf u}'_{k,n+1/2} = \frac{1}{2}\left({\bf u}^{'}_{k,n} +{\bf u}'_{k,n+1}\right)
- ! so that uBclNew is at time n+1/2
- block % state % time_levs(2) % state % uBcl % array(k,iEdge) = 0.5*( &
- block % state % time_levs(1) % state % uBcl % array(k,iEdge) &
- + uTemp(k) - dt * block % state % time_levs(1) % state % GBtrForcing % array(iEdge))
- enddo
+ deallocate(uTemp)
- enddo ! iEdge
+ block => block % next
+ end do
- deallocate(uTemp)
+ call mpas_timer_start("se halo ubcl", .false., timer_halo_ubcl)
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, &
+ block % state % time_levs(2) % state % uBcl % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nEdges, &
+ block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+ block => block % next
+ end do
+ call mpas_timer_stop("se halo ubcl", timer_halo_ubcl)
- block => block % next
- end do
+ end do ! do j=1,config_n_bcl_iter
- call mpas_timer_start("se halo ubcl", .false., timer_halo_ubcl)
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % uBcl % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nEdges, &
- block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
- block => block % next
- end do
- call mpas_timer_stop("se halo ubcl", timer_halo_ubcl)
-
- enddo ! do j=1,config_n_bcl_iter
-
- call mpas_timer_stop("se bcl vel", timer_bcl_vel)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! END baroclinic iterations on linear Coriolis term
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ call mpas_timer_stop("se bcl vel", timer_bcl_vel)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! END baroclinic iterations on linear Coriolis term
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !
- ! Stage 2: Barotropic velocity (2D) prediction, explicitly subcycled
- !
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! Stage 2: Barotropic velocity (2D) prediction, explicitly subcycled
+ !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- call mpas_timer_start("se btr vel", .false., timer_btr_vel)
+ call mpas_timer_start("se btr vel", .false., timer_btr_vel)
- oldBtrSubcycleTime = 1
- newBtrSubcycleTime = 2
+ oldBtrSubcycleTime = 1
+ newBtrSubcycleTime = 2
- if (trim(config_time_integration) == 'unsplit_explicit') then
+ if (trim(config_time_integration) == 'unsplit_explicit') then
- block => domain % blocklist
- do while (associated(block))
+ block => domain % blocklist
+ do while (associated(block))
- ! For Split_Explicit unsplit, simply set uBtrNew=0, uBtrSubcycle=0, and uNew=uBclNew
- block % state % time_levs(2) % state % uBtr % array(:) = 0.0
+ ! For Split_Explicit unsplit, simply set uBtrNew=0, uBtrSubcycle=0, and uNew=uBclNew
+ block % state % time_levs(2) % state % uBtr % array(:) = 0.0
- block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:) = 0.0
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % uBcl % array(:,:)
- block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % uBcl % array(:,:)
+ block => block % next
+ end do ! block
- block => block % next
- end do ! block
+ elseif (trim(config_time_integration) == 'split_explicit') then
- elseif (trim(config_time_integration) == 'split_explicit') then
+ ! Initialize variables for barotropic subcycling
+ block => domain % blocklist
+ do while (associated(block))
- ! Initialize variables for barotropic subcycling
- block => domain % blocklist
- do while (associated(block))
+ if (config_filter_btr_mode) then
+ block % state % time_levs(1) % state % GBtrForcing % array(:) = 0.0
+ endif
- if (config_filter_btr_mode) then
- block % state % time_levs(1) % state % GBtrForcing % array(:) = 0.0
- endif
+ do iCell=1,block % mesh % nCells
+ ! sshSubcycleOld = sshOld
+ block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
+ = block % state % time_levs(1) % state % ssh % array(iCell)
+ end do
- do iCell=1,block % mesh % nCells
- ! sshSubcycleOld = sshOld
- block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) = block % state % time_levs(1) % state % ssh % array(iCell)
+ do iEdge=1,block % mesh % nEdges
- ! sshNew = sshOld This is the first for the summation
- block % state % time_levs(2) % state % ssh % array(iCell) = block % state % time_levs(1) % state % ssh % array(iCell)
- enddo
+ ! uBtrSubcycleOld = uBtrOld
+ block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ = block % state % time_levs(1) % state % uBtr % array(iEdge)
- do iEdge=1,block % mesh % nEdges
+ ! uBtrNew = BtrOld This is the first for the summation
+ block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ = block % state % time_levs(1) % state % uBtr % array(iEdge)
- ! uBtrSubcycleOld = uBtrOld
- block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) = block % state % time_levs(1) % state % uBtr % array(iEdge)
+ ! FBtr = 0
+ block % state % time_levs(1) % state % FBtr % array(iEdge) = 0.0
+ end do
- ! uBtrNew = BtrOld This is the first for the summation
- block % state % time_levs(2) % state % uBtr % array(iEdge) = block % state % time_levs(1) % state % uBtr % array(iEdge)
+ block => block % next
+ end do ! block
- ! FBtr = 0
- block % state % time_levs(1) % state % FBtr % array(iEdge) = 0.0
- enddo
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! BEGIN Barotropic subcycle loop
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ do j=1,config_n_btr_subcycles*config_btr_subcycle_loop_factor
- block => block % next
- end do ! block
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Barotropic subcycle: VELOCITY PREDICTOR STEP
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ if (config_btr_gam1_uWt1>1.0e-12) then ! only do this part if it is needed in next SSH solve
+ uPerpTime = oldBtrSubcycleTime
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! BEGIN Barotropic subcycle loop
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- do j=1,config_n_btr_subcycles*config_btr_subcycle_loop_factor
+ block => domain % blocklist
+ do while (associated(block))
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Barotropic subcycle: initial solve for velecity
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- if (config_btr_gam1_uWt1>1.0e-12) then ! only do this part if it is needed in next SSH solve
- uPerpTime = oldBtrSubcycleTime
+ do iEdge=1,block % mesh % nEdges
- block => domain % blocklist
- do while (associated(block))
+ cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+ cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
- do iEdge=1,block % mesh % nEdges
-
- cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
- cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-
- ! Compute -f*uPerp
- uPerp = 0.0
- do i = 1,block % mesh % nEdgesOnEdge % array(iEdge)
- eoe = block % mesh % edgesOnEdge % array(i,iEdge)
- uPerp = uPerp + block % mesh % weightsOnEdge % array(i,iEdge) &
- * block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &
- * block % mesh % fEdge % array(eoe)
- end do
+ ! Compute the barotropic Coriolis term, -f*uPerp
+ CoriolisTerm = 0.0
+ do i = 1,block % mesh % nEdgesOnEdge % array(iEdge)
+ eoe = block % mesh % edgesOnEdge % array(i,iEdge)
+ CoriolisTerm = CoriolisTerm &
+ + block % mesh % weightsOnEdge % array(i,iEdge) &
+ * block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &
+ * block % mesh % fEdge % array(eoe)
+ end do
- ! uBtrNew = uBtrOld + dt*(-f*uBtroldPerp - g*grad(SSH) + G)
- block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- = (block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- + dt / config_n_btr_subcycles * (uPerp - gravity &
- * (block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) &
- - block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) ) &
- / block % mesh % dcEdge % array(iEdge) &
- + block % state % time_levs(1) % state % GBtrForcing % array(iEdge))) * block % mesh % edgeMask % array(1, iEdge)
- end do
+ ! uBtrNew = uBtrOld + dt/J*(-f*uBtroldPerp - g*grad(SSH) + G)
+ block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ = (block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ + dt / config_n_btr_subcycles * (CoriolisTerm - gravity &
+ * (block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) &
+ - block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) ) &
+ / block % mesh % dcEdge % array(iEdge) &
+ + block % state % time_levs(1) % state % GBtrForcing % array(iEdge))) * block % mesh % edgeMask % array(1, iEdge)
+ end do
- block => block % next
- end do ! block
+ block => block % next
+ end do ! block
- ! boundary update on uBtrNew
- call mpas_timer_start("se halo ubtr", .false., timer_halo_ubtr)
- block => domain % blocklist
- do while (associated(block))
+ ! boundary update on uBtrNew
+ call mpas_timer_start("se halo ubtr", .false., timer_halo_ubtr)
+ block => domain % blocklist
+ do while (associated(block))
- call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &
- block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:), &
- block % mesh % nEdges, block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+ call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &
+ block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:), &
+ block % mesh % nEdges, block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- block => block % next
- end do ! block
- call mpas_timer_stop("se halo ubtr", timer_halo_ubtr)
- endif ! config_btr_gam1_uWt1>1.0e-12
+ block => block % next
+ end do ! block
+ call mpas_timer_stop("se halo ubtr", timer_halo_ubtr)
+ endif ! config_btr_gam1_uWt1>1.0e-12
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Barotropic subcycle: Compute thickness flux and new SSH: PREDICTOR
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- block => domain % blocklist
- do while (associated(block))
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Barotropic subcycle: SSH PREDICTOR STEP
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ block => domain % blocklist
+ do while (associated(block))
- block % tend % ssh % array(:) = 0.0
+ block % tend % ssh % array(:) = 0.0
- if (config_btr_solve_SSH2) then
- ! If config_btr_solve_SSH2=.true., then do NOT accumulate FBtr in this SSH predictor
- ! section, because it will be accumulated in the SSH corrector section.
- FBtr_coeff = 0.0
- else
- ! otherwise, DO accumulate FBtr in this SSH predictor section
- FBtr_coeff = 1.0
- endif
+ if (config_btr_solve_SSH2) then
+ ! If config_btr_solve_SSH2=.true., then do NOT accumulate FBtr in this SSH predictor
+ ! section, because it will be accumulated in the SSH corrector section.
+ FBtr_coeff = 0.0
+ else
+ ! otherwise, DO accumulate FBtr in this SSH predictor section
+ FBtr_coeff = 1.0
+ endif
- ! config_btr_gam1_uWt1 sets the forward weighting of velocity in the SSH computation
- ! config_btr_gam1_uWt1= 1 flux = uBtrNew*H
- ! config_btr_gam1_uWt1=0.5 flux = 1/2*(uBtrNew+uBtrOld)*H
- ! config_btr_gam1_uWt1= 0 flux = uBtrOld*H
- do iEdge=1,block % mesh % nEdges
- cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
- cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+ ! config_btr_gam1_uWt1 sets the forward weighting of velocity in the SSH computation
+ ! config_btr_gam1_uWt1= 1 flux = uBtrNew*H
+ ! config_btr_gam1_uWt1=0.5 flux = 1/2*(uBtrNew+uBtrOld)*H
+ ! config_btr_gam1_uWt1= 0 flux = uBtrOld*H
+ ! mrp 120201 efficiency: could we combine the following edge and cell loops?
+ do iEdge=1,block % mesh % nEdges
+ cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+ cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
- sshEdge = 0.5 * (block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &
- + block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) )
- hSum = sum(block % mesh % hZLevel % array (1:block % mesh % maxLevelEdgeTop % array(iEdge)))
+ sshEdge = 0.5 * (block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &
+ + block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) )
+ hSum = sshEdge + block % mesh % referenceBottomDepthTopOfCell % array (block % mesh % maxLevelEdgeTop % array(iEdge)+1)
- flux = ((1.0-config_btr_gam1_uWt1) * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- + config_btr_gam1_uWt1 * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) * (sshEdge + hSum)
+ flux = ((1.0-config_btr_gam1_uWt1) * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ + config_btr_gam1_uWt1 * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) &
+ * hSum
- block % tend % ssh % array(cell1) = block % tend % ssh % array(cell1) - flux * block % mesh % dvEdge % array(iEdge)
- block % tend % ssh % array(cell2) = block % tend % ssh % array(cell2) + flux * block % mesh % dvEdge % array(iEdge)
+ block % tend % ssh % array(cell1) = block % tend % ssh % array(cell1) - flux * block % mesh % dvEdge % array(iEdge)
+ block % tend % ssh % array(cell2) = block % tend % ssh % array(cell2) + flux * block % mesh % dvEdge % array(iEdge)
- block % state % time_levs(1) % state % FBtr % array(iEdge) = block % state % time_levs(1) % state % FBtr % array(iEdge) &
- + FBtr_coeff*flux
- end do
+ block % state % time_levs(1) % state % FBtr % array(iEdge) = block % state % time_levs(1) % state % FBtr % array(iEdge) &
+ + FBtr_coeff*flux
+ end do
- ! SSHnew = SSHold + dt/J*(-div(Flux))
- do iCell=1,block % mesh % nCells
+ ! SSHnew = SSHold + dt/J*(-div(Flux))
+ do iCell=1,block % mesh % nCells
- block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
- = block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
- + dt/config_n_btr_subcycles * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
+ block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
+ = block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
+ + dt/config_n_btr_subcycles * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
- end do
-
- block => block % next
- end do ! block
-
- ! boundary update on SSHnew
- call mpas_timer_start("se halo ssh", .false., timer_halo_ssh)
- block => domain % blocklist
- do while (associated(block))
- ! block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &
-
- call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &
- block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &
- block % mesh % nCells, block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-
- block => block % next
- end do ! block
- call mpas_timer_stop("se halo ssh", timer_halo_ssh)
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Barotropic subcycle: Final solve for velocity. Iterate for Coriolis term.
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- do BtrCorIter=1,config_n_btr_cor_iter
- uPerpTime = newBtrSubcycleTime
-
- block => domain % blocklist
- do while (associated(block))
- do iEdge=1,block % mesh % nEdges
- cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
- cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-
- ! Compute -f*uPerp
- uPerp = 0.0
- do i = 1,block % mesh % nEdgesOnEdge % array(iEdge)
- eoe = block % mesh % edgesOnEdge % array(i,iEdge)
- uPerp = uPerp + block % mesh % weightsOnEdge % array(i,iEdge) &
- * block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &
- * block % mesh % fEdge % array(eoe)
- end do
-
- sshCell1 = (1-config_btr_gam2_SSHWt1)*block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &
- + config_btr_gam2_SSHWt1 *block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell1)
-
- sshCell2 = (1-config_btr_gam2_SSHWt1)*block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) &
- + config_btr_gam2_SSHWt1 *block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell2)
-
- block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- = (block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- + dt/config_n_btr_subcycles *(uPerp - gravity *(sshCell2 - sshCell1) /block % mesh % dcEdge % array(iEdge) &
- + block % state % time_levs(1) % state % GBtrForcing % array(iEdge) &
- + block % state % time_levs(1) % state % u_diffusionBtr % array(iEdge))) * block % mesh % edgeMask % array(1,iEdge)
end do
block => block % next
end do ! block
-
- ! boundary update on uBtrNew
- call mpas_timer_start("se halo ubtr", .false., timer_halo_ubtr)
+ ! boundary update on SSHnew
+ call mpas_timer_start("se halo ssh", .false., timer_halo_ssh)
block => domain % blocklist
do while (associated(block))
+
call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &
- block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:), &
- block % mesh % nEdges, block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+ block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &
+ block % mesh % nCells, block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
block => block % next
end do ! block
- call mpas_timer_stop("se halo ubtr", timer_halo_ubtr)
- end do !do BtrCorIter=1,config_n_btr_cor_iter
+ call mpas_timer_stop("se halo ssh", timer_halo_ssh)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Barotropic subcycle: Compute thickness flux and new SSH: CORRECTOR
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- if (config_btr_solve_SSH2) then
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Barotropic subcycle: VELOCITY CORRECTOR STEP
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ do BtrCorIter=1,config_n_btr_cor_iter
+ uPerpTime = newBtrSubcycleTime
- block => domain % blocklist
- do while (associated(block))
- block % tend % ssh % array(:) = 0.0
+ block => domain % blocklist
+ do while (associated(block))
+ do iEdge=1,block % mesh % nEdges
+ cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+ cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
- ! config_btr_gam3_uWt2 sets the forward weighting of velocity in the SSH computation
- ! config_btr_gam3_uWt2= 1 flux = uBtrNew*H
- ! config_btr_gam3_uWt2=0.5 flux = 1/2*(uBtrNew+uBtrOld)*H
- ! config_btr_gam3_uWt2= 0 flux = uBtrOld*H
+ ! Compute the barotropic Coriolis term, -f*uPerp
+ CoriolisTerm = 0.0
+ do i = 1,block % mesh % nEdgesOnEdge % array(iEdge)
+ eoe = block % mesh % edgesOnEdge % array(i,iEdge)
+ CoriolisTerm = CoriolisTerm + block % mesh % weightsOnEdge % array(i,iEdge) &
+ * block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &
+ * block % mesh % fEdge % array(eoe)
+ end do
- do iEdge=1,block % mesh % nEdges
- cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
- cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+ ! In this final solve for velocity, SSH is a linear
+ ! combination of SSHold and SSHnew.
+ sshCell1 = (1-config_btr_gam2_SSHWt1)*block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &
+ + config_btr_gam2_SSHWt1 *block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell1)
+ sshCell2 = (1-config_btr_gam2_SSHWt1)*block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) &
+ + config_btr_gam2_SSHWt1 *block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell2)
+
+ ! uBtrNew = uBtrOld + dt/J*(-f*uBtroldPerp - g*grad(SSH) + G)
+ block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ = (block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ + dt/config_n_btr_subcycles *(CoriolisTerm - gravity *(sshCell2 - sshCell1) /block % mesh % dcEdge % array(iEdge) &
+ + block % state % time_levs(1) % state % GBtrForcing % array(iEdge))) * block % mesh % edgeMask % array(1,iEdge)
+ end do
- sshEdge = 0.5 * (block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &
- + block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2))
- hSum = sum(block % mesh % hZLevel % array (1:block % mesh % maxLevelEdgeTop % array(iEdge)))
+ block => block % next
+ end do ! block
- flux = ((1.0-config_btr_gam3_uWt2) * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- + config_btr_gam3_uWt2 * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) &
- * (sshEdge + hSum)
+ ! boundary update on uBtrNew
+ call mpas_timer_start("se halo ubtr", .false., timer_halo_ubtr)
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &
+ block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:), &
+ block % mesh % nEdges, block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- block % tend % ssh % array(cell1) = block % tend % ssh % array(cell1) - flux * block % mesh % dvEdge % array(iEdge)
- block % tend % ssh % array(cell2) = block % tend % ssh % array(cell2) + flux * block % mesh % dvEdge % array(iEdge)
+ block => block % next
+ end do ! block
+ call mpas_timer_stop("se halo ubtr", timer_halo_ubtr)
+ end do !do BtrCorIter=1,config_n_btr_cor_iter
- block % state % time_levs(1) % state % FBtr % array(iEdge) = block % state % time_levs(1) % state % FBtr % array(iEdge) + flux
- end do
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Barotropic subcycle: SSH CORRECTOR STEP
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ if (config_btr_solve_SSH2) then
- ! SSHnew = SSHold + dt/J*(-div(Flux))
- do iCell=1,block % mesh % nCells
- block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
- = block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
- + dt/config_n_btr_subcycles * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
- end do
+ block => domain % blocklist
+ do while (associated(block))
+ block % tend % ssh % array(:) = 0.0
- block => block % next
- end do ! block
+ ! config_btr_gam3_uWt2 sets the forward weighting of velocity in the SSH computation
+ ! config_btr_gam3_uWt2= 1 flux = uBtrNew*H
+ ! config_btr_gam3_uWt2=0.5 flux = 1/2*(uBtrNew+uBtrOld)*H
+ ! config_btr_gam3_uWt2= 0 flux = uBtrOld*H
+ ! mrp 120201 efficiency: could we combine the following edge and cell loops?
+ do iEdge=1,block % mesh % nEdges
+ cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+ cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
- ! boundary update on SSHnew
- call mpas_timer_start("se halo ssh", .false., timer_halo_ssh)
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &
- block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &
- block % mesh % nCells, block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+ ! SSH is a linear combination of SSHold and SSHnew.
+ sshCell1 = (1-config_btr_gam2_SSHWt1)*block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &
+ + config_btr_gam2_SSHWt1 *block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell1)
+ sshCell2 = (1-config_btr_gam2_SSHWt1)*block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) &
+ + config_btr_gam2_SSHWt1 *block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell2)
+
+ sshEdge = 0.5 * (sshCell1 + sshCell2)
+ hSum = sshEdge + block % mesh % referenceBottomDepthTopOfCell % array (block % mesh % maxLevelEdgeTop % array(iEdge)+1)
- block => block % next
- end do ! block
- call mpas_timer_stop("se halo ssh", timer_halo_ssh)
- endif ! config_btr_solve_SSH2
+ flux = ((1.0-config_btr_gam3_uWt2) * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ + config_btr_gam3_uWt2 * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) &
+ * hSum
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Barotropic subcycle: Accumulate running sums, advance timestep pointers
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ block % tend % ssh % array(cell1) = block % tend % ssh % array(cell1) - flux * block % mesh % dvEdge % array(iEdge)
+ block % tend % ssh % array(cell2) = block % tend % ssh % array(cell2) + flux * block % mesh % dvEdge % array(iEdge)
- block => domain % blocklist
- do while (associated(block))
+ block % state % time_levs(1) % state % FBtr % array(iEdge) = block % state % time_levs(1) % state % FBtr % array(iEdge) + flux
+ end do
- ! Accumulate SSH in running sum over the subcycles.
- do iCell=1,block % mesh % nCells
- block % state % time_levs(2) % state % ssh % array(iCell) = block % state % time_levs(2) % state % ssh % array(iCell) &
- + block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell)
- end do
+ ! SSHnew = SSHold + dt/J*(-div(Flux))
+ do iCell=1,block % mesh % nCells
+ block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
+ = block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
+ + dt/config_n_btr_subcycles * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
+ end do
- ! uBtrNew = uBtrNew + uBtrSubcycleNEW
- ! This accumulates the sum.
- ! If the Barotropic Coriolis iteration is limited to one, this could
- ! be merged with the above code.
- do iEdge=1,block % mesh % nEdges
+ block => block % next
+ end do ! block
- block % state % time_levs(2) % state % uBtr % array(iEdge) = block % state % time_levs(2) % state % uBtr % array(iEdge) &
- + block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
+ ! boundary update on SSHnew
+ call mpas_timer_start("se halo ssh", .false., timer_halo_ssh)
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &
+ block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &
+ block % mesh % nCells, block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- end do ! iEdge
- block => block % next
- end do ! block
+ block => block % next
+ end do ! block
+ call mpas_timer_stop("se halo ssh", timer_halo_ssh)
+ endif ! config_btr_solve_SSH2
- ! advance time pointers
- oldBtrSubcycleTime = mod(oldBtrSubcycleTime,2)+1
- newBtrSubcycleTime = mod(newBtrSubcycleTime,2)+1
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Barotropic subcycle: Accumulate running sums, advance timestep pointers
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- end do ! j=1,config_n_btr_subcycles
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! END Barotropic subcycle loop
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ block => domain % blocklist
+ do while (associated(block))
-
- ! Normalize Barotropic subcycle sums: ssh, uBtr, and F
- block => domain % blocklist
- do while (associated(block))
+ ! uBtrNew = uBtrNew + uBtrSubcycleNEW
+ ! This accumulates the sum.
+ ! If the Barotropic Coriolis iteration is limited to one, this could
+ ! be merged with the above code.
+ do iEdge=1,block % mesh % nEdges
- do iEdge=1,block % mesh % nEdges
- block % state % time_levs(1) % state % FBtr % array(iEdge) = block % state % time_levs(1) % state % FBtr % array(iEdge) &
- / (config_n_btr_subcycles*config_btr_subcycle_loop_factor)
+ block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ = block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ + block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
- block % state % time_levs(2) % state % uBtr % array(iEdge) = block % state % time_levs(2) % state % uBtr % array(iEdge) &
- / (config_n_btr_subcycles*config_btr_subcycle_loop_factor + 1)
- end do
+ end do ! iEdge
+ block => block % next
+ end do ! block
- if (config_SSH_from=='avg_of_SSH_subcycles') then
- do iCell=1,block % mesh % nCells
- block % state % time_levs(2) % state % ssh % array(iCell) = block % state % time_levs(2) % state % ssh % array(iCell) &
- / (config_n_btr_subcycles*config_btr_subcycle_loop_factor + 1)
- end do
- elseif (config_SSH_from=='avg_flux') then
- ! see below
- else
- write(0,*) 'Abort: Unknown config_SSH_from option: ' //trim(config_SSH_from)
- call mpas_dmpar_abort(dminfo)
- endif
+ ! advance time pointers
+ oldBtrSubcycleTime = mod(oldBtrSubcycleTime,2)+1
+ newBtrSubcycleTime = mod(newBtrSubcycleTime,2)+1
- block => block % next
- end do ! block
+ end do ! j=1,config_n_btr_subcycles
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! END Barotropic subcycle loop
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ ! Normalize Barotropic subcycle sums: ssh, uBtr, and F
+ block => domain % blocklist
+ do while (associated(block))
+ do iEdge=1,block % mesh % nEdges
+ block % state % time_levs(1) % state % FBtr % array(iEdge) = block % state % time_levs(1) % state % FBtr % array(iEdge) &
+ / (config_n_btr_subcycles*config_btr_subcycle_loop_factor)
- ! boundary update on F
- call mpas_timer_start("se halo F", .false., timer_halo_f)
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &
- block % state % time_levs(1) % state % FBtr % array(:), &
- block % mesh % nEdges, block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+ block % state % time_levs(2) % state % uBtr % array(iEdge) = block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ / (config_n_btr_subcycles*config_btr_subcycle_loop_factor + 1)
+ end do
- block => block % next
- end do ! block
- call mpas_timer_stop("se halo F", timer_halo_f)
+ block => block % next
+ end do ! block
+
+
+ ! boundary update on F
+ call mpas_timer_start("se halo F", .false., timer_halo_f)
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &
+ block % state % time_levs(1) % state % FBtr % array(:), &
+ block % mesh % nEdges, block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+ block => block % next
+ end do ! block
+ call mpas_timer_stop("se halo F", timer_halo_f)
- ! Check that you can compute SSH using the total sum or the individual increments
- ! over the barotropic subcycles.
- ! efficiency: This next block of code is really a check for debugging, and can
- ! be removed later.
- block => domain % blocklist
- do while (associated(block))
+ ! Check that you can compute SSH using the total sum or the individual increments
+ ! over the barotropic subcycles.
+ ! efficiency: This next block of code is really a check for debugging, and can
+ ! be removed later.
+ block => domain % blocklist
+ do while (associated(block))
- allocate(uTemp(block % mesh % nVertLevels))
+ allocate(uTemp(block % mesh % nVertLevels))
- if (config_SSH_from=='avg_flux') then
- ! Accumulate fluxes in the tend % ssh variable
- block % tend % ssh % array(:) = 0.0
- do iEdge=1,block % mesh % nEdges
- cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
- cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+ ! Correction velocity uCorr = (Flux - Sum(h u*))/H
+ ! or, for the full latex version:
+ !{\bf u}^{corr} = \left( {\overline {\bf F}}
+ ! - \sum_{k=1}^{N^{edge}} h_{k,*}^{edge} {\bf u}_k^{avg} \right)
+ ! \left/ \sum_{k=1}^{N^{edge}} h_{k,*}^{edge} \right.
- block % tend % ssh % array(cell1) = block % tend % ssh % array(cell1) &
- - block % state % time_levs(1) % state % FBtr % array(iEdge) &
- * block % mesh % dvEdge % array(iEdge)
+ if (config_u_correction) then
+ ucorr_coef = 1
+ else
+ ucorr_coef = 0
+ endif
+ do iEdge=1,block % mesh % nEdges
- block % tend % ssh % array(cell2) = block % tend % ssh % array(cell2) &
- + block % state % time_levs(1) % state % FBtr % array(iEdge) &
- * block % mesh % dvEdge % array(iEdge)
+ ! This is u^{avg}
+ uTemp(:) = block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ + block % state % time_levs(2) % state % uBcl % array(:,iEdge)
- end do
+ ! hSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize hSum with a
+ ! nonzero value to avoid a NaN.
+ uhSum = block % state % time_levs(2) % state % h_edge % array(1,iEdge) * uTemp(1)
+ hSum = block % state % time_levs(2) % state % h_edge % array(1,iEdge)
- do iCell=1,block % mesh % nCells
+ do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
+ uhSum = uhSum + block % state % time_levs(2) % state % h_edge % array(k,iEdge) * uTemp(k)
+ hSum = hSum + block % state % time_levs(2) % state % h_edge % array(k,iEdge)
+ enddo
- ! SSHnew = SSHold + dt*(-div(Flux))
- block % state % time_levs(2) % state % ssh % array(iCell) = block % state % time_levs(1) % state % ssh % array(iCell) &
- + dt * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
- end do
- endif
+ uCorr = ucorr_coef*(( block % state % time_levs(1) % state % FBtr % array(iEdge) - uhSum)/hSum)
- ! Correction velocity uCorr = (Flux - Sum(h u*))/H
- ! or, for the full latex version:
- !u^{corr} = \left( {\overline {\bf F}}
- ! - \sum_{k=1}^{N^{edge}} \left(\zeta_{k,n}^{*\;edge}+\Delta z_k\right) u_k^* \right)
- !\left/ \sum_{k=1}^{N^{edge}} \left(\zeta_{k,n}^{*\;edge}+\Delta z_k\right) \right.
+ ! put u^{tr}, the velocity for tracer transport, in uNew
+ ! mrp 060611 not sure if boundary enforcement is needed here.
+ if (block % mesh % boundaryEdge % array(1,iEdge).eq.1) then
+ block % state % time_levs(2) % state % u % array(:,iEdge) = 0.0
+ else
+ do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
+ block % state % time_levs(2) % state % u % array(k,iEdge) = uTemp(k) + uCorr
+ enddo
+ do k=block % mesh % maxLevelEdgeTop % array(iEdge)+1,block % mesh % nVertLevels
+ block % state % time_levs(2) % state % u % array(k,iEdge) = 0.0
+ end do
+ endif
- if (config_u_correction) then
- ucorr_coef = 1
- else
- ucorr_coef = 0
- endif
+ end do ! iEdge
- do iEdge=1,block % mesh % nEdges
- cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
- cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+ deallocate(uTemp)
- sshEdge = 0.5 * (block % state % time_levs(2) % state % ssh % array(cell1) &
- + block % state % time_levs(2) % state % ssh % array(cell2))
+ block => block % next
+ end do ! block
- ! This is u*
- uTemp(:) = block % state % time_levs(2) % state % uBtr % array(iEdge) &
- + block % state % time_levs(2) % state % uBcl % array(:,iEdge)
+ endif ! split_explicit
- uhSum = (sshEdge + block % mesh % hZLevel % array(1)) * uTemp(1)
- hSum = sshEdge + block % mesh % hZLevel % array(1)
+ call mpas_timer_stop("se btr vel", timer_btr_vel)
- do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
- uhSum = uhSum + block % mesh % hZLevel % array(k) * uTemp(k)
- hSum = hSum + block % mesh % hZLevel % array(k)
- enddo
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! Stage 3: Tracer, density, pressure, vertical velocity prediction
+ !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- uCorr = ucorr_coef*(( block % state % time_levs(1) % state % FBtr % array(iEdge) - uhSum)/hSum)
+ !TDR: it seems almost trivial to hold off on doing T, S and rho updates until the
+ !TDR: dycore time step is complete. we might want to take this opportunity to clean-up
+ !TDR: Stage3 in order to faciliate the testing of not doing tracer updates after this code is committed to trunk.
+ !TDR: at this point, I am suggesting just pushing some of this code into subroutines.
+ !TDR: see comments farther down
- ! put u^{tr}, the velocity for tracer transport, in uNew
- ! mrp 060611 not sure if boundary enforcement is needed here.
- if (block % mesh % boundaryEdge % array(1,iEdge).eq.1) then
- block % state % time_levs(2) % state % u % array(:,iEdge) = 0.0
- else
- do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
- block % state % time_levs(2) % state % u % array(k,iEdge) = uTemp(k) + uCorr
- enddo
- do k=block % mesh % maxLevelEdgeTop % array(iEdge)+1,block % mesh % nVertLevels
- block % state % time_levs(2) % state % u % array(k,iEdge) = 0.0
- enddo
- endif
+ block => domain % blocklist
+ do while (associated(block))
+ call ocn_wtop(block % state % time_levs(1) % state,block % state % time_levs(2) % state, block % mesh)
- ! Put new sshEdge values in h_edge array, for the OcnTendScalar call below.
- block % state % time_levs(2) % state % h_edge % array(1,iEdge) = sshEdge + block % mesh % hZLevel % array(1)
+ call ocn_tend_h (block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
+ call ocn_tend_scalar(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
- do k=2,block % mesh % nVertLevels
- block % state % time_levs(2) % state % h_edge % array(k,iEdge) = block % mesh % hZLevel % array(k)
- enddo
- end do ! iEdge
+ block => block % next
+ end do
- ! Put new SSH values in h array, for the OcnTendScalar call below.
- do iCell=1,block % mesh % nCells
- block % state % time_levs(2) % state % h % array(1,iCell) = block % state % time_levs(2) % state % ssh % array(iCell) &
- + block % mesh % hZLevel % array(1)
+ ! update halo for thickness and tracer tendencies
+ call mpas_timer_start("se halo h", .false., timer_halo_h)
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % tend % h % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- ! mrp 110601 efficiency note: Since h just moves back and forth between pointers,
- ! this is not necessary once initialized.
- do k=2,block % mesh % nVertLevels * sshSwapFlag
- block % state % time_levs(2) % state % h % array(k,iCell) = block % mesh % hZLevel % array(k)
- enddo
- enddo ! iCell
-
- deallocate(uTemp)
-
block => block % next
- end do ! block
- sshSwapFlag = 0
- endif ! split_explicit
- call mpas_timer_stop("se btr vel", timer_btr_vel)
+ end do
+ call mpas_timer_stop("se halo h", timer_halo_h)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !
- ! Stage 3: Tracer, density, pressure, vertical velocity prediction
- !
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ block => domain % blocklist
+ do while (associated(block))
- block => domain % blocklist
- do while (associated(block))
- call ocn_wtop(block % state % time_levs(2) % state, block % mesh)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! If iterating, reset variables for next iteration
+ !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ if (split_explicit_step < config_n_ts_iter) then
- if (trim(config_time_integration) == 'unsplit_explicit') then
- call ocn_tend_h(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
- endif
+ !TDR: should we move this code into a subroutine called "compute_intermediate_value_at_midtime"
+ !TDR: this could be within a contains statement in this routine
- call ocn_tend_scalar(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
+ ! Only need T & S for earlier iterations,
+ ! then all the tracers needed the last time through.
+ do iCell=1,block % mesh % nCells
+ ! sshNew is a pointer, defined above.
+ do k=1,block % mesh % maxLevelCell % array(iCell)
- block => block % next
- end do
+ ! this is h_{n+1}
+ temp_h &
+ = block % state % time_levs(1) % state % h % array(k,iCell) &
+ + dt* block % tend % h % array(k,iCell)
- ! update halo for thicknes for unsplit only
- if (trim(config_time_integration) == 'unsplit_explicit') then
- call mpas_timer_start("se halo h", .false., timer_halo_h)
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % tend % h % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nCells, block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- block => block % next
- end do
- call mpas_timer_stop("se halo h", timer_halo_h)
- endif ! unsplit_explicit
+ ! this is h_{n+1/2}
+ block % state % time_levs(2) % state % h % array(k,iCell) &
+ = 0.5*( &
+ block % state % time_levs(1) % state % h % array(k,iCell) &
+ + temp_h)
+ do i=1,2
+ ! This is Phi at n+1
+ temp = ( &
+ block % state % time_levs(1) % state % tracers % array(i,k,iCell) &
+ * block % state % time_levs(1) % state % h % array(k,iCell) &
+ + dt * block % tend % tracers % array(i,k,iCell)) &
+ / temp_h
+
+ ! This is Phi at n+1/2
+ block % state % time_levs(2) % state % tracers % array(i,k,iCell) &
+ = 0.5*( &
+ block % state % time_levs(1) % state % tracers % array(i,k,iCell) &
+ + temp )
+ end do
+ end do
+ end do ! iCell
- block => domain % blocklist
- do while (associated(block))
- allocate(hNew(block % mesh % nVertLevels))
+ ! uBclNew is u'_{n+1/2}
+ ! uBtrNew is {\bar u}_{avg}
+ ! uNew is u^{tr}
- if (trim(config_new_btr_variables_from) == 'last_subcycle') then
- ! This points to the last barotropic SSH subcycle
- sshNew => block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array
- elseif (trim(config_new_btr_variables_from) == 'btr_avg') then
- ! This points to the tendency variable SSH*
- sshNew => block % state % time_levs(2) % state % ssh % array
- endif
+ ! mrp 110512 I really only need this to compute h_edge, density, pressure, and SSH
+ ! I can par this down later.
+ call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
- if (trim(config_time_integration) == 'unsplit_explicit') then
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! If large iteration complete, compute all variables at time n+1
+ !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ elseif (split_explicit_step == config_n_ts_iter) then
- do iCell=1,block % mesh % nCells
- ! this is h_{n+1}
- block % state % time_levs(2) % state % h % array(:,iCell) &
- = block % state % time_levs(1) % state % h % array(:,iCell) &
- + dt* block % tend % h % array(:,iCell)
+ !TDR: should we move this code into a subroutine called "compute_final_values_at_nplus1"?
+ !TDR: this could be within a contains statement in this routine
- ! this is only for the hNew computation below, so there is the correct
- ! value in the ssh variable for unsplit_explicit case.
- block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
- = block % state % time_levs(2) % state % h % array(1,iCell) &
- - block % mesh % hZLevel % array(1)
- end do ! iCell
- endif ! unsplit_explicit
+ do iCell=1,block % mesh % nCells
+ do k=1,block % mesh % maxLevelCell % array(iCell)
- ! Only need T & S for earlier iterations,
- ! then all the tracers needed the last time through.
- if (split_explicit_step < config_n_ts_iter) then
- hNew(:) = block % mesh % hZLevel % array(:)
- do iCell=1,block % mesh % nCells
- ! sshNew is a pointer, defined above.
- hNew(1) = sshNew(iCell) + block % mesh % hZLevel % array(1)
- do k=1,block % mesh % maxLevelCell % array(iCell)
- do i=1,2
- ! This is Phi at n+1
- tracerTemp = ( block % state % time_levs(1) % state % tracers % array(i,k,iCell) &
- * block % state % time_levs(1) % state % h % array(k,iCell) &
- + dt * block % tend % tracers % array(i,k,iCell)) / hNew(k)
+ ! this is h_{n+1}
+ block % state % time_levs(2) % state % h % array(k,iCell) &
+ = block % state % time_levs(1) % state % h % array(k,iCell) &
+ + dt* block % tend % h % array(k,iCell)
- ! This is Phi at n+1/2
- block % state % time_levs(2) % state % tracers % array(i,k,iCell) = 0.5*( &
- block % state % time_levs(1) % state % tracers % array(i,k,iCell) + tracerTemp )
- enddo
- end do
- end do ! iCell
+ ! This is Phi at n+1
+ do i=1,block % state % time_levs(1) % state % num_tracers
+ block % state % time_levs(2) % state % tracers % array(i,k,iCell) &
+ = (block % state % time_levs(1) % state % tracers % array(i,k,iCell) &
+ * block % state % time_levs(1) % state % h % array(k,iCell) &
+ + dt * block % tend % tracers % array(i,k,iCell)) &
+ / block % state % time_levs(2) % state % h % array(k,iCell)
+ enddo
+ end do
+ end do
- if (trim(config_time_integration) == 'unsplit_explicit') then
+ ! Recompute final u to go on to next step.
+ ! u_{n+1} = uBtr_{n+1} + uBcl_{n+1}
+ ! Right now uBclNew is at time n+1/2, so back compute to get uBcl at time n+1
+ ! using uBcl_{n+1/2} = 1/2*(uBcl_n + u_Bcl_{n+1})
+ ! so the following lines are
+ ! u_{n+1} = uBtr_{n+1} + 2*uBcl_{n+1/2} - uBcl_n
+ ! note that uBcl is recomputed at the beginning of the next timestep due to Imp Vert mixing,
+ ! so uBcl does not have to be recomputed here.
+
+ do iEdge=1,block % mesh % nEdges
+ do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
+ block % state % time_levs(2) % state % u % array(k,iEdge) &
+ = block % state % time_levs(2) % state % uBtr % array( iEdge) &
+ +2*block % state % time_levs(2) % state % uBcl % array(k,iEdge) &
+ - block % state % time_levs(1) % state % uBcl % array(k,iEdge)
+ end do
+ end do ! iEdges
- ! compute h*, which is h at n+1/2 and put into array hNew
- ! on last iteration, hNew remains at n+1
- do iCell=1,block % mesh % nCells
- block % state % time_levs(2) % state % h % array(1,iCell) = 0.5*( &
- block % state % time_levs(2) % state % h % array(1,iCell) &
- + block % state % time_levs(1) % state % h % array(1,iCell) )
- end do ! iCell
- endif ! unsplit_explicit
+ endif ! split_explicit_step
- ! compute u*, the velocity for tendency terms. Put in uNew.
- ! uBclNew is at time n+1/2 here.
- ! This overwrites u^{tr}, the tracer transport velocity, which was in uNew.
- ! The following must occur after call OcnTendScalar
- do iEdge=1,block % mesh % nEdges
- block % state % time_levs(2) % state % u % array(:,iEdge) &
- = block % state % time_levs(2) % state % uBtr % array(iEdge) &
- + block % state % time_levs(2) % state % uBcl % array(:,iEdge)
- end do ! iEdge
+ block => block % next
+ end do
- elseif (split_explicit_step == config_n_ts_iter) then
-
- hNew(:) = block % mesh % hZLevel % array(:)
- do iCell=1,block % mesh % nCells
- ! sshNew is a pointer, defined above.
- hNew(1) = sshNew(iCell) + block % mesh % hZLevel % array(1)
- do k=1,block % mesh % maxLevelCell % array(iCell)
- do i=1,block % state % time_levs(1) % state % num_tracers
- ! This is Phi at n+1
- block % state % time_levs(2) % state % tracers % array(i,k,iCell) &
- = (block % state % time_levs(1) % state % tracers % array(i,k,iCell) &
- * block % state % time_levs(1) % state % h % array(k,iCell) &
- + dt * block % tend % tracers % array(i,k,iCell)) / hNew(k)
-
- enddo
- end do
- end do
- endif ! split_explicit_step
- deallocate(hNew)
-
- block => block % next
- end do
-
! Boundary update on tracers. This is placed here, rather than
! on tend % tracers as in RK4, because I needed to update
! afterwards for the del4 diffusion operator.
- call mpas_timer_start("se halo tracers", .false., timer_halo_tracers)
- block => domain % blocklist
- do while (associated(block))
- call mpas_dmpar_exch_halo_field3d_real(domain % dminfo, block % state % time_levs(2) % state % tracers % array(:,:,:), &
- block % tend % num_tracers, block % mesh % nVertLevels, block % mesh % nCells, block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- block => block % next
- end do
- call mpas_timer_stop("se halo tracers", timer_halo_tracers)
+ call mpas_timer_start("se halo tracers", .false., timer_halo_tracers)
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_dmpar_exch_halo_field3d_real(domain % dminfo, block % state % time_levs(2) % state % tracers % array(:,:,:), &
+ block % tend % num_tracers, block % mesh % nVertLevels, block % mesh % nCells, block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- if (split_explicit_step < config_n_ts_iter) then
- ! mrp 110512 I really only need this to compute h_edge, density, pressure.
- ! I can par this down later.
- block => domain % blocklist
- do while (associated(block))
+ block => block % next
+ end do
+ call mpas_timer_stop("se halo tracers", timer_halo_tracers)
- call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
- block => block % next
- end do
- endif
end do ! split_explicit_step = 1, config_n_ts_iter
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END large iteration loop
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !
- ! A little clean up at the end: decouple new scalar fields and compute diagnostics for new state
- !
block => domain % blocklist
do while (associated(block))
- if (trim(config_new_btr_variables_from) == 'last_subcycle') then
- do iEdge=1,block % mesh % nEdges
- ! uBtrNew = uBtrSubcycleNew (old here is because counter already flipped)
- ! This line is not needed if u is resplit at the beginning of the timestep.
- block % state % time_levs(2) % state % uBtr % array(iEdge) &
- = block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
- enddo ! iEdges
- elseif (trim(config_new_btr_variables_from) == 'btr_avg') then
- ! uBtrNew from u*. this is done above, so u* is already in
- ! block % state % time_levs(2) % state % uBtr % array(iEdge)
- else
- write(0,*) 'Abort: Unknown config_new_btr_variables_from: '//trim(config_time_integration)
- call mpas_dmpar_abort(dminfo)
- endif
- ! Recompute final u to go on to next step.
- ! u_{n+1} = uBtr_{n+1} + uBcl_{n+1}
- ! Right now uBclNew is at time n+1/2, so back compute to get uBcl at time n+1
- ! using uBcl_{n+1/2} = 1/2*(uBcl_n + u_Bcl_{n+1})
- ! so the following lines are
- ! u_{n+1} = uBtr_{n+1} + 2*uBcl_{n+1/2} - uBcl_n
- ! note that uBcl is recomputed at the beginning of the next timestep due to Imp Vert mixing,
- ! so uBcl does not have to be recomputed here.
-
- do iEdge=1,block % mesh % nEdges
- do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
- block % state % time_levs(2) % state % u % array(k,iEdge) = block % state % time_levs(2) % state % uBtr % array(iEdge) &
- + 2*block % state % time_levs(2) % state % uBcl % array(k,iEdge) - block % state % time_levs(1) % state % uBcl % array(k,iEdge)
- enddo
- enddo ! iEdges
- if (trim(config_time_integration) == 'split_explicit') then
- if (trim(config_new_btr_variables_from) == 'last_subcycle') then
- do iCell=1,block % mesh % nCells
- ! SSH for the next step is from the end of the barotropic subcycle.
- block % state % time_levs(2) % state % ssh % array(iCell) = block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell)
- end do ! iCell
- elseif (trim(config_new_btr_variables_from) == 'btr_avg') then
- ! sshNew from ssh*. This is done above, so ssh* is already in
- ! block % state % time_levs(2) % state % ssh % array(iCell)
- endif
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! Implicit vertical mixing, done after timestep is complete
+ !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- do iCell=1,block % mesh % nCells
- ! Put new SSH values in h array, for the OcnTendScalar call below.
- block % state % time_levs(2) % state % h % array(1,iCell) = block % state % time_levs(2) % state % ssh % array(iCell) + block % mesh % hZLevel % array(1)
+ u => block % state % time_levs(2) % state % u % array
+ tracers => block % state % time_levs(2) % state % tracers % array
+ h => block % state % time_levs(2) % state % h % array
+ h_edge => block % state % time_levs(2) % state % h_edge % array
+ ke_edge => block % state % time_levs(2) % state % ke_edge % array
+ num_tracers = block % state % time_levs(2) % state % num_tracers
+ vertViscTopOfEdge => block % diagnostics % vertViscTopOfEdge % array
+ vertDiffTopOfCell => block % diagnostics % vertDiffTopOfCell % array
+ maxLevelCell => block % mesh % maxLevelCell % array
+ maxLevelEdgeTop => block % mesh % maxLevelEdgeTop % array
- ! mrp 110601 efficiency note: Since h just moves back and forth between pointers,
- ! this is not necessary once initialized.
- do k=2,block % mesh % nVertLevels * sshSwapFlag
- block % state % time_levs(2) % state % h % array(k,iCell) = block % mesh % hZLevel % array(k)
- end do
- end do ! iCell
- sshSwapFlag = 0
- end if ! split_explicit
+ if (config_implicit_vertical_mix) then
+ call ocn_vmix_coefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !
- ! Implicit vertical mixing, done after timestep is complete
- !
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- u => block % state % time_levs(2) % state % u % array
- tracers => block % state % time_levs(2) % state % tracers % array
- h => block % state % time_levs(2) % state % h % array
- h_edge => block % state % time_levs(2) % state % h_edge % array
- ke_edge => block % state % time_levs(2) % state % ke_edge % array
- num_tracers = block % state % time_levs(2) % state % num_tracers
- vertViscTopOfEdge => block % diagnostics % vertViscTopOfEdge % array
- vertDiffTopOfCell => block % diagnostics % vertDiffTopOfCell % array
- maxLevelCell => block % mesh % maxLevelCell % array
- maxLevelEdgeTop => block % mesh % maxLevelEdgeTop % array
-
- if (config_implicit_vertical_mix) then
- call ocn_vmix_coefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
-
- !
- ! Implicit vertical solve for momentum
- !
-
- call ocn_vel_vmix_tend_implicit(block % mesh, dt, ke_edge, vertvisctopofedge, h, h_edge, u, err)
+ ! Implicit vertical solve for momentum
+ call ocn_vel_vmix_tend_implicit(block % mesh, dt, ke_edge, vertvisctopofedge, h, h_edge, u, err)
- !
- ! Implicit vertical solve for tracers
- !
- call ocn_tracer_vmix_tend_implicit(block % mesh, dt, vertdifftopofcell, h, tracers, err)
- end if
+ ! Implicit vertical solve for tracers
+ call ocn_tracer_vmix_tend_implicit(block % mesh, dt, vertdifftopofcell, h, tracers, err)
+ end if
- if (config_test_case == 1) then ! For case 1, wind field should be fixed
- block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
- end if
-
- call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
-
- call mpas_reconstruct(block % mesh, block % state % time_levs(2) % state % u % array, &
+ if (config_test_case == 1) then ! For case 1, wind field should be fixed
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+ end if
+ call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
+ call mpas_reconstruct(block % mesh, block % state % time_levs(2) % state % u % array, &
block % state % time_levs(2) % state % uReconstructX % array, &
block % state % time_levs(2) % state % uReconstructY % array, &
block % state % time_levs(2) % state % uReconstructZ % array, &
block % state % time_levs(2) % state % uReconstructZonal % array, &
block % state % time_levs(2) % state % uReconstructMeridional % array)
- call ocn_time_average_accumulate(block % state % time_levs(2) % state, block % state % time_levs(1) % state)
+ call ocn_time_average_accumulate(block % state % time_levs(2) % state, block % state % time_levs(1) % state)
- block => block % next
+
+ block => block % next
end do
call mpas_timer_stop("se timestep", timer_main)
- end subroutine ocn_time_integrator_split!}}}
+
+ end subroutine ocn_time_integrator_split!}}}
+
subroutine filter_btr_mode_tend_u(tend, s, d, grid)!{{{
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Filter and remove barotropic mode from the tendencies
@@ -1046,103 +936,45 @@
type (diagnostics_type), intent(in) :: d
type (mesh_type), intent(in) :: grid
-! mrp 110512 I just split compute_tend into compute_tend_u and compute_tend_h.
-! Some of these variables can be removed, but at a later time.
- integer :: iEdge, iCell, iVertex, k, cell1, cell2, &
- vertex1, vertex2, eoe, i, j
+ integer :: iEdge, k
integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
- real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
- real (kind=RKIND), dimension(:), pointer :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+ real (kind=RKIND) :: vertSum, uhSum, hSum
real (kind=RKIND), dimension(:,:), pointer :: &
- weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
- tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
- MontPot, wTop, divergence, vertViscTopOfEdge
+ h_edge, h, u,tend_u
type (dm_info) :: dminfo
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
- integer, dimension(:,:), pointer :: &
- cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
- edgesOnEdge, edgesOnVertex
- real (kind=RKIND) :: u_diffusion
- real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+ integer, dimension(:), pointer :: maxLevelEdgeTop
- real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
- real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
- real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
-
-
- real (kind=RKIND), dimension(:,:), pointer :: u_src
- real (kind=RKIND), parameter :: rho_ref = 1000.0
-
call mpas_timer_start("filter_btr_mode_tend_u")
h => s % h % array
u => s % u % array
- v => s % v % array
- wTop => s % wTop % array
h_edge => s % h_edge % array
- circulation => s % circulation % array
- vorticity => s % vorticity % array
- divergence => s % divergence % array
- ke => s % ke % array
- ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
- MontPot => s % MontPot % array
- pressure => s % pressure % array
- vertViscTopOfEdge => d % vertViscTopOfEdge % array
- weightsOnEdge => grid % weightsOnEdge % array
- kiteAreasOnVertex => grid % kiteAreasOnVertex % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnVertex => grid % cellsOnVertex % array
- verticesOnEdge => grid % verticesOnEdge % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- edgesOnCell => grid % edgesOnCell % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
- edgesOnEdge => grid % edgesOnEdge % array
- edgesOnVertex => grid % edgesOnVertex % array
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => grid % areaCell % array
- areaTriangle => grid % areaTriangle % array
- h_s => grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
- fVertex => grid % fVertex % array
- fEdge => grid % fEdge % array
- zMidZLevel => grid % zMidZLevel % array
- zTopZLevel => grid % zTopZLevel % array
- maxLevelCell => grid % maxLevelCell % array
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
tend_u => tend % u % array
nCells = grid % nCells
nEdges = grid % nEdges
- nEdgesSolve = grid % nEdgesSolve
- nVertices = grid % nVertices
nVertLevels = grid % nVertLevels
- u_src => grid % u_src % array
+ do iEdge=1,nEdges
- do iEdge=1,grid % nEdges
- ! I am using hZLevel here. This assumes that SSH is zero everywhere already,
- ! which should be the case if the barotropic mode is filtered.
- ! The more general case is to use sshEdge or h_edge.
- uhSum = (grid % hZLevel % array(1)) * tend_u(1,iEdge)
- hSum = grid % hZLevel % array(1)
+ ! hSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize hSum with a
+ ! nonzero value to avoid a NaN.
+ uhSum = h_edge(1,iEdge) * tend_u(1,iEdge)
+ hSum = h_edge(1,iEdge)
- do k=2,grid % maxLevelEdgeTop % array(iEdge)
- uhSum = uhSum + grid % hZLevel % array(k) * tend_u(k,iEdge)
- hSum = hSum + grid % hZLevel % array(k)
+ do k=2,maxLevelEdgeTop(iEdge)
+ uhSum = uhSum + h_edge(k,iEdge) * tend_u(k,iEdge)
+ hSum = hSum + h_edge(k,iEdge)
enddo
vertSum = uhSum/hSum
- do k=1,grid % maxLevelEdgeTop % array(iEdge)
+ do k=1,maxLevelEdgeTop(iEdge)
tend_u(k,iEdge) = tend_u(k,iEdge) - vertSum
enddo
enddo ! iEdge
@@ -1166,100 +998,43 @@
type (state_type), intent(inout) :: s
type (mesh_type), intent(in) :: grid
-! mrp 110512 I just split compute_tend into compute_tend_u and compute_tend_h.
-! Some of these variables can be removed, but at a later time.
- integer :: iEdge, iCell, iVertex, k, cell1, cell2, &
- vertex1, vertex2, eoe, i, j
+ integer :: iEdge, k
integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
- real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
- real (kind=RKIND), dimension(:), pointer :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+ real (kind=RKIND) :: vertSum, uhSum, hSum
real (kind=RKIND), dimension(:,:), pointer :: &
- weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
- tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
- MontPot, wTop, divergence, vertViscTopOfEdge
+ h_edge, h, u
type (dm_info) :: dminfo
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
- integer, dimension(:,:), pointer :: &
- cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
- edgesOnEdge, edgesOnVertex
- real (kind=RKIND) :: u_diffusion
- real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+ integer, dimension(:), pointer :: maxLevelEdgeTop
- real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
- real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
- real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
-
-
- real (kind=RKIND), dimension(:,:), pointer :: u_src
- real (kind=RKIND), parameter :: rho_ref = 1000.0
-
call mpas_timer_start("filter_btr_mode_u")
h => s % h % array
u => s % u % array
- v => s % v % array
- wTop => s % wTop % array
h_edge => s % h_edge % array
- circulation => s % circulation % array
- vorticity => s % vorticity % array
- divergence => s % divergence % array
- ke => s % ke % array
- ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
- MontPot => s % MontPot % array
- pressure => s % pressure % array
- weightsOnEdge => grid % weightsOnEdge % array
- kiteAreasOnVertex => grid % kiteAreasOnVertex % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnVertex => grid % cellsOnVertex % array
- verticesOnEdge => grid % verticesOnEdge % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- edgesOnCell => grid % edgesOnCell % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
- edgesOnEdge => grid % edgesOnEdge % array
- edgesOnVertex => grid % edgesOnVertex % array
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => grid % areaCell % array
- areaTriangle => grid % areaTriangle % array
- h_s => grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
- fVertex => grid % fVertex % array
- fEdge => grid % fEdge % array
- zMidZLevel => grid % zMidZLevel % array
- zTopZLevel => grid % zTopZLevel % array
- maxLevelCell => grid % maxLevelCell % array
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
nCells = grid % nCells
nEdges = grid % nEdges
- nEdgesSolve = grid % nEdgesSolve
- nVertices = grid % nVertices
nVertLevels = grid % nVertLevels
- u_src => grid % u_src % array
+ do iEdge=1,nEdges
- do iEdge=1,grid % nEdges
- ! I am using hZLevel here. This assumes that SSH is zero everywhere already,
- ! which should be the case if the barotropic mode is filtered.
- ! The more general case is to use sshedge or h_edge.
- uhSum = (grid % hZLevel % array(1)) * u(1,iEdge)
- hSum = grid % hZLevel % array(1)
+ ! hSum is initialized outside the loop because on land boundaries
+ ! maxLevelEdgeTop=0, but I want to initialize hSum with a
+ ! nonzero value to avoid a NaN.
+ uhSum = h_edge(1,iEdge) * u(1,iEdge)
+ hSum = h_edge(1,iEdge)
- do k=2,grid % maxLevelEdgeTop % array(iEdge)
- uhSum = uhSum + grid % hZLevel % array(k) * u(k,iEdge)
- hSum = hSum + grid % hZLevel % array(k)
+ do k=2,maxLevelEdgeTop(iEdge)
+ uhSum = uhSum + h_edge(k,iEdge) * u(k,iEdge)
+ hSum = hSum + h_edge(k,iEdge)
enddo
vertSum = uhSum/hSum
- do k=1,grid % maxLevelEdgeTop % array(iEdge)
+ do k=1,maxLevelEdgeTop(iEdge)
u(k,iEdge) = u(k,iEdge) - vertSum
enddo
enddo ! iEdge
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_time_integration_split.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_time_integration_split.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_time_integration_split.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration_split.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_time_integration_split.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_time_integration_split.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_time_integration_split.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_time_integration_split.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_time_integration_split.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_time_integration_split.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_time_integration_split.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_time_integration_split.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_time_integration_split.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_time_integration_split.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_time_integration_split.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_time_integration_split.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_time_integration_split.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_time_integration_split.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration_split.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_time_integration_split.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_time_integration_split.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_time_integration_split.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_time_integration_split.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_time_integration_split.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_time_integration_split.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_time_integration_split.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_time_integration_split.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_time_integration_split.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_hadv.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hadv.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hadv.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hadv.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hadv.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hadv.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hadv.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hadv.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hadv.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hadv.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hadv.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hadv.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_hadv.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_hadv.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_hadv.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hadv.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hadv.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hadv.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hadv.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hadv.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hadv.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hadv.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hadv.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hadv.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_hadv2.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hadv2.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hadv2.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv2.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hadv2.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hadv2.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hadv2.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hadv2.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hadv2.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hadv2.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hadv2.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hadv2.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv2.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hadv2.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_hadv2.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_hadv2.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_hadv2.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hadv2.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv2.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hadv2.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hadv2.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hadv2.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hadv2.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hadv2.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hadv2.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hadv2.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hadv2.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv2.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_hadv3.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hadv3.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hadv3.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv3.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hadv3.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hadv3.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hadv3.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hadv3.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hadv3.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hadv3.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hadv3.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hadv3.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv3.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hadv3.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_hadv3.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_hadv3.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_hadv3.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hadv3.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv3.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hadv3.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hadv3.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hadv3.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hadv3.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hadv3.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hadv3.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hadv3.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hadv3.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv3.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_hadv4.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_hadv4.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_hadv4.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -131,7 +131,7 @@
nEdges = grid % nEdges
num_tracers = size(tracers, dim=1)
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- nEdgesOnCell = grid % nEdgesOnCell % array
+ nEdgesOnCell => grid % nEdgesOnCell % array
cellMask => grid % cellMask % array
cellsOnEdge => grid % cellsOnEdge % array
cellsOnCell => grid % cellsOnCell % array
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_hadv4.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hadv4.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hadv4.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv4.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hadv4.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hadv4.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hadv4.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hadv4.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hadv4.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hadv4.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hadv4.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hadv4.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv4.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hadv4.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_hadv4.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_hadv4.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_hadv4.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hadv4.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv4.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hadv4.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hadv4.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hadv4.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hadv4.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hadv4.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hadv4.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hadv4.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hadv4.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv4.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_hmix.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hmix.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hmix.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hmix.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hmix.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hmix.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hmix.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hmix.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hmix.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hmix.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hmix.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hmix.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hmix.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_hmix.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_hmix.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_hmix.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hmix.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hmix.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hmix.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hmix.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hmix.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hmix.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hmix.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hmix.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hmix.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hmix.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_hmix_del2.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hmix_del2.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_hmix_del4.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_hmix_del4.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -70,7 +70,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_vadv_tend(grid, wTop, tracers, tend, err)!{{{
+ subroutine ocn_tracer_vadv_tend(grid, h, wTop, tracers, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -79,6 +79,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h, & !< Input: layer thickness
wTop !< Input: vertical tracer in top layer
real (kind=RKIND), dimension(:,:,:), intent(in) :: &
@@ -122,10 +123,15 @@
err = 0
+ ! mrp 120202 efficiency note:
+ ! The following if statement is not needed, since wTop is set to
+ ! zero for isopycnal coordinates. This if statment saves flops
+ ! for isopycnal coordinates. However, if the loops are pushed
+ ! out, we could get rid of this if statement.
if(.not.vadvOn) return
- call ocn_tracer_vadv_stencil_tend(grid, wTop, tracers, tend, err1)
- call ocn_tracer_vadv_spline_tend(grid, wTop, tracers, tend, err2)
+ call ocn_tracer_vadv_stencil_tend(grid, h, wTop, tracers, tend, err1)
+ call ocn_tracer_vadv_spline_tend(grid, h, wTop, tracers, tend, err2)
err = ior(err1, err2)
@@ -166,7 +172,7 @@
err = 0
vadvOn = .false.
- if (config_vert_grid_type.eq.'zlevel') then
+ if (config_vert_grid_type.ne.'isopycnal') then
vadvOn = .true.
call ocn_tracer_vadv_stencil_init(err1)
call ocn_tracer_vadv_spline_init(err2)
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_vadv.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_vadv.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_vadv.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_spline.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_spline.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_spline.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -72,7 +72,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_vadv_spline_tend(grid, wTop, tracers, tend, err)!{{{
+ subroutine ocn_tracer_vadv_spline_tend(grid, h, wTop, tracers, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -81,6 +81,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h, & !< Input: layer thickness
wTop !< Input: vertical tracer in top layer
real (kind=RKIND), dimension(:,:,:), intent(in) :: &
@@ -127,10 +128,11 @@
if(.not.splineOn) return
call mpas_timer_start("spline 2", .false., spline2_timer)
- call ocn_tracer_vadv_spline2_tend(grid, wTop, tracers, tend, err1)
+ call ocn_tracer_vadv_spline2_tend(grid, h, wTop, tracers, tend, err1)
call mpas_timer_stop("spline 2", spline2_timer)
+
call mpas_timer_start("spline 3", .false., spline3_timer)
- call ocn_tracer_vadv_spline3_tend(grid, wTop, tracers, tend, err2)
+ call ocn_tracer_vadv_spline3_tend(grid, h, wTop, tracers, tend, err2)
call mpas_timer_stop("spline 3", spline3_timer)
err = ior(err1, err2)
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_spline.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_spline.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -63,7 +63,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_vadv_spline2_tend(grid, wTop, tracers, tend, err)!{{{
+ subroutine ocn_tracer_vadv_spline2_tend(grid, h, wTop, tracers, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -72,6 +72,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h, & !< Input: layer thickness
wTop !< Input: vertical tracer in top layer
real (kind=RKIND), dimension(:,:,:), intent(in) :: &
@@ -107,8 +108,6 @@
integer, dimension(:), pointer :: maxLevelCell
- real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, hRatioZLevelKm1
-
real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
!-----------------------------------------------------------------
@@ -130,20 +129,18 @@
num_tracers = size(tracers, 1)
maxLevelCell => grid % maxLevelCell % array
- hRatioZLevelK => grid % hRatioZLevelK % array
- hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
-
allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
do iCell=1,nCellsSolve
tracerTop(:,1,iCell) = tracers(:,1,iCell)
do k=2,maxLevelCell(iCell)
do iTracer=1,num_tracers
- ! Note hRatio on the k side is multiplied by tracer at k-1
- ! and hRatio on the Km1 (k-1) side is mult. by tracer at k.
+ ! Note h on the k side is multiplied by tracer at k-1
+ ! and h on the Km1 (k-1) side is mult. by tracer at k.
tracerTop(iTracer,k,iCell) = &
- hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
- + hRatioZLevelKm1(k)*tracers(iTracer,k ,iCell)
+ ( h(k ,iCell)*tracers(iTracer,k-1,iCell) &
+ + h(k-1,iCell)*tracers(iTracer,k ,iCell) ) &
+ / (h(k-1,iCell) + h(k,iCell))
end do
end do
tracerTop(:,maxLevelCell(iCell)+1,iCell) = tracers(:,maxLevelCell(iCell),iCell)
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -64,7 +64,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_vadv_spline3_tend(grid, wTop, tracers, tend, err)!{{{
+ subroutine ocn_tracer_vadv_spline3_tend(grid, h, wTop, tracers, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -73,6 +73,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h, & !< Input: layer thickness
wTop !< Input: vertical tracer in top layer
real (kind=RKIND), dimension(:,:,:), intent(in) :: &
@@ -108,11 +109,8 @@
integer, dimension(:), pointer :: maxLevelCell
- real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, &
- hRatioZLevelKm1, zTopZLevel, zMidZLevel
-
real (kind=RKIND), dimension(:), allocatable :: tracer2ndDer, &
- tracersIn, tracersOut, posZMidZLevel, posZTopZLevel
+ tracersIn, tracersOut, depthTop, depthMid
real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
!-----------------------------------------------------------------
@@ -134,26 +132,24 @@
num_tracers = size(tracers, 1)
maxLevelCell => grid % maxLevelCell % array
- hRatioZLevelK => grid % hRatioZLevelK % array
- hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
- zMidZLevel => grid % zMidZLevel % array
- zTopZLevel => grid % zTopZLevel % array
-
allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
! Compute tracerTop using cubic spline interpolation.
allocate(tracer2ndDer(nVertLevels))
allocate(tracersIn(nVertLevels),tracersOut(nVertLevels), &
- posZMidZLevel(nVertLevels), posZTopZLevel(nVertLevels-1))
+ depthMid(nVertLevels), depthTop(nVertLevels+1))
- ! For the ocean, zlevel coordinates are negative and decreasing,
- ! but spline functions assume increasing, so flip to positive.
+ do iCell=1,nCellsSolve
- posZMidZLevel = -zMidZLevel(1:nVertLevels)
- posZTopZLevel = -zTopZLevel(2:nVertLevels)
+ ! Here depth considers SSH to be depth=0. We don't need to
+ ! have true z-coordinate depths because it is just for interpolation.
+ depthTop(1) = 0.0
+ do k=1,maxLevelCell(iCell)
+ depthMid(k ) = depthTop(k) + 0.5*h(k,iCell)
+ depthTop(k+1) = depthTop(k) + h(k,iCell)
+ enddo
- do iCell=1,nCellsSolve
! mrp 110201 efficiency note: push tracer loop down
! into spline subroutines to improve efficiency
do iTracer=1,num_tracers
@@ -162,12 +158,12 @@
! subroutine call.
tracersIn(1:maxLevelCell(iCell))=tracers(iTracer,1:maxLevelCell(iCell),iCell)
- call mpas_cubic_spline_coefficients(posZMidZLevel, &
+ call mpas_cubic_spline_coefficients(depthMid, &
tracersIn, maxLevelCell(iCell), tracer2ndDer)
call mpas_interpolate_cubic_spline( &
- posZMidZLevel, tracersIn, tracer2ndDer, maxLevelCell(iCell), &
- posZTopZLevel, tracersOut, maxLevelCell(iCell)-1 )
+ depthMid, tracersIn, tracer2ndDer, maxLevelCell(iCell), &
+ depthTop(2:maxLevelCell(iCell)), tracersOut, maxLevelCell(iCell)-1 )
tracerTop(itracer,1,iCell) = tracers(iTracer,1,iCell)
tracerTop(iTracer,2:maxLevelCell(iCell),iCell) = tracersOut(1:maxLevelCell(iCell)-1)
@@ -186,7 +182,7 @@
end do
deallocate(tracer2ndDer)
- deallocate(tracersIn,tracersOut, posZMidZLevel, posZTopZLevel)
+ deallocate(tracersIn,tracersOut, depthMid, depthTop)
deallocate(tracerTop)
!--------------------------------------------------------------------
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -74,7 +74,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_vadv_stencil_tend(grid, wTop, tracers, tend, err)!{{{
+ subroutine ocn_tracer_vadv_stencil_tend(grid, h, wTop, tracers, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -83,6 +83,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h, & !< Input: layer thickness
wTop !< Input: vertical tracer in top layer
real (kind=RKIND), dimension(:,:,:), intent(in) :: &
@@ -126,16 +127,16 @@
err = 0
- if(.not.stencilOn) return
+ if(.not. stencilOn) return
call mpas_timer_start("stencil 2", .false., stencil2_timer)
call ocn_tracer_vadv_stencil2_tend(grid, wTop, tracers, tend, err1)
call mpas_timer_stop("stencil 2", stencil2_timer)
call mpas_timer_start("stencil 3", .false., stencil3_timer)
- call ocn_tracer_vadv_stencil3_tend(grid, wTop, tracers, tend, err2)
+ call ocn_tracer_vadv_stencil3_tend(grid, h, wTop, tracers, tend, err2)
call mpas_timer_stop("stencil 3", stencil3_timer)
call mpas_timer_start("stencil 4", .false., stencil4_timer)
- call ocn_tracer_vadv_stencil4_tend(grid, wTop, tracers, tend, err3)
+ call ocn_tracer_vadv_stencil4_tend(grid, h, wTop, tracers, tend, err3)
call mpas_timer_stop("stencil 4", stencil4_timer)
err = ior(err1, ior(err2, err3))
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -63,7 +63,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_vadv_stencil3_tend(grid, wTop, tracers, tend, err)!{{{
+ subroutine ocn_tracer_vadv_stencil3_tend(grid, h, wTop, tracers, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -72,6 +72,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h, & !< Input: layer thickness
wTop !< Input: vertical tracer in top layer
real (kind=RKIND), dimension(:,:,:), intent(in) :: &
@@ -109,7 +110,6 @@
integer, dimension(:), pointer :: maxLevelCell
real (kind=RKIND) :: cSignWTop, flux3Coef
- real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, hRatioZLevelKm1
real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
@@ -130,8 +130,6 @@
num_tracers = size(tracers, 1)
nVertLevels = grid % nVertLevels
maxLevelCell => grid % maxLevelCell % array
- hRatioZLevelK => grid % hRatioZLevelK % array
- hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
@@ -145,9 +143,10 @@
tracerTop(:,1,iCell) = tracers(:,1,iCell)
k=2
do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
- + hRatioZLevelKm1(k)*tracers(iTracer,k ,iCell)
+ tracerTop(iTracer,k,iCell) = &
+ ( h(k,iCell)*tracers(iTracer,k-1,iCell) &
+ + h(k-1,iCell)*tracers(iTracer,k ,iCell) ) &
+ / (h(k-1,iCell) + h(k,iCell))
end do
do k=3,maxLevelCell(iCell)-1
cSignWTop = sign(flux3Coef,wTop(k,iCell))
@@ -162,9 +161,10 @@
end do
k=maxLevelCell(iCell)
do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
- + hRatioZLevelKm1(k)*tracers(iTracer,k ,iCell)
+ tracerTop(iTracer,k,iCell) = &
+ ( h(k,iCell)*tracers(iTracer,k-1,iCell) &
+ + h(k-1,iCell)*tracers(iTracer,k ,iCell) ) &
+ / (h(k-1,iCell) + h(k,iCell))
end do
tracerTop(:,maxLevelCell(iCell)+1,iCell) = tracers(:,maxLevelCell(iCell),iCell)
end do
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -63,7 +63,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tracer_vadv_stencil4_tend(grid, wTop, tracers, tend, err)!{{{
+ subroutine ocn_tracer_vadv_stencil4_tend(grid, h, wTop, tracers, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -72,6 +72,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h, & !< Input: layer thickness
wTop !< Input: vertical tracer in top layer
real (kind=RKIND), dimension(:,:,:), intent(in) :: &
@@ -109,7 +110,6 @@
integer, dimension(:), pointer :: maxLevelCell
real (kind=RKIND) :: cSingWTop, flux3Coef
- real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, hRatioZLevelKm1
real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
@@ -130,8 +130,6 @@
num_tracers = size(tracers, 1)
nVertLevels = grid % nVertLevels
maxLevelCell => grid % maxLevelCell % array
- hRatioZLevelK => grid % hRatioZLevelK % array
- hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
@@ -141,9 +139,10 @@
tracerTop(:,1,iCell) = tracers(:,1,iCell)
k=2
do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
- + hRatioZLevelKm1(k)*tracers(iTracer,k ,iCell)
+ tracerTop(iTracer,k,iCell) = &
+ ( h(k ,iCell)*tracers(iTracer,k-1,iCell) &
+ + h(k-1,iCell)*tracers(iTracer,k ,iCell) ) &
+ / (h(k-1,iCell) + h(k,iCell))
end do
do k=3,maxLevelCell(iCell)-1
do iTracer=1,num_tracers
@@ -157,9 +156,10 @@
end do
k=maxLevelCell(iCell)
do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
- + hRatioZLevelKm1(k)*tracers(iTracer,k ,iCell)
+ tracerTop(iTracer,k,iCell) = &
+ ( h(k ,iCell)*tracers(iTracer,k-1,iCell) &
+ + h(k-1,iCell)*tracers(iTracer,k ,iCell) ) &
+ / (h(k-1,iCell) + h(k,iCell))
end do
tracerTop(:,maxLevelCell(iCell)+1,iCell) = tracers(:,maxLevelCell(iCell),iCell)
end do
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_coriolis.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_coriolis.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_coriolis.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_coriolis.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_coriolis.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_coriolis.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_coriolis.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_coriolis.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_coriolis.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_coriolis.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_coriolis.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_coriolis.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_coriolis.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_coriolis.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_vel_coriolis.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_vel_coriolis.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_vel_coriolis.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_coriolis.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_coriolis.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_coriolis.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_coriolis.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_coriolis.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_coriolis.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_coriolis.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_coriolis.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_coriolis.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_coriolis.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_coriolis.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_forcing.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_forcing.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_forcing.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_forcing.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_forcing.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_forcing.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_forcing.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_forcing.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_forcing.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_forcing.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_forcing.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_forcing.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_forcing.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_vel_forcing.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_vel_forcing.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_vel_forcing.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_forcing.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_forcing.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_forcing.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_forcing.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_forcing.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_forcing.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_forcing.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_forcing.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_forcing.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_forcing.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_forcing_windstress.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_forcing_windstress.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_hmix.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_hmix.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_hmix.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_hmix.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_hmix.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_hmix.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_hmix.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_hmix.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_hmix.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_hmix.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_hmix.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_hmix.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_hmix.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_vel_hmix.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_vel_hmix.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_vel_hmix.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_hmix.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_hmix.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_hmix.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_hmix.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_hmix.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_hmix.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_hmix.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_hmix.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_hmix.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_hmix.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_hmix_del2.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_hmix_del2.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_hmix_del2.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_hmix_del2.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_hmix_del2.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_hmix_del2.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_hmix_del2.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_hmix_del2.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_hmix_del4.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_hmix_del4.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_hmix_del4.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_hmix_del4.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_hmix_del4.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_hmix_del4.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_hmix_del4.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_hmix_del4.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_pressure_grad.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_pressure_grad.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_pressure_grad.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -17,6 +17,7 @@
use mpas_grid_types
use mpas_configure
+ use mpas_constants
implicit none
private
@@ -43,7 +44,7 @@
!
!--------------------------------------------------------------------
- real (kind=RKIND) :: rho0Inv
+ real (kind=RKIND) :: rho0Inv, grho0Inv
!***********************************************************************
@@ -64,7 +65,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_pressure_grad_tend(grid, pressure, tend, err)!{{{
+ subroutine ocn_vel_pressure_grad_tend(grid, pressure, zMid, rho, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -73,7 +74,9 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
- pressure !< Input: Pressure field or Mongomery potential
+ pressure, & !< Input: Pressure field or Mongomery potential
+ zMid, & !< Input: z-coordinate at mid-depth of layer
+ rho !< Input: density
type (mesh_type), intent(in) :: &
grid !< Input: grid information
@@ -116,20 +119,33 @@
dcEdge => grid % dcEdge % array
edgeMask => grid % edgeMask % array
-! dwj: 10/25/2011 - Need to explore isopycnal vs zlevel flags
- do iEdge=1,nEdgesSolve
- cell1 = cellsOnEdge(1,iEdge)
- cell2 = cellsOnEdge(2,iEdge)
+ ! pressure for generalized coordinates
+ ! -1/rho_0 (grad p_k + rho g grad z_k^{mid})
- invdcEdge = 1.0 / dcEdge(iEdge)
- do k=1,maxLevelEdgeTop(iEdge)
+ ! For pure isopycnal coordinates, we are still using
+ ! grad(M), the gradient of Montgomery Potential, because
+ ! we have set rho0Inv=1 and grho0Inv=0 in the init routine,
+ ! and pressure is passed in as MontPot.
- tend(k,iEdge) = tend(k,iEdge) - edgeMask(k,iEdge) * rho0Inv*( pressure(k,cell2) - pressure(k,cell1) ) * invdcEdge
- end do
+ do iEdge=1,nEdgesSolve
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ invdcEdge = 1.0 / dcEdge(iEdge)
- enddo
+ do k=1,maxLevelEdgeTop(iEdge)
+ tend(k,iEdge) = tend(k,iEdge) &
+ - edgeMask(k,iEdge) * rho0Inv*( pressure(k,cell2) &
+ - pressure(k,cell1) )* invdcEdge &
+ - edgeMask(k,iEdge) * grho0Inv* 0.5*(rho(k,cell1)+rho(k,cell2)) &
+ *( zMid(k,cell2) &
+ - zMid(k,cell1) )* invdcEdge
+
+ end do
+ end do
+
+
!--------------------------------------------------------------------
end subroutine ocn_vel_pressure_grad_tend!}}}
@@ -170,12 +186,16 @@
err = 0
- if (config_vert_grid_type.eq.'isopycnal') then
+ if (config_pressure_type.eq.'MontgomeryPotential') then
rho0Inv = 1.0
- elseif (config_vert_grid_type.eq.'zlevel') then
+ grho0Inv = 0.0
+ else
rho0Inv = 1.0/config_rho0
+ grho0Inv = gravity/config_rho0
end if
+
+
!--------------------------------------------------------------------
end subroutine ocn_vel_pressure_grad_init!}}}
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_pressure_grad.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_pressure_grad.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_pressure_grad.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_pressure_grad.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_pressure_grad.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_pressure_grad.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_pressure_grad.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_pressure_grad.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_vadv.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_vadv.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_vadv.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -64,7 +64,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_vadv_tend(grid, u, wTop, tend, err)!{{{
+ subroutine ocn_vel_vadv_tend(grid, u, h_edge, wTop, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -75,6 +75,7 @@
real (kind=RKIND), dimension(:,:), intent(in) :: &
u !< Input: Horizontal velocity
real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h_edge,&!< Input: thickness at edge
wTop !< Input: Vertical velocity on top layer
type (mesh_type), intent(in) :: &
@@ -110,8 +111,12 @@
real (kind=RKIND) :: wTopEdge
real (kind=RKIND), dimension(:), allocatable :: w_dudzTopEdge
- real (kind=RKIND), dimension(:), pointer :: zMidZLevel
+ ! mrp 120202 efficiency note:
+ ! The following if statement is not needed, since wTop is set to
+ ! zero for isopycnal coordinates. This if statment saves flops
+ ! for isopycnal coordinates. However, if the loops are pushed
+ ! out, we could get rid of this if statement.
if(.not.velVadvOn) return
err = 0
@@ -120,7 +125,6 @@
nEdgesSolve = grid % nEdgesSolve
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
cellsOnEdge => grid % cellsOnEdge % array
- zMidZLevel => grid % zMidZLevel % array
edgeMask => grid % edgeMask % array
allocate(w_dudzTopEdge(nVertLevels+1))
@@ -135,7 +139,7 @@
! compute dudz at vertical interface with first order derivative.
w_dudzTopEdge(k) = wTopEdge * (u(k-1,iEdge)-u(k,iEdge)) &
- / (zMidZLevel(k-1) - zMidZLevel(k))
+ / (0.5*(h_edge(k-1,iEdge) + h_edge(k,iEdge)))
end do
w_dudzTopEdge(maxLevelEdgeTop(iEdge)+1) = 0.0
! Average w*du/dz from vertical interface to vertical middle of cell
@@ -179,7 +183,7 @@
err = 0
velVadvOn = .false.
- if (config_vert_grid_type.eq.'zlevel') then
+ if (config_vert_grid_type.ne.'isopycnal') then
velVadvOn = .true.
end if
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vel_vadv.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_vadv.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_vadv.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_vadv.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_vadv.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_vadv.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_vadv.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_vadv.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_vadv.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_vadv.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_vadv.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_vadv.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_vadv.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vel_vadv.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_vel_vadv.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_vel_vadv.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_vel_vadv.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vel_vadv.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_vadv.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vel_vadv.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vel_vadv.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vel_vadv.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vel_vadv.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vel_vadv.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vel_vadv.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vel_vadv.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vel_vadv.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vel_vadv.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vmix.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vmix.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vmix.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -314,7 +314,6 @@
! mrp 110315 efficiency note: for z-level, could precompute
! -2.0*dt/(h(k)_h(k+1))/h(k) in setup
! h_edge is computed in compute_solve_diag, and is not available yet.
- ! This could be removed if hZLevel used instead.
cell1 = cellsOnEdge(1,iEdge)
cell2 = cellsOnEdge(2,iEdge)
do k=1,maxLevelEdgeTop(iEdge)
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vmix.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vmix.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vmix.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vmix.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vmix.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vmix.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vmix.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vmix.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vmix.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vmix.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vmix.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vmix.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vmix.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_vmix.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_vmix.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_vmix.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vmix.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vmix.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vmix.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vmix.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vmix.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vmix.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vmix.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vmix.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vmix.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vmix.F:1374-1538
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vmix_coefs_const.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vmix_coefs_const.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vmix_coefs_const.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vmix_coefs_const.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vmix_coefs_const.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vmix_coefs_const.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vmix_coefs_const.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vmix_coefs_const.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vmix_coefs_rich.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vmix_coefs_rich.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vmix_coefs_rich.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -248,8 +248,6 @@
else
! for Ri<0 and explicit vertical mix,
! use maximum diffusion allowed by CFL criterion
- ! mrp 110324 efficiency note: for z-level, could use fixed
- ! grid array hMeanTopZLevel and compute maxdiff on startup.
vertViscTopOfEdge(k,iEdge) = &
((h_edge(k-1,iEdge)+h_edge(k,iEdge))/2.0)**2/config_dt/4.0
end if
@@ -357,8 +355,6 @@
else
! for Ri<0 and explicit vertical mix,
! use maximum diffusion allowed by CFL criterion
- ! mrp 110324 efficiency note: for z-level, could use fixed
- ! grid array hMeanTopZLevel and compute maxdiff on startup.
vertDiffTopOfCell(k,iCell) = &
((h(k-1,iCell)+h(k,iCell))/2.0)**2/config_dt/4.0
end if
@@ -459,8 +455,8 @@
areaCell => grid % areaCell % array
allocate( &
- drhoTopOfCell(nVertLevels+1,nCells+1), drhoTopOfEdge(nVertLevels+1,nEdges+1), &
- du2TopOfCell(nVertLevels+1,nCells+1), du2TopOfEdge(nVertLevels+1,nEdges+1))
+ drhoTopOfCell(nVertLevels+1,nCells+1), drhoTopOfEdge(nVertLevels+1,nEdges), &
+ du2TopOfCell(nVertLevels+1,nCells+1), du2TopOfEdge(nVertLevels+1,nEdges))
! compute density of parcel displaced to next deeper z-level,
! in state % rhoDisplaced
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vmix_coefs_rich.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vmix_coefs_rich.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F
===================================================================
--- branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -177,18 +177,22 @@
integer :: k, nVertLevels
- real (kind=RKIND), dimension(:), pointer :: zTopZLevel
+ real (kind=RKIND), dimension(:), pointer :: referenceBottomDepth
err = 0
if(.not.tanhViscOn) return
nVertLevels = grid % nVertLevels
- zTopZLevel => grid % zTopZLevel % array
+ referenceBottomDepth => grid % referenceBottomDepth % array
- do k=1,nVertLevels+1
- vertViscTopOfEdge(k,:) = -(config_max_visc_tanh-config_min_visc_tanh)/2.0 &
- *tanh(-(zTopZLevel(k)-config_ZMid_tanh) &
+ ! referenceBottomDepth is used here for simplicity. Using zMid and h, which
+ ! vary in time, would give the exact location of the top, but it
+ ! would only change the diffusion value very slightly.
+ vertViscTopOfEdge = 0.0
+ do k=2,nVertLevels
+ vertViscTopOfEdge(k,:) = -(config_max_visc_tanh-config_min_visc_tanh)/2.0 &
+ *tanh((referenceBottomDepth(k-1)+config_ZMid_tanh) &
/config_zWidth_tanh) &
+ (config_max_visc_tanh+config_min_visc_tanh)/2
end do
@@ -246,18 +250,22 @@
integer :: k, nVertLevels
- real (kind=RKIND), dimension(:), pointer :: zTopZLevel
+ real (kind=RKIND), dimension(:), pointer :: referenceBottomDepth
err = 0
if(.not.tanhDiffOn) return
nVertLevels = grid % nVertLevels
- zTopZLevel => grid % zTopZLevel % array
+ referenceBottomDepth => grid % referenceBottomDepth % array
- do k=1,nVertLevels+1
+ ! referenceBottomDepth is used here for simplicity. Using zMid and h, which
+ ! vary in time, would give the exact location of the top, but it
+ ! would only change the diffusion value very slightly.
+ vertDiffTopOfCell = 0.0
+ do k=2,nVertLevels
vertDiffTopOfCell(k,:) = -(config_max_diff_tanh-config_min_diff_tanh)/2.0 &
- *tanh(-(zTopZLevel(k)-config_ZMid_tanh) &
+ *tanh((referenceBottomDepth(k-1)+config_ZMid_tanh) &
/config_zWidth_tanh) &
+ (config_max_diff_tanh+config_min_diff_tanh)/2
end do
@@ -308,14 +316,6 @@
tanhDiffOn = .true.
endif
- if((tanhViscOn) .or. (tanhDiffOn)) then
- if (config_vert_grid_type.ne.'zlevel') then
- write(0,*) 'Abort: config_vert_diff_type.eq.tanh may only', &
- ' use config_vert_grid_type of zlevel at this time'
- err = 1
- endif
- endif
-
!--------------------------------------------------------------------
end subroutine ocn_vmix_coefs_tanh_init!}}}
Property changes on: branches/omp_blocks/block_decomp/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1260-1270
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1374-1422
+ /branches/cam_mpas_nh/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1260-1270
/branches/ocean_projects/ale_split_exp/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1437-1483
/branches/ocean_projects/ale_vert_coord/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:754-986
/branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1120-1371
/branches/ocean_projects/rayleigh/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1298-1311
/branches/ocean_projects/split_explicit_mrp/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1134-1138
/branches/ocean_projects/split_explicit_timestepping/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1044-1097
/branches/ocean_projects/time_averaging/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1271-1305
/branches/ocean_projects/vert_adv_mrp/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:704-745
/branches/omp_blocks/ddt_reorg/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1301-1414
/branches/source_renaming/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1082-1113
/branches/time_manager/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:924-962
/trunk/mpas/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F:1374-1538
Modified: branches/omp_blocks/block_decomp/src/framework/mpas_configure.F
===================================================================
--- branches/omp_blocks/block_decomp/src/framework/mpas_configure.F 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/framework/mpas_configure.F 2012-02-28 00:35:39 UTC (rev 1539)
@@ -13,7 +13,7 @@
type (dm_info), intent(in) :: dminfo
- integer :: funit
+ integer :: funit, ierr
#include "config_namelist_defs.inc"
@@ -23,10 +23,12 @@
#include "config_set_defaults.inc"
if (dminfo % my_proc_id == IO_NODE) then
+ write(0,*) 'Reading namelist.input'
open(funit,file='namelist.input',status='old',form='formatted')
#include "config_namelist_reads.inc"
close(funit)
+ write(0,*) ' '
end if
#include "config_bcast_namelist.inc"
Modified: branches/omp_blocks/block_decomp/src/registry/gen_inc.c
===================================================================
--- branches/omp_blocks/block_decomp/src/registry/gen_inc.c 2012-02-27 22:33:23 UTC (rev 1538)
+++ branches/omp_blocks/block_decomp/src/registry/gen_inc.c 2012-02-28 00:35:39 UTC (rev 1539)
@@ -137,7 +137,15 @@
nls_ptr = nls;
while (nls_ptr) {
if (!dict_search(dictionary, nls_ptr->record)) {
- fortprintf(fd, " read(funit,%s)</font>
<font color="blue">", nls_ptr->record);
+ fortprintf(fd, " read(funit,%s,iostat=ierr)</font>
<font color="blue">", nls_ptr->record);
+ fortprintf(fd, " if (ierr > 0) then</font>
<font color="blue">");
+ fortprintf(fd, " write(0,*) \'Error while reading namelist record &%s\'</font>
<font color="blue">",nls_ptr->record);
+ fortprintf(fd, " call mpas_dmpar_abort(dminfo)</font>
<font color="blue">");
+ fortprintf(fd, " else if (ierr < 0) then</font>
<font color="blue">");
+ fortprintf(fd, " write(0,*) \'Namelist record &%s not found; using default values for this namelist\'\'s variables\'</font>
<font color="blue">",nls_ptr->record);
+ fortprintf(fd, " rewind(funit)</font>
<font color="blue">");
+ fortprintf(fd, " end if</font>
<font color="blue">");
+
dict_insert(dictionary, nls_ptr->record);
}
nls_ptr = nls_ptr->next;
</font>
</pre>