<p><b>qchen3@fsu.edu</b> 2012-03-15 13:43:17 -0600 (Thu, 15 Mar 2012)</p><p>BRANCH COMMIT<br>
<br>
This branch is to implement a framework for the GM closure in the ocean model.<br>
This commit contains updates from the trunk. After a committee review, it will be pushed into the trunk.<br>
<br>
</p><hr noshade><pre><font color="gray">
Property changes on: branches/ocean_projects/gmvar
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/cam_mpas_nh:1260-1270
/branches/ocean_projects/ale_split_exp:1437-1483
/branches/ocean_projects/ale_vert_coord:1225-1383
/branches/ocean_projects/ale_vert_coord_new:1387-1428
/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/source_renaming:1082-1113
/branches/time_manager:924-962
/trunk/mpas:1213-1492
+ /branches/cam_mpas_nh:1260-1270
/branches/ocean_projects/ale_split_exp:1437-1483
/branches/ocean_projects/ale_vert_coord:1225-1383
/branches/ocean_projects/ale_vert_coord_new:1387-1428
/branches/ocean_projects/imp_vert_mix_mrp:754-986
/branches/ocean_projects/monotonic_advection:1499-1640
/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/source_renaming:1082-1113
/branches/time_manager:924-962
/trunk/mpas:1213-1646
Modified: branches/ocean_projects/gmvar/Makefile
===================================================================
--- branches/ocean_projects/gmvar/Makefile 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/Makefile 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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:
- ( make all \
- "FC = xlf90" \
- "CC = xlc" \
- "SFC = xlf90" \
- "SCC = xlc" \
- "FFLAGS = -qrealsize=8 -g -C " \
- "CFLAGS = -g" \
- "LDFLAGS = -g -C" \
+xlf:
+ ( $(MAKE) all \
+ "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 = " \
+ ( $(MAKE) all \
+ "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" \
+ ( $(MAKE) all \
+ "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" \
+ ( $(MAKE) all \
+ "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 = " \
+ ( $(MAKE) all \
+ "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:
- ( make all \
- "FC = ifort" \
- "CC = gcc" \
- "SFC = ifort" \
- "SCC = gcc" \
- "FFLAGS = -real-size 64 -g -convert big_endian -FR" \
- "CFLAGS = -O3 -m64" \
- "LDFLAGS = -g" \
+ifort:
+ ( $(MAKE) all \
+ "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" \
+ ( $(MAKE) all \
+ "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" \
+ ( $(MAKE) all \
+ "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" \
+ ( $(MAKE) all \
+ "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" \
+ ( $(MAKE) all \
+ "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" \
+ ( $(MAKE) all \
+ "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,113 @@
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) -DMPAS_DEBUG
+ CFLAGS=$(CFLAGS_DEBUG) -DMPAS_DEBUG
+ LDFLAGS=$(LDFLAGS_DEBUG) -DMPAS_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)
+ override 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
+
+ifneq ($(wildcard $(NETCDF)/lib/libnetcdff.*), ) # CHECK FOR NETCDF4
+ LIBS += -lnetcdff
+endif # CHECK FOR NETCDF4
+
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)"
+ cd src; $(MAKE) -j1 FC="$(FC)" \
+ 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)"
+ 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/ocean_projects/gmvar/graphics/ncl/atm_cells.ncl (from rev 1646, trunk/mpas/graphics/ncl/atm_cells.ncl)
===================================================================
--- branches/ocean_projects/gmvar/graphics/ncl/atm_cells.ncl (rev 0)
+++ branches/ocean_projects/gmvar/graphics/ncl/atm_cells.ncl 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/graphics/ncl/atm_contours.ncl (from rev 1646, trunk/mpas/graphics/ncl/atm_contours.ncl)
===================================================================
--- branches/ocean_projects/gmvar/graphics/ncl/atm_contours.ncl (rev 0)
+++ branches/ocean_projects/gmvar/graphics/ncl/atm_contours.ncl 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/graphics/ncl/atm_mesh.ncl (from rev 1646, trunk/mpas/graphics/ncl/atm_mesh.ncl)
===================================================================
--- branches/ocean_projects/gmvar/graphics/ncl/atm_mesh.ncl (rev 0)
+++ branches/ocean_projects/gmvar/graphics/ncl/atm_mesh.ncl 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/graphics/ncl/atm_xsec.ncl (from rev 1646, trunk/mpas/graphics/ncl/atm_xsec.ncl)
===================================================================
--- branches/ocean_projects/gmvar/graphics/ncl/atm_xsec.ncl (rev 0)
+++ branches/ocean_projects/gmvar/graphics/ncl/atm_xsec.ncl 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/namelist.input.init_nhyd_atmos
===================================================================
--- branches/ocean_projects/gmvar/namelist.input.init_nhyd_atmos 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/namelist.input.init_nhyd_atmos 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/namelist.input.nhyd_atmos
===================================================================
--- branches/ocean_projects/gmvar/namelist.input.nhyd_atmos 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/namelist.input.nhyd_atmos 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/namelist.input.nhyd_atmos_mtn_wave
===================================================================
--- branches/ocean_projects/gmvar/namelist.input.nhyd_atmos_mtn_wave 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/namelist.input.nhyd_atmos_mtn_wave 2012-03-15 19:43:17 UTC (rev 1650)
@@ -1,49 +1,72 @@
&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
/
&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/ocean_projects/gmvar/namelist.input.nhyd_atmos_squall
===================================================================
--- branches/ocean_projects/gmvar/namelist.input.nhyd_atmos_squall 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/namelist.input.nhyd_atmos_squall 2012-03-15 19:43:17 UTC (rev 1650)
@@ -1,43 +1,74 @@
&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
/
&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/ocean_projects/gmvar/namelist.input.ocean
===================================================================
--- branches/ocean_projects/gmvar/namelist.input.ocean 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/namelist.input.ocean 2012-03-15 19:43:17 UTC (rev 1650)
@@ -45,7 +45,7 @@
config_h_kappa_q = 0.0
config_apvm_upwinding = 0.0
config_visc_vorticity_term = .true.
- config_h_tracer_eddy_diff2 = 0.0
+ config_h_tracer_eddy_diff2 = 1.0e5
config_h_tracer_eddy_diff4 = 0.0
/
&vmix
@@ -57,11 +57,11 @@
config_bottom_drag_coeff = 1.0e-3
/
&vmix_const
- config_vert_visc = 1.0e-4
- config_vert_diff = 1.0e-4
+ 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
/
@@ -79,9 +79,8 @@
&advection
config_vert_tracer_adv = 'stencil'
config_vert_tracer_adv_order = 2
- config_tracer_adv_order = 2
+ config_horiz_tracer_adv_order = 2
config_thickness_adv_order = 2
- config_positive_definite = .false.
config_monotonic = .false.
/
&restore
Property changes on: branches/ocean_projects/gmvar/src
___________________________________________________________________
Deleted: svn:mergeinfo
- /branches/cam_mpas_nh/src:1260-1270
/branches/ocean_projects/ale_split_exp/src:1437-1483
/branches/ocean_projects/ale_vert_coord/src:1225-1383
/branches/ocean_projects/ale_vert_coord_new/src:1387-1428
/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/source_renaming/src:1082-1113
/branches/time_manager/src:924-962
/trunk/mpas/src:1213-1492
Modified: branches/ocean_projects/gmvar/src/Makefile
===================================================================
--- branches/ocean_projects/gmvar/src/Makefile 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/Makefile 2012-03-15 19:43:17 UTC (rev 1650)
@@ -6,35 +6,35 @@
$(FC) $(LDFLAGS) -o $(CORE)_model.exe driver/*.o -L. -ldycore -lops -lframework $(LIBS) -I./external/esmf_time_f90 -L./external/esmf_time_f90 -lesmf_time
reg_includes:
- ( cd registry; make CC="$(SCC)" )
+ ( cd registry; $(MAKE) CC="$(SCC)" )
( cd inc; $(CPP) ../core_$(CORE)/Registry | ../registry/parse > Registry.processed)
-externals:
- ( cd external; make FC="$(FC)" SFC="$(SFC)" CC="$(CC)" SCC="$(SCC)" FFLAGS="$(FFLAGS)" CFLAGS="$(CFLAGS)" CPP="$(CPP)" NETCDF="$(NETCDF)" CORE="$(CORE)" )
+externals: reg_includes
+ ( cd external; $(MAKE) FC="$(FC)" SFC="$(SFC)" CC="$(CC)" SCC="$(SCC)" FFLAGS="$(FFLAGS)" CFLAGS="$(CFLAGS)" CPP="$(CPP)" NETCDF="$(NETCDF)" CORE="$(CORE)" )
-frame:
- ( cd framework; make all )
+frame: reg_includes externals
+ ( cd framework; $(MAKE) all )
ln -sf framework/libframework.a libframework.a
-ops:
- ( cd operators; make all )
+ops: reg_includes externals frame
+ ( cd operators; $(MAKE) all )
ln -sf operators/libops.a libops.a
-dycore:
- ( cd core_$(CORE); make all )
+dycore: reg_includes externals frame ops
+ ( cd core_$(CORE); $(MAKE) all )
ln -sf core_$(CORE)/libdycore.a libdycore.a
-drver:
- ( cd driver; make all )
+drver: reg_includes externals frame ops dycore
+ ( cd driver; $(MAKE) all )
clean:
$(RM) $(CORE)_model.exe libframework.a libops.a libdycore.a
- ( cd registry; make clean )
- ( cd external; make clean )
- ( cd framework; make clean )
- ( cd operators; make clean )
+ ( cd registry; $(MAKE) clean )
+ ( cd external; $(MAKE) clean )
+ ( cd framework; $(MAKE) clean )
+ ( cd operators; $(MAKE) clean )
( cd inc; rm -f *.inc Registry.processed )
if [ -d core_$(CORE) ] ; then \
- ( cd core_$(CORE); make clean ) \
+ ( cd core_$(CORE); $(MAKE) clean ) \
fi;
- ( cd driver; make clean )
+ ( cd driver; $(MAKE) clean )
Modified: branches/ocean_projects/gmvar/src/core_atmos_physics/Makefile
===================================================================
--- branches/ocean_projects/gmvar/src/core_atmos_physics/Makefile 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_atmos_physics/Makefile 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_control.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_control.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_control.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_driver.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_driver.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_driver.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_driver_convection_deep.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_driver_convection_deep.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_driver_convection_deep.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_initialize_real.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_initialize_real.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_initialize_real.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_manager.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_manager.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_manager.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_vars.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_vars.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_atmos_physics/mpas_atmphys_vars.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_atmos_physics/physics_wrf/Makefile
===================================================================
--- branches/ocean_projects/gmvar/src/core_atmos_physics/physics_wrf/Makefile 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_atmos_physics/physics_wrf/Makefile 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_atmos_physics/physics_wrf/module_cam_support.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_atmos_physics/physics_wrf/module_cam_support.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_atmos_physics/physics_wrf/module_cam_support.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_atmos_physics/physics_wrf/module_cu_tiedtke.F (from rev 1646, trunk/mpas/src/core_atmos_physics/physics_wrf/module_cu_tiedtke.F)
===================================================================
--- branches/ocean_projects/gmvar/src/core_atmos_physics/physics_wrf/module_cu_tiedtke.F (rev 0)
+++ branches/ocean_projects/gmvar/src/core_atmos_physics/physics_wrf/module_cu_tiedtke.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_hyd_atmos/Registry
===================================================================
--- branches/ocean_projects/gmvar/src/core_hyd_atmos/Registry 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_hyd_atmos/Registry 2012-03-15 19:43:17 UTC (rev 1650)
@@ -4,7 +4,7 @@
namelist integer sw_model config_test_case 5
namelist character sw_model config_time_integration SRK3
namelist real sw_model config_dt 172.8
-namelist integer sw_model config_calendar_type MPAS_360DAY
+namelist character sw_model config_calendar_type 360day
namelist character sw_model config_start_time 0000-01-01_00:00:00
namelist character sw_model config_stop_time none
namelist character sw_model config_run_duration none
Modified: branches/ocean_projects/gmvar/src/core_init_nhyd_atmos/Registry
===================================================================
--- branches/ocean_projects/gmvar/src/core_init_nhyd_atmos/Registry 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_init_nhyd_atmos/Registry 2012-03-15 19:43:17 UTC (rev 1650)
@@ -1,33 +1,32 @@
%
% namelist type namelist_record name default_value
%
-namelist integer nhyd_model config_test_case 5
-namelist integer nhyd_model config_calendar_type MPAS_GREGORIAN
+namelist integer nhyd_model config_test_case 7
+namelist character nhyd_model config_calendar_type 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 character io config_decomp_file_prefix graph.info.part.
namelist integer io config_frames_per_outfile 0
@@ -144,8 +143,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/ocean_projects/gmvar/src/core_init_nhyd_atmos/mpas_init_atm_test_cases.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_init_nhyd_atmos/mpas_init_atm_test_cases.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_init_nhyd_atmos/mpas_init_atm_test_cases.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_nhyd_atmos/Registry
===================================================================
--- branches/ocean_projects/gmvar/src/core_nhyd_atmos/Registry 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_nhyd_atmos/Registry 2012-03-15 19:43:17 UTC (rev 1650)
@@ -1,10 +1,10 @@
%
% 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 integer nhyd_model config_calendar_type MPAS_GREGORIAN
+namelist real nhyd_model config_dt 600.0
+namelist character nhyd_model config_calendar_type gregorian
namelist character nhyd_model config_start_time 0000-01-01_00:00:00
namelist character nhyd_model config_stop_time none
namelist character nhyd_model config_run_duration 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
@@ -146,10 +145,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...
@@ -334,14 +333,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
@@ -411,38 +410,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/ocean_projects/gmvar/src/core_nhyd_atmos/mpas_atm_mpas_core.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_nhyd_atmos/mpas_atm_mpas_core.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_nhyd_atmos/mpas_atm_mpas_core.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_nhyd_atmos/mpas_atm_test_cases.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_nhyd_atmos/mpas_atm_test_cases.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_nhyd_atmos/mpas_atm_test_cases.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_nhyd_atmos/mpas_atm_time_integration.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_nhyd_atmos/mpas_atm_time_integration.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_nhyd_atmos/mpas_atm_time_integration.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/core_ocean
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/source_renaming/src/core_ocean:1082-1113
/branches/time_manager/src/core_ocean:924-962
/trunk/mpas/src/core_ocean:1213-1492
Modified: branches/ocean_projects/gmvar/src/core_ocean/Makefile
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/Makefile 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_ocean/Makefile 2012-03-15 19:43:17 UTC (rev 1650)
@@ -37,6 +37,15 @@
mpas_ocn_vmix_coefs_tanh.o \
mpas_ocn_restoring.o \
mpas_ocn_tendency.o \
+ mpas_ocn_tracer_advection.o \
+ mpas_ocn_tracer_advection_std.o \
+ mpas_ocn_tracer_advection_std_hadv.o \
+ mpas_ocn_tracer_advection_std_vadv.o \
+ mpas_ocn_tracer_advection_std_vadv2.o \
+ mpas_ocn_tracer_advection_std_vadv3.o \
+ mpas_ocn_tracer_advection_std_vadv4.o \
+ mpas_ocn_tracer_advection_mono.o \
+ mpas_ocn_tracer_advection_helpers.o \
mpas_ocn_time_integration.o \
mpas_ocn_time_integration_rk4.o \
mpas_ocn_time_integration_split.o \
@@ -123,6 +132,24 @@
mpas_ocn_tracer_hmix_del4.o:
+mpas_ocn_tracer_advection.o: mpas_ocn_tracer_advection_std.o mpas_ocn_tracer_advection_mono.o
+
+mpas_ocn_tracer_advection_std.o: mpas_ocn_tracer_advection_std_hadv.o mpas_ocn_tracer_advection_std_vadv.o
+
+mpas_ocn_tracer_advection_std_hadv.o: mpas_ocn_tracer_advection_helpers.o
+
+mpas_ocn_tracer_advection_std_vadv.o: mpas_ocn_tracer_advection_std_vadv2.o mpas_ocn_tracer_advection_std_vadv3.o mpas_ocn_tracer_advection_std_vadv4.o
+
+mpas_ocn_tracer_advection_std_vadv2.o: mpas_ocn_tracer_advection_helpers.o
+
+mpas_ocn_tracer_advection_std_vadv3.o: mpas_ocn_tracer_advection_helpers.o
+
+mpas_ocn_tracer_advection_std_vadv4.o: mpas_ocn_tracer_advection_helpers.o
+
+mpas_ocn_tracer_advection_mono.o: mpas_ocn_tracer_advection_helpers.o
+
+mpas_ocn_tracer_advection_helpers.o:
+
mpas_ocn_restoring.o:
mpas_ocn_vmix.o: mpas_ocn_vmix_coefs_const.o mpas_ocn_vmix_coefs_rich.o mpas_ocn_vmix_coefs_tanh.o
@@ -174,6 +201,15 @@
mpas_ocn_vmix_coefs_rich.o \
mpas_ocn_vmix_coefs_tanh.o \
mpas_ocn_restoring.o \
+ mpas_ocn_tracer_advection.o \
+ mpas_ocn_tracer_advection_std.o \
+ mpas_ocn_tracer_advection_std_hadv.o \
+ mpas_ocn_tracer_advection_std_vadv.o \
+ mpas_ocn_tracer_advection_std_vadv2.o \
+ mpas_ocn_tracer_advection_std_vadv3.o \
+ mpas_ocn_tracer_advection_std_vadv4.o \
+ mpas_ocn_tracer_advection_mono.o \
+ mpas_ocn_tracer_advection_helpers.o \
mpas_ocn_tendency.o \
mpas_ocn_time_integration.o \
mpas_ocn_time_integration_rk4.o \
Modified: branches/ocean_projects/gmvar/src/core_ocean/Registry
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/Registry 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_ocean/Registry 2012-03-15 19:43:17 UTC (rev 1650)
@@ -5,12 +5,14 @@
namelist character sw_model config_time_integration RK4
namelist logical sw_model config_rk_filter_btr_mode false
namelist real sw_model config_dt 172.8
-namelist integer sw_model config_calendar_type MPAS_360DAY
+namelist character sw_model config_calendar_type 360day
namelist character sw_model config_start_time 0000-01-01_00:00:00
namelist character sw_model config_stop_time none
namelist character sw_model config_run_duration none
namelist integer sw_model config_stats_interval 100
namelist logical sw_model config_initial_stats false
+namelist logical sw_model config_prescribe_velocity false
+namelist logical sw_model config_prescribe_thickness false
namelist character io config_input_name grid.nc
namelist character io config_output_name output.nc
namelist character io config_restart_name restart.nc
@@ -49,6 +51,7 @@
namelist real hmix config_h_kappa_q 0.0
namelist logical hmix config_rayleigh_friction false
namelist real hmix config_rayleigh_damping_coeff 0.0
+namelist real hmix config_apvm_scale_factor 0.0
namelist character vmix config_vert_visc_type const
namelist character vmix config_vert_diff_type const
namelist logical vmix config_implicit_vertical_mix .true.
@@ -68,11 +71,12 @@
namelist real vmix_tanh config_zWidth_tanh 100
namelist character eos config_eos_type linear
namelist character advection config_vert_tracer_adv stencil
-namelist integer advection config_vert_tracer_adv_order 4
-namelist integer advection config_tracer_adv_order 2
+namelist integer advection config_vert_tracer_adv_order 4
+namelist integer advection config_horiz_tracer_adv_order 2
namelist integer advection config_thickness_adv_order 2
-namelist logical advection config_positive_definite false
+namelist real advection config_coef_3rd_order 0.25
namelist logical advection config_monotonic false
+namelist logical advection config_check_monotonicity false
namelist logical restore config_restoreTS false
namelist real restore config_restoreT_timescale 90.0
namelist real restore config_restoreS_timescale 90.0
@@ -84,6 +88,7 @@
dim nEdges nEdges
dim maxEdges maxEdges
dim maxEdges2 maxEdges2
+dim nAdvectionCells maxEdges2+0
dim nVertices nVertices
dim TWO 2
dim R3 3
@@ -151,9 +156,17 @@
var persistent real h_s ( nCells ) 0 iro h_s mesh - -
% Space needed for advection
-var persistent real deriv_two ( FIFTEEN TWO nEdges ) 0 - deriv_two mesh - -
-var persistent integer advCells ( TWENTYONE nCells ) 0 - advCells mesh - -
+var persistent real deriv_two ( maxEdges2 TWO nEdges ) 0 - deriv_two mesh - -
+% Added for monotonic advection scheme
+var persistent real adv_coefs ( nAdvectionCells nEdges ) 0 - adv_coefs mesh - -
+var persistent real adv_coefs_2nd ( nAdvectionCells nEdges ) 0 - adv_coefs_2nd mesh - -
+var persistent real adv_coefs_3rd ( nAdvectionCells nEdges ) 0 - adv_coefs_3rd mesh - -
+var persistent integer advCellsForEdge ( nAdvectionCells nEdges ) 0 - advCellsForEdge mesh - -
+var persistent integer nAdvCellsForEdge ( nEdges ) 0 - nAdvCellsForEdge mesh - -
+var persistent integer highOrderAdvectionMask ( nVertLevels nEdges ) 0 - highOrderAdvectionMask mesh - -
+var persistent integer lowOrderAdvectionMask ( nVertLevels nEdges ) 0 - lowOrderAdvectionMask mesh - -
+
% !! NOTE: the following arrays are needed to allow the use
% !! of the module_advection.F w/o alteration
% Space needed for deformation calculation weights
@@ -171,6 +184,7 @@
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 - -
% Boundary conditions: read from input, saved in restart and written to output
@@ -224,15 +238,15 @@
var persistent real h_kappa_q ( nVertLevels nEdges Time ) 2 - h_kappa_q state - -
var persistent real divergence ( nVertLevels nCells Time ) 2 o divergence state - -
var persistent real vorticity ( nVertLevels nVertices Time ) 2 o vorticity state - -
-var persistent real pv_edge ( nVertLevels nEdges Time ) 2 - pv_edge state - -
+var persistent real Vor_edge ( nVertLevels nEdges Time ) 2 - Vor_edge state - -
var persistent real h_edge ( nVertLevels nEdges Time ) 2 - h_edge state - -
var persistent real h_vertex ( nVertLevels nVertices Time ) 2 - h_vertex state - -
var persistent real ke ( nVertLevels nCells Time ) 2 o ke state - -
var persistent real kev ( nVertLevels nVertices Time ) 2 o kev state - -
var persistent real kevc ( nVertLevels nCells Time ) 2 o kevc state - -
var persistent real ke_edge ( nVertLevels nEdges Time ) 2 - ke_edge state - -
-var persistent real pv_vertex ( nVertLevels nVertices Time ) 2 o pv_vertex state - -
-var persistent real pv_cell ( nVertLevels nCells Time ) 2 o pv_cell state - -
+var persistent real Vor_vertex ( nVertLevels nVertices Time ) 2 - Vor_vertex state - -
+var persistent real Vor_cell ( nVertLevels nCells Time ) 2 o Vor_cell state - -
var persistent real uReconstructX ( nVertLevels nCells Time ) 2 - uReconstructX state - -
var persistent real uReconstructY ( nVertLevels nCells Time ) 2 - uReconstructY state - -
var persistent real uReconstructZ ( nVertLevels nCells Time ) 2 - uReconstructZ state - -
@@ -246,8 +260,8 @@
% Other diagnostic variables: neither read nor written to any files
var persistent real vh ( nVertLevels nEdges Time ) 2 - vh state - -
var persistent real circulation ( nVertLevels nVertices Time ) 2 - circulation state - -
-var persistent real gradPVt ( nVertLevels nEdges Time ) 2 - gradPVt state - -
-var persistent real gradPVn ( nVertLevels nEdges Time ) 2 - gradPVn state - -
+var persistent real gradVor_t ( nVertLevels nEdges Time ) 2 - gradVor_t state - -
+var persistent real gradVor_n ( nVertLevels nEdges Time ) 2 - gradVor_n state - -
% Globally reduced diagnostic variables: only written to output
var persistent real areaCellGlobal ( Time ) 2 o areaCellGlobal state - -
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/Registry
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/source_renaming/src/core_ocean/Registry:1082-1113
/branches/time_manager/src/core_ocean/Registry:924-962
/trunk/mpas/src/core_ocean/Registry:1213-1492
Modified: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_advection.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_advection.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_advection.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -9,19 +9,25 @@
contains
- subroutine ocn_initialize_advection_rk( grid )!{{{
+ subroutine ocn_initialize_advection_rk( grid, err )!{{{
!
! compute the cell coefficients for the polynomial fit.
! this is performed during setup for model integration.
! WCS, 31 August 2009
!
+! Described in:
+! Skamarock, W. C., & Gassmann, A. (2011).
+! Conservative Transport Schemes for Spherical Geodesic Grids: High-Order Flux Operators for ODE-Based Time Integration.
+! Monthly Weather Review, 139(9), 2962-2975. doi:10.1175/MWR-D-10-05056.1
+!
implicit none
type (mesh_type), intent(in) :: grid
+ integer, intent(out) :: err
real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
- integer, dimension(:,:), pointer :: advCells
+ integer, dimension(:), pointer :: advCells
! local variables
@@ -50,9 +56,7 @@
integer :: cell1, cell2
integer, parameter :: polynomial_order = 2
-! logical, parameter :: debug = .true.
logical, parameter :: debug = .false.
-! logical, parameter :: least_squares = .false.
logical, parameter :: least_squares = .true.
logical :: add_the_cell, do_the_cell
@@ -61,11 +65,19 @@
real (kind=RKIND) :: rcell, cos2t, costsint, sin2t
real (kind=RKIND), dimension(grid%maxEdges) :: angle_2d
-!---
+!---
+ err = 0
+ if(polynomial_order > 2) then
+ write (*,*) 'Polynomial for second derivitave can only be 2'
+ err = 1
+ return
+ end if
+
pii = 2.*asin(1.0)
- advCells => grid % advCells % array
+! advCells => grid % advCells % array
+ allocate(advCells(grid % maxEdges2))
deriv_two => grid % deriv_two % array
deriv_two(:,:,:) = 0.
@@ -93,7 +105,7 @@
end do
end if
- advCells(1,iCell) = n
+ advCells(1) = n
! check to see if we are reaching outside the halo
@@ -110,10 +122,10 @@
if ( grid % on_a_sphere ) then
do i=1,n
- advCells(i+1,iCell) = cell_list(i)
- xc(i) = grid % xCell % array(advCells(i+1,iCell))/a
- yc(i) = grid % yCell % array(advCells(i+1,iCell))/a
- zc(i) = grid % zCell % array(advCells(i+1,iCell))/a
+ advCells(i+1) = cell_list(i)
+ xc(i) = grid % xCell % array(advCells(i+1))/a
+ yc(i) = grid % yCell % array(advCells(i+1))/a
+ zc(i) = grid % zCell % array(advCells(i+1))/a
end do
theta_abs(iCell) = pii/2. - sphere_angle( xc(1), yc(1), zc(1), &
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_advection.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_equation_of_state.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_equation_of_state_jm.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_equation_of_state_linear.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Modified: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_global_diagnostics.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_global_diagnostics.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_global_diagnostics.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -46,8 +46,8 @@
real (kind=RKIND) :: volumeCellGlobal, volumeEdgeGlobal, CFLNumberGlobal, localCFL, localSum, areaCellGlobal, areaEdgeGlobal, areaTriangleGlobal
real (kind=RKIND), dimension(:), pointer :: areaCell, dcEdge, dvEdge, areaTriangle, areaEdge
- real (kind=RKIND), dimension(:,:), pointer :: h, u, v, h_edge, circulation, vorticity, ke, pv_edge, pv_vertex, &
- pv_cell, gradPVn, gradPVt, pressure, MontPot, wTop, rho, tracerTemp
+ real (kind=RKIND), dimension(:,:), pointer :: h, u, v, h_edge, circulation, vorticity, ke, Vor_edge, Vor_vertex, &
+ Vor_cell, gradVor_n, gradVor_t, pressure, MontPot, wTop, rho, tracerTemp
real (kind=RKIND), dimension(:,:,:), pointer :: tracers
real (kind=RKIND), dimension(kMaxVariables) :: sums, mins, maxes, averages, verticalSumMins, verticalSumMaxes, reductions
@@ -93,11 +93,11 @@
circulation => state % circulation % array
vorticity => state % vorticity % array
ke => state % ke % array
- pv_edge => state % pv_edge % array
- pv_vertex => state % pv_vertex % array
- pv_cell => state % pv_cell % array
- gradPVn => state % gradPVn % array
- gradPVt => state % gradPVt % array
+ Vor_edge => state % Vor_edge % array
+ Vor_vertex => state % Vor_vertex % array
+ Vor_cell => state % Vor_cell % array
+ gradVor_n => state % gradVor_n % array
+ gradVor_t => state % gradVor_t % array
MontPot => state % MontPot % array
pressure => state % pressure % array
@@ -176,10 +176,10 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! pv_edge
+ ! Vor_edge
variableIndex = variableIndex + 1
call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
- pv_edge(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
+ Vor_edge(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -187,10 +187,10 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! pv_vertex
+ ! Vor_vertex
variableIndex = variableIndex + 1
call ocn_compute_field_area_weighted_local_stats(dminfo, nVertLevels, nVerticesSolve, areaTriangle(1:nVerticesSolve), &
- pv_vertex(:,1:nVerticesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), &
+ Vor_vertex(:,1:nVerticesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), &
verticalSumMins_tmp(variableIndex), verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -198,10 +198,10 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! pv_cell
+ ! Vor_cell
variableIndex = variableIndex + 1
call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
- pv_cell(:,1:nCellsSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
+ Vor_cell(:,1:nCellsSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -209,10 +209,10 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! gradPVn
+ ! gradVor_n
variableIndex = variableIndex + 1
call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
- gradPVn(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
+ gradVor_n(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -220,10 +220,10 @@
verticalSumMins(variableIndex) = min(verticalSumMins(variableIndex), verticalSumMins_tmp(variableIndex))
verticalSumMaxes(variableIndex) = max(verticalSumMaxes(variableIndex), verticalSumMaxes_tmp(variableIndex))
- ! gradPVt
+ ! gradVor_t
variableIndex = variableIndex + 1
call ocn_compute_field_volume_weighted_local_stats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
- gradPVt(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
+ gradVor_t(:,1:nEdgesSolve), sums_tmp(variableIndex), mins_tmp(variableIndex), maxes_tmp(variableIndex), verticalSumMins_tmp(variableIndex), &
verticalSumMaxes_tmp(variableIndex))
sums(variableIndex) = sums(variableIndex) + sums_tmp(variableIndex)
mins(variableIndex) = min(mins(variableIndex), mins_tmp(variableIndex))
@@ -374,23 +374,23 @@
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
- ! pv_edge
+ ! Vor_edge
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
- ! pv_vertex
+ ! Vor_vertex
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/(areaTriangleGlobal*nVertLevels)
- ! pv_cell
+ ! Vor_cell
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
- ! gradPVn
+ ! gradVor_n
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
- ! gradPVt
+ ! gradVor_t
variableIndex = variableIndex + 1
averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_global_diagnostics.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Modified: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_mpas_core.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_mpas_core.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_mpas_core.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -45,6 +45,7 @@
subroutine mpas_core_init(domain, startTimeStamp)!{{{
use mpas_grid_types
+ use mpas_ocn_tracer_advection
implicit none
@@ -88,6 +89,9 @@
call ocn_tendency_init(err_tmp)
err = ior(err,err_tmp)
+ call mpas_ocn_tracer_advection_init(err_tmp)
+ err = ior(err,err_tmp)
+
call mpas_timer_init(domain)
if(err.eq.1) then
@@ -134,7 +138,10 @@
block => domain % blocklist
do while (associated(block))
- call mpas_init_block(block, block % mesh, dt)
+ call mpas_init_block(block, block % mesh, dt, err)
+ if(err.eq.1) then
+ call mpas_dmpar_abort(dminfo)
+ endif
block % state % time_levs(1) % state % xtime % scalar = startTimeStamp
block => block % next
end do
@@ -213,19 +220,27 @@
end subroutine ocn_simulation_clock_init!}}}
- subroutine mpas_init_block(block, mesh, dt)!{{{
+ subroutine mpas_init_block(block, mesh, dt, err)!{{{
use mpas_grid_types
use mpas_rbf_interpolation
use mpas_vector_reconstruction
+ use mpas_ocn_tracer_advection
+ use ocn_advection
implicit none
type (block_type), intent(inout) :: block
type (mesh_type), intent(inout) :: mesh
real (kind=RKIND), intent(in) :: dt
+ integer, intent(out) :: err
integer :: i, iEdge, iCell, k
+ integer :: err1
+ call ocn_initialize_advection_rk(mesh, err)
+ call mpas_ocn_tracer_advection_coefficients(mesh, err1)
+ err = ior(err, err1)
+
call ocn_time_average_init(block % state % time_levs(1) % state)
call mpas_timer_start("diagnostic solve", .false., initDiagSolveTimer)
@@ -272,29 +287,13 @@
:block % mesh % nVertLevels,iCell) = 0.0
! mrp changed to 0
! :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
-
end do
- if (.not. config_do_restart) then
-
-! mrp 110808 add, so that variables are copied to * variables for split explicit
- do i=2,nTimeLevs
- call mpas_copy_state(block % state % time_levs(i) % state, &
+ do i=2,nTimeLevs
+ call mpas_copy_state(block % state % time_levs(i) % state, &
block % state % time_levs(1) % state)
- end do
-! mrp 110808 add end
+ end do
-
- else
- do i=2,nTimeLevs
- call mpas_copy_state(block % state % time_levs(i) % state, &
- block % state % time_levs(1) % state)
- end do
- endif
-
end subroutine mpas_init_block!}}}
subroutine mpas_core_run(domain, output_obj, output_frame)!{{{
@@ -508,7 +507,8 @@
integer :: iTracer, cell, cell1, cell2
real (kind=RKIND) :: uhSum, hSum, hEdge1
- real (kind=RKIND), dimension(:), pointer :: referenceBottomDepth
+ real (kind=RKIND), dimension(:), pointer :: referenceBottomDepth, referenceBottomDepthTopOfCell
+
real (kind=RKIND), dimension(:,:), pointer :: h
integer :: nVertLevels
@@ -518,6 +518,7 @@
h => block % state % time_levs(1) % state % h % array
referenceBottomDepth => block % mesh % referenceBottomDepth % array
+ referenceBottomDepthTopOfCell => block % mesh % referenceBottomDepthTopOfCell % array
nVertLevels = block % mesh % nVertLevels
! mrp 120208 right now hZLevel is in the grid.nc file.
@@ -530,6 +531,12 @@
referenceBottomDepth(k) = referenceBottomDepth(k-1) + block % mesh % hZLevel % array(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
+
! Compute barotropic velocity at first timestep
! This is only done upon start-up.
if (trim(config_time_integration) == 'unsplit_explicit') then
@@ -724,8 +731,12 @@
if (boundaryEdge(k,iEdge).eq.1) then
boundaryCell(k,cellsOnEdge(1,iEdge)) = 1
boundaryCell(k,cellsOnEdge(2,iEdge)) = 1
- cellMask(k,cellsOnEdge(1,iEdge)) = 0
- cellMask(k,cellsOnEdge(2,iEdge)) = 0
+ if(maxLevelCell(cellsOnEdge(1,iEdge)) > k) then
+ cellMask(k, cellsOnEdge(1,iEdge)) = 0
+ end if
+ if(maxLevelCell(cellsOnEdge(2,iEdge)) > k) then
+ cellMask(k, cellsOnEdge(2,iEdge)) = 0
+ end if
boundaryVertex(k,verticesOnEdge(1,iEdge)) = 1
boundaryVertex(k,verticesOnEdge(2,iEdge)) = 1
vertexMask(k,verticesOnEdge(1,iEdge)) = 0
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_mpas_core.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_restoring.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Modified: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tendency.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tendency.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tendency.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -21,6 +21,8 @@
use mpas_constants
use mpas_timer
+ use mpas_ocn_tracer_advection
+
use ocn_thick_hadv
use ocn_thick_vadv
use ocn_gm
@@ -98,22 +100,12 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_tend_h(tend, s, d, grid)!{{{
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Compute height and normal wind tendencies, as well as diagnostic variables
- !
- ! Input: s - current model state
- ! grid - grid metadata
- !
- ! Output: tend - computed tendencies for prognostic variables
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
+ subroutine ocn_tend_h(tend, s, grid)!{{{
implicit none
- type (tend_type), intent(inout) :: tend
- type (state_type), intent(inout) :: s
- type (diagnostics_type), intent(in) :: d
- type (mesh_type), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend !< Input/Output: Tendency structure
+ type (state_type), intent(in) :: s !< Input: State information
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
real (kind=RKIND), dimension(:,:), pointer :: h_edge, u, wTop, tend_h, uTransport
@@ -139,6 +131,8 @@
! See Ringler et al. (2010) jcp paper, eqn 19, 21, and fig. 3.
! for explanation of divergence operator.
!
+ ! QC Comment (3/15/12): need to make sure that uTranport is the right
+ ! transport velocity here.
call mpas_timer_start("hadv", .false., thickHadvTimer)
call ocn_thick_hadv_tend(grid, uTransport, h_edge, tend_h, err)
call mpas_timer_stop("hadv", thickHadvTimer)
@@ -168,25 +162,16 @@
!-----------------------------------------------------------------------
subroutine ocn_tend_u(tend, s, d, grid)!{{{
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Compute height and normal wind tendencies, as well as diagnostic variables
- !
- ! Input: s - current model state
- ! grid - grid metadata
- !
- ! Output: tend - computed tendencies for prognostic variables
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
implicit none
- type (tend_type), intent(inout) :: tend
- type (state_type), intent(in) :: s
- type (diagnostics_type), intent(in) :: d
- type (mesh_type), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend !< Input/Output: Tendency structure
+ type (state_type), intent(in) :: s !< Input: State information
+ type (diagnostics_type), intent(in) :: d !< Input: Diagnostic information
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
real (kind=RKIND), dimension(:,:), pointer :: &
h_edge, h, u, rho, zMid, pressure, &
- tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
+ tend_u, circulation, vorticity, ke, ke_edge, Vor_edge, &
MontPot, wTop, divergence, vertViscTopOfEdge
real (kind=RKIND), dimension(:,:), pointer :: u_src
@@ -204,7 +189,7 @@
divergence => s % divergence % array
ke => s % ke % array
ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
+ Vor_edge => s % Vor_edge % array
MontPot => s % MontPot % array
pressure => s % pressure % array
vertViscTopOfEdge => d % vertViscTopOfEdge % array
@@ -224,7 +209,7 @@
!
call mpas_timer_start("coriolis", .false., velCorTimer)
- call ocn_vel_coriolis_tend(grid, pv_edge, h_edge, u, ke, tend_u, err)
+ call ocn_vel_coriolis_tend(grid, Vor_edge, h_edge, u, ke, tend_u, err)
call mpas_timer_stop("coriolis", velCorTimer)
!
@@ -288,31 +273,21 @@
!> This routine computes the scalar (tracer) tendency for the ocean
!
!-----------------------------------------------------------------------
-
- subroutine ocn_tend_scalar(tend, s, d, grid)!{{{
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !
- ! Input: s - current model state
- ! grid - grid metadata
- ! note: the variable s % tracers really contains the tracers,
- ! not tracers*h
- !
- ! Output: tend - computed scalar tendencies
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
+ subroutine ocn_tend_scalar(tend, s, d, grid, dt)!{{{
implicit none
- type (tend_type), intent(inout) :: tend
- type (state_type), intent(in) :: s
- type (diagnostics_type), intent(in) :: d
- type (mesh_type), intent(in) :: grid
+ type (tend_type), intent(inout) :: tend !< Input/Output: Tendency structure
+ type (state_type), intent(in) :: s !< Input: State information
+ type (diagnostics_type), intent(in) :: d !< Input: Diagnostic information
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
+ real (kind=RKIND), intent(in) :: dt !< Input: Time step
real (kind=RKIND), dimension(:,:), pointer :: &
- u, uTransport, h,wTop, h_edge, vertDiffTopOfCell
+ u, uTransport, h,wTop, h_edge, vertDiffTopOfCell, tend_h, uh
real (kind=RKIND), dimension(:,:,:), pointer :: &
tracers, tend_tr
- integer :: err
+ integer :: err, iEdge, k
call mpas_timer_start("ocn_tend_scalar")
@@ -325,8 +300,19 @@
vertDiffTopOfCell => d % vertDiffTopOfCell % array
tend_tr => tend % tracers % array
+ tend_h => tend % h % array
+ allocate(uh(grid % nVertLevels, grid % nEdges+1))
!
+ ! QC Comment (3/15/12): need to make sure that uTransport is the right
+ ! transport velocity for the tracer.
+ do iEdge = 1, grid % nEdges
+ do k = 1, grid % nVertLevels
+ uh(k, iEdge) = uTransport(k, iEdge) * h_edge(k, iEdge)
+ end do
+ end do
+
+ !
! initialize tracer tendency (RHS of tracer equation) to zero.
!
tend_tr(:,:,:) = 0.0
@@ -339,20 +325,13 @@
! and then change maxLevelEdgeTop to maxLevelEdgeBot in the following section.
! tracer_edge at the boundary will also need to be defined for flux boundaries.
- call mpas_timer_start("hadv", .false., tracerHadvTimer)
- call ocn_tracer_hadv_tend(grid, uTransport, h_edge, tracers, tend_tr, err)
- call mpas_timer_stop("hadv", tracerHadvTimer)
+ ! Monotonoic Advection, or standard advection
+ call mpas_timer_start("adv", .false., tracerHadvTimer)
+ call mpas_ocn_tracer_advection_tend(tracers, uh, wTop, h, h, dt, grid, tend_h, tend_tr)
+ call mpas_timer_stop("adv", tracerHadvTimer)
!
- ! tracer tendency: vertical advection term -d/dz( h \phi w)
- !
-
- call mpas_timer_start("vadv", .false., tracerVadvTimer)
- call ocn_tracer_vadv_tend(grid, h, wtop, tracers, tend_tr, err)
- call mpas_timer_stop("vadv", tracerVadvTimer)
-
- !
! tracer tendency: del2 horizontal tracer diffusion, div(h \kappa_2 </font>
<font color="gray">abla \phi)
!
call mpas_timer_start("hmix", .false., tracerHmixTimer)
@@ -394,6 +373,8 @@
10 format(2i8,10e20.10)
call mpas_timer_stop("ocn_tend_scalar")
+ deallocate(uh)
+
end subroutine ocn_tend_scalar!}}}
!***********************************************************************
@@ -410,19 +391,11 @@
!-----------------------------------------------------------------------
subroutine ocn_diagnostic_solve(dt, s, grid)!{{{
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Compute diagnostic fields used in the tendency computations
- !
- ! Input: grid - grid metadata
- !
- ! Output: s - computed diagnostics
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
implicit none
- real (kind=RKIND), intent(in) :: dt
- type (state_type), intent(inout) :: s
- type (mesh_type), intent(in) :: grid
+ real (kind=RKIND), intent(in) :: dt !< Input: Time step
+ type (state_type), intent(inout) :: s !< Input/Output: State information
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
@@ -444,7 +417,7 @@
real (kind=RKIND), dimension(:,:), pointer :: &
weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure,&
circulation, vorticity, ke, ke_edge, MontPot, wTop, zMid, &
- pv_edge, pv_vertex, pv_cell, gradPVn, gradPVt, divergence, &
+ Vor_edge, Vor_vertex, Vor_cell, gradVor_n, gradVor_t, divergence, &
rho, temperature, salinity, kev, kevc, uBolusGM, uTransport
real (kind=RKIND), dimension(:,:,:), pointer :: tracers, deriv_two
real (kind=RKIND), dimension(:,:), allocatable:: div_u
@@ -463,11 +436,11 @@
kev => s % kev % array
kevc => s % kevc % array
ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
- pv_vertex => s % pv_vertex % array
- pv_cell => s % pv_cell % array
- gradPVn => s % gradPVn % array
- gradPVt => s % gradPVt % array
+ Vor_edge => s % Vor_edge % array
+ Vor_vertex => s % Vor_vertex % array
+ Vor_cell => s % Vor_cell % array
+ gradVor_n => s % gradVor_n % array
+ gradVor_t => s % gradVor_t % array
rho => s % rho % array
MontPot => s % MontPot % array
pressure => s % pressure % array
@@ -515,6 +488,7 @@
! initialize h_edge to avoid divide by zero and NaN problems.
h_edge = -1.0e34
+ coef_3rd_order = config_coef_3rd_order
do iEdge=1,nEdges*hadv2nd
cell1 = cellsOnEdge(1,iEdge)
@@ -615,8 +589,9 @@
invAreaTri1 = 1.0 / areaTriangle(vertex1)
invAreaTri2 = 1.0 / areaTriangle(vertex2)
- invAreaCell1 = 1.0 / areaCell(cell1)
- invAreaCell2 = 1.0 / areaCell(cell2)
+ !dwj: 02/23/12 arraCell(nCells+1) is still 0, this is a temporary fix
+ invAreaCell1 = 1.0 / max(areaCell(cell1), 1.0)
+ invAreaCell2 = 1.0 / max(areaCell(cell2), 1.0)
do k=1,maxLevelEdgeBot(iEdge)
! Compute circulation and relative vorticity at each vertex
@@ -669,7 +644,8 @@
do iVertex = 1, nVertices*ke_vertex_flag
do i=1,grid % vertexDegree
iCell = cellsOnVertex(i,iVertex)
- invAreaCell1 = 1.0 / areaCell(iCell)
+ !dwj: 02/23/12 arraCell(nCells+1) is still 0, this is a temporary fix
+ invAreaCell1 = 1.0 / max(areaCell(iCell), 1.0)
do k=1,nVertLevels
kevc(k,iCell) = kevc(k,iCell) + kiteAreasOnVertex(i, iVertex) * kev(k, iVertex) * invAreaCell1
enddo
@@ -700,7 +676,7 @@
!
! Compute height at vertices, pv at vertices, and average pv to edge locations
- ! ( this computes pv_vertex at all vertices bounding real cells and distance-1 ghost cells )
+ ! ( this computes Vor_vertex at all vertices bounding real cells and distance-1 ghost cells )
!
do iVertex = 1,nVertices
invAreaTri1 = 1.0 / areaTriangle(iVertex)
@@ -711,35 +687,36 @@
end do
h_vertex = h_vertex * invAreaTri1
- pv_vertex(k,iVertex) = (fCoef*fVertex(iVertex) + vorticity(k,iVertex)) / h_vertex
+ Vor_vertex(k,iVertex) = (fCoef*fVertex(iVertex) + vorticity(k,iVertex)) / h_vertex
end do
end do
- pv_cell(:,:) = 0.0
- pv_edge(:,:) = 0.0
+ Vor_cell(:,:) = 0.0
+ Vor_edge(:,:) = 0.0
do iVertex = 1,nVertices
do i=1,vertexDegree
iCell = cellsOnVertex(i,iVertex)
iEdge = edgesOnVertex(i,iVertex)
- invAreaCell1 = 1.0 / areaCell(iCell)
+ !dwj: 02/23/12 arraCell(nCells+1) is still 0, this is a temporary fix
+ invAreaCell1 = 1.0 / max(areaCell(iCell), 1.0)
! Compute pv at cell centers
- ! ( this computes pv_cell for all real cells and distance-1 ghost cells )
+ ! ( this computes Vor_cell for all real cells and distance-1 ghost cells )
do k = 1,maxLevelCell(iCell)
- pv_cell(k,iCell) = pv_cell(k,iCell) + kiteAreasOnVertex(i, iVertex) * pv_vertex(k, iVertex) * invAreaCell1
+ Vor_cell(k,iCell) = Vor_cell(k,iCell) + kiteAreasOnVertex(i, iVertex) * Vor_vertex(k, iVertex) * invAreaCell1
enddo
! Compute pv at the edges
- ! ( this computes pv_edge at all edges bounding real cells )
+ ! ( this computes Vor_edge at all edges bounding real cells )
do k=1,maxLevelEdgeBot(iEdge)
- pv_edge(k,iEdge) = pv_edge(k,iEdge) + 0.5 * pv_vertex(k,iVertex)
+ Vor_edge(k,iEdge) = Vor_edge(k,iEdge) + 0.5 * Vor_vertex(k,iVertex)
enddo
enddo
enddo
-! gradPVn(:,:) = 0.0
-! gradPVt(:,:) = 0.0
+! gradVor_n(:,:) = 0.0
+! gradVor_t(:,:) = 0.0
do iEdge = 1,nEdges
cell1 = cellsOnEdge(1, iEdge)
cell2 = cellsOnEdge(2, iEdge)
@@ -748,16 +725,16 @@
invLength = 1.0 / dcEdge(iEdge)
! Compute gradient of PV in normal direction
- ! ( this computes gradPVn for all edges bounding real cells )
+ ! ( this computes gradVor_n for all edges bounding real cells )
do k=1,maxLevelEdgeTop(iEdge)
- gradPVn(k,iEdge) = (pv_cell(k,cell2) - pv_cell(k,cell1)) * invLength
+ gradVor_n(k,iEdge) = (Vor_cell(k,cell2) - Vor_cell(k,cell1)) * invLength
enddo
invLength = 1.0 / dvEdge(iEdge)
! Compute gradient of PV in the tangent direction
- ! ( this computes gradPVt at all edges bounding real cells and distance-1 ghost cells )
+ ! ( this computes gradVor_t at all edges bounding real cells and distance-1 ghost cells )
do k = 1,maxLevelEdgeBot(iEdge)
- gradPVt(k,iEdge) = (pv_vertex(k,vertex2) - pv_vertex(k,vertex1)) * invLength
+ gradVor_t(k,iEdge) = (Vor_vertex(k,vertex2) - Vor_vertex(k,vertex1)) * invLength
enddo
enddo
@@ -767,9 +744,9 @@
!
do iEdge = 1,nEdges
do k = 1,maxLevelEdgeBot(iEdge)
- pv_edge(k,iEdge) = pv_edge(k,iEdge) &
- - config_apvm_upwinding * dt* ( u(k,iEdge) * gradPVn(k,iEdge) &
- + v(k,iEdge) * gradPVt(k,iEdge) )
+ Vor_edge(k,iEdge) = Vor_edge(k,iEdge) &
+ - config_apvm_scale_factor * dt* ( u(k,iEdge) * gradVor_n(k,iEdge) &
+ + v(k,iEdge) * gradVor_t(k,iEdge) )
enddo
enddo
@@ -888,23 +865,13 @@
!> This routine computes the vertical velocity in the top layer for the ocean
!
!-----------------------------------------------------------------------
-
subroutine ocn_wtop(s1,s2, grid)!{{{
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Compute diagnostic fields used in the tendency computations
- !
- ! Input: grid - grid metadata
- !
- ! Output: s - computed diagnostics
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
implicit none
- type (state_type), intent(inout) :: s1
- type (state_type), intent(inout) :: s2
- type (mesh_type), intent(in) :: grid
+ type (state_type), intent(inout) :: s1 !< Input/Output: State 1 information
+ type (state_type), intent(inout) :: s2 !< Input/Output: State 2 information
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
- ! 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, hSum
@@ -1078,19 +1045,10 @@
!-----------------------------------------------------------------------
subroutine ocn_fuperp(s, grid)!{{{
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Put f*uBcl^{perp} in u as a work variable
- !
- ! Input: s - current model state
- ! grid - grid metadata
- !
- ! Output: tend - computed tendencies for prognostic variables
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
implicit none
- type (state_type), intent(inout) :: s
- type (mesh_type), intent(in) :: grid
+ type (state_type), intent(inout) :: s !< Input/Output: State information
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
! 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.
@@ -1154,9 +1112,8 @@
!> other tendency routines.
!
!-----------------------------------------------------------------------
-
subroutine ocn_tendency_init(err)!{{{
- integer, intent(out) :: err
+ integer, intent(out) :: err !< Output: Error flag
err = 0
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tendency.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_thick_hadv.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_thick_vadv.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_time_integration.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Modified: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_time_integration_rk4.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_time_integration_rk4.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_time_integration_rk4.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -144,7 +144,7 @@
call mpas_timer_start("RK4-diagnostic halo update")
block => domain % blocklist
do while (associated(block))
- call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, provis % pv_edge % array(:,:), &
+ call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, provis % Vor_edge % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
@@ -173,7 +173,7 @@
if (.not.config_implicit_vertical_mix) then
call ocn_vmix_coefs(block % mesh, provis, block % diagnostics, err)
end if
- call ocn_tend_h(block % tend, provis, block % diagnostics, block % mesh)
+ call ocn_tend_h(block % tend, provis, block % mesh)
call ocn_tend_u(block % tend, provis, block % diagnostics, block % mesh)
! mrp 110718 filter btr mode out of u_tend
@@ -182,7 +182,7 @@
call filter_btr_mode_tend_u(block % tend, provis, block % diagnostics, block % mesh)
endif
- call ocn_tend_scalar(block % tend, provis, block % diagnostics, block % mesh)
+ call ocn_tend_scalar(block % tend, provis, block % diagnostics, block % mesh, dt)
block => block % next
end do
call mpas_timer_stop("RK4-tendency computations")
@@ -231,6 +231,14 @@
provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
end if
+ if (config_prescribe_velocity) then
+ provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+ end if
+
+ if (config_prescribe_thickness) then
+ provis % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:)
+ end if
+
call ocn_diagnostic_solve(dt, provis, block % mesh)
block => block % next
@@ -325,6 +333,14 @@
block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
end if
+ if (config_prescribe_velocity) then
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+ end if
+
+ if (config_prescribe_thickness) then
+ block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(1) % state % h % 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, &
@@ -374,7 +390,7 @@
meshScalingDel2, meshScalingDel4
real (kind=RKIND), dimension(:,:), pointer :: &
weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
- tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
+ tend_u, circulation, vorticity, ke, ke_edge, Vor_edge, &
MontPot, wTop, divergence, vertViscTopOfEdge
type (dm_info) :: dminfo
@@ -406,7 +422,7 @@
divergence => s % divergence % array
ke => s % ke % array
ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
+ Vor_edge => s % Vor_edge % array
MontPot => s % MontPot % array
pressure => s % pressure % array
vertViscTopOfEdge => d % vertViscTopOfEdge % array
@@ -489,7 +505,7 @@
meshScalingDel2, meshScalingDel4
real (kind=RKIND), dimension(:,:), pointer :: &
weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
- tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
+ tend_u, circulation, vorticity, ke, ke_edge, Vor_edge, &
MontPot, wTop, divergence, vertViscTopOfEdge
type (dm_info) :: dminfo
@@ -521,7 +537,7 @@
divergence => s % divergence % array
ke => s % ke % array
ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
+ Vor_edge => s % Vor_edge % array
MontPot => s % MontPot % array
pressure => s % pressure % array
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_time_integration_rk4.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Modified: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_time_integration_split.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_time_integration_split.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_time_integration_split.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -167,7 +167,7 @@
do while (associated(block))
call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, &
- block % state % time_levs(2) % state % pv_edge % array(:,:), &
+ block % state % time_levs(2) % state % Vor_edge % array(:,:), &
block % mesh % nVertLevels, block % mesh % nEdges, &
block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
@@ -200,7 +200,7 @@
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)
+ call ocn_tend_u(block % tend, block % state % time_levs(2) % state, block % diagnostics, block % mesh)
block => block % next
end do
@@ -432,7 +432,7 @@
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 % referenceBottomDepth % array (block % mesh % maxLevelEdgeTop % array(iEdge))
+ 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)) &
@@ -546,7 +546,7 @@
+ config_btr_gam2_SSHWt1 *block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell2)
sshEdge = 0.5 * (sshCell1 + sshCell2)
- hSum = sshEdge + block % mesh % referenceBottomDepth % array (block % mesh % maxLevelEdgeTop % array(iEdge))
+ hSum = sshEdge + block % mesh % referenceBottomDepthTopOfCell % array (block % mesh % maxLevelEdgeTop % array(iEdge)+1)
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)) &
@@ -716,13 +716,12 @@
!TDR: at this point, I am suggesting just pushing some of this code into subroutines.
!TDR: see comments farther down
+ ! dwj: 02/22/12 splitting thickness and tracer tendency computations and halo updates to allow monotonic advection.
block => domain % blocklist
do while (associated(block))
call ocn_wtop(block % state % time_levs(1) % state,block % state % time_levs(2) % state, block % mesh)
- 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)
-
+ call ocn_tend_h(block % tend, block % state % time_levs(2) % state, block % mesh)
block => block % next
end do
@@ -733,13 +732,27 @@
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)
+ block => domain % blocklist
+ do while (associated(block))
+ call ocn_tend_scalar(block % tend, block % state % time_levs(2) % state, block % diagnostics, block % mesh, dt)
+
+ block => block % next
+ end do
+
+ ! update halo for thickness and tracer tendencies
+ 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 % tend % 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 h", timer_halo_h)
+ call mpas_timer_stop("se halo tracers", timer_halo_tracers)
block => domain % blocklist
do while (associated(block))
@@ -849,6 +862,8 @@
block => block % next
end do
+
+
end do ! split_explicit_step = 1, config_n_ts_iter
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! END large iteration loop
@@ -888,6 +903,15 @@
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
+
+ if (config_prescribe_velocity) then
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+ end if
+
+ if (config_prescribe_thickness) then
+ block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(1) % state % h % 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, &
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_time_integration_split.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Copied: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection.F (from rev 1646, trunk/mpas/src/core_ocean/mpas_ocn_tracer_advection.F)
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection.F (rev 0)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -0,0 +1,316 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_advection
+!
+!> \brief MPAS ocean tracer advection driver
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This module contains driver routine for tracer advection tendencys
+!> as well as the routines for setting up advection coefficients and
+!> initialization of the advection routines.
+!
+!-----------------------------------------------------------------------
+
+module mpas_ocn_tracer_advection
+
+ use mpas_kind_types
+ use mpas_grid_types
+ use mpas_configure
+
+ use mpas_ocn_tracer_advection_std
+ use mpas_ocn_tracer_advection_mono
+
+ implicit none
+ private
+ save
+
+ public :: mpas_ocn_tracer_advection_init, &
+ mpas_ocn_tracer_advection_coefficients, &
+ mpas_ocn_tracer_advection_tend
+
+ logical :: monotonicOn
+
+ contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_coefficients
+!
+!> \brief MPAS ocean tracer advection coefficients
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine precomputes the advection coefficients for horizontal
+!> advection of tracers.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_coefficients( grid, err )!{{{
+
+ implicit none
+ type (mesh_type) :: grid !< Input: Grid information
+ integer, intent(out) :: err
+
+ real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
+ real (kind=RKIND), dimension(:,:), pointer :: adv_coefs, adv_coefs_2nd, adv_coefs_3rd
+ integer, dimension(:,:), pointer :: cellsOnCell, cellsOnEdge, advCellsForEdge, highOrderAdvectionMask, lowOrderAdvectionMask, boundaryCell
+ integer, dimension(:), pointer :: nEdgesOnCell, nAdvCellsForEdge, maxLevelCell
+
+ integer, dimension(:), pointer :: cell_list, ordered_cell_list
+ integer :: cell1, cell2, iEdge, n, i, j, j_in, iCell, k, nVertLevels
+ logical :: addcell, highOrderAdvection
+
+ deriv_two => grid % deriv_two % array
+ adv_coefs => grid % adv_coefs % array
+ adv_coefs_2nd => grid % adv_coefs_2nd % array
+ adv_coefs_3rd => grid % adv_coefs_3rd % array
+ cellsOnCell => grid % cellsOnCell % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ advCellsForEdge => grid % advCellsForEdge % array
+ boundaryCell => grid % boundaryCell % array
+ highOrderAdvectionMask => grid % highOrderAdvectionMask % array
+ lowOrderAdvectionMask => grid % lowOrderAdvectionMask % array
+ nEdgesOnCell => grid % nEdgesOnCell % array
+ maxLevelCell => grid % maxLevelCell % array
+ nAdvCellsForEdge => grid % nAdvCellsForEdge % array
+
+ nVertLevels = grid % nVertLevels
+
+ allocate(cell_list(grid % maxEdges2 + 2))
+ allocate(ordered_cell_list(grid % maxEdges2 + 2))
+
+ err = 0
+
+ highOrderAdvectionMask = 0
+ lowOrderAdvectionMask = 0
+ if(config_horiz_tracer_adv_order == 2) then
+
+ end if
+
+ do iEdge = 1, grid % nEdges
+ nAdvCellsForEdge(iEdge) = 0
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+
+
+ do k = 1, nVertLevels
+ if (boundaryCell(k, cell1) == 1 .or. boundaryCell(k, cell2) == 1) then
+ highOrderAdvectionMask(k, iEdge) = 0
+ lowOrderAdvectionMask(k, iEdge) = 1
+ else
+ highOrderAdvectionMask(k, iEdge) = 1
+ lowOrderAdvectionMask(k, iEdge) = 0
+ end if
+ end do
+
+ !
+ ! do only if this edge flux is needed to update owned cells
+ !
+ if (cell1 <= grid%nCells .or. cell2 <= grid%nCells) then
+
+ cell_list(1) = cell1
+ cell_list(2) = cell2
+ n = 2
+
+ ! add cells surrounding cell 1. n is number of cells currently in list
+ do i = 1, nEdgesOnCell(cell1)
+ if(cellsOnCell(i,cell1) /= cell2) then
+ n = n + 1
+ cell_list(n) = cellsOnCell(i,cell1)
+ end if
+ end do
+
+ ! add cells surrounding cell 2 (brute force approach)
+ do iCell = 1, nEdgesOnCell(cell2)
+ addcell = .true.
+ do i=1,n
+ if(cell_list(i) == cellsOnCell(iCell,cell2)) addcell = .false.
+ end do
+ if(addcell) then
+ n = n+1
+ cell_list(n) = cellsOnCell(iCell,cell2)
+ end if
+ end do
+
+ ! order the list by increasing cell number (brute force approach)
+
+ do i=1,n
+ ordered_cell_list(i) = grid % nCells + 2
+ j_in = 1
+ do j=1,n
+ if(ordered_cell_list(i) > cell_list(j) ) then
+ j_in = j
+ ordered_cell_list(i) = cell_list(j)
+ end if
+ end do
+! ordered_cell_list(i) = cell_list(j_in)
+ cell_list(j_in) = grid % nCells + 3
+ end do
+
+ nAdvCellsForEdge(iEdge) = n
+ do iCell = 1, nAdvCellsForEdge(iEdge)
+ advCellsForEdge(iCell,iEdge) = ordered_cell_list(iCell)
+ end do
+
+ ! we have the ordered list, now construct coefficients
+
+ adv_coefs(:,iEdge) = 0.
+ adv_coefs_2nd(:,iEdge) = 0.
+ adv_coefs_3rd(:,iEdge) = 0.
+
+ ! pull together third and fourth order contributions to the flux
+ ! first from cell1
+
+ j_in = 0
+ do j=1, n
+ if( ordered_cell_list(j) == cell1 ) j_in = j
+ end do
+ adv_coefs (j_in,iEdge) = adv_coefs (j_in,iEdge) + deriv_two(1,1,iEdge)
+ adv_coefs_3rd(j_in,iEdge) = adv_coefs_3rd(j_in,iEdge) + deriv_two(1,1,iEdge)
+
+ do iCell = 1, nEdgesOnCell(cell1)
+ j_in = 0
+ do j=1, n
+ if( ordered_cell_list(j) == cellsOnCell(iCell,cell1) ) j_in = j
+ end do
+ adv_coefs (j_in,iEdge) = adv_coefs (j_in,iEdge) + deriv_two(iCell+1,1,iEdge)
+ adv_coefs_3rd(j_in,iEdge) = adv_coefs_3rd(j_in,iEdge) + deriv_two(iCell+1,1,iEdge)
+ end do
+
+ ! pull together third and fourth order contributions to the flux
+ ! now from cell2
+
+ j_in = 0
+ do j=1, n
+ if( ordered_cell_list(j) == cell2 ) j_in = j
+ enddo
+ adv_coefs (j_in,iEdge) = adv_coefs (j_in,iEdge) + deriv_two(1,2,iEdge)
+ adv_coefs_3rd(j_in,iEdge) = adv_coefs_3rd(j_in,iEdge) - deriv_two(1,2,iEdge)
+
+ do iCell = 1, nEdgesOnCell(cell2)
+ j_in = 0
+ do j=1, n
+ if( ordered_cell_list(j) == cellsOnCell(iCell,cell2) ) j_in = j
+ enddo
+ adv_coefs (j_in,iEdge) = adv_coefs (j_in,iEdge) + deriv_two(iCell+1,2,iEdge)
+ adv_coefs_3rd(j_in,iEdge) = adv_coefs_3rd(j_in,iEdge) - deriv_two(iCell+1,2,iEdge)
+ end do
+
+ do j = 1,n
+ adv_coefs (j,iEdge) = - (grid % dcEdge % array (iEdge) **2) * adv_coefs (j,iEdge) / 12.
+ adv_coefs_3rd(j,iEdge) = - (grid % dcEdge % array (iEdge) **2) * adv_coefs_3rd(j,iEdge) / 12.
+ end do
+
+ ! 2nd order centered contribution - place this in the main flux weights
+
+ j_in = 0
+ do j=1, n
+ if( ordered_cell_list(j) == cell1 ) j_in = j
+ enddo
+ adv_coefs(j_in,iEdge) = adv_coefs(j_in,iEdge) + 0.5
+ adv_coefs_2nd(j_in,iEdge) = adv_coefs_2nd(j_in,iEdge) + 0.5
+
+ j_in = 0
+ do j=1, n
+ if( ordered_cell_list(j) == cell2 ) j_in = j
+ enddo
+ adv_coefs(j_in,iEdge) = adv_coefs(j_in,iEdge) + 0.5
+ adv_coefs_2nd(j_in,iEdge) = adv_coefs_2nd(j_in,iEdge) + 0.5
+
+ ! multiply by edge length - thus the flux is just dt*ru times the results of the vector-vector multiply
+
+ do j=1,n
+ adv_coefs (j,iEdge) = grid % dvEdge % array(iEdge) * adv_coefs (j,iEdge)
+ adv_coefs_2nd(j,iEdge) = grid % dvEdge % array(iEdge) * adv_coefs_2nd(j,iEdge)
+ adv_coefs_3rd(j,iEdge) = grid % dvEdge % array(iEdge) * adv_coefs_3rd(j,iEdge)
+ end do
+
+ end if ! only do for edges of owned-cells
+
+ end do ! end loop over edges
+
+ deallocate(cell_list)
+ deallocate(ordered_cell_list)
+
+ ! If 2nd order advection, set masks appropriately.
+ if(config_horiz_tracer_adv_order == 2) then
+ lowOrderAdvectionMask = 1
+ highOrderAdvectionMask = 0
+ end if
+
+ if (maxval(highOrderAdvectionMask+lowOrderAdvectionMask) > 1) then
+ write(*,*) "Masks don't sum to 1."
+ err = 1
+ endif
+
+ end subroutine mpas_ocn_tracer_advection_coefficients!}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_tend
+!
+!> \brief MPAS ocean tracer advection tendency
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine is the driver routine for computing the tendency for
+!> advection of tracers.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_tend(tracers, uh, w, h, verticalCellSize, dt, grid, tend_h, tend)!{{{
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: tracer tendency
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input/Output: tracer values
+ real (kind=RKIND), dimension(:,:), intent(in) :: uh !< Input: Thickness weighted horizontal velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: w !< Input: Vertical velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: h !< Input: Thickness field
+ real (kind=RKIND), dimension(:,:), intent(in) :: verticalCellSize !< Input: Distance between vertical interfaces of a cell
+ real (kind=RKIND), intent(in) :: dt !< Input: Time step
+ type (mesh_type), intent(in) :: grid !< Input: grid information
+ real (kind=RKIND), dimension(:,:), intent(in) :: tend_h !< Input: Thickness tendency information
+
+ if(monotonicOn) then
+ call mpas_ocn_tracer_advection_mono_tend(tracers, uh, w, h, verticalCellSize, dt, grid, tend_h, tend)
+ else
+ call mpas_ocn_tracer_advection_std_tend(tracers, uh, w, verticalCellSize, grid, tend)
+ endif
+ end subroutine mpas_ocn_tracer_advection_tend!}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_init
+!
+!> \brief MPAS ocean tracer advection tendency
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine is the driver routine for initialization of
+!> the tracer advection routines.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_init(err)!{{{
+
+ integer, intent(inout) :: err !< Input/Output: Error flag
+
+ integer :: err_tmp
+
+ err = 0
+
+ call mpas_ocn_tracer_advection_std_init(err_tmp)
+ call mpas_ocn_tracer_advection_mono_init(err_tmp)
+
+ err = ior(err, err_tmp)
+
+ monotonicOn = .false.
+
+ if(config_monotonic) then
+ monotonicOn = .true.
+ endif
+
+ end subroutine mpas_ocn_tracer_advection_init!}}}
+
+end module mpas_ocn_tracer_advection
Copied: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_helpers.F (from rev 1646, trunk/mpas/src/core_ocean/mpas_ocn_tracer_advection_helpers.F)
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_helpers.F (rev 0)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_helpers.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -0,0 +1,68 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_advection_helpers
+!
+!> \brief MPAS ocean tracer advection helper functions
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This module contains helper functions tracer advection.
+!
+!-----------------------------------------------------------------------
+module mpas_ocn_tracer_advection_helpers
+
+ use mpas_kind_types
+
+ implicit none
+ save
+
+ contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! function mpas_ocn_tracer_advection_vflux4
+!
+!> \brief MPAS ocean 4th order vertical tracer advection stencil
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This function provides the stencil for 4th order vertical advection of tracers.
+!
+!-----------------------------------------------------------------------
+ real function mpas_ocn_tracer_advection_vflux4(q_im2, q_im1, q_i, q_ip1, w)!{{{
+ real (kind=RKIND), intent(in) :: q_im2 !< Input: Tracer value at index i-2
+ real (kind=RKIND), intent(in) :: q_im1 !< Input: Tracer value at index i-1
+ real (kind=RKIND), intent(in) :: q_i !< Input: Tracer value at index i
+ real (kind=RKIND), intent(in) :: q_ip1 !< Input: Tracer value at index i+1
+ real (kind=RKIND), intent(in) :: w !< Input: vertical veloicity
+ mpas_ocn_tracer_advection_vflux4 = w*( 7.*(q_i + q_im1) - (q_ip1 + q_im2) )/12.0
+ end function!}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! function mpas_ocn_tracer_advection_vflux3
+!
+!> \brief MPAS ocean 3rd order vertical tracer advection stencil
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This function provides the stencil for 3rd order vertical advection of tracers.
+!
+!-----------------------------------------------------------------------
+ real function mpas_ocn_tracer_advection_vflux3( q_im2, q_im1, q_i, q_ip1, w, coef)!{{{
+ real (kind=RKIND), intent(in) :: q_im2 !< Input: Tracer value at index i-2
+ real (kind=RKIND), intent(in) :: q_im1 !< Input: Tracer value at index i-1
+ real (kind=RKIND), intent(in) :: q_i !< Input: Tracer value at index i
+ real (kind=RKIND), intent(in) :: q_ip1 !< Input: Tracer value at index i+1
+ real (kind=RKIND), intent(in) :: w !< Input: vertical veloicity
+ real (kind=RKIND), intent(in) :: coef !< Input: Advection coefficient
+
+ !dwj 02/21/12 flux3 is different in ocean and atmosphere
+ !flux3 = (u * (7.0 * (q_i + q_im1) - (q_ip1 + q_im2)) + coef * abs(u) * ((q_ip1 - q_im2) - 3.0*(q_i-q_im1)))/12.0
+ mpas_ocn_tracer_advection_vflux3 = (w * (7.0 * (q_i + q_im1) - (q_ip1 + q_im2)) - coef * abs(w) * ((q_ip1 - q_im2) - 3.0*(q_i-q_im1)))/12.0
+ end function!}}}
+
+end module mpas_ocn_tracer_advection_helpers
Copied: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_mono.F (from rev 1646, trunk/mpas/src/core_ocean/mpas_ocn_tracer_advection_mono.F)
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_mono.F (rev 0)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_mono.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -0,0 +1,382 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_advection_mono
+!
+!> \brief MPAS ocean monotonic tracer advection with FCT
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This module contains routines for monotonic advection of tracers using a FCT
+!
+!-----------------------------------------------------------------------
+module mpas_ocn_tracer_advection_mono
+
+ use mpas_kind_types
+ use mpas_grid_types
+ use mpas_configure
+ use mpas_dmpar
+
+ use mpas_ocn_tracer_advection_helpers
+
+ implicit none
+ private
+ save
+
+ real (kind=RKIND) :: coef_3rd_order
+
+ public :: mpas_ocn_tracer_advection_mono_tend, &
+ mpas_ocn_tracer_advection_mono_init
+
+ contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_mono_tend
+!
+!> \brief MPAS ocean monotonic tracer advection tendency with FCT
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine computes the monotonic tracer advection tendencity using a FCT.
+!> Both horizontal and vertical.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_mono_tend(tracers, uh, w, h, verticalCellSize, dt, grid, tend_h, tend)!{{{
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! Input: s - current model state
+ ! grid - grid metadata
+ !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: current tracer values
+ real (kind=RKIND), dimension(:,:), intent(in) :: uh !< Input: Thichness weighted velocitiy
+ real (kind=RKIND), dimension(:,:), intent(in) :: w !< Input: Vertical velocitiy
+ real (kind=RKIND), dimension(:,:), intent(in) :: h !< Input: Thickness
+ real (kind=RKIND), dimension(:,:), intent(in) :: verticalCellSize !< Input: Distance between vertical interfaces of a cell
+ real (kind=RKIND), dimension(:,:), intent(in) :: tend_h !< Input: Tendency for thickness field
+ real (kind=RKIND), intent(in) :: dt !< Input: Timestep
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: Tracer tendency
+
+ integer :: i, iCell, iEdge, k, iTracer, cell1, cell2
+ integer :: nVertLevels, num_tracers, nCells, nEdges, nCellsSolve
+ integer, dimension(:), pointer :: nAdvCellsForEdge, maxLevelCell, maxLevelEdgeTop, nEdgesOnCell
+ integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnCell, advCellsForEdge, highOrderAdvectionMask, lowOrderAdvectionMask
+
+ real (kind=RKIND) :: flux_upwind, tracer_min_new, tracer_max_new, tracer_upwind_new, scale_factor
+ real (kind=RKIND) :: flux, tracer_weight, invDvEdge, invAreaCell1, invAreaCell2
+ real (kind=RKIND) :: cur_max, cur_min, new_max, new_min
+ real (kind=RKIND) :: verticalWeightK, verticalWeightKm1
+ real (kind=RKIND), dimension(:), pointer :: dvEdge, areaCell
+ real (kind=RKIND), dimension(:,:), pointer :: adv_coefs, adv_coefs_2nd, adv_coefs_3rd
+ real (kind=RKIND), dimension(:,:), pointer :: tracer_cur, tracer_new, upwind_tendency, inv_h_new, tracer_max, tracer_min
+ real (kind=RKIND), dimension(:,:), pointer :: flux_incoming, flux_outgoing, high_order_horiz_flux, high_order_vert_flux
+
+ real (kind=RKIND), parameter :: eps = 1.e-10
+
+ ! Initialize pointers
+ dvEdge => grid % dvEdge % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ cellsOnCell => grid % cellsOnCell % array
+ areaCell => grid % areaCell % array
+
+ nEdgesOnCell => grid % nEdgesOnCell % array
+ nAdvCellsForEdge => grid % nAdvCellsForEdge % array
+ advCellsForEdge => grid % advCellsForEdge % array
+ adv_coefs => grid % adv_coefs % array
+ adv_coefs_2nd => grid % adv_coefs_2nd % array
+ adv_coefs_3rd => grid % adv_coefs_3rd % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ highOrderAdvectionMask => grid % highOrderAdvectionMask % array
+ lowOrderAdvectionMask => grid % lowOrderAdvectionMask % array
+
+ nCells = grid % nCells
+ nCellsSolve = grid % nCellsSolve
+ nEdges = grid % nEdges
+ nVertLevels = grid % nVertLevels
+ num_tracers = size(tracers,dim=1)
+
+ ! allocate nCells arrays
+
+ allocate(tracer_new(nVertLevels, nCells))
+ allocate(tracer_cur(nVertLevels, nCells))
+ allocate(upwind_tendency(nVertLevels, nCells))
+ allocate(inv_h_new(nVertLevels, nCells))
+ allocate(tracer_max(nVertLevels, nCells))
+ allocate(tracer_min(nVertLevels, nCells))
+ allocate(flux_incoming(nVertLevels, nCells))
+ allocate(flux_outgoing(nVertLevels, nCells))
+
+ ! allocate nEdges arrays
+ allocate(high_order_horiz_flux(nVertLevels, nEdges))
+
+ ! allocate nVertLevels+1 and nCells arrays
+ allocate(high_order_vert_flux(nVertLevels+1, nCells))
+
+ do iCell = 1, nCells
+ do k=1, maxLevelCell(iCell)
+ inv_h_new(k, iCell) = 1.0 / (h(k, iCell) + dt * tend_h(k, iCell))
+ end do
+ end do
+
+ ! Loop over tracers. One tracer is advected at a time. It is copied into a temporary array in order to improve locality
+ do iTracer = 1, num_tracers
+ ! Initialize variables for use in this iTracer iteration
+ do iCell = 1, nCells
+ do k=1, maxLevelCell(iCell)
+ tracer_cur(k,iCell) = tracers(iTracer,k,iCell)
+ upwind_tendency(k, iCell) = 0.0
+
+ !tracer_new is supposed to be the "new" tracer state. This allows bounds checks.
+ if (config_check_monotonicity) then
+ tracer_new(k,iCell) = 0.0
+ end if
+ end do ! k loop
+ end do ! iCell loop
+
+ high_order_vert_flux = 0.0
+ high_order_horiz_flux = 0.0
+
+ ! Compute the high order vertical flux. Also determine bounds on tracer_cur.
+ do iCell = 1, nCells
+ k = 1
+ tracer_max(k,iCell) = max(tracer_cur(k,iCell),tracer_cur(k+1,iCell))
+ tracer_min(k,iCell) = min(tracer_cur(k,iCell),tracer_cur(k+1,iCell))
+
+ k = 2
+ verticalWeightK = verticalCellSize(k-1, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ verticalWeightKm1 = verticalCellSize(k, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ high_order_vert_flux(k,iCell) = w(k,iCell)*(verticalWeightK*tracer_cur(k,iCell)+verticalWeightKm1*tracer_cur(k-1,iCell))
+ tracer_max(k,iCell) = max(tracer_cur(k-1,iCell),tracer_cur(k,iCell),tracer_cur(k+1,iCell))
+ tracer_min(k,iCell) = min(tracer_cur(k-1,iCell),tracer_cur(k,iCell),tracer_cur(k+1,iCell))
+
+ do k=3,maxLevelCell(iCell)-1
+ high_order_vert_flux(k,iCell) = mpas_ocn_tracer_advection_vflux3( tracer_cur(k-2,iCell),tracer_cur(k-1,iCell), &
+ tracer_cur(k ,iCell),tracer_cur(k+1,iCell), &
+ w(k,iCell), coef_3rd_order )
+ tracer_max(k,iCell) = max(tracer_cur(k-1,iCell),tracer_cur(k,iCell),tracer_cur(k+1,iCell))
+ tracer_min(k,iCell) = min(tracer_cur(k-1,iCell),tracer_cur(k,iCell),tracer_cur(k+1,iCell))
+ end do
+
+ k = maxLevelCell(iCell)
+ verticalWeightK = verticalCellSize(k-1, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ verticalWeightKm1 = verticalCellSize(k, iCell) / (verticalCellSize(k, iCell) + verticalCellSize(k-1, iCell))
+ high_order_vert_flux(k,iCell) = w(k,iCell)*(verticalWeightK*tracer_cur(k,iCell)+verticalWeightKm1*tracer_cur(k-1,iCell))
+ tracer_max(k,iCell) = max(tracer_cur(k,iCell),tracer_cur(k-1,iCell))
+ tracer_min(k,iCell) = min(tracer_cur(k,iCell),tracer_cur(k-1,iCell))
+
+ ! pull tracer_min and tracer_max from the (horizontal) surrounding cells
+ do i = 1, nEdgesOnCell(iCell)
+ do k=1, maxLevelCell(cellsOnCell(i, iCell))
+ tracer_max(k,iCell) = max(tracer_max(k,iCell),tracer_cur(k, cellsOnCell(i,iCell)))
+ tracer_min(k,iCell) = min(tracer_min(k,iCell),tracer_cur(k, cellsOnCell(i,iCell)))
+ end do ! k loop
+ end do ! i loop over nEdgesOnCell
+ end do ! iCell Loop
+
+ ! Compute the high order horizontal flux
+ do iEdge = 1, nEdges
+ do i = 1, nAdvCellsForEdge(iEdge)
+ iCell = advCellsForEdge(i,iEdge)
+ do k = 1, maxLevelCell(iCell)
+ tracer_weight = lowOrderAdvectionMask(k, iEdge) * adv_coefs_2nd(i,iEdge) &
+ + highOrderAdvectionMask(k, iEdge) * (adv_coefs(i,iEdge) + coef_3rd_order*sign(1.,uh(k,iEdge))*adv_coefs_3rd(i,iEdge))
+
+ tracer_weight = uh(k,iEdge)*tracer_weight
+ high_order_horiz_flux(k,iEdge) = high_order_horiz_flux(k,iEdge) + tracer_weight* tracer_cur(k,iCell)
+ end do ! k loop
+ end do ! i loop over nAdvCellsForEdge
+ end do ! iEdge loop
+
+ ! low order upwind vertical flux (monotonic and diffused)
+ ! Remove low order flux from the high order flux.
+ ! Store left over high order flux in high_order_vert_flux array.
+ ! Upwind fluxes are accumulated in upwind_tendency
+ do iCell = 1, nCells
+ do k = 2, maxLevelCell(iCell)
+ ! dwj 02/03/12 Ocean and Atmosphere are different in vertical
+! flux_upwind = max(0.,w(k,iCell))*tracer_cur(k-1,iCell) + min(0.,w(k,iCell))*tracer_cur(k,iCell)
+ flux_upwind = min(0.,w(k,iCell))*tracer_cur(k-1,iCell) + max(0.,w(k,iCell))*tracer_cur(k,iCell)
+ upwind_tendency(k-1,iCell) = upwind_tendency(k-1,iCell) + flux_upwind
+ upwind_tendency(k ,iCell) = upwind_tendency(k ,iCell) - flux_upwind
+ high_order_vert_flux(k,iCell) = high_order_vert_flux(k,iCell) - flux_upwind
+ end do ! k loop
+
+ ! flux_incoming contains the total remaining high order flux into iCell
+ ! it is positive.
+ ! flux_outgoing contains the total remaining high order flux out of iCell
+ ! it is negative
+ do k = 1, maxLevelCell(iCell)
+ ! dwj 02/03/12 Ocean and Atmosphere are different in vertical
+! flux_incoming (k,iCell) = -(min(0.,high_order_vert_flux(k+1,iCell))-max(0.,high_order_vert_flux(k,iCell)))
+! flux_outgoing(k,iCell) = -(max(0.,high_order_vert_flux(k+1,iCell))-min(0.,high_order_vert_flux(k,iCell)))
+
+ flux_incoming (k, iCell) = max(0.0, high_order_vert_flux(k+1, iCell)) - min(0.0, high_order_vert_flux(k, iCell))
+ flux_outgoing(k, iCell) = min(0.0, high_order_vert_flux(k+1, iCell)) - max(0.0, high_order_vert_flux(k, iCell))
+ end do ! k Loop
+ end do ! iCell Loop
+
+ ! low order upwind horizontal flux (monotinc and diffused)
+ ! Remove low order flux from the high order flux
+ ! Store left over high order flux in high_order_horiz_flux array
+ ! Upwind fluxes are accumulated in upwind_tendency
+ 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, maxLevelEdgeTop(iEdge)
+ flux_upwind = dvEdge(iEdge) * (max(0.,uh(k,iEdge))*tracer_cur(k,cell1) + min(0.,uh(k,iEdge))*tracer_cur(k,cell2))
+ high_order_horiz_flux(k,iEdge) = high_order_horiz_flux(k,iEdge) - flux_upwind
+
+ upwind_tendency(k,cell1) = upwind_tendency(k,cell1) - flux_upwind * invAreaCell1
+ upwind_tendency(k,cell2) = upwind_tendency(k,cell2) + flux_upwind * invAreaCell2
+
+ ! Accumulate remaining high order fluxes
+ flux_outgoing(k,cell1) = flux_outgoing(k,cell1) - max(0.,high_order_horiz_flux(k,iEdge)) * invAreaCell1
+ flux_incoming (k,cell1) = flux_incoming (k,cell1) - min(0.,high_order_horiz_flux(k,iEdge)) * invAreaCell1
+ flux_outgoing(k,cell2) = flux_outgoing(k,cell2) + min(0.,high_order_horiz_flux(k,iEdge)) * invAreaCell2
+ flux_incoming (k,cell2) = flux_incoming (k,cell2) + max(0.,high_order_horiz_flux(k,iEdge)) * invAreaCell2
+ end do ! k loop
+ end do ! iEdge loop
+
+ ! Build the factors for the FCT
+ ! Computed using the bounds that were computed previously, and the bounds on the newly updated value
+ ! Factors are placed in the flux_incoming and flux_outgoing arrays
+ do iCell = 1, nCells
+ do k = 1, maxLevelCell(iCell)
+ tracer_min_new = (tracer_cur(k,iCell)*h(k,iCell) + dt*(upwind_tendency(k,iCell)+flux_outgoing(k,iCell))) * inv_h_new(k,iCell)
+ tracer_max_new = (tracer_cur(k,iCell)*h(k,iCell) + dt*(upwind_tendency(k,iCell)+flux_incoming(k,iCell))) * inv_h_new(k,iCell)
+ tracer_upwind_new = (tracer_cur(k,iCell)*h(k,iCell) + dt*upwind_tendency(k,iCell)) * inv_h_new(k,iCell)
+
+ scale_factor = (tracer_max(k,iCell)-tracer_upwind_new)/(tracer_max_new-tracer_upwind_new+eps)
+ flux_incoming(k,iCell) = min( 1.0, max( 0.0, scale_factor) )
+
+ scale_factor = (tracer_upwind_new-tracer_min(k,iCell))/(tracer_upwind_new-tracer_min_new+eps)
+ flux_outgoing(k,iCell) = min( 1.0, max( 0.0, scale_factor) )
+ end do ! k loop
+ end do ! iCell loop
+
+ ! rescale the high order horizontal fluxes
+ do iEdge = 1, nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ do k = 1, maxLevelEdgeTop(iEdge)
+ flux = high_order_horiz_flux(k,iEdge)
+ flux = max(0.,flux) * min(flux_outgoing(k,cell1), flux_incoming(k,cell2)) &
+ + min(0.,flux) * min(flux_incoming(k,cell1), flux_outgoing(k,cell2))
+ high_order_horiz_flux(k,iEdge) = flux
+ end do ! k loop
+ end do ! iEdge loop
+
+ ! rescale the high order vertical flux
+ do iCell = 1, nCellsSolve
+ do k = 2, maxLevelCell(iCell)
+ flux = high_order_vert_flux(k,iCell)
+ ! dwj 02/03/12 Ocean and Atmosphere are different in vertical.
+! flux = max(0.,flux) * min(flux_outgoing(k-1,iCell), flux_incoming(k ,iCell)) &
+! + min(0.,flux) * min(flux_outgoing(k ,iCell), flux_incoming(k-1,iCell))
+ flux = max(0.,flux) * min(flux_outgoing(k ,iCell), flux_incoming(k-1,iCell)) &
+ + min(0.,flux) * min(flux_outgoing(k-1,iCell), flux_incoming(k ,iCell))
+ high_order_vert_flux(k,iCell) = flux
+ end do ! k loop
+ end do ! iCell loop
+
+ ! Accumulate the scaled high order horizontal tendencies
+ 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,maxLevelEdgeTop(iEdge)
+ tend(iTracer, k, cell1) = tend(iTracer, k, cell1) - high_order_horiz_flux(k, iEdge) * invAreaCell1
+ tend(iTracer, k, cell2) = tend(iTracer, k, cell2) + high_order_horiz_flux(k, iEdge) * invAreaCell2
+
+ if (config_check_monotonicity) then
+ !tracer_new holds a tendency for now.
+ tracer_new(k, cell1) = tracer_new(k, cell1) - high_order_horiz_flux(k, iEdge) * invAreaCell1
+ tracer_new(k, cell2) = tracer_new(k, cell2) + high_order_horiz_flux(k, iEdge) * invAreaCell2
+ end if
+ end do ! k loop
+ end do ! iEdge loop
+
+ ! Accumulate the scaled high order vertical tendencies, and the upwind tendencies
+ do iCell = 1, nCellsSolve
+ do k = 1,maxLevelCell(iCell)
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + (high_order_vert_flux(k+1, iCell) - high_order_vert_flux(k, iCell)) + upwind_tendency(k,iCell)
+
+ if (config_check_monotonicity) then
+ !tracer_new holds a tendency for now. Only for a check on monotonicity
+ tracer_new(k, iCell) = tracer_new(k, iCell) + (high_order_vert_flux(k+1, iCell) - high_order_vert_flux(k, iCell)) + upwind_tendency(k,iCell)
+
+ !tracer_new is now the new state of the tracer. Only for a check on monotonicity
+ tracer_new(k, iCell) = (tracer_cur(k, iCell)*h(k, iCell) + dt * tracer_new(k, iCell)) * inv_h_new(k, iCell)
+ end if
+ end do ! k loop
+ end do ! iCell loop
+
+ if (config_check_monotonicity) then
+ !build min and max bounds on old and new tracer for check on monotonicity.
+ cur_min = minval(tracer_cur(:,1:nCellsSolve))
+ cur_max = maxval(tracer_cur(:,1:nCellsSolve))
+ new_min = minval(tracer_new(:,1:nCellsSolve))
+ new_max = maxval(tracer_new(:,1:nCellsSolve))
+
+ !check monotonicity
+ if(new_min < cur_min-eps) then
+ write(*,*) 'Minimum out of bounds on tracer ', iTracer, cur_min, new_min
+ end if
+
+ if(new_max > cur_max+eps) then
+ write(*,*) 'Maximum out of bounds on tracer ', iTracer, cur_max, new_max
+ end if
+ end if
+ end do ! iTracer loop
+
+ deallocate(tracer_new)
+ deallocate(tracer_cur)
+ deallocate(upwind_tendency)
+ deallocate(inv_h_new)
+ deallocate(tracer_max)
+ deallocate(tracer_min)
+ deallocate(flux_incoming)
+ deallocate(flux_outgoing)
+ deallocate(high_order_horiz_flux)
+ deallocate(high_order_vert_flux)
+ end subroutine mpas_ocn_tracer_advection_mono_tend!}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_mono_init
+!
+!> \brief MPAS ocean initialize monotonic tracer advection tendency with FCT
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine initializes the monotonic tracer advection tendencity using a FCT.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_mono_init(err)!{{{
+ integer, intent(inout) :: err !< Input: Error Flags
+
+ integer :: err_tmp
+
+ err = 0
+
+ if ( config_horiz_tracer_adv_order == 3) then
+ coef_3rd_order = config_coef_3rd_order
+ else if(config_horiz_tracer_adv_order == 2 .or. config_horiz_tracer_adv_order == 4) then
+ coef_3rd_order = 0.0
+ end if
+
+ end subroutine mpas_ocn_tracer_advection_mono_init!}}}
+
+end module mpas_ocn_tracer_advection_mono
Copied: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std.F (from rev 1646, trunk/mpas/src/core_ocean/mpas_ocn_tracer_advection_std.F)
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std.F (rev 0)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -0,0 +1,100 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_advection_std
+!
+!> \brief MPAS ocean tracer advection driver (non-monotonic/fct)
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This module contains driver routine for tracer advection tendencies
+!> as well as the routines for setting up advection coefficients and
+!> initialization of the advection routines.
+!
+!-----------------------------------------------------------------------
+module mpas_ocn_tracer_advection_std
+
+ use mpas_kind_types
+ use mpas_grid_types
+ use mpas_configure
+ use mpas_dmpar
+ use mpas_timer
+
+ use mpas_ocn_tracer_advection_std_hadv
+ use mpas_ocn_tracer_advection_std_vadv
+
+ implicit none
+ private
+ save
+
+ public :: mpas_ocn_tracer_advection_std_tend, &
+ mpas_ocn_tracer_advection_std_init
+
+ contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_std_tend
+!
+!> \brief MPAS ocean standard tracer advection tendency
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine is the driver routine for the standard computation of
+!> tracer advection tendencies.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_std_tend(tracers, uh, w, verticalCellSize, grid, tend)!{{{
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! Input: s - current model state
+ ! grid - grid metadata
+ !
+ ! Output: tend - computed scalar tendencies
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: Tracer tendency
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: Tracer values
+ real (kind=RKIND), dimension(:,:), intent(in) :: uh !< Input: Thickness weighted horizontal velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: w !< Input: Vertical Velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: verticalCellSize !< Input: Distance between vertical interfaces of a cell
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
+
+ call mpas_timer_start("tracer-hadv", .false.)
+ call mpas_ocn_tracer_advection_std_hadv_tend(tracers, uh, grid, tend)
+ call mpas_timer_stop("tracer-hadv")
+ call mpas_timer_start("tracer-vadv", .false.)
+ call mpas_ocn_tracer_advection_std_vadv_tend(tracers, w, verticalCellSize, grid, tend)
+ call mpas_timer_stop("tracer-vadv")
+
+ end subroutine mpas_ocn_tracer_advection_std_tend!}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_std_init
+!
+!> \brief MPAS ocean standard tracer advection initialization
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine is the driver routine for the initializtion of the standard
+!> tracer advection routines.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_std_init(err)!{{{
+ integer, intent(inout) :: err !< Input: Error Flags
+
+ integer :: err_tmp
+
+ err = 0
+
+ call mpas_ocn_tracer_advection_std_hadv_init(err_tmp)
+ err = ior(err, err_tmp)
+ call mpas_ocn_tracer_advection_std_vadv_init(err_tmp)
+ err = ior(err, err_tmp)
+
+ end subroutine mpas_ocn_tracer_advection_std_init!}}}
+
+end module mpas_ocn_tracer_advection_std
Copied: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_hadv.F (from rev 1646, trunk/mpas/src/core_ocean/mpas_ocn_tracer_advection_std_hadv.F)
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_hadv.F (rev 0)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_hadv.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -0,0 +1,140 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_advection_std_hadv
+!
+!> \brief MPAS ocean standard horizontal tracer advection (non-monotonic/fct)
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This module contains routines for horizontal tracer advection tendencies
+!> and initialization of the horizontal advection routines.
+!
+!-----------------------------------------------------------------------
+module mpas_ocn_tracer_advection_std_hadv
+
+ use mpas_kind_types
+ use mpas_grid_types
+ use mpas_configure
+ use mpas_dmpar
+
+ use mpas_ocn_tracer_advection_helpers
+
+ implicit none
+ private
+ save
+
+ public :: mpas_ocn_tracer_advection_std_hadv_tend, &
+ mpas_ocn_tracer_advection_std_hadv_init
+
+ real (kind=RKIND) :: coef_3rd_order
+
+ logical :: hadvOn
+
+ contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_std_hadv_tend
+!
+!> \brief MPAS ocean standard horizontal tracer advection tendency
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine computes the tendency for 3rd order horizontal advection of tracers.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_std_hadv_tend(tracers, uh, grid, tend)!{{{
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/output: Tracer tendency
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: Tracer values
+ real (kind=RKIND), dimension(:,:), intent(in) :: uh !< Input: Thickness weighted horizontal velocity
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
+
+ integer :: i, iCell, iEdge, k, iTracer, cell1, cell2
+ real (kind=RKIND) :: flux, tracer_weight
+
+ real (kind=RKIND), dimension(:), pointer :: areaCell
+ integer, dimension(:,:), pointer :: cellsOnEdge
+
+ integer, dimension(:,:), pointer :: advCellsForEdge, highOrderAdvectionMask, lowOrderAdvectionMask
+ integer, dimension(:), pointer :: nAdvCellsForEdge
+ real (kind=RKIND), dimension(:,:), pointer :: adv_coefs, adv_coefs_2nd, adv_coefs_3rd
+ real (kind=RKIND), dimension(:,:), allocatable :: flux_arr
+ integer :: nVertLevels, num_tracers
+
+ if (.not. hadvOn) return
+
+ cellsOnEdge => grid % cellsOnEdge % array
+ areaCell => grid % areaCell % array
+
+ nAdvCellsForEdge => grid % nAdvCellsForEdge % array
+ advCellsForEdge => grid % advCellsForEdge % array
+ adv_coefs => grid % adv_coefs % array
+ adv_coefs_2nd => grid % adv_coefs_2nd % array
+ adv_coefs_3rd => grid % adv_coefs_3rd % array
+ highOrderAdvectionMask => grid % highOrderAdvectionMask % array
+ lowOrderAdvectionMask => grid % lowOrderAdvectionMask % array
+
+ nVertLevels = grid % nVertLevels
+ num_tracers = size(tracers, dim=1)
+
+ allocate(flux_arr(num_tracers, grid % nVertLevels))
+
+ ! horizontal flux divergence, accumulate in tracer_tend
+ do iEdge=1,grid%nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+ if (cell1 <= grid%nCellsSolve .or. cell2 <= grid%nCellsSolve) then ! only for owned cells
+ flux_arr(:,:) = 0.
+ do i=1,nAdvCellsForEdge(iEdge)
+ iCell = advCellsForEdge(i,iEdge)
+ do k=1,grid % nVertLevels
+ tracer_weight = lowOrderAdvectionMask(k, iEdge) * adv_coefs_2nd(i,iEdge) &
+ + highOrderAdvectionMask(k, iEdge) * (adv_coefs(i,iEdge) + coef_3rd_order*sign(1.,uh(k,iEdge))*adv_coefs_3rd(i,iEdge))
+ do iTracer=1,num_tracers
+ flux_arr(iTracer,k) = flux_arr(iTracer,k) + tracer_weight* tracers(iTracer,k,iCell)
+ end do
+ end do
+ end do
+
+ do k=1,grid % nVertLevels
+ do iTracer=1,num_tracers
+ tend(iTracer,k,cell1) = tend(iTracer,k,cell1) - uh(k,iEdge)*flux_arr(iTracer,k)/areaCell(cell1)
+ tend(iTracer,k,cell2) = tend(iTracer,k,cell2) + uh(k,iEdge)*flux_arr(iTracer,k)/areaCell(cell2)
+ end do
+ end do
+ end if
+ end do
+
+ deallocate(flux_arr)
+
+ end subroutine mpas_ocn_tracer_advection_std_hadv_tend!}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_std_hadv_init
+!
+!> \brief MPAS ocean standard horizontal tracer advection initialization
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine initializes the 3rd order standard horizontal advection of tracers
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_std_hadv_init(err)!{{{
+ integer, intent(inout) :: err !< Input/Output: Error flag
+
+ err = 0
+
+ hadvOn =.true.
+
+ if ( config_horiz_tracer_adv_order == 3) then
+ coef_3rd_order = config_coef_3rd_order
+ else if ( config_horiz_tracer_adv_order == 2 .or. config_horiz_tracer_adv_order == 4) then
+ coef_3rd_order = 0.0
+ end if
+ end subroutine mpas_ocn_tracer_advection_std_hadv_init!}}}
+
+end module mpas_ocn_tracer_advection_std_hadv
Copied: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_vadv.F (from rev 1646, trunk/mpas/src/core_ocean/mpas_ocn_tracer_advection_std_vadv.F)
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_vadv.F (rev 0)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_vadv.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -0,0 +1,103 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_advection_std_vadv
+!
+!> \brief MPAS ocean vertical tracer advection driver (non-monotonic/fct)
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This module contains driver routines for vertical tracer advection tendencies
+!> and initialization of the advection routines.
+!
+!-----------------------------------------------------------------------
+module mpas_ocn_tracer_advection_std_vadv
+
+ use mpas_kind_types
+ use mpas_grid_types
+ use mpas_configure
+ use mpas_dmpar
+
+ use mpas_ocn_tracer_advection_std_vadv2
+ use mpas_ocn_tracer_advection_std_vadv3
+ use mpas_ocn_tracer_advection_std_vadv4
+
+ implicit none
+ private
+ save
+
+ public :: mpas_ocn_tracer_advection_std_vadv_tend, &
+ mpas_ocn_tracer_advection_std_vadv_init
+
+ logical :: order2, order3, order4
+
+ contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_std_vadv_tend
+!
+!> \brief MPAS ocean standard vertical tracer advection tendency
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine is the driver routine for the standard computation of
+!> vertical tracer advection tendencies.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_std_vadv_tend(tracers, w, verticalCellSize, grid, tend)!{{{
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: Tracer Tendency
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: Tracer Values
+ real (kind=RKIND), dimension(:,:), intent(in) :: w !< Input: Vertical Velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: verticalCellSize !< Input: Distance between vertical interfaces of cell
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
+
+ if(order2) then
+ call mpas_ocn_tracer_advection_std_vadv2_tend(tracers, w, verticalCellSize, grid, tend)
+ else if(order3) then
+ call mpas_ocn_tracer_advection_std_vadv3_tend(tracers, w, verticalCellSize, grid, tend)
+ else if(order4) then
+ call mpas_ocn_tracer_advection_std_vadv4_tend(tracers, w, verticalCellSize, grid, tend)
+ endif
+
+ end subroutine mpas_ocn_tracer_advection_std_vadv_tend!}}}
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_std_vadv_init
+!
+!> \brief MPAS ocean standard vertical tracer advection tendency
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine initializes the vertical tracer advection tendencies.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_std_vadv_init(err)!{{{
+ integer, intent(inout) :: err !< Input/Output: Error flag
+
+ err = 0
+
+ order2 = .false.
+ order3 = .false.
+ order4 = .false.
+
+ if (config_vert_tracer_adv_order == 2) then
+ order2 = .true.
+ else if (config_vert_tracer_adv_order == 3) then
+ order3 = .true.
+ else if (config_vert_tracer_adv_order == 4) then
+ order4 = .true.
+ else
+ print *, 'invalid value for config_tracer_vadv_order'
+ print *, 'options are 2, 3, or 4'
+ err = 1
+ endif
+
+ end subroutine mpas_ocn_tracer_advection_std_vadv_init!}}}
+
+end module mpas_ocn_tracer_advection_std_vadv
+
Copied: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_vadv2.F (from rev 1646, trunk/mpas/src/core_ocean/mpas_ocn_tracer_advection_std_vadv2.F)
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_vadv2.F (rev 0)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_vadv2.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -0,0 +1,96 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_advection_std_vadv2
+!
+!> \brief MPAS ocean 2nd order vertical tracer advection driver (non-monotonic/fct)
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This module contains routines for 2nd order vertical tracer advection tendencies.
+!
+!-----------------------------------------------------------------------
+module mpas_ocn_tracer_advection_std_vadv2
+
+ use mpas_kind_types
+ use mpas_grid_types
+ use mpas_configure
+ use mpas_dmpar
+
+ use mpas_ocn_tracer_advection_helpers
+
+ implicit none
+ private
+ save
+
+ public :: mpas_ocn_tracer_advection_std_vadv2_tend
+
+ contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_std_vadv2_tend
+!
+!> \brief MPAS ocean 2nd order standard vertical tracer advection tendency
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine is the driver routine for the 2nd order standard computation of
+!> vertical tracer advection tendencies.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_std_vadv2_tend(tracers, w, verticalCellSize, grid, tend)!{{{
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: tracer tendency
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: Tracer values
+ real (kind=RKIND), dimension(:,:), intent(in) :: w !< Input: Vertical Velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: verticalCellSize !< Input: Distance between vertical interfaces of cell
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
+
+ integer :: i, iCell, iEdge, k, iTracer, cell1, cell2
+ real (kind=RKIND) :: flux, tracer_edge, tracer_weight
+ real (kind=RKIND) :: tracer_weight_cell1, tracer_weight_cell2
+
+
+ real (kind=RKIND), dimension(:,:), allocatable :: vert_flux
+ real (kind=RKIND) :: weightK, weightKm1
+ integer :: nVertLevels, num_tracers
+ integer, dimension(:), pointer :: maxLevelCell
+
+ nVertLevels = grid % nVertLevels
+ num_tracers = size(tracers, dim=1)
+ maxLevelCell => grid % maxLevelCell % array
+
+ allocate(vert_flux(num_tracers, nVertLevels+1))
+
+ !
+ ! vertical flux divergence
+ !
+
+ ! zero fluxes at top and bottom
+
+ vert_flux(:,1) = 0.
+
+ do iCell=1,grid % nCellsSolve
+ do k = 2, maxLevelCell(iCell)
+ do iTracer=1,num_tracers
+ weightK = verticalCellSize(k-1, iCell) / (verticalCellSize(k-1, iCell) + verticalCellSize(k, iCell))
+ weightKm1 = verticalCellSize(k, iCell) / (verticalCellSize(k-1, iCell) + verticalCellSize(k, iCell))
+ vert_flux(iTracer,k) = w(k,iCell)*(weightK*tracers(iTracer,k,iCell)+weightKm1*tracers(iTracer,k-1,iCell))
+ end do
+ end do
+
+ vert_flux(:,maxLevelCell(iCell)+1) = 0
+
+ do k=1,maxLevelCell(iCell)
+ do iTracer=1,num_tracers
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + ( vert_flux(iTracer, k+1) - vert_flux(iTracer, k))
+ end do
+ end do
+ end do
+
+ deallocate(vert_flux)
+
+ end subroutine mpas_ocn_tracer_advection_std_vadv2_tend!}}}
+
+end module mpas_ocn_tracer_advection_std_vadv2
Copied: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_vadv3.F (from rev 1646, trunk/mpas/src/core_ocean/mpas_ocn_tracer_advection_std_vadv3.F)
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_vadv3.F (rev 0)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_vadv3.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -0,0 +1,106 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_advection_std_vadv3
+!
+!> \brief MPAS ocean 3rd order vertical tracer advection driver (non-monotonic/fct)
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This module contains routines for 3rd order vertical tracer advection tendencies.
+!
+!-----------------------------------------------------------------------
+module mpas_ocn_tracer_advection_std_vadv3
+
+ use mpas_kind_types
+ use mpas_grid_types
+ use mpas_configure
+ use mpas_dmpar
+
+ use mpas_ocn_tracer_advection_helpers
+
+ implicit none
+ private
+ save
+
+ public :: mpas_ocn_tracer_advection_std_vadv3_tend
+
+ real (kind=RKIND) :: coef_3rd_order
+
+ contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_std_vadv3_tend
+!
+!> \brief MPAS ocean 3rd order standard vertical tracer advection tendency
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine computes the 3rd order vertical tracer advection tendencies.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_std_vadv3_tend(tracers, w, verticalCellSize, grid, tend)!{{{
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: Tracer Tendency
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: Tracer Values
+ real (kind=RKIND), dimension(:,:), intent(in) :: w !< Input: Vertical Velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: verticalCellSize !< Input: Distance between vertical interfaces of cell
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
+
+ integer :: i, iCell, iEdge, k, iTracer, cell1, cell2
+
+ real (kind=RKIND), dimension(:,:), allocatable :: vert_flux
+ real (kind=RKIND) :: weightK, weightKm1
+ integer :: nVertLevels, num_tracers
+ integer, dimension(:), pointer :: maxLevelCell
+
+ coef_3rd_order = config_coef_3rd_order
+
+ nVertLevels = grid % nVertLevels
+ num_tracers = size(tracers, dim=1)
+ maxLevelCell => grid % maxLevelCell % array
+
+ allocate(vert_flux(num_tracers, nVertLevels+1))
+
+ vert_flux(:,1) = 0.
+
+ do iCell=1,grid % nCellsSolve
+
+ k = 2
+ do iTracer=1,num_tracers
+ weightK = verticalCellSize(k-1, iCell) / (verticalCellSize(k-1, iCell) + verticalCellSize(k, iCell))
+ weightKm1 = verticalCellSize(k, iCell) / (verticalCellSize(k-1, iCell) + verticalCellSize(k, iCell))
+ vert_flux(iTracer,k) = w(k,iCell)*(weightK*tracers(iTracer,k,iCell)+weightKm1*tracers(iTracer,k-1,iCell))
+ enddo
+
+ do k=3,maxLevelCell(iCell)-1
+ do iTracer=1,num_tracers
+ vert_flux(iTracer,k) = mpas_ocn_tracer_advection_vflux3( tracers(iTracer,k-2,iCell),tracers(iTracer,k-1,iCell), &
+ tracers(iTracer,k ,iCell),tracers(iTracer,k+1,iCell), &
+ w(k,iCell), coef_3rd_order )
+ end do
+ end do
+
+ k = maxLevelCell(iCell)
+
+ do iTracer=1,num_tracers
+ weightK = verticalCellSize(k-1, iCell) / (verticalCellSize(k-1, iCell) + verticalCellSize(k, iCell))
+ weightKm1 = verticalCellSize(k, iCell) / (verticalCellSize(k-1, iCell) + verticalCellSize(k, iCell))
+ vert_flux(iTracer,k) = w(k,iCell)*(weightK*tracers(iTracer,k,iCell)+weightKm1*tracers(iTracer,k-1,iCell))
+ enddo
+
+ vert_Flux(:, maxLevelCell(iCell)+1) = 0.0
+
+ do k=1,maxLevelCell(iCell)
+ do iTracer=1,num_tracers
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + (vert_flux(iTracer, k+1) - vert_flux(iTracer, k))
+ end do
+ end do
+ end do
+
+ deallocate(vert_flux)
+
+ end subroutine mpas_ocn_tracer_advection_std_vadv3_tend!}}}
+
+end module mpas_ocn_tracer_advection_std_vadv3
Copied: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_vadv4.F (from rev 1646, trunk/mpas/src/core_ocean/mpas_ocn_tracer_advection_std_vadv4.F)
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_vadv4.F (rev 0)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_advection_std_vadv4.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -0,0 +1,105 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_advection_std_vadv4
+!
+!> \brief MPAS ocean 4th order vertical tracer advection driver (non-monotonic/fct)
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This module contains routines for 4th order vertical tracer advection.
+!
+!-----------------------------------------------------------------------
+module mpas_ocn_tracer_advection_std_vadv4
+
+ use mpas_kind_types
+ use mpas_grid_types
+ use mpas_configure
+ use mpas_dmpar
+
+ use mpas_ocn_tracer_advection_helpers
+
+ implicit none
+ private
+ save
+
+ public :: mpas_ocn_tracer_advection_std_vadv4_tend
+
+ contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! routine mpas_ocn_tracer_advection_std_vadv4_tend
+!
+!> \brief MPAS ocean 4th order standard vertical tracer advection tendency
+!> \author Doug Jacobsen
+!> \date 03/09/12
+!> \version SVN:$Id:$
+!> \details
+!> This routine computes the 4th order vertical tracer advection tendencies.
+!
+!-----------------------------------------------------------------------
+ subroutine mpas_ocn_tracer_advection_std_vadv4_tend(tracers, w, verticalCellSize, grid, tend)!{{{
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: tend !< Input/Output: Tracer tendency
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !< Input: Tracer Values
+ real (kind=RKIND), dimension(:,:), intent(in) :: w !< Input: Vertical Velocity
+ real (kind=RKIND), dimension(:,:), intent(in) :: verticalCellSize !< Input: Distance between vertical interfaces of cell
+ type (mesh_type), intent(in) :: grid !< Input: Grid information
+
+ integer :: i, iCell, iEdge, k, iTracer, cell1, cell2
+
+ real (kind=RKIND), dimension(:,:), allocatable :: vert_flux
+ real (kind=RKIND) :: weightK, weightKm1
+ integer :: nVertLevels, num_tracers
+ integer, dimension(:), pointer :: maxLevelCell
+
+ nVertLevels = grid % nVertLevels
+ num_tracers = size(tracers, dim=1)
+ maxLevelCell => grid % maxLevelCell % array
+
+ allocate(vert_flux(num_tracers, nVertLevels+1))
+
+ ! vertical flux divergence
+ !
+
+ ! zero fluxes at top and bottom
+
+ vert_flux(:,1) = 0.
+
+ do iCell=1,grid % nCellsSolve
+
+ k = 2
+ do iTracer=1,num_tracers
+ weightK = verticalCellSize(k-1, iCell) / (verticalCellSize(k-1, iCell) + verticalCellSize(k, iCell))
+ weightKm1 = verticalCellSize(k, iCell) / (verticalCellSize(k-1, iCell) + verticalCellSize(k, iCell))
+ vert_flux(iTracer,k) = w(k,iCell)*(weightK*tracers(iTracer,k,iCell)+weightKm1*tracers(iTracer,k-1,iCell))
+ enddo
+ do k=3,nVertLevels-1
+ do iTracer=1,num_tracers
+ vert_flux(iTracer,k) = mpas_ocn_tracer_advection_vflux4( tracers(iTracer,k-2,iCell),tracers(iTracer,k-1,iCell), &
+ tracers(iTracer,k ,iCell),tracers(iTracer,k+1,iCell), w(k,iCell) )
+ end do
+ end do
+
+ k = maxLevelCell(iCell)
+ do iTracer=1,num_tracers
+ weightK = verticalCellSize(k-1, iCell) / (verticalCellSize(k-1, iCell) + verticalCellSize(k, iCell))
+ weightKm1 = verticalCellSize(k, iCell) / (verticalCellSize(k-1, iCell) + verticalCellSize(k, iCell))
+ vert_flux(iTracer,k) = w(k,iCell)*(weightK*tracers(iTracer,k,iCell)+weightKm1*tracers(iTracer,k-1,iCell))
+ enddo
+
+ vert_flux(:,maxLevelCell(iCell)+1) = 0.0
+
+ do k=1,maxLevelCell(iCell)
+ do iTracer=1,num_tracers
+ tend(iTracer, k, iCell) = tend(iTracer, k, iCell) + (vert_flux(iTracer, k+1) - vert_flux(iTracer, k))
+ end do
+ end do
+
+ end do
+
+ deallocate(vert_flux)
+
+ end subroutine mpas_ocn_tracer_advection_std_vadv4_tend!}}}
+
+end module mpas_ocn_tracer_advection_std_vadv4
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hadv.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Modified: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hadv2.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hadv2.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hadv2.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -182,7 +182,7 @@
err = 0
hadv2On = .false.
- if (config_tracer_adv_order == 2) then
+ if (config_horiz_tracer_adv_order == 2) then
hadv2On = .true.
end if
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hadv2.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Modified: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hadv3.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hadv3.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hadv3.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -221,11 +221,10 @@
err = 0
hadv3On = .false.
- if (config_tracer_adv_order == 3) then
+ if (config_horiz_tracer_adv_order == 3) then
hadv3On = .true.
- coef_3rd_order = 1.0
- if (config_monotonic) coef_3rd_order = 0.25
+ coef_3rd_order = config_coef_3rd_order
end if
!--------------------------------------------------------------------
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hadv3.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Modified: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hadv4.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hadv4.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hadv4.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -213,7 +213,7 @@
err = 0
hadv4On = .false.
- if (config_tracer_adv_order == 4) then
+ if (config_horiz_tracer_adv_order == 4) then
hadv4On = .true.
end if
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hadv4.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hmix.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hmix_del2.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_hmix_del4.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_vadv.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_vadv_spline.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Modified: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vel_coriolis.F
===================================================================
--- branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vel_coriolis.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vel_coriolis.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -62,7 +62,7 @@
!
!-----------------------------------------------------------------------
- subroutine ocn_vel_coriolis_tend(grid, pv_edge, h_edge, u, ke, tend, err)!{{{
+ subroutine ocn_vel_coriolis_tend(grid, Vor_edge, h_edge, u, ke, tend, err)!{{{
!-----------------------------------------------------------------
!
@@ -71,7 +71,7 @@
!-----------------------------------------------------------------
real (kind=RKIND), dimension(:,:), intent(in) :: &
- pv_edge !< Input: Potential vorticity on edge
+ Vor_edge !< Input: Potential vorticity on edge
real (kind=RKIND), dimension(:,:), intent(in) :: &
h_edge !< Input: Thickness on edge
real (kind=RKIND), dimension(:,:), intent(in) :: &
@@ -138,7 +138,7 @@
q = 0.0
do j = 1,nEdgesOnEdge(iEdge)
eoe = edgesOnEdge(j,iEdge)
- workpv = 0.5 * (pv_edge(k,iEdge) + pv_edge(k,eoe))
+ workpv = 0.5 * (Vor_edge(k,iEdge) + Vor_edge(k,eoe))
q = q + weightsOnEdge(j,iEdge) * u(k,eoe) * workpv * h_edge(k,eoe)
end do
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vel_coriolis.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vel_forcing.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vel_forcing_windstress.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vel_hmix.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vel_hmix_del2.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vel_hmix_del4.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vel_pressure_grad.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vel_vadv.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vmix.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vmix_coefs_const.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vmix_coefs_rich.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Property changes on: branches/ocean_projects/gmvar/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F
___________________________________________________________________
Deleted: svn:mergeinfo
- /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/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:1213-1492
Modified: branches/ocean_projects/gmvar/src/core_sw/Registry
===================================================================
--- branches/ocean_projects/gmvar/src/core_sw/Registry 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/core_sw/Registry 2012-03-15 19:43:17 UTC (rev 1650)
@@ -4,7 +4,7 @@
namelist integer sw_model config_test_case 5
namelist character sw_model config_time_integration RK4
namelist real sw_model config_dt 172.8
-namelist integer sw_model config_calendar_type MPAS_360DAY
+namelist character sw_model config_calendar_type 360day
namelist character sw_model config_start_time 0000-01-01_00:00:00
namelist character sw_model config_stop_time none
namelist character sw_model config_run_duration none
Modified: branches/ocean_projects/gmvar/src/external/Makefile
===================================================================
--- branches/ocean_projects/gmvar/src/external/Makefile 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/external/Makefile 2012-03-15 19:43:17 UTC (rev 1650)
@@ -3,7 +3,7 @@
all: esmf_time
esmf_time:
- ( cd esmf_time_f90; make FC="$(FC) $(FFLAGS)" CPP="$(CPP)" )
+ ( cd esmf_time_f90; $(MAKE) FC="$(FC) $(FFLAGS)" CPP="$(CPP)" )
clean:
- ( cd esmf_time_f90; make clean )
+ ( cd esmf_time_f90; $(MAKE) clean )
Modified: branches/ocean_projects/gmvar/src/external/esmf_time_f90/ESMF_Calendar.F90
===================================================================
--- branches/ocean_projects/gmvar/src/external/esmf_time_f90/ESMF_Calendar.F90 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/external/esmf_time_f90/ESMF_Calendar.F90 2012-03-15 19:43:17 UTC (rev 1650)
@@ -51,14 +51,23 @@
INTEGER, PARAMETER :: MONTHS_PER_YEAR = 12
- INTEGER, PARAMETER :: mday(MONTHS_PER_YEAR) &
+
+ INTEGER, PARAMETER :: daysPerMonthNoLeap(MONTHS_PER_YEAR) &
= (/31,28,31,30,31,30,31,31,30,31,30,31/)
- INTEGER, PARAMETER :: mdayleap(MONTHS_PER_YEAR) &
+ INTEGER, PARAMETER :: daysPerMonthLeap(MONTHS_PER_YEAR) &
= (/31,29,31,30,31,30,31,31,30,31,30,31/)
- INTEGER, DIMENSION(365) :: daym
- INTEGER, DIMENSION(366) :: daymleap
+ INTEGER, PARAMETER :: daysPerMonth360(MONTHS_PER_YEAR) &
+ = (/30,30,30,30,30,30,30,30,30,30,30,30/)
+
+ INTEGER, DIMENSION(MONTHS_PER_YEAR) :: mday
+ INTEGER, DIMENSION(MONTHS_PER_YEAR) :: mdayleap
+
+ INTEGER, DIMENSION(:), POINTER :: daym
+ INTEGER, DIMENSION(:), POINTER :: daymleap
+
INTEGER :: mdaycum(0:MONTHS_PER_YEAR)
INTEGER :: mdayleapcum(0:MONTHS_PER_YEAR)
+
TYPE(ESMF_BaseTime), TARGET :: monthbdys(0:MONTHS_PER_YEAR)
TYPE(ESMF_BaseTime), TARGET :: monthbdysleap(0:MONTHS_PER_YEAR)
@@ -69,7 +78,6 @@
! ! F90 "enum" type to match C++ ESMC_CalendarType enum
type ESMF_CalendarType
- private
integer :: caltype
end type
@@ -152,7 +160,10 @@
!
! !PUBLIC MEMBER FUNCTIONS:
public ESMF_CalendarCreate
+ public ESMF_CalendarDestroy
+ public ESMF_GetCalendarType
+
! Required inherited and overridden ESMF_Base class methods
public ESMF_CalendarInitialized ! Only in this implementation, intended
@@ -165,6 +176,14 @@
!==============================================================================
+
+
+ type(ESMF_CalendarType) function ESMF_GetCalendarType()
+ ESMF_GetCalendarType = defaultCal % Type
+ end function ESMF_GetCalendarType
+
+
+!==============================================================================
!BOP
! !IROUTINE: ESMF_CalendarCreate - Create a new ESMF Calendar of built-in type
@@ -210,50 +229,61 @@
type(ESMF_DaysPerYear) :: dayspy
if ( present(rc) ) rc = ESMF_FAILURE
-! Calendar type is hard-coded. Use ESMF library if more flexibility is
-! needed.
-#ifdef NO_LEAP_CALENDAR
- if ( calendartype%caltype /= ESMF_CAL_NOLEAP%caltype ) then
+
+ if ( calendartype % caltype == ESMF_CAL_GREGORIAN % caltype ) then
+ ESMF_CalendarCreate % Type = ESMF_CAL_GREGORIAN
+ mday = daysPerMonthNoLeap
+ mdayleap = daysPerMonthLeap
+ allocate(daym(365))
+ allocate(daymleap(366))
+ else if ( calendartype % caltype == ESMF_CAL_NOLEAP % caltype ) then
+ ESMF_CalendarCreate % Type = ESMF_CAL_NOLEAP
+ mday = daysPerMonthNoLeap
+ mdayleap = daysPerMonthNoLeap
+ allocate(daym(365))
+ allocate(daymleap(365))
+ else if ( calendartype % caltype == ESMF_CAL_360DAY % caltype ) then
+ ESMF_CalendarCreate % Type = ESMF_CAL_360DAY
+ mday = daysPerMonth360
+ mdayleap = daysPerMonth360
+ allocate(daym(360))
+ allocate(daymleap(360))
+ else
write(6,*) 'Not a valid calendar type for this implementation'
- write(6,*) 'This implementation only allows ESMF_CAL_NOLEAP'
- write(6,*) 'calender type set to = ', calendartype%caltype
- write(6,*) 'NO_LEAP calendar type is = ', ESMF_CAL_NOLEAP%caltype
+ write(6,*) 'The current implementation only supports ESMF_CAL_NOLEAP, ESMF_CAL_GREGORIAN, ESMF_CAL_360DAY'
return
end if
- ESMF_CalendarCreate%Type = ESMF_CAL_NOLEAP
-#else
- if ( calendartype%caltype /= ESMF_CAL_GREGORIAN%caltype ) then
- write(6,*) 'Not a valid calendar type for this implementation'
- write(6,*) 'This implementation only allows ESMF_CAL_GREGORIAN'
- write(6,*) 'calender type set to = ', calendartype%caltype
- write(6,*) 'GREGORIAN calendar type is = ', ESMF_CAL_GREGORIAN%caltype
- return
- end if
- ESMF_CalendarCreate%Type = ESMF_CAL_GREGORIAN
-#endif
-! This is a bug on some systems -- need initial value set by compiler at
-! startup.
-! However, note that some older compilers do not support compile-time
-! initialization of data members of Fortran derived data types. For example,
-! PGI 5.x compilers do not support this F95 feature. See
-! NO_DT_COMPONENT_INIT.
- ESMF_CalendarCreate%Set = .true.
- ESMF_CalendarCreate%SecondsPerDay = SECONDS_PER_DAY
-! DaysPerYear and SecondsPerYear are incorrect for Gregorian calendars...
- dayspy%D = size(daym)
-!TBH: TODO: Replace DaysPerYear and SecondsPerYear with methods
-!TBH: TODO: since they only make sense for the NO_LEAP calendar!
- ESMF_CalendarCreate%DaysPerYear = dayspy
- ESMF_CalendarCreate%SecondsPerYear = ESMF_CalendarCreate%SecondsPerDay &
- * dayspy%D
-!TBH: TODO: use mdayleap for leap-year calendar
- ESMF_CalendarCreate%DaysPerMonth(:) = mday(:)
+ ESMF_CalendarCreate % Set = .true.
+ ESMF_CalendarCreate % DaysPerMonth(:) = mday(:)
+ ESMF_CalendarCreate % SecondsPerDay = SECONDS_PER_DAY
+
+!TBH: TODO: Replace DaysPerYear and SecondsPerYear with methods
+!TBH: TODO: since they only make sense for the NO_LEAP calendar!
+ dayspy % D = size(daym)
+ ESMF_CalendarCreate % DaysPerYear = dayspy
+ ESMF_CalendarCreate % SecondsPerYear = ESMF_CalendarCreate % SecondsPerDay * dayspy % D
+
if ( present(rc) ) rc = ESMF_SUCCESS
- end function ESMF_CalendarCreate
+ end function ESMF_CalendarCreate
+ subroutine ESMF_CalendarDestroy(rc)
+
+ integer, intent(out), optional :: rc
+
+ if ( present(rc) ) rc = ESMF_FAILURE
+
+ deallocate(daym)
+ deallocate(daymleap)
+
+ if ( present(rc) ) rc = ESMF_SUCCESS
+
+ end subroutine ESMF_CalendarDestroy
+
+
+
!==============================================================================
!BOP
! !IROUTINE: ESMF_CalendarInitialized - check if calendar was created
Modified: branches/ocean_projects/gmvar/src/external/esmf_time_f90/ESMF_Stubs.F90
===================================================================
--- branches/ocean_projects/gmvar/src/external/esmf_time_f90/ESMF_Stubs.F90 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/external/esmf_time_f90/ESMF_Stubs.F90 2012-03-15 19:43:17 UTC (rev 1650)
@@ -91,6 +91,8 @@
! NOOP
SUBROUTINE ESMF_Finalize( rc )
USE esmf_basemod
+ USE esmf_calendarmod
+
INTEGER, INTENT( OUT), OPTIONAL :: rc
#if (defined SPMD) || (defined COUP_CSM)
#include <mpif.h>
@@ -98,6 +100,8 @@
LOGICAL :: flag
INTEGER :: ier
+ CALL ESMF_CalendarDestroy()
+
IF ( PRESENT( rc ) ) rc = ESMF_SUCCESS
#if (defined SPMD) || (defined COUP_CSM)
CALL MPI_Finalized( flag, ier )
Modified: branches/ocean_projects/gmvar/src/external/esmf_time_f90/Meat.F90
===================================================================
--- branches/ocean_projects/gmvar/src/external/esmf_time_f90/Meat.F90 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/external/esmf_time_f90/Meat.F90 2012-03-15 19:43:17 UTC (rev 1650)
@@ -169,26 +169,34 @@
! added from share/module_date_time in WRF.
FUNCTION nfeb ( year ) RESULT (num_days)
+ USE ESMF_CalendarMod
+
! Compute the number of days in February for the given year
IMPLICIT NONE
INTEGER :: year
INTEGER :: num_days
-! TBH: TODO: Replace this hack with run-time decision based on
-! TBH: TODO: passed-in calendar.
-#ifdef NO_LEAP_CALENDAR
- num_days = 28 ! By default, February has 28 days ...
-#else
- num_days = 28 ! By default, February has 28 days ...
- IF (MOD(year,4).eq.0) THEN
- num_days = 29 ! But every four years, it has 29 days ...
- IF (MOD(year,100).eq.0) THEN
- num_days = 28 ! Except every 100 years, when it has 28 days ...
- IF (MOD(year,400).eq.0) THEN
- num_days = 29 ! Except every 400 years, when it has 29 days.
+
+ type(ESMF_CalendarType) :: calendarType
+
+ calendarType = ESMF_GetCalendarType()
+
+ IF (calendarType % caltype == ESMF_CAL_NOLEAP % caltype) then
+ num_days = 28
+ ELSE IF (calendarType % caltype == ESMF_CAL_360DAY % caltype) then
+ num_days = 30
+ ELSE
+ num_days = 28 ! By default, February has 28 days ...
+ IF (MOD(year,4).eq.0) THEN
+ num_days = 29 ! But every four years, it has 29 days ...
+ IF (MOD(year,100).eq.0) THEN
+ num_days = 28 ! Except every 100 years, when it has 28 days ...
+ IF (MOD(year,400).eq.0) THEN
+ num_days = 29 ! Except every 400 years, when it has 29 days.
+ END IF
END IF
END IF
END IF
-#endif
+
END FUNCTION nfeb
@@ -206,6 +214,8 @@
#else
IF ( nfeb( year ) .EQ. 29 ) THEN
num_diy = 366
+ ELSE IF ( nfeb( year ) .EQ. 30 ) THEN
+ num_diy = 360
ELSE
num_diy = 365
ENDIF
Modified: branches/ocean_projects/gmvar/src/framework/mpas_configure.F
===================================================================
--- branches/ocean_projects/gmvar/src/framework/mpas_configure.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/framework/mpas_configure.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -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/ocean_projects/gmvar/src/framework/mpas_timekeeping.F
===================================================================
--- branches/ocean_projects/gmvar/src/framework/mpas_timekeeping.F 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/framework/mpas_timekeeping.F 2012-03-15 19:43:17 UTC (rev 1650)
@@ -114,15 +114,16 @@
implicit none
- integer, intent(in) :: calendar
+ character (len=*), intent(in) :: calendar
- TheCalendar = calendar
-
- if (TheCalendar == MPAS_GREGORIAN) then
+ if (trim(calendar) == 'gregorian') then
+ TheCalendar = MPAS_GREGORIAN
call ESMF_Initialize(defaultCalendar=ESMF_CAL_GREGORIAN)
- else if (TheCalendar == MPAS_GREGORIAN_NOLEAP) then
+ else if (trim(calendar) == 'gregorian_noleap') then
+ TheCalendar = MPAS_GREGORIAN_NOLEAP
call ESMF_Initialize(defaultCalendar=ESMF_CAL_NOLEAP)
- else if (TheCalendar == MPAS_360DAY) then
+ else if (trim(calendar) == '360day') then
+ TheCalendar = MPAS_360DAY
call ESMF_Initialize(defaultCalendar=ESMF_CAL_360DAY)
else
write(0,*) 'ERROR: mpas_timekeeping_init: Invalid calendar type'
Modified: branches/ocean_projects/gmvar/src/framework/streams.c
===================================================================
--- branches/ocean_projects/gmvar/src/framework/streams.c 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/framework/streams.c 2012-03-15 19:43:17 UTC (rev 1650)
@@ -18,6 +18,37 @@
{
char fname[128];
+#ifndef MPAS_DEBUG
+ if(*id == 0){
+ sprintf(fname, "log.%4.4i.err", *id);
+ fd_err = open(fname,O_CREAT|O_WRONLY|O_TRUNC,0644);
+ if (dup2(fd_err, 2) < 0) {
+ printf("Error duplicating STDERR</font>
<font color="blue">");
+ return;
+ }
+
+ sprintf(fname, "log.%4.4i.out", *id);
+ fd_out = open(fname,O_CREAT|O_WRONLY|O_TRUNC,0644);
+ if (dup2(fd_out, 1) < 0) {
+ printf("Error duplicating STDOUT</font>
<font color="blue">");
+ return;
+ }
+ } else {
+ sprintf(fname, "/dev/null", *id);
+ fd_err = open(fname,O_CREAT|O_WRONLY|O_TRUNC,0644);
+ if (dup2(fd_err, 2) < 0) {
+ printf("Error duplicating STDERR</font>
<font color="blue">");
+ return;
+ }
+
+ sprintf(fname, "/dev/null", *id);
+ fd_out = open(fname,O_CREAT|O_WRONLY|O_TRUNC,0644);
+ if (dup2(fd_out, 1) < 0) {
+ printf("Error duplicating STDOUT</font>
<font color="gray">");
+ return;
+ }
+ }
+#else
sprintf(fname, "log.%4.4i.err", *id);
fd_err = open(fname,O_CREAT|O_WRONLY|O_TRUNC,0644);
if (dup2(fd_err, 2) < 0) {
@@ -31,6 +62,7 @@
printf("Error duplicating STDOUT</font>
<font color="gray">");
return;
}
+#endif
}
void close_streams()
Modified: branches/ocean_projects/gmvar/src/registry/gen_inc.c
===================================================================
--- branches/ocean_projects/gmvar/src/registry/gen_inc.c 2012-03-15 18:59:24 UTC (rev 1649)
+++ branches/ocean_projects/gmvar/src/registry/gen_inc.c 2012-03-15 19:43:17 UTC (rev 1650)
@@ -125,7 +125,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>