<p><b>dwj07@fsu.edu</b> 2011-10-21 13:22:38 -0600 (Fri, 21 Oct 2011)</p><p><br>
        -- BRANCH COMMIT --<br>
<br>
        Removing stale branch operator_addition.<br>
<br>
        Removing completed branch source_renaming.<br>
<br>
        Creating a new branch source_condensing.<br>
                This branch will be used to remove shared routines between cores, and put them in a global postion to aid in code reuse.<br>
</p><hr noshade><pre><font color="gray">Modified: branches/ocean_projects/performance/Makefile
===================================================================
--- branches/ocean_projects/performance/Makefile        2011-10-21 19:18:00 UTC (rev 1114)
+++ branches/ocean_projects/performance/Makefile        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,3 +1,4 @@
+CORE=ocean
 #MODEL_FORMULATION = -DNCAR_FORMULATION
 MODEL_FORMULATION = -DLANL_FORMULATION
 


Property changes on: branches/ocean_projects/performance/src
___________________________________________________________________
Added: svn:mergeinfo
   + /trunk/mpas/src:753-1099

Modified: branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_coriolis.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_coriolis.F        2011-10-21 19:18:00 UTC (rev 1114)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_coriolis.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -109,6 +109,7 @@
       integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnEdge
       real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge
       real (kind=RKIND), dimension(:), pointer :: dcEdge
+      real (kind=RKIND) :: invLength
 
       integer :: j, k
       integer :: cell1, cell2, nEdgesSolve, iEdge, eoe
@@ -129,6 +130,8 @@
          cell1 = cellsOnEdge(1,iEdge)
          cell2 = cellsOnEdge(2,iEdge)
 
+         invLength = 1.0 / dcEdge(iEdge)
+
          do k=1,maxLevelEdgeTop(iEdge)
 
             q = 0.0
@@ -138,9 +141,7 @@
                q = q + weightsOnEdge(j,iEdge) * u(k,eoe) * workpv * h_edge(k,eoe) 
             end do
 
-           tend(k,iEdge) = tend(k,iEdge)     &amp;
-                  + q     &amp;
-                  - (   ke(k,cell2) - ke(k,cell1) ) / dcEdge(iEdge)
+           tend(k,iEdge) = tend(k,iEdge) + q - (   ke(k,cell2) - ke(k,cell1) ) * invLength
 
          end do
       end do

Deleted: branches/source_condensing/README
===================================================================
--- trunk/mpas/README        2011-10-21 19:18:00 UTC (rev 1114)
+++ branches/source_condensing/README        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,146 +0,0 @@
-swmodel: A 2d shallow water model on a C-grid staggering.
-
-2 Sept 2009 -- Long overdue update to this readme.
-
-21 May 2009 -- Added vertical dimension (currently fixed at 1) and 3d scalar array dimensioned
-                  (nTracers,nVertLevels,nCells).
-               Pushed loop over blocks down into RK4 time integration; now each RK step loops
-                  over blocks, and ghost-cell updates can be performed between steps.
-               Temporary storage for intermediate RK steps is allocated once when a block is created
-               Various other re-arrangements to code.
-
-15 May 2009 -- The &quot;h&quot; field is now consistently treated as fluid thickness.
-               Fixed the computation of &quot;vh&quot;.
-               Added kiteAreasOnVertex and separate fEdge and fVertex fields to input files.
-               Two formulations are now available in module_time_integration.F for computation
-                  of terms in the u tendency equation; either is selectable by suitably defining
-                  MODEL_FORMULATION in the Makefile.
-
-13 May 2009 -- Initial version
-
-
-I. Code layout
-
-   The swmodel is written in Fortran (plus one C routine), with some of the code being generated
-   by a C program called the &quot;registry&quot;. All of the Fortran code for the model is contained in the
-   src/ directory, while the registry program resides in the Registry/ directory. When building the
-   model with the 'make' command, the registry is first compiled in the Registry/ directory; after
-   the registry is built, it is run by make to generate pieces of Fortran code that are included in
-   various hand-written Fortran routines in the src/ directory; these registry-generated pieces of
-   code are placed in the inc/ directory. After running the registry program, the main swmodel code
-   in the src/ directory is compiled, and the final executable, swmodel, is linked into the top-level
-   directory. At present, the only external package needed by the model is the NetCDF library, which 
-   is linked in the swmodel executable. However, if the need arises to build other software libraries 
-   when the swmodel code is built, these packages can be located in the external/ directory.
-   
-   Briefly, the main Fortran source files in the src/ directory are as follows:
-
-         swmodel.F           -- Contains the main program, which essentially calls routines within other 
-                                modules.
-
-         module_block_decomp.F -- Contains code to read a mesh decomposition file to decompose the
-                                model grid into &quot;blocks&quot;, each of which is solved for by a single MPI 
-                                process.
-
-         module_configure.F  -- Contains user-specified configuration information (e.g., model time,
-                                number of timesteps to simulate, interval between writes of model state,
-                                and which shallow water test case to run) that is read from a Fortran 
-                                namelist (namelist.input). The actual variables in the namelist are
-                                defined in the Registry/Registry file, and the code to read these variables
-                                as a namelist is generated by the registry program.
-
-         module_constants.F  -- Contains definitions of constants used at various points in the model
-                                (e.g., radius of the earth, omega, gravity, pi).
-
-         module_dmpar.F      -- Contains routines to perform distributed memory operations, such as
-                                update ghost cells in a block, determine which block owns a list of cells,
-                                and perform collective operations like broadcasts and sums. These operations
-                                are currently implemented using MPI.
-
-         module_grid_types.F -- Contains definitions of derived data types used in the model, as well
-                                as routines for allocating and deallocating each type. The members of
-                                two of the types (grid meta, which contains time-invariant fields, and
-                                grid_state, which contains time-varying fields) are supplied by registry-
-                                generated code, and, therefore, all fields in the model should ultimately
-                                be defined in the Registry/Registry file.
-
-         module_hash.F       -- A simple dictionary/hash table implementation.
-
-         module_io_input.F   -- Contain code for reading grid and model state information from an input
-         module_io_output.F     file (grid.nc or restart.nc) and writing model state to an output file 
-                                (output.nc or restart.nc). Like the fields in module_grid_types, the 
-                                actual code to read or write a particular field is generated by the
-                                registry program at compile time.
-
-         module_sort.F       -- Contains implementations of mergesort, quicksort, and binary search.
-
-         module_sw_solver.F  -- Contains the main solver loop, which advances each block of the domain
-                                forward in time by a specified delta-t and periodically writes model state 
-                                to an output file.
-
-         module_test_cases.F -- Contains routines (one per test case) to initialize the model state for
-                                the particular case specified in the user input (namelist) file.

-         module_time_integration.F -- Contains time integration routine (currently RK4) and a function
-                                to compute the tendencies for prognostic variables given the current 
-                                model state.
-
-         module_timer.F      -- Contains functions to measure the execution time between two points
-                                in the code.
-
-
-II. Building the code
-
-    The swmodel code may be built using the included Makefile, after suitably editing this file to
-    set compiler and compiler flags appropriate to the system. Additionally, the environment
-    variable NETCDF must be set to the path of the NetCDF installation. In the Makefile, the following 
-    should be set:
-
-       FC -- The MPI Fortran compiler if compiling a parallel executable; otherwise, the serial 
-             Fortran compiler.
-
-       CC -- The MPI C compiler if compiling a parallel executable; otherwise, the serial C compiler.
-
-       SFC -- The serial Fortran compiler; the same as $(FC) when compiling a serial executable.
-
-       SCC -- The serial C compiler; the same as $(CC) when compiling a serial executable.
-
-       FFLAGS -- Flags specified to the compiler when compiling Fortran source files; there aren't 
-             any particular flags to be specified, although one might want to add debugging or
-             optimization flags here
-       
-       LDFLAGS -- Flags given when linking the final executable; again, nothing in particular needs
-             to be given here, although debugging and optimization flags can be helpful.
-
-       CPPFLAGS -- These should *not* be changed, since -DRKIND=8 will set the kind of Fortran
-             reals to be 8-bytes, which is necessary for reading the double precision model initial
-             state from the input file, grid.nc. If building a serial executable, -D_MPI should
-             not appear in the definition of CPPFLAGS.
-
-       CPPINCLUDES -- The flags necessary to tell the C preprocessor where to find include/header files.
-
-       FCINCLUDES -- The flags necessary to tell the compiler where to find NetCDF include/header files.
-
-       LIBS -- The flags necessary to tell the compiler where to find NetCDF libraries; typically,
-             these flags must include a flag specifying the path to libraries, as well as flags to
-             link the libraries themselves (either libnetcdf.a, or in some installations, libnetcdff.a
-             and libnetcdf.a)
-
-     
-
-III. Running the code
-
-    After successfully compiling but before running, it will be necessary to have downloaded an input
-    file, and, if the code was compiled for parallel execution, a grid decomposition file. These input
-    files may be downloaded for several grid sizes from http://www.mmm.ucar.edu/people/duda/files/mpas/, 
-    where the name of the tar file indicates the number of grid cells. Once the input files (grid.nc 
-    and graph.info.part.?) have been copied into the top-level directory, the swmodel executable may be 
-    run.
-
-    For a parallel run, a graph.info.part.N file must be present in the run directory, where N is the
-    number of processors to run on; then, the swmodel executable may be run with mpirun, mpiexec, etc.
-
-    For a serial run, no grid decomposition file (i.e., graph.info.part.*) file is necessary. It should
-    be noted that to run the code in serial, the code must not have been compiled with mpif90/mpicc, since
-    no graph.info.part.1 files are available (although one could be trivially generated).
-

Copied: branches/source_condensing/README (from rev 1108, trunk/mpas/README)
===================================================================
--- branches/source_condensing/README                                (rev 0)
+++ branches/source_condensing/README        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,146 @@
+swmodel: A 2d shallow water model on a C-grid staggering.
+
+2 Sept 2009 -- Long overdue update to this readme.
+
+21 May 2009 -- Added vertical dimension (currently fixed at 1) and 3d scalar array dimensioned
+                  (nTracers,nVertLevels,nCells).
+               Pushed loop over blocks down into RK4 time integration; now each RK step loops
+                  over blocks, and ghost-cell updates can be performed between steps.
+               Temporary storage for intermediate RK steps is allocated once when a block is created
+               Various other re-arrangements to code.
+
+15 May 2009 -- The &quot;h&quot; field is now consistently treated as fluid thickness.
+               Fixed the computation of &quot;vh&quot;.
+               Added kiteAreasOnVertex and separate fEdge and fVertex fields to input files.
+               Two formulations are now available in module_time_integration.F for computation
+                  of terms in the u tendency equation; either is selectable by suitably defining
+                  MODEL_FORMULATION in the Makefile.
+
+13 May 2009 -- Initial version
+
+
+I. Code layout
+
+   The swmodel is written in Fortran (plus one C routine), with some of the code being generated
+   by a C program called the &quot;registry&quot;. All of the Fortran code for the model is contained in the
+   src/ directory, while the registry program resides in the Registry/ directory. When building the
+   model with the 'make' command, the registry is first compiled in the Registry/ directory; after
+   the registry is built, it is run by make to generate pieces of Fortran code that are included in
+   various hand-written Fortran routines in the src/ directory; these registry-generated pieces of
+   code are placed in the inc/ directory. After running the registry program, the main swmodel code
+   in the src/ directory is compiled, and the final executable, swmodel, is linked into the top-level
+   directory. At present, the only external package needed by the model is the NetCDF library, which 
+   is linked in the swmodel executable. However, if the need arises to build other software libraries 
+   when the swmodel code is built, these packages can be located in the external/ directory.
+   
+   Briefly, the main Fortran source files in the src/ directory are as follows:
+
+         swmodel.F           -- Contains the main program, which essentially calls routines within other 
+                                modules.
+
+         module_block_decomp.F -- Contains code to read a mesh decomposition file to decompose the
+                                model grid into &quot;blocks&quot;, each of which is solved for by a single MPI 
+                                process.
+
+         module_configure.F  -- Contains user-specified configuration information (e.g., model time,
+                                number of timesteps to simulate, interval between writes of model state,
+                                and which shallow water test case to run) that is read from a Fortran 
+                                namelist (namelist.input). The actual variables in the namelist are
+                                defined in the Registry/Registry file, and the code to read these variables
+                                as a namelist is generated by the registry program.
+
+         module_constants.F  -- Contains definitions of constants used at various points in the model
+                                (e.g., radius of the earth, omega, gravity, pi).
+
+         module_dmpar.F      -- Contains routines to perform distributed memory operations, such as
+                                update ghost cells in a block, determine which block owns a list of cells,
+                                and perform collective operations like broadcasts and sums. These operations
+                                are currently implemented using MPI.
+
+         module_grid_types.F -- Contains definitions of derived data types used in the model, as well
+                                as routines for allocating and deallocating each type. The members of
+                                two of the types (grid meta, which contains time-invariant fields, and
+                                grid_state, which contains time-varying fields) are supplied by registry-
+                                generated code, and, therefore, all fields in the model should ultimately
+                                be defined in the Registry/Registry file.
+
+         module_hash.F       -- A simple dictionary/hash table implementation.
+
+         module_io_input.F   -- Contain code for reading grid and model state information from an input
+         module_io_output.F     file (grid.nc or restart.nc) and writing model state to an output file 
+                                (output.nc or restart.nc). Like the fields in module_grid_types, the 
+                                actual code to read or write a particular field is generated by the
+                                registry program at compile time.
+
+         module_sort.F       -- Contains implementations of mergesort, quicksort, and binary search.
+
+         module_sw_solver.F  -- Contains the main solver loop, which advances each block of the domain
+                                forward in time by a specified delta-t and periodically writes model state 
+                                to an output file.
+
+         module_test_cases.F -- Contains routines (one per test case) to initialize the model state for
+                                the particular case specified in the user input (namelist) file.

+         module_time_integration.F -- Contains time integration routine (currently RK4) and a function
+                                to compute the tendencies for prognostic variables given the current 
+                                model state.
+
+         module_timer.F      -- Contains functions to measure the execution time between two points
+                                in the code.
+
+
+II. Building the code
+
+    The swmodel code may be built using the included Makefile, after suitably editing this file to
+    set compiler and compiler flags appropriate to the system. Additionally, the environment
+    variable NETCDF must be set to the path of the NetCDF installation. In the Makefile, the following 
+    should be set:
+
+       FC -- The MPI Fortran compiler if compiling a parallel executable; otherwise, the serial 
+             Fortran compiler.
+
+       CC -- The MPI C compiler if compiling a parallel executable; otherwise, the serial C compiler.
+
+       SFC -- The serial Fortran compiler; the same as $(FC) when compiling a serial executable.
+
+       SCC -- The serial C compiler; the same as $(CC) when compiling a serial executable.
+
+       FFLAGS -- Flags specified to the compiler when compiling Fortran source files; there aren't 
+             any particular flags to be specified, although one might want to add debugging or
+             optimization flags here
+       
+       LDFLAGS -- Flags given when linking the final executable; again, nothing in particular needs
+             to be given here, although debugging and optimization flags can be helpful.
+
+       CPPFLAGS -- These should *not* be changed, since -DRKIND=8 will set the kind of Fortran
+             reals to be 8-bytes, which is necessary for reading the double precision model initial
+             state from the input file, grid.nc. If building a serial executable, -D_MPI should
+             not appear in the definition of CPPFLAGS.
+
+       CPPINCLUDES -- The flags necessary to tell the C preprocessor where to find include/header files.
+
+       FCINCLUDES -- The flags necessary to tell the compiler where to find NetCDF include/header files.
+
+       LIBS -- The flags necessary to tell the compiler where to find NetCDF libraries; typically,
+             these flags must include a flag specifying the path to libraries, as well as flags to
+             link the libraries themselves (either libnetcdf.a, or in some installations, libnetcdff.a
+             and libnetcdf.a)
+
+     
+
+III. Running the code
+
+    After successfully compiling but before running, it will be necessary to have downloaded an input
+    file, and, if the code was compiled for parallel execution, a grid decomposition file. These input
+    files may be downloaded for several grid sizes from http://www.mmm.ucar.edu/people/duda/files/mpas/, 
+    where the name of the tar file indicates the number of grid cells. Once the input files (grid.nc 
+    and graph.info.part.?) have been copied into the top-level directory, the swmodel executable may be 
+    run.
+
+    For a parallel run, a graph.info.part.N file must be present in the run directory, where N is the
+    number of processors to run on; then, the swmodel executable may be run with mpirun, mpiexec, etc.
+
+    For a serial run, no grid decomposition file (i.e., graph.info.part.*) file is necessary. It should
+    be noted that to run the code in serial, the code must not have been compiled with mpif90/mpicc, since
+    no graph.info.part.1 files are available (although one could be trivially generated).
+

Deleted: branches/source_condensing/namelist.input
===================================================================
--- trunk/mpas/namelist.input        2011-10-21 19:18:00 UTC (rev 1114)
+++ branches/source_condensing/namelist.input        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1 +0,0 @@
-link namelist.input.sw
\ No newline at end of file

Copied: branches/source_condensing/namelist.input (from rev 1108, trunk/mpas/namelist.input)
===================================================================
--- branches/source_condensing/namelist.input                                (rev 0)
+++ branches/source_condensing/namelist.input        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1 @@
+link namelist.input.sw
\ No newline at end of file

Deleted: branches/source_condensing/namelist.input.hyd_atmos
===================================================================
--- trunk/mpas/namelist.input.hyd_atmos        2011-10-21 19:18:00 UTC (rev 1114)
+++ branches/source_condensing/namelist.input.hyd_atmos        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,34 +0,0 @@
-&amp;sw_model
-   config_test_case = 2
-   config_time_integration = 'SRK3'
-   config_dt = 3600
-   config_start_time = '0000-01-01_00:00:00'
-   config_run_duration = '10_00:00:00'
-   config_number_of_sub_steps = 4
-   config_h_mom_eddy_visc2 = 0.0
-   config_h_mom_eddy_visc4 = 0.0
-   config_v_mom_eddy_visc2 = 0.0
-   config_h_theta_eddy_visc2 = 0.0
-   config_h_theta_eddy_visc4 = 0.0
-   config_v_theta_eddy_visc2 = 0.0
-   config_theta_adv_order = 2
-   config_scalar_adv_order = 2
-   config_mp_physics = 0
-/
-
-&amp;dimensions
-   config_nvertlevels = 26
-/
-
-&amp;io
-   config_input_name = 'grid.nc'
-   config_output_name = 'output.nc'
-   config_restart_name = 'restart.nc'
-   config_output_interval = '1_00:00:00'
-   config_frames_per_outfile = 0
-/
-
-&amp;restart
-   config_restart_interval = '1000_00:00:00'
-   config_do_restart = .false.
-/

Copied: branches/source_condensing/namelist.input.hyd_atmos (from rev 1108, trunk/mpas/namelist.input.hyd_atmos)
===================================================================
--- branches/source_condensing/namelist.input.hyd_atmos                                (rev 0)
+++ branches/source_condensing/namelist.input.hyd_atmos        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,34 @@
+&amp;sw_model
+   config_test_case = 2
+   config_time_integration = 'SRK3'
+   config_dt = 3600
+   config_start_time = '0000-01-01_00:00:00'
+   config_run_duration = '10_00:00:00'
+   config_number_of_sub_steps = 4
+   config_h_mom_eddy_visc2 = 0.0
+   config_h_mom_eddy_visc4 = 0.0
+   config_v_mom_eddy_visc2 = 0.0
+   config_h_theta_eddy_visc2 = 0.0
+   config_h_theta_eddy_visc4 = 0.0
+   config_v_theta_eddy_visc2 = 0.0
+   config_theta_adv_order = 2
+   config_scalar_adv_order = 2
+   config_mp_physics = 0
+/
+
+&amp;dimensions
+   config_nvertlevels = 26
+/
+
+&amp;io
+   config_input_name = 'grid.nc'
+   config_output_name = 'output.nc'
+   config_restart_name = 'restart.nc'
+   config_output_interval = '1_00:00:00'
+   config_frames_per_outfile = 0
+/
+
+&amp;restart
+   config_restart_interval = '1000_00:00:00'
+   config_do_restart = .false.
+/

Deleted: branches/source_condensing/src/core_hyd_atmos/Makefile
===================================================================
--- trunk/mpas/src/core_hyd_atmos/Makefile        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_hyd_atmos/Makefile        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,27 +0,0 @@
-.SUFFIXES: .F .o
-
-OBJS = module_mpas_core.o \
-       module_test_cases.o \
-       module_time_integration.o \
-       module_advection.o
-
-all: core_hyd
-
-core_hyd: $(OBJS)
-        ar -ru libdycore.a $(OBJS)
-
-module_test_cases.o: 
-
-module_time_integration.o: 
-
-module_advection.o: 
-
-module_mpas_core.o: module_advection.o module_test_cases.o module_time_integration.o
-
-clean:
-        $(RM) *.o *.mod *.f90 libdycore.a
-
-.F.o:
-        $(RM) $@ $*.mod
-        $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $&lt; &gt; $*.f90
-        $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework -I../operators -I../external/esmf_time_f90

Copied: branches/source_condensing/src/core_hyd_atmos/Makefile (from rev 1114, trunk/mpas/src/core_hyd_atmos/Makefile)
===================================================================
--- branches/source_condensing/src/core_hyd_atmos/Makefile                                (rev 0)
+++ branches/source_condensing/src/core_hyd_atmos/Makefile        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,27 @@
+.SUFFIXES: .F .o
+
+OBJS = mpas_atmh_mpas_core.o \
+       mpas_atmh_test_cases.o \
+       mpas_atmh_time_integration.o \
+       mpas_atmh_advection.o
+
+all: core_hyd
+
+core_hyd: $(OBJS)
+        ar -ru libdycore.a $(OBJS)
+
+mpas_atmh_test_cases.o: 
+
+mpas_atmh_time_integration.o: 
+
+mpas_atmh_advection.o: 
+
+mpas_atmh_mpas_core.o: mpas_atmh_advection.o mpas_atmh_test_cases.o mpas_atmh_time_integration.o
+
+clean:
+        $(RM) *.o *.mod *.f90 libdycore.a
+
+.F.o:
+        $(RM) $@ $*.mod
+        $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $&lt; &gt; $*.f90
+        $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework -I../operators -I../external/esmf_time_f90

Deleted: branches/source_condensing/src/core_hyd_atmos/module_advection.F
===================================================================
--- trunk/mpas/src/core_hyd_atmos/module_advection.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_hyd_atmos/module_advection.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,688 +0,0 @@
-module advection
-
-   use grid_types
-   use configure
-   use constants
-
-
-   contains
-
-
-   subroutine initialize_advection_rk( grid )
-                                      
-!
-! compute the cell coefficients for the polynomial fit.
-! this is performed during setup for model integration.
-! WCS, 31 August 2009
-!
-      implicit none
-
-      type (mesh_type), intent(in) :: grid
-
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      integer, dimension(:,:), pointer :: advCells
-
-!  local variables
-
-      real (kind=RKIND), dimension(2, grid % nEdges) :: thetae
-      real (kind=RKIND), dimension(grid % nEdges) :: xe, ye
-      real (kind=RKIND), dimension(grid % nCells) :: theta_abs
-
-      real (kind=RKIND), dimension(25) :: xc, yc, zc ! cell center coordinates
-      real (kind=RKIND), dimension(25) :: thetav, thetat, dl_sphere
-      real (kind=RKIND) :: xm, ym, zm, dl, xec, yec, zec
-      real (kind=RKIND) :: thetae_tmp, xe_tmp, ye_tmp
-      real (kind=RKIND) :: xv1, xv2, yv1, yv2, zv1, zv2
-      integer :: i, j, k, ip1, ip2, m, n, ip1a, ii
-      integer :: iCell, iEdge
-      real (kind=RKIND) :: pii
-      real (kind=RKIND) :: x0, y0, x1, y1, x2, y2, x3, y3, x4, y4, x5, y5
-      real (kind=RKIND) :: pdx1, pdx2, pdx3, pdy1, pdy2, pdy3, dx1, dx2, dy1, dy2
-      real (kind=RKIND) :: angv1, angv2, dl1, dl2
-      real (kind=RKIND), dimension(25) :: dxe, dye, x2v, y2v, xp, yp
-      
-      real (kind=RKIND) :: amatrix(25,25), bmatrix(25,25), wmatrix(25,25)
-      real (kind=RKIND) :: length_scale
-      integer :: ma,na, cell_add, mw, nn
-      integer, dimension(25) :: cell_list
-
-
-      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
-
-      logical, parameter :: reset_poly = .true.
-
-      real (kind=RKIND) :: rcell, cos2t, costsint, sin2t
-
-!---
-
-      pii = 2.*asin(1.0)
-
-      advCells =&gt; grid % advCells % array
-      deriv_two =&gt; grid % deriv_two % array
-      deriv_two(:,:,:) = 0.
-
-      do iCell = 1, grid % nCells !  is this correct? - we need first halo cell also...
-
-         cell_list(1) = iCell
-         do i=2, grid % nEdgesOnCell % array(iCell)+1
-            cell_list(i) = grid % CellsOnCell % array(i-1,iCell)
-         end do
-         n = grid % nEdgesOnCell % array(iCell) + 1
-
-         if ( polynomial_order &gt; 2 ) then
-            do i=2,grid % nEdgesOnCell % array(iCell) + 1
-               do j=1,grid % nEdgesOnCell % array ( cell_list(i) )
-                  cell_add = grid % CellsOnCell % array (j,cell_list(i))
-                  add_the_cell = .true.
-                  do k=1,n
-                     if ( cell_add == cell_list(k) ) add_the_cell = .false.
-                  end do
-                  if (add_the_cell) then
-                     n = n+1
-                     cell_list(n) = cell_add
-                  end if
-               end do
-            end do
-         end if

-         advCells(1,iCell) = n
-
-!  check to see if we are reaching outside the halo
-
-         do_the_cell = .true.
-         do i=1,n
-            if (cell_list(i) &gt; grid % nCells) do_the_cell = .false.
-         end do
-
-
-         if ( .not. do_the_cell ) cycle
-
-
-!  compute poynomial fit for this cell if all needed neighbors exist
-         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
-            end do
-
-            theta_abs(iCell) =  pii/2. - sphere_angle( xc(1), yc(1), zc(1),  &amp;
-                                                       xc(2), yc(2), zc(2),  &amp;
-                                                       0.,    0.,    1.      ) 
-
-! angles from cell center to neighbor centers (thetav)
-
-            do i=1,n-1
-   
-               ip2 = i+2
-               if (ip2 &gt; n) ip2 = 2
-    
-               thetav(i) = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
-                                         xc(i+1), yc(i+1), zc(i+1),  &amp;
-                                         xc(ip2), yc(ip2), zc(ip2)   )
-
-               dl_sphere(i) = a*arc_length( xc(1),   yc(1),   zc(1),  &amp;
-                                            xc(i+1), yc(i+1), zc(i+1) )
-            end do
-
-            length_scale = 1.
-            do i=1,n-1
-               dl_sphere(i) = dl_sphere(i)/length_scale
-            end do
-
-!            thetat(1) = 0.  !  this defines the x direction, cell center 1 -&gt; 
-            thetat(1) = theta_abs(iCell)  !  this defines the x direction, longitude line
-            do i=2,n-1
-               thetat(i) = thetat(i-1) + thetav(i-1)
-            end do
-   
-            do i=1,n-1
-               xp(i) = cos(thetat(i)) * dl_sphere(i)
-               yp(i) = sin(thetat(i)) * dl_sphere(i)
-            end do
-
-         else     ! On an x-y plane
-
-            do i=1,n-1
-               xp(i) = grid % xCell % array(cell_list(i)) - grid % xCell % array(iCell)
-               yp(i) = grid % yCell % array(cell_list(i)) - grid % yCell % array(iCell)
-            end do
-
-         end if
-
-
-         ma = n-1
-         mw = grid % nEdgesOnCell % array (iCell)
-
-         bmatrix = 0.
-         amatrix = 0.
-         wmatrix = 0.
-
-         if (polynomial_order == 2) then
-            na = 6
-            ma = ma+1
-  
-            amatrix(1,1) = 1.
-            wmatrix(1,1) = 1.
-            do i=2,ma
-               amatrix(i,1) = 1.
-               amatrix(i,2) = xp(i-1)
-               amatrix(i,3) = yp(i-1)
-               amatrix(i,4) = xp(i-1)**2
-               amatrix(i,5) = xp(i-1) * yp(i-1)
-               amatrix(i,6) = yp(i-1)**2
-   
-               wmatrix(i,i) = 1.
-            end do

-         else if (polynomial_order == 3) then
-            na = 10
-            ma = ma+1
-  
-            amatrix(1,1) = 1.
-            wmatrix(1,1) = 1.
-            do i=2,ma
-               amatrix(i,1) = 1.
-               amatrix(i,2) = xp(i-1)
-               amatrix(i,3) = yp(i-1)
-   
-               amatrix(i,4) = xp(i-1)**2
-               amatrix(i,5) = xp(i-1) * yp(i-1)
-               amatrix(i,6) = yp(i-1)**2
-   
-               amatrix(i,7) = xp(i-1)**3
-               amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
-               amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
-               amatrix(i,10) = yp(i-1)**3
-   
-               wmatrix(i,i) = 1.

-            end do
-
-         else
-            na = 15
-            ma = ma+1
-  
-            amatrix(1,1) = 1.
-            wmatrix(1,1) = 1.
-            do i=2,ma
-               amatrix(i,1) = 1.
-               amatrix(i,2) = xp(i-1)
-               amatrix(i,3) = yp(i-1)
-   
-               amatrix(i,4) = xp(i-1)**2
-               amatrix(i,5) = xp(i-1) * yp(i-1)
-               amatrix(i,6) = yp(i-1)**2
-   
-               amatrix(i,7) = xp(i-1)**3
-               amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
-               amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
-               amatrix(i,10) = yp(i-1)**3
-   
-               amatrix(i,11) = xp(i-1)**4
-               amatrix(i,12) = yp(i-1) * (xp(i-1)**3)
-               amatrix(i,13) = (xp(i-1)**2)*(yp(i-1)**2)
-               amatrix(i,14) = xp(i-1) * (yp(i-1)**3)
-               amatrix(i,15) = yp(i-1)**4
-   
-               wmatrix(i,i) = 1.
-  
-            end do

-            do i=1,mw
-               wmatrix(i,i) = 1.
-            end do

-         end if

-         call poly_fit_2( amatrix, bmatrix, wmatrix, ma, na, 25 )
-
-         do i=1,grid % nEdgesOnCell % array (iCell)
-            ip1 = i+1
-            if (ip1 &gt; n-1) ip1 = 1
-  
-            iEdge = grid % EdgesOnCell % array (i,iCell)
-            xv1 = grid % xVertex % array(grid % verticesOnEdge % array (1,iedge))/a
-            yv1 = grid % yVertex % array(grid % verticesOnEdge % array (1,iedge))/a
-            zv1 = grid % zVertex % array(grid % verticesOnEdge % array (1,iedge))/a
-            xv2 = grid % xVertex % array(grid % verticesOnEdge % array (2,iedge))/a
-            yv2 = grid % yVertex % array(grid % verticesOnEdge % array (2,iedge))/a
-            zv2 = grid % zVertex % array(grid % verticesOnEdge % array (2,iedge))/a
-  
-            if ( grid % on_a_sphere ) then
-               call arc_bisect( xv1, yv1, zv1,  &amp;
-                                xv2, yv2, zv2,  &amp;
-                                xec, yec, zec   )
-  
-               thetae_tmp = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
-                                          xc(i+1), yc(i+1), zc(i+1),  &amp;
-                                          xec,     yec,     zec       )
-               thetae_tmp = thetae_tmp + thetat(i)
-               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
-                  thetae(1,grid % EdgesOnCell % array (i,iCell)) = thetae_tmp
-               else
-                  thetae(2,grid % EdgesOnCell % array (i,iCell)) = thetae_tmp
-               end if
-            else
-               xe(grid % EdgesOnCell % array (i,iCell)) = 0.5 * (xv1 + xv2)
-               ye(grid % EdgesOnCell % array (i,iCell)) = 0.5 * (yv1 + yv2)
-            end if
-  
-         end do
-
-!  fill second derivative stencil for rk advection 
-
-         do i=1, grid % nEdgesOnCell % array (iCell)
-            iEdge = grid % EdgesOnCell % array (i,iCell)
-  
-  
-            if ( grid % on_a_sphere ) then
-               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
-  
-                  cos2t = cos(thetae(1,grid % EdgesOnCell % array (i,iCell)))
-                  sin2t = sin(thetae(1,grid % EdgesOnCell % array (i,iCell)))
-                  costsint = cos2t*sin2t
-                  cos2t = cos2t**2
-                  sin2t = sin2t**2
-   
-                  do j=1,n
-                     deriv_two(j,1,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
-                                            + 2.*costsint*bmatrix(5,j)  &amp;
-                                            + 2.*sin2t*bmatrix(6,j)
-                  end do
-               else
-     
-                  cos2t = cos(thetae(2,grid % EdgesOnCell % array (i,iCell)))
-                  sin2t = sin(thetae(2,grid % EdgesOnCell % array (i,iCell)))
-                  costsint = cos2t*sin2t
-                  cos2t = cos2t**2
-                  sin2t = sin2t**2
-      
-                  do j=1,n
-                     deriv_two(j,2,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
-                                            + 2.*costsint*bmatrix(5,j)  &amp;
-                                            + 2.*sin2t*bmatrix(6,j)
-                  end do
-               end if
-            else
-               do j=1,n
-                  deriv_two(j,1,iEdge) =   2.*xe(iEdge)*xe(iEdge)*bmatrix(4,j)  &amp;
-                                         + 2.*xe(iEdge)*ye(iEdge)*bmatrix(5,j)  &amp;
-                                         + 2.*ye(iEdge)*ye(iEdge)*bmatrix(6,j)
-                  deriv_two(j,2,iEdge) = deriv_two(j,1,iEdge)
-               end do
-            end if
-         end do

-      end do ! end of loop over cells
-
-      if (debug) stop
-
-   end subroutine initialize_advection_rk
-
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! FUNCTION SPHERE_ANGLE
-   !
-   ! Computes the angle between arcs AB and AC, given points A, B, and C
-   ! Equation numbers w.r.t. http://mathworld.wolfram.com/SphericalTrigonometry.html
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   real function sphere_angle(ax, ay, az, bx, by, bz, cx, cy, cz)
-   
-      implicit none
-   
-      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz, cx, cy, cz
-   
-      real (kind=RKIND) :: a, b, c          ! Side lengths of spherical triangle ABC
-   
-      real (kind=RKIND) :: ABx, ABy, ABz    ! The components of the vector AB
-      real (kind=RKIND) :: mAB              ! The magnitude of AB
-      real (kind=RKIND) :: ACx, ACy, ACz    ! The components of the vector AC
-      real (kind=RKIND) :: mAC              ! The magnitude of AC
-   
-      real (kind=RKIND) :: Dx               ! The i-components of the cross product AB x AC
-      real (kind=RKIND) :: Dy               ! The j-components of the cross product AB x AC
-      real (kind=RKIND) :: Dz               ! The k-components of the cross product AB x AC
-   
-      real (kind=RKIND) :: s                ! Semiperimeter of the triangle
-      real (kind=RKIND) :: sin_angle
-   
-      a = acos(max(min(bx*cx + by*cy + bz*cz,1.0),-1.0))      ! Eqn. (3)
-      b = acos(max(min(ax*cx + ay*cy + az*cz,1.0),-1.0))      ! Eqn. (2)
-      c = acos(max(min(ax*bx + ay*by + az*bz,1.0),-1.0))      ! Eqn. (1)
-   
-      ABx = bx - ax
-      ABy = by - ay
-      ABz = bz - az
-   
-      ACx = cx - ax
-      ACy = cy - ay
-      ACz = cz - az
-   
-      Dx =   (ABy * ACz) - (ABz * ACy)
-      Dy = -((ABx * ACz) - (ABz * ACx))
-      Dz =   (ABx * ACy) - (ABy * ACx)
-   
-      s = 0.5*(a + b + c)
-!      sin_angle = sqrt((sin(s-b)*sin(s-c))/(sin(b)*sin(c)))   ! Eqn. (28)
-      sin_angle = sqrt(min(1.,max(0.,(sin(s-b)*sin(s-c))/(sin(b)*sin(c)))))   ! Eqn. (28)
-   
-      if ((Dx*ax + Dy*ay + Dz*az) &gt;= 0.0) then
-         sphere_angle =  2.0 * asin(max(min(sin_angle,1.0),-1.0))
-      else
-         sphere_angle = -2.0 * asin(max(min(sin_angle,1.0),-1.0))
-      end if
-   
-   end function sphere_angle
-   
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! FUNCTION PLANE_ANGLE
-   !
-   ! Computes the angle between vectors AB and AC, given points A, B, and C, and
-   !   a vector (u,v,w) normal to the plane.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   real function plane_angle(ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w)
-   
-      implicit none
-   
-      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w
-   
-      real (kind=RKIND) :: ABx, ABy, ABz    ! The components of the vector AB
-      real (kind=RKIND) :: mAB              ! The magnitude of AB
-      real (kind=RKIND) :: ACx, ACy, ACz    ! The components of the vector AC
-      real (kind=RKIND) :: mAC              ! The magnitude of AC
-   
-      real (kind=RKIND) :: Dx               ! The i-components of the cross product AB x AC
-      real (kind=RKIND) :: Dy               ! The j-components of the cross product AB x AC
-      real (kind=RKIND) :: Dz               ! The k-components of the cross product AB x AC
-   
-      real (kind=RKIND) :: cos_angle
-   
-      ABx = bx - ax
-      ABy = by - ay
-      ABz = bz - az
-      mAB = sqrt(ABx**2.0 + ABy**2.0 + ABz**2.0)
-   
-      ACx = cx - ax
-      ACy = cy - ay
-      ACz = cz - az
-      mAC = sqrt(ACx**2.0 + ACy**2.0 + ACz**2.0)
-   
-   
-      Dx =   (ABy * ACz) - (ABz * ACy)
-      Dy = -((ABx * ACz) - (ABz * ACx))
-      Dz =   (ABx * ACy) - (ABy * ACx)
-   
-      cos_angle = (ABx*ACx + ABy*ACy + ABz*ACz) / (mAB * mAC)
-   
-      if ((Dx*u + Dy*v + Dz*w) &gt;= 0.0) then
-         plane_angle =  acos(max(min(cos_angle,1.0),-1.0))
-      else
-         plane_angle = -acos(max(min(cos_angle,1.0),-1.0))
-      end if
-   
-   end function plane_angle
-
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! FUNCTION ARC_LENGTH
-   !
-   ! Returns the length of the great circle arc from A=(ax, ay, az) to 
-   !    B=(bx, by, bz). It is assumed that both A and B lie on the surface of the
-   !    same sphere centered at the origin.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   real function arc_length(ax, ay, az, bx, by, bz)
-   
-      implicit none
-   
-      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz
-   
-      real (kind=RKIND) :: r, c
-      real (kind=RKIND) :: cx, cy, cz
-   
-      cx = bx - ax
-      cy = by - ay
-      cz = bz - az
-
-!      r = ax*ax + ay*ay + az*az
-!      c = cx*cx + cy*cy + cz*cz
-!
-!      arc_length = sqrt(r) * acos(1.0 - c/(2.0*r))
-
-      r = sqrt(ax*ax + ay*ay + az*az)
-      c = sqrt(cx*cx + cy*cy + cz*cz)
-!      arc_length = sqrt(r) * 2.0 * asin(c/(2.0*r))
-      arc_length = r * 2.0 * asin(c/(2.0*r))
-
-   end function arc_length
-   
-   
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! SUBROUTINE ARC_BISECT
-   !
-   ! Returns the point C=(cx, cy, cz) that bisects the great circle arc from
-   !   A=(ax, ay, az) to B=(bx, by, bz). It is assumed that A and B lie on the
-   !   surface of a sphere centered at the origin.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   subroutine arc_bisect(ax, ay, az, bx, by, bz, cx, cy, cz)
-   
-      implicit none
-   
-      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz
-      real (kind=RKIND), intent(out) :: cx, cy, cz
-   
-      real (kind=RKIND) :: r           ! Radius of the sphere
-      real (kind=RKIND) :: d           
-   
-      r = sqrt(ax*ax + ay*ay + az*az)
-   
-      cx = 0.5*(ax + bx)
-      cy = 0.5*(ay + by)
-      cz = 0.5*(az + bz)
-   
-      if (cx == 0. .and. cy == 0. .and. cz == 0.) then
-         write(0,*) 'Error: arc_bisect: A and B are diametrically opposite'
-      else
-         d = sqrt(cx*cx + cy*cy + cz*cz)
-         cx = r * cx / d
-         cy = r * cy / d
-         cz = r * cz / d
-      end if
-   
-   end subroutine arc_bisect
-
-
-   subroutine poly_fit_2(a_in,b_out,weights_in,m,n,ne)
-
-      implicit none
-
-      integer, intent(in) :: m,n,ne
-      real (kind=RKIND), dimension(ne,ne), intent(in) :: a_in, weights_in
-      real (kind=RKIND), dimension(ne,ne), intent(out) :: b_out
-   
-      ! local storage
-   
-      real (kind=RKIND), dimension(m,n)  :: a
-      real (kind=RKIND), dimension(n,m)  :: b
-      real (kind=RKIND), dimension(m,m)  :: w,wt,h
-      real (kind=RKIND), dimension(n,m)  :: at, ath
-      real (kind=RKIND), dimension(n,n)  :: ata, ata_inv, atha, atha_inv
-      integer, dimension(n) :: indx
-      integer :: i,j
-   
-      if ( (ne&lt;n) .or. (ne&lt;m) ) then
-         write(6,*) ' error in poly_fit_2 inversion ',m,n,ne
-         stop
-      end if
-   
-!      a(1:m,1:n) = a_in(1:n,1:m) 
-      a(1:m,1:n) = a_in(1:m,1:n)
-      w(1:m,1:m) = weights_in(1:m,1:m) 
-      b_out(:,:) = 0.   
-
-      wt = transpose(w)
-      h = matmul(wt,w)
-      at = transpose(a)
-      ath = matmul(at,h)
-      atha = matmul(ath,a)
-      
-      ata = matmul(at,a)
-
-!      if (m == n) then
-!         call migs(a,n,b,indx)
-!      else
-
-         call migs(atha,n,atha_inv,indx)
-
-         b = matmul(atha_inv,ath)
-
-!         call migs(ata,n,ata_inv,indx)
-!         b = matmul(ata_inv,at)
-!      end if
-      b_out(1:n,1:m) = b(1:n,1:m)
-
-!     do i=1,n
-!        write(6,*) ' i, indx ',i,indx(i)
-!     end do
-!
-!     write(6,*) ' '
-
-   end subroutine poly_fit_2
-
-
-! Updated 10/24/2001.
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!   Program 4.4   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!                                                                       !
-! Please Note:                                                          !
-!                                                                       !
-! (1) This computer program is written by Tao Pang in conjunction with  !
-!     his book, &quot;An Introduction to Computational Physics,&quot; published   !
-!     by Cambridge University Press in 1997.                            !
-!                                                                       !
-! (2) No warranties, express or implied, are made for this program.     !
-!                                                                       !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-SUBROUTINE MIGS (A,N,X,INDX)
-!
-! Subroutine to invert matrix A(N,N) with the inverse stored
-! in X(N,N) in the output.  Copyright (c) Tao Pang 2001.
-!
-  IMPLICIT NONE
-  INTEGER, INTENT (IN) :: N
-  INTEGER :: I,J,K
-  INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
-  REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N):: A
-  REAL (kind=RKIND), INTENT (OUT), DIMENSION (N,N):: X
-  REAL (kind=RKIND), DIMENSION (N,N) :: B
-!
-  DO I = 1, N
-    DO J = 1, N
-      B(I,J) = 0.0
-    END DO
-  END DO
-  DO I = 1, N
-    B(I,I) = 1.0
-  END DO
-!
-  CALL ELGS (A,N,INDX)
-!
-  DO I = 1, N-1
-    DO J = I+1, N
-      DO K = 1, N
-        B(INDX(J),K) = B(INDX(J),K)-A(INDX(J),I)*B(INDX(I),K)
-      END DO
-    END DO
-  END DO
-!
-  DO I = 1, N
-    X(N,I) = B(INDX(N),I)/A(INDX(N),N)
-    DO J = N-1, 1, -1
-      X(J,I) = B(INDX(J),I)
-      DO K = J+1, N
-        X(J,I) = X(J,I)-A(INDX(J),K)*X(K,I)
-      END DO
-      X(J,I) =  X(J,I)/A(INDX(J),J)
-    END DO
-  END DO
-END SUBROUTINE MIGS
-
-
-SUBROUTINE ELGS (A,N,INDX)
-!
-! Subroutine to perform the partial-pivoting Gaussian elimination.
-! A(N,N) is the original matrix in the input and transformed matrix
-! plus the pivoting element ratios below the diagonal in the output.
-! INDX(N) records the pivoting order.  Copyright (c) Tao Pang 2001.
-!
-  IMPLICIT NONE
-  INTEGER, INTENT (IN) :: N
-  INTEGER :: I,J,K,ITMP
-  INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
-  REAL (kind=RKIND) :: C1,PI,PI1,PJ
-  REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
-  REAL (kind=RKIND), DIMENSION (N) :: C
-!
-! Initialize the index
-!
-  DO I = 1, N
-    INDX(I) = I
-  END DO
-!
-! Find the rescaling factors, one from each row
-!
-  DO I = 1, N
-    C1= 0.0
-    DO J = 1, N
-      C1 = AMAX1(C1,ABS(A(I,J)))
-    END DO
-    C(I) = C1
-  END DO
-!
-! Search the pivoting (largest) element from each column
-!
-  DO J = 1, N-1
-    PI1 = 0.0
-    DO I = J, N
-      PI = ABS(A(INDX(I),J))/C(INDX(I))
-      IF (PI.GT.PI1) THEN
-        PI1 = PI
-        K   = I
-      ENDIF
-    END DO
-!
-! Interchange the rows via INDX(N) to record pivoting order
-!
-    ITMP    = INDX(J)
-    INDX(J) = INDX(K)
-    INDX(K) = ITMP
-    DO I = J+1, N
-      PJ  = A(INDX(I),J)/A(INDX(J),J)
-!
-! Record pivoting ratios below the diagonal
-!
-      A(INDX(I),J) = PJ
-!
-! Modify other elements accordingly
-!
-      DO K = J+1, N
-        A(INDX(I),K) = A(INDX(I),K)-PJ*A(INDX(J),K)
-      END DO
-    END DO
-  END DO
-!
-END SUBROUTINE ELGS
-
-end module advection

Deleted: branches/source_condensing/src/core_hyd_atmos/module_mpas_core.F
===================================================================
--- trunk/mpas/src/core_hyd_atmos/module_mpas_core.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_hyd_atmos/module_mpas_core.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,301 +0,0 @@
-module mpas_core
-
-   use mpas_framework
-   use mpas_timekeeping
-
-   type (io_output_object) :: restart_obj
-   integer :: restart_frame
-
-   integer :: current_outfile_frames
-
-   type (MPAS_Clock_type) :: clock
-
-   integer, parameter :: outputAlarmID = 1
-   integer, parameter :: restartAlarmID = 2
-
-   contains
-
-
-     subroutine mpas_core_init(domain, startTimeStamp)
-
-      use configure
-      use grid_types
-      use test_cases
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      character(len=*), intent(out) :: startTimeStamp
-
-      real (kind=RKIND) :: dt
-      type (block_type), pointer :: block
-
-
-      if (.not. config_do_restart) call setup_hyd_test_case(domain)
-
-      !
-      ! Initialize core
-      !
-      dt = config_dt
-
-      call simulation_clock_init(domain, dt, startTimeStamp)
-
-      block =&gt; domain % blocklist
-      do while (associated(block))
-         call mpas_init_block(block, block % mesh, dt)
-         block % state % time_levs(1) % state % xtime % scalar = startTimeStamp 
-         block =&gt; block % next
-      end do
-
-      restart_frame = 1
-      current_outfile_frames = 0
-
-   end subroutine mpas_core_init
-
-
-   subroutine simulation_clock_init(domain, dt, startTimeStamp)
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      real (kind=RKIND), intent(in) :: dt
-      character(len=*), intent(out) :: startTimeStamp
-
-      type (MPAS_Time_Type) :: startTime, stopTime, alarmStartTime
-      type (MPAS_TimeInterval_type) :: runDuration, timeStep, alarmTimeStep
-      integer :: ierr
-
-      call MPAS_setTime(curr_time=startTime, dateTimeString=config_start_time, ierr=ierr)
-      call MPAS_setTimeInterval(timeStep, dt=dt, ierr=ierr)
-
-      if (trim(config_run_duration) /= &quot;none&quot;) then
-         call MPAS_setTimeInterval(runDuration, timeString=config_run_duration, ierr=ierr)
-         call MPAS_createClock(clock, startTime=startTime, timeStep=timeStep, runDuration=runDuration, ierr=ierr)
-
-         if (trim(config_stop_time) /= &quot;none&quot;) then
-            call MPAS_setTime(curr_time=stopTime, dateTimeString=config_stop_time, ierr=ierr)
-            if(startTime + runduration /= stopTime) then
-               write(0,*) 'Warning: config_run_duration and config_stop_time are inconsitent: using config_run_duration.'
-            end if
-         end if
-      else if (trim(config_stop_time) /= &quot;none&quot;) then
-         call MPAS_setTime(curr_time=stopTime, dateTimeString=config_stop_time, ierr=ierr)
-         call MPAS_createClock(clock, startTime=startTime, timeStep=timeStep, stopTime=stopTime, ierr=ierr)
-      else
-          write(0,*) 'Error: Neither config_run_duration nor config_stop_time were specified.'
-          call dmpar_abort(domain % dminfo)
-      end if
-
-      ! set output alarm
-      call MPAS_setTimeInterval(alarmTimeStep, timeString=config_output_interval, ierr=ierr)
-      alarmStartTime = startTime + alarmTimeStep
-      call MPAS_addClockAlarm(clock, outputAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
-
-      ! set restart alarm, if necessary
-      if (trim(config_restart_interval) /= &quot;none&quot;) then
-         call MPAS_setTimeInterval(alarmTimeStep, timeString=config_restart_interval, ierr=ierr)
-         alarmStartTime = startTime + alarmTimeStep
-         call MPAS_addClockAlarm(clock, restartAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
-      end if
-
-      call MPAS_getTime(curr_time=startTime, dateTimeString=startTimeStamp, ierr=ierr)
-
-   end subroutine simulation_clock_init
-
-
-   subroutine mpas_init_block(block, mesh, dt)
-   
-      use grid_types
-      use advection
-      use time_integration
-      use RBF_interpolation
-      use vector_reconstruction
-   
-      implicit none
-   
-      type (block_type), intent(inout) :: block
-      type (mesh_type), intent(inout) :: mesh
-      real (kind=RKIND), intent(in) :: dt
-   
-   
-      call compute_solver_constants(block % state % time_levs(1) % state, mesh)
-      call compute_state_diagnostics(block % state % time_levs(1) % state, mesh)
-      call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
-      call initialize_advection_rk(mesh)
-      call rbfInterp_initialize(mesh)
-      call init_reconstruct(mesh)
-      call reconstruct(mesh, block % state % time_levs(1) % state % u % array, &amp;
-                       block % diag % uReconstructX % array,                   &amp;
-                       block % diag % uReconstructY % array,                   &amp;
-                       block % diag % uReconstructZ % array,                   &amp;
-                       block % diag % uReconstructZonal % array,               &amp;
-                       block % diag % uReconstructMeridional % array           &amp;
-                      )
-
-  
-   end subroutine mpas_init_block
-   
-   
-   subroutine mpas_core_run(domain, output_obj, output_frame)
-   
-      use grid_types
-      use io_output
-      use timer
-   
-      implicit none
-   
-      type (domain_type), intent(inout) :: domain
-      type (io_output_object), intent(inout) :: output_obj
-      integer, intent(inout) :: output_frame
-   
-      integer :: ntimesteps, itimestep
-      real (kind=RKIND) :: dt
-      type (block_type), pointer :: block_ptr
-
-      type (MPAS_Time_Type) :: currTime
-      character(len=32) :: timeStamp
-      integer :: ierr
-   
-      ! Eventually, dt should be domain specific
-      dt = config_dt
-
-      currTime = MPAS_getClockTime(clock, MPAS_NOW, ierr)
-      call MPAS_getTime(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)
-      write(0,*) 'Initial time ', timeStamp
-
-      call write_output_frame(output_obj, output_frame, domain)
-   
-      ! During integration, time level 1 stores the model state at the beginning of the
-      !   time step, and time level 2 stores the state advanced dt in time by timestep(...)
-      do while (.not. MPAS_isClockStopTime(clock))
-
-         call MPAS_advanceClock(clock)
-
-         currTime = MPAS_getClockTime(clock, MPAS_NOW, ierr)
-         call MPAS_getTime(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)
-         write(0,*) 'Doing timestep ', timeStamp
-
-         call timer_start(&quot;time integration&quot;)
-         call mpas_timestep(domain, dt, timeStamp)
-         call timer_stop(&quot;time integration&quot;)
-   
-         ! Move time level 2 fields back into time level 1 for next time step
-         call shift_time_levels_state(domain % blocklist % state)
-   
-         if (MPAS_isAlarmRinging(clock, outputAlarmID, ierr=ierr)) then
-            call MPAS_resetClockAlarm(clock, outputAlarmID, ierr=ierr)
-            if(output_frame == 1) call output_state_init(output_obj, domain, &quot;OUTPUT&quot;, trim(timeStamp)) ! output_frame will always be &gt; 1 here unless it is reset after the output file is finalized
-            call write_output_frame(output_obj, output_frame, domain)
-         end if
-
-         if (MPAS_isAlarmRinging(clock, restartAlarmID, ierr=ierr)) then
-            call MPAS_resetClockAlarm(clock, restartAlarmID, ierr=ierr)
-            if (restart_frame == 1) call output_state_init(restart_obj, domain, &quot;RESTART&quot;)
-            call output_state_for_domain(restart_obj, domain, restart_frame)
-            restart_frame = restart_frame + 1
-         end if
-
-      end do
-
-   end subroutine mpas_core_run
-   
-   
-   subroutine write_output_frame(output_obj, output_frame, domain)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute diagnostic fields for a domain and write model state to output file
-   !
-   ! Input/Output: domain - contains model state; diagnostic field are computed
-   !                        before returning
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   
-      use grid_types
-      use io_output
-   
-      implicit none
-   
-      integer, intent(inout) :: output_frame
-      type (domain_type), intent(inout) :: domain
-      type (io_output_object), intent(inout) :: output_obj
-   
-      integer :: i, j, k
-      integer :: eoe
-      type (block_type), pointer :: block_ptr
-   
-      block_ptr =&gt; domain % blocklist
-      do while (associated(block_ptr))
-         call compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
-         block_ptr =&gt; block_ptr % next
-      end do
-   
-      call output_state_for_domain(output_obj, domain, output_frame)
-      output_frame = output_frame + 1
-
-      ! if the maximum number of frames per outfile has been reached, finalize outfile and reset frame
-      if (config_frames_per_outfile &gt; 0) then
-         current_outfile_frames = current_outfile_frames + 1
-         if(current_outfile_frames &gt;= config_frames_per_outfile) then
-            current_outfile_frames = 0
-            call output_state_finalize(output_obj, domain % dminfo)
-            output_frame = 1
-         end if
-      end if
-
-   end subroutine write_output_frame
-   
-   
-   subroutine compute_output_diagnostics(state, grid)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute diagnostic fields for a domain
-   !
-   ! Input: state - contains model prognostic fields
-   !        grid  - contains grid metadata
-   !
-   ! Output: state - upon returning, diagnostic fields will have be computed
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   
-      use grid_types
-   
-      implicit none
-   
-      type (state_type), intent(inout) :: state
-      type (mesh_type), intent(in) :: grid
-   
-      integer :: i, eoe
-      integer :: iEdge, k
-   
-   end subroutine compute_output_diagnostics
-   
-   
-   subroutine mpas_timestep(domain, dt, timeStamp)
-   
-      use grid_types
-      use time_integration
-   
-      implicit none
-   
-      type (domain_type), intent(inout) :: domain 
-      real (kind=RKIND), intent(in) :: dt
-      character(len=*), intent(in) :: timeStamp
-   
-      call timestep(domain, dt, timeStamp)
-   
-   end subroutine mpas_timestep
-   
-   
-   subroutine mpas_core_finalize(domain)
-   
-      use grid_types
-   
-      implicit none
-  
-      integer :: ierr

-      type (domain_type), intent(inout) :: domain 
-
-      if (restart_frame &gt; 1) call output_state_finalize(restart_obj, domain % dminfo)
-
-      call MPAS_destroyClock(clock, ierr)
-
-   end subroutine mpas_core_finalize
-
-end module mpas_core

Deleted: branches/source_condensing/src/core_hyd_atmos/module_test_cases.F
===================================================================
--- trunk/mpas/src/core_hyd_atmos/module_test_cases.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_hyd_atmos/module_test_cases.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,544 +0,0 @@
-module test_cases
-
-   use grid_types
-   use configure
-   use constants
-
-
-   contains
-
-
-   subroutine setup_hyd_test_case(domain)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Configure grid metadata and model state for the hydrostatic test case
-   !   specified in the namelist
-   !
-   ! Output: block - a subset (not necessarily proper) of the model domain to be
-   !                 initialized
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-
-      integer :: i
-      type (block_type), pointer :: block_ptr
-
-      if (config_test_case == 0) then
-         write(0,*) ' need hydrostatic test case configuration, error stop '
-         stop
-
-      else 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 '
-         if (config_test_case == 1) write(0,*) ' no initial perturbation '
-         if (config_test_case == 2) write(0,*) ' initial perturbation included '
-         if (config_test_case == 3) write(0,*) ' normal-mode perturbation included '
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            call hyd_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state, config_test_case)
-            do i=2,nTimeLevs
-               call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
-            end do
-
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else
-         write(0,*) ' Only test case 1 and 2 are currently supported for hydrostatic core '
-         stop
-      end if
-
-   end subroutine setup_hyd_test_case
-
-!----------------------------------------------------------------------------------------------------------
-
-   subroutine hyd_test_case_1(grid, state, test_case)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup baroclinic wave test case from Jablonowski and Williamson 2008 (QJRMS)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (mesh_type), intent(inout) :: grid
-      type (state_type), intent(inout) :: state
-      integer, intent(in) :: test_case
-
-      real (kind=RKIND), parameter :: u0 = 35.0
-      real (kind=RKIND), parameter :: alpha_grid = 0.  ! no grid rotation
-      real (kind=RKIND), parameter :: omega_e = 7.29212e-05
-      real (kind=RKIND), parameter :: t0 = 288., delta_t = 4.8e+05, dtdz = 0.005, eta_t = 0.2
-      real (kind=RKIND), parameter :: u_perturbation = 1., pert_radius = 0.1, latitude_pert = 40., longitude_pert = 20.
-      real (kind=RKIND), parameter :: theta_c = pii/4.0
-      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
-      real (kind=RKIND), parameter :: rh_max = 0.4       ! Maximum relative humidity
-      real (kind=RKIND), parameter :: k_x = 9.           ! Normal mode wave number
-
-      real (kind=RKIND), dimension(:), pointer :: rdnu, rdnw, fnm, fnp, dbn, dnu, dnw
-      real (kind=RKIND), dimension(:), pointer :: surface_pressure
-      real (kind=RKIND), dimension(:,:), pointer :: pressure, theta, alpha, geopotential, h
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalars
-
-      integer :: iCell, iEdge, vtx1, vtx2, ivtx, k, nz, nz1, index_qv
-      real (kind=RKIND) :: u, v, flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
-
-      real (kind=RKIND) :: ptop, p0, phi
-      real (kind=RKIND) :: lon_Edge
-
-      real (kind=RKIND), dimension(grid % nVertLevels, grid % nCells) :: rel_hum, temperature
-      real (kind=RKIND) :: ptmp, es, qvs
-      integer :: iter
-
-!      real (kind=RKIND), dimension(grid % nVertLevelsP1 ) :: hyai, hybi, znu, znw, znwc, znwv, hyam, hybm
-!      real (kind=RKIND), dimension(grid % nVertLevelsP1 ) :: znuc, znuv, bn, divh, dpn, teta, phi
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: hyai, hybi, znu, znw, znwc, znwv, hyam, hybm
-      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: znuc, znuv, bn, divh, dpn, teta
-
-      real (kind=RKIND) :: HYAI_CAM26(27), HYBI_CAM26(27), HYAM_CAM26(26), HYBM_CAM26(26)
-
-      logical, parameter :: cam26 = .true.
-
-      data hyai_cam26 / 0.002194067, 0.004895209, 0.009882418, 0.018052010,  &amp;
-                        0.029837240, 0.044623340, 0.061605870, 0.078512430,  &amp;
-                        0.077312710, 0.075901310, 0.074240860, 0.072287440,  &amp;
-                        0.069989330, 0.067285740, 0.064105090, 0.060363220,  &amp;
-                        0.055961110, 0.050782250, 0.044689600, 0.037521910,  &amp;
-                        0.029089490, 0.020847390, 0.013344430, 0.007084990,  &amp;
-                        0.002521360, 0.000000000, 0.000000000/,              &amp;
-           hybi_cam26 / 0.000000000, 0.000000000, 0.000000000, 0.000000000,  &amp;
-                        0.000000000, 0.000000000, 0.000000000, 0.000000000,  &amp;
-                        0.015053090, 0.032762280, 0.053596220, 0.078106270,  &amp;
-                        0.106941100, 0.140863700, 0.180772000, 0.227722000,  &amp;
-                        0.282956200, 0.347936400, 0.424382200, 0.514316800,  &amp;
-                        0.620120200, 0.723535500, 0.817676800, 0.896215300,  &amp;
-                        0.953476103, 0.985112200, 1.000000000/
-
-      !
-      ! Scale all distances and areas from a unit sphere to one with radius a
-      !
-      grid % xCell % array = grid % xCell % array * a
-      grid % yCell % array = grid % yCell % array * a
-      grid % zCell % array = grid % zCell % array * a
-      grid % xVertex % array = grid % xVertex % array * a
-      grid % yVertex % array = grid % yVertex % array * a
-      grid % zVertex % array = grid % zVertex % array * a
-      grid % xEdge % array = grid % xEdge % array * a
-      grid % yEdge % array = grid % yEdge % array * a
-      grid % zEdge % array = grid % zEdge % array * a
-      grid % dvEdge % array = grid % dvEdge % array * a
-      grid % dcEdge % array = grid % dcEdge % array * a
-      grid % areaCell % array = grid % areaCell % array * a**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
-      index_qv = state % index_qv
-      
-      nz1 = grid % nVertLevels
-      nz = nz1 + 1
-
-      rdnu =&gt; grid % rdnu % array
-      rdnw =&gt; grid % rdnw % array
-      fnm =&gt; grid % fnm % array
-      fnp =&gt; grid % fnp % array
-      dbn =&gt; grid % dbn % array
-      dnu =&gt; grid % dnu % array
-      dnw =&gt; grid % dnw % array
-
-      surface_pressure =&gt; state % surface_pressure % array
-      pressure =&gt; state % pressure % array
-      theta =&gt; state % theta % array
-      alpha =&gt; state % alpha % array
-      geopotential =&gt; state % geopotential % array
-      h =&gt; state % h % array
-      scalars =&gt; state % scalars % array
-
-      scalars(:,:,:) = 0.
-
-      p0      = 100000.
-      bn (1) = 1.
-      znw(1) = 1.
-      znwc(1) = 1.
-      !znwv(1) = (znwc(1)-.252)*pii/2.
-      znwv(1) = ((znwc(1)-.252)*pii/2.*p0-ptop)/(p0-ptop)
-                
-      if (cam26) then
-
-        if (grid % nVertLevels /= 26 ) then
-          write(0,*) ' init is for 26 levels only, error stop '
-          stop
-        else
-                do k=1,nz
-            hyai(k) = hyai_cam26(k)
-            hybi(k) = hybi_cam26(k)
-          end do
-
-          write(0,*) ' initialization using cam 26 levels '
-
-        end if
-
-        ptop    = hyai(1)*p0
-
-        do k=1,nz1
-           hyam(k) = .5*(hyai(k)+hyai(k+1))
-           hybm(k) = .5*(hybi(k)+hybi(k+1))
-           znuc(nz-k)   = hyam(k) + hybm(k)
-           znwc(nz-k+1) = hyai(k) + hybi(k)
-           znu (nz-k  ) = (znuc(nz-k  )*p0-ptop)/(p0-ptop)
-           znw (nz-k+1) = (znwc(nz-k+1)*p0-ptop)/(p0-ptop)
-!           znuv(nz-k  ) = (znuc(nz-k  )-.252)*pii/2.
-!           znwv(nz-k+1) = (znwc(nz-k+1)-.252)*pii/2.
-           bn(k+1) = hybi(nz-k)
-        end do
-
-      else ! analytic profile
-
-        ptop = 219.4067
-        znw(1) = 1.
-
-        do k=1,nz1
-
-          ! eta profile (constant deta for exp=1,)
-
-          znw(k+1) = (1.-float(k)/float(nz1))**2.
-
-          ! profile for tranisition from sigma to presure coordinate
-          ! bn(k)=znw(k) for sigma coord, bn(k)=0 for p coord
-          !  bn(1)=1, bn(nz)=0 must be satisfied
-                                
-          bn(k+1) = znw(k+1)*sin(.5*pii*znw(k+1))**2
-          !!  bn(k+1) = znw(k+1)
-                                                                                                                                
-          znu (k)   = .5*(znw(k)+znw(k+1))
-          znuc(k)   = (znu(k  )*(p0-ptop)+ptop)/p0
-          znwc(k+1) = (znw(k+1)*(p0-ptop)+ptop)/p0
-        end do
-
-      end if  ! cam or analytic grid-level profile
-
-      !
-      !  metrics for vertical stretching
-      !
-
-      do k=1,nz1
-        !znuv(k  ) = (znuc(k  )-.252)*pii/2.
-        !znwv(k+1) = (znwc(k+1)-.252)*pii/2.
-        znuv(k  ) = ((znuc(k  )-.252)*pii/2.*p0-ptop)/(p0-ptop)
-        znwv(k+1) = ((znwc(k+1)-.252)*pii/2.*p0-ptop)/(p0-ptop)
-        dnw (k) = znw(k+1)-znw(k)
-        rdnw(k) = 1./dnw(k)
-        dbn (k) = rdnw(k)*(bn(k+1)-bn(k))
-        dpn (k) = 0.
-        divh(k) = 0.
-        write (6,*) k,znw(k),dnw(k),bn(k),dbn(k)
-      end do
-
-      dpn(nz)=0.
-      fnm(1) = 0.
-      fnp(1) = 0.
-      do k=2,nz1
-         dnu (k)  = .5*(dnw(k)+dnw(k-1))
-         rdnu(k)  = 1./dnu(k)
-         fnp (k)  = .5* dnw(k  )/dnu(k)
-         fnm (k)  = .5* dnw(k-1)/dnu(k)
-      end do
-
-      !
-      ! Initialize wind field
-      !
-
-      lat_pert = latitude_pert*pii/180.
-      lon_pert = longitude_pert*pii/180.
-
-      do iEdge=1,grid % nEdges
-
-         vtx1 = grid % VerticesOnEdge % array (1,iEdge)
-         vtx2 = grid % VerticesOnEdge % array (2,iEdge)
-         lat1 = grid%latVertex%array(vtx1)
-         lat2 = grid%latVertex%array(vtx2)
-         flux = (0.5*(lat2-lat1) - 0.125*(sin(4.*lat2) - sin(4.*lat1)))*a/grid % dvEdge % array(iEdge)
-
-         if (config_test_case == 2) then
-            r_pert = sphere_distance( grid % latEdge % array (iEdge), grid % lonEdge % array (iEdge), &amp;
-                                      lat_pert, lon_pert, 1.)/(pert_radius)
-            u_pert = u_perturbation*exp(-r_pert**2)*(lat2-lat1)*a/grid % dvEdge % array(iEdge)
-
-         else if (config_test_case == 3) then
-            lon_Edge = grid % lonEdge % array(iEdge)
-            u_pert = u_perturbation*cos(k_x*(lon_Edge - lon_pert)) &amp;
-                         *(0.5*(lat2-lat1) - 0.125*(sin(4.*lat2) - sin(4.*lat1)))*a/grid % dvEdge % array(iEdge)
-         else
-            u_pert = 0.0
-         end if
-
-
-         do k=1,grid % nVertLevels
-           fluxk = u0*flux*(cos(znuv(k))**(1.5))
-           state % u % array(k,iEdge) = fluxk + u_pert
-         end do
-
-      !
-      ! Generate rotated Coriolis field
-      !
-
-         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
-                                       ( -cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha_grid) + &amp;
-                                         sin(grid%latEdge%array(iEdge)) * cos(alpha_grid) &amp;
-                                       )
-      end do
-
-      do iVtx=1,grid % nVertices
-         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
-                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha_grid) + &amp;
-                                          sin(grid%latVertex%array(iVtx)) * cos(alpha_grid) &amp;
-                                         )
-      end do
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! To get hydrostatic balance with misture -- soln. 2.
-! original scheme by Jablonowski
-!                            T' = -1./R_d *(p/p_0) * d(phi')/d(eta)
-!                               = -1./R_d * eta * d(phi')/d(eta)
-! soln. 2 -&gt; derive temperature profile from hydrostatic balance with moisture
-! 
-!                           T_v = -1/(1+q_v)*(p/R_d)* d(eta)/d(p_d) * d(phi)/d(eta)
-!                           phi'(k) = phi(k+1) + d(eta)* alpha_pert * d(eta)/d(p_d)
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-                        
-      do iCell=1,grid % nCells
-
-        phi = grid % latCell % array (iCell)
-
-        surface_pressure(iCell) = p0
-
-        do k=1,nz1
-          h(k,iCell) = (1.-dbn(k))*(p0-ptop)+dbn(k)*(surface_pressure(iCell)-ptop)
-        end do
-                        
-         pressure(nz,iCell) = ptop
-         do k=nz1,1,-1
-               pressure(k,iCell) = pressure(k+1,iCell)-dnw(k)*h(k,iCell)
-         end do
-
-         do k=1,nz1
-            ptmp = 0.5*(pressure(k,iCell)+pressure(k+1,iCell))
-            if (znuc(k) &gt;= eta_t) then
-               teta(k) = t0*(ptmp/p0)**(rgas*dtdz/gravity)
-            else
-               teta(k) = t0*(ptmp/p0)**(rgas*dtdz/gravity) + delta_t*(eta_t-ptmp/p0)**5
-            end if
-            theta (k,iCell) = teta(k)+.75*ptmp/h(k,iCell)*pii*u0/rgas*sin(znuv(k))    &amp;
-                              *sqrt(cos(znuv(k)))*                         &amp;
-                                ((-2.*sin(phi)**6                          &amp;
-                                     *(cos(phi)**2+1./3.)+10./63.)         &amp;
-                                     *2.*u0*cos(znuv(k))**1.5              &amp;
-                                +(1.6*cos(phi)**3                          &amp;
-                                     *(sin(phi)**2+2./3.)-pii/4.)*a*omega)
-
-            theta (k,iCell) = theta(k,iCell)*  &amp;
-                      (0.5*(pressure(k,iCell)+pressure(k+1,iCell))/p0)**(-rgas/cp)
-            alpha(k,iCell) = ((rgas/p0)*theta(k,iCell)* &amp;
-                      (0.5*(pressure(k,iCell)+pressure(k+1,iCell))/p0)**cvpm)
-
-         end do
-      end do
-!
-!     initialization for geopotential
-!
-      do iCell=1,grid % nCells
-
-         phi = grid % latCell % array (iCell)
-
-         geopotential(1,iCell) = u0*cos(znwv(1))**1.5*                     &amp;
-                                 ((-2.*sin(phi)**6                     &amp;
-                                      *(cos(phi)**2+1./3.)+10./63.)    &amp;
-                                      *(u0)*cos(znwv(1))**1.5          &amp;
-                                 +(1.6*cos(phi)**3                     &amp;
-                                     *(sin(phi)**2+2./3.)-pii/4.)*a*omega)
-         do k=1,nz1
-           geopotential(k+1,iCell) = geopotential(k,iCell)-dnw(k)*h(k,iCell)*alpha(k,iCell)
-         end do
-      end do
-                
-      write(6,*) 'ptop_dry = ',ptop,'  zt_dry = ',geopotential(nz,1)/gravity
-
-      write(6,*) ' full sounding for dry'
-      do k=1,nz1
-         write(6,*) k, geopotential(k,1)/gravity, 0.01*pressure(k,1), theta(k,1), &amp;
-                    theta(k,1)*(pressure(k,1)/p0)**(rgas/cp)
-      end do
-
-!
-!     initialization for moisture 
-!
-      if (config_mp_physics /= 0) then
-
-         do iCell=1,grid % nCells
-            do k=1,nz1
-               ptmp = 0.5*(pressure(k,iCell) + pressure(k+1,iCell))
-               if (ptmp &lt; 50000.) then
-                  rel_hum(k,iCell) = 0.0
-               else
-                  rel_hum(k,iCell) = (1.-((p0-ptmp)/50000.)**1.25)
-               end if
-               rel_hum(k,iCell) = min(rh_max,rel_hum(k,iCell))
-            end do
-         end do
-      else
-         rel_hum(:,:) = 0.
-      end if
-
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-      ! iteration 
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      do iter=1,30
-         do iCell=1,grid % nCells 
-   
-            phi = grid % latCell % array (iCell)
-            do k=1,nz1
-               ptmp = 0.5*(pressure(k+1,iCell)+pressure(k,iCell))
-   
-               if(znuc(k) &gt;= eta_t)  then
-                  teta(k) = t0*(ptmp/p0)**(rgas*dtdz/gravity)
-               else
-                  teta(k) = t0*(ptmp/p0)**(rgas*dtdz/gravity) + delta_t*(eta_t-ptmp/p0)**5
-               end if
-   
-               temperature (k,iCell) = teta(k)+.75*ptmp/h(k,iCell)*pii*u0/rgas*sin(znuv(k))    &amp;
-                                 *sqrt(cos(znuv(k)))*                         &amp;
-                                   ((-2.*sin(phi)**6                          &amp;
-                                        *(cos(phi)**2+1./3.)+10./63.)         &amp;
-                                        *2.*u0*cos(znuv(k))**1.5              &amp;
-                                   +(1.6*cos(phi)**3                          &amp;
-                                        *(sin(phi)**2+2./3.)-pii/4.)*a*omega)
-   
-               temperature(k,iCell) = temperature(k,iCell)/(1.+0.61*scalars(index_qv,k,iCell))
-   
-               theta (k,iCell) = temperature(k,iCell)*  &amp;
-                                     (0.5*(pressure(k,iCell)+pressure(k+1,iCell))/p0)**(-rgas/cp)
-               alpha (k,iCell) = (rgas/p0)*theta(k,iCell)*(1.+1.61*scalars(index_qv,k,iCell))* &amp;
-                                     (0.5*(pressure(k,iCell)+pressure(k+1,iCell))/p0)**cvpm
-   
-               if (temperature(k,iCell) &gt; 273.15) then
-                   es  = 1000.*0.6112*exp(17.67*(temperature(k,iCell)-273.15)/(temperature(k,iCell)-29.65))
-               else
-                   es  = 1000.*0.6112*exp(21.8745584*(temperature(k,iCell)-273.16)/(temperature(k,iCell)-7.66))
-               end if
-               qvs = (287.04/461.6)*es/(ptmp-es)
-!               qvs =  380.*exp(17.27*(temperature(k,iCell)-273.)/(temperature(k,iCell)-36.))/ptmp
-   
-               scalars(index_qv,k,iCell) = rel_hum(k,iCell)*qvs
-            end do
-   
-            do k=nz1,1,-1
-               pressure(k,iCell) = pressure(k+1,iCell)-dnw(k)*h(k,iCell)*(1.+scalars(index_qv,k,iCell))
-               geopotential(k,iCell) = geopotential(k+1,iCell)+dnw(k)*h(k,iCell)*alpha(k,iCell)
-            end do
-   
-         end do
-      end do
-
-      write(6,*) 'ptop = ',ptop,'  zt = ',geopotential(nz,1)/gravity
-
-      write(6,*) ' full sounding with moisture'
-      do k=1,nz1
-         write(6,*) k, geopotential(k,1)/gravity, 0.01*pressure(k,1), theta(k,1), &amp;
-                    theta(k,1)*(pressure(k,1)/p0)**(rgas/cp)
-      end do
-
-! When initializing a scalar, be sure not to put unreasonably large values
-! into indices in the moist class
-!      scalars(2,:,:) = 1.  ! transport test
-!      scalars(2,:,:) = theta  ! transport test
-!      if (num_scalars &gt;= 2) then
-!         scalars(2,:,:) = 0.0
-!         do iCell=1,grid%nCells
-!            r = sphere_distance(theta_c, lambda_c, grid % latCell % array(iCell), grid % lonCell % array(iCell), a)
-!            if (r &lt; a/3.0) then
-!               do k=1,grid%nVertLevels
-!                  scalars(2,k,iCell) = (1.0 / 2.0) * (1.0 + cos(pii*r*3.0/a))
-!               end do
-!            end if
-!         end do
-!      end if
-!      if (num_scalars &gt;= 3) scalars(3,:,:) = theta + 100.  ! transport test
-!      if (num_scalars &gt;= 4) scalars(4,:,:) = theta + 200.  ! transport test
-!      if (num_scalars &gt;= 5) scalars(5,:,:) = theta + 300.  ! transport test
-
-   end subroutine hyd_test_case_1
-
-
-   real function sphere_distance(lat1, lon1, lat2, lon2, radius)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
-   !   sphere with given radius.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), intent(in) :: lat1, lon1, lat2, lon2, radius
-
-      real (kind=RKIND) :: arg1
-
-      arg1 = sqrt( sin(0.5*(lat2-lat1))**2 +  &amp;
-                   cos(lat1)*cos(lat2)*sin(0.5*(lon2-lon1))**2 )
-      sphere_distance = 2.*radius*asin(arg1)
-
-   end function sphere_distance
-
-
-   real function AA(theta)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! A, used in height field computation for Rossby-Haurwitz wave
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), parameter :: w = 7.848e-6
-      real (kind=RKIND), parameter :: K = 7.848e-6
-      real (kind=RKIND), parameter :: R = 4.0
-
-      real (kind=RKIND), intent(in) :: theta
-
-      AA = 0.5 * w * (2.0 * omega + w) * cos(theta)**2.0 + &amp;
-          0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 + 2.0*R**2.0 - R - 2.0 - 2.0*(R*cos(theta))**2.0)
-
-   end function AA
-
-   
-   real function BB(theta)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! B, used in height field computation for Rossby-Haurwitz wave
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), parameter :: w = 7.848e-6
-      real (kind=RKIND), parameter :: K = 7.848e-6
-      real (kind=RKIND), parameter :: R = 4.0
-
-      real (kind=RKIND), intent(in) :: theta
-
-      BB = (2.0*(omega + w)*K / ((R+1.0)*(R+2.0))) * cos(theta)**R * ((R**2.0 + 2.0*R + 2.0) - ((R+1.0)*cos(theta))**2.0)
-
-   end function BB
-
-
-   real function CC(theta)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! C, used in height field computation for Rossby-Haurwitz wave
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), parameter :: w = 7.848e-6
-      real (kind=RKIND), parameter :: K = 7.848e-6
-      real (kind=RKIND), parameter :: R = 4.0
-
-      real (kind=RKIND), intent(in) :: theta
-
-      CC = 0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 - R - 2.0)
-
-   end function CC
-
-end module test_cases

Deleted: branches/source_condensing/src/core_hyd_atmos/module_time_integration.F
===================================================================
--- trunk/mpas/src/core_hyd_atmos/module_time_integration.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_hyd_atmos/module_time_integration.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,2122 +0,0 @@
-module time_integration
-
-   use grid_types
-   use configure
-   use constants
-   use dmpar
-   use vector_reconstruction
-
-
-   contains
-
-
-   subroutine timestep(domain, dt, timeStamp)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Advance model state forward in time by the specified time step
-   !
-   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
-   !                 plus grid meta-data
-   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
-   !                  model state advanced forward in time by dt seconds
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      real (kind=RKIND), intent(in) :: dt
-      character(len=*), intent(in) :: timeStamp
-
-      type (block_type), pointer :: block
-
-      if (trim(config_time_integration) == 'SRK3') then
-         call srk3(domain, dt)
-      else
-         write(0,*) 'Unknown time integration option '//trim(config_time_integration)
-         write(0,*) 'Currently, only ''SRK3'' is supported.'
-         stop
-      end if
-
-      block =&gt; domain % blocklist
-      do while (associated(block))
-         block % state % time_levs(2) % state % xtime % scalar = timeStamp
-         block =&gt; block % next
-      end do
-
-   end subroutine timestep
-
-
-   subroutine srk3(domain, dt)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Advance model state forward in time by the specified time step using 
-   !   time-split RK3 scheme
-   !
-   ! Hydrostatic (primitive eqns.) solver
-   !
-   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
-   !                 plus grid meta-data
-   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
-   !                  model state advanced forward in time by dt seconds
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      real (kind=RKIND), intent(in) :: dt
-
-      integer :: iCell, k
-      type (block_type), pointer :: block
-
-      integer, parameter :: TEND   = 1
-      integer :: rk_step, number_of_sub_steps
-
-      real (kind=RKIND), dimension(3) :: rk_timestep, rk_sub_timestep
-      integer, dimension(3) :: number_sub_steps
-      integer :: small_step
-      logical, parameter :: debug = .false.
-      logical, parameter :: debug_mass_conservation = .true.
-
-      real (kind=RKIND) :: domain_mass, scalar_mass, scalar_min, scalar_max
-      real (kind=RKIND) :: global_domain_mass, global_scalar_mass, global_scalar_min, global_scalar_max
-
-      !
-      ! Initialize time_levs(2) with state at current time
-      ! Initialize RK weights
-      !
-
-      number_of_sub_steps = config_number_of_sub_steps
-
-      rk_timestep(1) = dt/3.
-      rk_timestep(2) = dt/2.
-      rk_timestep(3) = dt
-
-      rk_sub_timestep(1) = dt/3.
-      rk_sub_timestep(2) = dt/real(number_of_sub_steps)
-      rk_sub_timestep(3) = dt/real(number_of_sub_steps)
-
-      number_sub_steps(1) = 1
-      number_sub_steps(2) = number_of_sub_steps/2
-      number_sub_steps(3) = number_of_sub_steps
-
-      if(debug) write(0,*) ' copy step in rk solver '
-
-      block =&gt; domain % blocklist
-      do while (associated(block))
-         call copy_state( block % state % time_levs(2) % state, block % state % time_levs(1) % state )
-         block =&gt; block % next
-      end do
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-      ! BEGIN RK loop 
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-
-      do rk_step = 1, 3
-
-        if(debug) write(0,*) ' rk substep ', rk_step
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % qtot % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % cqu % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
-                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % h % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % pressure % array(:,:), &amp;
-                                            block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % geopotential % array(:,:), &amp;
-                                            block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % alpha % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % pv_edge % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
-                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-           if (config_h_mom_eddy_visc4 &gt; 0.0) then
-              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &amp;
-                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &amp;
-                                               block % mesh % nVertLevels, block % mesh % nVertices, &amp;
-                                               block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
-           end if
-           block =&gt; block % next
-        end do
-
-        if(debug) write(0,*) ' rk substep ', rk_step
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call compute_dyn_tend( block % tend, block % state % time_levs(2) % state, block % mesh )
-           block =&gt; block % next
-        end do
-
-        if(debug) write(0,*) ' returned from dyn_tend '
-
-        !
-        ! ---  update halos for tendencies
-        !
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % u % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
-                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % theta % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           block =&gt; block % next
-        end do
-
-
-        ! ---  advance over sub_steps
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           !
-           ! Note: Scalars in new time level shouldn't be overwritten, since their provisional values 
-           !    from the previous RK step are needed to compute new scalar tendencies in advance_scalars. 
-           !    A cleaner way of preserving scalars should be added in future.
-           !
-           block % mesh % scalars_old % array(:,:,:) = block % state % time_levs(2) % state % scalars % array(:,:,:)
-           call copy_state( block % state % time_levs(2) % state, block % state % time_levs(1) % state )
-           block % state % time_levs(2) % state % scalars % array(:,:,:) = block % mesh % scalars_old % array(:,:,:)
-           block =&gt; block % next
-        end do
-
-        if(debug) write(0,*) ' returned from copy_state '
-
-        do small_step = 1, number_sub_steps(rk_step)
-
-           if(debug) write(0,*) ' small step ',small_step
-      
-           block =&gt; domain % blocklist
-           do while (associated(block))
-              call advance_dynamics( block % tend, block % state % time_levs(2) % state,  &amp;
-                                     block % mesh,                                                           &amp;
-                                     small_step, number_sub_steps(rk_step), rk_sub_timestep(rk_step) )
-              block =&gt; block % next
-           end do
-
-          if(debug) write(0,*) ' dynamics advance complete '
-  
-           !  will need communications here?
-           !
-           ! ---  update halos for prognostic variables
-           !
-           block =&gt; domain % blocklist
-           do while (associated(block))
-!!              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % u % array(:,:), &amp;
-!!                                               block % mesh % nVertLevels, block % mesh % nEdges, &amp;
-!!                                               block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % h_edge % array(:,:), &amp;
-                                               block % mesh % nVertLevels, block % mesh % nEdges, &amp;
-                                               block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-!!              call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % uhAvg % array(:,:), &amp;
-!!                                               block % mesh % nVertLevels, block % mesh % nEdges, &amp;
-!!                                               block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-!!              call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % wwAvg % array(:,:), &amp;
-!!                                               block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
-!!                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % theta % array(:,:), &amp;
-                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-!!              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % h % array(:,:), &amp;
-!!                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
-!!                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-!!              call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % h % array(:,:), &amp;
-!!                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
-!!                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-              call dmpar_exch_halo_field1dReal(domain % dminfo, block % mesh % dpsdt % array(:), &amp;
-                                               block % mesh % nCells, &amp;
-                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-              call dmpar_exch_halo_field1dReal(domain % dminfo, block % state % time_levs(2) % state % surface_pressure % array(:), &amp;
-                                               block % mesh % nCells, &amp;
-                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % alpha % array(:,:), &amp;
-                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % ww % array(:,:), &amp;
-                                               block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
-                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % pressure % array(:,:), &amp;
-                                               block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
-                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-!!              call dmpar_exch_halo_field2dReal(domain % dminfo, block % mesh % pressure_old % array(:,:), &amp;
-!!                                               block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
-!!                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % geopotential % array(:,:), &amp;
-                                               block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
-                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-              block =&gt; block % next
-           end do
-
-        end do
-
-        if(debug) write(0,*) ' advance scalars '
-
-
-        ! ---  advance scalars with time integrated mass fluxes
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           !
-           ! Note: The advance_scalars_mono routine can be used without limiting, and thus, encompasses 
-           !       the functionality of the advance_scalars routine; however, it is noticeably slower, 
-           !       so we keep the advance_scalars routine as well
-           !
-           if (rk_step &lt; 3 .or. (.not. config_monotonic .and. .not. config_positive_definite)) then
-              call advance_scalars( block % tend,                                                               &amp;
-                                    block % state % time_levs(1) % state, block % state % time_levs(2) % state, &amp;
-                                    block % mesh, rk_timestep(rk_step) )
-           else
-              call advance_scalars_mono( block % tend,                                                               &amp;
-                                         block % state % time_levs(1) % state, block % state % time_levs(2) % state, &amp;
-                                         block % mesh, rk_timestep(rk_step), rk_step, 3,                             &amp;
-                                         domain % dminfo, block % parinfo % cellsToSend, block % parinfo % cellsToRecv )
-           end if
-           block =&gt; block % next
-        end do
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % scalars % array(:,:,:), &amp;
-                                            block % tend % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           call dmpar_exch_halo_field3dReal(domain % dminfo, block % state % time_levs(2) % state % scalars % array(:,:,:), &amp;
-                                            block % tend % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           block =&gt; block % next
-        end do
-
-        
-        if(debug) write(0,*) ' advance scalars complete '
-
-        ! --- compute some diagnostic quantities for the next timestep
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call compute_solver_constants( block % state % time_levs(2) % state, block % mesh )
-           call compute_state_diagnostics( block % state % time_levs(2) % state, block % mesh )
-           call compute_solve_diagnostics( dt, block % state % time_levs(2) % state, block % mesh )
-           block =&gt; block % next
-        end do
-
-        if(debug) write(0,*) ' diagnostics complete '
-      
-
-        !  might need communications here *****************************
-
-      end do
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-      ! END RK loop 
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      !
-      ! Compute full velocity vectors at cell centers, and compute vertical velocity diagnostic
-      !
-      block =&gt; domain % blocklist
-      do while (associated(block))
-         call reconstruct(block % mesh, block % state % time_levs(2) % state % u % array, &amp;
-                          block % diag % uReconstructX % array,                           &amp;
-                          block % diag % uReconstructY % array,                           &amp;
-                          block % diag % uReconstructZ % array,                           &amp;
-                          block % diag % uReconstructZonal % array,                       &amp;
-                          block % diag % uReconstructMeridional % array                   &amp;
-                         )
-
-         call compute_w(block % state % time_levs(2) % state, block % state % time_levs(1) % state, block % mesh, dt)
-         block =&gt; block % next
-      end do
-
-      if(debug) write(0,*) ' rk step complete - mass diagnostics '
-
-      if(debug .or. debug_mass_conservation) then
-         domain_mass = 0.
-         scalar_mass = 0.
-         block =&gt; domain % blocklist
-         scalar_min = block % state % time_levs(2) % state % scalars % array (2,1,1)
-         scalar_max = block % state % time_levs(2) % state % scalars % array (2,1,1)
-         do while(associated(block))
-           do iCell = 1, block % mesh % nCellsSolve
-             domain_mass = domain_mass + block % state % time_levs(2) % state % surface_pressure % array (iCell) * &amp;
-                                         block % mesh % areaCell % array (iCell) &amp;
-                                       - block % state % time_levs(2) % state % pressure % array (block % mesh % nVertLevels + 1, 1) * &amp;
-                                         block % mesh % areaCell % array (iCell)
-             do k=1, block % mesh % nVertLevelsSolve
-               scalar_mass = scalar_mass - block % state % time_levs(2) % state % scalars % array (2,k,iCell) * &amp;
-                                           block % state % time_levs(2) % state % h % array (k,iCell) * &amp;
-                                           block % mesh % dnw % array (k) * &amp;
-                                           block % mesh % areaCell % array (iCell)
-               scalar_min = min(scalar_min,block % state % time_levs(2) % state % scalars % array (2,k,iCell))
-               scalar_max = max(scalar_max,block % state % time_levs(2) % state % scalars % array (2,k,iCell))
-             end do
-           end do
-           block =&gt; block % next
-         end do
-         call dmpar_sum_real(domain % dminfo, domain_mass, global_domain_mass)
-         call dmpar_sum_real(domain % dminfo, scalar_mass, global_scalar_mass)
-         call dmpar_min_real(domain % dminfo, scalar_min, global_scalar_min)
-         call dmpar_max_real(domain % dminfo, scalar_max, global_scalar_max)
-         write(0,*) ' mass in the domain = ',global_domain_mass
-         write(0,*) ' scalar mass in the domain = ',global_scalar_mass
-         write(0,*) ' scalar_min, scalar_max ',global_scalar_min, global_scalar_max
-      end if
-
-
-   end subroutine srk3
-
-!------------------------------------------------------------------------------------------------------------------
-
-   subroutine compute_solver_constants(s, grid)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Compute height and normal wind tendencies, as well as diagnostic variables
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - computed diagnostics (parallel velocities, v; mass fluxes, vh; 
-   !                circulation; vorticity; and kinetic energy, ke) and the 
-   !                tendencies for height (h) and u (u)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (state_type), intent(in) :: s
-      type (mesh_type), intent(inout) :: grid
-
-      integer :: iEdge, iCell, k, cell1, cell2, iq
-
-      integer :: nCells, nEdges, nVertLevels
-
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertLevels = grid % nVertLevels
-
-      grid % qtot % array = 0.
-      grid % cqu % array = 1.
-
-      if (s % num_scalars &gt; 0) then
-
-        do iCell = 1, nCells
-          do k = 1, nVertLevels
-            do iq = s % moist_start, s % moist_end
-              grid % qtot % array(k,iCell) = grid % qtot % array(k,iCell) + s % scalars % array (iq, k, iCell)
-            end do
-          end do
-        end do
-
-        do iEdge = 1, nEdges
-          do k = 1, nVertLevels
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            grid % cqu % array(k,iEdge) = 1./( 1. + 0.5*(grid % qtot % array(k,cell1)+grid % qtot % array(k,cell2)) )
-          end do
-        end do
-
-      end if
-
-      end subroutine compute_solver_constants
-
-!------------------------------------------------------------------------------------------------------------------
-
-   subroutine compute_state_diagnostics(s, grid)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Compute diagnostic variables
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - computed diagnostics (parallel velocities, v; mass fluxes, vh; 
-   !                circulation; vorticity; and kinetic energy, ke) and the 
-   !                tendencies for height (h) and u (u)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (state_type), intent(inout) :: s
-      type (mesh_type), intent(inout) :: grid
-
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalar
-      real (kind=RKIND), dimension(:,:), pointer :: h, pressure, qtot, alpha, geopotential, theta
-      real (kind=RKIND), dimension(:,:), pointer :: theta_old, ww_old, u_old, u, ww, h_edge_old, h_edge, h_old
-      real (kind=RKIND), dimension(:), pointer :: surface_pressure, dbn, dnu, dnw
-
-      integer :: iEdge, iCell, k, cell1, cell2, iq
-      integer :: nCells, nEdges, nVertLevels
-
-      real (kind=RKIND) :: p0,tm,ptop,ptmp
-
-      h                =&gt; s % h % array
-      theta            =&gt; s % theta % array
-      pressure         =&gt; s % pressure % array
-      qtot             =&gt; grid % qtot % array
-      surface_pressure =&gt; s % surface_pressure % array
-      alpha            =&gt; s % alpha % array
-      geopotential     =&gt; s % geopotential % array
-      scalar           =&gt; s % scalars % array
-      theta_old        =&gt; grid % theta_old % array
-      u_old            =&gt; grid % u_old % array
-      ww_old           =&gt; grid % ww_old % array
-      h_old            =&gt; grid % h_old % array
-      h_edge_old       =&gt; grid % h_edge_old % array
-      h_edge           =&gt; s % h_edge % array
-      u                =&gt; s % u % array
-      ww               =&gt; s % ww % array
-
-      dbn              =&gt; grid % dbn % array
-      dnu              =&gt; grid % dnu % array
-      dnw              =&gt; grid % dnw % array
-
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertLevels = grid % nVertLevels
-
-
-
-!      ptop        = grid % ptop
-!      p0          = grid % p0
-!       ptop = 219.4067
-       p0 = 1e+05
-       ptop = pressure(nVertLevels+1,1)
-
-!       write(0,*) ' ptop in compute_state_diagnostics ',ptop
-
-!*****************************
-
-      do iCell = 1, nCells
-        do k=1,nVertLevels
-          h(k,iCell) = (1.-dbn(k))*(p0-ptop)+dbn(k)*(surface_pressure(iCell)-ptop)
-        end do
-
-        do k = nVertLevels, 1, -1
-          pressure(k,iCell) = pressure(k+1,iCell) - dnw(k)*(1.+qtot(k,iCell))*h(k,iCell)
-        end do
-
-        do k=1, nVertLevels
-          ! note that theta is not coupled here
-          tm = (1.+1.61*scalar(1,k,iCell))*theta(k,iCell)  !  assume scalar(1) is qv here?
-          alpha(k,iCell) = (rgas/p0)*tm*(0.5*(pressure(k+1,iCell)+pressure(k,iCell))/p0)**cvpm
-          geopotential(k+1,iCell) = geopotential(k,iCell) - dnw(k)*h(k,iCell)*alpha(k,iCell)
-        end do
-      end do
-
-      theta_old(:,:) = theta(:,:)
-      ww_old(:,:) = ww(:,:)
-      u_old(:,:) = u(:,:)
-      h_edge_old(:,:) = h_edge(:,:)
-      h_old(:,:) = h(:,:)
-
-      end subroutine compute_state_diagnostics
-
-!------------------------------------------------------------------------------------------
-
-   subroutine compute_dyn_tend(tend, s, grid)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Compute height and normal wind tendencies, as well as diagnostic variables
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - computed diagnostics (parallel velocities, v; mass fluxes, vh; 
-   !                circulation; vorticity; and kinetic energy, ke) and the 
-   !                tendencies for height (h) and u (u)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (tend_type), intent(inout) :: tend
-      type (state_type), intent(in) :: s
-      type (mesh_type), intent(in) :: grid
-
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
-      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, upstream_bias
-
-      integer :: nCells, nEdges, nVertices, nVertLevels
-      real (kind=RKIND) :: h_mom_eddy_visc2,   v_mom_eddy_visc2,   h_mom_eddy_visc4
-      real (kind=RKIND) :: h_theta_eddy_visc2, v_theta_eddy_visc2, h_theta_eddy_visc4
-      real (kind=RKIND) :: u_diffusion
-      real (kind=RKIND), dimension(:), pointer :: h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, p_s
-      real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, tend_h, tend_u, &amp;
-                                                    circulation, divergence, vorticity, ke, pv_edge, geopotential, theta, ww, &amp;
-                                                    h_diabatic, tend_theta
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
-
-      real (kind=RKIND), dimension( grid % nVertLevels + 1 ) :: wdtn, wdun
-      real (kind=RKIND) :: theta_edge, theta_turb_flux, z1, z2, z3, z4, zm, z0, zp, r
-      real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2
-
-      real (kind=RKIND), dimension(:), pointer :: rdnu, rdnw, fnm, fnp
-
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_theta, delsq_divergence
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
-
-      h            =&gt; s % h % array
-      u            =&gt; s % u % array
-      h_edge       =&gt; s % h_edge % array
-      circulation  =&gt; s % circulation % array
-      divergence   =&gt; s % divergence % array
-      vorticity    =&gt; s % vorticity % array
-      ke           =&gt; s % ke % array
-      pv_edge      =&gt; s % pv_edge % array
-      geopotential =&gt; s % geopotential % array
-      theta        =&gt; s % theta % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array  
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      fEdge             =&gt; grid % fEdge % array
-      deriv_two         =&gt; grid % deriv_two % array
-
-      vh          =&gt; tend % vh % array
-      tend_u      =&gt; tend % u % array
-      tend_theta  =&gt; tend % theta % array
-      h_diabatic  =&gt; grid % h_diabatic % array
-
-      ww          =&gt; s % ww % array
-      rdnu        =&gt; grid % rdnu % array
-      rdnw        =&gt; grid % rdnw % array
-      fnm         =&gt; grid % fnm % array
-      fnp         =&gt; grid % fnp % array
-                  
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertLevels = grid % nVertLevels
-      nVertices   = grid % nVertices
-
-      h_mom_eddy_visc2 = config_h_mom_eddy_visc2
-      h_mom_eddy_visc4 = config_h_mom_eddy_visc4
-      v_mom_eddy_visc2 = config_v_mom_eddy_visc2
-      h_theta_eddy_visc2 = config_h_theta_eddy_visc2
-      h_theta_eddy_visc4 = config_h_theta_eddy_visc4
-      v_theta_eddy_visc2 = config_v_theta_eddy_visc2
-
-
-      !
-      ! Compute u (normal) velocity tendency for each edge (cell face)
-      !
-
-      tend_u(:,:) = 0.0
-
-#ifdef LANL_FORMULATION
-      do iEdge=1,grid % nEdgesSolve
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         do k=1,nVertLevels
-            q = 0.0
-            do j = 1,nEdgesOnEdge(iEdge)
-               eoe = edgesOnEdge(j,iEdge)
-               workpv = 0.5 * (pv_edge(k,iEdge) + pv_edge(k,eoe))
-               q = q + weightsOnEdge(j,iEdge) * u(k,eoe) * workpv * h_edge(k,eoe) 
-            end do
-            tend_u(k,iEdge) = q - (ke(k,cell2) - ke(k,cell1)) / dcEdge(iEdge)
-         end do
-      end do
-
-#endif
-
-#ifdef NCAR_FORMULATION
-      !
-      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
-      !
-      vh(:,:) = 0.0
-      do iEdge=1,grid % nEdgesSolve
-         do j=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(j,iEdge)
-            do k=1,nVertLevels
-               vh(k,iEdge) = vh(k,iEdge) + weightsOnEdge(j,iEdge) * u(k,eoe) * h_edge(k,eoe)
-            end do
-         end do
-      end do
-
-      do iEdge=1,grid % nEdgesSolve
-         vertex1 = verticesOnEdge(1,iEdge)
-         vertex2 = verticesOnEdge(2,iEdge)
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         do k=1,nVertLevels
-            vorticity_abs = fEdge(iEdge) + (circulation(k,vertex1) + circulation(k,vertex2)) / &amp;
-                                           (areaTriangle(vertex1) + areaTriangle(vertex2))
-
-            workpv = 2.0 * vorticity_abs / (h(k,cell1) + h(k,cell2))
-
-            tend_u(k,iEdge) = workpv * vh(k,iEdge) - (ke(k,cell2) - ke(k,cell1)) / dcEdge(iEdge)
-         end do
-      end do
-#endif
-
-
-      !
-      !  horizontal mixing for u
-      !
-      if ( h_mom_eddy_visc2 &gt; 0.0 ) then
-         do iEdge=1,grid % nEdgesSolve
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            vertex1 = verticesOnEdge(1,iEdge)
-            vertex2 = verticesOnEdge(2,iEdge)
-
-            do k=1,nVertLevels
-
-               !
-               ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="red">abla vorticity
-               !                    only valid for h_mom_eddy_visc2 == constant
-               !
-               u_diffusion =   ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-                              -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
-               u_diffusion = h_mom_eddy_visc2 * u_diffusion

-               tend_u(k,iEdge) = tend_u(k,iEdge) + u_diffusion
-            end do
-         end do
-      end if
-
-      if ( h_mom_eddy_visc4 &gt; 0.0 ) then
-
-         allocate(delsq_divergence(nVertLevels, nCells+1))
-         allocate(delsq_u(nVertLevels, nEdges+1))
-         allocate(delsq_circulation(nVertLevels, nVertices+1))
-         allocate(delsq_vorticity(nVertLevels, nVertices+1))
-
-         delsq_u(:,:) = 0.0
-
-         do iEdge=1,grid % nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            vertex1 = verticesOnEdge(1,iEdge)
-            vertex2 = verticesOnEdge(2,iEdge)
-
-            do k=1,nVertLevels
-   
-               !
-               ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="red">abla vorticity
-               !                    only valid for h_mom_eddy_visc4 == constant
-               !
-               u_diffusion =   ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-                              -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)

-               delsq_u(k,iEdge) = delsq_u(k,iEdge) + u_diffusion
-            end do
-         end do
-
-         delsq_circulation(:,:) = 0.0
-         do iEdge=1,nEdges
-            do k=1,nVertLevels
-               delsq_circulation(k,verticesOnEdge(1,iEdge)) = delsq_circulation(k,verticesOnEdge(1,iEdge)) - dcEdge(iEdge) * delsq_u(k,iEdge)
-               delsq_circulation(k,verticesOnEdge(2,iEdge)) = delsq_circulation(k,verticesOnEdge(2,iEdge)) + dcEdge(iEdge) * delsq_u(k,iEdge)
-            end do
-         end do
-         do iVertex=1,nVertices
-            r = 1.0 / areaTriangle(iVertex)
-            do k=1,nVertLevels
-               delsq_vorticity(k,iVertex) = delsq_circulation(k,iVertex) * r
-            end do
-         end do
-
-         delsq_divergence(:,:) = 0.0
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            do k=1,nVertLevels
-              delsq_divergence(k,cell1) = delsq_divergence(k,cell1) + delsq_u(k,iEdge)*dvEdge(iEdge)
-              delsq_divergence(k,cell2) = delsq_divergence(k,cell2) - delsq_u(k,iEdge)*dvEdge(iEdge)
-            end do
-         end do
-         do iCell = 1,nCells
-            r = 1.0 / areaCell(iCell)
-            do k = 1,nVertLevels
-               delsq_divergence(k,iCell) = delsq_divergence(k,iCell) * r
-            end do
-         end do
-
-         do iEdge=1,grid % nEdgesSolve
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            vertex1 = verticesOnEdge(1,iEdge)
-            vertex2 = verticesOnEdge(2,iEdge)
-
-            do k=1,nVertLevels
-
-               !
-               ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="gray">abla vorticity
-               !                    only valid for h_mom_eddy_visc4 == constant
-               !
-               u_diffusion =   ( delsq_divergence(k,cell2)  - delsq_divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-                              -( delsq_vorticity(k,vertex2) - delsq_vorticity(k,vertex1) ) / dvEdge(iEdge)

-               tend_u(k,iEdge) = tend_u(k,iEdge) - h_mom_eddy_visc4 * u_diffusion
-            end do
-         end do
-
-         deallocate(delsq_divergence)
-         deallocate(delsq_u)
-         deallocate(delsq_circulation)
-         deallocate(delsq_vorticity)
-
-      end if
-
-
-      !
-      !  vertical advection for u
-      !
-      do iEdge=1,grid % nEdgesSolve
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         wdun(1) = 0.
-         do k=2,nVertLevels
-            wdun(k) =                                                                                  &amp;
-                     (ww(k,cell1)/(h(k,cell1)+h(k-1,cell1)) +ww(k,cell2)/(h(k,cell2)+h(k-1,cell2)))*   &amp;
-                      rdnu(k)*(u(k,iEdge)-u(k-1,iEdge))
-         end do
-         wdun(nVertLevels+1) = 0.
-
-         do k=1,nVertLevels
-            tend_u(k,iEdge) = tend_u(k,iEdge) - 0.5*(wdun(k+1)+wdun(k))
-         end do
-      end do
-
-
-      !
-      !  vertical mixing for u - 2nd order 
-      !
-      if ( v_mom_eddy_visc2 &gt; 0.0 ) then
-
-         do iEdge=1,grid % nEdgesSolve
-   
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-    
-            do k=2,nVertLevels-1
-    
-               z1 = 0.5*(geopotential(k-1,cell1)+geopotential(k-1,cell2))/gravity
-               z2 = 0.5*(geopotential(k  ,cell1)+geopotential(k  ,cell2))/gravity
-               z3 = 0.5*(geopotential(k+1,cell1)+geopotential(k+1,cell2))/gravity
-               z4 = 0.5*(geopotential(k+2,cell1)+geopotential(k+2,cell2))/gravity
-     
-               zm = 0.5*(z1+z2)
-               z0 = 0.5*(z2+z3)
-               zp = 0.5*(z3+z4)
-     
-               tend_u(k,iEdge) = tend_u(k,iEdge) + v_mom_eddy_visc2*(                 &amp;
-                                  (u(k+1,iEdge)-u(k  ,iEdge))/(zp-z0)                 &amp;
-                                 -(u(k  ,iEdge)-u(k-1,iEdge))/(z0-zm) )/(0.5*(zp-zm))
-            end do
-         end do
-
-      end if
-
-
-!----------- rhs for theta
-
-      tend_theta(:,:) = 0.
-
-
-      !
-      !  horizontal mixing for theta - we could combine this with advection directly (i.e. as a turbulent flux),
-      !  but here we can also code in hyperdiffusion if we wish (2nd order at present)
-      !
-      if ( h_theta_eddy_visc2 &gt; 0.0 ) then
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-
-            do k=1,grid % nVertLevels
-               theta_turb_flux = h_theta_eddy_visc2*prandtl*(theta(k,cell2) - theta(k,cell1))/dcEdge(iEdge)
-               flux = dvEdge (iEdge) * h_edge(k,iEdge) * theta_turb_flux
-               tend_theta(k,cell1) = tend_theta(k,cell1) + flux
-               tend_theta(k,cell2) = tend_theta(k,cell2) - flux
-            end do 
-
-         end do 
-
-      end if 
-
-      if ( h_theta_eddy_visc4 &gt; 0.0 ) then
-
-         allocate(delsq_theta(nVertLevels, nCells+1))
-
-         delsq_theta(:,:) = 0.
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-
-            do k=1,grid % nVertLevels
-               delsq_theta(k,cell1) = delsq_theta(k,cell1) + dvEdge(iEdge)*h_edge(k,iEdge)*(theta(k,cell2) - theta(k,cell1))/dcEdge(iEdge)
-               delsq_theta(k,cell2) = delsq_theta(k,cell2) - dvEdge(iEdge)*h_edge(k,iEdge)*(theta(k,cell2) - theta(k,cell1))/dcEdge(iEdge)
-            end do 
-
-         end do 
-
-         do iCell = 1, nCells
-            r = 1.0 / areaCell(iCell)
-            do k=1,nVertLevels
-               delsq_theta(k,iCell) = delsq_theta(k,iCell) * r
-            end do
-         end do
-
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-
-            do k=1,grid % nVertLevels
-               theta_turb_flux = h_theta_eddy_visc4*prandtl*(delsq_theta(k,cell2) - delsq_theta(k,cell1))/dcEdge(iEdge)
-               flux = dvEdge (iEdge) * theta_turb_flux
-
-               tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-               tend_theta(k,cell2) = tend_theta(k,cell2) + flux
-            end do 
-
-         end do 
-
-         deallocate(delsq_theta)
-
-      end if 
-
-
-      !
-      !  horizontal advection for theta
-      !
-
-      if (config_theta_adv_order == 2) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            do k=1,grid % nVertLevels
-               flux = dvEdge(iEdge) *  h_edge(k,iEdge) * u(k,iEdge) * (      &amp;
-                                      0.5*(theta(k,cell1) + theta(k,cell2)) )
-               tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-               tend_theta(k,cell2) = tend_theta(k,cell2) + flux
-            end do 
-         end do 
-
-      else if (config_theta_adv_order == 3) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-  
-            do k=1,grid % nVertLevels
-   
-               d2fdx2_cell1 = deriv_two(1,1,iEdge) * theta(k,cell1)
-               d2fdx2_cell2 = deriv_two(1,2,iEdge) * theta(k,cell2)
-               do i=1, grid % nEdgesOnCell % array (cell1)
-                  d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * theta(k,grid % CellsOnCell % array (i,cell1))
-               end do
-               do i=1, grid % nEdgesOnCell % array (cell2)
-                  d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * theta(k,grid % CellsOnCell % array (i,cell2))
-               end do

-!  3rd order stencil
-               if( u(k,iEdge) &gt; 0) then
-                  flux = dvEdge(iEdge) *  h_edge(k,iEdge) * u(k,iEdge) * (          &amp;
-                                         0.5*(theta(k,cell1) + theta(k,cell2))      &amp;
-                                         -(dcEdge(iEdge) **2) * (d2fdx2_cell1) / 6. )
-               else
-                  flux = dvEdge(iEdge) *  h_edge(k,iEdge) * u(k,iEdge) * (          &amp;
-                                         0.5*(theta(k,cell1) + theta(k,cell2))      &amp;
-                                         -(dcEdge(iEdge) **2) * (d2fdx2_cell2) / 6. )
-               end if
-   
-               tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-               tend_theta(k,cell2) = tend_theta(k,cell2) + flux

-            end do 
-         end do 
-
-      else  if (config_theta_adv_order == 4) then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-
-            do k=1,grid % nVertLevels
-   
-               d2fdx2_cell1 = deriv_two(1,1,iEdge) * theta(k,cell1)
-               d2fdx2_cell2 = deriv_two(1,2,iEdge) * theta(k,cell2)
-               do i=1, grid % nEdgesOnCell % array (cell1)
-                  d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * theta(k,grid % CellsOnCell % array (i,cell1))
-               end do
-               do i=1, grid % nEdgesOnCell % array (cell2)
-                  d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * theta(k,grid % CellsOnCell % array (i,cell2))
-               end do
-   
-               flux = dvEdge(iEdge) *  h_edge(k,iEdge) * u(k,iEdge) * (          &amp;
-                                      0.5*(theta(k,cell1) + theta(k,cell2))      &amp;
-                                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
-  
-               tend_theta(k,cell1) = tend_theta(k,cell1) - flux
-               tend_theta(k,cell2) = tend_theta(k,cell2) + flux
-            end do 

-         end do
-      end if
-
-
-      !
-      !  vertical advection plus diabatic term
-      !  Note: we are also dividing through by the cell area after the horizontal flux divergence
-      !
-      do iCell = 1, nCells
-         wdtn(1) = 0.
-         do k=2,nVertLevels
-            wdtn(k) =  ww(k,icell)*(fnm(k)*theta(k,iCell)+fnp(k)*theta(k-1,iCell))
-         end do
-         wdtn(nVertLevels+1) = 0.
-         do k=1,nVertLevels
-            tend_theta(k,iCell) = tend_theta(k,iCell)/areaCell(iCell) -rdnw(k)*(wdtn(k+1)-wdtn(k))
-!!           tend_theta(k,iCell) = tend_theta(k) + h(k,iCell)*h_diabatic(k,iCell)
-         end do
-      end do
-
-
-      !
-      !  vertical mixing for theta - 2nd order 
-      !
-      if ( v_theta_eddy_visc2 &gt; 0.0 ) then
-
-         do iCell = 1, grid % nCellsSolve
-            do k=2,nVertLevels-1
-               z1 = geopotential(k-1,iCell)/gravity
-               z2 = geopotential(k  ,iCell)/gravity
-               z3 = geopotential(k+1,iCell)/gravity
-               z4 = geopotential(k+2,iCell)/gravity
-     
-               zm = 0.5*(z1+z2)
-               z0 = 0.5*(z2+z3)
-               zp = 0.5*(z3+z4)
-     
-               tend_theta(k,iCell) = tend_theta(k,iCell) + v_theta_eddy_visc2*prandtl*h(k,iCell)*(  &amp;
-                                        (theta(k+1,iCell)-theta(k  ,iCell))/(zp-z0)                 &amp;
-                                       -(theta(k  ,iCell)-theta(k-1,iCell))/(z0-zm) )/(0.5*(zp-zm))
-            end do
-         end do
-
-      end if
-
-   end subroutine compute_dyn_tend
-
-!---------------------------------------------------------------------------------------------------------
-
-   subroutine advance_dynamics(tend, s, grid, small_step, number_small_steps, dt)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Advance the dry dynamics a small timestep (forward-backward integration)
-   !
-   ! Input: s - current model state
-   !        tend - large-timestep tendency (d*/dt)
-   !        grid - grid metadata
-   !        dt   - timestep
-   !
-   ! Output: s - model state advanced a timestep dt
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (tend_type), intent(in) :: tend
-      type (state_type), intent(inout) :: s
-      type (mesh_type), intent(in) :: grid
-      real (kind=RKIND), intent(in) :: dt
-      integer, intent(in) :: small_step, number_small_steps
-
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
-      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, upstream_bias
-
-      integer :: nEdges, nVertices, nVertLevels
-      real (kind=RKIND), dimension(:), pointer :: h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, dpsdt, &amp;
-                                                  surface_pressure
-      real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, tend_h, tend_u, &amp;
-                                                    circulation, vorticity, ke, pv_edge, geopotential, alpha, theta,       &amp;
-                                                    pressure, pressure_old, tend_theta, uhAvg, wwAvg, ww, u_old,           &amp;
-                                                    theta_old, h_edge_old, qtot, ww_old, cqu, h_old
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalar
-
-!      real (kind=RKIND), pointer :: smext, p0, ptop
-      real (kind=RKIND) :: smext, smdiv, p0, ptop
-      real (kind=RKIND) :: tm, ptmp, he_old
-
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
-
-      real (kind=RKIND), dimension( grid % nVertLevels + 1) :: wdtn
-
-      real (kind=RKIND), dimension(:), pointer :: dnw, dbn, rdnw, dnu, fnm, fnp
-      real (kind=RKIND) :: maxpdt,minpdt, maxww, minww
-      integer :: maxpt,minpt
-
-      h            =&gt; s % h % array
-      u            =&gt; s % u % array
-      h_edge       =&gt; s % h_edge % array
-      theta        =&gt; s % theta % array
-
-!      u_old        =&gt; s_old % u % array
-!      h_edge_old   =&gt; s_old % h_edge % array
-!      theta_old    =&gt; s_old % theta % array
-!      ww_old      =&gt; s_old % ww % array
-!      h_old       =&gt; s_old % h % array
-      u_old        =&gt; grid % u_old % array
-      h_edge_old   =&gt; grid % h_edge_old % array
-      theta_old    =&gt; grid % theta_old % array
-      ww_old      =&gt; grid % ww_old % array
-      h_old       =&gt; grid % h_old % array
-
-      geopotential =&gt; s % geopotential % array
-      alpha        =&gt; s % alpha % array
-      surface_pressure     =&gt; s % surface_pressure % array
-      pressure     =&gt; s % pressure % array
-      pressure_old =&gt; grid % pressure_old % array
-
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      tend_h      =&gt; tend % h % array
-      tend_u      =&gt; tend % u % array
-      tend_theta      =&gt; tend % theta % array
-                  
-
-      uhAvg       =&gt; grid % uhAvg % array
-      wwAvg       =&gt; grid % wwAvg % array
-      dpsdt       =&gt; grid % dpsdt % array
-      qtot        =&gt; grid % qtot % array
-      cqu         =&gt; grid % cqu % array
-      ww          =&gt; s % ww % array
-      scalar      =&gt; s % scalars % array
-
-      dnw         =&gt; grid % dnw % array
-      dbn         =&gt; grid % dbn % array
-      dnu         =&gt; grid % dnu % array
-      rdnw        =&gt; grid % rdnw % array
-      fnm         =&gt; grid % fnm % array
-      fnp         =&gt; grid % fnp % array
-
-!      p0          =&gt; grid % p0
-!      ptop        =&gt; grid % ptop
-!      smext       =&gt; grid % smext
-
-      nVertLevels = grid % nVertLevels
-      nEdges = grid % nEdges
-
-      p0 = 1.e+05
-      ptop = pressure(nVertLevels+1,1)
-      smext = 0.1
-      smdiv = 0.1
-
-!       write(0,*) ' ptop in advance_dynamics ',ptop
-
-!---  begin computations
-
-!  we assume that the pressure, alpha, geopotential are already properly set
-!  in first small step of a set, couple theta
-
-      if(small_step == 1) then
-
-        do iCell=1,grid % nCells
-           do k=1,nVertLevels
-              theta(k,iCell) = theta(k,iCell)*h(k,iCell)
-           end do
-        end do
-
-        uhAvg = 0.
-        wwAvg = 0.
-        pressure_old(:,:) = pressure(:,:)
-        dpsdt(:) = 0.
-
-      end if
-
-      !
-      !  update horizontal momentum
-      !
-
-      do iEdge=1,grid % nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=1,nVertLevels
-            u(k,iEdge) = u(k,iEdge) + dt*tend_u(k,iEdge)                 &amp;
-                               -(0.5*dt/dcEdge(iEdge))*(                 &amp;
-                 (geopotential(k+1,cell2)-geopotential(k+1,cell1))       &amp;
-                +(geopotential(k  ,cell2)-geopotential(k  ,cell1))       &amp;
-                +cqu(k,iEdge)*(alpha(k,cell2)+alpha(k,cell1))*           &amp;
-                       0.5*(pressure(k+1,cell2)-pressure(k+1,cell1)      &amp;
-                           +pressure(k  ,cell2)-pressure(k  ,cell1)))    &amp;
-                      -smext*dcEdge(iEdge)*(dpsdt(cell2)-dpsdt(cell1))/h_edge(k,iEdge)
-         end do
-      end do
-
-      !
-      !  calculate omega, update theta
-      !
-
-      tend_h = 0.
-      do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            do k=1,nVertLevels
-               flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge)
-               tend_h(k,cell1) = tend_h(k,cell1) + flux
-               tend_h(k,cell2) = tend_h(k,cell2) - flux
-            end do 
-            do k=1,nVertLevels
-               uhAvg(k,iEdge) = uhAvg(k,iEdge) + u(k,iEdge) * h_edge(k,iEdge)
-            end do 
-      end do 
-
-      do iCell=1, grid % nCells
-        dpsdt(iCell) = 0.
-        do k=1,nVertLevels
-          dpsdt(iCell) = dpsdt(iCell) + dnw(k)*tend_h(k,iCell)
-        end do
-        dpsdt(iCell) = dpsdt(iCell)/areaCell(iCell)
-
-        surface_pressure(iCell) = surface_pressure(iCell) + dt*dpsdt(iCell)
-
-        do k=1,nVertLevels
-          h(k,iCell) = (1.-dbn(k))*(p0-ptop)+dbn(k)*(surface_pressure(iCell)-ptop)
-        end do
-
-        ! omega calculation
-
-        ww(1,iCell) = 0.
-        do k=2, nVertLevels
-          ww(k,iCell) = ww(k-1,iCell)-dnw(k-1)*(dbn(k-1)*dpsdt(iCell)+tend_h(k-1,iCell)/areaCell(iCell))
-          wwAvg(k,iCell) = wwAvg(k,iCell) + ww(k,iCell)
-        end do
-        ww(nVertLevels+1,iCell) = 0.
-
-        ! theta update  - theta should be coupled at this point...
-
-        wdtn(1) = 0.
-        do k = 2, nVertLevels
-          wdtn(k) = (ww(k,iCell)-ww_old(k,iCell))*(fnm(k)*theta_old(k,iCell)+fnp(k)*theta_old(k-1,iCell))
-        end do
-        wdtn(nVertLevels+1) = 0.
-
-        do k = 1, nVertLevels
-          theta(k,iCell) = theta(k,iCell) + dt*tend_theta(k,iCell)
-          theta(k,iCell) = theta(k,iCell) - dt*rdnw(k)*(wdtn(k+1)-wdtn(k))
-        end do
-      end do
-
-      !
-      ! add in perturbation horizontal flux divergence
-      !
-
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=1,nVertLevels
-            h_edge(k,iEdge) = 0.5*(h(k,cell1)+h(k,cell2))  !  here is update of h_edge
-            he_old = 0.5*(h_old(k,cell1)+h_old(k,cell2))
-            flux = 0.5*(u(k,iEdge) * h_edge(k,iEdge) - u_old(k,iEdge) * he_old)* &amp;
-                        (theta_old(k,cell1)+theta_old(k,cell2))*dvEdge(iEdge)
-            theta(k,cell1) = theta(k,cell1) - dt*flux/areaCell(cell1)
-            theta(k,cell2) = theta(k,cell2) + dt*flux/areaCell(cell2)
-         end do
-      end do
-
-
-      !  compute some diagnostics using the new state
-
-      do iCell = 1, grid % nCells
-
-        do k = nVertLevels,1,-1
-          pressure(k,iCell) = pressure(k+1,iCell) - dnw(k)*(1.+qtot(k,iCell))*h(k,iCell) 
-        end do
-
-        do k=1, nVertLevels
-          tm = (1.+1.61*scalar(1,k,iCell))*theta(k,iCell)/h(k,iCell)  !  assume scalar(1) is qv here?
-          alpha(k,iCell) = (rgas/p0)*tm*  &amp;
-              (0.5*(pressure(k,iCell)+pressure(k+1,iCell))/p0)**cvpm
-          geopotential(k+1,iCell) = geopotential(k,iCell) - dnw(k)*h(k,iCell)*alpha(k,iCell)
-        end do
-
-        if(small_step /= number_small_steps) then
-          do k=1, nVertLevels+1
-            ptmp = pressure(k,iCell)
-            pressure(k,iCell) = pressure(k,iCell) + smdiv*(pressure(k,iCell)-pressure_old(k,iCell))
-            pressure_old(k,iCell) = ptmp
-          end do
-        end if
-
-      end do
-
-!  if last small step of a set, decouple theta
-
-      if(small_step == number_small_steps) then
-        do iCell=1,grid % nCells
-           do k=1,nVertLevels
-              theta(k,iCell) = theta(k,iCell)/h(k,iCell)
-           end do
-        end do
-        uhAvg = uhAvg/real(number_small_steps)
-        wwAvg = wwAvg/real(number_small_steps)
-      end if
-
-   end subroutine advance_dynamics
-
-
-   subroutine advance_scalars( tend, s_old, s_new, grid, dt)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - computed scalar tendencies
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (tend_type), intent(in) :: tend
-      type (state_type), intent(in) :: s_old
-      type (state_type), intent(inout) :: s_new
-      type (mesh_type), intent(in) :: grid
-      real (kind=RKIND) :: dt
-
-      integer :: i, iCell, iEdge, k, iScalar, cell1, cell2, num_scalars
-      real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2
-
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalar_old, scalar_new, scalar_tend
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      real (kind=RKIND), dimension(:,:), pointer :: uhAvg, h_old, h_new, wwAvg
-      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
-      integer, dimension(:,:), pointer :: cellsOnEdge
-
-      real (kind=RKIND), dimension( s_old % num_scalars, grid % nVertLevels + 1 ) :: wdtn
-      integer :: nVertLevels
-
-      real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw
-      real (kind=RKIND) :: coef_3rd_order
-
-      num_scalars = s_old % num_scalars
-
-      coef_3rd_order = 0.
-      if (config_scalar_adv_order == 3) coef_3rd_order = 1.0
-      if (config_scalar_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
-
-      scalar_old  =&gt; s_old % scalars % array
-      scalar_new  =&gt; s_new % scalars % array
-      deriv_two   =&gt; grid % deriv_two % array
-      uhAvg       =&gt; grid % uhAvg % array
-      dvEdge      =&gt; grid % dvEdge % array
-      dcEdge      =&gt; grid % dcEdge % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      scalar_tend =&gt; tend % scalars % array
-      h_old       =&gt; s_old % h % array
-      h_new       =&gt; s_new % h % array
-      wwAvg       =&gt; grid % wwAvg % array
-      areaCell    =&gt; grid % areaCell % array
-
-      fnm         =&gt; grid % fnm % array
-      fnp         =&gt; grid % fnp % array
-      rdnw        =&gt; grid % rdnw % array
-
-      nVertLevels = grid % nVertLevels
-
-      scalar_tend = 0.  !  testing purposes - we have no sources or sinks
-
-      !
-      ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts form scalar_old
-      !
-      !
-      !  horizontal flux divergence, accumulate in scalar_tend
-
-      if (config_scalar_adv_order == 2) then
-
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            do k=1,grid % nVertLevels
-               do iScalar=1,num_scalars
-                  scalar_edge = 0.5 * (scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))
-                  flux = uhAvg(k,iEdge) * dvEdge(iEdge)  * scalar_edge
-                  scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) - flux/areaCell(cell1)
-                  scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) + flux/areaCell(cell2)
-               end do 
-            end do 
-         end do 
-
-      else if (config_scalar_adv_order == 3) then
-
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-  
-            do k=1,grid % nVertLevels
-   
-               do iScalar=1,num_scalars
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                     d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                                    deriv_two(i+1,1,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell1))
-                  end do
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                     d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                                    deriv_two(i+1,2,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell2))
-                  end do
-
-                  if (uhAvg(k,iEdge) &gt; 0) then
-                     flux = dvEdge(iEdge) * uhAvg(k,iEdge) * (          &amp;
-                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                                             -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                  else
-                     flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
-                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                                             +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                  end if
-
-! old version of the above code, with coef_3rd_order assumed to be 1.0
-!                  if (uhAvg(k,iEdge) &gt; 0) then
-!                     flux = dvEdge(iEdge) * uhAvg(k,iEdge) * (          &amp;
-!                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-!                                            -(dcEdge(iEdge) **2) * (d2fdx2_cell1) / 6. )
-!                  else
-!                     flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
-!                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-!                                            -(dcEdge(iEdge) **2) * (d2fdx2_cell2) / 6. )
-!                  end if
-   
-                  scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) - flux/areaCell(cell1)
-                  scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) + flux/areaCell(cell2)

-               end do 
-            end do 
-         end do 
-
-      else  if (config_scalar_adv_order == 4) then
-
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-
-            do k=1,grid % nVertLevels
-   
-               do iScalar=1,num_scalars
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                        d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                                       deriv_two(i+1,1,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell1))
-                  end do
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                     d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                                    deriv_two(i+1,2,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell2))
-                  end do
-      
-                  flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
-                                         0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                          -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
-     
-                  scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) - flux/areaCell(cell1)
-                  scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) + flux/areaCell(cell2)
-               end do 
-            end do 

-         end do
-      end if
-
-
-      !
-      !  vertical flux divergence
-      !
-
-      do iCell=1,grid % nCells
-
-        wdtn(:,1) = 0.
-        do k = 2, nVertLevels
-          do iScalar=1,num_scalars
-            wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
-          end do
-        end do
-        wdtn(:,nVertLevels+1) = 0.
-
-         do k=1,grid % nVertLevelsSolve
-            do iScalar=1,num_scalars
-              scalar_new(iScalar,k,iCell) = (   scalar_old(iScalar,k,iCell)*h_old(k,iCell) &amp;
-                    + dt*( scalar_tend(iScalar,k,iCell) -rdnw(k)*(wdtn(iScalar,k+1)-wdtn(iScalar,k)) ) )/h_new(k,iCell)
-                                                                                        
-            end do
-         end do
-      end do
-
-   end subroutine advance_scalars
-
-
-   subroutine advance_scalars_mono( tend, s_old, s_new, grid, dt, rk_step, rk_order, dminfo, cellsToSend, cellsToRecv)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - computed scalar tendencies
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (tend_type), intent(in) :: tend
-      type (state_type), intent(in) :: s_old
-      type (state_type), intent(inout) :: s_new
-      type (mesh_type), intent(in) :: grid
-      integer, intent(in) :: rk_step, rk_order
-      real (kind=RKIND), intent(in) :: dt
-      type (dm_info), intent(in) :: dminfo
-      type (exchange_list), pointer :: cellsToSend, cellsToRecv
-
-      integer :: i, iCell, iEdge, k, iScalar, cell_upwind, cell1, cell2, num_scalars
-      real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2
-      real (kind=RKIND) :: fdir, flux_upwind, h_flux_upwind, s_upwind
-
-      real (kind=RKIND), dimension(:,:,:), pointer :: scalar_old, scalar_new, scalar_tend
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      real (kind=RKIND), dimension(:,:), pointer :: uhAvg, h_old, h_new, wwAvg
-      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
-      integer, dimension(:,:), pointer :: cellsOnEdge
-
-      real (kind=RKIND), dimension( s_old % num_scalars, grid % nEdges+1) :: h_flux
-      real (kind=RKIND), dimension( s_old % num_scalars, grid % nCells+1, 2 ) :: v_flux, v_flux_upwind, s_update
-      real (kind=RKIND), dimension( s_old % num_scalars, grid % nCells+1, 2 ) :: scale_out, scale_in
-      real (kind=RKIND), dimension( s_old % num_scalars ) :: s_max, s_min, s_max_update, s_min_update
-
-      integer :: nVertLevels, km0, km1, ktmp, kcp1, kcm1
-
-      real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw
-      real (kind=RKIND), parameter :: eps=1.e-20
-      real (kind=RKIND) :: coef_3rd_order
-
-      num_scalars = s_old % num_scalars
-
-      scalar_old  =&gt; s_old % scalars % array
-      scalar_new  =&gt; s_new % scalars % array
-      deriv_two   =&gt; grid % deriv_two % array
-      uhAvg       =&gt; grid % uhAvg % array
-      dvEdge      =&gt; grid % dvEdge % array
-      dcEdge      =&gt; grid % dcEdge % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      scalar_tend =&gt; tend % scalars % array
-      h_old       =&gt; s_old % h % array
-      h_new       =&gt; s_new % h % array
-      wwAvg       =&gt; grid % wwAvg % array
-      areaCell    =&gt; grid % areaCell % array
-
-      fnm         =&gt; grid % fnm % array
-      fnp         =&gt; grid % fnp % array
-      rdnw        =&gt; grid % rdnw % array
-
-      nVertLevels = grid % nVertLevels
-
-      scalar_tend = 0.  !  testing purposes - we have no sources or sinks
-
-      !
-      ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts from scalar_old
-      !
-
-      km1 = 1
-      km0 = 2
-      v_flux(:,:,km1) = 0.
-      v_flux_upwind(:,:,km1) = 0.
-      scale_out(:,:,:) = 1.
-      scale_in(:,:,:) = 1.
-
-      coef_3rd_order = 0.
-      if (config_scalar_adv_order == 3) coef_3rd_order = 1.0
-      if (config_scalar_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
-
-      do k = 1, grid % nVertLevels
-         kcp1 = min(k+1,grid % nVertLevels)
-         kcm1 = max(k-1,1)
-
-!  vertical flux
-
-         do iCell=1,grid % nCells
-
-            if (k &lt; grid % nVertLevels) then
-               cell_upwind = k
-               if (wwAvg(k+1,iCell) &gt;= 0) cell_upwind = k+1
-               do iScalar=1,num_scalars
-                  v_flux(iScalar,iCell,km0) = dt * wwAvg(k+1,iCell) *   &amp;
-                       (fnm(k+1) * scalar_new(iScalar,k+1,iCell) + fnp(k+1) * scalar_new(iScalar,k,iCell))
-                  v_flux_upwind(iScalar,iCell,km0) = dt * wwAvg(k+1,iCell) * scalar_old(iScalar,cell_upwind,iCell)
-                  v_flux(iScalar,iCell,km0) = v_flux(iScalar,iCell,km0) - v_flux_upwind(iScalar,iCell,km0)
-!                  v_flux(iScalar,iCell,km0) = 0.  ! use only upwind - for testing
-                  s_update(iScalar,iCell,km0) = scalar_old(iScalar,k,iCell) * h_old(k,iCell)  &amp;
-                            - rdnw(k) * (v_flux_upwind(iScalar,iCell,km0) - v_flux_upwind(iScalar,iCell,km1))
-               end do
-            else
-               do iScalar=1,num_scalars
-                  v_flux(iScalar,iCell,km0) = 0.
-                  v_flux_upwind(iScalar,iCell,km0) = 0.
-                  s_update(iScalar,iCell,km0) = scalar_old(iScalar,k,iCell) * h_old(k,iCell)  &amp;
-                            - rdnw(k) * (v_flux_upwind(iScalar,iCell,km0) - v_flux_upwind(iScalar,iCell,km1))
-               end do
-            end if
-
-         end do
-
-! horizontal flux
-
-         if (config_scalar_adv_order == 2) then
-
-            do iEdge=1,grid%nEdges
-               cell1 = cellsOnEdge(1,iEdge)
-               cell2 = cellsOnEdge(2,iEdge)
-               cell_upwind = cell2
-               if (uhAvg(k,iEdge) &gt;= 0) cell_upwind = cell1
-               do iScalar=1,num_scalars
-                  scalar_edge = 0.5 * (scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))
-                  h_flux(iScalar,iEdge) = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_edge
-                  h_flux_upwind = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_old(iScalar,k,cell_upwind)
-                  h_flux(iScalar,iEdge) = h_flux(iScalar,iEdge) - h_flux_upwind
-!                  h_flux(iScalar,iEdge) = 0.  ! use only upwind - for testing
-                  s_update(iScalar,cell1,km0) = s_update(iScalar,cell1,km0) - h_flux_upwind / grid % areaCell % array(cell1)
-                  s_update(iScalar,cell2,km0) = s_update(iScalar,cell2,km0) + h_flux_upwind / grid % areaCell % array(cell2)
-               end do 
-            end do 
-
-         else if (config_scalar_adv_order &gt;= 3) then
-
-            do iEdge=1,grid%nEdges
-               cell1 = cellsOnEdge(1,iEdge)
-               cell2 = cellsOnEdge(2,iEdge)
-               cell_upwind = cell2
-               if (uhAvg(k,iEdge) &gt;= 0) cell_upwind = cell1
-               do iScalar=1,num_scalars
-
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                     d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                                    deriv_two(i+1,1,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell1))
-                  end do
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                     d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                                    deriv_two(i+1,2,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell2))
-                  end do
-   
-                  if (uhAvg(k,iEdge) &gt; 0) then
-                     flux = dvEdge(iEdge) * uhAvg(k,iEdge) * (          &amp;
-                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                                             -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                  else
-                     flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
-                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
-                                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                                             +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                  end if
-  
-                  h_flux(iScalar,iEdge) = dt * flux
-                  h_flux_upwind = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_old(iScalar,k,cell_upwind)
-                  h_flux(iScalar,iEdge) = h_flux(iScalar,iEdge) - h_flux_upwind
-!                  h_flux(iScalar,iEdge) = 0.  ! use only upwind - for testing
-                  s_update(iScalar,cell1,km0) = s_update(iScalar,cell1,km0) - h_flux_upwind / grid % areaCell % array(cell1)
-                  s_update(iScalar,cell2,km0) = s_update(iScalar,cell2,km0) + h_flux_upwind / grid % areaCell % array(cell2)
-               end do 
-            end do 
-
-         end if
-
-
-         if ( (rk_step == rk_order) .and. (config_monotonic .or. config_positive_definite) ) then   
-
-!*************************************************************************************************************
-!---  limiter - we limit horizontal and vertical fluxes on level k 
-!---  (these are h fluxes contributing to level k scalars, and v flux contributing to level k, k-1 scalars)
-
-            do iCell=1,grid % nCells
-  
-               do iScalar=1,num_scalars
-   
-                  s_max(iScalar) = max(scalar_old(iScalar,k,iCell), scalar_old(iScalar,kcp1,iCell), scalar_old(iScalar,kcm1,iCell))
-                  s_min(iScalar) = min(scalar_old(iScalar,k,iCell), scalar_old(iScalar,kcp1,iCell), scalar_old(iScalar,kcm1,iCell))
-                  s_max_update(iScalar) = s_update(iScalar,iCell,km0)
-                  s_min_update(iScalar) = s_update(iScalar,iCell,km0)
-    
-                  ! add in vertical flux to get max and min estimate
-                  s_max_update(iScalar) = s_max_update(iScalar)  &amp;
-                     - rdnw(k) * (max(0.,v_flux(iScalar,iCell,km0)) - min(0.,v_flux(iScalar,iCell,km1)))
-                  s_min_update(iScalar) = s_min_update(iScalar)  &amp;
-                     - rdnw(k) * (min(0.,v_flux(iScalar,iCell,km0)) - max(0.,v_flux(iScalar,iCell,km1)))
-    
-               end do
-   
-               do i = 1, grid % nEdgesOnCell % array(iCell)  ! go around the edges of each cell
-                  do iScalar=1,num_scalars
-    
-                     s_max(iScalar)  = max(scalar_old(iScalar,k,grid % cellsOnCell % array(i,iCell)), s_max(iScalar))
-                     s_min(iScalar)  = min(scalar_old(iScalar,k,grid % cellsOnCell % array(i,iCell)), s_min(iScalar))
-     
-                     iEdge = grid % EdgesOnCell % array (i,iCell)
-                     if (iCell == cellsOnEdge(1,iEdge)) then
-                        fdir = 1.0
-                     else
-                        fdir = -1.0
-                     end if
-                     flux = -fdir * h_flux(iScalar,iEdge)/grid % areaCell % array(iCell)
-                     s_max_update(iScalar) = s_max_update(iScalar) + max(0.,flux)
-                     s_min_update(iScalar) = s_min_update(iScalar) + min(0.,flux)
-  
-                  end do
-   
-               end do
-   
-               if( config_positive_definite ) s_min(:) = 0.
-   
-               do iScalar=1,num_scalars
-                  scale_out (iScalar,iCell,km0) = 1.
-                  scale_in (iScalar,iCell,km0) = 1.
-                  s_max_update (iScalar) =  s_max_update (iScalar) / h_new (k,iCell)
-                  s_min_update (iScalar) =  s_min_update (iScalar) / h_new (k,iCell)
-                  s_upwind = s_update(iScalar,iCell,km0) / h_new(k,iCell)
-                  if ( s_max_update(iScalar) &gt; s_max(iScalar) .and. config_monotonic)   &amp;
-                     scale_in (iScalar,iCell,km0) = max(0.,(s_max(iScalar)-s_upwind)/(s_max_update(iScalar)-s_upwind+eps))
-                  if ( s_min_update(iScalar) &lt; s_min(iScalar) )   &amp;
-                     scale_out (iScalar,iCell,km0) = max(0.,(s_upwind-s_min(iScalar))/(s_upwind-s_min_update(iScalar)+eps))
-                end do
-  
-            end do ! end loop over cells to compute scale factor
-
-
-            call dmpar_exch_halo_field2dReal(dminfo, scale_out(:,:,1), &amp;
-                                             num_scalars, grid % nCells, &amp;
-                                             cellsToSend, cellsToRecv)
-            call dmpar_exch_halo_field2dReal(dminfo, scale_out(:,:,2), &amp;
-                                             num_scalars, grid % nCells, &amp;
-                                             cellsToSend, cellsToRecv)
-            call dmpar_exch_halo_field2dReal(dminfo, scale_in(:,:,1), &amp;
-                                             num_scalars, grid % nCells, &amp;
-                                             cellsToSend, cellsToRecv)
-            call dmpar_exch_halo_field2dReal(dminfo, scale_in(:,:,2), &amp;
-                                             num_scalars, grid % nCells, &amp;
-                                             cellsToSend, cellsToRecv)
-
-       ! rescale the horizontal fluxes

-            do iEdge = 1, grid % nEdges
-               cell1 = grid % cellsOnEdge % array(1,iEdge)
-               cell2 = grid % cellsOnEdge % array(2,iEdge)
-               do iScalar=1,num_scalars
-                  flux = h_flux(iScalar,iEdge)
-                  if (flux &gt; 0) then
-                     flux = flux * min(scale_out(iScalar,cell1,km0), scale_in(iScalar,cell2,km0))
-                  else
-                     flux = flux * min(scale_in(iScalar,cell1,km0), scale_out(iScalar,cell2,km0))
-                  end if
-                  h_flux(iScalar,iEdge) = flux
-               end do
-            end do

-       ! rescale the vertical flux

-            do iCell=1,grid % nCells
-               do iScalar=1,num_scalars
-                  flux =  v_flux(iScalar,iCell,km1)
-                  if (flux &gt; 0) then
-                     flux = flux * min(scale_out(iScalar,iCell,km0), scale_in(iScalar,iCell,km1))
-                  else
-                     flux = flux * min(scale_in(iScalar,iCell,km0), scale_out(iScalar,iCell,km1))
-                  end if
-                  v_flux(iScalar,iCell,km1) = flux
-               end do
-            end do
-
-!  end of limiter
-!*******************************************************************************************************************
-
-         end if
-
-!---  update
-
-         do iCell=1,grid % nCells
-            !  add in upper vertical flux that was just renormalized
-            do iScalar=1,num_scalars
-               s_update(iScalar,iCell,km0) = s_update(iScalar,iCell,km0) + rdnw(k) * v_flux(iScalar,iCell,km1)
-               if (k &gt; 1) s_update(iScalar,iCell,km1) = s_update(iScalar,iCell,km1) - rdnw(k-1)*v_flux(iScalar,iCell,km1)
-            end do
-         end do

-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            do iScalar=1,num_scalars
-               s_update(iScalar,cell1,km0) = s_update(iScalar,cell1,km0) - &amp;
-                   h_flux(iScalar,iEdge) / grid % areaCell % array(cell1)
-               s_update(iScalar,cell2,km0) = s_update(iScalar,cell2,km0) + &amp;
-                   h_flux(iScalar,iEdge) / grid % areaCell % array(cell2)
-            end do 
-         end do 

-         ! decouple from mass
-         if (k &gt; 1) then
-            do iCell=1,grid % nCells
-               do iScalar=1,num_scalars
-                  s_update(iScalar,iCell,km1) = s_update(iScalar,iCell,km1) / h_new(k-1,iCell)
-               end do
-            end do

-            do iCell=1,grid % nCells
-               do iScalar=1,num_scalars
-                  scalar_new(iScalar,k-1,iCell) = s_update(iScalar,iCell,km1) 
-               end do
-            end do
-         end if

-         ktmp = km1
-         km1 = km0
-         km0 = ktmp
-
-      end do
-
-      do iCell=1,grid % nCells
-         do iScalar=1,num_scalars
-            scalar_new(iScalar,grid % nVertLevels,iCell) = s_update(iScalar,iCell,km1) / h_new(grid%nVertLevels,iCell)
-         end do
-      end do
-
-   end subroutine advance_scalars_mono
-
-
-   subroutine compute_solve_diagnostics(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
-
-
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
-      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, r
-
-      integer :: nCells, nEdges, nVertices, nVertLevels
-      real (kind=RKIND), dimension(:), pointer :: h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
-      real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, tend_h, tend_u, &amp;
-                                                    circulation, vorticity, ke, pv_edge, pv_vertex, pv_cell, gradPVn, gradPVt, &amp;
-                                                    divergence
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
-
-
-      h           =&gt; s % h % array
-      u           =&gt; s % u % array
-      v           =&gt; s % v % array
-      vh          =&gt; s % vh % array
-      h_edge      =&gt; s % h_edge % array
-      tend_h      =&gt; s % h % array
-      tend_u      =&gt; s % u % array
-      circulation =&gt; s % circulation % array
-      vorticity   =&gt; s % vorticity % array
-      divergence  =&gt; s % divergence % array
-      ke          =&gt; s % ke % array
-      pv_edge     =&gt; s % pv_edge % array
-      pv_vertex   =&gt; s % pv_vertex % array
-      pv_cell     =&gt; s % pv_cell % array
-      gradPVn     =&gt; s % gradPVn % array
-      gradPVt     =&gt; s % gradPVt % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      cellsOnVertex     =&gt; grid % cellsOnVertex % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
-      edgesOnCell       =&gt; grid % edgesOnCell % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      edgesOnVertex     =&gt; grid % edgesOnVertex % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      h_s               =&gt; grid % h_s % array
-      fVertex           =&gt; grid % fVertex % array
-      fEdge             =&gt; grid % fEdge % array
-                  
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      !
-      ! Compute height on cell edges at velocity locations
-      !
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=1,nVertLevels
-            h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
-         end do
-      end do
-
-      !
-      ! Compute circulation and relative vorticity at each vertex
-      !
-      circulation(:,:) = 0.0
-      do iEdge=1,nEdges
-         do k=1,nVertLevels
-            circulation(k,verticesOnEdge(1,iEdge)) = circulation(k,verticesOnEdge(1,iEdge)) - dcEdge(iEdge) * u(k,iEdge)
-            circulation(k,verticesOnEdge(2,iEdge)) = circulation(k,verticesOnEdge(2,iEdge)) + dcEdge(iEdge) * u(k,iEdge)
-         end do
-      end do
-      do iVertex=1,nVertices
-         do k=1,nVertLevels
-            vorticity(k,iVertex) = circulation(k,iVertex) / areaTriangle(iVertex)
-         end do
-      end do
-
-
-      !
-      ! Compute the divergence at each cell center
-      !
-      divergence(:,:) = 0.0
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=1,nVertLevels
-           divergence(k,cell1) = divergence(k,cell1) + u(k,iEdge)*dvEdge(iEdge)
-           divergence(k,cell2) = divergence(k,cell2) - u(k,iEdge)*dvEdge(iEdge)
-         end do
-      end do
-      do iCell = 1,nCells
-        r = 1.0 / areaCell(iCell)
-        do k = 1,nVertLevels
-           divergence(k,iCell) = divergence(k,iCell) * r
-        end do
-      end do
-
-
-      !
-      ! Compute kinetic energy in each cell
-      !
-      ke(:,:) = 0.0
-      do iCell=1,nCells
-         do i=1,nEdgesOnCell(iCell)
-            iEdge = edgesOnCell(i,iCell)
-            do k=1,nVertLevels
-               ke(k,iCell) = ke(k,iCell) + 0.25 * dcEdge(iEdge) * dvEdge(iEdge) * u(k,iEdge)**2.0
-            end do
-         end do
-         do k=1,nVertLevels
-            ke(k,iCell) = ke(k,iCell) / areaCell(iCell)
-         end do
-      end do
-
-      !
-      ! Compute v (tangential) velocities
-      !
-      v(:,:) = 0.0
-      do iEdge = 1,nEdges
-         do i=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(i,iEdge)
-            do k = 1,nVertLevels
-               v(k,iEdge) = v(k,iEdge) + weightsOnEdge(i,iEdge) * u(k, eoe)
-            end do
-         end do
-      end do
-
-
-      ! tdr
-      !
-      ! Compute height at vertices, pv at vertices, and average pv to edge locations
-      !  ( this computes pv_vertex at all vertices bounding real cells )
-      !
-      do iVertex = 1,nVertices
-         do k=1,nVertLevels
-            h_vertex = 0.0
-            do i=1,grid % vertexDegree
-               h_vertex = h_vertex + h(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
-            end do
-            h_vertex = h_vertex / areaTriangle(iVertex)
-
-            pv_vertex(k,iVertex) = (fVertex(iVertex) + vorticity(k,iVertex)) / h_vertex
-         end do
-      end do
-      ! tdr
-
-
-      ! tdr
-      !
-      ! Compute gradient of PV in the tangent direction
-      !   ( this computes gradPVt at all edges bounding real cells )
-      !
-      do iEdge = 1,nEdges
-         do k = 1,nVertLevels
-           gradPVt(k,iEdge) = (pv_vertex(k,verticesOnEdge(2,iEdge)) - pv_vertex(k,verticesOnEdge(1,iEdge))) / &amp;
-                              dvEdge(iEdge)
-         end do
-      end do
-
-      ! tdr
-      !
-      ! Compute pv at the edges
-      !   ( this computes pv_edge at all edges bounding real cells )
-      !
-      pv_edge(:,:) = 0.0
-      do iVertex = 1,nVertices
-        do i=1,grid % vertexDegree
-           iEdge = edgesOnVertex(i,iVertex)
-           do k=1,nVertLevels
-              pv_edge(k,iEdge) =  pv_edge(k,iEdge)  + 0.5 * pv_vertex(k,iVertex)
-           end do
-        end do
-      end do
-      ! tdr
-
-      ! tdr
-      !
-      ! Modify PV edge with upstream bias. 
-      !
-      do iEdge = 1,nEdges
-         do k = 1,nVertLevels
-           pv_edge(k,iEdge) = pv_edge(k,iEdge) - config_apvm_upwinding * v(k,iEdge) * dt * gradPVt(k,iEdge)
-         end do
-      end do
-
-
-      ! tdr
-      !
-      ! Compute pv at cell centers
-      !    ( this computes pv_cell for all real cells )
-      !
-      pv_cell(:,:) = 0.0
-      do iVertex = 1, nVertices
-       do i=1,grid % vertexDegree
-          iCell = cellsOnVertex(i,iVertex)
-          do k = 1,nVertLevels
-             pv_cell(k,iCell) = pv_cell(k,iCell) + kiteAreasOnVertex(i, iVertex) * pv_vertex(k, iVertex) / areaCell(iCell)
-          end do
-       end do
-      end do
-      ! tdr
-
-      ! tdr
-      !
-      ! Compute gradient of PV in normal direction
-      !   (tdr: 2009-10-02: this is not correct because the pv_cell in the halo is not correct)
-      !
-      gradPVn(:,:) = 0.0
-      do iEdge = 1,nEdges
-         do k = 1,nVertLevels
-            gradPVn(k,iEdge) = (pv_cell(k,cellsOnEdge(2,iEdge)) - pv_cell(k,cellsOnEdge(1,iEdge))) / &amp;
-                                 dcEdge(iEdge)
-         end do
-      end do
-      ! tdr
-
-      ! Modify PV edge with upstream bias.
-      !
-     do iEdge = 1,nEdges
-        do k = 1,nVertLevels
-          pv_edge(k,iEdge) = pv_edge(k,iEdge) - config_apvm_upwinding * u(k,iEdge) * dt * gradPVn(k,iEdge)
-        end do
-     end do
-
-
-   end subroutine compute_solve_diagnostics
-
-
-   subroutine compute_w (s_new, s_old, grid, dt )
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Compute (diagnose) vertical velocity (used by physics)
-   !
-   ! Input: s_new - current model state
-   !        s_old - previous model state
-   !        grid - grid metadata
-   !        dt - timestep between new and old
-   !
-   ! Output: w  (m/s)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (state_type), intent(inout) :: s_new
-      type (state_type), intent(in) :: s_old
-      type (mesh_type), intent(inout) :: grid
-
-      real (kind=RKIND), intent(in) :: dt
-
-      real (kind=RKIND), dimension(:,:), pointer :: geo_new, geo_old, u, ww, h, w
-      real (kind=RKIND), dimension(:), pointer :: dvEdge, rdnw, fnm, fnp
-
-      integer :: iEdge, iCell, k, cell1, cell2
-      real (kind=RKIND), dimension( grid % nVertlevels + 1 ) :: wdwn
-      real (kind=RKIND) :: flux
-
-      geo_new =&gt; s_new % geopotential % array      
-      geo_old =&gt; s_old % geopotential % array      
-      u =&gt; s_new % u % array 
-      ww =&gt; s_new % ww % array
-      h =&gt; s_new % h % array
-      w =&gt; s_new % w % array
-      dvEdge =&gt; grid % dvEdge % array
-      rdnw =&gt; grid % rdnw % array
-      fnm =&gt; grid % fnm % array
-      fnp =&gt; grid % fnp % array
-
-      w = 0.
-
-      do iCell=1, grid % nCellsSolve
-        wdwn(1) = 0.
-        do k=2,grid % nVertlevels + 1
-          wdwn(k) = (0.5*(ww(k,iCell)+ww(k-1,iCell))/h(k-1,iCell))   &amp;
-                     *rdnw(k-1)*(geo_new(k,iCell)-geo_new(k-1,iCell))
-        enddo
-        w(1,iCell) = 0.
-        do k=2, grid % nVertLevels
-          w(k,iCell) = (((geo_new(k,iCell)-geo_old(k,iCell))/dt)+ &amp;
-                          fnm(k)*wdwn(k+1)+fnp(k)*wdwn(k))/gravity
-        enddo
-        k = grid % nVertLevels + 1
-        w(k,iCell) = ((geo_new(k,iCell)-geo_old(k,iCell))/dt)/gravity
-      enddo
-
-      do iEdge=1, grid % nEdges
-        cell1 = grid % cellsOnEdge % array (1,iEdge)
-        cell2 = grid % cellsOnEdge % array (2,iEdge)
-        if (cell1 &lt;= grid % nCellsSolve .or. cell2 &lt;= grid % nCellsSolve ) then
-          do k=2, grid % nVertLevels
-            flux = 0.25*(u(k,iEdge)+u(k-1,iEdge)*(geo_new(k,cell2)-geo_new(k,cell1))) * dvEdge(iEdge) / gravity
-            w(k,cell1) = w(k,cell1) + flux/ grid % AreaCell % array (cell1)
-            w(k,cell2) = w(k,cell2) + flux/ grid % AreaCell % array (cell2)
-          enddo
-          k = 1
-          flux = 0.5*(1.5*u(1,iEdge)-0.5*u(2,iEdge)*(geo_new(k,cell2)-geo_new(k,cell1))) * dvEdge(iEdge) / gravity
-          w(k,cell1) = w(k,cell1) + flux/ grid % AreaCell % array (cell1)
-          w(k,cell2) = w(k,cell2) + flux/ grid % AreaCell % array (cell2)
-
-          k = grid % nVertLevels + 1
-          flux = 0.5*(1.5*u(k-1,iEdge)-0.5*u(k-2,iEdge)*(geo_new(k,cell2)-geo_new(k,cell1))) * dvEdge(iEdge) / gravity
-          w(k,cell1) = w(k,cell1) + flux/ grid % AreaCell % array (cell1)
-          w(k,cell2) = w(k,cell2) + flux/ grid % AreaCell % array (cell2)
-
-        end if
-      end do
-
-   end subroutine compute_w
-
-end module time_integration

Copied: branches/source_condensing/src/core_hyd_atmos/mpas_atmh_advection.F (from rev 1114, trunk/mpas/src/core_hyd_atmos/mpas_atmh_advection.F)
===================================================================
--- branches/source_condensing/src/core_hyd_atmos/mpas_atmh_advection.F                                (rev 0)
+++ branches/source_condensing/src/core_hyd_atmos/mpas_atmh_advection.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,688 @@
+module atmh_advection
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+
+
+   contains
+
+
+   subroutine atmh_initialize_advection_rk( grid )
+                                      
+!
+! compute the cell coefficients for the polynomial fit.
+! this is performed during setup for model integration.
+! WCS, 31 August 2009
+!
+      implicit none
+
+      type (mesh_type), intent(in) :: grid
+
+      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
+      integer, dimension(:,:), pointer :: advCells
+
+!  local variables
+
+      real (kind=RKIND), dimension(2, grid % nEdges) :: thetae
+      real (kind=RKIND), dimension(grid % nEdges) :: xe, ye
+      real (kind=RKIND), dimension(grid % nCells) :: theta_abs
+
+      real (kind=RKIND), dimension(25) :: xc, yc, zc ! cell center coordinates
+      real (kind=RKIND), dimension(25) :: thetav, thetat, dl_sphere
+      real (kind=RKIND) :: xm, ym, zm, dl, xec, yec, zec
+      real (kind=RKIND) :: thetae_tmp, xe_tmp, ye_tmp
+      real (kind=RKIND) :: xv1, xv2, yv1, yv2, zv1, zv2
+      integer :: i, j, k, ip1, ip2, m, n, ip1a, ii
+      integer :: iCell, iEdge
+      real (kind=RKIND) :: pii
+      real (kind=RKIND) :: x0, y0, x1, y1, x2, y2, x3, y3, x4, y4, x5, y5
+      real (kind=RKIND) :: pdx1, pdx2, pdx3, pdy1, pdy2, pdy3, dx1, dx2, dy1, dy2
+      real (kind=RKIND) :: angv1, angv2, dl1, dl2
+      real (kind=RKIND), dimension(25) :: dxe, dye, x2v, y2v, xp, yp
+      
+      real (kind=RKIND) :: amatrix(25,25), bmatrix(25,25), wmatrix(25,25)
+      real (kind=RKIND) :: length_scale
+      integer :: ma,na, cell_add, mw, nn
+      integer, dimension(25) :: cell_list
+
+
+      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
+
+      logical, parameter :: reset_poly = .true.
+
+      real (kind=RKIND) :: rcell, cos2t, costsint, sin2t
+
+!---
+
+      pii = 2.*asin(1.0)
+
+      advCells =&gt; grid % advCells % array
+      deriv_two =&gt; grid % deriv_two % array
+      deriv_two(:,:,:) = 0.
+
+      do iCell = 1, grid % nCells !  is this correct? - we need first halo cell also...
+
+         cell_list(1) = iCell
+         do i=2, grid % nEdgesOnCell % array(iCell)+1
+            cell_list(i) = grid % CellsOnCell % array(i-1,iCell)
+         end do
+         n = grid % nEdgesOnCell % array(iCell) + 1
+
+         if ( polynomial_order &gt; 2 ) then
+            do i=2,grid % nEdgesOnCell % array(iCell) + 1
+               do j=1,grid % nEdgesOnCell % array ( cell_list(i) )
+                  cell_add = grid % CellsOnCell % array (j,cell_list(i))
+                  add_the_cell = .true.
+                  do k=1,n
+                     if ( cell_add == cell_list(k) ) add_the_cell = .false.
+                  end do
+                  if (add_the_cell) then
+                     n = n+1
+                     cell_list(n) = cell_add
+                  end if
+               end do
+            end do
+         end if

+         advCells(1,iCell) = n
+
+!  check to see if we are reaching outside the halo
+
+         do_the_cell = .true.
+         do i=1,n
+            if (cell_list(i) &gt; grid % nCells) do_the_cell = .false.
+         end do
+
+
+         if ( .not. do_the_cell ) cycle
+
+
+!  compute poynomial fit for this cell if all needed neighbors exist
+         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
+            end do
+
+            theta_abs(iCell) =  pii/2. - sphere_angle( xc(1), yc(1), zc(1),  &amp;
+                                                       xc(2), yc(2), zc(2),  &amp;
+                                                       0.,    0.,    1.      ) 
+
+! angles from cell center to neighbor centers (thetav)
+
+            do i=1,n-1
+   
+               ip2 = i+2
+               if (ip2 &gt; n) ip2 = 2
+    
+               thetav(i) = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
+                                         xc(i+1), yc(i+1), zc(i+1),  &amp;
+                                         xc(ip2), yc(ip2), zc(ip2)   )
+
+               dl_sphere(i) = a*arc_length( xc(1),   yc(1),   zc(1),  &amp;
+                                            xc(i+1), yc(i+1), zc(i+1) )
+            end do
+
+            length_scale = 1.
+            do i=1,n-1
+               dl_sphere(i) = dl_sphere(i)/length_scale
+            end do
+
+!            thetat(1) = 0.  !  this defines the x direction, cell center 1 -&gt; 
+            thetat(1) = theta_abs(iCell)  !  this defines the x direction, longitude line
+            do i=2,n-1
+               thetat(i) = thetat(i-1) + thetav(i-1)
+            end do
+   
+            do i=1,n-1
+               xp(i) = cos(thetat(i)) * dl_sphere(i)
+               yp(i) = sin(thetat(i)) * dl_sphere(i)
+            end do
+
+         else     ! On an x-y plane
+
+            do i=1,n-1
+               xp(i) = grid % xCell % array(cell_list(i)) - grid % xCell % array(iCell)
+               yp(i) = grid % yCell % array(cell_list(i)) - grid % yCell % array(iCell)
+            end do
+
+         end if
+
+
+         ma = n-1
+         mw = grid % nEdgesOnCell % array (iCell)
+
+         bmatrix = 0.
+         amatrix = 0.
+         wmatrix = 0.
+
+         if (polynomial_order == 2) then
+            na = 6
+            ma = ma+1
+  
+            amatrix(1,1) = 1.
+            wmatrix(1,1) = 1.
+            do i=2,ma
+               amatrix(i,1) = 1.
+               amatrix(i,2) = xp(i-1)
+               amatrix(i,3) = yp(i-1)
+               amatrix(i,4) = xp(i-1)**2
+               amatrix(i,5) = xp(i-1) * yp(i-1)
+               amatrix(i,6) = yp(i-1)**2
+   
+               wmatrix(i,i) = 1.
+            end do

+         else if (polynomial_order == 3) then
+            na = 10
+            ma = ma+1
+  
+            amatrix(1,1) = 1.
+            wmatrix(1,1) = 1.
+            do i=2,ma
+               amatrix(i,1) = 1.
+               amatrix(i,2) = xp(i-1)
+               amatrix(i,3) = yp(i-1)
+   
+               amatrix(i,4) = xp(i-1)**2
+               amatrix(i,5) = xp(i-1) * yp(i-1)
+               amatrix(i,6) = yp(i-1)**2
+   
+               amatrix(i,7) = xp(i-1)**3
+               amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
+               amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
+               amatrix(i,10) = yp(i-1)**3
+   
+               wmatrix(i,i) = 1.

+            end do
+
+         else
+            na = 15
+            ma = ma+1
+  
+            amatrix(1,1) = 1.
+            wmatrix(1,1) = 1.
+            do i=2,ma
+               amatrix(i,1) = 1.
+               amatrix(i,2) = xp(i-1)
+               amatrix(i,3) = yp(i-1)
+   
+               amatrix(i,4) = xp(i-1)**2
+               amatrix(i,5) = xp(i-1) * yp(i-1)
+               amatrix(i,6) = yp(i-1)**2
+   
+               amatrix(i,7) = xp(i-1)**3
+               amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
+               amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
+               amatrix(i,10) = yp(i-1)**3
+   
+               amatrix(i,11) = xp(i-1)**4
+               amatrix(i,12) = yp(i-1) * (xp(i-1)**3)
+               amatrix(i,13) = (xp(i-1)**2)*(yp(i-1)**2)
+               amatrix(i,14) = xp(i-1) * (yp(i-1)**3)
+               amatrix(i,15) = yp(i-1)**4
+   
+               wmatrix(i,i) = 1.
+  
+            end do

+            do i=1,mw
+               wmatrix(i,i) = 1.
+            end do

+         end if

+         call poly_fit_2( amatrix, bmatrix, wmatrix, ma, na, 25 )
+
+         do i=1,grid % nEdgesOnCell % array (iCell)
+            ip1 = i+1
+            if (ip1 &gt; n-1) ip1 = 1
+  
+            iEdge = grid % EdgesOnCell % array (i,iCell)
+            xv1 = grid % xVertex % array(grid % verticesOnEdge % array (1,iedge))/a
+            yv1 = grid % yVertex % array(grid % verticesOnEdge % array (1,iedge))/a
+            zv1 = grid % zVertex % array(grid % verticesOnEdge % array (1,iedge))/a
+            xv2 = grid % xVertex % array(grid % verticesOnEdge % array (2,iedge))/a
+            yv2 = grid % yVertex % array(grid % verticesOnEdge % array (2,iedge))/a
+            zv2 = grid % zVertex % array(grid % verticesOnEdge % array (2,iedge))/a
+  
+            if ( grid % on_a_sphere ) then
+               call arc_bisect( xv1, yv1, zv1,  &amp;
+                                xv2, yv2, zv2,  &amp;
+                                xec, yec, zec   )
+  
+               thetae_tmp = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
+                                          xc(i+1), yc(i+1), zc(i+1),  &amp;
+                                          xec,     yec,     zec       )
+               thetae_tmp = thetae_tmp + thetat(i)
+               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
+                  thetae(1,grid % EdgesOnCell % array (i,iCell)) = thetae_tmp
+               else
+                  thetae(2,grid % EdgesOnCell % array (i,iCell)) = thetae_tmp
+               end if
+            else
+               xe(grid % EdgesOnCell % array (i,iCell)) = 0.5 * (xv1 + xv2)
+               ye(grid % EdgesOnCell % array (i,iCell)) = 0.5 * (yv1 + yv2)
+            end if
+  
+         end do
+
+!  fill second derivative stencil for rk advection 
+
+         do i=1, grid % nEdgesOnCell % array (iCell)
+            iEdge = grid % EdgesOnCell % array (i,iCell)
+  
+  
+            if ( grid % on_a_sphere ) then
+               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
+  
+                  cos2t = cos(thetae(1,grid % EdgesOnCell % array (i,iCell)))
+                  sin2t = sin(thetae(1,grid % EdgesOnCell % array (i,iCell)))
+                  costsint = cos2t*sin2t
+                  cos2t = cos2t**2
+                  sin2t = sin2t**2
+   
+                  do j=1,n
+                     deriv_two(j,1,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
+                                            + 2.*costsint*bmatrix(5,j)  &amp;
+                                            + 2.*sin2t*bmatrix(6,j)
+                  end do
+               else
+     
+                  cos2t = cos(thetae(2,grid % EdgesOnCell % array (i,iCell)))
+                  sin2t = sin(thetae(2,grid % EdgesOnCell % array (i,iCell)))
+                  costsint = cos2t*sin2t
+                  cos2t = cos2t**2
+                  sin2t = sin2t**2
+      
+                  do j=1,n
+                     deriv_two(j,2,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
+                                            + 2.*costsint*bmatrix(5,j)  &amp;
+                                            + 2.*sin2t*bmatrix(6,j)
+                  end do
+               end if
+            else
+               do j=1,n
+                  deriv_two(j,1,iEdge) =   2.*xe(iEdge)*xe(iEdge)*bmatrix(4,j)  &amp;
+                                         + 2.*xe(iEdge)*ye(iEdge)*bmatrix(5,j)  &amp;
+                                         + 2.*ye(iEdge)*ye(iEdge)*bmatrix(6,j)
+                  deriv_two(j,2,iEdge) = deriv_two(j,1,iEdge)
+               end do
+            end if
+         end do

+      end do ! end of loop over cells
+
+      if (debug) stop
+
+   end subroutine atmh_initialize_advection_rk
+
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! FUNCTION SPHERE_ANGLE
+   !
+   ! Computes the angle between arcs AB and AC, given points A, B, and C
+   ! Equation numbers w.r.t. http://mathworld.wolfram.com/SphericalTrigonometry.html
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   real function sphere_angle(ax, ay, az, bx, by, bz, cx, cy, cz)
+   
+      implicit none
+   
+      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz, cx, cy, cz
+   
+      real (kind=RKIND) :: a, b, c          ! Side lengths of spherical triangle ABC
+   
+      real (kind=RKIND) :: ABx, ABy, ABz    ! The components of the vector AB
+      real (kind=RKIND) :: mAB              ! The magnitude of AB
+      real (kind=RKIND) :: ACx, ACy, ACz    ! The components of the vector AC
+      real (kind=RKIND) :: mAC              ! The magnitude of AC
+   
+      real (kind=RKIND) :: Dx               ! The i-components of the cross product AB x AC
+      real (kind=RKIND) :: Dy               ! The j-components of the cross product AB x AC
+      real (kind=RKIND) :: Dz               ! The k-components of the cross product AB x AC
+   
+      real (kind=RKIND) :: s                ! Semiperimeter of the triangle
+      real (kind=RKIND) :: sin_angle
+   
+      a = acos(max(min(bx*cx + by*cy + bz*cz,1.0),-1.0))      ! Eqn. (3)
+      b = acos(max(min(ax*cx + ay*cy + az*cz,1.0),-1.0))      ! Eqn. (2)
+      c = acos(max(min(ax*bx + ay*by + az*bz,1.0),-1.0))      ! Eqn. (1)
+   
+      ABx = bx - ax
+      ABy = by - ay
+      ABz = bz - az
+   
+      ACx = cx - ax
+      ACy = cy - ay
+      ACz = cz - az
+   
+      Dx =   (ABy * ACz) - (ABz * ACy)
+      Dy = -((ABx * ACz) - (ABz * ACx))
+      Dz =   (ABx * ACy) - (ABy * ACx)
+   
+      s = 0.5*(a + b + c)
+!      sin_angle = sqrt((sin(s-b)*sin(s-c))/(sin(b)*sin(c)))   ! Eqn. (28)
+      sin_angle = sqrt(min(1.,max(0.,(sin(s-b)*sin(s-c))/(sin(b)*sin(c)))))   ! Eqn. (28)
+   
+      if ((Dx*ax + Dy*ay + Dz*az) &gt;= 0.0) then
+         sphere_angle =  2.0 * asin(max(min(sin_angle,1.0),-1.0))
+      else
+         sphere_angle = -2.0 * asin(max(min(sin_angle,1.0),-1.0))
+      end if
+   
+   end function sphere_angle
+   
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! FUNCTION PLANE_ANGLE
+   !
+   ! Computes the angle between vectors AB and AC, given points A, B, and C, and
+   !   a vector (u,v,w) normal to the plane.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   real function plane_angle(ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w)
+   
+      implicit none
+   
+      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w
+   
+      real (kind=RKIND) :: ABx, ABy, ABz    ! The components of the vector AB
+      real (kind=RKIND) :: mAB              ! The magnitude of AB
+      real (kind=RKIND) :: ACx, ACy, ACz    ! The components of the vector AC
+      real (kind=RKIND) :: mAC              ! The magnitude of AC
+   
+      real (kind=RKIND) :: Dx               ! The i-components of the cross product AB x AC
+      real (kind=RKIND) :: Dy               ! The j-components of the cross product AB x AC
+      real (kind=RKIND) :: Dz               ! The k-components of the cross product AB x AC
+   
+      real (kind=RKIND) :: cos_angle
+   
+      ABx = bx - ax
+      ABy = by - ay
+      ABz = bz - az
+      mAB = sqrt(ABx**2.0 + ABy**2.0 + ABz**2.0)
+   
+      ACx = cx - ax
+      ACy = cy - ay
+      ACz = cz - az
+      mAC = sqrt(ACx**2.0 + ACy**2.0 + ACz**2.0)
+   
+   
+      Dx =   (ABy * ACz) - (ABz * ACy)
+      Dy = -((ABx * ACz) - (ABz * ACx))
+      Dz =   (ABx * ACy) - (ABy * ACx)
+   
+      cos_angle = (ABx*ACx + ABy*ACy + ABz*ACz) / (mAB * mAC)
+   
+      if ((Dx*u + Dy*v + Dz*w) &gt;= 0.0) then
+         plane_angle =  acos(max(min(cos_angle,1.0),-1.0))
+      else
+         plane_angle = -acos(max(min(cos_angle,1.0),-1.0))
+      end if
+   
+   end function plane_angle
+
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! FUNCTION ARC_LENGTH
+   !
+   ! Returns the length of the great circle arc from A=(ax, ay, az) to 
+   !    B=(bx, by, bz). It is assumed that both A and B lie on the surface of the
+   !    same sphere centered at the origin.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   real function arc_length(ax, ay, az, bx, by, bz)
+   
+      implicit none
+   
+      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz
+   
+      real (kind=RKIND) :: r, c
+      real (kind=RKIND) :: cx, cy, cz
+   
+      cx = bx - ax
+      cy = by - ay
+      cz = bz - az
+
+!      r = ax*ax + ay*ay + az*az
+!      c = cx*cx + cy*cy + cz*cz
+!
+!      arc_length = sqrt(r) * acos(1.0 - c/(2.0*r))
+
+      r = sqrt(ax*ax + ay*ay + az*az)
+      c = sqrt(cx*cx + cy*cy + cz*cz)
+!      arc_length = sqrt(r) * 2.0 * asin(c/(2.0*r))
+      arc_length = r * 2.0 * asin(c/(2.0*r))
+
+   end function arc_length
+   
+   
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! SUBROUTINE ARC_BISECT
+   !
+   ! Returns the point C=(cx, cy, cz) that bisects the great circle arc from
+   !   A=(ax, ay, az) to B=(bx, by, bz). It is assumed that A and B lie on the
+   !   surface of a sphere centered at the origin.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   subroutine arc_bisect(ax, ay, az, bx, by, bz, cx, cy, cz)
+   
+      implicit none
+   
+      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz
+      real (kind=RKIND), intent(out) :: cx, cy, cz
+   
+      real (kind=RKIND) :: r           ! Radius of the sphere
+      real (kind=RKIND) :: d           
+   
+      r = sqrt(ax*ax + ay*ay + az*az)
+   
+      cx = 0.5*(ax + bx)
+      cy = 0.5*(ay + by)
+      cz = 0.5*(az + bz)
+   
+      if (cx == 0. .and. cy == 0. .and. cz == 0.) then
+         write(0,*) 'Error: arc_bisect: A and B are diametrically opposite'
+      else
+         d = sqrt(cx*cx + cy*cy + cz*cz)
+         cx = r * cx / d
+         cy = r * cy / d
+         cz = r * cz / d
+      end if
+   
+   end subroutine arc_bisect
+
+
+   subroutine poly_fit_2(a_in,b_out,weights_in,m,n,ne)
+
+      implicit none
+
+      integer, intent(in) :: m,n,ne
+      real (kind=RKIND), dimension(ne,ne), intent(in) :: a_in, weights_in
+      real (kind=RKIND), dimension(ne,ne), intent(out) :: b_out
+   
+      ! local storage
+   
+      real (kind=RKIND), dimension(m,n)  :: a
+      real (kind=RKIND), dimension(n,m)  :: b
+      real (kind=RKIND), dimension(m,m)  :: w,wt,h
+      real (kind=RKIND), dimension(n,m)  :: at, ath
+      real (kind=RKIND), dimension(n,n)  :: ata, ata_inv, atha, atha_inv
+      integer, dimension(n) :: indx
+      integer :: i,j
+   
+      if ( (ne&lt;n) .or. (ne&lt;m) ) then
+         write(6,*) ' error in poly_fit_2 inversion ',m,n,ne
+         stop
+      end if
+   
+!      a(1:m,1:n) = a_in(1:n,1:m) 
+      a(1:m,1:n) = a_in(1:m,1:n)
+      w(1:m,1:m) = weights_in(1:m,1:m) 
+      b_out(:,:) = 0.   
+
+      wt = transpose(w)
+      h = matmul(wt,w)
+      at = transpose(a)
+      ath = matmul(at,h)
+      atha = matmul(ath,a)
+      
+      ata = matmul(at,a)
+
+!      if (m == n) then
+!         call MIGS(a,n,b,indx)
+!      else
+
+         call MIGS(atha,n,atha_inv,indx)
+
+         b = matmul(atha_inv,ath)
+
+!         call MIGS(ata,n,ata_inv,indx)
+!         b = matmul(ata_inv,at)
+!      end if
+      b_out(1:n,1:m) = b(1:n,1:m)
+
+!     do i=1,n
+!        write(6,*) ' i, indx ',i,indx(i)
+!     end do
+!
+!     write(6,*) ' '
+
+   end subroutine poly_fit_2
+
+
+! Updated 10/24/2001.
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!   Program 4.4   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!                                                                       !
+! Please Note:                                                          !
+!                                                                       !
+! (1) This computer program is written by Tao Pang in conjunction with  !
+!     his book, &quot;An Introduction to Computational Physics,&quot; published   !
+!     by Cambridge University Press in 1997.                            !
+!                                                                       !
+! (2) No warranties, express or implied, are made for this program.     !
+!                                                                       !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+SUBROUTine MIGS (A,N,X,INDX)
+!
+! Subroutine to invert matrix A(N,N) with the inverse stored
+! in X(N,N) in the output.  Copyright (c) Tao Pang 2001.
+!
+  IMPLICIT NONE
+  INTEGER, INTENT (IN) :: N
+  INTEGER :: I,J,K
+  INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
+  REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N):: A
+  REAL (kind=RKIND), INTENT (OUT), DIMENSION (N,N):: X
+  REAL (kind=RKIND), DIMENSION (N,N) :: B
+!
+  DO I = 1, N
+    DO J = 1, N
+      B(I,J) = 0.0
+    END DO
+  END DO
+  DO I = 1, N
+    B(I,I) = 1.0
+  END DO
+!
+  CALL ELGS (A,N,INDX)
+!
+  DO I = 1, N-1
+    DO J = I+1, N
+      DO K = 1, N
+        B(INDX(J),K) = B(INDX(J),K)-A(INDX(J),I)*B(INDX(I),K)
+      END DO
+    END DO
+  END DO
+!
+  DO I = 1, N
+    X(N,I) = B(INDX(N),I)/A(INDX(N),N)
+    DO J = N-1, 1, -1
+      X(J,I) = B(INDX(J),I)
+      DO K = J+1, N
+        X(J,I) = X(J,I)-A(INDX(J),K)*X(K,I)
+      END DO
+      X(J,I) =  X(J,I)/A(INDX(J),J)
+    END DO
+  END DO
+END SUBROUTine MIGS
+
+
+SUBROUTINE ELGS (A,N,INDX)
+!
+! Subroutine to perform the partial-pivoting Gaussian elimination.
+! A(N,N) is the original matrix in the input and transformed matrix
+! plus the pivoting element ratios below the diagonal in the output.
+! INDX(N) records the pivoting order.  Copyright (c) Tao Pang 2001.
+!
+  IMPLICIT NONE
+  INTEGER, INTENT (IN) :: N
+  INTEGER :: I,J,K,ITMP
+  INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
+  REAL (kind=RKIND) :: C1,PI,PI1,PJ
+  REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
+  REAL (kind=RKIND), DIMENSION (N) :: C
+!
+! Initialize the index
+!
+  DO I = 1, N
+    INDX(I) = I
+  END DO
+!
+! Find the rescaling factors, one from each row
+!
+  DO I = 1, N
+    C1= 0.0
+    DO J = 1, N
+      C1 = AMAX1(C1,ABS(A(I,J)))
+    END DO
+    C(I) = C1
+  END DO
+!
+! Search the pivoting (largest) element from each column
+!
+  DO J = 1, N-1
+    PI1 = 0.0
+    DO I = J, N
+      PI = ABS(A(INDX(I),J))/C(INDX(I))
+      IF (PI.GT.PI1) THEN
+        PI1 = PI
+        K   = I
+      ENDIF
+    END DO
+!
+! Interchange the rows via INDX(N) to record pivoting order
+!
+    ITMP    = INDX(J)
+    INDX(J) = INDX(K)
+    INDX(K) = ITMP
+    DO I = J+1, N
+      PJ  = A(INDX(I),J)/A(INDX(J),J)
+!
+! Record pivoting ratios below the diagonal
+!
+      A(INDX(I),J) = PJ
+!
+! Modify other elements accordingly
+!
+      DO K = J+1, N
+        A(INDX(I),K) = A(INDX(I),K)-PJ*A(INDX(J),K)
+      END DO
+    END DO
+  END DO
+!
+END SUBROUTINE ELGS
+
+end module atmh_advection

Copied: branches/source_condensing/src/core_hyd_atmos/mpas_atmh_mpas_core.F (from rev 1114, trunk/mpas/src/core_hyd_atmos/mpas_atmh_mpas_core.F)
===================================================================
--- branches/source_condensing/src/core_hyd_atmos/mpas_atmh_mpas_core.F                                (rev 0)
+++ branches/source_condensing/src/core_hyd_atmos/mpas_atmh_mpas_core.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,302 @@
+module mpas_core
+
+   use mpas_framework
+   use mpas_timekeeping
+
+   type (io_output_object) :: restart_obj
+   integer :: restart_frame
+
+   integer :: current_outfile_frames
+
+   type (MPAS_Clock_type) :: clock
+
+   integer, parameter :: outputAlarmID = 1
+   integer, parameter :: restartAlarmID = 2
+
+
+   contains
+
+
+     subroutine mpas_core_init(domain, startTimeStamp)
+
+      use mpas_configure
+      use mpas_grid_types
+      use atmh_test_cases
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+      character(len=*), intent(out) :: startTimeStamp
+
+      real (kind=RKIND) :: dt
+      type (block_type), pointer :: block
+
+
+      if (.not. config_do_restart) call atmh_setup_test_case(domain)
+
+      !
+      ! Initialize core
+      !
+      dt = config_dt
+
+      call atmh_simulation_clock_init(domain, dt, startTimeStamp)
+
+      block =&gt; domain % blocklist
+      do while (associated(block))
+         call atmh_init_block(block, block % mesh, dt)
+         block % state % time_levs(1) % state % xtime % scalar = startTimeStamp 
+         block =&gt; block % next
+      end do
+
+      restart_frame = 1
+      current_outfile_frames = 0
+
+   end subroutine mpas_core_init
+   
+   
+   subroutine mpas_core_run(domain, output_obj, output_frame)
+   
+      use mpas_grid_types
+      use mpas_io_output
+      use mpas_timer
+   
+      implicit none
+   
+      type (domain_type), intent(inout) :: domain
+      type (io_output_object), intent(inout) :: output_obj
+      integer, intent(inout) :: output_frame
+   
+      integer :: ntimesteps, itimestep
+      real (kind=RKIND) :: dt
+      type (block_type), pointer :: block_ptr
+
+      type (MPAS_Time_Type) :: currTime
+      character(len=32) :: timeStamp
+      integer :: ierr
+   
+      ! Eventually, dt should be domain specific
+      dt = config_dt
+
+      currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+      call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)
+      write(0,*) 'Initial time ', timeStamp
+
+      call atmh_write_output_frame(output_obj, output_frame, domain)
+   
+      ! During integration, time level 1 stores the model state at the beginning of the
+      !   time step, and time level 2 stores the state advanced dt in time by timestep(...)
+      do while (.not. mpas_is_clock_stop_time(clock))
+
+         call mpas_advance_clock(clock)
+
+         currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+         call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)
+         write(0,*) 'Doing timestep ', timeStamp
+
+         call mpas_timer_start(&quot;time integration&quot;)
+         call atmh_do_timestep(domain, dt, timeStamp)
+         call mpas_timer_stop(&quot;time integration&quot;)
+   
+         ! Move time level 2 fields back into time level 1 for next time step
+         call mpas_shift_time_levels_state(domain % blocklist % state)
+   
+         if (mpas_is_alarm_ringing(clock, outputAlarmID, ierr=ierr)) then
+            call mpas_reset_clock_alarm(clock, outputAlarmID, ierr=ierr)
+            if(output_frame == 1) call mpas_output_state_init(output_obj, domain, &quot;OUTPUT&quot;, trim(timeStamp)) ! output_frame will always be &gt; 1 here unless it is reset after the output file is finalized
+            call atmh_write_output_frame(output_obj, output_frame, domain)
+         end if
+
+         if (mpas_is_alarm_ringing(clock, restartAlarmID, ierr=ierr)) then
+            call mpas_reset_clock_alarm(clock, restartAlarmID, ierr=ierr)
+            if (restart_frame == 1) call mpas_output_state_init(restart_obj, domain, &quot;RESTART&quot;)
+            call mpas_output_state_for_domain(restart_obj, domain, restart_frame)
+            restart_frame = restart_frame + 1
+         end if
+
+      end do
+
+   end subroutine mpas_core_run
+   
+   
+   subroutine mpas_core_finalize(domain)
+   
+      use mpas_grid_types
+   
+      implicit none
+  
+      integer :: ierr

+      type (domain_type), intent(inout) :: domain 
+
+      if (restart_frame &gt; 1) call mpas_output_state_finalize(restart_obj, domain % dminfo)
+
+      call mpas_destroy_clock(clock, ierr)
+
+   end subroutine mpas_core_finalize
+
+
+   subroutine atmh_simulation_clock_init(domain, dt, startTimeStamp)
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+      real (kind=RKIND), intent(in) :: dt
+      character(len=*), intent(out) :: startTimeStamp
+
+      type (MPAS_Time_Type) :: startTime, stopTime, alarmStartTime
+      type (MPAS_TimeInterval_type) :: runDuration, timeStep, alarmTimeStep
+      integer :: ierr
+
+      call mpas_set_time(curr_time=startTime, dateTimeString=config_start_time, ierr=ierr)
+      call mpas_set_timeInterval(timeStep, dt=dt, ierr=ierr)
+
+      if (trim(config_run_duration) /= &quot;none&quot;) then
+         call mpas_set_timeInterval(runDuration, timeString=config_run_duration, ierr=ierr)
+         call mpas_create_clock(clock, startTime=startTime, timeStep=timeStep, runDuration=runDuration, ierr=ierr)
+
+         if (trim(config_stop_time) /= &quot;none&quot;) then
+            call mpas_set_time(curr_time=stopTime, dateTimeString=config_stop_time, ierr=ierr)
+            if(startTime + runduration /= stopTime) then
+               write(0,*) 'Warning: config_run_duration and config_stop_time are inconsitent: using config_run_duration.'
+            end if
+         end if
+      else if (trim(config_stop_time) /= &quot;none&quot;) then
+         call mpas_set_time(curr_time=stopTime, dateTimeString=config_stop_time, ierr=ierr)
+         call mpas_create_clock(clock, startTime=startTime, timeStep=timeStep, stopTime=stopTime, ierr=ierr)
+      else
+          write(0,*) 'Error: Neither config_run_duration nor config_stop_time were specified.'
+          call mpas_dmpar_abort(domain % dminfo)
+      end if
+
+      ! set output alarm
+      call mpas_set_timeInterval(alarmTimeStep, timeString=config_output_interval, ierr=ierr)
+      alarmStartTime = startTime + alarmTimeStep
+      call mpas_add_clock_alarm(clock, outputAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
+
+      ! set restart alarm, if necessary
+      if (trim(config_restart_interval) /= &quot;none&quot;) then
+         call mpas_set_timeInterval(alarmTimeStep, timeString=config_restart_interval, ierr=ierr)
+         alarmStartTime = startTime + alarmTimeStep
+         call mpas_add_clock_alarm(clock, restartAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
+      end if
+
+      call mpas_get_time(curr_time=startTime, dateTimeString=startTimeStamp, ierr=ierr)
+
+   end subroutine atmh_simulation_clock_init
+
+
+   subroutine atmh_init_block(block, mesh, dt)
+   
+      use mpas_grid_types
+      use mpas_rbf_interpolation
+      use mpas_vector_reconstruction
+      use atmh_advection
+      use atmh_time_integration
+   
+      implicit none
+   
+      type (block_type), intent(inout) :: block
+      type (mesh_type), intent(inout) :: mesh
+      real (kind=RKIND), intent(in) :: dt
+   
+   
+      call atmh_compute_solver_constants(block % state % time_levs(1) % state, mesh)
+      call atmh_compute_state_diagnostics(block % state % time_levs(1) % state, mesh)
+      call atmh_compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
+      call atmh_initialize_advection_rk(mesh)
+      call mpas_rbf_interp_initialize(mesh)
+      call mpas_init_reconstruct(mesh)
+      call mpas_reconstruct(mesh, block % state % time_levs(1) % state % u % array, &amp;
+                       block % diag % uReconstructX % array,                   &amp;
+                       block % diag % uReconstructY % array,                   &amp;
+                       block % diag % uReconstructZ % array,                   &amp;
+                       block % diag % uReconstructZonal % array,               &amp;
+                       block % diag % uReconstructMeridional % array           &amp;
+                      )
+
+  
+   end subroutine atmh_init_block
+   
+   
+   subroutine atmh_write_output_frame(output_obj, output_frame, domain)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Compute diagnostic fields for a domain and write model state to output file
+   !
+   ! Input/Output: domain - contains model state; diagnostic field are computed
+   !                        before returning
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   
+      use mpas_grid_types
+      use mpas_io_output
+   
+      implicit none
+   
+      integer, intent(inout) :: output_frame
+      type (domain_type), intent(inout) :: domain
+      type (io_output_object), intent(inout) :: output_obj
+   
+      integer :: i, j, k
+      integer :: eoe
+      type (block_type), pointer :: block_ptr
+   
+      block_ptr =&gt; domain % blocklist
+      do while (associated(block_ptr))
+         call atmh_compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
+         block_ptr =&gt; block_ptr % next
+      end do
+   
+      call mpas_output_state_for_domain(output_obj, domain, output_frame)
+      output_frame = output_frame + 1
+
+      ! if the maximum number of frames per outfile has been reached, finalize outfile and reset frame
+      if (config_frames_per_outfile &gt; 0) then
+         current_outfile_frames = current_outfile_frames + 1
+         if(current_outfile_frames &gt;= config_frames_per_outfile) then
+            current_outfile_frames = 0
+            call mpas_output_state_finalize(output_obj, domain % dminfo)
+            output_frame = 1
+         end if
+      end if
+
+   end subroutine atmh_write_output_frame
+   
+   
+   subroutine atmh_compute_output_diagnostics(state, grid)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Compute diagnostic fields for a domain
+   !
+   ! 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 (mesh_type), intent(in) :: grid
+   
+      integer :: i, eoe
+      integer :: iEdge, k
+   
+   end subroutine atmh_compute_output_diagnostics
+   
+   
+   subroutine atmh_do_timestep(domain, dt, timeStamp)
+   
+      use mpas_grid_types
+      use atmh_time_integration
+   
+      implicit none
+   
+      type (domain_type), intent(inout) :: domain 
+      real (kind=RKIND), intent(in) :: dt
+      character(len=*), intent(in) :: timeStamp
+   
+      call atmh_timestep(domain, dt, timeStamp)
+   
+   end subroutine atmh_do_timestep
+
+end module mpas_core

Copied: branches/source_condensing/src/core_hyd_atmos/mpas_atmh_test_cases.F (from rev 1114, trunk/mpas/src/core_hyd_atmos/mpas_atmh_test_cases.F)
===================================================================
--- branches/source_condensing/src/core_hyd_atmos/mpas_atmh_test_cases.F                                (rev 0)
+++ branches/source_condensing/src/core_hyd_atmos/mpas_atmh_test_cases.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,544 @@
+module atmh_test_cases
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+
+
+   contains
+
+
+   subroutine atmh_setup_test_case(domain)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Configure grid metadata and model state for the hydrostatic test case
+   !   specified in the namelist
+   !
+   ! Output: block - a subset (not necessarily proper) of the model domain to be
+   !                 initialized
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+
+      integer :: i
+      type (block_type), pointer :: block_ptr
+
+      if (config_test_case == 0) then
+         write(0,*) ' need hydrostatic test case configuration, error stop '
+         stop
+
+      else 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 '
+         if (config_test_case == 1) write(0,*) ' no initial perturbation '
+         if (config_test_case == 2) write(0,*) ' initial perturbation included '
+         if (config_test_case == 3) write(0,*) ' normal-mode perturbation included '
+         block_ptr =&gt; domain % blocklist
+         do while (associated(block_ptr))
+            call atmh_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state, config_test_case)
+            do i=2,nTimeLevs
+               call mpas_copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
+            end do
+
+            block_ptr =&gt; block_ptr % next
+         end do
+
+      else
+         write(0,*) ' Only test case 1 and 2 are currently supported for hydrostatic core '
+         stop
+      end if
+
+   end subroutine atmh_setup_test_case
+
+!----------------------------------------------------------------------------------------------------------
+
+   subroutine atmh_test_case_1(grid, state, test_case)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Setup baroclinic wave test case from Jablonowski and Williamson 2008 (QJRMS)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (mesh_type), intent(inout) :: grid
+      type (state_type), intent(inout) :: state
+      integer, intent(in) :: test_case
+
+      real (kind=RKIND), parameter :: u0 = 35.0
+      real (kind=RKIND), parameter :: alpha_grid = 0.  ! no grid rotation
+      real (kind=RKIND), parameter :: omega_e = 7.29212e-05
+      real (kind=RKIND), parameter :: t0 = 288., delta_t = 4.8e+05, dtdz = 0.005, eta_t = 0.2
+      real (kind=RKIND), parameter :: u_perturbation = 1., pert_radius = 0.1, latitude_pert = 40., longitude_pert = 20.
+      real (kind=RKIND), parameter :: theta_c = pii/4.0
+      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
+      real (kind=RKIND), parameter :: rh_max = 0.4       ! Maximum relative humidity
+      real (kind=RKIND), parameter :: k_x = 9.           ! Normal mode wave number
+
+      real (kind=RKIND), dimension(:), pointer :: rdnu, rdnw, fnm, fnp, dbn, dnu, dnw
+      real (kind=RKIND), dimension(:), pointer :: surface_pressure
+      real (kind=RKIND), dimension(:,:), pointer :: pressure, theta, alpha, geopotential, h
+      real (kind=RKIND), dimension(:,:,:), pointer :: scalars
+
+      integer :: iCell, iEdge, vtx1, vtx2, ivtx, k, nz, nz1, index_qv
+      real (kind=RKIND) :: u, v, flux, fluxk, lat1, lat2, eta_v, r_pert, u_pert, lat_pert, lon_pert, r
+
+      real (kind=RKIND) :: ptop, p0, phi
+      real (kind=RKIND) :: lon_Edge
+
+      real (kind=RKIND), dimension(grid % nVertLevels, grid % nCells) :: rel_hum, temperature
+      real (kind=RKIND) :: ptmp, es, qvs
+      integer :: iter
+
+!      real (kind=RKIND), dimension(grid % nVertLevelsP1 ) :: hyai, hybi, znu, znw, znwc, znwv, hyam, hybm
+!      real (kind=RKIND), dimension(grid % nVertLevelsP1 ) :: znuc, znuv, bn, divh, dpn, teta, phi
+      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: hyai, hybi, znu, znw, znwc, znwv, hyam, hybm
+      real (kind=RKIND), dimension(grid % nVertLevels + 1 ) :: znuc, znuv, bn, divh, dpn, teta
+
+      real (kind=RKIND) :: HYAI_CAM26(27), HYBI_CAM26(27), HYAM_CAM26(26), HYBM_CAM26(26)
+
+      logical, parameter :: cam26 = .true.
+
+      data hyai_cam26 / 0.002194067, 0.004895209, 0.009882418, 0.018052010,  &amp;
+                        0.029837240, 0.044623340, 0.061605870, 0.078512430,  &amp;
+                        0.077312710, 0.075901310, 0.074240860, 0.072287440,  &amp;
+                        0.069989330, 0.067285740, 0.064105090, 0.060363220,  &amp;
+                        0.055961110, 0.050782250, 0.044689600, 0.037521910,  &amp;
+                        0.029089490, 0.020847390, 0.013344430, 0.007084990,  &amp;
+                        0.002521360, 0.000000000, 0.000000000/,              &amp;
+           hybi_cam26 / 0.000000000, 0.000000000, 0.000000000, 0.000000000,  &amp;
+                        0.000000000, 0.000000000, 0.000000000, 0.000000000,  &amp;
+                        0.015053090, 0.032762280, 0.053596220, 0.078106270,  &amp;
+                        0.106941100, 0.140863700, 0.180772000, 0.227722000,  &amp;
+                        0.282956200, 0.347936400, 0.424382200, 0.514316800,  &amp;
+                        0.620120200, 0.723535500, 0.817676800, 0.896215300,  &amp;
+                        0.953476103, 0.985112200, 1.000000000/
+
+      !
+      ! Scale all distances and areas from a unit sphere to one with radius a
+      !
+      grid % xCell % array = grid % xCell % array * a
+      grid % yCell % array = grid % yCell % array * a
+      grid % zCell % array = grid % zCell % array * a
+      grid % xVertex % array = grid % xVertex % array * a
+      grid % yVertex % array = grid % yVertex % array * a
+      grid % zVertex % array = grid % zVertex % array * a
+      grid % xEdge % array = grid % xEdge % array * a
+      grid % yEdge % array = grid % yEdge % array * a
+      grid % zEdge % array = grid % zEdge % array * a
+      grid % dvEdge % array = grid % dvEdge % array * a
+      grid % dcEdge % array = grid % dcEdge % array * a
+      grid % areaCell % array = grid % areaCell % array * a**2.0
+      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
+      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
+
+      index_qv = state % index_qv
+      
+      nz1 = grid % nVertLevels
+      nz = nz1 + 1
+
+      rdnu =&gt; grid % rdnu % array
+      rdnw =&gt; grid % rdnw % array
+      fnm =&gt; grid % fnm % array
+      fnp =&gt; grid % fnp % array
+      dbn =&gt; grid % dbn % array
+      dnu =&gt; grid % dnu % array
+      dnw =&gt; grid % dnw % array
+
+      surface_pressure =&gt; state % surface_pressure % array
+      pressure =&gt; state % pressure % array
+      theta =&gt; state % theta % array
+      alpha =&gt; state % alpha % array
+      geopotential =&gt; state % geopotential % array
+      h =&gt; state % h % array
+      scalars =&gt; state % scalars % array
+
+      scalars(:,:,:) = 0.
+
+      p0      = 100000.
+      bn (1) = 1.
+      znw(1) = 1.
+      znwc(1) = 1.
+      !znwv(1) = (znwc(1)-.252)*pii/2.
+      znwv(1) = ((znwc(1)-.252)*pii/2.*p0-ptop)/(p0-ptop)
+                
+      if (cam26) then
+
+        if (grid % nVertLevels /= 26 ) then
+          write(0,*) ' init is for 26 levels only, error stop '
+          stop
+        else
+                do k=1,nz
+            hyai(k) = hyai_cam26(k)
+            hybi(k) = hybi_cam26(k)
+          end do
+
+          write(0,*) ' initialization using cam 26 levels '
+
+        end if
+
+        ptop    = hyai(1)*p0
+
+        do k=1,nz1
+           hyam(k) = .5*(hyai(k)+hyai(k+1))
+           hybm(k) = .5*(hybi(k)+hybi(k+1))
+           znuc(nz-k)   = hyam(k) + hybm(k)
+           znwc(nz-k+1) = hyai(k) + hybi(k)
+           znu (nz-k  ) = (znuc(nz-k  )*p0-ptop)/(p0-ptop)
+           znw (nz-k+1) = (znwc(nz-k+1)*p0-ptop)/(p0-ptop)
+!           znuv(nz-k  ) = (znuc(nz-k  )-.252)*pii/2.
+!           znwv(nz-k+1) = (znwc(nz-k+1)-.252)*pii/2.
+           bn(k+1) = hybi(nz-k)
+        end do
+
+      else ! analytic profile
+
+        ptop = 219.4067
+        znw(1) = 1.
+
+        do k=1,nz1
+
+          ! eta profile (constant deta for exp=1,)
+
+          znw(k+1) = (1.-float(k)/float(nz1))**2.
+
+          ! profile for tranisition from sigma to presure coordinate
+          ! bn(k)=znw(k) for sigma coord, bn(k)=0 for p coord
+          !  bn(1)=1, bn(nz)=0 must be satisfied
+                                
+          bn(k+1) = znw(k+1)*sin(.5*pii*znw(k+1))**2
+          !!  bn(k+1) = znw(k+1)
+                                                                                                                                
+          znu (k)   = .5*(znw(k)+znw(k+1))
+          znuc(k)   = (znu(k  )*(p0-ptop)+ptop)/p0
+          znwc(k+1) = (znw(k+1)*(p0-ptop)+ptop)/p0
+        end do
+
+      end if  ! cam or analytic grid-level profile
+
+      !
+      !  metrics for vertical stretching
+      !
+
+      do k=1,nz1
+        !znuv(k  ) = (znuc(k  )-.252)*pii/2.
+        !znwv(k+1) = (znwc(k+1)-.252)*pii/2.
+        znuv(k  ) = ((znuc(k  )-.252)*pii/2.*p0-ptop)/(p0-ptop)
+        znwv(k+1) = ((znwc(k+1)-.252)*pii/2.*p0-ptop)/(p0-ptop)
+        dnw (k) = znw(k+1)-znw(k)
+        rdnw(k) = 1./dnw(k)
+        dbn (k) = rdnw(k)*(bn(k+1)-bn(k))
+        dpn (k) = 0.
+        divh(k) = 0.
+        write (6,*) k,znw(k),dnw(k),bn(k),dbn(k)
+      end do
+
+      dpn(nz)=0.
+      fnm(1) = 0.
+      fnp(1) = 0.
+      do k=2,nz1
+         dnu (k)  = .5*(dnw(k)+dnw(k-1))
+         rdnu(k)  = 1./dnu(k)
+         fnp (k)  = .5* dnw(k  )/dnu(k)
+         fnm (k)  = .5* dnw(k-1)/dnu(k)
+      end do
+
+      !
+      ! Initialize wind field
+      !
+
+      lat_pert = latitude_pert*pii/180.
+      lon_pert = longitude_pert*pii/180.
+
+      do iEdge=1,grid % nEdges
+
+         vtx1 = grid % VerticesOnEdge % array (1,iEdge)
+         vtx2 = grid % VerticesOnEdge % array (2,iEdge)
+         lat1 = grid%latVertex%array(vtx1)
+         lat2 = grid%latVertex%array(vtx2)
+         flux = (0.5*(lat2-lat1) - 0.125*(sin(4.*lat2) - sin(4.*lat1)))*a/grid % dvEdge % array(iEdge)
+
+         if (config_test_case == 2) then
+            r_pert = sphere_distance( grid % latEdge % array (iEdge), grid % lonEdge % array (iEdge), &amp;
+                                      lat_pert, lon_pert, 1.)/(pert_radius)
+            u_pert = u_perturbation*exp(-r_pert**2)*(lat2-lat1)*a/grid % dvEdge % array(iEdge)
+
+         else if (config_test_case == 3) then
+            lon_Edge = grid % lonEdge % array(iEdge)
+            u_pert = u_perturbation*cos(k_x*(lon_Edge - lon_pert)) &amp;
+                         *(0.5*(lat2-lat1) - 0.125*(sin(4.*lat2) - sin(4.*lat1)))*a/grid % dvEdge % array(iEdge)
+         else
+            u_pert = 0.0
+         end if
+
+
+         do k=1,grid % nVertLevels
+           fluxk = u0*flux*(cos(znuv(k))**(1.5))
+           state % u % array(k,iEdge) = fluxk + u_pert
+         end do
+
+      !
+      ! Generate rotated Coriolis field
+      !
+
+         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
+                                       ( -cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha_grid) + &amp;
+                                         sin(grid%latEdge%array(iEdge)) * cos(alpha_grid) &amp;
+                                       )
+      end do
+
+      do iVtx=1,grid % nVertices
+         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
+                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha_grid) + &amp;
+                                          sin(grid%latVertex%array(iVtx)) * cos(alpha_grid) &amp;
+                                         )
+      end do
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! To get hydrostatic balance with misture -- soln. 2.
+! original scheme by Jablonowski
+!                            T' = -1./R_d *(p/p_0) * d(phi')/d(eta)
+!                               = -1./R_d * eta * d(phi')/d(eta)
+! soln. 2 -&gt; derive temperature profile from hydrostatic balance with moisture
+! 
+!                           T_v = -1/(1+q_v)*(p/R_d)* d(eta)/d(p_d) * d(phi)/d(eta)
+!                           phi'(k) = phi(k+1) + d(eta)* alpha_pert * d(eta)/d(p_d)
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+                        
+      do iCell=1,grid % nCells
+
+        phi = grid % latCell % array (iCell)
+
+        surface_pressure(iCell) = p0
+
+        do k=1,nz1
+          h(k,iCell) = (1.-dbn(k))*(p0-ptop)+dbn(k)*(surface_pressure(iCell)-ptop)
+        end do
+                        
+         pressure(nz,iCell) = ptop
+         do k=nz1,1,-1
+               pressure(k,iCell) = pressure(k+1,iCell)-dnw(k)*h(k,iCell)
+         end do
+
+         do k=1,nz1
+            ptmp = 0.5*(pressure(k,iCell)+pressure(k+1,iCell))
+            if (znuc(k) &gt;= eta_t) then
+               teta(k) = t0*(ptmp/p0)**(rgas*dtdz/gravity)
+            else
+               teta(k) = t0*(ptmp/p0)**(rgas*dtdz/gravity) + delta_t*(eta_t-ptmp/p0)**5
+            end if
+            theta (k,iCell) = teta(k)+.75*ptmp/h(k,iCell)*pii*u0/rgas*sin(znuv(k))    &amp;
+                              *sqrt(cos(znuv(k)))*                         &amp;
+                                ((-2.*sin(phi)**6                          &amp;
+                                     *(cos(phi)**2+1./3.)+10./63.)         &amp;
+                                     *2.*u0*cos(znuv(k))**1.5              &amp;
+                                +(1.6*cos(phi)**3                          &amp;
+                                     *(sin(phi)**2+2./3.)-pii/4.)*a*omega)
+
+            theta (k,iCell) = theta(k,iCell)*  &amp;
+                      (0.5*(pressure(k,iCell)+pressure(k+1,iCell))/p0)**(-rgas/cp)
+            alpha(k,iCell) = ((rgas/p0)*theta(k,iCell)* &amp;
+                      (0.5*(pressure(k,iCell)+pressure(k+1,iCell))/p0)**cvpm)
+
+         end do
+      end do
+!
+!     initialization for geopotential
+!
+      do iCell=1,grid % nCells
+
+         phi = grid % latCell % array (iCell)
+
+         geopotential(1,iCell) = u0*cos(znwv(1))**1.5*                     &amp;
+                                 ((-2.*sin(phi)**6                     &amp;
+                                      *(cos(phi)**2+1./3.)+10./63.)    &amp;
+                                      *(u0)*cos(znwv(1))**1.5          &amp;
+                                 +(1.6*cos(phi)**3                     &amp;
+                                     *(sin(phi)**2+2./3.)-pii/4.)*a*omega)
+         do k=1,nz1
+           geopotential(k+1,iCell) = geopotential(k,iCell)-dnw(k)*h(k,iCell)*alpha(k,iCell)
+         end do
+      end do
+                
+      write(6,*) 'ptop_dry = ',ptop,'  zt_dry = ',geopotential(nz,1)/gravity
+
+      write(6,*) ' full sounding for dry'
+      do k=1,nz1
+         write(6,*) k, geopotential(k,1)/gravity, 0.01*pressure(k,1), theta(k,1), &amp;
+                    theta(k,1)*(pressure(k,1)/p0)**(rgas/cp)
+      end do
+
+!
+!     initialization for moisture 
+!
+      if (config_mp_physics /= 0) then
+
+         do iCell=1,grid % nCells
+            do k=1,nz1
+               ptmp = 0.5*(pressure(k,iCell) + pressure(k+1,iCell))
+               if (ptmp &lt; 50000.) then
+                  rel_hum(k,iCell) = 0.0
+               else
+                  rel_hum(k,iCell) = (1.-((p0-ptmp)/50000.)**1.25)
+               end if
+               rel_hum(k,iCell) = min(rh_max,rel_hum(k,iCell))
+            end do
+         end do
+      else
+         rel_hum(:,:) = 0.
+      end if
+
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+      ! iteration 
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      do iter=1,30
+         do iCell=1,grid % nCells 
+   
+            phi = grid % latCell % array (iCell)
+            do k=1,nz1
+               ptmp = 0.5*(pressure(k+1,iCell)+pressure(k,iCell))
+   
+               if(znuc(k) &gt;= eta_t)  then
+                  teta(k) = t0*(ptmp/p0)**(rgas*dtdz/gravity)
+               else
+                  teta(k) = t0*(ptmp/p0)**(rgas*dtdz/gravity) + delta_t*(eta_t-ptmp/p0)**5
+               end if
+   
+               temperature (k,iCell) = teta(k)+.75*ptmp/h(k,iCell)*pii*u0/rgas*sin(znuv(k))    &amp;
+                                 *sqrt(cos(znuv(k)))*                         &amp;
+                                   ((-2.*sin(phi)**6                          &amp;
+                                        *(cos(phi)**2+1./3.)+10./63.)         &amp;
+                                        *2.*u0*cos(znuv(k))**1.5              &amp;
+                                   +(1.6*cos(phi)**3                          &amp;
+                                        *(sin(phi)**2+2./3.)-pii/4.)*a*omega)
+   
+               temperature(k,iCell) = temperature(k,iCell)/(1.+0.61*scalars(index_qv,k,iCell))
+   
+               theta (k,iCell) = temperature(k,iCell)*  &amp;
+                                     (0.5*(pressure(k,iCell)+pressure(k+1,iCell))/p0)**(-rgas/cp)
+               alpha (k,iCell) = (rgas/p0)*theta(k,iCell)*(1.+1.61*scalars(index_qv,k,iCell))* &amp;
+                                     (0.5*(pressure(k,iCell)+pressure(k+1,iCell))/p0)**cvpm
+   
+               if (temperature(k,iCell) &gt; 273.15) then
+                   es  = 1000.*0.6112*exp(17.67*(temperature(k,iCell)-273.15)/(temperature(k,iCell)-29.65))
+               else
+                   es  = 1000.*0.6112*exp(21.8745584*(temperature(k,iCell)-273.16)/(temperature(k,iCell)-7.66))
+               end if
+               qvs = (287.04/461.6)*es/(ptmp-es)
+!               qvs =  380.*exp(17.27*(temperature(k,iCell)-273.)/(temperature(k,iCell)-36.))/ptmp
+   
+               scalars(index_qv,k,iCell) = rel_hum(k,iCell)*qvs
+            end do
+   
+            do k=nz1,1,-1
+               pressure(k,iCell) = pressure(k+1,iCell)-dnw(k)*h(k,iCell)*(1.+scalars(index_qv,k,iCell))
+               geopotential(k,iCell) = geopotential(k+1,iCell)+dnw(k)*h(k,iCell)*alpha(k,iCell)
+            end do
+   
+         end do
+      end do
+
+      write(6,*) 'ptop = ',ptop,'  zt = ',geopotential(nz,1)/gravity
+
+      write(6,*) ' full sounding with moisture'
+      do k=1,nz1
+         write(6,*) k, geopotential(k,1)/gravity, 0.01*pressure(k,1), theta(k,1), &amp;
+                    theta(k,1)*(pressure(k,1)/p0)**(rgas/cp)
+      end do
+
+! When initializing a scalar, be sure not to put unreasonably large values
+! into indices in the moist class
+!      scalars(2,:,:) = 1.  ! transport test
+!      scalars(2,:,:) = theta  ! transport test
+!      if (num_scalars &gt;= 2) then
+!         scalars(2,:,:) = 0.0
+!         do iCell=1,grid%nCells
+!            r = sphere_distance(theta_c, lambda_c, grid % latCell % array(iCell), grid % lonCell % array(iCell), a)
+!            if (r &lt; a/3.0) then
+!               do k=1,grid%nVertLevels
+!                  scalars(2,k,iCell) = (1.0 / 2.0) * (1.0 + cos(pii*r*3.0/a))
+!               end do
+!            end if
+!         end do
+!      end if
+!      if (num_scalars &gt;= 3) scalars(3,:,:) = theta + 100.  ! transport test
+!      if (num_scalars &gt;= 4) scalars(4,:,:) = theta + 200.  ! transport test
+!      if (num_scalars &gt;= 5) scalars(5,:,:) = theta + 300.  ! transport test
+
+   end subroutine atmh_test_case_1
+
+
+   real function sphere_distance(lat1, lon1, lat2, lon2, radius)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
+   !   sphere with given radius.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      real (kind=RKIND), intent(in) :: lat1, lon1, lat2, lon2, radius
+
+      real (kind=RKIND) :: arg1
+
+      arg1 = sqrt( sin(0.5*(lat2-lat1))**2 +  &amp;
+                   cos(lat1)*cos(lat2)*sin(0.5*(lon2-lon1))**2 )
+      sphere_distance = 2.*radius*asin(arg1)
+
+   end function sphere_distance
+
+
+   real function AA(theta)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! A, used in height field computation for Rossby-Haurwitz wave
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      real (kind=RKIND), parameter :: w = 7.848e-6
+      real (kind=RKIND), parameter :: K = 7.848e-6
+      real (kind=RKIND), parameter :: R = 4.0
+
+      real (kind=RKIND), intent(in) :: theta
+
+      AA = 0.5 * w * (2.0 * omega + w) * cos(theta)**2.0 + &amp;
+          0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 + 2.0*R**2.0 - R - 2.0 - 2.0*(R*cos(theta))**2.0)
+
+   end function AA
+
+   
+   real function BB(theta)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! B, used in height field computation for Rossby-Haurwitz wave
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      real (kind=RKIND), parameter :: w = 7.848e-6
+      real (kind=RKIND), parameter :: K = 7.848e-6
+      real (kind=RKIND), parameter :: R = 4.0
+
+      real (kind=RKIND), intent(in) :: theta
+
+      BB = (2.0*(omega + w)*K / ((R+1.0)*(R+2.0))) * cos(theta)**R * ((R**2.0 + 2.0*R + 2.0) - ((R+1.0)*cos(theta))**2.0)
+
+   end function BB
+
+
+   real function CC(theta)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! C, used in height field computation for Rossby-Haurwitz wave
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      real (kind=RKIND), parameter :: w = 7.848e-6
+      real (kind=RKIND), parameter :: K = 7.848e-6
+      real (kind=RKIND), parameter :: R = 4.0
+
+      real (kind=RKIND), intent(in) :: theta
+
+      CC = 0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 - R - 2.0)
+
+   end function CC
+
+end module atmh_test_cases

Copied: branches/source_condensing/src/core_hyd_atmos/mpas_atmh_time_integration.F (from rev 1114, trunk/mpas/src/core_hyd_atmos/mpas_atmh_time_integration.F)
===================================================================
--- branches/source_condensing/src/core_hyd_atmos/mpas_atmh_time_integration.F                                (rev 0)
+++ branches/source_condensing/src/core_hyd_atmos/mpas_atmh_time_integration.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,2122 @@
+module atmh_time_integration
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+   use mpas_dmpar
+   use mpas_vector_reconstruction
+
+
+   contains
+
+
+   subroutine atmh_timestep(domain, dt, timeStamp)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Advance model state forward in time by the specified time step
+   !
+   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
+   !                 plus grid meta-data
+   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
+   !                  model state advanced forward in time by dt seconds
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+      real (kind=RKIND), intent(in) :: dt
+      character(len=*), intent(in) :: timeStamp
+
+      type (block_type), pointer :: block
+
+      if (trim(config_time_integration) == 'SRK3') then
+         call atmh_srk3(domain, dt)
+      else
+         write(0,*) 'Unknown time integration option '//trim(config_time_integration)
+         write(0,*) 'Currently, only ''SRK3'' is supported.'
+         stop
+      end if
+
+      block =&gt; domain % blocklist
+      do while (associated(block))
+         block % state % time_levs(2) % state % xtime % scalar = timeStamp
+         block =&gt; block % next
+      end do
+
+   end subroutine atmh_timestep
+
+
+   subroutine atmh_srk3(domain, dt)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Advance model state forward in time by the specified time step using 
+   !   time-split RK3 scheme
+   !
+   ! Hydrostatic (primitive eqns.) solver
+   !
+   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
+   !                 plus grid meta-data
+   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
+   !                  model state advanced forward in time by dt seconds
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+      real (kind=RKIND), intent(in) :: dt
+
+      integer :: iCell, k
+      type (block_type), pointer :: block
+
+      integer, parameter :: TEND   = 1
+      integer :: rk_step, number_of_sub_steps
+
+      real (kind=RKIND), dimension(3) :: rk_timestep, rk_sub_timestep
+      integer, dimension(3) :: number_sub_steps
+      integer :: small_step
+      logical, parameter :: debug = .false.
+      logical, parameter :: debug_mass_conservation = .true.
+
+      real (kind=RKIND) :: domain_mass, scalar_mass, scalar_min, scalar_max
+      real (kind=RKIND) :: global_domain_mass, global_scalar_mass, global_scalar_min, global_scalar_max
+
+      !
+      ! Initialize time_levs(2) with state at current time
+      ! Initialize RK weights
+      !
+
+      number_of_sub_steps = config_number_of_sub_steps
+
+      rk_timestep(1) = dt/3.
+      rk_timestep(2) = dt/2.
+      rk_timestep(3) = dt
+
+      rk_sub_timestep(1) = dt/3.
+      rk_sub_timestep(2) = dt/real(number_of_sub_steps)
+      rk_sub_timestep(3) = dt/real(number_of_sub_steps)
+
+      number_sub_steps(1) = 1
+      number_sub_steps(2) = number_of_sub_steps/2
+      number_sub_steps(3) = number_of_sub_steps
+
+      if(debug) write(0,*) ' copy step in rk solver '
+
+      block =&gt; domain % blocklist
+      do while (associated(block))
+         call mpas_copy_state( block % state % time_levs(2) % state, block % state % time_levs(1) % state )
+         block =&gt; block % next
+      end do
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+      ! BEGIN RK loop 
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+
+      do rk_step = 1, 3
+
+        if(debug) write(0,*) ' rk substep ', rk_step
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % mesh % qtot % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % mesh % cqu % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
+                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % h % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % pressure % array(:,:), &amp;
+                                            block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % geopotential % array(:,:), &amp;
+                                            block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % alpha % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % pv_edge % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
+                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+           if (config_h_mom_eddy_visc4 &gt; 0.0) then
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &amp;
+                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &amp;
+                                               block % mesh % nVertLevels, block % mesh % nVertices, &amp;
+                                               block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
+           end if
+           block =&gt; block % next
+        end do
+
+        if(debug) write(0,*) ' rk substep ', rk_step
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           call atmh_compute_dyn_tend( block % tend, block % state % time_levs(2) % state, block % mesh )
+           block =&gt; block % next
+        end do
+
+        if(debug) write(0,*) ' returned from dyn_tend '
+
+        !
+        ! ---  update halos for tendencies
+        !
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % tend % u % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
+                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % tend % theta % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           block =&gt; block % next
+        end do
+
+
+        ! ---  advance over sub_steps
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           !
+           ! Note: Scalars in new time level shouldn't be overwritten, since their provisional values 
+           !    from the previous RK step are needed to compute new scalar tendencies in advance_scalars. 
+           !    A cleaner way of preserving scalars should be added in future.
+           !
+           block % mesh % scalars_old % array(:,:,:) = block % state % time_levs(2) % state % scalars % array(:,:,:)
+           call mpas_copy_state( block % state % time_levs(2) % state, block % state % time_levs(1) % state )
+           block % state % time_levs(2) % state % scalars % array(:,:,:) = block % mesh % scalars_old % array(:,:,:)
+           block =&gt; block % next
+        end do
+
+        if(debug) write(0,*) ' returned from copy_state '
+
+        do small_step = 1, number_sub_steps(rk_step)
+
+           if(debug) write(0,*) ' small step ',small_step
+      
+           block =&gt; domain % blocklist
+           do while (associated(block))
+              call atmh_advance_dynamics( block % tend, block % state % time_levs(2) % state,  &amp;
+                                     block % mesh,                                                           &amp;
+                                     small_step, number_sub_steps(rk_step), rk_sub_timestep(rk_step) )
+              block =&gt; block % next
+           end do
+
+          if(debug) write(0,*) ' dynamics advance complete '
+  
+           !  will need communications here?
+           !
+           ! ---  update halos for prognostic variables
+           !
+           block =&gt; domain % blocklist
+           do while (associated(block))
+!!              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % u % array(:,:), &amp;
+!!                                               block % mesh % nVertLevels, block % mesh % nEdges, &amp;
+!!                                               block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % h_edge % array(:,:), &amp;
+                                               block % mesh % nVertLevels, block % mesh % nEdges, &amp;
+                                               block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+!!              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % mesh % uhAvg % array(:,:), &amp;
+!!                                               block % mesh % nVertLevels, block % mesh % nEdges, &amp;
+!!                                               block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+!!              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % mesh % wwAvg % array(:,:), &amp;
+!!                                               block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
+!!                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % theta % array(:,:), &amp;
+                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+!!              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % h % array(:,:), &amp;
+!!                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
+!!                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+!!              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % tend % h % array(:,:), &amp;
+!!                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
+!!                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+              call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, block % mesh % dpsdt % array(:), &amp;
+                                               block % mesh % nCells, &amp;
+                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+              call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, block % state % time_levs(2) % state % surface_pressure % array(:), &amp;
+                                               block % mesh % nCells, &amp;
+                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % alpha % array(:,:), &amp;
+                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % ww % array(:,:), &amp;
+                                               block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
+                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % pressure % array(:,:), &amp;
+                                               block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
+                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+!!              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % mesh % pressure_old % array(:,:), &amp;
+!!                                               block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
+!!                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % geopotential % array(:,:), &amp;
+                                               block % mesh % nVertLevels+1, block % mesh % nCells, &amp;
+                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+              block =&gt; block % next
+           end do
+
+        end do
+
+        if(debug) write(0,*) ' advance scalars '
+
+
+        ! ---  advance scalars with time integrated mass fluxes
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           !
+           ! Note: The advance_scalars_mono routine can be used without limiting, and thus, encompasses 
+           !       the functionality of the advance_scalars routine; however, it is noticeably slower, 
+           !       so we keep the advance_scalars routine as well
+           !
+           if (rk_step &lt; 3 .or. (.not. config_monotonic .and. .not. config_positive_definite)) then
+              call atmh_advance_scalars( block % tend,                                                               &amp;
+                                    block % state % time_levs(1) % state, block % state % time_levs(2) % state, &amp;
+                                    block % mesh, rk_timestep(rk_step) )
+           else
+              call atmh_advance_scalars_mono( block % tend,                                                               &amp;
+                                         block % state % time_levs(1) % state, block % state % time_levs(2) % state, &amp;
+                                         block % mesh, rk_timestep(rk_step), rk_step, 3,                             &amp;
+                                         domain % dminfo, block % parinfo % cellsToSend, block % parinfo % cellsToRecv )
+           end if
+           block =&gt; block % next
+        end do
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           call mpas_dmpar_exch_halo_field3d_real(domain % dminfo, block % tend % scalars % array(:,:,:), &amp;
+                                            block % tend % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           call mpas_dmpar_exch_halo_field3d_real(domain % dminfo, block % state % time_levs(2) % state % scalars % array(:,:,:), &amp;
+                                            block % tend % num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           block =&gt; block % next
+        end do
+
+        
+        if(debug) write(0,*) ' advance scalars complete '
+
+        ! --- compute some diagnostic quantities for the next timestep
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           call atmh_compute_solver_constants( block % state % time_levs(2) % state, block % mesh )
+           call atmh_compute_state_diagnostics( block % state % time_levs(2) % state, block % mesh )
+           call atmh_compute_solve_diagnostics( dt, block % state % time_levs(2) % state, block % mesh )
+           block =&gt; block % next
+        end do
+
+        if(debug) write(0,*) ' diagnostics complete '
+      
+
+        !  might need communications here *****************************
+
+      end do
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+      ! END RK loop 
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      !
+      ! Compute full velocity vectors at cell centers, and compute vertical velocity diagnostic
+      !
+      block =&gt; domain % blocklist
+      do while (associated(block))
+         call mpas_reconstruct(block % mesh, block % state % time_levs(2) % state % u % array, &amp;
+                          block % diag % uReconstructX % array,                           &amp;
+                          block % diag % uReconstructY % array,                           &amp;
+                          block % diag % uReconstructZ % array,                           &amp;
+                          block % diag % uReconstructZonal % array,                       &amp;
+                          block % diag % uReconstructMeridional % array                   &amp;
+                         )
+
+         call atmh_compute_w(block % state % time_levs(2) % state, block % state % time_levs(1) % state, block % mesh, dt)
+         block =&gt; block % next
+      end do
+
+      if(debug) write(0,*) ' rk step complete - mass diagnostics '
+
+      if(debug .or. debug_mass_conservation) then
+         domain_mass = 0.
+         scalar_mass = 0.
+         block =&gt; domain % blocklist
+         scalar_min = block % state % time_levs(2) % state % scalars % array (2,1,1)
+         scalar_max = block % state % time_levs(2) % state % scalars % array (2,1,1)
+         do while(associated(block))
+           do iCell = 1, block % mesh % nCellsSolve
+             domain_mass = domain_mass + block % state % time_levs(2) % state % surface_pressure % array (iCell) * &amp;
+                                         block % mesh % areaCell % array (iCell) &amp;
+                                       - block % state % time_levs(2) % state % pressure % array (block % mesh % nVertLevels + 1, 1) * &amp;
+                                         block % mesh % areaCell % array (iCell)
+             do k=1, block % mesh % nVertLevelsSolve
+               scalar_mass = scalar_mass - block % state % time_levs(2) % state % scalars % array (2,k,iCell) * &amp;
+                                           block % state % time_levs(2) % state % h % array (k,iCell) * &amp;
+                                           block % mesh % dnw % array (k) * &amp;
+                                           block % mesh % areaCell % array (iCell)
+               scalar_min = min(scalar_min,block % state % time_levs(2) % state % scalars % array (2,k,iCell))
+               scalar_max = max(scalar_max,block % state % time_levs(2) % state % scalars % array (2,k,iCell))
+             end do
+           end do
+           block =&gt; block % next
+         end do
+         call mpas_dmpar_sum_real(domain % dminfo, domain_mass, global_domain_mass)
+         call mpas_dmpar_sum_real(domain % dminfo, scalar_mass, global_scalar_mass)
+         call mpas_dmpar_min_real(domain % dminfo, scalar_min, global_scalar_min)
+         call mpas_dmpar_max_real(domain % dminfo, scalar_max, global_scalar_max)
+         write(0,*) ' mass in the domain = ',global_domain_mass
+         write(0,*) ' scalar mass in the domain = ',global_scalar_mass
+         write(0,*) ' scalar_min, scalar_max ',global_scalar_min, global_scalar_max
+      end if
+
+
+   end subroutine atmh_srk3
+
+!------------------------------------------------------------------------------------------------------------------
+
+   subroutine atmh_compute_solver_constants(s, grid)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Compute height and normal wind tendencies, as well as diagnostic variables
+   !
+   ! Input: s - current model state
+   !        grid - grid metadata
+   !
+   ! Output: tend - computed diagnostics (parallel velocities, v; mass fluxes, vh; 
+   !                circulation; vorticity; and kinetic energy, ke) and the 
+   !                tendencies for height (h) and u (u)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      implicit none
+
+      type (state_type), intent(in) :: s
+      type (mesh_type), intent(inout) :: grid
+
+      integer :: iEdge, iCell, k, cell1, cell2, iq
+
+      integer :: nCells, nEdges, nVertLevels
+
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nVertLevels = grid % nVertLevels
+
+      grid % qtot % array = 0.
+      grid % cqu % array = 1.
+
+      if (s % num_scalars &gt; 0) then
+
+        do iCell = 1, nCells
+          do k = 1, nVertLevels
+            do iq = s % moist_start, s % moist_end
+              grid % qtot % array(k,iCell) = grid % qtot % array(k,iCell) + s % scalars % array (iq, k, iCell)
+            end do
+          end do
+        end do
+
+        do iEdge = 1, nEdges
+          do k = 1, nVertLevels
+            cell1 = grid % cellsOnEdge % array(1,iEdge)
+            cell2 = grid % cellsOnEdge % array(2,iEdge)
+            grid % cqu % array(k,iEdge) = 1./( 1. + 0.5*(grid % qtot % array(k,cell1)+grid % qtot % array(k,cell2)) )
+          end do
+        end do
+
+      end if
+
+      end subroutine atmh_compute_solver_constants
+
+!------------------------------------------------------------------------------------------------------------------
+
+   subroutine atmh_compute_state_diagnostics(s, grid)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Compute diagnostic variables
+   !
+   ! Input: s - current model state
+   !        grid - grid metadata
+   !
+   ! Output: tend - computed diagnostics (parallel velocities, v; mass fluxes, vh; 
+   !                circulation; vorticity; and kinetic energy, ke) and the 
+   !                tendencies for height (h) and u (u)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      implicit none
+
+      type (state_type), intent(inout) :: s
+      type (mesh_type), intent(inout) :: grid
+
+      real (kind=RKIND), dimension(:,:,:), pointer :: scalar
+      real (kind=RKIND), dimension(:,:), pointer :: h, pressure, qtot, alpha, geopotential, theta
+      real (kind=RKIND), dimension(:,:), pointer :: theta_old, ww_old, u_old, u, ww, h_edge_old, h_edge, h_old
+      real (kind=RKIND), dimension(:), pointer :: surface_pressure, dbn, dnu, dnw
+
+      integer :: iEdge, iCell, k, cell1, cell2, iq
+      integer :: nCells, nEdges, nVertLevels
+
+      real (kind=RKIND) :: p0,tm,ptop,ptmp
+
+      h                =&gt; s % h % array
+      theta            =&gt; s % theta % array
+      pressure         =&gt; s % pressure % array
+      qtot             =&gt; grid % qtot % array
+      surface_pressure =&gt; s % surface_pressure % array
+      alpha            =&gt; s % alpha % array
+      geopotential     =&gt; s % geopotential % array
+      scalar           =&gt; s % scalars % array
+      theta_old        =&gt; grid % theta_old % array
+      u_old            =&gt; grid % u_old % array
+      ww_old           =&gt; grid % ww_old % array
+      h_old            =&gt; grid % h_old % array
+      h_edge_old       =&gt; grid % h_edge_old % array
+      h_edge           =&gt; s % h_edge % array
+      u                =&gt; s % u % array
+      ww               =&gt; s % ww % array
+
+      dbn              =&gt; grid % dbn % array
+      dnu              =&gt; grid % dnu % array
+      dnw              =&gt; grid % dnw % array
+
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nVertLevels = grid % nVertLevels
+
+
+
+!      ptop        = grid % ptop
+!      p0          = grid % p0
+!       ptop = 219.4067
+       p0 = 1e+05
+       ptop = pressure(nVertLevels+1,1)
+
+!       write(0,*) ' ptop in compute_state_diagnostics ',ptop
+
+!*****************************
+
+      do iCell = 1, nCells
+        do k=1,nVertLevels
+          h(k,iCell) = (1.-dbn(k))*(p0-ptop)+dbn(k)*(surface_pressure(iCell)-ptop)
+        end do
+
+        do k = nVertLevels, 1, -1
+          pressure(k,iCell) = pressure(k+1,iCell) - dnw(k)*(1.+qtot(k,iCell))*h(k,iCell)
+        end do
+
+        do k=1, nVertLevels
+          ! note that theta is not coupled here
+          tm = (1.+1.61*scalar(1,k,iCell))*theta(k,iCell)  !  assume scalar(1) is qv here?
+          alpha(k,iCell) = (rgas/p0)*tm*(0.5*(pressure(k+1,iCell)+pressure(k,iCell))/p0)**cvpm
+          geopotential(k+1,iCell) = geopotential(k,iCell) - dnw(k)*h(k,iCell)*alpha(k,iCell)
+        end do
+      end do
+
+      theta_old(:,:) = theta(:,:)
+      ww_old(:,:) = ww(:,:)
+      u_old(:,:) = u(:,:)
+      h_edge_old(:,:) = h_edge(:,:)
+      h_old(:,:) = h(:,:)
+
+      end subroutine atmh_compute_state_diagnostics
+
+!------------------------------------------------------------------------------------------
+
+   subroutine atmh_compute_dyn_tend(tend, s, grid)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Compute height and normal wind tendencies, as well as diagnostic variables
+   !
+   ! Input: s - current model state
+   !        grid - grid metadata
+   !
+   ! Output: tend - computed diagnostics (parallel velocities, v; mass fluxes, vh; 
+   !                circulation; vorticity; and kinetic energy, ke) and the 
+   !                tendencies for height (h) and u (u)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      implicit none
+
+      type (tend_type), intent(inout) :: tend
+      type (state_type), intent(in) :: s
+      type (mesh_type), intent(in) :: grid
+
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
+      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, upstream_bias
+
+      integer :: nCells, nEdges, nVertices, nVertLevels
+      real (kind=RKIND) :: h_mom_eddy_visc2,   v_mom_eddy_visc2,   h_mom_eddy_visc4
+      real (kind=RKIND) :: h_theta_eddy_visc2, v_theta_eddy_visc2, h_theta_eddy_visc4
+      real (kind=RKIND) :: u_diffusion
+      real (kind=RKIND), dimension(:), pointer :: h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, p_s
+      real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, tend_h, tend_u, &amp;
+                                                    circulation, divergence, vorticity, ke, pv_edge, geopotential, theta, ww, &amp;
+                                                    h_diabatic, tend_theta
+      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
+      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
+
+      real (kind=RKIND), dimension( grid % nVertLevels + 1 ) :: wdtn, wdun
+      real (kind=RKIND) :: theta_edge, theta_turb_flux, z1, z2, z3, z4, zm, z0, zp, r
+      real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2
+
+      real (kind=RKIND), dimension(:), pointer :: rdnu, rdnw, fnm, fnp
+
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_theta, delsq_divergence
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
+
+      h            =&gt; s % h % array
+      u            =&gt; s % u % array
+      h_edge       =&gt; s % h_edge % array
+      circulation  =&gt; s % circulation % array
+      divergence   =&gt; s % divergence % array
+      vorticity    =&gt; s % vorticity % array
+      ke           =&gt; s % ke % array
+      pv_edge      =&gt; s % pv_edge % array
+      geopotential =&gt; s % geopotential % array
+      theta        =&gt; s % theta % array
+
+      weightsOnEdge     =&gt; grid % weightsOnEdge % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array  
+      verticesOnEdge    =&gt; grid % verticesOnEdge % array
+      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
+      edgesOnEdge       =&gt; grid % edgesOnEdge % array
+      dcEdge            =&gt; grid % dcEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      areaCell          =&gt; grid % areaCell % array
+      areaTriangle      =&gt; grid % areaTriangle % array
+      fEdge             =&gt; grid % fEdge % array
+      deriv_two         =&gt; grid % deriv_two % array
+
+      vh          =&gt; tend % vh % array
+      tend_u      =&gt; tend % u % array
+      tend_theta  =&gt; tend % theta % array
+      h_diabatic  =&gt; grid % h_diabatic % array
+
+      ww          =&gt; s % ww % array
+      rdnu        =&gt; grid % rdnu % array
+      rdnw        =&gt; grid % rdnw % array
+      fnm         =&gt; grid % fnm % array
+      fnp         =&gt; grid % fnp % array
+                  
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nVertLevels = grid % nVertLevels
+      nVertices   = grid % nVertices
+
+      h_mom_eddy_visc2 = config_h_mom_eddy_visc2
+      h_mom_eddy_visc4 = config_h_mom_eddy_visc4
+      v_mom_eddy_visc2 = config_v_mom_eddy_visc2
+      h_theta_eddy_visc2 = config_h_theta_eddy_visc2
+      h_theta_eddy_visc4 = config_h_theta_eddy_visc4
+      v_theta_eddy_visc2 = config_v_theta_eddy_visc2
+
+
+      !
+      ! Compute u (normal) velocity tendency for each edge (cell face)
+      !
+
+      tend_u(:,:) = 0.0
+
+#ifdef LANL_FORMULATION
+      do iEdge=1,grid % nEdgesSolve
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+
+         do k=1,nVertLevels
+            q = 0.0
+            do j = 1,nEdgesOnEdge(iEdge)
+               eoe = edgesOnEdge(j,iEdge)
+               workpv = 0.5 * (pv_edge(k,iEdge) + pv_edge(k,eoe))
+               q = q + weightsOnEdge(j,iEdge) * u(k,eoe) * workpv * h_edge(k,eoe) 
+            end do
+            tend_u(k,iEdge) = q - (ke(k,cell2) - ke(k,cell1)) / dcEdge(iEdge)
+         end do
+      end do
+
+#endif
+
+#ifdef NCAR_FORMULATION
+      !
+      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
+      !
+      vh(:,:) = 0.0
+      do iEdge=1,grid % nEdgesSolve
+         do j=1,nEdgesOnEdge(iEdge)
+            eoe = edgesOnEdge(j,iEdge)
+            do k=1,nVertLevels
+               vh(k,iEdge) = vh(k,iEdge) + weightsOnEdge(j,iEdge) * u(k,eoe) * h_edge(k,eoe)
+            end do
+         end do
+      end do
+
+      do iEdge=1,grid % nEdgesSolve
+         vertex1 = verticesOnEdge(1,iEdge)
+         vertex2 = verticesOnEdge(2,iEdge)
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+
+         do k=1,nVertLevels
+            vorticity_abs = fEdge(iEdge) + (circulation(k,vertex1) + circulation(k,vertex2)) / &amp;
+                                           (areaTriangle(vertex1) + areaTriangle(vertex2))
+
+            workpv = 2.0 * vorticity_abs / (h(k,cell1) + h(k,cell2))
+
+            tend_u(k,iEdge) = workpv * vh(k,iEdge) - (ke(k,cell2) - ke(k,cell1)) / dcEdge(iEdge)
+         end do
+      end do
+#endif
+
+
+      !
+      !  horizontal mixing for u
+      !
+      if ( h_mom_eddy_visc2 &gt; 0.0 ) then
+         do iEdge=1,grid % nEdgesSolve
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            vertex1 = verticesOnEdge(1,iEdge)
+            vertex2 = verticesOnEdge(2,iEdge)
+
+            do k=1,nVertLevels
+
+               !
+               ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="blue">abla vorticity
+               !                    only valid for h_mom_eddy_visc2 == constant
+               !
+               u_diffusion =   ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
+                              -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
+               u_diffusion = h_mom_eddy_visc2 * u_diffusion

+               tend_u(k,iEdge) = tend_u(k,iEdge) + u_diffusion
+            end do
+         end do
+      end if
+
+      if ( h_mom_eddy_visc4 &gt; 0.0 ) then
+
+         allocate(delsq_divergence(nVertLevels, nCells+1))
+         allocate(delsq_u(nVertLevels, nEdges+1))
+         allocate(delsq_circulation(nVertLevels, nVertices+1))
+         allocate(delsq_vorticity(nVertLevels, nVertices+1))
+
+         delsq_u(:,:) = 0.0
+
+         do iEdge=1,grid % nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            vertex1 = verticesOnEdge(1,iEdge)
+            vertex2 = verticesOnEdge(2,iEdge)
+
+            do k=1,nVertLevels
+   
+               !
+               ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="blue">abla vorticity
+               !                    only valid for h_mom_eddy_visc4 == constant
+               !
+               u_diffusion =   ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
+                              -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)

+               delsq_u(k,iEdge) = delsq_u(k,iEdge) + u_diffusion
+            end do
+         end do
+
+         delsq_circulation(:,:) = 0.0
+         do iEdge=1,nEdges
+            do k=1,nVertLevels
+               delsq_circulation(k,verticesOnEdge(1,iEdge)) = delsq_circulation(k,verticesOnEdge(1,iEdge)) - dcEdge(iEdge) * delsq_u(k,iEdge)
+               delsq_circulation(k,verticesOnEdge(2,iEdge)) = delsq_circulation(k,verticesOnEdge(2,iEdge)) + dcEdge(iEdge) * delsq_u(k,iEdge)
+            end do
+         end do
+         do iVertex=1,nVertices
+            r = 1.0 / areaTriangle(iVertex)
+            do k=1,nVertLevels
+               delsq_vorticity(k,iVertex) = delsq_circulation(k,iVertex) * r
+            end do
+         end do
+
+         delsq_divergence(:,:) = 0.0
+         do iEdge=1,nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            do k=1,nVertLevels
+              delsq_divergence(k,cell1) = delsq_divergence(k,cell1) + delsq_u(k,iEdge)*dvEdge(iEdge)
+              delsq_divergence(k,cell2) = delsq_divergence(k,cell2) - delsq_u(k,iEdge)*dvEdge(iEdge)
+            end do
+         end do
+         do iCell = 1,nCells
+            r = 1.0 / areaCell(iCell)
+            do k = 1,nVertLevels
+               delsq_divergence(k,iCell) = delsq_divergence(k,iCell) * r
+            end do
+         end do
+
+         do iEdge=1,grid % nEdgesSolve
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            vertex1 = verticesOnEdge(1,iEdge)
+            vertex2 = verticesOnEdge(2,iEdge)
+
+            do k=1,nVertLevels
+
+               !
+               ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="gray">abla vorticity
+               !                    only valid for h_mom_eddy_visc4 == constant
+               !
+               u_diffusion =   ( delsq_divergence(k,cell2)  - delsq_divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
+                              -( delsq_vorticity(k,vertex2) - delsq_vorticity(k,vertex1) ) / dvEdge(iEdge)

+               tend_u(k,iEdge) = tend_u(k,iEdge) - h_mom_eddy_visc4 * u_diffusion
+            end do
+         end do
+
+         deallocate(delsq_divergence)
+         deallocate(delsq_u)
+         deallocate(delsq_circulation)
+         deallocate(delsq_vorticity)
+
+      end if
+
+
+      !
+      !  vertical advection for u
+      !
+      do iEdge=1,grid % nEdgesSolve
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+
+         wdun(1) = 0.
+         do k=2,nVertLevels
+            wdun(k) =                                                                                  &amp;
+                     (ww(k,cell1)/(h(k,cell1)+h(k-1,cell1)) +ww(k,cell2)/(h(k,cell2)+h(k-1,cell2)))*   &amp;
+                      rdnu(k)*(u(k,iEdge)-u(k-1,iEdge))
+         end do
+         wdun(nVertLevels+1) = 0.
+
+         do k=1,nVertLevels
+            tend_u(k,iEdge) = tend_u(k,iEdge) - 0.5*(wdun(k+1)+wdun(k))
+         end do
+      end do
+
+
+      !
+      !  vertical mixing for u - 2nd order 
+      !
+      if ( v_mom_eddy_visc2 &gt; 0.0 ) then
+
+         do iEdge=1,grid % nEdgesSolve
+   
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+    
+            do k=2,nVertLevels-1
+    
+               z1 = 0.5*(geopotential(k-1,cell1)+geopotential(k-1,cell2))/gravity
+               z2 = 0.5*(geopotential(k  ,cell1)+geopotential(k  ,cell2))/gravity
+               z3 = 0.5*(geopotential(k+1,cell1)+geopotential(k+1,cell2))/gravity
+               z4 = 0.5*(geopotential(k+2,cell1)+geopotential(k+2,cell2))/gravity
+     
+               zm = 0.5*(z1+z2)
+               z0 = 0.5*(z2+z3)
+               zp = 0.5*(z3+z4)
+     
+               tend_u(k,iEdge) = tend_u(k,iEdge) + v_mom_eddy_visc2*(                 &amp;
+                                  (u(k+1,iEdge)-u(k  ,iEdge))/(zp-z0)                 &amp;
+                                 -(u(k  ,iEdge)-u(k-1,iEdge))/(z0-zm) )/(0.5*(zp-zm))
+            end do
+         end do
+
+      end if
+
+
+!----------- rhs for theta
+
+      tend_theta(:,:) = 0.
+
+
+      !
+      !  horizontal mixing for theta - we could combine this with advection directly (i.e. as a turbulent flux),
+      !  but here we can also code in hyperdiffusion if we wish (2nd order at present)
+      !
+      if ( h_theta_eddy_visc2 &gt; 0.0 ) then
+
+         do iEdge=1,grid % nEdges
+            cell1 = grid % cellsOnEdge % array(1,iEdge)
+            cell2 = grid % cellsOnEdge % array(2,iEdge)
+
+            do k=1,grid % nVertLevels
+               theta_turb_flux = h_theta_eddy_visc2*prandtl*(theta(k,cell2) - theta(k,cell1))/dcEdge(iEdge)
+               flux = dvEdge (iEdge) * h_edge(k,iEdge) * theta_turb_flux
+               tend_theta(k,cell1) = tend_theta(k,cell1) + flux
+               tend_theta(k,cell2) = tend_theta(k,cell2) - flux
+            end do 
+
+         end do 
+
+      end if 
+
+      if ( h_theta_eddy_visc4 &gt; 0.0 ) then
+
+         allocate(delsq_theta(nVertLevels, nCells+1))
+
+         delsq_theta(:,:) = 0.
+
+         do iEdge=1,grid % nEdges
+            cell1 = grid % cellsOnEdge % array(1,iEdge)
+            cell2 = grid % cellsOnEdge % array(2,iEdge)
+
+            do k=1,grid % nVertLevels
+               delsq_theta(k,cell1) = delsq_theta(k,cell1) + dvEdge(iEdge)*h_edge(k,iEdge)*(theta(k,cell2) - theta(k,cell1))/dcEdge(iEdge)
+               delsq_theta(k,cell2) = delsq_theta(k,cell2) - dvEdge(iEdge)*h_edge(k,iEdge)*(theta(k,cell2) - theta(k,cell1))/dcEdge(iEdge)
+            end do 
+
+         end do 
+
+         do iCell = 1, nCells
+            r = 1.0 / areaCell(iCell)
+            do k=1,nVertLevels
+               delsq_theta(k,iCell) = delsq_theta(k,iCell) * r
+            end do
+         end do
+
+         do iEdge=1,grid % nEdges
+            cell1 = grid % cellsOnEdge % array(1,iEdge)
+            cell2 = grid % cellsOnEdge % array(2,iEdge)
+
+            do k=1,grid % nVertLevels
+               theta_turb_flux = h_theta_eddy_visc4*prandtl*(delsq_theta(k,cell2) - delsq_theta(k,cell1))/dcEdge(iEdge)
+               flux = dvEdge (iEdge) * theta_turb_flux
+
+               tend_theta(k,cell1) = tend_theta(k,cell1) - flux
+               tend_theta(k,cell2) = tend_theta(k,cell2) + flux
+            end do 
+
+         end do 
+
+         deallocate(delsq_theta)
+
+      end if 
+
+
+      !
+      !  horizontal advection for theta
+      !
+
+      if (config_theta_adv_order == 2) then
+
+         do iEdge=1,nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            do k=1,grid % nVertLevels
+               flux = dvEdge(iEdge) *  h_edge(k,iEdge) * u(k,iEdge) * (      &amp;
+                                      0.5*(theta(k,cell1) + theta(k,cell2)) )
+               tend_theta(k,cell1) = tend_theta(k,cell1) - flux
+               tend_theta(k,cell2) = tend_theta(k,cell2) + flux
+            end do 
+         end do 
+
+      else if (config_theta_adv_order == 3) then
+
+         do iEdge=1,nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+  
+            do k=1,grid % nVertLevels
+   
+               d2fdx2_cell1 = deriv_two(1,1,iEdge) * theta(k,cell1)
+               d2fdx2_cell2 = deriv_two(1,2,iEdge) * theta(k,cell2)
+               do i=1, grid % nEdgesOnCell % array (cell1)
+                  d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * theta(k,grid % CellsOnCell % array (i,cell1))
+               end do
+               do i=1, grid % nEdgesOnCell % array (cell2)
+                  d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * theta(k,grid % CellsOnCell % array (i,cell2))
+               end do

+!  3rd order stencil
+               if( u(k,iEdge) &gt; 0) then
+                  flux = dvEdge(iEdge) *  h_edge(k,iEdge) * u(k,iEdge) * (          &amp;
+                                         0.5*(theta(k,cell1) + theta(k,cell2))      &amp;
+                                         -(dcEdge(iEdge) **2) * (d2fdx2_cell1) / 6. )
+               else
+                  flux = dvEdge(iEdge) *  h_edge(k,iEdge) * u(k,iEdge) * (          &amp;
+                                         0.5*(theta(k,cell1) + theta(k,cell2))      &amp;
+                                         -(dcEdge(iEdge) **2) * (d2fdx2_cell2) / 6. )
+               end if
+   
+               tend_theta(k,cell1) = tend_theta(k,cell1) - flux
+               tend_theta(k,cell2) = tend_theta(k,cell2) + flux

+            end do 
+         end do 
+
+      else  if (config_theta_adv_order == 4) then
+
+         do iEdge=1,nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+
+            do k=1,grid % nVertLevels
+   
+               d2fdx2_cell1 = deriv_two(1,1,iEdge) * theta(k,cell1)
+               d2fdx2_cell2 = deriv_two(1,2,iEdge) * theta(k,cell2)
+               do i=1, grid % nEdgesOnCell % array (cell1)
+                  d2fdx2_cell1 = d2fdx2_cell1 + deriv_two(i+1,1,iEdge) * theta(k,grid % CellsOnCell % array (i,cell1))
+               end do
+               do i=1, grid % nEdgesOnCell % array (cell2)
+                  d2fdx2_cell2 = d2fdx2_cell2 + deriv_two(i+1,2,iEdge) * theta(k,grid % CellsOnCell % array (i,cell2))
+               end do
+   
+               flux = dvEdge(iEdge) *  h_edge(k,iEdge) * u(k,iEdge) * (          &amp;
+                                      0.5*(theta(k,cell1) + theta(k,cell2))      &amp;
+                                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
+  
+               tend_theta(k,cell1) = tend_theta(k,cell1) - flux
+               tend_theta(k,cell2) = tend_theta(k,cell2) + flux
+            end do 

+         end do
+      end if
+
+
+      !
+      !  vertical advection plus diabatic term
+      !  Note: we are also dividing through by the cell area after the horizontal flux divergence
+      !
+      do iCell = 1, nCells
+         wdtn(1) = 0.
+         do k=2,nVertLevels
+            wdtn(k) =  ww(k,icell)*(fnm(k)*theta(k,iCell)+fnp(k)*theta(k-1,iCell))
+         end do
+         wdtn(nVertLevels+1) = 0.
+         do k=1,nVertLevels
+            tend_theta(k,iCell) = tend_theta(k,iCell)/areaCell(iCell) -rdnw(k)*(wdtn(k+1)-wdtn(k))
+!!           tend_theta(k,iCell) = tend_theta(k) + h(k,iCell)*h_diabatic(k,iCell)
+         end do
+      end do
+
+
+      !
+      !  vertical mixing for theta - 2nd order 
+      !
+      if ( v_theta_eddy_visc2 &gt; 0.0 ) then
+
+         do iCell = 1, grid % nCellsSolve
+            do k=2,nVertLevels-1
+               z1 = geopotential(k-1,iCell)/gravity
+               z2 = geopotential(k  ,iCell)/gravity
+               z3 = geopotential(k+1,iCell)/gravity
+               z4 = geopotential(k+2,iCell)/gravity
+     
+               zm = 0.5*(z1+z2)
+               z0 = 0.5*(z2+z3)
+               zp = 0.5*(z3+z4)
+     
+               tend_theta(k,iCell) = tend_theta(k,iCell) + v_theta_eddy_visc2*prandtl*h(k,iCell)*(  &amp;
+                                        (theta(k+1,iCell)-theta(k  ,iCell))/(zp-z0)                 &amp;
+                                       -(theta(k  ,iCell)-theta(k-1,iCell))/(z0-zm) )/(0.5*(zp-zm))
+            end do
+         end do
+
+      end if
+
+   end subroutine atmh_compute_dyn_tend
+
+!---------------------------------------------------------------------------------------------------------
+
+   subroutine atmh_advance_dynamics(tend, s, grid, small_step, number_small_steps, dt)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Advance the dry dynamics a small timestep (forward-backward integration)
+   !
+   ! Input: s - current model state
+   !        tend - large-timestep tendency (d*/dt)
+   !        grid - grid metadata
+   !        dt   - timestep
+   !
+   ! Output: s - model state advanced a timestep dt
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      implicit none
+
+      type (tend_type), intent(in) :: tend
+      type (state_type), intent(inout) :: s
+      type (mesh_type), intent(in) :: grid
+      real (kind=RKIND), intent(in) :: dt
+      integer, intent(in) :: small_step, number_small_steps
+
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
+      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, upstream_bias
+
+      integer :: nEdges, nVertices, nVertLevels
+      real (kind=RKIND), dimension(:), pointer :: h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, dpsdt, &amp;
+                                                  surface_pressure
+      real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, tend_h, tend_u, &amp;
+                                                    circulation, vorticity, ke, pv_edge, geopotential, alpha, theta,       &amp;
+                                                    pressure, pressure_old, tend_theta, uhAvg, wwAvg, ww, u_old,           &amp;
+                                                    theta_old, h_edge_old, qtot, ww_old, cqu, h_old
+      real (kind=RKIND), dimension(:,:,:), pointer :: scalar
+
+!      real (kind=RKIND), pointer :: smext, p0, ptop
+      real (kind=RKIND) :: smext, smdiv, p0, ptop
+      real (kind=RKIND) :: tm, ptmp, he_old
+
+      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
+
+      real (kind=RKIND), dimension( grid % nVertLevels + 1) :: wdtn
+
+      real (kind=RKIND), dimension(:), pointer :: dnw, dbn, rdnw, dnu, fnm, fnp
+      real (kind=RKIND) :: maxpdt,minpdt, maxww, minww
+      integer :: maxpt,minpt
+
+      h            =&gt; s % h % array
+      u            =&gt; s % u % array
+      h_edge       =&gt; s % h_edge % array
+      theta        =&gt; s % theta % array
+
+!      u_old        =&gt; s_old % u % array
+!      h_edge_old   =&gt; s_old % h_edge % array
+!      theta_old    =&gt; s_old % theta % array
+!      ww_old      =&gt; s_old % ww % array
+!      h_old       =&gt; s_old % h % array
+      u_old        =&gt; grid % u_old % array
+      h_edge_old   =&gt; grid % h_edge_old % array
+      theta_old    =&gt; grid % theta_old % array
+      ww_old      =&gt; grid % ww_old % array
+      h_old       =&gt; grid % h_old % array
+
+      geopotential =&gt; s % geopotential % array
+      alpha        =&gt; s % alpha % array
+      surface_pressure     =&gt; s % surface_pressure % array
+      pressure     =&gt; s % pressure % array
+      pressure_old =&gt; grid % pressure_old % array
+
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      dcEdge            =&gt; grid % dcEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      areaCell          =&gt; grid % areaCell % array
+      tend_h      =&gt; tend % h % array
+      tend_u      =&gt; tend % u % array
+      tend_theta      =&gt; tend % theta % array
+                  
+
+      uhAvg       =&gt; grid % uhAvg % array
+      wwAvg       =&gt; grid % wwAvg % array
+      dpsdt       =&gt; grid % dpsdt % array
+      qtot        =&gt; grid % qtot % array
+      cqu         =&gt; grid % cqu % array
+      ww          =&gt; s % ww % array
+      scalar      =&gt; s % scalars % array
+
+      dnw         =&gt; grid % dnw % array
+      dbn         =&gt; grid % dbn % array
+      dnu         =&gt; grid % dnu % array
+      rdnw        =&gt; grid % rdnw % array
+      fnm         =&gt; grid % fnm % array
+      fnp         =&gt; grid % fnp % array
+
+!      p0          =&gt; grid % p0
+!      ptop        =&gt; grid % ptop
+!      smext       =&gt; grid % smext
+
+      nVertLevels = grid % nVertLevels
+      nEdges = grid % nEdges
+
+      p0 = 1.e+05
+      ptop = pressure(nVertLevels+1,1)
+      smext = 0.1
+      smdiv = 0.1
+
+!       write(0,*) ' ptop in advance_dynamics ',ptop
+
+!---  begin computations
+
+!  we assume that the pressure, alpha, geopotential are already properly set
+!  in first small step of a set, couple theta
+
+      if(small_step == 1) then
+
+        do iCell=1,grid % nCells
+           do k=1,nVertLevels
+              theta(k,iCell) = theta(k,iCell)*h(k,iCell)
+           end do
+        end do
+
+        uhAvg = 0.
+        wwAvg = 0.
+        pressure_old(:,:) = pressure(:,:)
+        dpsdt(:) = 0.
+
+      end if
+
+      !
+      !  update horizontal momentum
+      !
+
+      do iEdge=1,grid % nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         do k=1,nVertLevels
+            u(k,iEdge) = u(k,iEdge) + dt*tend_u(k,iEdge)                 &amp;
+                               -(0.5*dt/dcEdge(iEdge))*(                 &amp;
+                 (geopotential(k+1,cell2)-geopotential(k+1,cell1))       &amp;
+                +(geopotential(k  ,cell2)-geopotential(k  ,cell1))       &amp;
+                +cqu(k,iEdge)*(alpha(k,cell2)+alpha(k,cell1))*           &amp;
+                       0.5*(pressure(k+1,cell2)-pressure(k+1,cell1)      &amp;
+                           +pressure(k  ,cell2)-pressure(k  ,cell1)))    &amp;
+                      -smext*dcEdge(iEdge)*(dpsdt(cell2)-dpsdt(cell1))/h_edge(k,iEdge)
+         end do
+      end do
+
+      !
+      !  calculate omega, update theta
+      !
+
+      tend_h = 0.
+      do iEdge=1,nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            do k=1,nVertLevels
+               flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge)
+               tend_h(k,cell1) = tend_h(k,cell1) + flux
+               tend_h(k,cell2) = tend_h(k,cell2) - flux
+            end do 
+            do k=1,nVertLevels
+               uhAvg(k,iEdge) = uhAvg(k,iEdge) + u(k,iEdge) * h_edge(k,iEdge)
+            end do 
+      end do 
+
+      do iCell=1, grid % nCells
+        dpsdt(iCell) = 0.
+        do k=1,nVertLevels
+          dpsdt(iCell) = dpsdt(iCell) + dnw(k)*tend_h(k,iCell)
+        end do
+        dpsdt(iCell) = dpsdt(iCell)/areaCell(iCell)
+
+        surface_pressure(iCell) = surface_pressure(iCell) + dt*dpsdt(iCell)
+
+        do k=1,nVertLevels
+          h(k,iCell) = (1.-dbn(k))*(p0-ptop)+dbn(k)*(surface_pressure(iCell)-ptop)
+        end do
+
+        ! omega calculation
+
+        ww(1,iCell) = 0.
+        do k=2, nVertLevels
+          ww(k,iCell) = ww(k-1,iCell)-dnw(k-1)*(dbn(k-1)*dpsdt(iCell)+tend_h(k-1,iCell)/areaCell(iCell))
+          wwAvg(k,iCell) = wwAvg(k,iCell) + ww(k,iCell)
+        end do
+        ww(nVertLevels+1,iCell) = 0.
+
+        ! theta update  - theta should be coupled at this point...
+
+        wdtn(1) = 0.
+        do k = 2, nVertLevels
+          wdtn(k) = (ww(k,iCell)-ww_old(k,iCell))*(fnm(k)*theta_old(k,iCell)+fnp(k)*theta_old(k-1,iCell))
+        end do
+        wdtn(nVertLevels+1) = 0.
+
+        do k = 1, nVertLevels
+          theta(k,iCell) = theta(k,iCell) + dt*tend_theta(k,iCell)
+          theta(k,iCell) = theta(k,iCell) - dt*rdnw(k)*(wdtn(k+1)-wdtn(k))
+        end do
+      end do
+
+      !
+      ! add in perturbation horizontal flux divergence
+      !
+
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         do k=1,nVertLevels
+            h_edge(k,iEdge) = 0.5*(h(k,cell1)+h(k,cell2))  !  here is update of h_edge
+            he_old = 0.5*(h_old(k,cell1)+h_old(k,cell2))
+            flux = 0.5*(u(k,iEdge) * h_edge(k,iEdge) - u_old(k,iEdge) * he_old)* &amp;
+                        (theta_old(k,cell1)+theta_old(k,cell2))*dvEdge(iEdge)
+            theta(k,cell1) = theta(k,cell1) - dt*flux/areaCell(cell1)
+            theta(k,cell2) = theta(k,cell2) + dt*flux/areaCell(cell2)
+         end do
+      end do
+
+
+      !  compute some diagnostics using the new state
+
+      do iCell = 1, grid % nCells
+
+        do k = nVertLevels,1,-1
+          pressure(k,iCell) = pressure(k+1,iCell) - dnw(k)*(1.+qtot(k,iCell))*h(k,iCell) 
+        end do
+
+        do k=1, nVertLevels
+          tm = (1.+1.61*scalar(1,k,iCell))*theta(k,iCell)/h(k,iCell)  !  assume scalar(1) is qv here?
+          alpha(k,iCell) = (rgas/p0)*tm*  &amp;
+              (0.5*(pressure(k,iCell)+pressure(k+1,iCell))/p0)**cvpm
+          geopotential(k+1,iCell) = geopotential(k,iCell) - dnw(k)*h(k,iCell)*alpha(k,iCell)
+        end do
+
+        if(small_step /= number_small_steps) then
+          do k=1, nVertLevels+1
+            ptmp = pressure(k,iCell)
+            pressure(k,iCell) = pressure(k,iCell) + smdiv*(pressure(k,iCell)-pressure_old(k,iCell))
+            pressure_old(k,iCell) = ptmp
+          end do
+        end if
+
+      end do
+
+!  if last small step of a set, decouple theta
+
+      if(small_step == number_small_steps) then
+        do iCell=1,grid % nCells
+           do k=1,nVertLevels
+              theta(k,iCell) = theta(k,iCell)/h(k,iCell)
+           end do
+        end do
+        uhAvg = uhAvg/real(number_small_steps)
+        wwAvg = wwAvg/real(number_small_steps)
+      end if
+
+   end subroutine atmh_advance_dynamics
+
+
+   subroutine atmh_advance_scalars( tend, s_old, s_new, grid, dt)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   !
+   ! Input: s - current model state
+   !        grid - grid metadata
+   !
+   ! Output: tend - computed scalar tendencies
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      implicit none
+
+      type (tend_type), intent(in) :: tend
+      type (state_type), intent(in) :: s_old
+      type (state_type), intent(inout) :: s_new
+      type (mesh_type), intent(in) :: grid
+      real (kind=RKIND) :: dt
+
+      integer :: i, iCell, iEdge, k, iScalar, cell1, cell2, num_scalars
+      real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2
+
+      real (kind=RKIND), dimension(:,:,:), pointer :: scalar_old, scalar_new, scalar_tend
+      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
+      real (kind=RKIND), dimension(:,:), pointer :: uhAvg, h_old, h_new, wwAvg
+      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
+      integer, dimension(:,:), pointer :: cellsOnEdge
+
+      real (kind=RKIND), dimension( s_old % num_scalars, grid % nVertLevels + 1 ) :: wdtn
+      integer :: nVertLevels
+
+      real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw
+      real (kind=RKIND) :: coef_3rd_order
+
+      num_scalars = s_old % num_scalars
+
+      coef_3rd_order = 0.
+      if (config_scalar_adv_order == 3) coef_3rd_order = 1.0
+      if (config_scalar_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
+
+      scalar_old  =&gt; s_old % scalars % array
+      scalar_new  =&gt; s_new % scalars % array
+      deriv_two   =&gt; grid % deriv_two % array
+      uhAvg       =&gt; grid % uhAvg % array
+      dvEdge      =&gt; grid % dvEdge % array
+      dcEdge      =&gt; grid % dcEdge % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      scalar_tend =&gt; tend % scalars % array
+      h_old       =&gt; s_old % h % array
+      h_new       =&gt; s_new % h % array
+      wwAvg       =&gt; grid % wwAvg % array
+      areaCell    =&gt; grid % areaCell % array
+
+      fnm         =&gt; grid % fnm % array
+      fnp         =&gt; grid % fnp % array
+      rdnw        =&gt; grid % rdnw % array
+
+      nVertLevels = grid % nVertLevels
+
+      scalar_tend = 0.  !  testing purposes - we have no sources or sinks
+
+      !
+      ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts form scalar_old
+      !
+      !
+      !  horizontal flux divergence, accumulate in scalar_tend
+
+      if (config_scalar_adv_order == 2) then
+
+         do iEdge=1,grid%nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            do k=1,grid % nVertLevels
+               do iScalar=1,num_scalars
+                  scalar_edge = 0.5 * (scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))
+                  flux = uhAvg(k,iEdge) * dvEdge(iEdge)  * scalar_edge
+                  scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) - flux/areaCell(cell1)
+                  scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) + flux/areaCell(cell2)
+               end do 
+            end do 
+         end do 
+
+      else if (config_scalar_adv_order == 3) then
+
+         do iEdge=1,grid%nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+  
+            do k=1,grid % nVertLevels
+   
+               do iScalar=1,num_scalars
+                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
+                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
+                  do i=1, grid % nEdgesOnCell % array (cell1)
+                     d2fdx2_cell1 = d2fdx2_cell1 + &amp;
+                                    deriv_two(i+1,1,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell1))
+                  end do
+                  do i=1, grid % nEdgesOnCell % array (cell2)
+                     d2fdx2_cell2 = d2fdx2_cell2 + &amp;
+                                    deriv_two(i+1,2,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell2))
+                  end do
+
+                  if (uhAvg(k,iEdge) &gt; 0) then
+                     flux = dvEdge(iEdge) * uhAvg(k,iEdge) * (          &amp;
+                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
+                                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
+                                             -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
+                  else
+                     flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
+                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
+                                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
+                                             +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
+                  end if
+
+! old version of the above code, with coef_3rd_order assumed to be 1.0
+!                  if (uhAvg(k,iEdge) &gt; 0) then
+!                     flux = dvEdge(iEdge) * uhAvg(k,iEdge) * (          &amp;
+!                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
+!                                            -(dcEdge(iEdge) **2) * (d2fdx2_cell1) / 6. )
+!                  else
+!                     flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
+!                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
+!                                            -(dcEdge(iEdge) **2) * (d2fdx2_cell2) / 6. )
+!                  end if
+   
+                  scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) - flux/areaCell(cell1)
+                  scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) + flux/areaCell(cell2)

+               end do 
+            end do 
+         end do 
+
+      else  if (config_scalar_adv_order == 4) then
+
+         do iEdge=1,grid%nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+
+            do k=1,grid % nVertLevels
+   
+               do iScalar=1,num_scalars
+                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
+                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
+                  do i=1, grid % nEdgesOnCell % array (cell1)
+                        d2fdx2_cell1 = d2fdx2_cell1 + &amp;
+                                       deriv_two(i+1,1,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell1))
+                  end do
+                  do i=1, grid % nEdgesOnCell % array (cell2)
+                     d2fdx2_cell2 = d2fdx2_cell2 + &amp;
+                                    deriv_two(i+1,2,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell2))
+                  end do
+      
+                  flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
+                                         0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
+                                          -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
+     
+                  scalar_tend(iScalar,k,cell1) = scalar_tend(iScalar,k,cell1) - flux/areaCell(cell1)
+                  scalar_tend(iScalar,k,cell2) = scalar_tend(iScalar,k,cell2) + flux/areaCell(cell2)
+               end do 
+            end do 

+         end do
+      end if
+
+
+      !
+      !  vertical flux divergence
+      !
+
+      do iCell=1,grid % nCells
+
+        wdtn(:,1) = 0.
+        do k = 2, nVertLevels
+          do iScalar=1,num_scalars
+            wdtn(iScalar,k) = wwAvg(k,iCell)*(fnm(k)*scalar_new(iScalar,k,iCell)+fnp(k)*scalar_new(iScalar,k-1,iCell))
+          end do
+        end do
+        wdtn(:,nVertLevels+1) = 0.
+
+         do k=1,grid % nVertLevelsSolve
+            do iScalar=1,num_scalars
+              scalar_new(iScalar,k,iCell) = (   scalar_old(iScalar,k,iCell)*h_old(k,iCell) &amp;
+                    + dt*( scalar_tend(iScalar,k,iCell) -rdnw(k)*(wdtn(iScalar,k+1)-wdtn(iScalar,k)) ) )/h_new(k,iCell)
+                                                                                        
+            end do
+         end do
+      end do
+
+   end subroutine atmh_advance_scalars
+
+
+   subroutine atmh_advance_scalars_mono( tend, s_old, s_new, grid, dt, rk_step, rk_order, dminfo, cellsToSend, cellsToRecv)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   !
+   ! Input: s - current model state
+   !        grid - grid metadata
+   !
+   ! Output: tend - computed scalar tendencies
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      implicit none
+
+      type (tend_type), intent(in) :: tend
+      type (state_type), intent(in) :: s_old
+      type (state_type), intent(inout) :: s_new
+      type (mesh_type), intent(in) :: grid
+      integer, intent(in) :: rk_step, rk_order
+      real (kind=RKIND), intent(in) :: dt
+      type (dm_info), intent(in) :: dminfo
+      type (exchange_list), pointer :: cellsToSend, cellsToRecv
+
+      integer :: i, iCell, iEdge, k, iScalar, cell_upwind, cell1, cell2, num_scalars
+      real (kind=RKIND) :: flux, scalar_edge, d2fdx2_cell1, d2fdx2_cell2
+      real (kind=RKIND) :: fdir, flux_upwind, h_flux_upwind, s_upwind
+
+      real (kind=RKIND), dimension(:,:,:), pointer :: scalar_old, scalar_new, scalar_tend
+      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
+      real (kind=RKIND), dimension(:,:), pointer :: uhAvg, h_old, h_new, wwAvg
+      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
+      integer, dimension(:,:), pointer :: cellsOnEdge
+
+      real (kind=RKIND), dimension( s_old % num_scalars, grid % nEdges+1) :: h_flux
+      real (kind=RKIND), dimension( s_old % num_scalars, grid % nCells+1, 2 ) :: v_flux, v_flux_upwind, s_update
+      real (kind=RKIND), dimension( s_old % num_scalars, grid % nCells+1, 2 ) :: scale_out, scale_in
+      real (kind=RKIND), dimension( s_old % num_scalars ) :: s_max, s_min, s_max_update, s_min_update
+
+      integer :: nVertLevels, km0, km1, ktmp, kcp1, kcm1
+
+      real (kind=RKIND), dimension(:), pointer :: fnm, fnp, rdnw
+      real (kind=RKIND), parameter :: eps=1.e-20
+      real (kind=RKIND) :: coef_3rd_order
+
+      num_scalars = s_old % num_scalars
+
+      scalar_old  =&gt; s_old % scalars % array
+      scalar_new  =&gt; s_new % scalars % array
+      deriv_two   =&gt; grid % deriv_two % array
+      uhAvg       =&gt; grid % uhAvg % array
+      dvEdge      =&gt; grid % dvEdge % array
+      dcEdge      =&gt; grid % dcEdge % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      scalar_tend =&gt; tend % scalars % array
+      h_old       =&gt; s_old % h % array
+      h_new       =&gt; s_new % h % array
+      wwAvg       =&gt; grid % wwAvg % array
+      areaCell    =&gt; grid % areaCell % array
+
+      fnm         =&gt; grid % fnm % array
+      fnp         =&gt; grid % fnp % array
+      rdnw        =&gt; grid % rdnw % array
+
+      nVertLevels = grid % nVertLevels
+
+      scalar_tend = 0.  !  testing purposes - we have no sources or sinks
+
+      !
+      ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts from scalar_old
+      !
+
+      km1 = 1
+      km0 = 2
+      v_flux(:,:,km1) = 0.
+      v_flux_upwind(:,:,km1) = 0.
+      scale_out(:,:,:) = 1.
+      scale_in(:,:,:) = 1.
+
+      coef_3rd_order = 0.
+      if (config_scalar_adv_order == 3) coef_3rd_order = 1.0
+      if (config_scalar_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
+
+      do k = 1, grid % nVertLevels
+         kcp1 = min(k+1,grid % nVertLevels)
+         kcm1 = max(k-1,1)
+
+!  vertical flux
+
+         do iCell=1,grid % nCells
+
+            if (k &lt; grid % nVertLevels) then
+               cell_upwind = k
+               if (wwAvg(k+1,iCell) &gt;= 0) cell_upwind = k+1
+               do iScalar=1,num_scalars
+                  v_flux(iScalar,iCell,km0) = dt * wwAvg(k+1,iCell) *   &amp;
+                       (fnm(k+1) * scalar_new(iScalar,k+1,iCell) + fnp(k+1) * scalar_new(iScalar,k,iCell))
+                  v_flux_upwind(iScalar,iCell,km0) = dt * wwAvg(k+1,iCell) * scalar_old(iScalar,cell_upwind,iCell)
+                  v_flux(iScalar,iCell,km0) = v_flux(iScalar,iCell,km0) - v_flux_upwind(iScalar,iCell,km0)
+!                  v_flux(iScalar,iCell,km0) = 0.  ! use only upwind - for testing
+                  s_update(iScalar,iCell,km0) = scalar_old(iScalar,k,iCell) * h_old(k,iCell)  &amp;
+                            - rdnw(k) * (v_flux_upwind(iScalar,iCell,km0) - v_flux_upwind(iScalar,iCell,km1))
+               end do
+            else
+               do iScalar=1,num_scalars
+                  v_flux(iScalar,iCell,km0) = 0.
+                  v_flux_upwind(iScalar,iCell,km0) = 0.
+                  s_update(iScalar,iCell,km0) = scalar_old(iScalar,k,iCell) * h_old(k,iCell)  &amp;
+                            - rdnw(k) * (v_flux_upwind(iScalar,iCell,km0) - v_flux_upwind(iScalar,iCell,km1))
+               end do
+            end if
+
+         end do
+
+! horizontal flux
+
+         if (config_scalar_adv_order == 2) then
+
+            do iEdge=1,grid%nEdges
+               cell1 = cellsOnEdge(1,iEdge)
+               cell2 = cellsOnEdge(2,iEdge)
+               cell_upwind = cell2
+               if (uhAvg(k,iEdge) &gt;= 0) cell_upwind = cell1
+               do iScalar=1,num_scalars
+                  scalar_edge = 0.5 * (scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))
+                  h_flux(iScalar,iEdge) = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_edge
+                  h_flux_upwind = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_old(iScalar,k,cell_upwind)
+                  h_flux(iScalar,iEdge) = h_flux(iScalar,iEdge) - h_flux_upwind
+!                  h_flux(iScalar,iEdge) = 0.  ! use only upwind - for testing
+                  s_update(iScalar,cell1,km0) = s_update(iScalar,cell1,km0) - h_flux_upwind / grid % areaCell % array(cell1)
+                  s_update(iScalar,cell2,km0) = s_update(iScalar,cell2,km0) + h_flux_upwind / grid % areaCell % array(cell2)
+               end do 
+            end do 
+
+         else if (config_scalar_adv_order &gt;= 3) then
+
+            do iEdge=1,grid%nEdges
+               cell1 = cellsOnEdge(1,iEdge)
+               cell2 = cellsOnEdge(2,iEdge)
+               cell_upwind = cell2
+               if (uhAvg(k,iEdge) &gt;= 0) cell_upwind = cell1
+               do iScalar=1,num_scalars
+
+                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * scalar_new(iScalar,k,cell1)
+                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * scalar_new(iScalar,k,cell2)
+                  do i=1, grid % nEdgesOnCell % array (cell1)
+                     d2fdx2_cell1 = d2fdx2_cell1 + &amp;
+                                    deriv_two(i+1,1,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell1))
+                  end do
+                  do i=1, grid % nEdgesOnCell % array (cell2)
+                     d2fdx2_cell2 = d2fdx2_cell2 + &amp;
+                                    deriv_two(i+1,2,iEdge) * scalar_new(iScalar,k,grid % CellsOnCell % array (i,cell2))
+                  end do
+   
+                  if (uhAvg(k,iEdge) &gt; 0) then
+                     flux = dvEdge(iEdge) * uhAvg(k,iEdge) * (          &amp;
+                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
+                                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
+                                             -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
+                  else
+                     flux = dvEdge(iEdge) *  uhAvg(k,iEdge) * (          &amp;
+                                            0.5*(scalar_new(iScalar,k,cell1) + scalar_new(iScalar,k,cell2))      &amp;
+                                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
+                                             +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
+                  end if
+  
+                  h_flux(iScalar,iEdge) = dt * flux
+                  h_flux_upwind = dt * uhAvg(k,iEdge) * dvEdge(iEdge) * scalar_old(iScalar,k,cell_upwind)
+                  h_flux(iScalar,iEdge) = h_flux(iScalar,iEdge) - h_flux_upwind
+!                  h_flux(iScalar,iEdge) = 0.  ! use only upwind - for testing
+                  s_update(iScalar,cell1,km0) = s_update(iScalar,cell1,km0) - h_flux_upwind / grid % areaCell % array(cell1)
+                  s_update(iScalar,cell2,km0) = s_update(iScalar,cell2,km0) + h_flux_upwind / grid % areaCell % array(cell2)
+               end do 
+            end do 
+
+         end if
+
+
+         if ( (rk_step == rk_order) .and. (config_monotonic .or. config_positive_definite) ) then   
+
+!*************************************************************************************************************
+!---  limiter - we limit horizontal and vertical fluxes on level k 
+!---  (these are h fluxes contributing to level k scalars, and v flux contributing to level k, k-1 scalars)
+
+            do iCell=1,grid % nCells
+  
+               do iScalar=1,num_scalars
+   
+                  s_max(iScalar) = max(scalar_old(iScalar,k,iCell), scalar_old(iScalar,kcp1,iCell), scalar_old(iScalar,kcm1,iCell))
+                  s_min(iScalar) = min(scalar_old(iScalar,k,iCell), scalar_old(iScalar,kcp1,iCell), scalar_old(iScalar,kcm1,iCell))
+                  s_max_update(iScalar) = s_update(iScalar,iCell,km0)
+                  s_min_update(iScalar) = s_update(iScalar,iCell,km0)
+    
+                  ! add in vertical flux to get max and min estimate
+                  s_max_update(iScalar) = s_max_update(iScalar)  &amp;
+                     - rdnw(k) * (max(0.,v_flux(iScalar,iCell,km0)) - min(0.,v_flux(iScalar,iCell,km1)))
+                  s_min_update(iScalar) = s_min_update(iScalar)  &amp;
+                     - rdnw(k) * (min(0.,v_flux(iScalar,iCell,km0)) - max(0.,v_flux(iScalar,iCell,km1)))
+    
+               end do
+   
+               do i = 1, grid % nEdgesOnCell % array(iCell)  ! go around the edges of each cell
+                  do iScalar=1,num_scalars
+    
+                     s_max(iScalar)  = max(scalar_old(iScalar,k,grid % cellsOnCell % array(i,iCell)), s_max(iScalar))
+                     s_min(iScalar)  = min(scalar_old(iScalar,k,grid % cellsOnCell % array(i,iCell)), s_min(iScalar))
+     
+                     iEdge = grid % EdgesOnCell % array (i,iCell)
+                     if (iCell == cellsOnEdge(1,iEdge)) then
+                        fdir = 1.0
+                     else
+                        fdir = -1.0
+                     end if
+                     flux = -fdir * h_flux(iScalar,iEdge)/grid % areaCell % array(iCell)
+                     s_max_update(iScalar) = s_max_update(iScalar) + max(0.,flux)
+                     s_min_update(iScalar) = s_min_update(iScalar) + min(0.,flux)
+  
+                  end do
+   
+               end do
+   
+               if( config_positive_definite ) s_min(:) = 0.
+   
+               do iScalar=1,num_scalars
+                  scale_out (iScalar,iCell,km0) = 1.
+                  scale_in (iScalar,iCell,km0) = 1.
+                  s_max_update (iScalar) =  s_max_update (iScalar) / h_new (k,iCell)
+                  s_min_update (iScalar) =  s_min_update (iScalar) / h_new (k,iCell)
+                  s_upwind = s_update(iScalar,iCell,km0) / h_new(k,iCell)
+                  if ( s_max_update(iScalar) &gt; s_max(iScalar) .and. config_monotonic)   &amp;
+                     scale_in (iScalar,iCell,km0) = max(0.,(s_max(iScalar)-s_upwind)/(s_max_update(iScalar)-s_upwind+eps))
+                  if ( s_min_update(iScalar) &lt; s_min(iScalar) )   &amp;
+                     scale_out (iScalar,iCell,km0) = max(0.,(s_upwind-s_min(iScalar))/(s_upwind-s_min_update(iScalar)+eps))
+                end do
+  
+            end do ! end loop over cells to compute scale factor
+
+
+            call mpas_dmpar_exch_halo_field2d_real(dminfo, scale_out(:,:,1), &amp;
+                                             num_scalars, grid % nCells, &amp;
+                                             cellsToSend, cellsToRecv)
+            call mpas_dmpar_exch_halo_field2d_real(dminfo, scale_out(:,:,2), &amp;
+                                             num_scalars, grid % nCells, &amp;
+                                             cellsToSend, cellsToRecv)
+            call mpas_dmpar_exch_halo_field2d_real(dminfo, scale_in(:,:,1), &amp;
+                                             num_scalars, grid % nCells, &amp;
+                                             cellsToSend, cellsToRecv)
+            call mpas_dmpar_exch_halo_field2d_real(dminfo, scale_in(:,:,2), &amp;
+                                             num_scalars, grid % nCells, &amp;
+                                             cellsToSend, cellsToRecv)
+
+       ! rescale the horizontal fluxes

+            do iEdge = 1, grid % nEdges
+               cell1 = grid % cellsOnEdge % array(1,iEdge)
+               cell2 = grid % cellsOnEdge % array(2,iEdge)
+               do iScalar=1,num_scalars
+                  flux = h_flux(iScalar,iEdge)
+                  if (flux &gt; 0) then
+                     flux = flux * min(scale_out(iScalar,cell1,km0), scale_in(iScalar,cell2,km0))
+                  else
+                     flux = flux * min(scale_in(iScalar,cell1,km0), scale_out(iScalar,cell2,km0))
+                  end if
+                  h_flux(iScalar,iEdge) = flux
+               end do
+            end do

+       ! rescale the vertical flux

+            do iCell=1,grid % nCells
+               do iScalar=1,num_scalars
+                  flux =  v_flux(iScalar,iCell,km1)
+                  if (flux &gt; 0) then
+                     flux = flux * min(scale_out(iScalar,iCell,km0), scale_in(iScalar,iCell,km1))
+                  else
+                     flux = flux * min(scale_in(iScalar,iCell,km0), scale_out(iScalar,iCell,km1))
+                  end if
+                  v_flux(iScalar,iCell,km1) = flux
+               end do
+            end do
+
+!  end of limiter
+!*******************************************************************************************************************
+
+         end if
+
+!---  update
+
+         do iCell=1,grid % nCells
+            !  add in upper vertical flux that was just renormalized
+            do iScalar=1,num_scalars
+               s_update(iScalar,iCell,km0) = s_update(iScalar,iCell,km0) + rdnw(k) * v_flux(iScalar,iCell,km1)
+               if (k &gt; 1) s_update(iScalar,iCell,km1) = s_update(iScalar,iCell,km1) - rdnw(k-1)*v_flux(iScalar,iCell,km1)
+            end do
+         end do

+         do iEdge=1,grid%nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            do iScalar=1,num_scalars
+               s_update(iScalar,cell1,km0) = s_update(iScalar,cell1,km0) - &amp;
+                   h_flux(iScalar,iEdge) / grid % areaCell % array(cell1)
+               s_update(iScalar,cell2,km0) = s_update(iScalar,cell2,km0) + &amp;
+                   h_flux(iScalar,iEdge) / grid % areaCell % array(cell2)
+            end do 
+         end do 

+         ! decouple from mass
+         if (k &gt; 1) then
+            do iCell=1,grid % nCells
+               do iScalar=1,num_scalars
+                  s_update(iScalar,iCell,km1) = s_update(iScalar,iCell,km1) / h_new(k-1,iCell)
+               end do
+            end do

+            do iCell=1,grid % nCells
+               do iScalar=1,num_scalars
+                  scalar_new(iScalar,k-1,iCell) = s_update(iScalar,iCell,km1) 
+               end do
+            end do
+         end if

+         ktmp = km1
+         km1 = km0
+         km0 = ktmp
+
+      end do
+
+      do iCell=1,grid % nCells
+         do iScalar=1,num_scalars
+            scalar_new(iScalar,grid % nVertLevels,iCell) = s_update(iScalar,iCell,km1) / h_new(grid%nVertLevels,iCell)
+         end do
+      end do
+
+   end subroutine atmh_advance_scalars_mono
+
+
+   subroutine atmh_compute_solve_diagnostics(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
+
+
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
+      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, r
+
+      integer :: nCells, nEdges, nVertices, nVertLevels
+      real (kind=RKIND), dimension(:), pointer :: h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
+      real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, tend_h, tend_u, &amp;
+                                                    circulation, vorticity, ke, pv_edge, pv_vertex, pv_cell, gradPVn, gradPVt, &amp;
+                                                    divergence
+      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
+
+
+      h           =&gt; s % h % array
+      u           =&gt; s % u % array
+      v           =&gt; s % v % array
+      vh          =&gt; s % vh % array
+      h_edge      =&gt; s % h_edge % array
+      tend_h      =&gt; s % h % array
+      tend_u      =&gt; s % u % array
+      circulation =&gt; s % circulation % array
+      vorticity   =&gt; s % vorticity % array
+      divergence  =&gt; s % divergence % array
+      ke          =&gt; s % ke % array
+      pv_edge     =&gt; s % pv_edge % array
+      pv_vertex   =&gt; s % pv_vertex % array
+      pv_cell     =&gt; s % pv_cell % array
+      gradPVn     =&gt; s % gradPVn % array
+      gradPVt     =&gt; s % gradPVt % array
+
+      weightsOnEdge     =&gt; grid % weightsOnEdge % array
+      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      cellsOnVertex     =&gt; grid % cellsOnVertex % array
+      verticesOnEdge    =&gt; grid % verticesOnEdge % array
+      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
+      edgesOnCell       =&gt; grid % edgesOnCell % array
+      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
+      edgesOnEdge       =&gt; grid % edgesOnEdge % array
+      edgesOnVertex     =&gt; grid % edgesOnVertex % array
+      dcEdge            =&gt; grid % dcEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      areaCell          =&gt; grid % areaCell % array
+      areaTriangle      =&gt; grid % areaTriangle % array
+      h_s               =&gt; grid % h_s % array
+      fVertex           =&gt; grid % fVertex % array
+      fEdge             =&gt; grid % fEdge % array
+                  
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+
+      !
+      ! Compute height on cell edges at velocity locations
+      !
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         do k=1,nVertLevels
+            h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
+         end do
+      end do
+
+      !
+      ! Compute circulation and relative vorticity at each vertex
+      !
+      circulation(:,:) = 0.0
+      do iEdge=1,nEdges
+         do k=1,nVertLevels
+            circulation(k,verticesOnEdge(1,iEdge)) = circulation(k,verticesOnEdge(1,iEdge)) - dcEdge(iEdge) * u(k,iEdge)
+            circulation(k,verticesOnEdge(2,iEdge)) = circulation(k,verticesOnEdge(2,iEdge)) + dcEdge(iEdge) * u(k,iEdge)
+         end do
+      end do
+      do iVertex=1,nVertices
+         do k=1,nVertLevels
+            vorticity(k,iVertex) = circulation(k,iVertex) / areaTriangle(iVertex)
+         end do
+      end do
+
+
+      !
+      ! Compute the divergence at each cell center
+      !
+      divergence(:,:) = 0.0
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         do k=1,nVertLevels
+           divergence(k,cell1) = divergence(k,cell1) + u(k,iEdge)*dvEdge(iEdge)
+           divergence(k,cell2) = divergence(k,cell2) - u(k,iEdge)*dvEdge(iEdge)
+         end do
+      end do
+      do iCell = 1,nCells
+        r = 1.0 / areaCell(iCell)
+        do k = 1,nVertLevels
+           divergence(k,iCell) = divergence(k,iCell) * r
+        end do
+      end do
+
+
+      !
+      ! Compute kinetic energy in each cell
+      !
+      ke(:,:) = 0.0
+      do iCell=1,nCells
+         do i=1,nEdgesOnCell(iCell)
+            iEdge = edgesOnCell(i,iCell)
+            do k=1,nVertLevels
+               ke(k,iCell) = ke(k,iCell) + 0.25 * dcEdge(iEdge) * dvEdge(iEdge) * u(k,iEdge)**2.0
+            end do
+         end do
+         do k=1,nVertLevels
+            ke(k,iCell) = ke(k,iCell) / areaCell(iCell)
+         end do
+      end do
+
+      !
+      ! Compute v (tangential) velocities
+      !
+      v(:,:) = 0.0
+      do iEdge = 1,nEdges
+         do i=1,nEdgesOnEdge(iEdge)
+            eoe = edgesOnEdge(i,iEdge)
+            do k = 1,nVertLevels
+               v(k,iEdge) = v(k,iEdge) + weightsOnEdge(i,iEdge) * u(k, eoe)
+            end do
+         end do
+      end do
+
+
+      ! tdr
+      !
+      ! Compute height at vertices, pv at vertices, and average pv to edge locations
+      !  ( this computes pv_vertex at all vertices bounding real cells )
+      !
+      do iVertex = 1,nVertices
+         do k=1,nVertLevels
+            h_vertex = 0.0
+            do i=1,grid % vertexDegree
+               h_vertex = h_vertex + h(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
+            end do
+            h_vertex = h_vertex / areaTriangle(iVertex)
+
+            pv_vertex(k,iVertex) = (fVertex(iVertex) + vorticity(k,iVertex)) / h_vertex
+         end do
+      end do
+      ! tdr
+
+
+      ! tdr
+      !
+      ! Compute gradient of PV in the tangent direction
+      !   ( this computes gradPVt at all edges bounding real cells )
+      !
+      do iEdge = 1,nEdges
+         do k = 1,nVertLevels
+           gradPVt(k,iEdge) = (pv_vertex(k,verticesOnEdge(2,iEdge)) - pv_vertex(k,verticesOnEdge(1,iEdge))) / &amp;
+                              dvEdge(iEdge)
+         end do
+      end do
+
+      ! tdr
+      !
+      ! Compute pv at the edges
+      !   ( this computes pv_edge at all edges bounding real cells )
+      !
+      pv_edge(:,:) = 0.0
+      do iVertex = 1,nVertices
+        do i=1,grid % vertexDegree
+           iEdge = edgesOnVertex(i,iVertex)
+           do k=1,nVertLevels
+              pv_edge(k,iEdge) =  pv_edge(k,iEdge)  + 0.5 * pv_vertex(k,iVertex)
+           end do
+        end do
+      end do
+      ! tdr
+
+      ! tdr
+      !
+      ! Modify PV edge with upstream bias. 
+      !
+      do iEdge = 1,nEdges
+         do k = 1,nVertLevels
+           pv_edge(k,iEdge) = pv_edge(k,iEdge) - config_apvm_upwinding * v(k,iEdge) * dt * gradPVt(k,iEdge)
+         end do
+      end do
+
+
+      ! tdr
+      !
+      ! Compute pv at cell centers
+      !    ( this computes pv_cell for all real cells )
+      !
+      pv_cell(:,:) = 0.0
+      do iVertex = 1, nVertices
+       do i=1,grid % vertexDegree
+          iCell = cellsOnVertex(i,iVertex)
+          do k = 1,nVertLevels
+             pv_cell(k,iCell) = pv_cell(k,iCell) + kiteAreasOnVertex(i, iVertex) * pv_vertex(k, iVertex) / areaCell(iCell)
+          end do
+       end do
+      end do
+      ! tdr
+
+      ! tdr
+      !
+      ! Compute gradient of PV in normal direction
+      !   (tdr: 2009-10-02: this is not correct because the pv_cell in the halo is not correct)
+      !
+      gradPVn(:,:) = 0.0
+      do iEdge = 1,nEdges
+         do k = 1,nVertLevels
+            gradPVn(k,iEdge) = (pv_cell(k,cellsOnEdge(2,iEdge)) - pv_cell(k,cellsOnEdge(1,iEdge))) / &amp;
+                                 dcEdge(iEdge)
+         end do
+      end do
+      ! tdr
+
+      ! Modify PV edge with upstream bias.
+      !
+     do iEdge = 1,nEdges
+        do k = 1,nVertLevels
+          pv_edge(k,iEdge) = pv_edge(k,iEdge) - config_apvm_upwinding * u(k,iEdge) * dt * gradPVn(k,iEdge)
+        end do
+     end do
+
+
+   end subroutine atmh_compute_solve_diagnostics
+
+
+   subroutine atmh_compute_w (s_new, s_old, grid, dt )
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Compute (diagnose) vertical velocity (used by physics)
+   !
+   ! Input: s_new - current model state
+   !        s_old - previous model state
+   !        grid - grid metadata
+   !        dt - timestep between new and old
+   !
+   ! Output: w  (m/s)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      implicit none
+
+      type (state_type), intent(inout) :: s_new
+      type (state_type), intent(in) :: s_old
+      type (mesh_type), intent(inout) :: grid
+
+      real (kind=RKIND), intent(in) :: dt
+
+      real (kind=RKIND), dimension(:,:), pointer :: geo_new, geo_old, u, ww, h, w
+      real (kind=RKIND), dimension(:), pointer :: dvEdge, rdnw, fnm, fnp
+
+      integer :: iEdge, iCell, k, cell1, cell2
+      real (kind=RKIND), dimension( grid % nVertlevels + 1 ) :: wdwn
+      real (kind=RKIND) :: flux
+
+      geo_new =&gt; s_new % geopotential % array      
+      geo_old =&gt; s_old % geopotential % array      
+      u =&gt; s_new % u % array 
+      ww =&gt; s_new % ww % array
+      h =&gt; s_new % h % array
+      w =&gt; s_new % w % array
+      dvEdge =&gt; grid % dvEdge % array
+      rdnw =&gt; grid % rdnw % array
+      fnm =&gt; grid % fnm % array
+      fnp =&gt; grid % fnp % array
+
+      w = 0.
+
+      do iCell=1, grid % nCellsSolve
+        wdwn(1) = 0.
+        do k=2,grid % nVertlevels + 1
+          wdwn(k) = (0.5*(ww(k,iCell)+ww(k-1,iCell))/h(k-1,iCell))   &amp;
+                     *rdnw(k-1)*(geo_new(k,iCell)-geo_new(k-1,iCell))
+        enddo
+        w(1,iCell) = 0.
+        do k=2, grid % nVertLevels
+          w(k,iCell) = (((geo_new(k,iCell)-geo_old(k,iCell))/dt)+ &amp;
+                          fnm(k)*wdwn(k+1)+fnp(k)*wdwn(k))/gravity
+        enddo
+        k = grid % nVertLevels + 1
+        w(k,iCell) = ((geo_new(k,iCell)-geo_old(k,iCell))/dt)/gravity
+      enddo
+
+      do iEdge=1, grid % nEdges
+        cell1 = grid % cellsOnEdge % array (1,iEdge)
+        cell2 = grid % cellsOnEdge % array (2,iEdge)
+        if (cell1 &lt;= grid % nCellsSolve .or. cell2 &lt;= grid % nCellsSolve ) then
+          do k=2, grid % nVertLevels
+            flux = 0.25*(u(k,iEdge)+u(k-1,iEdge)*(geo_new(k,cell2)-geo_new(k,cell1))) * dvEdge(iEdge) / gravity
+            w(k,cell1) = w(k,cell1) + flux/ grid % AreaCell % array (cell1)
+            w(k,cell2) = w(k,cell2) + flux/ grid % AreaCell % array (cell2)
+          enddo
+          k = 1
+          flux = 0.5*(1.5*u(1,iEdge)-0.5*u(2,iEdge)*(geo_new(k,cell2)-geo_new(k,cell1))) * dvEdge(iEdge) / gravity
+          w(k,cell1) = w(k,cell1) + flux/ grid % AreaCell % array (cell1)
+          w(k,cell2) = w(k,cell2) + flux/ grid % AreaCell % array (cell2)
+
+          k = grid % nVertLevels + 1
+          flux = 0.5*(1.5*u(k-1,iEdge)-0.5*u(k-2,iEdge)*(geo_new(k,cell2)-geo_new(k,cell1))) * dvEdge(iEdge) / gravity
+          w(k,cell1) = w(k,cell1) + flux/ grid % AreaCell % array (cell1)
+          w(k,cell2) = w(k,cell2) + flux/ grid % AreaCell % array (cell2)
+
+        end if
+      end do
+
+   end subroutine atmh_compute_w
+
+end module atmh_time_integration

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_advection.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_advection.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_advection.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,934 +0,0 @@
-module advection
-
-   use grid_types
-   use configure
-   use constants
-
-
-   contains
-
-
-   subroutine initialize_advection_rk( grid )
-                                      
-!
-! compute the cell coefficients for the polynomial fit.
-! this is performed during setup for model integration.
-! WCS, 31 August 2009
-!
-      implicit none
-
-      type (mesh_type), intent(in) :: grid
-
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      integer, dimension(:,:), pointer :: advCells
-
-!  local variables
-
-      real (kind=RKIND), dimension(2, grid % nEdges) :: thetae
-      real (kind=RKIND), dimension(grid % nEdges) :: xe, ye
-      real (kind=RKIND), dimension(grid % nCells) :: theta_abs
-
-      real (kind=RKIND), dimension(25) :: xc, yc, zc ! cell center coordinates
-      real (kind=RKIND), dimension(25) :: thetav, thetat, dl_sphere
-      real (kind=RKIND) :: xm, ym, zm, dl, xec, yec, zec
-      real (kind=RKIND) :: thetae_tmp, xe_tmp, ye_tmp
-      real (kind=RKIND) :: xv1, xv2, yv1, yv2, zv1, zv2
-      integer :: i, j, k, ip1, ip2, m, n, ip1a, ii
-      integer :: iCell, iEdge
-      real (kind=RKIND) :: pii
-      real (kind=RKIND) :: x0, y0, x1, y1, x2, y2, x3, y3, x4, y4, x5, y5
-      real (kind=RKIND) :: pdx1, pdx2, pdx3, pdy1, pdy2, pdy3, dx1, dx2, dy1, dy2
-      real (kind=RKIND) :: angv1, angv2, dl1, dl2
-      real (kind=RKIND), dimension(25) :: dxe, dye, x2v, y2v, xp, yp
-      
-      real (kind=RKIND) :: amatrix(25,25), bmatrix(25,25), wmatrix(25,25)
-      real (kind=RKIND) :: length_scale
-      integer :: ma,na, cell_add, mw, nn
-      integer, dimension(25) :: cell_list
-
-
-      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
-
-      logical, parameter :: reset_poly = .true.
-
-      real (kind=RKIND) :: rcell, cos2t, costsint, sin2t
-      real (kind=RKIND), dimension(grid%maxEdges) :: angle_2d
-
-!---
-
-      pii = 2.*asin(1.0)
-
-      advCells =&gt; grid % advCells % array
-      deriv_two =&gt; grid % deriv_two % array
-      deriv_two(:,:,:) = 0.
-
-      do iCell = 1, grid % nCells !  is this correct? - we need first halo cell also...
-
-         cell_list(1) = iCell
-         do i=2, grid % nEdgesOnCell % array(iCell)+1
-            cell_list(i) = grid % CellsOnCell % array(i-1,iCell)
-         end do
-         n = grid % nEdgesOnCell % array(iCell) + 1
-
-         if ( polynomial_order &gt; 2 ) then
-            do i=2,grid % nEdgesOnCell % array(iCell) + 1
-               do j=1,grid % nEdgesOnCell % array ( cell_list(i) )
-                  cell_add = grid % CellsOnCell % array (j,cell_list(i))
-                  add_the_cell = .true.
-                  do k=1,n
-                     if ( cell_add == cell_list(k) ) add_the_cell = .false.
-                  end do
-                  if (add_the_cell) then
-                     n = n+1
-                     cell_list(n) = cell_add
-                  end if
-               end do
-            end do
-         end if

-         advCells(1,iCell) = n
-
-!  check to see if we are reaching outside the halo
-
-         do_the_cell = .true.
-         do i=1,n
-            if (cell_list(i) &gt; grid % nCells) do_the_cell = .false.
-         end do
-
-
-         if ( .not. do_the_cell ) cycle
-
-
-!  compute poynomial fit for this cell if all needed neighbors exist
-         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
-            end do
-
-            theta_abs(iCell) =  pii/2. - sphere_angle( xc(1), yc(1), zc(1),  &amp;
-                                                       xc(2), yc(2), zc(2),  &amp;
-                                                       0.,    0.,    1.      ) 
-
-! angles from cell center to neighbor centers (thetav)
-
-            do i=1,n-1
-   
-               ip2 = i+2
-               if (ip2 &gt; n) ip2 = 2
-    
-               thetav(i) = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
-                                         xc(i+1), yc(i+1), zc(i+1),  &amp;
-                                         xc(ip2), yc(ip2), zc(ip2)   )
-
-               dl_sphere(i) = a*arc_length( xc(1),   yc(1),   zc(1),  &amp;
-                                            xc(i+1), yc(i+1), zc(i+1) )
-            end do
-
-            length_scale = 1.
-            do i=1,n-1
-               dl_sphere(i) = dl_sphere(i)/length_scale
-            end do
-
-!            thetat(1) = 0.  !  this defines the x direction, cell center 1 -&gt; 
-            thetat(1) = theta_abs(iCell)  !  this defines the x direction, longitude line
-            do i=2,n-1
-               thetat(i) = thetat(i-1) + thetav(i-1)
-            end do
-   
-            do i=1,n-1
-               xp(i) = cos(thetat(i)) * dl_sphere(i)
-               yp(i) = sin(thetat(i)) * dl_sphere(i)
-            end do
-
-         else     ! On an x-y plane
-
-            do i=1,n-1
-
-               angle_2d(i) = grid%angleEdge%array(grid % EdgesOnCell % array(i,iCell))
-               iEdge = grid % EdgesOnCell % array(i,iCell)
-               if ( iCell .ne. grid % CellsOnEdge % array(1,iEdge)) &amp;
-                  angle_2d(i) = angle_2d(i) - pii
-
-!               xp(i) = grid % xCell % array(cell_list(i)) - grid % xCell % array(iCell)
-!               yp(i) = grid % yCell % array(cell_list(i)) - grid % yCell % array(iCell)
-
-               xp(i) = grid % dcEdge % array(grid % EdgesOnCell % array(i,iCell)) * cos(angle_2d(i))
-               yp(i) = grid % dcEdge % array(grid % EdgesOnCell % array(i,iCell)) * sin(angle_2d(i))
-
-            end do
-
-         end if
-
-
-         ma = n-1
-         mw = grid % nEdgesOnCell % array (iCell)
-
-         bmatrix = 0.
-         amatrix = 0.
-         wmatrix = 0.
-
-         if (polynomial_order == 2) then
-            na = 6
-            ma = ma+1
-  
-            amatrix(1,1) = 1.
-            wmatrix(1,1) = 1.
-            do i=2,ma
-               amatrix(i,1) = 1.
-               amatrix(i,2) = xp(i-1)
-               amatrix(i,3) = yp(i-1)
-               amatrix(i,4) = xp(i-1)**2
-               amatrix(i,5) = xp(i-1) * yp(i-1)
-               amatrix(i,6) = yp(i-1)**2
-   
-               wmatrix(i,i) = 1.
-            end do

-         else if (polynomial_order == 3) then
-            na = 10
-            ma = ma+1
-  
-            amatrix(1,1) = 1.
-            wmatrix(1,1) = 1.
-            do i=2,ma
-               amatrix(i,1) = 1.
-               amatrix(i,2) = xp(i-1)
-               amatrix(i,3) = yp(i-1)
-   
-               amatrix(i,4) = xp(i-1)**2
-               amatrix(i,5) = xp(i-1) * yp(i-1)
-               amatrix(i,6) = yp(i-1)**2
-   
-               amatrix(i,7) = xp(i-1)**3
-               amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
-               amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
-               amatrix(i,10) = yp(i-1)**3
-   
-               wmatrix(i,i) = 1.

-            end do
-
-         else
-            na = 15
-            ma = ma+1
-  
-            amatrix(1,1) = 1.
-            wmatrix(1,1) = 1.
-            do i=2,ma
-               amatrix(i,1) = 1.
-               amatrix(i,2) = xp(i-1)
-               amatrix(i,3) = yp(i-1)
-   
-               amatrix(i,4) = xp(i-1)**2
-               amatrix(i,5) = xp(i-1) * yp(i-1)
-               amatrix(i,6) = yp(i-1)**2
-   
-               amatrix(i,7) = xp(i-1)**3
-               amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
-               amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
-               amatrix(i,10) = yp(i-1)**3
-   
-               amatrix(i,11) = xp(i-1)**4
-               amatrix(i,12) = yp(i-1) * (xp(i-1)**3)
-               amatrix(i,13) = (xp(i-1)**2)*(yp(i-1)**2)
-               amatrix(i,14) = xp(i-1) * (yp(i-1)**3)
-               amatrix(i,15) = yp(i-1)**4
-   
-               wmatrix(i,i) = 1.
-  
-            end do

-            do i=1,mw
-               wmatrix(i,i) = 1.
-            end do

-         end if

-         call poly_fit_2( amatrix, bmatrix, wmatrix, ma, na, 25 )
-
-         do i=1,grid % nEdgesOnCell % array (iCell)
-            ip1 = i+1
-            if (ip1 &gt; n-1) ip1 = 1
-  
-            iEdge = grid % EdgesOnCell % array (i,iCell)
-            xv1 = grid % xVertex % array(grid % verticesOnEdge % array (1,iedge))/a
-            yv1 = grid % yVertex % array(grid % verticesOnEdge % array (1,iedge))/a
-            zv1 = grid % zVertex % array(grid % verticesOnEdge % array (1,iedge))/a
-            xv2 = grid % xVertex % array(grid % verticesOnEdge % array (2,iedge))/a
-            yv2 = grid % yVertex % array(grid % verticesOnEdge % array (2,iedge))/a
-            zv2 = grid % zVertex % array(grid % verticesOnEdge % array (2,iedge))/a
-  
-            if ( grid % on_a_sphere ) then
-               call arc_bisect( xv1, yv1, zv1,  &amp;
-                                xv2, yv2, zv2,  &amp;
-                                xec, yec, zec   )
-  
-               thetae_tmp = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
-                                          xc(i+1), yc(i+1), zc(i+1),  &amp;
-                                          xec,     yec,     zec       )
-               thetae_tmp = thetae_tmp + thetat(i)
-               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
-                  thetae(1,grid % EdgesOnCell % array (i,iCell)) = thetae_tmp
-               else
-                  thetae(2,grid % EdgesOnCell % array (i,iCell)) = thetae_tmp
-               end if
-!            else
-!
-!               xe(grid % EdgesOnCell % array (i,iCell)) = 0.5 * (xv1 + xv2)
-!               ye(grid % EdgesOnCell % array (i,iCell)) = 0.5 * (yv1 + yv2)
-
-            end if
-  
-         end do
-
-!  fill second derivative stencil for rk advection 
-
-         do i=1, grid % nEdgesOnCell % array (iCell)
-            iEdge = grid % EdgesOnCell % array (i,iCell)
-  
-  
-            if ( grid % on_a_sphere ) then
-               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
-  
-                  cos2t = cos(thetae(1,grid % EdgesOnCell % array (i,iCell)))
-                  sin2t = sin(thetae(1,grid % EdgesOnCell % array (i,iCell)))
-                  costsint = cos2t*sin2t
-                  cos2t = cos2t**2
-                  sin2t = sin2t**2
-   
-                  do j=1,n
-                     deriv_two(j,1,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
-                                            + 2.*costsint*bmatrix(5,j)  &amp;
-                                            + 2.*sin2t*bmatrix(6,j)
-                  end do
-               else
-     
-                  cos2t = cos(thetae(2,grid % EdgesOnCell % array (i,iCell)))
-                  sin2t = sin(thetae(2,grid % EdgesOnCell % array (i,iCell)))
-                  costsint = cos2t*sin2t
-                  cos2t = cos2t**2
-                  sin2t = sin2t**2
-      
-                  do j=1,n
-                     deriv_two(j,2,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
-                                            + 2.*costsint*bmatrix(5,j)  &amp;
-                                            + 2.*sin2t*bmatrix(6,j)
-                  end do
-               end if
-
-            else
-
-               cos2t = cos(angle_2d(i))
-               sin2t = sin(angle_2d(i))
-               costsint = cos2t*sin2t
-               cos2t = cos2t**2
-               sin2t = sin2t**2
-
-!               do j=1,n
-!
-!                  deriv_two(j,1,iEdge) =   2.*xe(iEdge)*xe(iEdge)*bmatrix(4,j)  &amp;
-!                                         + 2.*xe(iEdge)*ye(iEdge)*bmatrix(5,j)  &amp;
-!                                         + 2.*ye(iEdge)*ye(iEdge)*bmatrix(6,j)
-!               end do
-
-               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
-                  do j=1,n
-                     deriv_two(j,1,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
-                                            + 2.*costsint*bmatrix(5,j)  &amp;
-                                            + 2.*sin2t*bmatrix(6,j)
-                  end do
-               else
-                  do j=1,n
-                     deriv_two(j,2,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
-                                            + 2.*costsint*bmatrix(5,j)  &amp;
-                                            + 2.*sin2t*bmatrix(6,j)
-                  end do
-               end if
-
-            end if
-         end do

-      end do ! end of loop over cells
-
-      if (debug) stop
-
-
-!      write(0,*) ' check for deriv2 coefficients, iEdge 4 '
-!
-!      iEdge = 4
-!      j = 1
-!      iCell = grid % cellsOnEdge % array(1,iEdge)
-!      write(0,*) ' j, icell, coef ',j,iCell,deriv_two(j,1,iEdge)
-!      do j=2,7
-!         write(0,*) ' j, icell, coef ',j,grid % CellsOnCell % array(j-1,iCell),deriv_two(j,1,iEdge)
-!      end do
-!
-!      j = 1
-!      iCell = grid % cellsOnEdge % array(2,iEdge)
-!      write(0,*) ' j, icell, coef ',j,iCell,deriv_two(j,2,iEdge)
-!      do j=2,7
-!         write(0,*) ' j, icell, coef ',j,grid % CellsOnCell % array(j-1,iCell),deriv_two(j,2,iEdge)
-!      end do
-!      stop
-
-   end subroutine initialize_advection_rk
-
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! FUNCTION SPHERE_ANGLE
-   !
-   ! Computes the angle between arcs AB and AC, given points A, B, and C
-   ! Equation numbers w.r.t. http://mathworld.wolfram.com/SphericalTrigonometry.html
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   real function sphere_angle(ax, ay, az, bx, by, bz, cx, cy, cz)
-   
-      implicit none
-   
-      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz, cx, cy, cz
-   
-      real (kind=RKIND) :: a, b, c          ! Side lengths of spherical triangle ABC
-   
-      real (kind=RKIND) :: ABx, ABy, ABz    ! The components of the vector AB
-      real (kind=RKIND) :: mAB              ! The magnitude of AB
-      real (kind=RKIND) :: ACx, ACy, ACz    ! The components of the vector AC
-      real (kind=RKIND) :: mAC              ! The magnitude of AC
-   
-      real (kind=RKIND) :: Dx               ! The i-components of the cross product AB x AC
-      real (kind=RKIND) :: Dy               ! The j-components of the cross product AB x AC
-      real (kind=RKIND) :: Dz               ! The k-components of the cross product AB x AC
-   
-      real (kind=RKIND) :: s                ! Semiperimeter of the triangle
-      real (kind=RKIND) :: sin_angle
-   
-      a = acos(max(min(bx*cx + by*cy + bz*cz,1.0),-1.0))      ! Eqn. (3)
-      b = acos(max(min(ax*cx + ay*cy + az*cz,1.0),-1.0))      ! Eqn. (2)
-      c = acos(max(min(ax*bx + ay*by + az*bz,1.0),-1.0))      ! Eqn. (1)
-   
-      ABx = bx - ax
-      ABy = by - ay
-      ABz = bz - az
-   
-      ACx = cx - ax
-      ACy = cy - ay
-      ACz = cz - az
-   
-      Dx =   (ABy * ACz) - (ABz * ACy)
-      Dy = -((ABx * ACz) - (ABz * ACx))
-      Dz =   (ABx * ACy) - (ABy * ACx)
-   
-      s = 0.5*(a + b + c)
-!      sin_angle = sqrt((sin(s-b)*sin(s-c))/(sin(b)*sin(c)))   ! Eqn. (28)
-      sin_angle = sqrt(min(1.,max(0.,(sin(s-b)*sin(s-c))/(sin(b)*sin(c)))))   ! Eqn. (28)
-   
-      if ((Dx*ax + Dy*ay + Dz*az) &gt;= 0.0) then
-         sphere_angle =  2.0 * asin(max(min(sin_angle,1.0),-1.0))
-      else
-         sphere_angle = -2.0 * asin(max(min(sin_angle,1.0),-1.0))
-      end if
-   
-   end function sphere_angle
-   
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! FUNCTION PLANE_ANGLE
-   !
-   ! Computes the angle between vectors AB and AC, given points A, B, and C, and
-   !   a vector (u,v,w) normal to the plane.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   real function plane_angle(ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w)
-   
-      implicit none
-   
-      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w
-   
-      real (kind=RKIND) :: ABx, ABy, ABz    ! The components of the vector AB
-      real (kind=RKIND) :: mAB              ! The magnitude of AB
-      real (kind=RKIND) :: ACx, ACy, ACz    ! The components of the vector AC
-      real (kind=RKIND) :: mAC              ! The magnitude of AC
-   
-      real (kind=RKIND) :: Dx               ! The i-components of the cross product AB x AC
-      real (kind=RKIND) :: Dy               ! The j-components of the cross product AB x AC
-      real (kind=RKIND) :: Dz               ! The k-components of the cross product AB x AC
-   
-      real (kind=RKIND) :: cos_angle
-   
-      ABx = bx - ax
-      ABy = by - ay
-      ABz = bz - az
-      mAB = sqrt(ABx**2.0 + ABy**2.0 + ABz**2.0)
-   
-      ACx = cx - ax
-      ACy = cy - ay
-      ACz = cz - az
-      mAC = sqrt(ACx**2.0 + ACy**2.0 + ACz**2.0)
-   
-   
-      Dx =   (ABy * ACz) - (ABz * ACy)
-      Dy = -((ABx * ACz) - (ABz * ACx))
-      Dz =   (ABx * ACy) - (ABy * ACx)
-   
-      cos_angle = (ABx*ACx + ABy*ACy + ABz*ACz) / (mAB * mAC)
-   
-      if ((Dx*u + Dy*v + Dz*w) &gt;= 0.0) then
-         plane_angle =  acos(max(min(cos_angle,1.0),-1.0))
-      else
-         plane_angle = -acos(max(min(cos_angle,1.0),-1.0))
-      end if
-   
-   end function plane_angle
-
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! FUNCTION ARC_LENGTH
-   !
-   ! Returns the length of the great circle arc from A=(ax, ay, az) to 
-   !    B=(bx, by, bz). It is assumed that both A and B lie on the surface of the
-   !    same sphere centered at the origin.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   real function arc_length(ax, ay, az, bx, by, bz)
-   
-      implicit none
-   
-      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz
-   
-      real (kind=RKIND) :: r, c
-      real (kind=RKIND) :: cx, cy, cz
-   
-      cx = bx - ax
-      cy = by - ay
-      cz = bz - az
-
-!      r = ax*ax + ay*ay + az*az
-!      c = cx*cx + cy*cy + cz*cz
-!
-!      arc_length = sqrt(r) * acos(1.0 - c/(2.0*r))
-
-      r = sqrt(ax*ax + ay*ay + az*az)
-      c = sqrt(cx*cx + cy*cy + cz*cz)
-!      arc_length = sqrt(r) * 2.0 * asin(c/(2.0*r))
-      arc_length = r * 2.0 * asin(c/(2.0*r))
-
-   end function arc_length
-   
-   
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! SUBROUTINE ARC_BISECT
-   !
-   ! Returns the point C=(cx, cy, cz) that bisects the great circle arc from
-   !   A=(ax, ay, az) to B=(bx, by, bz). It is assumed that A and B lie on the
-   !   surface of a sphere centered at the origin.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   subroutine arc_bisect(ax, ay, az, bx, by, bz, cx, cy, cz)
-   
-      implicit none
-   
-      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz
-      real (kind=RKIND), intent(out) :: cx, cy, cz
-   
-      real (kind=RKIND) :: r           ! Radius of the sphere
-      real (kind=RKIND) :: d           
-   
-      r = sqrt(ax*ax + ay*ay + az*az)
-   
-      cx = 0.5*(ax + bx)
-      cy = 0.5*(ay + by)
-      cz = 0.5*(az + bz)
-   
-      if (cx == 0. .and. cy == 0. .and. cz == 0.) then
-         write(0,*) 'Error: arc_bisect: A and B are diametrically opposite'
-      else
-         d = sqrt(cx*cx + cy*cy + cz*cz)
-         cx = r * cx / d
-         cy = r * cy / d
-         cz = r * cz / d
-      end if
-   
-   end subroutine arc_bisect
-
-
-   subroutine poly_fit_2(a_in,b_out,weights_in,m,n,ne)
-
-      implicit none
-
-      integer, intent(in) :: m,n,ne
-      real (kind=RKIND), dimension(ne,ne), intent(in) :: a_in, weights_in
-      real (kind=RKIND), dimension(ne,ne), intent(out) :: b_out
-   
-      ! local storage
-   
-      real (kind=RKIND), dimension(m,n)  :: a
-      real (kind=RKIND), dimension(n,m)  :: b
-      real (kind=RKIND), dimension(m,m)  :: w,wt,h
-      real (kind=RKIND), dimension(n,m)  :: at, ath
-      real (kind=RKIND), dimension(n,n)  :: ata, ata_inv, atha, atha_inv
-      integer, dimension(n) :: indx
-      integer :: i,j
-   
-      if ( (ne&lt;n) .or. (ne&lt;m) ) then
-         write(6,*) ' error in poly_fit_2 inversion ',m,n,ne
-         stop
-      end if
-   
-!      a(1:m,1:n) = a_in(1:n,1:m) 
-      a(1:m,1:n) = a_in(1:m,1:n)
-      w(1:m,1:m) = weights_in(1:m,1:m) 
-      b_out(:,:) = 0.   
-
-      wt = transpose(w)
-      h = matmul(wt,w)
-      at = transpose(a)
-      ath = matmul(at,h)
-      atha = matmul(ath,a)
-      
-      ata = matmul(at,a)
-
-!      if (m == n) then
-!         call migs(a,n,b,indx)
-!      else
-
-         call migs(atha,n,atha_inv,indx)
-
-         b = matmul(atha_inv,ath)
-
-!         call migs(ata,n,ata_inv,indx)
-!         b = matmul(ata_inv,at)
-!      end if
-      b_out(1:n,1:m) = b(1:n,1:m)
-
-!     do i=1,n
-!        write(6,*) ' i, indx ',i,indx(i)
-!     end do
-!
-!     write(6,*) ' '
-
-   end subroutine poly_fit_2
-
-
-! Updated 10/24/2001.
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!   Program 4.4   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!                                                                       !
-! Please Note:                                                          !
-!                                                                       !
-! (1) This computer program is written by Tao Pang in conjunction with  !
-!     his book, &quot;An Introduction to Computational Physics,&quot; published   !
-!     by Cambridge University Press in 1997.                            !
-!                                                                       !
-! (2) No warranties, express or implied, are made for this program.     !
-!                                                                       !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-SUBROUTINE MIGS (A,N,X,INDX)
-!
-! Subroutine to invert matrix A(N,N) with the inverse stored
-! in X(N,N) in the output.  Copyright (c) Tao Pang 2001.
-!
-  IMPLICIT NONE
-  INTEGER, INTENT (IN) :: N
-  INTEGER :: I,J,K
-  INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
-  REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N):: A
-  REAL (kind=RKIND), INTENT (OUT), DIMENSION (N,N):: X
-  REAL (kind=RKIND), DIMENSION (N,N) :: B
-!
-  DO I = 1, N
-    DO J = 1, N
-      B(I,J) = 0.0
-    END DO
-  END DO
-  DO I = 1, N
-    B(I,I) = 1.0
-  END DO
-!
-  CALL ELGS (A,N,INDX)
-!
-  DO I = 1, N-1
-    DO J = I+1, N
-      DO K = 1, N
-        B(INDX(J),K) = B(INDX(J),K)-A(INDX(J),I)*B(INDX(I),K)
-      END DO
-    END DO
-  END DO
-!
-  DO I = 1, N
-    X(N,I) = B(INDX(N),I)/A(INDX(N),N)
-    DO J = N-1, 1, -1
-      X(J,I) = B(INDX(J),I)
-      DO K = J+1, N
-        X(J,I) = X(J,I)-A(INDX(J),K)*X(K,I)
-      END DO
-      X(J,I) =  X(J,I)/A(INDX(J),J)
-    END DO
-  END DO
-END SUBROUTINE MIGS
-
-
-SUBROUTINE ELGS (A,N,INDX)
-!
-! Subroutine to perform the partial-pivoting Gaussian elimination.
-! A(N,N) is the original matrix in the input and transformed matrix
-! plus the pivoting element ratios below the diagonal in the output.
-! INDX(N) records the pivoting order.  Copyright (c) Tao Pang 2001.
-!
-  IMPLICIT NONE
-  INTEGER, INTENT (IN) :: N
-  INTEGER :: I,J,K,ITMP
-  INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
-  REAL (kind=RKIND) :: C1,PI,PI1,PJ
-  REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
-  REAL (kind=RKIND), DIMENSION (N) :: C
-!
-! Initialize the index
-!
-  DO I = 1, N
-    INDX(I) = I
-  END DO
-!
-! Find the rescaling factors, one from each row
-!
-  DO I = 1, N
-    C1= 0.0
-    DO J = 1, N
-      C1 = MAX(C1,ABS(A(I,J)))
-    END DO
-    C(I) = C1
-  END DO
-!
-! Search the pivoting (largest) element from each column
-!
-  DO J = 1, N-1
-    PI1 = 0.0
-    DO I = J, N
-      PI = ABS(A(INDX(I),J))/C(INDX(I))
-      IF (PI.GT.PI1) THEN
-        PI1 = PI
-        K   = I
-      ENDIF
-    END DO
-!
-! Interchange the rows via INDX(N) to record pivoting order
-!
-    ITMP    = INDX(J)
-    INDX(J) = INDX(K)
-    INDX(K) = ITMP
-    DO I = J+1, N
-      PJ  = A(INDX(I),J)/A(INDX(J),J)
-!
-! Record pivoting ratios below the diagonal
-!
-      A(INDX(I),J) = PJ
-!
-! Modify other elements accordingly
-!
-      DO K = J+1, N
-        A(INDX(I),K) = A(INDX(I),K)-PJ*A(INDX(J),K)
-      END DO
-    END DO
-  END DO
-!
-END SUBROUTINE ELGS
-
-!-------------------------------------------------------------
-
-   subroutine initialize_deformation_weights( grid )
-                                      
-!
-! compute the cell coefficients for the deformation calculations
-! WCS, 13 July 2010
-!
-      implicit none
-
-      type (mesh_type), intent(in) :: grid
-!      type (grid_meta), intent(in) :: grid
-
-      real (kind=RKIND), dimension(:,:), pointer :: defc_a, defc_b
-      integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
-
-!  local variables
-
-      real (kind=RKIND), dimension(2, grid % nEdges) :: thetae
-      real (kind=RKIND), dimension(grid % nEdges) :: xe, ye
-      real (kind=RKIND), dimension(grid % nCells) :: theta_abs
-
-      real (kind=RKIND), dimension(25) :: xc, yc, zc ! cell center coordinates
-      real (kind=RKIND), dimension(25) :: thetav, thetat, dl_sphere
-      real (kind=RKIND) :: xm, ym, zm, dl, xec, yec, zec
-      real (kind=RKIND) :: thetae_tmp, xe_tmp, ye_tmp
-      real (kind=RKIND) :: xv1, xv2, yv1, yv2, zv1, zv2
-      integer :: i, j, k, ip1, ip2, m, n, ip1a, ii
-      integer :: iCell, iEdge
-      real (kind=RKIND) :: pii
-      real (kind=RKIND) :: x0, y0, x1, y1, x2, y2, x3, y3, x4, y4, x5, y5
-      real (kind=RKIND) :: pdx1, pdx2, pdx3, pdy1, pdy2, pdy3, dx1, dx2, dy1, dy2
-      real (kind=RKIND) :: angv1, angv2, dl1, dl2
-      real (kind=RKIND), dimension(25) :: dxe, dye, x2v, y2v, xp, yp, xpt, ypt
-      
-      real (kind=RKIND) :: length_scale
-      integer :: ma,na, cell_add, mw, nn
-      integer, dimension(25) :: cell_list
-
-      integer :: cell1, cell2, iv
-      logical :: do_the_cell
-      real (kind=RKIND) :: area_cell, sint2, cost2, sint_cost, sumw1, sumw2, xptt, area_cellt
-
-      logical, parameter :: debug = .false.
-
-      if (debug) write(0,*) ' in def weight calc '
-
-      defc_a =&gt; grid % defc_a % array
-      defc_b =&gt; grid % defc_b % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      edgesOnCell =&gt; grid % edgesOnCell % array
-
-      defc_a(:,:) = 0.
-      defc_b(:,:) = 0.
-
-      pii = 2.*asin(1.0)
-
-      if (debug) write(0,*) ' beginning cell loop '
-
-      do iCell = 1, grid % nCells
-
-         if (debug) write(0,*) ' cell loop ', iCell
-
-         cell_list(1) = iCell
-         do i=2, grid % nEdgesOnCell % array(iCell)+1
-            cell_list(i) = grid % CellsOnCell % array(i-1,iCell)
-         end do
-         n = grid % nEdgesOnCell % array(iCell) + 1
-
-!  check to see if we are reaching outside the halo
-
-         if (debug) write(0,*) ' points ', n
-
-         do_the_cell = .true.
-         do i=1,n
-            if (cell_list(i) &gt; grid % nCells) do_the_cell = .false.
-         end do
-
-
-         if (.not. do_the_cell) cycle
-
-
-!  compute poynomial fit for this cell if all needed neighbors exist
-         if (grid % on_a_sphere) then
-
-            xc(1) = grid % xCell % array(iCell)/a
-            yc(1) = grid % yCell % array(iCell)/a
-            zc(1) = grid % zCell % array(iCell)/a
-
-
-            do i=2,n
-               iv = grid % verticesOnCell % array(i-1,iCell)
-               xc(i) = grid % xVertex % array(iv)/a
-               yc(i) = grid % yVertex % array(iv)/a
-               zc(i) = grid % zVertex % array(iv)/a
-            end do
-
-            theta_abs(iCell) =  pii/2. - sphere_angle( xc(1), yc(1), zc(1),  &amp;
-                                                       xc(2), yc(2), zc(2),  &amp;
-                                                       0.,    0.,    1.      ) 
-
-! angles from cell center to neighbor centers (thetav)
-
-            do i=1,n-1
-   
-               ip2 = i+2
-               if (ip2 &gt; n) ip2 = 2
-    
-               thetav(i) = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
-                                         xc(i+1), yc(i+1), zc(i+1),  &amp;
-                                         xc(ip2), yc(ip2), zc(ip2)   )
-
-               dl_sphere(i) = a*arc_length( xc(1),   yc(1),   zc(1),  &amp;
-                                            xc(i+1), yc(i+1), zc(i+1) )
-            end do
-
-            length_scale = 1.
-            do i=1,n-1
-               dl_sphere(i) = dl_sphere(i)/length_scale
-            end do
-
-            thetat(1) = 0.  !  this defines the x direction, cell center 1 -&gt; 
-!            thetat(1) = theta_abs(iCell)  !  this defines the x direction, longitude line
-            do i=2,n-1
-               thetat(i) = thetat(i-1) + thetav(i-1)
-            end do
-   
-            do i=1,n-1
-               xp(i) = cos(thetat(i)) * dl_sphere(i)
-               yp(i) = sin(thetat(i)) * dl_sphere(i)
-            end do
-
-         else     ! On an x-y plane
-
-            xp(1) = grid % xCell % array(iCell)
-            yp(1) = grid % yCell % array(iCell)
-
-
-            do i=2,n
-               iv = grid % verticesOnCell % array(i-1,iCell)
-               xp(i) = grid % xVertex % array(iv)
-               yp(i) = grid % yVertex % array(iv)
-            end do
-
-         end if
-
-!         thetat(1) = 0.
-         thetat(1) = theta_abs(iCell)
-         do i=2,n-1
-            ip1 = i+1
-            if (ip1 == n) ip1 = 1
-            thetat(i) = plane_angle( 0.,0.,0.,  &amp;
-                                     xp(i)-xp(i-1), yp(i)-yp(i-1), 0.,  &amp;
-                                     xp(ip1)-xp(i), yp(ip1)-yp(i), 0.,  &amp;
-                                     0., 0., 1.)
-            thetat(i) = thetat(i) + thetat(i-1)
-         end do
-
-         area_cell = 0.
-         area_cellt = 0.
-         do i=1,n-1
-            ip1 = i+1
-            if (ip1 == n) ip1 = 1
-            dl = sqrt((xp(ip1)-xp(i))**2 + (yp(ip1)-yp(i))**2)
-            area_cell = area_cell + 0.25*(xp(i)+xp(ip1))*(yp(ip1)-yp(i)) - 0.25*(yp(i)+yp(ip1))*(xp(ip1)-xp(i))
-            area_cellt = area_cellt + (0.25*(xp(i)+xp(ip1))*cos(thetat(i)) + 0.25*(yp(i)+yp(ip1))*sin(thetat(i)))*dl
-         end do
-         if (debug) write(0,*) ' area_cell, area_cellt ',area_cell, area_cellt,area_cell-area_cellt
-
-         do i=1,n-1
-            ip1 = i+1
-            if (ip1 == n) ip1 = 1
-            dl = sqrt((xp(ip1)-xp(i))**2 + (yp(ip1)-yp(i))**2)
-            sint2 = (sin(thetat(i)))**2
-            cost2 = (cos(thetat(i)))**2
-            sint_cost = sin(thetat(i))*cos(thetat(i))
-            defc_a(i,iCell) = dl*(cost2 - sint2)/area_cell
-            defc_b(i,iCell) = dl*2.*sint_cost/area_cell
-            if (cellsOnEdge(1,EdgesOnCell(i,iCell)) /= iCell) then
-               defc_a(i,iCell) = - defc_a(i,iCell)
-               defc_b(i,iCell) = - defc_b(i,iCell)
-            end if

-         end do
-
-      end do
-
-      if (debug) write(0,*) ' exiting def weight calc '
-
-   end subroutine initialize_deformation_weights
-
-end module advection

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_advection.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_advection.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_advection.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_advection.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,934 @@
+module advection
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+
+
+   contains
+
+
+   subroutine initialize_advection_rk( grid )
+                                      
+!
+! compute the cell coefficients for the polynomial fit.
+! this is performed during setup for model integration.
+! WCS, 31 August 2009
+!
+      implicit none
+
+      type (mesh_type), intent(in) :: grid
+
+      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
+      integer, dimension(:,:), pointer :: advCells
+
+!  local variables
+
+      real (kind=RKIND), dimension(2, grid % nEdges) :: thetae
+      real (kind=RKIND), dimension(grid % nEdges) :: xe, ye
+      real (kind=RKIND), dimension(grid % nCells) :: theta_abs
+
+      real (kind=RKIND), dimension(25) :: xc, yc, zc ! cell center coordinates
+      real (kind=RKIND), dimension(25) :: thetav, thetat, dl_sphere
+      real (kind=RKIND) :: xm, ym, zm, dl, xec, yec, zec
+      real (kind=RKIND) :: thetae_tmp, xe_tmp, ye_tmp
+      real (kind=RKIND) :: xv1, xv2, yv1, yv2, zv1, zv2
+      integer :: i, j, k, ip1, ip2, m, n, ip1a, ii
+      integer :: iCell, iEdge
+      real (kind=RKIND) :: pii
+      real (kind=RKIND) :: x0, y0, x1, y1, x2, y2, x3, y3, x4, y4, x5, y5
+      real (kind=RKIND) :: pdx1, pdx2, pdx3, pdy1, pdy2, pdy3, dx1, dx2, dy1, dy2
+      real (kind=RKIND) :: angv1, angv2, dl1, dl2
+      real (kind=RKIND), dimension(25) :: dxe, dye, x2v, y2v, xp, yp
+      
+      real (kind=RKIND) :: amatrix(25,25), bmatrix(25,25), wmatrix(25,25)
+      real (kind=RKIND) :: length_scale
+      integer :: ma,na, cell_add, mw, nn
+      integer, dimension(25) :: cell_list
+
+
+      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
+
+      logical, parameter :: reset_poly = .true.
+
+      real (kind=RKIND) :: rcell, cos2t, costsint, sin2t
+      real (kind=RKIND), dimension(grid%maxEdges) :: angle_2d
+
+!---
+
+      pii = 2.*asin(1.0)
+
+      advCells =&gt; grid % advCells % array
+      deriv_two =&gt; grid % deriv_two % array
+      deriv_two(:,:,:) = 0.
+
+      do iCell = 1, grid % nCells !  is this correct? - we need first halo cell also...
+
+         cell_list(1) = iCell
+         do i=2, grid % nEdgesOnCell % array(iCell)+1
+            cell_list(i) = grid % CellsOnCell % array(i-1,iCell)
+         end do
+         n = grid % nEdgesOnCell % array(iCell) + 1
+
+         if ( polynomial_order &gt; 2 ) then
+            do i=2,grid % nEdgesOnCell % array(iCell) + 1
+               do j=1,grid % nEdgesOnCell % array ( cell_list(i) )
+                  cell_add = grid % CellsOnCell % array (j,cell_list(i))
+                  add_the_cell = .true.
+                  do k=1,n
+                     if ( cell_add == cell_list(k) ) add_the_cell = .false.
+                  end do
+                  if (add_the_cell) then
+                     n = n+1
+                     cell_list(n) = cell_add
+                  end if
+               end do
+            end do
+         end if

+         advCells(1,iCell) = n
+
+!  check to see if we are reaching outside the halo
+
+         do_the_cell = .true.
+         do i=1,n
+            if (cell_list(i) &gt; grid % nCells) do_the_cell = .false.
+         end do
+
+
+         if ( .not. do_the_cell ) cycle
+
+
+!  compute poynomial fit for this cell if all needed neighbors exist
+         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
+            end do
+
+            theta_abs(iCell) =  pii/2. - sphere_angle( xc(1), yc(1), zc(1),  &amp;
+                                                       xc(2), yc(2), zc(2),  &amp;
+                                                       0.,    0.,    1.      ) 
+
+! angles from cell center to neighbor centers (thetav)
+
+            do i=1,n-1
+   
+               ip2 = i+2
+               if (ip2 &gt; n) ip2 = 2
+    
+               thetav(i) = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
+                                         xc(i+1), yc(i+1), zc(i+1),  &amp;
+                                         xc(ip2), yc(ip2), zc(ip2)   )
+
+               dl_sphere(i) = a*arc_length( xc(1),   yc(1),   zc(1),  &amp;
+                                            xc(i+1), yc(i+1), zc(i+1) )
+            end do
+
+            length_scale = 1.
+            do i=1,n-1
+               dl_sphere(i) = dl_sphere(i)/length_scale
+            end do
+
+!            thetat(1) = 0.  !  this defines the x direction, cell center 1 -&gt; 
+            thetat(1) = theta_abs(iCell)  !  this defines the x direction, longitude line
+            do i=2,n-1
+               thetat(i) = thetat(i-1) + thetav(i-1)
+            end do
+   
+            do i=1,n-1
+               xp(i) = cos(thetat(i)) * dl_sphere(i)
+               yp(i) = sin(thetat(i)) * dl_sphere(i)
+            end do
+
+         else     ! On an x-y plane
+
+            do i=1,n-1
+
+               angle_2d(i) = grid%angleEdge%array(grid % EdgesOnCell % array(i,iCell))
+               iEdge = grid % EdgesOnCell % array(i,iCell)
+               if ( iCell .ne. grid % CellsOnEdge % array(1,iEdge)) &amp;
+                  angle_2d(i) = angle_2d(i) - pii
+
+!               xp(i) = grid % xCell % array(cell_list(i)) - grid % xCell % array(iCell)
+!               yp(i) = grid % yCell % array(cell_list(i)) - grid % yCell % array(iCell)
+
+               xp(i) = grid % dcEdge % array(grid % EdgesOnCell % array(i,iCell)) * cos(angle_2d(i))
+               yp(i) = grid % dcEdge % array(grid % EdgesOnCell % array(i,iCell)) * sin(angle_2d(i))
+
+            end do
+
+         end if
+
+
+         ma = n-1
+         mw = grid % nEdgesOnCell % array (iCell)
+
+         bmatrix = 0.
+         amatrix = 0.
+         wmatrix = 0.
+
+         if (polynomial_order == 2) then
+            na = 6
+            ma = ma+1
+  
+            amatrix(1,1) = 1.
+            wmatrix(1,1) = 1.
+            do i=2,ma
+               amatrix(i,1) = 1.
+               amatrix(i,2) = xp(i-1)
+               amatrix(i,3) = yp(i-1)
+               amatrix(i,4) = xp(i-1)**2
+               amatrix(i,5) = xp(i-1) * yp(i-1)
+               amatrix(i,6) = yp(i-1)**2
+   
+               wmatrix(i,i) = 1.
+            end do

+         else if (polynomial_order == 3) then
+            na = 10
+            ma = ma+1
+  
+            amatrix(1,1) = 1.
+            wmatrix(1,1) = 1.
+            do i=2,ma
+               amatrix(i,1) = 1.
+               amatrix(i,2) = xp(i-1)
+               amatrix(i,3) = yp(i-1)
+   
+               amatrix(i,4) = xp(i-1)**2
+               amatrix(i,5) = xp(i-1) * yp(i-1)
+               amatrix(i,6) = yp(i-1)**2
+   
+               amatrix(i,7) = xp(i-1)**3
+               amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
+               amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
+               amatrix(i,10) = yp(i-1)**3
+   
+               wmatrix(i,i) = 1.

+            end do
+
+         else
+            na = 15
+            ma = ma+1
+  
+            amatrix(1,1) = 1.
+            wmatrix(1,1) = 1.
+            do i=2,ma
+               amatrix(i,1) = 1.
+               amatrix(i,2) = xp(i-1)
+               amatrix(i,3) = yp(i-1)
+   
+               amatrix(i,4) = xp(i-1)**2
+               amatrix(i,5) = xp(i-1) * yp(i-1)
+               amatrix(i,6) = yp(i-1)**2
+   
+               amatrix(i,7) = xp(i-1)**3
+               amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
+               amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
+               amatrix(i,10) = yp(i-1)**3
+   
+               amatrix(i,11) = xp(i-1)**4
+               amatrix(i,12) = yp(i-1) * (xp(i-1)**3)
+               amatrix(i,13) = (xp(i-1)**2)*(yp(i-1)**2)
+               amatrix(i,14) = xp(i-1) * (yp(i-1)**3)
+               amatrix(i,15) = yp(i-1)**4
+   
+               wmatrix(i,i) = 1.
+  
+            end do

+            do i=1,mw
+               wmatrix(i,i) = 1.
+            end do

+         end if

+         call poly_fit_2( amatrix, bmatrix, wmatrix, ma, na, 25 )
+
+         do i=1,grid % nEdgesOnCell % array (iCell)
+            ip1 = i+1
+            if (ip1 &gt; n-1) ip1 = 1
+  
+            iEdge = grid % EdgesOnCell % array (i,iCell)
+            xv1 = grid % xVertex % array(grid % verticesOnEdge % array (1,iedge))/a
+            yv1 = grid % yVertex % array(grid % verticesOnEdge % array (1,iedge))/a
+            zv1 = grid % zVertex % array(grid % verticesOnEdge % array (1,iedge))/a
+            xv2 = grid % xVertex % array(grid % verticesOnEdge % array (2,iedge))/a
+            yv2 = grid % yVertex % array(grid % verticesOnEdge % array (2,iedge))/a
+            zv2 = grid % zVertex % array(grid % verticesOnEdge % array (2,iedge))/a
+  
+            if ( grid % on_a_sphere ) then
+               call arc_bisect( xv1, yv1, zv1,  &amp;
+                                xv2, yv2, zv2,  &amp;
+                                xec, yec, zec   )
+  
+               thetae_tmp = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
+                                          xc(i+1), yc(i+1), zc(i+1),  &amp;
+                                          xec,     yec,     zec       )
+               thetae_tmp = thetae_tmp + thetat(i)
+               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
+                  thetae(1,grid % EdgesOnCell % array (i,iCell)) = thetae_tmp
+               else
+                  thetae(2,grid % EdgesOnCell % array (i,iCell)) = thetae_tmp
+               end if
+!            else
+!
+!               xe(grid % EdgesOnCell % array (i,iCell)) = 0.5 * (xv1 + xv2)
+!               ye(grid % EdgesOnCell % array (i,iCell)) = 0.5 * (yv1 + yv2)
+
+            end if
+  
+         end do
+
+!  fill second derivative stencil for rk advection 
+
+         do i=1, grid % nEdgesOnCell % array (iCell)
+            iEdge = grid % EdgesOnCell % array (i,iCell)
+  
+  
+            if ( grid % on_a_sphere ) then
+               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
+  
+                  cos2t = cos(thetae(1,grid % EdgesOnCell % array (i,iCell)))
+                  sin2t = sin(thetae(1,grid % EdgesOnCell % array (i,iCell)))
+                  costsint = cos2t*sin2t
+                  cos2t = cos2t**2
+                  sin2t = sin2t**2
+   
+                  do j=1,n
+                     deriv_two(j,1,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
+                                            + 2.*costsint*bmatrix(5,j)  &amp;
+                                            + 2.*sin2t*bmatrix(6,j)
+                  end do
+               else
+     
+                  cos2t = cos(thetae(2,grid % EdgesOnCell % array (i,iCell)))
+                  sin2t = sin(thetae(2,grid % EdgesOnCell % array (i,iCell)))
+                  costsint = cos2t*sin2t
+                  cos2t = cos2t**2
+                  sin2t = sin2t**2
+      
+                  do j=1,n
+                     deriv_two(j,2,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
+                                            + 2.*costsint*bmatrix(5,j)  &amp;
+                                            + 2.*sin2t*bmatrix(6,j)
+                  end do
+               end if
+
+            else
+
+               cos2t = cos(angle_2d(i))
+               sin2t = sin(angle_2d(i))
+               costsint = cos2t*sin2t
+               cos2t = cos2t**2
+               sin2t = sin2t**2
+
+!               do j=1,n
+!
+!                  deriv_two(j,1,iEdge) =   2.*xe(iEdge)*xe(iEdge)*bmatrix(4,j)  &amp;
+!                                         + 2.*xe(iEdge)*ye(iEdge)*bmatrix(5,j)  &amp;
+!                                         + 2.*ye(iEdge)*ye(iEdge)*bmatrix(6,j)
+!               end do
+
+               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
+                  do j=1,n
+                     deriv_two(j,1,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
+                                            + 2.*costsint*bmatrix(5,j)  &amp;
+                                            + 2.*sin2t*bmatrix(6,j)
+                  end do
+               else
+                  do j=1,n
+                     deriv_two(j,2,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
+                                            + 2.*costsint*bmatrix(5,j)  &amp;
+                                            + 2.*sin2t*bmatrix(6,j)
+                  end do
+               end if
+
+            end if
+         end do

+      end do ! end of loop over cells
+
+      if (debug) stop
+
+
+!      write(0,*) ' check for deriv2 coefficients, iEdge 4 '
+!
+!      iEdge = 4
+!      j = 1
+!      iCell = grid % cellsOnEdge % array(1,iEdge)
+!      write(0,*) ' j, icell, coef ',j,iCell,deriv_two(j,1,iEdge)
+!      do j=2,7
+!         write(0,*) ' j, icell, coef ',j,grid % CellsOnCell % array(j-1,iCell),deriv_two(j,1,iEdge)
+!      end do
+!
+!      j = 1
+!      iCell = grid % cellsOnEdge % array(2,iEdge)
+!      write(0,*) ' j, icell, coef ',j,iCell,deriv_two(j,2,iEdge)
+!      do j=2,7
+!         write(0,*) ' j, icell, coef ',j,grid % CellsOnCell % array(j-1,iCell),deriv_two(j,2,iEdge)
+!      end do
+!      stop
+
+   end subroutine initialize_advection_rk
+
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! FUNCTION SPHERE_ANGLE
+   !
+   ! Computes the angle between arcs AB and AC, given points A, B, and C
+   ! Equation numbers w.r.t. http://mathworld.wolfram.com/SphericalTrigonometry.html
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   real function sphere_angle(ax, ay, az, bx, by, bz, cx, cy, cz)
+   
+      implicit none
+   
+      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz, cx, cy, cz
+   
+      real (kind=RKIND) :: a, b, c          ! Side lengths of spherical triangle ABC
+   
+      real (kind=RKIND) :: ABx, ABy, ABz    ! The components of the vector AB
+      real (kind=RKIND) :: mAB              ! The magnitude of AB
+      real (kind=RKIND) :: ACx, ACy, ACz    ! The components of the vector AC
+      real (kind=RKIND) :: mAC              ! The magnitude of AC
+   
+      real (kind=RKIND) :: Dx               ! The i-components of the cross product AB x AC
+      real (kind=RKIND) :: Dy               ! The j-components of the cross product AB x AC
+      real (kind=RKIND) :: Dz               ! The k-components of the cross product AB x AC
+   
+      real (kind=RKIND) :: s                ! Semiperimeter of the triangle
+      real (kind=RKIND) :: sin_angle
+   
+      a = acos(max(min(bx*cx + by*cy + bz*cz,1.0),-1.0))      ! Eqn. (3)
+      b = acos(max(min(ax*cx + ay*cy + az*cz,1.0),-1.0))      ! Eqn. (2)
+      c = acos(max(min(ax*bx + ay*by + az*bz,1.0),-1.0))      ! Eqn. (1)
+   
+      ABx = bx - ax
+      ABy = by - ay
+      ABz = bz - az
+   
+      ACx = cx - ax
+      ACy = cy - ay
+      ACz = cz - az
+   
+      Dx =   (ABy * ACz) - (ABz * ACy)
+      Dy = -((ABx * ACz) - (ABz * ACx))
+      Dz =   (ABx * ACy) - (ABy * ACx)
+   
+      s = 0.5*(a + b + c)
+!      sin_angle = sqrt((sin(s-b)*sin(s-c))/(sin(b)*sin(c)))   ! Eqn. (28)
+      sin_angle = sqrt(min(1.,max(0.,(sin(s-b)*sin(s-c))/(sin(b)*sin(c)))))   ! Eqn. (28)
+   
+      if ((Dx*ax + Dy*ay + Dz*az) &gt;= 0.0) then
+         sphere_angle =  2.0 * asin(max(min(sin_angle,1.0),-1.0))
+      else
+         sphere_angle = -2.0 * asin(max(min(sin_angle,1.0),-1.0))
+      end if
+   
+   end function sphere_angle
+   
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! FUNCTION PLANE_ANGLE
+   !
+   ! Computes the angle between vectors AB and AC, given points A, B, and C, and
+   !   a vector (u,v,w) normal to the plane.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   real function plane_angle(ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w)
+   
+      implicit none
+   
+      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w
+   
+      real (kind=RKIND) :: ABx, ABy, ABz    ! The components of the vector AB
+      real (kind=RKIND) :: mAB              ! The magnitude of AB
+      real (kind=RKIND) :: ACx, ACy, ACz    ! The components of the vector AC
+      real (kind=RKIND) :: mAC              ! The magnitude of AC
+   
+      real (kind=RKIND) :: Dx               ! The i-components of the cross product AB x AC
+      real (kind=RKIND) :: Dy               ! The j-components of the cross product AB x AC
+      real (kind=RKIND) :: Dz               ! The k-components of the cross product AB x AC
+   
+      real (kind=RKIND) :: cos_angle
+   
+      ABx = bx - ax
+      ABy = by - ay
+      ABz = bz - az
+      mAB = sqrt(ABx**2.0 + ABy**2.0 + ABz**2.0)
+   
+      ACx = cx - ax
+      ACy = cy - ay
+      ACz = cz - az
+      mAC = sqrt(ACx**2.0 + ACy**2.0 + ACz**2.0)
+   
+   
+      Dx =   (ABy * ACz) - (ABz * ACy)
+      Dy = -((ABx * ACz) - (ABz * ACx))
+      Dz =   (ABx * ACy) - (ABy * ACx)
+   
+      cos_angle = (ABx*ACx + ABy*ACy + ABz*ACz) / (mAB * mAC)
+   
+      if ((Dx*u + Dy*v + Dz*w) &gt;= 0.0) then
+         plane_angle =  acos(max(min(cos_angle,1.0),-1.0))
+      else
+         plane_angle = -acos(max(min(cos_angle,1.0),-1.0))
+      end if
+   
+   end function plane_angle
+
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! FUNCTION ARC_LENGTH
+   !
+   ! Returns the length of the great circle arc from A=(ax, ay, az) to 
+   !    B=(bx, by, bz). It is assumed that both A and B lie on the surface of the
+   !    same sphere centered at the origin.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   real function arc_length(ax, ay, az, bx, by, bz)
+   
+      implicit none
+   
+      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz
+   
+      real (kind=RKIND) :: r, c
+      real (kind=RKIND) :: cx, cy, cz
+   
+      cx = bx - ax
+      cy = by - ay
+      cz = bz - az
+
+!      r = ax*ax + ay*ay + az*az
+!      c = cx*cx + cy*cy + cz*cz
+!
+!      arc_length = sqrt(r) * acos(1.0 - c/(2.0*r))
+
+      r = sqrt(ax*ax + ay*ay + az*az)
+      c = sqrt(cx*cx + cy*cy + cz*cz)
+!      arc_length = sqrt(r) * 2.0 * asin(c/(2.0*r))
+      arc_length = r * 2.0 * asin(c/(2.0*r))
+
+   end function arc_length
+   
+   
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! SUBROUTINE ARC_BISECT
+   !
+   ! Returns the point C=(cx, cy, cz) that bisects the great circle arc from
+   !   A=(ax, ay, az) to B=(bx, by, bz). It is assumed that A and B lie on the
+   !   surface of a sphere centered at the origin.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   subroutine arc_bisect(ax, ay, az, bx, by, bz, cx, cy, cz)
+   
+      implicit none
+   
+      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz
+      real (kind=RKIND), intent(out) :: cx, cy, cz
+   
+      real (kind=RKIND) :: r           ! Radius of the sphere
+      real (kind=RKIND) :: d           
+   
+      r = sqrt(ax*ax + ay*ay + az*az)
+   
+      cx = 0.5*(ax + bx)
+      cy = 0.5*(ay + by)
+      cz = 0.5*(az + bz)
+   
+      if (cx == 0. .and. cy == 0. .and. cz == 0.) then
+         write(0,*) 'Error: arc_bisect: A and B are diametrically opposite'
+      else
+         d = sqrt(cx*cx + cy*cy + cz*cz)
+         cx = r * cx / d
+         cy = r * cy / d
+         cz = r * cz / d
+      end if
+   
+   end subroutine arc_bisect
+
+
+   subroutine poly_fit_2(a_in,b_out,weights_in,m,n,ne)
+
+      implicit none
+
+      integer, intent(in) :: m,n,ne
+      real (kind=RKIND), dimension(ne,ne), intent(in) :: a_in, weights_in
+      real (kind=RKIND), dimension(ne,ne), intent(out) :: b_out
+   
+      ! local storage
+   
+      real (kind=RKIND), dimension(m,n)  :: a
+      real (kind=RKIND), dimension(n,m)  :: b
+      real (kind=RKIND), dimension(m,m)  :: w,wt,h
+      real (kind=RKIND), dimension(n,m)  :: at, ath
+      real (kind=RKIND), dimension(n,n)  :: ata, ata_inv, atha, atha_inv
+      integer, dimension(n) :: indx
+      integer :: i,j
+   
+      if ( (ne&lt;n) .or. (ne&lt;m) ) then
+         write(6,*) ' error in poly_fit_2 inversion ',m,n,ne
+         stop
+      end if
+   
+!      a(1:m,1:n) = a_in(1:n,1:m) 
+      a(1:m,1:n) = a_in(1:m,1:n)
+      w(1:m,1:m) = weights_in(1:m,1:m) 
+      b_out(:,:) = 0.   
+
+      wt = transpose(w)
+      h = matmul(wt,w)
+      at = transpose(a)
+      ath = matmul(at,h)
+      atha = matmul(ath,a)
+      
+      ata = matmul(at,a)
+
+!      if (m == n) then
+!         call MIGS(a,n,b,indx)
+!      else
+
+         call MIGS(atha,n,atha_inv,indx)
+
+         b = matmul(atha_inv,ath)
+
+!         call MIGS(ata,n,ata_inv,indx)
+!         b = matmul(ata_inv,at)
+!      end if
+      b_out(1:n,1:m) = b(1:n,1:m)
+
+!     do i=1,n
+!        write(6,*) ' i, indx ',i,indx(i)
+!     end do
+!
+!     write(6,*) ' '
+
+   end subroutine poly_fit_2
+
+
+! Updated 10/24/2001.
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!   Program 4.4   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!                                                                       !
+! Please Note:                                                          !
+!                                                                       !
+! (1) This computer program is written by Tao Pang in conjunction with  !
+!     his book, &quot;An Introduction to Computational Physics,&quot; published   !
+!     by Cambridge University Press in 1997.                            !
+!                                                                       !
+! (2) No warranties, express or implied, are made for this program.     !
+!                                                                       !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+SUBROUTine MIGS (A,N,X,INDX)
+!
+! Subroutine to invert matrix A(N,N) with the inverse stored
+! in X(N,N) in the output.  Copyright (c) Tao Pang 2001.
+!
+  IMPLICIT NONE
+  INTEGER, INTENT (IN) :: N
+  INTEGER :: I,J,K
+  INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
+  REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N):: A
+  REAL (kind=RKIND), INTENT (OUT), DIMENSION (N,N):: X
+  REAL (kind=RKIND), DIMENSION (N,N) :: B
+!
+  DO I = 1, N
+    DO J = 1, N
+      B(I,J) = 0.0
+    END DO
+  END DO
+  DO I = 1, N
+    B(I,I) = 1.0
+  END DO
+!
+  CALL ELGS (A,N,INDX)
+!
+  DO I = 1, N-1
+    DO J = I+1, N
+      DO K = 1, N
+        B(INDX(J),K) = B(INDX(J),K)-A(INDX(J),I)*B(INDX(I),K)
+      END DO
+    END DO
+  END DO
+!
+  DO I = 1, N
+    X(N,I) = B(INDX(N),I)/A(INDX(N),N)
+    DO J = N-1, 1, -1
+      X(J,I) = B(INDX(J),I)
+      DO K = J+1, N
+        X(J,I) = X(J,I)-A(INDX(J),K)*X(K,I)
+      END DO
+      X(J,I) =  X(J,I)/A(INDX(J),J)
+    END DO
+  END DO
+END SUBROUTine MIGS
+
+
+SUBROUTINE ELGS (A,N,INDX)
+!
+! Subroutine to perform the partial-pivoting Gaussian elimination.
+! A(N,N) is the original matrix in the input and transformed matrix
+! plus the pivoting element ratios below the diagonal in the output.
+! INDX(N) records the pivoting order.  Copyright (c) Tao Pang 2001.
+!
+  IMPLICIT NONE
+  INTEGER, INTENT (IN) :: N
+  INTEGER :: I,J,K,ITMP
+  INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
+  REAL (kind=RKIND) :: C1,PI,PI1,PJ
+  REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
+  REAL (kind=RKIND), DIMENSION (N) :: C
+!
+! Initialize the index
+!
+  DO I = 1, N
+    INDX(I) = I
+  END DO
+!
+! Find the rescaling factors, one from each row
+!
+  DO I = 1, N
+    C1= 0.0
+    DO J = 1, N
+      C1 = MAX(C1,ABS(A(I,J)))
+    END DO
+    C(I) = C1
+  END DO
+!
+! Search the pivoting (largest) element from each column
+!
+  DO J = 1, N-1
+    PI1 = 0.0
+    DO I = J, N
+      PI = ABS(A(INDX(I),J))/C(INDX(I))
+      IF (PI.GT.PI1) THEN
+        PI1 = PI
+        K   = I
+      ENDIF
+    END DO
+!
+! Interchange the rows via INDX(N) to record pivoting order
+!
+    ITMP    = INDX(J)
+    INDX(J) = INDX(K)
+    INDX(K) = ITMP
+    DO I = J+1, N
+      PJ  = A(INDX(I),J)/A(INDX(J),J)
+!
+! Record pivoting ratios below the diagonal
+!
+      A(INDX(I),J) = PJ
+!
+! Modify other elements accordingly
+!
+      DO K = J+1, N
+        A(INDX(I),K) = A(INDX(I),K)-PJ*A(INDX(J),K)
+      END DO
+    END DO
+  END DO
+!
+END SUBROUTINE ELGS
+
+!-------------------------------------------------------------
+
+   subroutine initialize_deformation_weights( grid )
+                                      
+!
+! compute the cell coefficients for the deformation calculations
+! WCS, 13 July 2010
+!
+      implicit none
+
+      type (mesh_type), intent(in) :: grid
+!      type (grid_meta), intent(in) :: grid
+
+      real (kind=RKIND), dimension(:,:), pointer :: defc_a, defc_b
+      integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
+
+!  local variables
+
+      real (kind=RKIND), dimension(2, grid % nEdges) :: thetae
+      real (kind=RKIND), dimension(grid % nEdges) :: xe, ye
+      real (kind=RKIND), dimension(grid % nCells) :: theta_abs
+
+      real (kind=RKIND), dimension(25) :: xc, yc, zc ! cell center coordinates
+      real (kind=RKIND), dimension(25) :: thetav, thetat, dl_sphere
+      real (kind=RKIND) :: xm, ym, zm, dl, xec, yec, zec
+      real (kind=RKIND) :: thetae_tmp, xe_tmp, ye_tmp
+      real (kind=RKIND) :: xv1, xv2, yv1, yv2, zv1, zv2
+      integer :: i, j, k, ip1, ip2, m, n, ip1a, ii
+      integer :: iCell, iEdge
+      real (kind=RKIND) :: pii
+      real (kind=RKIND) :: x0, y0, x1, y1, x2, y2, x3, y3, x4, y4, x5, y5
+      real (kind=RKIND) :: pdx1, pdx2, pdx3, pdy1, pdy2, pdy3, dx1, dx2, dy1, dy2
+      real (kind=RKIND) :: angv1, angv2, dl1, dl2
+      real (kind=RKIND), dimension(25) :: dxe, dye, x2v, y2v, xp, yp, xpt, ypt
+      
+      real (kind=RKIND) :: length_scale
+      integer :: ma,na, cell_add, mw, nn
+      integer, dimension(25) :: cell_list
+
+      integer :: cell1, cell2, iv
+      logical :: do_the_cell
+      real (kind=RKIND) :: area_cell, sint2, cost2, sint_cost, sumw1, sumw2, xptt, area_cellt
+
+      logical, parameter :: debug = .false.
+
+      if (debug) write(0,*) ' in def weight calc '
+
+      defc_a =&gt; grid % defc_a % array
+      defc_b =&gt; grid % defc_b % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      edgesOnCell =&gt; grid % edgesOnCell % array
+
+      defc_a(:,:) = 0.
+      defc_b(:,:) = 0.
+
+      pii = 2.*asin(1.0)
+
+      if (debug) write(0,*) ' beginning cell loop '
+
+      do iCell = 1, grid % nCells
+
+         if (debug) write(0,*) ' cell loop ', iCell
+
+         cell_list(1) = iCell
+         do i=2, grid % nEdgesOnCell % array(iCell)+1
+            cell_list(i) = grid % CellsOnCell % array(i-1,iCell)
+         end do
+         n = grid % nEdgesOnCell % array(iCell) + 1
+
+!  check to see if we are reaching outside the halo
+
+         if (debug) write(0,*) ' points ', n
+
+         do_the_cell = .true.
+         do i=1,n
+            if (cell_list(i) &gt; grid % nCells) do_the_cell = .false.
+         end do
+
+
+         if (.not. do_the_cell) cycle
+
+
+!  compute poynomial fit for this cell if all needed neighbors exist
+         if (grid % on_a_sphere) then
+
+            xc(1) = grid % xCell % array(iCell)/a
+            yc(1) = grid % yCell % array(iCell)/a
+            zc(1) = grid % zCell % array(iCell)/a
+
+
+            do i=2,n
+               iv = grid % verticesOnCell % array(i-1,iCell)
+               xc(i) = grid % xVertex % array(iv)/a
+               yc(i) = grid % yVertex % array(iv)/a
+               zc(i) = grid % zVertex % array(iv)/a
+            end do
+
+            theta_abs(iCell) =  pii/2. - sphere_angle( xc(1), yc(1), zc(1),  &amp;
+                                                       xc(2), yc(2), zc(2),  &amp;
+                                                       0.,    0.,    1.      ) 
+
+! angles from cell center to neighbor centers (thetav)
+
+            do i=1,n-1
+   
+               ip2 = i+2
+               if (ip2 &gt; n) ip2 = 2
+    
+               thetav(i) = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
+                                         xc(i+1), yc(i+1), zc(i+1),  &amp;
+                                         xc(ip2), yc(ip2), zc(ip2)   )
+
+               dl_sphere(i) = a*arc_length( xc(1),   yc(1),   zc(1),  &amp;
+                                            xc(i+1), yc(i+1), zc(i+1) )
+            end do
+
+            length_scale = 1.
+            do i=1,n-1
+               dl_sphere(i) = dl_sphere(i)/length_scale
+            end do
+
+            thetat(1) = 0.  !  this defines the x direction, cell center 1 -&gt; 
+!            thetat(1) = theta_abs(iCell)  !  this defines the x direction, longitude line
+            do i=2,n-1
+               thetat(i) = thetat(i-1) + thetav(i-1)
+            end do
+   
+            do i=1,n-1
+               xp(i) = cos(thetat(i)) * dl_sphere(i)
+               yp(i) = sin(thetat(i)) * dl_sphere(i)
+            end do
+
+         else     ! On an x-y plane
+
+            xp(1) = grid % xCell % array(iCell)
+            yp(1) = grid % yCell % array(iCell)
+
+
+            do i=2,n
+               iv = grid % verticesOnCell % array(i-1,iCell)
+               xp(i) = grid % xVertex % array(iv)
+               yp(i) = grid % yVertex % array(iv)
+            end do
+
+         end if
+
+!         thetat(1) = 0.
+         thetat(1) = theta_abs(iCell)
+         do i=2,n-1
+            ip1 = i+1
+            if (ip1 == n) ip1 = 1
+            thetat(i) = plane_angle( 0.,0.,0.,  &amp;
+                                     xp(i)-xp(i-1), yp(i)-yp(i-1), 0.,  &amp;
+                                     xp(ip1)-xp(i), yp(ip1)-yp(i), 0.,  &amp;
+                                     0., 0., 1.)
+            thetat(i) = thetat(i) + thetat(i-1)
+         end do
+
+         area_cell = 0.
+         area_cellt = 0.
+         do i=1,n-1
+            ip1 = i+1
+            if (ip1 == n) ip1 = 1
+            dl = sqrt((xp(ip1)-xp(i))**2 + (yp(ip1)-yp(i))**2)
+            area_cell = area_cell + 0.25*(xp(i)+xp(ip1))*(yp(ip1)-yp(i)) - 0.25*(yp(i)+yp(ip1))*(xp(ip1)-xp(i))
+            area_cellt = area_cellt + (0.25*(xp(i)+xp(ip1))*cos(thetat(i)) + 0.25*(yp(i)+yp(ip1))*sin(thetat(i)))*dl
+         end do
+         if (debug) write(0,*) ' area_cell, area_cellt ',area_cell, area_cellt,area_cell-area_cellt
+
+         do i=1,n-1
+            ip1 = i+1
+            if (ip1 == n) ip1 = 1
+            dl = sqrt((xp(ip1)-xp(i))**2 + (yp(ip1)-yp(i))**2)
+            sint2 = (sin(thetat(i)))**2
+            cost2 = (cos(thetat(i)))**2
+            sint_cost = sin(thetat(i))*cos(thetat(i))
+            defc_a(i,iCell) = dl*(cost2 - sint2)/area_cell
+            defc_b(i,iCell) = dl*2.*sint_cost/area_cell
+            if (cellsOnEdge(1,EdgesOnCell(i,iCell)) /= iCell) then
+               defc_a(i,iCell) = - defc_a(i,iCell)
+               defc_b(i,iCell) = - defc_b(i,iCell)
+            end if

+         end do
+
+      end do
+
+      if (debug) write(0,*) ' exiting def weight calc '
+
+   end subroutine initialize_deformation_weights
+
+end module advection

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_equation_of_state.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,185 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_equation_of_state
-!
-!&gt; \brief MPAS ocean equation of state driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   29 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for calling
-!&gt;  the equation of state.
-!
-!-----------------------------------------------------------------------
-
-module ocn_equation_of_state
-
-   use grid_types
-   use configure
-   use timer
-   use ocn_equation_of_state_linear
-   use ocn_equation_of_state_jm
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_equation_of_state_rho, &amp;
-             ocn_equation_of_state_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: eosON
-   logical :: linearEos, jmEos
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_equation_of_state
-!
-!&gt; \brief   Calls equation of state
-!&gt; \author  Doug Jacobsen
-!&gt; \date    29 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine calls the equation of state to update the density
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_equation_of_state_rho(s, grid, k_displaced, displacement_type, err)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !  This module contains routines necessary for computing the density
-   !  from model temperature and salinity using an equation of state.
-   !
-   ! Input: grid - grid metadata
-   !        s - state: tracers
-   !        k_displaced 
-   !  If k_displaced&lt;=0, state % rho is returned with no displaced
-   !  If k_displaced&gt;0,the state % rhoDisplaced is returned, and is for
-   !  a parcel adiabatically displaced from its original level to level 
-   !  k_displaced.  This does not effect the linear EOS.
-   !
-   ! Output: s - state: computed density
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      implicit none
-
-      type (state_type), intent(inout) :: s
-      type (mesh_type), intent(in) :: grid
-      integer, intent(out) :: err
-      integer :: k_displaced
-      character(len=8), intent(in) :: displacement_type
-
-      integer, dimension(:), pointer :: maxLevelCell
-      real (kind=RKIND), dimension(:,:), pointer :: rho
-      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
-      integer :: nCells, iCell, k, indexT, indexS
-      type (dm_info) :: dminfo
-
-      err = 0
-
-      if(.not.eosOn) return
-
-      call timer_start(&quot;ocn_equation_of_state_rho&quot;)
-
-      tracers =&gt; s % tracers % array
-      indexT = s % index_temperature
-      indexS = s % index_salinity
-
-      if (linearEos) then
-         rho =&gt; s % rho % array
-
-         call ocn_equation_of_state_linear_rho(grid, indexT, indexS, tracers, rho, err)
-
-      elseif (jmEos) then
-
-         if(k_displaced == 0) then
-             rho =&gt; s % rho % array
-         else
-             rho =&gt; s % rhoDisplaced % array
-         endif
-
-         call ocn_equation_of_state_jm_rho(grid, k_displaced, displacement_type, indexT, indexS, tracers, rho, err)
-
-      endif
-
-      call timer_stop(&quot;ocn_equation_of_state_rho&quot;)
-
-   end subroutine ocn_equation_of_state_rho!}}}
-
-!***********************************************************************
-!
-!  routine ocn_equation_of_stateInit
-!
-!&gt; \brief   Initializes ocean momentum horizontal mixing quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    29 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  horizontal velocity mixing in the ocean. Since a variety of 
-!&gt;  parameterizations are available, this routine primarily calls the
-!&gt;  individual init routines for each parameterization. 
-!
-!----------------------------------------------------------------------
-
-   subroutine ocn_equation_of_state_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err
-
-      err = 0
-      eosON = .false.
-      linearEos = .false.
-      jmEos = .false.
-
-      if(config_vert_grid_type.eq.'zlevel') then
-          eosON = .true.
-
-          if (config_eos_type.eq.'linear') then
-              linearEos = .true.
-          elseif (config_eos_type.eq.'jm') then
-              jmEos = .true.
-          else
-              print *,'Invalid choice for config_eos_type.'
-              print *,'  Choices are: linear, jm'
-              err = 1
-          endif
-      endif
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_equation_of_state_init!}}}
-
-!***********************************************************************
-
-end module ocn_equation_of_state
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_equation_of_state.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,185 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_equation_of_state
+!
+!&gt; \brief MPAS ocean equation of state driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   29 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for calling
+!&gt;  the equation of state.
+!
+!-----------------------------------------------------------------------
+
+module ocn_equation_of_state
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+   use ocn_equation_of_state_linear
+   use ocn_equation_of_state_jm
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_equation_of_state_rho, &amp;
+             ocn_equation_of_state_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: eosON
+   logical :: linearEos, jmEos
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_equation_of_state
+!
+!&gt; \brief   Calls equation of state
+!&gt; \author  Doug Jacobsen
+!&gt; \date    29 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine calls the equation of state to update the density
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_equation_of_state_rho(s, grid, k_displaced, displacement_type, err)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !  This module contains routines necessary for computing the density
+   !  from model temperature and salinity using an equation of state.
+   !
+   ! Input: grid - grid metadata
+   !        s - state: tracers
+   !        k_displaced 
+   !  If k_displaced&lt;=0, state % rho is returned with no displaced
+   !  If k_displaced&gt;0,the state % rhoDisplaced is returned, and is for
+   !  a parcel adiabatically displaced from its original level to level 
+   !  k_displaced.  This does not effect the linear EOS.
+   !
+   ! Output: s - state: computed density
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      implicit none
+
+      type (state_type), intent(inout) :: s
+      type (mesh_type), intent(in) :: grid
+      integer, intent(out) :: err
+      integer :: k_displaced
+      character(len=8), intent(in) :: displacement_type
+
+      integer, dimension(:), pointer :: maxLevelCell
+      real (kind=RKIND), dimension(:,:), pointer :: rho
+      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+      integer :: nCells, iCell, k, indexT, indexS
+      type (dm_info) :: dminfo
+
+      err = 0
+
+      if(.not.eosOn) return
+
+      call mpas_timer_start(&quot;ocn_equation_of_state_rho&quot;)
+
+      tracers =&gt; s % tracers % array
+      indexT = s % index_temperature
+      indexS = s % index_salinity
+
+      if (linearEos) then
+         rho =&gt; s % rho % array
+
+         call ocn_equation_of_state_linear_rho(grid, indexT, indexS, tracers, rho, err)
+
+      elseif (jmEos) then
+
+         if(k_displaced == 0) then
+             rho =&gt; s % rho % array
+         else
+             rho =&gt; s % rhoDisplaced % array
+         endif
+
+         call ocn_equation_of_state_jm_rho(grid, k_displaced, displacement_type, indexT, indexS, tracers, rho, err)
+
+      endif
+
+      call mpas_timer_stop(&quot;ocn_equation_of_state_rho&quot;)
+
+   end subroutine ocn_equation_of_state_rho!}}}
+
+!***********************************************************************
+!
+!  routine ocn_equation_of_stateInit
+!
+!&gt; \brief   Initializes ocean momentum horizontal mixing quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    29 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  horizontal velocity mixing in the ocean. Since a variety of 
+!&gt;  parameterizations are available, this routine primarily calls the
+!&gt;  individual init routines for each parameterization. 
+!
+!----------------------------------------------------------------------
+
+   subroutine ocn_equation_of_state_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err
+
+      err = 0
+      eosON = .false.
+      linearEos = .false.
+      jmEos = .false.
+
+      if(config_vert_grid_type.eq.'zlevel') then
+          eosON = .true.
+
+          if (config_eos_type.eq.'linear') then
+              linearEos = .true.
+          elseif (config_eos_type.eq.'jm') then
+              jmEos = .true.
+          else
+              print *,'Invalid choice for config_eos_type.'
+              print *,'  Choices are: linear, jm'
+              err = 1
+          endif
+      endif
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_equation_of_state_init!}}}
+
+!***********************************************************************
+
+end module ocn_equation_of_state
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state_jm.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_equation_of_state_jm.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state_jm.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,355 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_equation_of_state_jm
-!
-!&gt; \brief MPAS ocean equation of state driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   28 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for calling
-!&gt;  the equation of state.
-!
-!-----------------------------------------------------------------------
-
-module ocn_equation_of_state_jm
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_equation_of_state_jm_rho, &amp;
-             ocn_equation_of_state_jm_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_equation_of_state_jm_rho
-!
-!&gt; \brief   Calls JM equation of state
-!&gt; \author  Doug Jacobsen
-!&gt; \date    28 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine uses a JM equation of state to update the density
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_equation_of_state_jm_rho(grid, k_displaced, displacement_type, indexT, indexS, tracers, rho, err)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !  This module contains routines necessary for computing the density
-   !  from model temperature and salinity using an equation of state.
-   !
-   !  The UNESCO equation of state computed using the
-   !  potential-temperature-based bulk modulus from Jackett and
-   !  McDougall, JTECH, Vol.12, pp 381-389, April, 1995.
-   !
-   ! Input: grid - grid metadata
-   !        s - state: tracers
-   !        k_displaced 
-
-   !  If k_displaced&lt;=0, density is returned with no displaced
-   !  If k_displaced&gt;0,the density returned is that for a parcel
-   !  adiabatically displaced from its original level to level 
-   !  k_displaced.
-
-   !
-   ! Output: s - state: computed density
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (mesh_type), intent(in) :: grid
-      integer :: k_displaced, indexT, indexS
-      character(len=8), intent(in) :: displacement_type
-      integer, intent(out) :: err
-
-      type (dm_info) :: dminfo
-      integer :: iEdge, iCell, iVertex, k
-
-      integer :: nCells, nEdges, nVertices, nVertLevels
-
-
-      real (kind=RKIND), dimension(:), pointer :: &amp;
-        zMidZLevel, pRefEOS
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-        rho
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
-
-      integer, dimension(:), pointer :: maxLevelCell
-
-   real (kind=RKIND) :: &amp;
-      TQ,SQ,             &amp;! adjusted T,S
-      BULK_MOD,          &amp;! Bulk modulus
-      RHO_S,             &amp;! density at the surface
-      DRDT0,             &amp;! d(density)/d(temperature), for surface
-      DRDS0,             &amp;! d(density)/d(salinity   ), for surface
-      DKDT,              &amp;! d(bulk modulus)/d(pot. temp.)
-      DKDS,              &amp;! d(bulk modulus)/d(salinity  )
-      SQR,DENOMK,        &amp;! work arrays
-      WORK1, WORK2, WORK3, WORK4, T2, depth
-
-   real (kind=RKIND) :: &amp; 
-      tmin, tmax,        &amp;! valid temperature range for level k
-      smin, smax          ! valid salinity    range for level k
-
-   real (kind=RKIND), dimension(:), allocatable :: &amp;
-      p, p2 ! temporary pressure scalars
-
-!-----------------------------------------------------------------------
-!
-!  UNESCO EOS constants and JMcD bulk modulus constants
-!
-!-----------------------------------------------------------------------
-
-   !*** for density of fresh water (standard UNESCO)
-
-   real (kind=RKIND), parameter ::              &amp;
-      unt0 =   999.842594,           &amp;
-      unt1 =  6.793952e-2,           &amp;
-      unt2 = -9.095290e-3,           &amp;
-      unt3 =  1.001685e-4,           &amp;
-      unt4 = -1.120083e-6,           &amp;
-      unt5 =  6.536332e-9
-
-   !*** for dependence of surface density on salinity (UNESCO)
-
-   real (kind=RKIND), parameter ::              &amp;
-      uns1t0 =  0.824493 ,           &amp;
-      uns1t1 = -4.0899e-3,           &amp;
-      uns1t2 =  7.6438e-5,           &amp;
-      uns1t3 = -8.2467e-7,           &amp;
-      uns1t4 =  5.3875e-9,           &amp;
-      unsqt0 = -5.72466e-3,          &amp;
-      unsqt1 =  1.0227e-4,           &amp;
-      unsqt2 = -1.6546e-6,           &amp;
-      uns2t0 =  4.8314e-4
-
-   !*** from Table A1 of Jackett and McDougall
-
-   real (kind=RKIND), parameter ::              &amp;
-      bup0s0t0 =  1.965933e+4,       &amp;
-      bup0s0t1 =  1.444304e+2,       &amp;
-      bup0s0t2 = -1.706103   ,       &amp;
-      bup0s0t3 =  9.648704e-3,       &amp;
-      bup0s0t4 = -4.190253e-5
-
-   real (kind=RKIND), parameter ::              &amp;
-      bup0s1t0 =  5.284855e+1,       &amp;
-      bup0s1t1 = -3.101089e-1,       &amp;
-      bup0s1t2 =  6.283263e-3,       &amp;
-      bup0s1t3 = -5.084188e-5
-
-   real (kind=RKIND), parameter ::              &amp;
-      bup0sqt0 =  3.886640e-1,       &amp;
-      bup0sqt1 =  9.085835e-3,       &amp;
-      bup0sqt2 = -4.619924e-4
-
-   real (kind=RKIND), parameter ::              &amp;
-      bup1s0t0 =  3.186519   ,       &amp;
-      bup1s0t1 =  2.212276e-2,       &amp;
-      bup1s0t2 = -2.984642e-4,       &amp;
-      bup1s0t3 =  1.956415e-6 
-
-   real (kind=RKIND), parameter ::              &amp;
-      bup1s1t0 =  6.704388e-3,       &amp;
-      bup1s1t1 = -1.847318e-4,       &amp;
-      bup1s1t2 =  2.059331e-7,       &amp;
-      bup1sqt0 =  1.480266e-4 
-
-   real (kind=RKIND), parameter ::              &amp;
-      bup2s0t0 =  2.102898e-4,       &amp;
-      bup2s0t1 = -1.202016e-5,       &amp;
-      bup2s0t2 =  1.394680e-7,       &amp;
-      bup2s1t0 = -2.040237e-6,       &amp;
-      bup2s1t1 =  6.128773e-8,       &amp;
-      bup2s1t2 =  6.207323e-10
-
-   integer :: k_test, k_ref
-
-      err = 0
-
-      call timer_start(&quot;equation_of_state_jm&quot;)
-
-      nCells      = grid % nCells
-      maxLevelCell      =&gt; grid % maxLevelCell % array
-      nVertLevels = grid % nVertLevels
-      zMidZLevel        =&gt; grid % zMidZLevel % array
-
-
-!  Jackett and McDougall
-      tmin = -2.0  ! valid pot. temp. range
-      tmax = 40.0 
-      smin =  0.0  ! valid salinity, in psu   
-      smax = 42.0 
-
-      ! This could be put in a startup routine.
-      ! Note I am using zMidZlevel, so pressure on top level does
-      ! not include SSH contribution.  I am not sure if that matters.
-
-!  This function computes pressure in bars from depth in meters
-!  using a mean density derived from depth-dependent global 
-!  average temperatures and salinities from Levitus 1994, and 
-!  integrating using hydrostatic balance.
-
-      allocate(pRefEOS(nVertLevels),p(nVertLevels),p2(nVertLevels))
-      do k = 1,nVertLevels
-        depth = -zMidZLevel(k)
-        pRefEOS(k) = 0.059808*(exp(-0.025*depth) - 1.0) &amp;
-            + 0.100766*depth + 2.28405e-7*depth**2
-      enddo
-
-   !  If k_displaced=0, in-situ density is returned (no displacement)
-   !  If k_displaced/=0, potential density is returned
-
-   !  if displacement_type = 'relative', potential density is calculated
-   !     referenced to level k + k_displaced
-   !  if displacement_type = 'absolute', potential density is calculated
-   !     referenced to level k_displaced for all k
-   !  NOTE: k_displaced = 0 or &gt; nVertLevels is incompatible with 'absolute'
-   !     so abort if necessary
-
-   if (displacement_type == 'absolute' .and.   &amp;
-       (k_displaced &lt;= 0 .or. k_displaced &gt; nVertLevels) ) then
-      write(0,*) 'Abort: In equation_of_state_jm', &amp;
-         ' k_displaced must be between 1 and nVertLevels for ', &amp;
-         'displacement_type = absolute'
-      call dmpar_abort(dminfo)
-   endif
-
-   if (k_displaced == 0) then
-      do k=1,nVertLevels
-         p(k)   = pRefEOS(k)
-         p2(k)  = p(k)*p(k)
-      enddo
-   else ! k_displaced /= 0
-      do k=1,nVertLevels
-         if (displacement_type == 'relative') then
-            k_test = min(k + k_displaced, nVertLevels)
-            k_ref  = max(k_test, 1)
-         else
-            k_test = min(k_displaced, nVertLevels)
-            k_ref  = max(k_test, 1)
-         endif
-         p(k)   = pRefEOS(k_ref)
-         p2(k)  = p(k)*p(k)
-      enddo
-   endif
-
-  do iCell=1,nCells
-    do k=1,maxLevelCell(iCell)
-
-      SQ  = max(min(tracers(indexS,k,iCell),smax),smin)
-      TQ  = max(min(tracers(indexT,k,iCell),tmax),tmin)
-
-      SQR = sqrt(SQ)
-      T2  = TQ*TQ
-
-      !***
-      !*** first calculate surface (p=0) values from UNESCO eqns.
-      !***
-
-      WORK1 = uns1t0 + uns1t1*TQ + &amp; 
-             (uns1t2 + uns1t3*TQ + uns1t4*T2)*T2
-      WORK2 = SQR*(unsqt0 + unsqt1*TQ + unsqt2*T2)
-
-      RHO_S = unt1*TQ + (unt2 + unt3*TQ + (unt4 + unt5*TQ)*T2)*T2 &amp;
-                      + (uns2t0*SQ + WORK1 + WORK2)*SQ
-
-      !***
-      !*** now calculate bulk modulus at pressure p from 
-      !*** Jackett and McDougall formula
-      !***
-
-      WORK3 = bup0s1t0 + bup0s1t1*TQ +                    &amp;
-             (bup0s1t2 + bup0s1t3*TQ)*T2 +                &amp;
-              p(k) *(bup1s1t0 + bup1s1t1*TQ + bup1s1t2*T2) + &amp;
-              p2(k)*(bup2s1t0 + bup2s1t1*TQ + bup2s1t2*T2)
-      WORK4 = SQR*(bup0sqt0 + bup0sqt1*TQ + bup0sqt2*T2 + &amp;
-                   bup1sqt0*p(k))
-
-      BULK_MOD  = bup0s0t0 + bup0s0t1*TQ +                    &amp;
-                  (bup0s0t2 + bup0s0t3*TQ + bup0s0t4*T2)*T2 + &amp;
-                  p(k) *(bup1s0t0 + bup1s0t1*TQ +                &amp;
-                     (bup1s0t2 + bup1s0t3*TQ)*T2) +           &amp;
-                  p2(k)*(bup2s0t0 + bup2s0t1*TQ + bup2s0t2*T2) + &amp;
-                  SQ*(WORK3 + WORK4)
-
-      DENOMK = 1.0/(BULK_MOD - p(k))
-
-      rho(k,iCell) = (unt0 + RHO_S)*BULK_MOD*DENOMK
-
-    end do
-  end do
-
-   deallocate(pRefEOS,p,p2)
-
-   call timer_stop(&quot;equation_of_state_jm&quot;)
-
-   end subroutine ocn_equation_of_state_jm_rho!}}}
-
-!***********************************************************************
-!
-!  routine ocn_equation_of_state_jm_init
-!
-!&gt; \brief   Initializes ocean momentum horizontal mixing quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    28 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  horizontal velocity mixing in the ocean. Since a variety of 
-!&gt;  parameterizations are available, this routine primarily calls the
-!&gt;  individual init routines for each parameterization. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_equation_of_state_jm_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err
-
-      err = 0
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_equation_of_state_jm_init!}}}
-
-!***********************************************************************
-
-end module ocn_equation_of_state_jm
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state_jm.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_equation_of_state_jm.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state_jm.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state_jm.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,355 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_equation_of_state_jm
+!
+!&gt; \brief MPAS ocean equation of state driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   28 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for calling
+!&gt;  the equation of state.
+!
+!-----------------------------------------------------------------------
+
+module ocn_equation_of_state_jm
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_equation_of_state_jm_rho, &amp;
+             ocn_equation_of_state_jm_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_equation_of_state_jm_rho
+!
+!&gt; \brief   Calls JM equation of state
+!&gt; \author  Doug Jacobsen
+!&gt; \date    28 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine uses a JM equation of state to update the density
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_equation_of_state_jm_rho(grid, k_displaced, displacement_type, indexT, indexS, tracers, rho, err)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !  This module contains routines necessary for computing the density
+   !  from model temperature and salinity using an equation of state.
+   !
+   !  The UNESCO equation of state computed using the
+   !  potential-temperature-based bulk modulus from Jackett and
+   !  McDougall, JTECH, Vol.12, pp 381-389, April, 1995.
+   !
+   ! Input: grid - grid metadata
+   !        s - state: tracers
+   !        k_displaced 
+
+   !  If k_displaced&lt;=0, density is returned with no displaced
+   !  If k_displaced&gt;0,the density returned is that for a parcel
+   !  adiabatically displaced from its original level to level 
+   !  k_displaced.
+
+   !
+   ! Output: s - state: computed density
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (mesh_type), intent(in) :: grid
+      integer :: k_displaced, indexT, indexS
+      character(len=8), intent(in) :: displacement_type
+      integer, intent(out) :: err
+
+      type (dm_info) :: dminfo
+      integer :: iEdge, iCell, iVertex, k
+
+      integer :: nCells, nEdges, nVertices, nVertLevels
+
+
+      real (kind=RKIND), dimension(:), pointer :: &amp;
+        zMidZLevel, pRefEOS
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+        rho
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
+
+      integer, dimension(:), pointer :: maxLevelCell
+
+   real (kind=RKIND) :: &amp;
+      TQ,SQ,             &amp;! adjusted T,S
+      BULK_MOD,          &amp;! Bulk modulus
+      RHO_S,             &amp;! density at the surface
+      DRDT0,             &amp;! d(density)/d(temperature), for surface
+      DRDS0,             &amp;! d(density)/d(salinity   ), for surface
+      DKDT,              &amp;! d(bulk modulus)/d(pot. temp.)
+      DKDS,              &amp;! d(bulk modulus)/d(salinity  )
+      SQR,DENOMK,        &amp;! work arrays
+      WORK1, WORK2, WORK3, WORK4, T2, depth
+
+   real (kind=RKIND) :: &amp; 
+      tmin, tmax,        &amp;! valid temperature range for level k
+      smin, smax          ! valid salinity    range for level k
+
+   real (kind=RKIND), dimension(:), allocatable :: &amp;
+      p, p2 ! temporary pressure scalars
+
+!-----------------------------------------------------------------------
+!
+!  UNESCO EOS constants and JMcD bulk modulus constants
+!
+!-----------------------------------------------------------------------
+
+   !*** for density of fresh water (standard UNESCO)
+
+   real (kind=RKIND), parameter ::              &amp;
+      unt0 =   999.842594,           &amp;
+      unt1 =  6.793952e-2,           &amp;
+      unt2 = -9.095290e-3,           &amp;
+      unt3 =  1.001685e-4,           &amp;
+      unt4 = -1.120083e-6,           &amp;
+      unt5 =  6.536332e-9
+
+   !*** for dependence of surface density on salinity (UNESCO)
+
+   real (kind=RKIND), parameter ::              &amp;
+      uns1t0 =  0.824493 ,           &amp;
+      uns1t1 = -4.0899e-3,           &amp;
+      uns1t2 =  7.6438e-5,           &amp;
+      uns1t3 = -8.2467e-7,           &amp;
+      uns1t4 =  5.3875e-9,           &amp;
+      unsqt0 = -5.72466e-3,          &amp;
+      unsqt1 =  1.0227e-4,           &amp;
+      unsqt2 = -1.6546e-6,           &amp;
+      uns2t0 =  4.8314e-4
+
+   !*** from Table A1 of Jackett and McDougall
+
+   real (kind=RKIND), parameter ::              &amp;
+      bup0s0t0 =  1.965933e+4,       &amp;
+      bup0s0t1 =  1.444304e+2,       &amp;
+      bup0s0t2 = -1.706103   ,       &amp;
+      bup0s0t3 =  9.648704e-3,       &amp;
+      bup0s0t4 = -4.190253e-5
+
+   real (kind=RKIND), parameter ::              &amp;
+      bup0s1t0 =  5.284855e+1,       &amp;
+      bup0s1t1 = -3.101089e-1,       &amp;
+      bup0s1t2 =  6.283263e-3,       &amp;
+      bup0s1t3 = -5.084188e-5
+
+   real (kind=RKIND), parameter ::              &amp;
+      bup0sqt0 =  3.886640e-1,       &amp;
+      bup0sqt1 =  9.085835e-3,       &amp;
+      bup0sqt2 = -4.619924e-4
+
+   real (kind=RKIND), parameter ::              &amp;
+      bup1s0t0 =  3.186519   ,       &amp;
+      bup1s0t1 =  2.212276e-2,       &amp;
+      bup1s0t2 = -2.984642e-4,       &amp;
+      bup1s0t3 =  1.956415e-6 
+
+   real (kind=RKIND), parameter ::              &amp;
+      bup1s1t0 =  6.704388e-3,       &amp;
+      bup1s1t1 = -1.847318e-4,       &amp;
+      bup1s1t2 =  2.059331e-7,       &amp;
+      bup1sqt0 =  1.480266e-4 
+
+   real (kind=RKIND), parameter ::              &amp;
+      bup2s0t0 =  2.102898e-4,       &amp;
+      bup2s0t1 = -1.202016e-5,       &amp;
+      bup2s0t2 =  1.394680e-7,       &amp;
+      bup2s1t0 = -2.040237e-6,       &amp;
+      bup2s1t1 =  6.128773e-8,       &amp;
+      bup2s1t2 =  6.207323e-10
+
+   integer :: k_test, k_ref
+
+      err = 0
+
+      call mpas_timer_start(&quot;equation_of_state_jm&quot;)
+
+      nCells      = grid % nCells
+      maxLevelCell      =&gt; grid % maxLevelCell % array
+      nVertLevels = grid % nVertLevels
+      zMidZLevel        =&gt; grid % zMidZLevel % array
+
+
+!  Jackett and McDougall
+      tmin = -2.0  ! valid pot. temp. range
+      tmax = 40.0 
+      smin =  0.0  ! valid salinity, in psu   
+      smax = 42.0 
+
+      ! This could be put in a startup routine.
+      ! Note I am using zMidZlevel, so pressure on top level does
+      ! not include SSH contribution.  I am not sure if that matters.
+
+!  This function computes pressure in bars from depth in meters
+!  using a mean density derived from depth-dependent global 
+!  average temperatures and salinities from Levitus 1994, and 
+!  integrating using hydrostatic balance.
+
+      allocate(pRefEOS(nVertLevels),p(nVertLevels),p2(nVertLevels))
+      do k = 1,nVertLevels
+        depth = -zMidZLevel(k)
+        pRefEOS(k) = 0.059808*(exp(-0.025*depth) - 1.0) &amp;
+            + 0.100766*depth + 2.28405e-7*depth**2
+      enddo
+
+   !  If k_displaced=0, in-situ density is returned (no displacement)
+   !  If k_displaced/=0, potential density is returned
+
+   !  if displacement_type = 'relative', potential density is calculated
+   !     referenced to level k + k_displaced
+   !  if displacement_type = 'absolute', potential density is calculated
+   !     referenced to level k_displaced for all k
+   !  NOTE: k_displaced = 0 or &gt; nVertLevels is incompatible with 'absolute'
+   !     so abort if necessary
+
+   if (displacement_type == 'absolute' .and.   &amp;
+       (k_displaced &lt;= 0 .or. k_displaced &gt; nVertLevels) ) then
+      write(0,*) 'Abort: In equation_of_state_jm', &amp;
+         ' k_displaced must be between 1 and nVertLevels for ', &amp;
+         'displacement_type = absolute'
+      call mpas_dmpar_abort(dminfo)
+   endif
+
+   if (k_displaced == 0) then
+      do k=1,nVertLevels
+         p(k)   = pRefEOS(k)
+         p2(k)  = p(k)*p(k)
+      enddo
+   else ! k_displaced /= 0
+      do k=1,nVertLevels
+         if (displacement_type == 'relative') then
+            k_test = min(k + k_displaced, nVertLevels)
+            k_ref  = max(k_test, 1)
+         else
+            k_test = min(k_displaced, nVertLevels)
+            k_ref  = max(k_test, 1)
+         endif
+         p(k)   = pRefEOS(k_ref)
+         p2(k)  = p(k)*p(k)
+      enddo
+   endif
+
+  do iCell=1,nCells
+    do k=1,maxLevelCell(iCell)
+
+      SQ  = max(min(tracers(indexS,k,iCell),smax),smin)
+      TQ  = max(min(tracers(indexT,k,iCell),tmax),tmin)
+
+      SQR = sqrt(SQ)
+      T2  = TQ*TQ
+
+      !***
+      !*** first calculate surface (p=0) values from UNESCO eqns.
+      !***
+
+      WORK1 = uns1t0 + uns1t1*TQ + &amp; 
+             (uns1t2 + uns1t3*TQ + uns1t4*T2)*T2
+      WORK2 = SQR*(unsqt0 + unsqt1*TQ + unsqt2*T2)
+
+      RHO_S = unt1*TQ + (unt2 + unt3*TQ + (unt4 + unt5*TQ)*T2)*T2 &amp;
+                      + (uns2t0*SQ + WORK1 + WORK2)*SQ
+
+      !***
+      !*** now calculate bulk modulus at pressure p from 
+      !*** Jackett and McDougall formula
+      !***
+
+      WORK3 = bup0s1t0 + bup0s1t1*TQ +                    &amp;
+             (bup0s1t2 + bup0s1t3*TQ)*T2 +                &amp;
+              p(k) *(bup1s1t0 + bup1s1t1*TQ + bup1s1t2*T2) + &amp;
+              p2(k)*(bup2s1t0 + bup2s1t1*TQ + bup2s1t2*T2)
+      WORK4 = SQR*(bup0sqt0 + bup0sqt1*TQ + bup0sqt2*T2 + &amp;
+                   bup1sqt0*p(k))
+
+      BULK_MOD  = bup0s0t0 + bup0s0t1*TQ +                    &amp;
+                  (bup0s0t2 + bup0s0t3*TQ + bup0s0t4*T2)*T2 + &amp;
+                  p(k) *(bup1s0t0 + bup1s0t1*TQ +                &amp;
+                     (bup1s0t2 + bup1s0t3*TQ)*T2) +           &amp;
+                  p2(k)*(bup2s0t0 + bup2s0t1*TQ + bup2s0t2*T2) + &amp;
+                  SQ*(WORK3 + WORK4)
+
+      DENOMK = 1.0/(BULK_MOD - p(k))
+
+      rho(k,iCell) = (unt0 + RHO_S)*BULK_MOD*DENOMK
+
+    end do
+  end do
+
+   deallocate(pRefEOS,p,p2)
+
+   call mpas_timer_stop(&quot;equation_of_state_jm&quot;)
+
+   end subroutine ocn_equation_of_state_jm_rho!}}}
+
+!***********************************************************************
+!
+!  routine ocn_equation_of_state_jm_init
+!
+!&gt; \brief   Initializes ocean momentum horizontal mixing quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    28 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  horizontal velocity mixing in the ocean. Since a variety of 
+!&gt;  parameterizations are available, this routine primarily calls the
+!&gt;  individual init routines for each parameterization. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_equation_of_state_jm_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err
+
+      err = 0
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_equation_of_state_jm_init!}}}
+
+!***********************************************************************
+
+end module ocn_equation_of_state_jm
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state_linear.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_equation_of_state_linear.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state_linear.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,151 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_equation_of_state_linear
-!
-!&gt; \brief MPAS ocean equation of state driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   28 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for calling
-!&gt;  the equation of state.
-!
-!-----------------------------------------------------------------------
-
-module ocn_equation_of_state_linear
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_equation_of_state_linear_rho, &amp;
-             ocn_equation_of_state_linear_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_equation_of_state_linear_rho
-!
-!&gt; \brief   Calls equation of state
-!&gt; \author  Doug Jacobsen
-!&gt; \date    28 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine uses a linear equation of state to update the density
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_equation_of_state_linear_rho(grid, indexT, indexS, tracers, rho, err)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !  This module contains routines necessary for computing the density
-   !  from model temperature and salinity using an equation of state.
-   !
-   ! Input: grid - grid metadata
-   !        s - state: tracers
-   !        k_displaced 
-   !  If k_displaced&lt;=0, state % rho is returned with no displaced
-   !  If k_displaced&gt;0,the state % rhoDisplaced is returned, and is for
-   !  a parcel adiabatically displaced from its original level to level 
-   !  k_displaced.  This does not effect the linear EOS.
-   !
-   ! Output: s - state: computed density
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      implicit none
-
-      type (mesh_type), intent(in) :: grid
-      real (kind=RKIND), dimension(:,:), intent(inout) :: rho
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
-      integer, intent(in) :: indexT, indexS
-      integer, intent(out) :: err
-
-      integer, dimension(:), pointer :: maxLevelCell
-      integer :: nCells, iCell, k
-      type (dm_info) :: dminfo
-
-      call timer_start(&quot;ocn_equation_of_state_linear&quot;)
-
-      maxLevelCell      =&gt; grid % maxLevelCell % array
-      nCells      = grid % nCells
-
-      err = 0
-
-      do iCell=1,nCells
-         do k=1,maxLevelCell(iCell)
-            ! Linear equation of state
-            rho(k,iCell) = 1000.0*(  1.0 &amp;
-               - 2.5e-4*tracers(indexT,k,iCell) &amp;
-               + 7.6e-4*tracers(indexS,k,iCell))
-         end do
-      end do
-
-      call timer_stop(&quot;ocn_equation_of_state_linear&quot;)
-
-   end subroutine ocn_equation_of_state_linear_rho!}}}
-
-!***********************************************************************
-!
-!  routine ocn_equation_of_state_linear_init
-!
-!&gt; \brief   Initializes ocean momentum horizontal mixing quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    28 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  horizontal velocity mixing in the ocean. Since a variety of 
-!&gt;  parameterizations are available, this routine primarily calls the
-!&gt;  individual init routines for each parameterization. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_equation_of_state_linear_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err
-
-      integer :: err1, err2
-
-      err = 0
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_equation_of_state_linear_init!}}}
-
-!***********************************************************************
-
-end module ocn_equation_of_state_linear
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state_linear.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_equation_of_state_linear.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state_linear.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_equation_of_state_linear.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,151 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_equation_of_state_linear
+!
+!&gt; \brief MPAS ocean equation of state driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   28 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for calling
+!&gt;  the equation of state.
+!
+!-----------------------------------------------------------------------
+
+module ocn_equation_of_state_linear
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_equation_of_state_linear_rho, &amp;
+             ocn_equation_of_state_linear_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_equation_of_state_linear_rho
+!
+!&gt; \brief   Calls equation of state
+!&gt; \author  Doug Jacobsen
+!&gt; \date    28 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine uses a linear equation of state to update the density
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_equation_of_state_linear_rho(grid, indexT, indexS, tracers, rho, err)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !  This module contains routines necessary for computing the density
+   !  from model temperature and salinity using an equation of state.
+   !
+   ! Input: grid - grid metadata
+   !        s - state: tracers
+   !        k_displaced 
+   !  If k_displaced&lt;=0, state % rho is returned with no displaced
+   !  If k_displaced&gt;0,the state % rhoDisplaced is returned, and is for
+   !  a parcel adiabatically displaced from its original level to level 
+   !  k_displaced.  This does not effect the linear EOS.
+   !
+   ! Output: s - state: computed density
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      implicit none
+
+      type (mesh_type), intent(in) :: grid
+      real (kind=RKIND), dimension(:,:), intent(inout) :: rho
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
+      integer, intent(in) :: indexT, indexS
+      integer, intent(out) :: err
+
+      integer, dimension(:), pointer :: maxLevelCell
+      integer :: nCells, iCell, k
+      type (dm_info) :: dminfo
+
+      call mpas_timer_start(&quot;ocn_equation_of_state_linear&quot;)
+
+      maxLevelCell      =&gt; grid % maxLevelCell % array
+      nCells      = grid % nCells
+
+      err = 0
+
+      do iCell=1,nCells
+         do k=1,maxLevelCell(iCell)
+            ! Linear equation of state
+            rho(k,iCell) = 1000.0*(  1.0 &amp;
+               - 2.5e-4*tracers(indexT,k,iCell) &amp;
+               + 7.6e-4*tracers(indexS,k,iCell))
+         end do
+      end do
+
+      call mpas_timer_stop(&quot;ocn_equation_of_state_linear&quot;)
+
+   end subroutine ocn_equation_of_state_linear_rho!}}}
+
+!***********************************************************************
+!
+!  routine ocn_equation_of_state_linear_init
+!
+!&gt; \brief   Initializes ocean momentum horizontal mixing quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    28 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  horizontal velocity mixing in the ocean. Since a variety of 
+!&gt;  parameterizations are available, this routine primarily calls the
+!&gt;  individual init routines for each parameterization. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_equation_of_state_linear_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err
+
+      integer :: err1, err2
+
+      err = 0
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_equation_of_state_linear_init!}}}
+
+!***********************************************************************
+
+end module ocn_equation_of_state_linear
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_global_diagnostics.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_global_diagnostics.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_global_diagnostics.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,618 +0,0 @@
-module global_diagnostics
-
-   use grid_types
-   use configure
-   use constants
-   use dmpar
-
-   implicit none
-   save
-   public
-
-   contains
-
-   subroutine computeGlobalDiagnostics(dminfo, state, grid, timeIndex, dt)
-
-      ! Note: this routine assumes that there is only one block per processor. No looping
-      ! is preformed over blocks.
-      ! dminfo is the domain info needed for global communication
-      ! state contains the state variables needed to compute global diagnostics
-      ! grid conains the meta data about the grid
-      ! timeIndex is the current time step counter
-      ! dt is the duration of each time step
-
-      ! Sums of variables at vertices are not weighted by thickness (since h is not known at
-      !    vertices as it is at cell centers and at edges).
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      type (state_type), intent(inout) :: state
-      type (mesh_type), intent(in) :: grid
-      integer, intent(in) :: timeIndex
-      real (kind=RKIND), intent(in) :: dt
-
-      integer :: nVertLevels, nCellsSolve, nEdgesSolve, nVerticesSolve, nCellsGlobal, nEdgesGlobal, nVerticesGlobal, iTracer
-
-      real (kind=RKIND) ::  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, &amp;
-         pv_cell, gradPVn, gradPVt, pressure, MontPot, wTop, rho, tracerTemp
-      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
-
-      real (kind=RKIND) :: volumeCellGlobal, volumeEdgeGlobal, CFLNumberGlobal
-      real (kind=RKIND) ::  localCFL, localSum
-      integer :: elementIndex, variableIndex, nVariables, nSums, nMaxes, nMins
-      integer :: timeLevel,k,i, num_tracers
-
-      integer, parameter :: kMaxVariables = 1024 ! this must be a little more than double the number of variables to be reduced
-
-      real (kind=RKIND), dimension(kMaxVariables) :: sums, mins, maxes, averages, verticalSumMins, verticalSumMaxes, reductions
-
-      integer :: fileID
-
-      num_tracers = state % num_tracers
-
-      nVertLevels = grid % nVertLevels
-      nCellsSolve = grid % nCellsSolve
-      nEdgesSolve = grid % nEdgesSolve
-      nVerticesSolve = grid % nVerticesSolve
-
-      areaCell =&gt; grid % areaCell % array
-      dcEdge =&gt; grid % dcEdge % array
-      dvEdge =&gt; grid % dvEdge % array
-      areaTriangle =&gt; grid % areaTriangle % array
-      allocate(areaEdge(1:nEdgesSolve))
-      areaEdge = dcEdge(1:nEdgesSolve)*dvEdge(1:nEdgesSolve)
-
-      h =&gt; state % h % array
-      u =&gt; state % u % array
-      rho =&gt; state % rho % array
-      tracers =&gt; state % tracers % array
-      v =&gt; state % v % array
-      wTop =&gt; state % wTop % array
-      h_edge =&gt; state % h_edge % array
-      circulation =&gt; state % circulation % array
-      vorticity =&gt; state % vorticity % array
-      ke =&gt; state % ke % array
-      pv_edge =&gt; state % pv_edge % array
-      pv_vertex =&gt; state % pv_vertex % array
-      pv_cell =&gt; state % pv_cell % array
-      gradPVn =&gt; state % gradPVn % array
-      gradPVt =&gt; state % gradPVt % array
-      MontPot =&gt; state % MontPot % array
-      pressure =&gt; state % pressure % array
-
-      variableIndex = 0
-      ! h
-      variableIndex = variableIndex + 1
-      call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
-        sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
-
-      ! u
-      variableIndex = variableIndex + 1
-      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &amp;
-        u(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
-        verticalSumMaxes(variableIndex))
-
-      ! v
-      variableIndex = variableIndex + 1
-      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &amp;
-        v(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
-        verticalSumMaxes(variableIndex))
-
-      ! h_edge
-      variableIndex = variableIndex + 1
-      call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &amp;
-        sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
-
-      ! circulation
-      variableIndex = variableIndex + 1
-      call computeFieldLocalStats(dminfo, nVertLevels, nVerticesSolve, circulation(:,1:nVerticesSolve), &amp;
-        sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
-
-      ! vorticity
-      variableIndex = variableIndex + 1
-      call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nVerticesSolve, areaTriangle(1:nVerticesSolve), &amp;
-        vorticity(:,1:nVerticesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), &amp;
-        verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
-
-      ! ke
-      variableIndex = variableIndex + 1
-      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
-        ke(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
-        verticalSumMaxes(variableIndex))
-
-      ! pv_edge
-      variableIndex = variableIndex + 1
-      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &amp;
-        pv_edge(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
-        verticalSumMaxes(variableIndex))
-
-      ! pv_vertex
-      variableIndex = variableIndex + 1
-      call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nVerticesSolve, areaTriangle(1:nVerticesSolve), &amp;
-        pv_vertex(:,1:nVerticesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), &amp;
-        verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
-
-      ! pv_cell
-      variableIndex = variableIndex + 1
-      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
-        pv_cell(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
-        verticalSumMaxes(variableIndex))
-
-      ! gradPVn
-      variableIndex = variableIndex + 1
-      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &amp;
-        gradPVn(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
-        verticalSumMaxes(variableIndex))
-
-      ! gradPVt
-      variableIndex = variableIndex + 1
-      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &amp;
-        gradPVt(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
-        verticalSumMaxes(variableIndex))
-
-      ! pressure
-      variableIndex = variableIndex + 1
-      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
-        pressure(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
-        verticalSumMaxes(variableIndex))
-
-      ! MontPot
-      variableIndex = variableIndex + 1
-      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
-        MontPot(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
-        verticalSumMaxes(variableIndex))
-
-      ! wTop vertical velocity
-      variableIndex = variableIndex + 1
-      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels+1, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
-        wTop(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
-        verticalSumMaxes(variableIndex))
-
-      ! Tracers
-      allocate(tracerTemp(nVertLevels,nCellsSolve))
-      do iTracer=1,num_tracers
-        variableIndex = variableIndex + 1
-        tracerTemp = Tracers(iTracer,:,1:nCellsSolve)
-        call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
-          tracerTemp, sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
-          verticalSumMaxes(variableIndex))
-      enddo
-      deallocate(tracerTemp)
-
-      nVariables = variableIndex
-      nSums = nVariables
-      nMins = nVariables
-      nMaxes = nVariables
-
-      nSums = nSums + 1
-      sums(nSums) = sum(areaCell(1:nCellsSolve))
-
-      nSums = nSums + 1
-      sums(nSums) = sum(dcEdge(1:nEdgesSolve)*dvEdge(1:nEdgesSolve))
-
-      nSums = nSums + 1
-      sums(nSums) = sum(areaTriangle(1:nVerticesSolve))
-
-      nSums = nSums + 1
-      sums(nSums) = nCellsSolve
-
-      nSums = nSums + 1
-      sums(nSums) = nEdgesSolve
-
-      nSums = nSums + 1
-      sums(nSums) = nVerticesSolve
-
-      localCFL = 0.0
-      do elementIndex = 1,nEdgesSolve
-         localCFL = max(localCFL, maxval(dt*u(:,elementIndex)/dcEdge(elementIndex)))
-      end do
-      nMaxes = nMaxes + 1
-      maxes(nMaxes) = localCFL
-
-      mins(nMins+1:nMins+nVariables) = verticalSumMins(1:nVariables)
-      nMins = nMins + nVariables
-      maxes(nMaxes+1:nMaxes+nVariables) = verticalSumMaxes(1:nVariables)
-      nMaxes = nMaxes + nVariables
-
-      ! global reduction of the 5 arrays (packed into 3 to minimize global communication)
-      call dmpar_sum_real_array(dminfo, nSums, sums(1:nSums), reductions(1:nSums))
-      sums(1:nVariables) = reductions(1:nVariables)
-      areaCellGlobal = reductions(nVariables+1)
-      areaEdgeGlobal = reductions(nVariables+2)
-      areaTriangleGlobal = reductions(nVariables+3)
-      nCellsGlobal = int(reductions(nVariables+4))
-      nEdgesGlobal = int(reductions(nVariables+5))
-      nVerticesGlobal = int(reductions(nVariables+6))
-
-      call dmpar_min_real_array(dminfo, nMins, mins(1:nMins), reductions(1:nMins))
-      mins(1:nVariables) = reductions(1:nVariables)
-      verticalSumMins(1:nVariables) = reductions(nMins-nVariables+1:nMins)
-
-      call dmpar_max_real_array(dminfo, nMaxes, maxes(1:nMaxes), reductions(1:nMaxes))
-      maxes(1:nVariables) = reductions(1:nVariables)
-      CFLNumberGlobal = reductions(nVariables+1)
-      verticalSumMaxes(1:nVariables) = reductions(nMaxes-nVariables+1:nMaxes)
-
-      volumeCellGlobal = sums(1)
-      volumeEdgeGlobal = sums(4)
-      ! compute the averages (slightly different depending on how the sum was computed)
-      variableIndex = 0
-      ! h
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/(areaCellGlobal*nVertLevels)
-
-      ! u
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
-
-      ! v
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
-
-      ! h_edge
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/(areaEdgeGlobal*nVertLevels)
-
-      ! circulation
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/(nVerticesGlobal*nVertLevels)
-
-      ! vorticity
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/(areaTriangleGlobal*nVertLevels)
-
-      ! ke
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
-
-      ! pv_edge
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
-
-      ! pv_vertex
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/(areaTriangleGlobal*nVertLevels)
-
-      ! pv_cell
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
-
-      ! gradPVn
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
-
-      ! gradPVt
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
-
-      ! pressure
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
-
-      ! MontPot
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
-
-      ! wTop vertical velocity
-      variableIndex = variableIndex + 1
-      averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
-
-      ! Tracers
-      do iTracer=1,num_tracers
-        variableIndex = variableIndex + 1
-        averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
-      enddo
-
-      ! write out the data to files
-      if (dminfo % my_proc_id == IO_NODE) then
-         fileID = getFreeUnit()
-         open(fileID,file='stats_min.txt',ACCESS='append')
-            write (fileID,'(100es24.16)') mins(1:nVariables)
-         close (fileID)
-         open(fileID,file='stats_max.txt',ACCESS='append')
-            write (fileID,'(100es24.16)') maxes(1:nVariables)
-         close (fileID)
-         open(fileID,file='stats_sum.txt',ACCESS='append')
-            write (fileID,'(100es24.16)') sums(1:nVariables)
-         close (fileID)
-         open(fileID,file='stats_avg.txt',ACCESS='append')
-            write (fileID,'(100es24.16)') averages(1:nVariables)
-         close (fileID)
-         open(fileID,file='stats_time.txt',ACCESS='append')
-            write (fileID,'(i5,10x,a,100es24.16)') timeIndex, &amp;
-               state % xtime % scalar, dt, &amp;
-               CFLNumberGlobal
-         close (fileID)
-         open(fileID,file='stats_colmin.txt',ACCESS='append')
-            write (fileID,'(100es24.16)') verticalSumMins(1:nVariables)
-         close (fileID)
-         open(fileID,file='stats_colmax.txt',ACCESS='append')
-            write (fileID,'(100es24.16)') verticalSumMaxes(1:nVariables)
-         close (fileID)
-      end if
-
-      state % areaCellGlobal % scalar = areaCellGlobal
-      state % areaEdgeGlobal % scalar = areaEdgeGlobal
-      state % areaTriangleGlobal % scalar = areaTriangleGlobal
-
-      state % volumeCellGlobal % scalar = volumeCellGlobal
-      state % volumeEdgeGlobal % scalar = volumeEdgeGlobal
-      state % CFLNumberGlobal % scalar = CFLNumberGlobal
-      deallocate(areaEdge)
-
-   end subroutine computeGlobalDiagnostics
-
-   integer function getFreeUnit()
-      implicit none
-
-      integer :: index
-      logical :: isOpened
-
-      getFreeUnit = 0
-      do index = 1,99
-         if((index /= 5) .and. (index /= 6)) then
-            inquire(unit = index, opened = isOpened)
-            if( .not. isOpened) then
-               getFreeUnit = index
-               return
-            end if
-         end if
-      end do
-   end function getFreeUnit
-
-   subroutine computeFieldLocalStats(dminfo, nVertLevels, nElements, field, localSum, localMin, localMax, localVertSumMin, &amp;
-      localVertSumMax)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: localSum, localMin, localMax, localVertSumMin, &amp;
-      localVertSumMax
-
-      localSum = sum(field)
-      localMin = minval(field)
-      localMax = maxval(field)
-      localVertSumMin = minval(sum(field,1))
-      localVertSumMax = maxval(sum(field,1))
-
-   end subroutine computeFieldLocalStats
-
-   subroutine computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nElements, areas, field, localSum, localMin, &amp;
-      localMax, localVertSumMin, localVertSumMax)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nElements), intent(in) :: areas
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: localSum, localMin, localMax, localVertSumMin, &amp;
-      localVertSumMax
-
-      integer :: elementIndex
-
-      localSum = 0.0
-      do elementIndex = 1, nElements
-        localSum = localSum + areas(elementIndex) * sum(field(:,elementIndex))
-      end do
-
-      localMin = minval(field)
-      localMax = maxval(field)
-      localVertSumMin = minval(sum(field,1))
-      localVertSumMax = maxval(sum(field,1))
-
-   end subroutine computeFieldAreaWeightedLocalStats
-
-   subroutine computeFieldThicknessWeightedLocalStats(dminfo, nVertLevels, nElements, h, field, &amp;
-      localSum, localMin, localMax, localVertSumMin, localVertSumMax)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: h
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: localSum, localMin, localMax, localVertSumMin, &amp;
-      localVertSumMax
-
-      real (kind=RKIND), dimension(nVertLevels, nElements) :: hTimesField
-
-      integer :: elementIndex
-
-      localSum = sum(h*field)
-      localMin = minval(field)
-      localMax = maxval(field)
-      localVertSumMin = minval(sum(h*field,1))
-      localVertSumMax = maxval(sum(h*field,1))
-
-   end subroutine computeFieldThicknessWeightedLocalStats
-
-   subroutine computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nElements, areas, h, field, &amp;
-      localSum, localMin, localMax, localVertSumMin, localVertSumMax)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nElements), intent(in) :: areas
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: h
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: localSum, localMin, localMax, localVertSumMin, &amp;
-      localVertSumMax
-
-      real (kind=RKIND), dimension(nVertLevels, nElements) :: hTimesField
-
-      integer :: elementIndex
-
-      localSum = 0.0
-      do elementIndex = 1, nElements
-        localSum = localSum + areas(elementIndex) * sum(h(:,elementIndex)*field(:,elementIndex))
-      end do
-
-      localMin = minval(field)
-      localMax = maxval(field)
-      localVertSumMin = minval(sum(h*field,1))
-      localVertSumMax = maxval(sum(h*field,1))
-
-   end subroutine computeFieldVolumeWeightedLocalStats
-
-
-   subroutine computeGlobalSum(dminfo, nVertLevels, nElements, field, globalSum)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: globalSum
-
-      real (kind=RKIND) :: localSum
-
-      localSum = sum(field)
-      call dmpar_sum_real(dminfo, localSum, globalSum)
-
-   end subroutine computeGlobalSum
-
-   subroutine computeAreaWeightedGlobalSum(dminfo, nVertLevels, nElements, areas, field, globalSum)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nElements), intent(in) :: areas
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: globalSum
-      
-      integer :: elementIndex
-      real (kind=RKIND) :: localSum
-
-      localSum = 0.
-      do elementIndex = 1, nElements
-        localSum = localSum + areas(elementIndex) * sum(field(:,elementIndex))
-      end do
-   
-      call dmpar_sum_real(dminfo, localSum, globalSum)
-       
-   end subroutine computeAreaWeightedGlobalSum
-
-   subroutine computeVolumeWeightedGlobalSum(dminfo, nVertLevels, nElements, areas, h, field, globalSum)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nElements), intent(in) :: areas
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: h
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: globalSum
-
-      real (kind=RKIND), dimension(nVertLevels, nElements) :: hTimesField
-
-      hTimesField = h*field
-
-      call computeAreaWeightedGlobalSum(dminfo, nVertLevels, nElements, areas, hTimesField, globalSum)
-
-   end subroutine computeVolumeWeightedGlobalSum
-
-   subroutine computeGlobalMin(dminfo, nVertLevels, nElements, field, globalMin)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: globalMin
-
-      real (kind=RKIND) :: localMin
-
-      localMin = minval(field)
-      call dmpar_min_real(dminfo, localMin, globalMin)
-
-   end subroutine computeGlobalMin
-
-   subroutine computeGlobalMax(dminfo, nVertLevels, nElements, field, globalMax)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: globalMax
-
-      real (kind=RKIND) :: localMax
-
-      localMax = maxval(field)
-      call dmpar_max_real(dminfo, localMax, globalMax)
-
-   end subroutine computeGlobalMax
-
-   subroutine computeGlobalVertSumHorizMin(dminfo, nVertLevels, nElements, field, globalMin)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: globalMin
-
-      real (kind=RKIND) :: localMin
-
-      localMin = minval(sum(field,1))
-      call dmpar_min_real(dminfo, localMin, globalMin)
-
-   end subroutine computeGlobalVertSumHorizMin
-
-   subroutine computeGlobalVertSumHorizMax(dminfo, nVertLevels, nElements, field, globalMax)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: globalMax
-
-      real (kind=RKIND) :: localMax
-
-      localMax = maxval(sum(field,1))
-      call dmpar_max_real(dminfo, localMax, globalMax)
-
-   end subroutine computeGlobalVertSumHorizMax
-
-   subroutine computeGlobalVertThicknessWeightedSumHorizMin(dminfo, nVertLevels, nElements, h, field, globalMin)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: h, field
-      real (kind=RKIND), intent(out) :: globalMin
-
-      real (kind=RKIND) :: localMin
-
-      localMin = minval(sum(h*field,1))
-      call dmpar_min_real(dminfo, localMin, globalMin)
-
-   end subroutine computeGlobalVertThicknessWeightedSumHorizMin
-
-   subroutine computeGlobalVertThicknessWeightedSumHorizMax(dminfo, nVertLevels, nElements, h, field, globalMax)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: h, field
-      real (kind=RKIND), intent(out) :: globalMax
-
-      real (kind=RKIND) :: localMax
-
-      localMax = maxval(sum(h*field,1))
-      call dmpar_max_real(dminfo, localMax, globalMax)
-
-   end subroutine computeGlobalVertThicknessWeightedSumHorizMax
-
-end module global_diagnostics

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_global_diagnostics.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_global_diagnostics.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_global_diagnostics.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_global_diagnostics.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,618 @@
+module global_diagnostics
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+   use mpas_dmpar
+
+   implicit none
+   save
+   public
+
+   contains
+
+   subroutine computeGlobalDiagnostics(dminfo, state, grid, timeIndex, dt)
+
+      ! Note: this routine assumes that there is only one block per processor. No looping
+      ! is preformed over blocks.
+      ! dminfo is the domain info needed for global communication
+      ! state contains the state variables needed to compute global diagnostics
+      ! grid conains the meta data about the grid
+      ! timeIndex is the current time step counter
+      ! dt is the duration of each time step
+
+      ! Sums of variables at vertices are not weighted by thickness (since h is not known at
+      !    vertices as it is at cell centers and at edges).
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      type (state_type), intent(inout) :: state
+      type (mesh_type), intent(in) :: grid
+      integer, intent(in) :: timeIndex
+      real (kind=RKIND), intent(in) :: dt
+
+      integer :: nVertLevels, nCellsSolve, nEdgesSolve, nVerticesSolve, nCellsGlobal, nEdgesGlobal, nVerticesGlobal, iTracer
+
+      real (kind=RKIND) ::  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, &amp;
+         pv_cell, gradPVn, gradPVt, pressure, MontPot, wTop, rho, tracerTemp
+      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+
+      real (kind=RKIND) :: volumeCellGlobal, volumeEdgeGlobal, CFLNumberGlobal
+      real (kind=RKIND) ::  localCFL, localSum
+      integer :: elementIndex, variableIndex, nVariables, nSums, nMaxes, nMins
+      integer :: timeLevel,k,i, num_tracers
+
+      integer, parameter :: kMaxVariables = 1024 ! this must be a little more than double the number of variables to be reduced
+
+      real (kind=RKIND), dimension(kMaxVariables) :: sums, mins, maxes, averages, verticalSumMins, verticalSumMaxes, reductions
+
+      integer :: fileID
+
+      num_tracers = state % num_tracers
+
+      nVertLevels = grid % nVertLevels
+      nCellsSolve = grid % nCellsSolve
+      nEdgesSolve = grid % nEdgesSolve
+      nVerticesSolve = grid % nVerticesSolve
+
+      areaCell =&gt; grid % areaCell % array
+      dcEdge =&gt; grid % dcEdge % array
+      dvEdge =&gt; grid % dvEdge % array
+      areaTriangle =&gt; grid % areaTriangle % array
+      allocate(areaEdge(1:nEdgesSolve))
+      areaEdge = dcEdge(1:nEdgesSolve)*dvEdge(1:nEdgesSolve)
+
+      h =&gt; state % h % array
+      u =&gt; state % u % array
+      rho =&gt; state % rho % array
+      tracers =&gt; state % tracers % array
+      v =&gt; state % v % array
+      wTop =&gt; state % wTop % array
+      h_edge =&gt; state % h_edge % array
+      circulation =&gt; state % circulation % array
+      vorticity =&gt; state % vorticity % array
+      ke =&gt; state % ke % array
+      pv_edge =&gt; state % pv_edge % array
+      pv_vertex =&gt; state % pv_vertex % array
+      pv_cell =&gt; state % pv_cell % array
+      gradPVn =&gt; state % gradPVn % array
+      gradPVt =&gt; state % gradPVt % array
+      MontPot =&gt; state % MontPot % array
+      pressure =&gt; state % pressure % array
+
+      variableIndex = 0
+      ! h
+      variableIndex = variableIndex + 1
+      call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
+        sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
+
+      ! u
+      variableIndex = variableIndex + 1
+      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &amp;
+        u(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
+        verticalSumMaxes(variableIndex))
+
+      ! v
+      variableIndex = variableIndex + 1
+      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &amp;
+        v(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
+        verticalSumMaxes(variableIndex))
+
+      ! h_edge
+      variableIndex = variableIndex + 1
+      call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &amp;
+        sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
+
+      ! circulation
+      variableIndex = variableIndex + 1
+      call computeFieldLocalStats(dminfo, nVertLevels, nVerticesSolve, circulation(:,1:nVerticesSolve), &amp;
+        sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
+
+      ! vorticity
+      variableIndex = variableIndex + 1
+      call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nVerticesSolve, areaTriangle(1:nVerticesSolve), &amp;
+        vorticity(:,1:nVerticesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), &amp;
+        verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
+
+      ! ke
+      variableIndex = variableIndex + 1
+      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
+        ke(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
+        verticalSumMaxes(variableIndex))
+
+      ! pv_edge
+      variableIndex = variableIndex + 1
+      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &amp;
+        pv_edge(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
+        verticalSumMaxes(variableIndex))
+
+      ! pv_vertex
+      variableIndex = variableIndex + 1
+      call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nVerticesSolve, areaTriangle(1:nVerticesSolve), &amp;
+        pv_vertex(:,1:nVerticesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), &amp;
+        verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
+
+      ! pv_cell
+      variableIndex = variableIndex + 1
+      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
+        pv_cell(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
+        verticalSumMaxes(variableIndex))
+
+      ! gradPVn
+      variableIndex = variableIndex + 1
+      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &amp;
+        gradPVn(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
+        verticalSumMaxes(variableIndex))
+
+      ! gradPVt
+      variableIndex = variableIndex + 1
+      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &amp;
+        gradPVt(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
+        verticalSumMaxes(variableIndex))
+
+      ! pressure
+      variableIndex = variableIndex + 1
+      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
+        pressure(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
+        verticalSumMaxes(variableIndex))
+
+      ! MontPot
+      variableIndex = variableIndex + 1
+      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
+        MontPot(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
+        verticalSumMaxes(variableIndex))
+
+      ! wTop vertical velocity
+      variableIndex = variableIndex + 1
+      call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels+1, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
+        wTop(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
+        verticalSumMaxes(variableIndex))
+
+      ! Tracers
+      allocate(tracerTemp(nVertLevels,nCellsSolve))
+      do iTracer=1,num_tracers
+        variableIndex = variableIndex + 1
+        tracerTemp = Tracers(iTracer,:,1:nCellsSolve)
+        call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &amp;
+          tracerTemp, sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &amp;
+          verticalSumMaxes(variableIndex))
+      enddo
+      deallocate(tracerTemp)
+
+      nVariables = variableIndex
+      nSums = nVariables
+      nMins = nVariables
+      nMaxes = nVariables
+
+      nSums = nSums + 1
+      sums(nSums) = sum(areaCell(1:nCellsSolve))
+
+      nSums = nSums + 1
+      sums(nSums) = sum(dcEdge(1:nEdgesSolve)*dvEdge(1:nEdgesSolve))
+
+      nSums = nSums + 1
+      sums(nSums) = sum(areaTriangle(1:nVerticesSolve))
+
+      nSums = nSums + 1
+      sums(nSums) = nCellsSolve
+
+      nSums = nSums + 1
+      sums(nSums) = nEdgesSolve
+
+      nSums = nSums + 1
+      sums(nSums) = nVerticesSolve
+
+      localCFL = 0.0
+      do elementIndex = 1,nEdgesSolve
+         localCFL = max(localCFL, maxval(dt*u(:,elementIndex)/dcEdge(elementIndex)))
+      end do
+      nMaxes = nMaxes + 1
+      maxes(nMaxes) = localCFL
+
+      mins(nMins+1:nMins+nVariables) = verticalSumMins(1:nVariables)
+      nMins = nMins + nVariables
+      maxes(nMaxes+1:nMaxes+nVariables) = verticalSumMaxes(1:nVariables)
+      nMaxes = nMaxes + nVariables
+
+      ! global reduction of the 5 arrays (packed into 3 to minimize global communication)
+      call mpas_dmpar_sum_real_array(dminfo, nSums, sums(1:nSums), reductions(1:nSums))
+      sums(1:nVariables) = reductions(1:nVariables)
+      areaCellGlobal = reductions(nVariables+1)
+      areaEdgeGlobal = reductions(nVariables+2)
+      areaTriangleGlobal = reductions(nVariables+3)
+      nCellsGlobal = int(reductions(nVariables+4))
+      nEdgesGlobal = int(reductions(nVariables+5))
+      nVerticesGlobal = int(reductions(nVariables+6))
+
+      call mpas_dmpar_min_real_array(dminfo, nMins, mins(1:nMins), reductions(1:nMins))
+      mins(1:nVariables) = reductions(1:nVariables)
+      verticalSumMins(1:nVariables) = reductions(nMins-nVariables+1:nMins)
+
+      call mpas_dmpar_max_real_array(dminfo, nMaxes, maxes(1:nMaxes), reductions(1:nMaxes))
+      maxes(1:nVariables) = reductions(1:nVariables)
+      CFLNumberGlobal = reductions(nVariables+1)
+      verticalSumMaxes(1:nVariables) = reductions(nMaxes-nVariables+1:nMaxes)
+
+      volumeCellGlobal = sums(1)
+      volumeEdgeGlobal = sums(4)
+      ! compute the averages (slightly different depending on how the sum was computed)
+      variableIndex = 0
+      ! h
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/(areaCellGlobal*nVertLevels)
+
+      ! u
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
+
+      ! v
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
+
+      ! h_edge
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/(areaEdgeGlobal*nVertLevels)
+
+      ! circulation
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/(nVerticesGlobal*nVertLevels)
+
+      ! vorticity
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/(areaTriangleGlobal*nVertLevels)
+
+      ! ke
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
+
+      ! pv_edge
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
+
+      ! pv_vertex
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/(areaTriangleGlobal*nVertLevels)
+
+      ! pv_cell
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
+
+      ! gradPVn
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
+
+      ! gradPVt
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/volumeEdgeGlobal
+
+      ! pressure
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
+
+      ! MontPot
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
+
+      ! wTop vertical velocity
+      variableIndex = variableIndex + 1
+      averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
+
+      ! Tracers
+      do iTracer=1,num_tracers
+        variableIndex = variableIndex + 1
+        averages(variableIndex) = sums(variableIndex)/volumeCellGlobal
+      enddo
+
+      ! write out the data to files
+      if (dminfo % my_proc_id == IO_NODE) then
+         fileID = getFreeUnit()
+         open(fileID,file='stats_min.txt',ACCESS='append')
+            write (fileID,'(100es24.16)') mins(1:nVariables)
+         close (fileID)
+         open(fileID,file='stats_max.txt',ACCESS='append')
+            write (fileID,'(100es24.16)') maxes(1:nVariables)
+         close (fileID)
+         open(fileID,file='stats_sum.txt',ACCESS='append')
+            write (fileID,'(100es24.16)') sums(1:nVariables)
+         close (fileID)
+         open(fileID,file='stats_avg.txt',ACCESS='append')
+            write (fileID,'(100es24.16)') averages(1:nVariables)
+         close (fileID)
+         open(fileID,file='stats_time.txt',ACCESS='append')
+            write (fileID,'(i5,10x,a,100es24.16)') timeIndex, &amp;
+               state % xtime % scalar, dt, &amp;
+               CFLNumberGlobal
+         close (fileID)
+         open(fileID,file='stats_colmin.txt',ACCESS='append')
+            write (fileID,'(100es24.16)') verticalSumMins(1:nVariables)
+         close (fileID)
+         open(fileID,file='stats_colmax.txt',ACCESS='append')
+            write (fileID,'(100es24.16)') verticalSumMaxes(1:nVariables)
+         close (fileID)
+      end if
+
+      state % areaCellGlobal % scalar = areaCellGlobal
+      state % areaEdgeGlobal % scalar = areaEdgeGlobal
+      state % areaTriangleGlobal % scalar = areaTriangleGlobal
+
+      state % volumeCellGlobal % scalar = volumeCellGlobal
+      state % volumeEdgeGlobal % scalar = volumeEdgeGlobal
+      state % CFLNumberGlobal % scalar = CFLNumberGlobal
+      deallocate(areaEdge)
+
+   end subroutine computeGlobalDiagnostics
+
+   integer function getFreeUnit()
+      implicit none
+
+      integer :: index
+      logical :: isOpened
+
+      getFreeUnit = 0
+      do index = 1,99
+         if((index /= 5) .and. (index /= 6)) then
+            inquire(unit = index, opened = isOpened)
+            if( .not. isOpened) then
+               getFreeUnit = index
+               return
+            end if
+         end if
+      end do
+   end function getFreeUnit
+
+   subroutine computeFieldLocalStats(dminfo, nVertLevels, nElements, field, localSum, localMin, localMax, localVertSumMin, &amp;
+      localVertSumMax)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: localSum, localMin, localMax, localVertSumMin, &amp;
+      localVertSumMax
+
+      localSum = sum(field)
+      localMin = minval(field)
+      localMax = maxval(field)
+      localVertSumMin = minval(sum(field,1))
+      localVertSumMax = maxval(sum(field,1))
+
+   end subroutine computeFieldLocalStats
+
+   subroutine computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nElements, areas, field, localSum, localMin, &amp;
+      localMax, localVertSumMin, localVertSumMax)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nElements), intent(in) :: areas
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: localSum, localMin, localMax, localVertSumMin, &amp;
+      localVertSumMax
+
+      integer :: elementIndex
+
+      localSum = 0.0
+      do elementIndex = 1, nElements
+        localSum = localSum + areas(elementIndex) * sum(field(:,elementIndex))
+      end do
+
+      localMin = minval(field)
+      localMax = maxval(field)
+      localVertSumMin = minval(sum(field,1))
+      localVertSumMax = maxval(sum(field,1))
+
+   end subroutine computeFieldAreaWeightedLocalStats
+
+   subroutine computeFieldThicknessWeightedLocalStats(dminfo, nVertLevels, nElements, h, field, &amp;
+      localSum, localMin, localMax, localVertSumMin, localVertSumMax)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: h
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: localSum, localMin, localMax, localVertSumMin, &amp;
+      localVertSumMax
+
+      real (kind=RKIND), dimension(nVertLevels, nElements) :: hTimesField
+
+      integer :: elementIndex
+
+      localSum = sum(h*field)
+      localMin = minval(field)
+      localMax = maxval(field)
+      localVertSumMin = minval(sum(h*field,1))
+      localVertSumMax = maxval(sum(h*field,1))
+
+   end subroutine computeFieldThicknessWeightedLocalStats
+
+   subroutine computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nElements, areas, h, field, &amp;
+      localSum, localMin, localMax, localVertSumMin, localVertSumMax)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nElements), intent(in) :: areas
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: h
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: localSum, localMin, localMax, localVertSumMin, &amp;
+      localVertSumMax
+
+      real (kind=RKIND), dimension(nVertLevels, nElements) :: hTimesField
+
+      integer :: elementIndex
+
+      localSum = 0.0
+      do elementIndex = 1, nElements
+        localSum = localSum + areas(elementIndex) * sum(h(:,elementIndex)*field(:,elementIndex))
+      end do
+
+      localMin = minval(field)
+      localMax = maxval(field)
+      localVertSumMin = minval(sum(h*field,1))
+      localVertSumMax = maxval(sum(h*field,1))
+
+   end subroutine computeFieldVolumeWeightedLocalStats
+
+
+   subroutine computeGlobalSum(dminfo, nVertLevels, nElements, field, globalSum)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: globalSum
+
+      real (kind=RKIND) :: localSum
+
+      localSum = sum(field)
+      call mpas_dmpar_sum_real(dminfo, localSum, globalSum)
+
+   end subroutine computeGlobalSum
+
+   subroutine computeAreaWeightedGlobalSum(dminfo, nVertLevels, nElements, areas, field, globalSum)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nElements), intent(in) :: areas
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: globalSum
+      
+      integer :: elementIndex
+      real (kind=RKIND) :: localSum
+
+      localSum = 0.
+      do elementIndex = 1, nElements
+        localSum = localSum + areas(elementIndex) * sum(field(:,elementIndex))
+      end do
+   
+      call mpas_dmpar_sum_real(dminfo, localSum, globalSum)
+       
+   end subroutine computeAreaWeightedGlobalSum
+
+   subroutine computeVolumeWeightedGlobalSum(dminfo, nVertLevels, nElements, areas, h, field, globalSum)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nElements), intent(in) :: areas
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: h
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: globalSum
+
+      real (kind=RKIND), dimension(nVertLevels, nElements) :: hTimesField
+
+      hTimesField = h*field
+
+      call computeAreaWeightedGlobalSum(dminfo, nVertLevels, nElements, areas, hTimesField, globalSum)
+
+   end subroutine computeVolumeWeightedGlobalSum
+
+   subroutine computeGlobalMin(dminfo, nVertLevels, nElements, field, globalMin)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: globalMin
+
+      real (kind=RKIND) :: localMin
+
+      localMin = minval(field)
+      call mpas_dmpar_min_real(dminfo, localMin, globalMin)
+
+   end subroutine computeGlobalMin
+
+   subroutine computeGlobalMax(dminfo, nVertLevels, nElements, field, globalMax)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: globalMax
+
+      real (kind=RKIND) :: localMax
+
+      localMax = maxval(field)
+      call mpas_dmpar_max_real(dminfo, localMax, globalMax)
+
+   end subroutine computeGlobalMax
+
+   subroutine computeGlobalVertSumHorizMin(dminfo, nVertLevels, nElements, field, globalMin)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: globalMin
+
+      real (kind=RKIND) :: localMin
+
+      localMin = minval(sum(field,1))
+      call mpas_dmpar_min_real(dminfo, localMin, globalMin)
+
+   end subroutine computeGlobalVertSumHorizMin
+
+   subroutine computeGlobalVertSumHorizMax(dminfo, nVertLevels, nElements, field, globalMax)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: globalMax
+
+      real (kind=RKIND) :: localMax
+
+      localMax = maxval(sum(field,1))
+      call mpas_dmpar_max_real(dminfo, localMax, globalMax)
+
+   end subroutine computeGlobalVertSumHorizMax
+
+   subroutine computeGlobalVertThicknessWeightedSumHorizMin(dminfo, nVertLevels, nElements, h, field, globalMin)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: h, field
+      real (kind=RKIND), intent(out) :: globalMin
+
+      real (kind=RKIND) :: localMin
+
+      localMin = minval(sum(h*field,1))
+      call mpas_dmpar_min_real(dminfo, localMin, globalMin)
+
+   end subroutine computeGlobalVertThicknessWeightedSumHorizMin
+
+   subroutine computeGlobalVertThicknessWeightedSumHorizMax(dminfo, nVertLevels, nElements, h, field, globalMax)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: h, field
+      real (kind=RKIND), intent(out) :: globalMax
+
+      real (kind=RKIND) :: localMax
+
+      localMax = maxval(sum(h*field,1))
+      call mpas_dmpar_max_real(dminfo, localMax, globalMax)
+
+   end subroutine computeGlobalVertThicknessWeightedSumHorizMax
+
+end module global_diagnostics

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_mpas_core.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_mpas_core.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_mpas_core.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,795 +0,0 @@
-module mpas_core
-
-   use mpas_framework
-   use mpas_timekeeping
-   use dmpar
-   use test_cases
-
-   use ocn_time_integration
-
-   use ocn_tendency
-
-   use ocn_vel_pressure_grad
-   use ocn_vel_vadv
-   use ocn_vel_hmix
-   use ocn_vel_forcing
-
-   use ocn_tracer_hadv
-   use ocn_tracer_vadv
-   use ocn_tracer_hmix
-   use ocn_restoring
-
-   use ocn_equation_of_state
-
-   use ocn_vmix
-
-   type (io_output_object) :: restart_obj
-   integer :: restart_frame
-
-   integer :: current_outfile_frames
-
-   type (MPAS_Clock_type) :: clock
-
-   integer, parameter :: outputAlarmID = 1
-   integer, parameter :: restartAlarmID = 2
-   integer, parameter :: statsAlarmID = 3
-
-   contains
-
-   subroutine mpas_core_init(domain, startTimeStamp)!{{{
-
-      use configure
-      use grid_types
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      character(len=*), intent(out) :: startTimeStamp
-
-      real (kind=RKIND) :: dt
-      type (block_type), pointer :: block
-      type (dm_info) :: dminfo
-
-      integer :: err, err_tmp
-
-      ! Initialize submodules before initializing blocks.
-      call ocn_timestep_init(err)
-
-      call ocn_vel_pressure_grad_init(err_tmp)
-      err = err .or. err_tmp
-
-      call ocn_vel_vadv_init(err_tmp)
-      err = err .or. err_tmp
-      call ocn_vel_hmix_init(err_tmp)
-      err = err .or. err_tmp
-      call ocn_vel_forcing_init(err_tmp)
-      err = err .or. err_tmp
-
-      call ocn_tracer_hadv_init(err_tmp)
-      err = err .or. err_tmp
-      call ocn_tracer_vadv_init(err_tmp)
-      err = err .or. err_tmp
-      call ocn_tracer_hmix_init(err_tmp)
-      err = err .or. err_tmp
-      call ocn_restoring_init(err_tmp)
-      err = err .or. err_tmp
-
-      call ocn_vmix_init(err_tmp)
-      err = err .or. err_tmp
-
-      call ocn_equation_of_state_init(err_tmp)
-      err = err .or. err_tmp
-
-      if(err) then
-          call dmpar_abort(dminfo)
-      endif
-
-      if (.not. config_do_restart) call setup_sw_test_case(domain)
-
-      call compute_maxLevel(domain)
-
-      if (config_vert_grid_type.eq.'isopycnal') then
-         print *, ' Using isopycnal coordinates'
-      elseif (config_vert_grid_type.eq.'zlevel') then
-         print *, ' Using z-level coordinates'
-         call init_ZLevel(domain)
-      else 
-         print *, ' Incorrect choice of config_vert_grid_type:',&amp;
-           config_vert_grid_type
-         call dmpar_abort(dminfo)
-      endif
-
-      if (trim(config_new_btr_variables_from) == 'btr_avg' &amp;
-           .and.trim(config_time_integration) == 'unsplit_explicit') then
-         print *, ' unsplit_explicit option must use',&amp;
-           ' config_new_btr_variables_from==last_subcycle'
-         call dmpar_abort(dminfo)
-      endif
-
-      !
-      ! Initialize core
-      !
-      dt = config_dt
-
-      call simulation_clock_init(domain, dt, startTimeStamp)
-
-      block =&gt; domain % blocklist
-      do while (associated(block))
-         call mpas_init_block(block, block % mesh, dt)
-         block % state % time_levs(1) % state % xtime % scalar = startTimeStamp 
-         block =&gt; block % next
-
-         !dwj 110919 This allows the restorings to grab the indices for
-         ! temperature and salinity tracers from state.
-      end do
-
-   ! mrp 100316 In order for this to work, we need to pass domain % dminfo as an 
-   ! input arguement into mpas_init.  Ask about that later.  For now, there will be
-   ! no initial statistics write.
-   
-   !   call timer_start(&quot;global diagnostics&quot;)
-   !   call computeGlobalDiagnostics(domain % dminfo, block % state % time_levs(1) % state, mesh, 0, dt)
-   !   call timer_stop(&quot;global diagnostics&quot;)
-   !   call output_state_init(output_obj, domain, &quot;OUTPUT&quot;)
-   !   call write_output_frame(output_obj, domain)
-
-      restart_frame = 1
-      current_outfile_frames = 0
-
-   end subroutine mpas_core_init!}}}
-
-   subroutine simulation_clock_init(domain, dt, startTimeStamp)!{{{
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      real (kind=RKIND), intent(in) :: dt
-      character(len=*), intent(out) :: startTimeStamp
-
-      type (MPAS_Time_Type) :: startTime, stopTime, alarmStartTime
-      type (MPAS_TimeInterval_type) :: runDuration, timeStep, alarmTimeStep
-      integer :: ierr
-
-      call MPAS_setTime(curr_time=startTime, dateTimeString=config_start_time, ierr=ierr)
-      call MPAS_setTimeInterval(timeStep, dt=dt, ierr=ierr)
-
-      if (trim(config_run_duration) /= &quot;none&quot;) then
-         call MPAS_setTimeInterval(runDuration, timeString=config_run_duration, ierr=ierr)
-         call MPAS_createClock(clock, startTime=startTime, timeStep=timeStep, runDuration=runDuration, ierr=ierr)
-
-         if (trim(config_stop_time) /= &quot;none&quot;) then
-            call MPAS_setTime(curr_time=stopTime, dateTimeString=config_stop_time, ierr=ierr)
-            if(startTime + runduration /= stopTime) then
-               write(0,*) 'Warning: config_run_duration and config_stop_time are inconsitent: using config_run_duration.'
-            end if
-         end if
-      else if (trim(config_stop_time) /= &quot;none&quot;) then
-         call MPAS_setTime(curr_time=stopTime, dateTimeString=config_stop_time, ierr=ierr)
-         call MPAS_createClock(clock, startTime=startTime, timeStep=timeStep, stopTime=stopTime, ierr=ierr)
-      else
-          write(0,*) 'Error: Neither config_run_duration nor config_stop_time were specified.'
-          call dmpar_finalize(domain % dminfo)
-      end if
-
-      ! set output alarm
-      call MPAS_setTimeInterval(alarmTimeStep, timeString=config_output_interval, ierr=ierr)
-      alarmStartTime = startTime + alarmTimeStep
-      call MPAS_addClockAlarm(clock, outputAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
-
-      ! set restart alarm, if necessary
-      if (trim(config_restart_interval) /= &quot;none&quot;) then
-         call MPAS_setTimeInterval(alarmTimeStep, timeString=config_restart_interval, ierr=ierr)
-         alarmStartTime = startTime + alarmTimeStep
-         call MPAS_addClockAlarm(clock, restartAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
-      end if
-
-      !TODO: use this code if we desire to convert config_stats_interval to alarms 
-      !(must also change config_stats_interval type to character) 
-      ! set stats alarm, if necessary
-      !if (trim(config_stats_interval) /= &quot;none&quot;) then      
-      !   call MPAS_setTimeInterval(alarmTimeStep, timeString=config_stats_interval, ierr=ierr)
-      !   alarmStartTime = startTime + alarmTimeStep
-      !   call MPAS_addClockAlarm(clock, statsAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
-      !end if
-
-      call MPAS_getTime(curr_time=startTime, dateTimeString=startTimeStamp, ierr=ierr)
-
-   end subroutine simulation_clock_init!}}}
-
-   subroutine mpas_init_block(block, mesh, dt)!{{{
-   
-      use grid_types
-      use RBF_interpolation
-      use vector_reconstruction
-   
-      implicit none
-   
-      type (block_type), intent(inout) :: block
-      type (mesh_type), intent(inout) :: mesh
-      real (kind=RKIND), intent(in) :: dt
-      integer :: i, iEdge, iCell, k
-   
-   
-      call ocn_diagnostic_solve(dt, block % state % time_levs(1) % state, mesh)
-
-      call compute_mesh_scaling(mesh)

-      call rbfInterp_initialize(mesh)
-      call init_reconstruct(mesh)
-      call reconstruct(mesh, block % state % time_levs(1) % state % u % array,                  &amp;
-                       block % state % time_levs(1) % state % uReconstructX % array,            &amp;
-                       block % state % time_levs(1) % state % uReconstructY % array,            &amp;
-                       block % state % time_levs(1) % state % uReconstructZ % array,            &amp;
-                       block % state % time_levs(1) % state % uReconstructZonal % array,        &amp;
-                       block % state % time_levs(1) % state % uReconstructMeridional % array    &amp;
-                      )
-
-      ! initialize velocities and tracers on land to be -1e34
-      ! The reconstructed velocity on land will have values not exactly
-      ! -1e34 due to the interpolation of reconstruction.
-
-      do iEdge=1,block % mesh % nEdges
-         ! mrp 101115 note: in order to include flux boundary conditions, the following
-         ! line will need to change.  Right now, set boundary edges between land and 
-         ! water to have zero velocity.
-         block % state % time_levs(1) % state % u % array( &amp;
-             block % mesh % maxLevelEdgeTop % array(iEdge)+1 &amp;
-            :block % mesh % maxLevelEdgeBot % array(iEdge), iEdge) = 0.0
-
-         block % state % time_levs(1) % state % u % array( &amp;
-             block % mesh % maxLevelEdgeBot % array(iEdge)+1: &amp;
-             block % mesh % nVertLevels,iEdge) = 0.0
-! mrp changed to 0
-!             block % mesh % nVertLevels,iEdge) = -1e34
-      end do
-      do iCell=1,block % mesh % nCells
-         block % state % time_levs(1) % state % tracers % array( &amp;
-            :, block % mesh % maxLevelCell % array(iCell)+1 &amp;
-              :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(3,:,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 copy_state(block % state % time_levs(i) % state, &amp;
-                             block % state % time_levs(1) % state)
-          end do
-! mrp 110808 add end
-
-
-      else
-          do i=2,nTimeLevs
-             call copy_state(block % state % time_levs(i) % state, &amp;
-                             block % state % time_levs(1) % state)
-          end do
-      endif
-
-   end subroutine mpas_init_block!}}}
-   
-   subroutine mpas_core_run(domain, output_obj, output_frame)!{{{
-   
-      use grid_types
-      use io_output
-      use timer
-   
-      implicit none
-   
-      type (domain_type), intent(inout) :: domain
-      type (io_output_object), intent(inout) :: output_obj
-      integer, intent(inout) :: output_frame
-   
-      integer :: itimestep
-      real (kind=RKIND) :: dt
-      type (block_type), pointer :: block_ptr
-
-      type (MPAS_Time_Type) :: currTime
-      character(len=32) :: timeStamp
-      integer :: ierr
-   
-      ! Eventually, dt should be domain specific
-      dt = config_dt
-
-      currTime = MPAS_getClockTime(clock, MPAS_NOW, ierr)
-      call MPAS_getTime(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)
-      write(0,*) 'Initial time ', timeStamp
-
-      call write_output_frame(output_obj, output_frame, domain)
-
-      ! During integration, time level 1 stores the model state at the beginning of the
-      !   time step, and time level 2 stores the state advanced dt in time by timestep(...)
-      itimestep = 0
-      do while (.not. MPAS_isClockStopTime(clock))
-
-         itimestep = itimestep + 1
-         call MPAS_advanceClock(clock)
-
-         currTime = MPAS_getClockTime(clock, MPAS_NOW, ierr)
-         call MPAS_getTime(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)
-         write(0,*) 'Doing timestep ', timeStamp
-
-         call timer_start(&quot;time integration&quot;)
-         call mpas_timestep(domain, itimestep, dt, timeStamp)
-         call timer_stop(&quot;time integration&quot;)
-   
-         ! Move time level 2 fields back into time level 1 for next time step
-         call shift_time_levels_state(domain % blocklist % state)
-      
-         if (MPAS_isAlarmRinging(clock, outputAlarmID, ierr=ierr)) then
-            call MPAS_resetClockAlarm(clock, outputAlarmID, ierr=ierr)
-            if(output_frame == 1) call output_state_init(output_obj, domain, &quot;OUTPUT&quot;, trim(timeStamp)) ! output_frame will always be &gt; 1 here unless it is reset after the output file is finalized
-            call write_output_frame(output_obj, output_frame, domain)
-         end if
-
-         if (MPAS_isAlarmRinging(clock, restartAlarmID, ierr=ierr)) then
-            call MPAS_resetClockAlarm(clock, restartAlarmID, ierr=ierr)
-            if (restart_frame == 1) call output_state_init(restart_obj, domain, &quot;RESTART&quot;)
-            call output_state_for_domain(restart_obj, domain, restart_frame)
-            restart_frame = restart_frame + 1
-         end if
-
-      end do
-
-   end subroutine mpas_core_run!}}}
-   
-   subroutine write_output_frame(output_obj, output_frame, domain)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute diagnostic fields for a domain and write model state to output file
-   !
-   ! Input/Output: domain - contains model state; diagnostic field are computed
-   !                        before returning
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   
-      use grid_types
-      use io_output
-   
-      implicit none
-   
-      integer, intent(inout) :: output_frame
-      type (domain_type), intent(inout) :: domain
-      type (io_output_object), intent(inout) :: output_obj
-   
-      integer :: i, j, k
-      integer :: eoe
-      type (block_type), pointer :: block_ptr
-   
-      block_ptr =&gt; domain % blocklist
-      do while (associated(block_ptr))
-         call compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
-         block_ptr =&gt; block_ptr % next
-      end do
-   
-      call output_state_for_domain(output_obj, domain, output_frame)
-      output_frame = output_frame + 1
-
-      ! if the maximum number of frames per outfile has been reached, finalize outfile and reset frame
-      if (config_frames_per_outfile &gt; 0) then
-         current_outfile_frames = current_outfile_frames + 1            
-         if(current_outfile_frames &gt;= config_frames_per_outfile) then
-            current_outfile_frames = 0
-            call output_state_finalize(output_obj, domain % dminfo)
-            output_frame = 1
-         end if
-      end if
-   
-   end subroutine write_output_frame!}}}
-   
-   subroutine compute_output_diagnostics(state, grid)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute diagnostic fields for a domain
-   !
-   ! Input: state - contains model prognostic fields
-   !        grid  - contains grid metadata
-   !
-   ! Output: state - upon returning, diagnostic fields will have be computed
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   
-      use grid_types
-   
-      implicit none
-   
-      type (state_type), intent(inout) :: state
-      type (mesh_type), intent(in) :: grid
-   
-      integer :: i, eoe
-      integer :: iEdge, k
-   
-   end subroutine compute_output_diagnostics!}}}
-   
-   subroutine mpas_timestep(domain, itimestep, dt, timeStamp)!{{{
-   
-      use grid_types
-      use timer
-      use global_diagnostics
-   
-      implicit none
-   
-      type (domain_type), intent(inout) :: domain 
-      integer, intent(in) :: itimestep
-      real (kind=RKIND), intent(in) :: dt
-      character(len=*), intent(in) :: timeStamp
-
-      type (block_type), pointer :: block_ptr
-      integer :: ierr
-   
-      call ocn_timestep(domain, dt, timeStamp)
-
-      if (config_stats_interval &gt; 0) then
-          if (mod(itimestep, config_stats_interval) == 0) then
-              block_ptr =&gt; domain % blocklist
-              if (associated(block_ptr % next)) then
-                  write(0,*) 'Error: computeGlobalDiagnostics assumes ',&amp;
-                     'that there is only one block per processor.'
-              end if
-
-          call timer_start(&quot;global diagnostics&quot;)
-          call computeGlobalDiagnostics(domain % dminfo, &amp;
-             block_ptr % state % time_levs(2) % state, block_ptr % mesh, &amp;
-             itimestep, dt)
-          call timer_stop(&quot;global diagnostics&quot;)
-          end if
-      end if
-
-      !TODO: replace the above code block with this if we desire to convert config_stats_interval to use alarms
-      !if (MPAS_isAlarmRinging(clock, statsAlarmID, ierr=ierr)) then
-      !   call MPAS_resetClockAlarm(clock, statsAlarmID, ierr=ierr)
-
-      !   block_ptr =&gt; domain % blocklist
-      !   if (associated(block_ptr % next)) then
-      !      write(0,*) 'Error: computeGlobalDiagnostics assumes ',&amp;
-      !                 'that there is only one block per processor.'
-      !   end if
-   
-      !   call timer_start(&quot;global diagnostics&quot;)
-      !   call computeGlobalDiagnostics(domain % dminfo, &amp;
-      !            block_ptr % state % time_levs(2) % state, block_ptr % mesh, &amp;
-      !            timeStamp, dt)
-      !   call timer_stop(&quot;global diagnostics&quot;)
-      !end if
-
-   end subroutine mpas_timestep!}}}
-
-subroutine init_ZLevel(domain)!{{{
-! Initialize maxLevel and bouncary grid variables.
-
-   use grid_types
-   use configure
-
-   implicit none
-
-   type (domain_type), intent(inout) :: domain
-
-   integer :: i, iCell, iEdge, iVertex, k
-   type (block_type), pointer :: block
-
-   integer :: iTracer, cell, cell1, cell2
-   real (kind=RKIND) :: uhSum, hSum, sshEdge
-   real (kind=RKIND), dimension(:), pointer :: &amp;
-      hZLevel, zMidZLevel, zTopZLevel, &amp;
-      hMeanTopZLevel, hRatioZLevelK, hRatioZLevelKm1
-   real (kind=RKIND), dimension(:,:), pointer :: h
-   integer :: nVertLevels
-
-   ! Initialize z-level grid variables from h, read in from input file.
-   block =&gt; domain % blocklist
-   do while (associated(block))
-
-      h          =&gt; block % state % time_levs(1) % state % h % array
-      hZLevel    =&gt; block % mesh % hZLevel % array
-      zMidZLevel =&gt; block % mesh % zMidZLevel % array
-      zTopZLevel =&gt; block % mesh % zTopZLevel % array
-      nVertLevels = block % mesh % nVertLevels
-      hMeanTopZLevel    =&gt; block % mesh % hMeanTopZLevel % array
-      hRatioZLevelK    =&gt; block % mesh % hRatioZLevelK % array
-      hRatioZLevelKm1    =&gt; block % mesh % hRatioZLevelKm1 % array
-
-      ! These should eventually be in an input file.  For now
-      ! I just read them in from h(:,1).
-      ! Upon restart, the correct hZLevel should be in restart.nc
-      if (.not. config_do_restart) hZLevel = h(:,1)
-
-      ! hZLevel should be in the grid.nc and restart.nc file, 
-      ! and h for k=1 must be specified there as well.

-      zTopZLevel(1) = 0.0
-      do k = 1,nVertLevels
-         zMidZLevel(k) = zTopZLevel(k)-0.5*hZLevel(k)
-         zTopZLevel(k+1) = zTopZLevel(k)-  hZLevel(k)
-      end do
-
-      hMeanTopZLevel(1) = 0.0
-      hRatioZLevelK(1) = 0.0
-      hRatioZLevelKm1(1) = 0.0
-      do k = 2,nVertLevels
-         hMeanTopZLevel(k) = 0.5*(hZLevel(k-1) + hZLevel(k))
-         hRatioZLevelK(k) = 0.5*hZLevel(k)/hMeanTopZLevel(k)
-         hRatioZLevelKm1(k) = 0.5*hZLevel(k-1)/hMeanTopZLevel(k)
-      end do
-
-      ! mrp 110601 For now, h is the variable saved in the restart file
-      ! I am computing SSH here.  In the future, could make smaller 
-      ! restart files for z-Level runs by saving SSH only.
-      do iCell=1,block % mesh % nCells
-
-          block % state % time_levs(1) % state % ssh % array(iCell) &amp; 
-        = block % state % time_levs(1) % state % h % array(1,iCell) &amp; 
-        - block % mesh % hZLevel % array(1)
-      enddo
-
-         ! Compute barotropic velocity at first timestep
-         ! This is only done upon start-up.
-         if     (trim(config_time_integration) == 'unsplit_explicit') then
-            block % state % time_levs(1) % state % uBtr % array(:) = 0.0
-
-              block % state % time_levs(1) % state % uBcl % array(:,:) &amp;
-            = block % state % time_levs(1) % state % u % array(:,:) 
-
-         elseif (trim(config_time_integration) == 'split_explicit') then
-
-            if (config_filter_btr_mode) then
-               do iCell=1,block % mesh % nCells
-                  block % state % time_levs(1) % state % h % array(1,iCell) &amp; 
-                = block % mesh % hZLevel % array(1)

-                  block % state % time_levs(1) % state % ssh % array(iCell) = 0.0
-               enddo
-            endif 
-
-            do iEdge=1,block % mesh % nEdges
-               cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
-               cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-
-               sshEdge = 0.5*( &amp;
-                   block % state % time_levs(1) % state % ssh % array(cell1) &amp; 
-                 + block % state % time_levs(1) % state % ssh % array(cell2) ) 
-
-               ! uBtr = sum(u)/sum(h) on each column
-               uhSum = (sshEdge + block % mesh % hZLevel % array(1)) &amp;
-                  * block % state % time_levs(1) % state % u % array(1,iEdge)
-               hSum = sshEdge + block % mesh % hZLevel % array(1)
-
-               do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
-                  uhSum = uhSum &amp;
-                     + block % mesh % hZLevel % array(k) &amp;
-                      *block % state % time_levs(1) % state % u % array(k,iEdge)
-                  hSum = hSum &amp;
-                     + block % mesh % hZLevel % array(k)
-               enddo
-               block % state % time_levs(1) % state % uBtr % array(iEdge) = uhSum/hsum
-
-               ! uBcl(k,iEdge) = u(k,iEdge) - uBtr(iEdge)
-               do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
-                 block % state % time_levs(1) % state % uBcl % array(k,iEdge) &amp;
-                 = block % state % time_levs(1) % state % u % array(k,iEdge) &amp;
-                 - block % state % time_levs(1) % state % uBtr % array(iEdge)
-               enddo
-
-               ! uBcl=0, u=0 on land cells
-               do k=block % mesh % maxLevelEdgeTop % array(iEdge)+1, block % mesh % nVertLevels
-                 block % state % time_levs(1) % state % uBcl % array(k,iEdge) = 0.0
-                 block % state % time_levs(1) % state % u % array(k,iEdge) = 0.0
-               enddo
-            enddo
-
-            if (config_filter_btr_mode) then
-               ! filter uBtr out of initial condition
-                block % state % time_levs(1) % state % u % array(:,:) &amp;
-              = block % state % time_levs(1) % state % uBcl % array(:,:)
-
-               block % state % time_levs(1) % state % uBtr % array(:) = 0.0
-            endif 
-
-         endif
-
-!print *, '11 u ',minval(domain % blocklist % state % time_levs(1) % state % u % array(:,1:domain % blocklist % mesh % nEdgesSolve)), &amp;
-!                maxval(domain % blocklist % state % time_levs(1) % state % u % array(:,1:domain % blocklist % mesh % nEdgesSolve))
-!print *, '11 uBtr ',minval(domain % blocklist % state % time_levs(1) % state % uBtr % array(1:domain % blocklist % mesh % nEdgesSolve)), &amp;
-!                    maxval(domain % blocklist % state % time_levs(1) % state % uBtr % array(1:domain % blocklist % mesh % nEdgesSolve))
-!print *, '11 uBcl ',minval(domain % blocklist % state % time_levs(1) % state % uBcl % array(:,1:domain % blocklist % mesh % nEdgesSolve)), &amp;
-!                    maxval(domain % blocklist % state % time_levs(1) % state % uBcl % array(:,1:domain % blocklist % mesh % nEdgesSolve))
-
-
-! mrp temp testing - is uBcl vert sum zero?
-!            do iEdge=1,block % mesh % nEdges
-!              uhSum = (sshEdge + block % mesh % hZLevel % array(1)) * block % state % time_levs(1) % state % uBcl % array(1,iEdge)
-!              hSum  =  sshEdge + block % mesh % hZLevel % array(1)
-
-!              do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
-!                 uhSum = uhSum + block % mesh % hZLevel % array(k) *  block % state % time_levs(1) % state % uBcl % array(k,iEdge)
-!                 hSum  =  hSum + block % mesh % hZLevel % array(k)
-!              enddo
-!              block % state % time_levs(1) % state % FBtr % array(iEdge) = uhSum/hSum
-
-!           enddo ! iEdge
-
-!print *, 'uBcl vert sum IC',minval(block % state % time_levs(1) % state % FBtr % array(1:block % mesh % nEdgesSolve)), &amp;
-!                            maxval(block % state % time_levs(1) % state % FBtr % array(1:block % mesh % nEdgesSolve))
-
-! mrp temp testing - is uBcl vert sum zero? end
-
-      block =&gt; block % next
-
-   end do
-
-end subroutine init_ZLevel!}}}
-
-subroutine compute_maxLevel(domain)!{{{
-! Initialize maxLevel and bouncary grid variables.
-
-   use grid_types
-   use configure
-   use constants
-
-   implicit none
-
-   type (domain_type), intent(inout) :: domain
-
-   integer :: i, iCell, iEdge, iVertex, k
-   type (block_type), pointer :: block
-
-   real (kind=RKIND), dimension(:,:), pointer :: h, u, u_src, rho
-   real (kind=RKIND), dimension(:,:,:), pointer :: tracers
-   real (kind=RKIND) :: delta_rho, pi, latCenter, lonCenter, dist
-   real (kind=RKIND) :: centerx, centery
-   integer :: nCells, nEdges, nVertices, nVertLevels, vertexDegree
-
-   integer, dimension(:), pointer :: &amp;
-      maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &amp;
-      maxLevelVertexTop, maxLevelVertexBot
-   integer, dimension(:,:), pointer :: &amp;
-      cellsOnEdge, cellsOnVertex, boundaryEdge, boundaryCell, &amp;
-      boundaryVertex, verticesOnEdge
-
-   ! Initialize z-level grid variables from h, read in from input file.
-   block =&gt; domain % blocklist
-   do while (associated(block))
-
-      maxLevelCell =&gt; block % mesh % maxLevelCell % array
-      maxLevelEdgeTop =&gt; block % mesh % maxLevelEdgeTop % array
-      maxLevelEdgeBot =&gt; block % mesh % maxLevelEdgeBot % array
-      maxLevelVertexTop =&gt; block % mesh % maxLevelVertexTop % array
-      maxLevelVertexBot =&gt; block % mesh % maxLevelVertexBot % array
-      cellsOnEdge    =&gt; block % mesh % cellsOnEdge % array
-      cellsOnVertex  =&gt; block % mesh % cellsOnVertex % array
-      verticesOnEdge =&gt; block % mesh % verticesOnEdge % array
-      boundaryEdge   =&gt; block % mesh % boundaryEdge % array
-      boundaryCell   =&gt; block % mesh % boundaryCell % array
-      boundaryVertex =&gt; block % mesh % boundaryVertex % array
-
-      nCells      = block % mesh % nCells
-      nEdges      = block % mesh % nEdges
-      nVertices   = block % mesh % nVertices
-      nVertLevels = block % mesh % nVertLevels
-      vertexDegree = block % mesh % vertexDegree
-
-      ! for z-grids, maxLevelCell should be in input state
-      ! Isopycnal grid uses all vertical cells
-      if (config_vert_grid_type.eq.'isopycnal') then
-         maxLevelCell(1:nCells) = nVertLevels
-      endif
-      maxLevelCell(nCells+1) = 0
-
-      ! maxLevelEdgeTop is the minimum (shallowest) of the surrounding cells
-      do iEdge=1,nEdges
-         maxLevelEdgeTop(iEdge) = &amp;
-            min( maxLevelCell(cellsOnEdge(1,iEdge)), &amp;
-                 maxLevelCell(cellsOnEdge(2,iEdge)) )
-      end do 
-      maxLevelEdgeTop(nEdges+1) = 0
-
-      ! maxLevelEdgeBot is the maximum (deepest) of the surrounding cells
-      do iEdge=1,nEdges
-         maxLevelEdgeBot(iEdge) = &amp;
-            max( maxLevelCell(cellsOnEdge(1,iEdge)), &amp;
-                 maxLevelCell(cellsOnEdge(2,iEdge)) )
-      end do 
-      maxLevelEdgeBot(nEdges+1) = 0
-
-      ! maxLevelVertexBot is the maximum (deepest) of the surrounding cells
-      do iVertex = 1,nVertices
-         maxLevelVertexBot(iVertex) = maxLevelCell(cellsOnVertex(1,iVertex))
-         do i=2,vertexDegree
-            maxLevelVertexBot(iVertex) = &amp;
-               max( maxLevelVertexBot(iVertex), &amp;
-                    maxLevelCell(cellsOnVertex(i,iVertex)))
-         end do
-      end do 
-      maxLevelVertexBot(nVertices+1) = 0
-
-      ! maxLevelVertexTop is the minimum (shallowest) of the surrounding cells
-      do iVertex = 1,nVertices
-         maxLevelVertexTop(iVertex) = maxLevelCell(cellsOnVertex(1,iVertex))
-         do i=2,vertexDegree
-            maxLevelVertexTop(iVertex) = &amp;
-               min( maxLevelVertexTop(iVertex), &amp;
-                    maxLevelCell(cellsOnVertex(i,iVertex)))
-         end do
-      end do 
-      maxLevelVertexTop(nVertices+1) = 0
-
-      ! set boundary edge
-      boundaryEdge=1
-      do iEdge=1,nEdges
-         boundaryEdge(1:maxLevelEdgeTop(iEdge),iEdge)=0
-      end do 
-
-      !
-      ! Find cells and vertices that have an edge on the boundary
-      !
-      boundaryCell(:,:) = 0
-      do iEdge=1,nEdges
-         do k=1,nVertLevels
-            if (boundaryEdge(k,iEdge).eq.1) then
-               boundaryCell(k,cellsOnEdge(1,iEdge)) = 1
-               boundaryCell(k,cellsOnEdge(2,iEdge)) = 1
-               boundaryVertex(k,verticesOnEdge(1,iEdge)) = 1
-               boundaryVertex(k,verticesOnEdge(2,iEdge)) = 1
-            endif
-         end do
-      end do
-
-      block =&gt; block % next
-   end do
-
-   ! Note: We do not update halos on maxLevel* variables.  I want the
-   ! outside edge of a halo to be zero on each processor.
-
-end subroutine compute_maxLevel!}}}
-   
-   subroutine mpas_core_finalize(domain)!{{{
-   
-      use grid_types
-   
-      implicit none
-
-      integer :: ierr
-
-      type (domain_type), intent(inout) :: domain 
-
-      if (restart_frame &gt; 1) call output_state_finalize(restart_obj, domain % dminfo)
-
-      call MPAS_destroyClock(clock, ierr)
-
-   end subroutine mpas_core_finalize!}}}
-
-   subroutine compute_mesh_scaling(mesh)!{{{
-
-      use grid_types
-      use configure
-
-      implicit none
-
-      type (mesh_type), intent(inout) :: mesh
-
-      integer :: iEdge, cell1, cell2
-      real (kind=RKIND), dimension(:), pointer :: meshDensity, meshScalingDel2, meshScalingDel4
-
-      meshDensity =&gt; mesh % meshDensity % array
-      meshScalingDel2 =&gt; mesh % meshScalingDel2 % array
-      meshScalingDel4 =&gt; mesh % meshScalingDel4 % array
-
-      !
-      ! Compute the scaling factors to be used in the del2 and del4 dissipation
-      !
-      meshScalingDel2(:) = 1.0
-      meshScalingDel4(:) = 1.0
-      if (config_h_ScaleWithMesh) then
-         do iEdge=1,mesh%nEdges
-            cell1 = mesh % cellsOnEdge % array(1,iEdge)
-            cell2 = mesh % cellsOnEdge % array(2,iEdge)
-            meshScalingDel2(iEdge) = 1.0 / ( (meshDensity(cell1) + meshDensity(cell2) )/2.0)**(5.0/12.0)
-            meshScalingDel4(iEdge) = 1.0 / ( (meshDensity(cell1) + meshDensity(cell2) )/2.0)**(5.0/6.0)
-         end do
-      end if
-
-   end subroutine compute_mesh_scaling!}}}
-
-end module mpas_core
-
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_mpas_core.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_mpas_core.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_mpas_core.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_mpas_core.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,795 @@
+module mpas_core
+
+   use mpas_framework
+   use mpas_timekeeping
+   use mpas_dmpar
+   use test_cases
+
+   use ocn_time_integration
+
+   use ocn_tendency
+
+   use ocn_vel_pressure_grad
+   use ocn_vel_vadv
+   use ocn_vel_hmix
+   use ocn_vel_forcing
+
+   use ocn_tracer_hadv
+   use ocn_tracer_vadv
+   use ocn_tracer_hmix
+   use ocn_restoring
+
+   use ocn_equation_of_state
+
+   use ocn_vmix
+
+   type (io_output_object) :: restart_obj
+   integer :: restart_frame
+
+   integer :: current_outfile_frames
+
+   type (MPAS_Clock_type) :: clock
+
+   integer, parameter :: outputAlarmID = 1
+   integer, parameter :: restartAlarmID = 2
+   integer, parameter :: statsAlarmID = 3
+
+   contains
+
+   subroutine mpas_core_init(domain, startTimeStamp)!{{{
+
+      use mpas_configure
+      use mpas_grid_types
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+      character(len=*), intent(out) :: startTimeStamp
+
+      real (kind=RKIND) :: dt
+      type (block_type), pointer :: block
+      type (dm_info) :: dminfo
+
+      integer :: err, err_tmp
+
+      ! Initialize submodules before initializing blocks.
+      call ocn_timestep_init(err)
+
+      call ocn_vel_pressure_grad_init(err_tmp)
+      err = err .or. err_tmp
+
+      call ocn_vel_vadv_init(err_tmp)
+      err = err .or. err_tmp
+      call ocn_vel_hmix_init(err_tmp)
+      err = err .or. err_tmp
+      call ocn_vel_forcing_init(err_tmp)
+      err = err .or. err_tmp
+
+      call ocn_tracer_hadv_init(err_tmp)
+      err = err .or. err_tmp
+      call ocn_tracer_vadv_init(err_tmp)
+      err = err .or. err_tmp
+      call ocn_tracer_hmix_init(err_tmp)
+      err = err .or. err_tmp
+      call ocn_restoring_init(err_tmp)
+      err = err .or. err_tmp
+
+      call ocn_vmix_init(err_tmp)
+      err = err .or. err_tmp
+
+      call ocn_equation_of_state_init(err_tmp)
+      err = err .or. err_tmp
+
+      if(err) then
+          call mpas_dmpar_abort(dminfo)
+      endif
+
+      if (.not. config_do_restart) call setup_sw_test_case(domain)
+
+      call compute_maxLevel(domain)
+
+      if (config_vert_grid_type.eq.'isopycnal') then
+         print *, ' Using isopycnal coordinates'
+      elseif (config_vert_grid_type.eq.'zlevel') then
+         print *, ' Using z-level coordinates'
+         call init_ZLevel(domain)
+      else 
+         print *, ' Incorrect choice of config_vert_grid_type:',&amp;
+           config_vert_grid_type
+         call mpas_dmpar_abort(dminfo)
+      endif
+
+      if (trim(config_new_btr_variables_from) == 'btr_avg' &amp;
+           .and.trim(config_time_integration) == 'unsplit_explicit') then
+         print *, ' unsplit_explicit option must use',&amp;
+           ' config_new_btr_variables_from==last_subcycle'
+         call mpas_dmpar_abort(dminfo)
+      endif
+
+      !
+      ! Initialize core
+      !
+      dt = config_dt
+
+      call simulation_clock_init(domain, dt, startTimeStamp)
+
+      block =&gt; domain % blocklist
+      do while (associated(block))
+         call mpas_init_block(block, block % mesh, dt)
+         block % state % time_levs(1) % state % xtime % scalar = startTimeStamp 
+         block =&gt; block % next
+
+         !dwj 110919 This allows the restorings to grab the indices for
+         ! temperature and salinity tracers from state.
+      end do
+
+   ! mrp 100316 In order for this to work, we need to pass domain % dminfo as an 
+   ! input arguement into mpas_init.  Ask about that later.  For now, there will be
+   ! no initial statistics write.
+   
+   !   call mpas_timer_start(&quot;global diagnostics&quot;)
+   !   call computeGlobalDiagnostics(domain % dminfo, block % state % time_levs(1) % state, mesh, 0, dt)
+   !   call mpas_timer_stop(&quot;global diagnostics&quot;)
+   !   call mpas_output_state_init(output_obj, domain, &quot;OUTPUT&quot;)
+   !   call write_output_frame(output_obj, domain)
+
+      restart_frame = 1
+      current_outfile_frames = 0
+
+   end subroutine mpas_core_init!}}}
+
+   subroutine simulation_clock_init(domain, dt, startTimeStamp)!{{{
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+      real (kind=RKIND), intent(in) :: dt
+      character(len=*), intent(out) :: startTimeStamp
+
+      type (MPAS_Time_Type) :: startTime, stopTime, alarmStartTime
+      type (MPAS_TimeInterval_type) :: runDuration, timeStep, alarmTimeStep
+      integer :: ierr
+
+      call mpas_set_time(curr_time=startTime, dateTimeString=config_start_time, ierr=ierr)
+      call mpas_set_timeInterval(timeStep, dt=dt, ierr=ierr)
+
+      if (trim(config_run_duration) /= &quot;none&quot;) then
+         call mpas_set_timeInterval(runDuration, timeString=config_run_duration, ierr=ierr)
+         call mpas_create_clock(clock, startTime=startTime, timeStep=timeStep, runDuration=runDuration, ierr=ierr)
+
+         if (trim(config_stop_time) /= &quot;none&quot;) then
+            call mpas_set_time(curr_time=stopTime, dateTimeString=config_stop_time, ierr=ierr)
+            if(startTime + runduration /= stopTime) then
+               write(0,*) 'Warning: config_run_duration and config_stop_time are inconsitent: using config_run_duration.'
+            end if
+         end if
+      else if (trim(config_stop_time) /= &quot;none&quot;) then
+         call mpas_set_time(curr_time=stopTime, dateTimeString=config_stop_time, ierr=ierr)
+         call mpas_create_clock(clock, startTime=startTime, timeStep=timeStep, stopTime=stopTime, ierr=ierr)
+      else
+          write(0,*) 'Error: Neither config_run_duration nor config_stop_time were specified.'
+          call mpas_dmpar_finalize(domain % dminfo)
+      end if
+
+      ! set output alarm
+      call mpas_set_timeInterval(alarmTimeStep, timeString=config_output_interval, ierr=ierr)
+      alarmStartTime = startTime + alarmTimeStep
+      call mpas_add_clock_alarm(clock, outputAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
+
+      ! set restart alarm, if necessary
+      if (trim(config_restart_interval) /= &quot;none&quot;) then
+         call mpas_set_timeInterval(alarmTimeStep, timeString=config_restart_interval, ierr=ierr)
+         alarmStartTime = startTime + alarmTimeStep
+         call mpas_add_clock_alarm(clock, restartAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
+      end if
+
+      !TODO: use this code if we desire to convert config_stats_interval to alarms 
+      !(must also change config_stats_interval type to character) 
+      ! set stats alarm, if necessary
+      !if (trim(config_stats_interval) /= &quot;none&quot;) then      
+      !   call mpas_set_timeInterval(alarmTimeStep, timeString=config_stats_interval, ierr=ierr)
+      !   alarmStartTime = startTime + alarmTimeStep
+      !   call mpas_add_clock_alarm(clock, statsAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
+      !end if
+
+      call mpas_get_time(curr_time=startTime, dateTimeString=startTimeStamp, ierr=ierr)
+
+   end subroutine simulation_clock_init!}}}
+
+   subroutine mpas_init_block(block, mesh, dt)!{{{
+   
+      use mpas_grid_types
+      use mpas_rbf_interpolation
+      use mpas_vector_reconstruction
+   
+      implicit none
+   
+      type (block_type), intent(inout) :: block
+      type (mesh_type), intent(inout) :: mesh
+      real (kind=RKIND), intent(in) :: dt
+      integer :: i, iEdge, iCell, k
+   
+   
+      call ocn_diagnostic_solve(dt, block % state % time_levs(1) % state, mesh)
+
+      call compute_mesh_scaling(mesh)

+      call mpas_rbf_interp_initialize(mesh)
+      call mpas_init_reconstruct(mesh)
+      call mpas_reconstruct(mesh, block % state % time_levs(1) % state % u % array,                  &amp;
+                       block % state % time_levs(1) % state % uReconstructX % array,            &amp;
+                       block % state % time_levs(1) % state % uReconstructY % array,            &amp;
+                       block % state % time_levs(1) % state % uReconstructZ % array,            &amp;
+                       block % state % time_levs(1) % state % uReconstructZonal % array,        &amp;
+                       block % state % time_levs(1) % state % uReconstructMeridional % array    &amp;
+                      )
+
+      ! initialize velocities and tracers on land to be -1e34
+      ! The reconstructed velocity on land will have values not exactly
+      ! -1e34 due to the interpolation of reconstruction.
+
+      do iEdge=1,block % mesh % nEdges
+         ! mrp 101115 note: in order to include flux boundary conditions, the following
+         ! line will need to change.  Right now, set boundary edges between land and 
+         ! water to have zero velocity.
+         block % state % time_levs(1) % state % u % array( &amp;
+             block % mesh % maxLevelEdgeTop % array(iEdge)+1 &amp;
+            :block % mesh % maxLevelEdgeBot % array(iEdge), iEdge) = 0.0
+
+         block % state % time_levs(1) % state % u % array( &amp;
+             block % mesh % maxLevelEdgeBot % array(iEdge)+1: &amp;
+             block % mesh % nVertLevels,iEdge) = 0.0
+! mrp changed to 0
+!             block % mesh % nVertLevels,iEdge) = -1e34
+      end do
+      do iCell=1,block % mesh % nCells
+         block % state % time_levs(1) % state % tracers % array( &amp;
+            :, block % mesh % maxLevelCell % array(iCell)+1 &amp;
+              :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(3,:,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, &amp;
+                             block % state % time_levs(1) % state)
+          end do
+! mrp 110808 add end
+
+
+      else
+          do i=2,nTimeLevs
+             call mpas_copy_state(block % state % time_levs(i) % state, &amp;
+                             block % state % time_levs(1) % state)
+          end do
+      endif
+
+   end subroutine mpas_init_block!}}}
+   
+   subroutine mpas_core_run(domain, output_obj, output_frame)!{{{
+   
+      use mpas_grid_types
+      use mpas_io_output
+      use mpas_timer
+   
+      implicit none
+   
+      type (domain_type), intent(inout) :: domain
+      type (io_output_object), intent(inout) :: output_obj
+      integer, intent(inout) :: output_frame
+   
+      integer :: itimestep
+      real (kind=RKIND) :: dt
+      type (block_type), pointer :: block_ptr
+
+      type (MPAS_Time_Type) :: currTime
+      character(len=32) :: timeStamp
+      integer :: ierr
+   
+      ! Eventually, dt should be domain specific
+      dt = config_dt
+
+      currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+      call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)
+      write(0,*) 'Initial time ', timeStamp
+
+      call write_output_frame(output_obj, output_frame, domain)
+
+      ! During integration, time level 1 stores the model state at the beginning of the
+      !   time step, and time level 2 stores the state advanced dt in time by timestep(...)
+      itimestep = 0
+      do while (.not. mpas_is_clock_stop_time(clock))
+
+         itimestep = itimestep + 1
+         call mpas_advance_clock(clock)
+
+         currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+         call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)
+         write(0,*) 'Doing timestep ', timeStamp
+
+         call mpas_timer_start(&quot;time integration&quot;)
+         call mpas_timestep(domain, itimestep, dt, timeStamp)
+         call mpas_timer_stop(&quot;time integration&quot;)
+   
+         ! Move time level 2 fields back into time level 1 for next time step
+         call mpas_shift_time_levels_state(domain % blocklist % state)
+      
+         if (mpas_is_alarm_ringing(clock, outputAlarmID, ierr=ierr)) then
+            call mpas_reset_clock_alarm(clock, outputAlarmID, ierr=ierr)
+            if(output_frame == 1) call mpas_output_state_init(output_obj, domain, &quot;OUTPUT&quot;, trim(timeStamp)) ! output_frame will always be &gt; 1 here unless it is reset after the output file is finalized
+            call write_output_frame(output_obj, output_frame, domain)
+         end if
+
+         if (mpas_is_alarm_ringing(clock, restartAlarmID, ierr=ierr)) then
+            call mpas_reset_clock_alarm(clock, restartAlarmID, ierr=ierr)
+            if (restart_frame == 1) call mpas_output_state_init(restart_obj, domain, &quot;RESTART&quot;)
+            call mpas_output_state_for_domain(restart_obj, domain, restart_frame)
+            restart_frame = restart_frame + 1
+         end if
+
+      end do
+
+   end subroutine mpas_core_run!}}}
+   
+   subroutine write_output_frame(output_obj, output_frame, domain)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Compute diagnostic fields for a domain and write model state to output file
+   !
+   ! Input/Output: domain - contains model state; diagnostic field are computed
+   !                        before returning
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   
+      use mpas_grid_types
+      use mpas_io_output
+   
+      implicit none
+   
+      integer, intent(inout) :: output_frame
+      type (domain_type), intent(inout) :: domain
+      type (io_output_object), intent(inout) :: output_obj
+   
+      integer :: i, j, k
+      integer :: eoe
+      type (block_type), pointer :: block_ptr
+   
+      block_ptr =&gt; domain % blocklist
+      do while (associated(block_ptr))
+         call compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
+         block_ptr =&gt; block_ptr % next
+      end do
+   
+      call mpas_output_state_for_domain(output_obj, domain, output_frame)
+      output_frame = output_frame + 1
+
+      ! if the maximum number of frames per outfile has been reached, finalize outfile and reset frame
+      if (config_frames_per_outfile &gt; 0) then
+         current_outfile_frames = current_outfile_frames + 1            
+         if(current_outfile_frames &gt;= config_frames_per_outfile) then
+            current_outfile_frames = 0
+            call mpas_output_state_finalize(output_obj, domain % dminfo)
+            output_frame = 1
+         end if
+      end if
+   
+   end subroutine write_output_frame!}}}
+   
+   subroutine compute_output_diagnostics(state, grid)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Compute diagnostic fields for a domain
+   !
+   ! 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 (mesh_type), intent(in) :: grid
+   
+      integer :: i, eoe
+      integer :: iEdge, k
+   
+   end subroutine compute_output_diagnostics!}}}
+   
+   subroutine mpas_timestep(domain, itimestep, dt, timeStamp)!{{{
+   
+      use mpas_grid_types
+      use mpas_timer
+      use global_diagnostics
+   
+      implicit none
+   
+      type (domain_type), intent(inout) :: domain 
+      integer, intent(in) :: itimestep
+      real (kind=RKIND), intent(in) :: dt
+      character(len=*), intent(in) :: timeStamp
+
+      type (block_type), pointer :: block_ptr
+      integer :: ierr
+   
+      call ocn_timestep(domain, dt, timeStamp)
+
+      if (config_stats_interval &gt; 0) then
+          if (mod(itimestep, config_stats_interval) == 0) then
+              block_ptr =&gt; domain % blocklist
+              if (associated(block_ptr % next)) then
+                  write(0,*) 'Error: computeGlobalDiagnostics assumes ',&amp;
+                     'that there is only one block per processor.'
+              end if
+
+          call mpas_timer_start(&quot;global diagnostics&quot;)
+          call computeGlobalDiagnostics(domain % dminfo, &amp;
+             block_ptr % state % time_levs(2) % state, block_ptr % mesh, &amp;
+             itimestep, dt)
+          call mpas_timer_stop(&quot;global diagnostics&quot;)
+          end if
+      end if
+
+      !TODO: replace the above code block with this if we desire to convert config_stats_interval to use alarms
+      !if (mpas_is_alarm_ringing(clock, statsAlarmID, ierr=ierr)) then
+      !   call mpas_reset_clock_alarm(clock, statsAlarmID, ierr=ierr)
+
+      !   block_ptr =&gt; domain % blocklist
+      !   if (associated(block_ptr % next)) then
+      !      write(0,*) 'Error: computeGlobalDiagnostics assumes ',&amp;
+      !                 'that there is only one block per processor.'
+      !   end if
+   
+      !   call mpas_timer_start(&quot;global diagnostics&quot;)
+      !   call computeGlobalDiagnostics(domain % dminfo, &amp;
+      !            block_ptr % state % time_levs(2) % state, block_ptr % mesh, &amp;
+      !            timeStamp, dt)
+      !   call mpas_timer_stop(&quot;global diagnostics&quot;)
+      !end if
+
+   end subroutine mpas_timestep!}}}
+
+subroutine init_ZLevel(domain)!{{{
+! Initialize maxLevel and bouncary grid variables.
+
+   use mpas_grid_types
+   use mpas_configure
+
+   implicit none
+
+   type (domain_type), intent(inout) :: domain
+
+   integer :: i, iCell, iEdge, iVertex, k
+   type (block_type), pointer :: block
+
+   integer :: iTracer, cell, cell1, cell2
+   real (kind=RKIND) :: uhSum, hSum, sshEdge
+   real (kind=RKIND), dimension(:), pointer :: &amp;
+      hZLevel, zMidZLevel, zTopZLevel, &amp;
+      hMeanTopZLevel, hRatioZLevelK, hRatioZLevelKm1
+   real (kind=RKIND), dimension(:,:), pointer :: h
+   integer :: nVertLevels
+
+   ! Initialize z-level grid variables from h, read in from input file.
+   block =&gt; domain % blocklist
+   do while (associated(block))
+
+      h          =&gt; block % state % time_levs(1) % state % h % array
+      hZLevel    =&gt; block % mesh % hZLevel % array
+      zMidZLevel =&gt; block % mesh % zMidZLevel % array
+      zTopZLevel =&gt; block % mesh % zTopZLevel % array
+      nVertLevels = block % mesh % nVertLevels
+      hMeanTopZLevel    =&gt; block % mesh % hMeanTopZLevel % array
+      hRatioZLevelK    =&gt; block % mesh % hRatioZLevelK % array
+      hRatioZLevelKm1    =&gt; block % mesh % hRatioZLevelKm1 % array
+
+      ! These should eventually be in an input file.  For now
+      ! I just read them in from h(:,1).
+      ! Upon restart, the correct hZLevel should be in restart.nc
+      if (.not. config_do_restart) hZLevel = h(:,1)
+
+      ! hZLevel should be in the grid.nc and restart.nc file, 
+      ! and h for k=1 must be specified there as well.

+      zTopZLevel(1) = 0.0
+      do k = 1,nVertLevels
+         zMidZLevel(k) = zTopZLevel(k)-0.5*hZLevel(k)
+         zTopZLevel(k+1) = zTopZLevel(k)-  hZLevel(k)
+      end do
+
+      hMeanTopZLevel(1) = 0.0
+      hRatioZLevelK(1) = 0.0
+      hRatioZLevelKm1(1) = 0.0
+      do k = 2,nVertLevels
+         hMeanTopZLevel(k) = 0.5*(hZLevel(k-1) + hZLevel(k))
+         hRatioZLevelK(k) = 0.5*hZLevel(k)/hMeanTopZLevel(k)
+         hRatioZLevelKm1(k) = 0.5*hZLevel(k-1)/hMeanTopZLevel(k)
+      end do
+
+      ! mrp 110601 For now, h is the variable saved in the restart file
+      ! I am computing SSH here.  In the future, could make smaller 
+      ! restart files for z-Level runs by saving SSH only.
+      do iCell=1,block % mesh % nCells
+
+          block % state % time_levs(1) % state % ssh % array(iCell) &amp; 
+        = block % state % time_levs(1) % state % h % array(1,iCell) &amp; 
+        - block % mesh % hZLevel % array(1)
+      enddo
+
+         ! Compute barotropic velocity at first timestep
+         ! This is only done upon start-up.
+         if     (trim(config_time_integration) == 'unsplit_explicit') then
+            block % state % time_levs(1) % state % uBtr % array(:) = 0.0
+
+              block % state % time_levs(1) % state % uBcl % array(:,:) &amp;
+            = block % state % time_levs(1) % state % u % array(:,:) 
+
+         elseif (trim(config_time_integration) == 'split_explicit') then
+
+            if (config_filter_btr_mode) then
+               do iCell=1,block % mesh % nCells
+                  block % state % time_levs(1) % state % h % array(1,iCell) &amp; 
+                = block % mesh % hZLevel % array(1)

+                  block % state % time_levs(1) % state % ssh % array(iCell) = 0.0
+               enddo
+            endif 
+
+            do iEdge=1,block % mesh % nEdges
+               cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+               cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+
+               sshEdge = 0.5*( &amp;
+                   block % state % time_levs(1) % state % ssh % array(cell1) &amp; 
+                 + block % state % time_levs(1) % state % ssh % array(cell2) ) 
+
+               ! uBtr = sum(u)/sum(h) on each column
+               uhSum = (sshEdge + block % mesh % hZLevel % array(1)) &amp;
+                  * block % state % time_levs(1) % state % u % array(1,iEdge)
+               hSum = sshEdge + block % mesh % hZLevel % array(1)
+
+               do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
+                  uhSum = uhSum &amp;
+                     + block % mesh % hZLevel % array(k) &amp;
+                      *block % state % time_levs(1) % state % u % array(k,iEdge)
+                  hSum = hSum &amp;
+                     + block % mesh % hZLevel % array(k)
+               enddo
+               block % state % time_levs(1) % state % uBtr % array(iEdge) = uhSum/hsum
+
+               ! uBcl(k,iEdge) = u(k,iEdge) - uBtr(iEdge)
+               do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
+                 block % state % time_levs(1) % state % uBcl % array(k,iEdge) &amp;
+                 = block % state % time_levs(1) % state % u % array(k,iEdge) &amp;
+                 - block % state % time_levs(1) % state % uBtr % array(iEdge)
+               enddo
+
+               ! uBcl=0, u=0 on land cells
+               do k=block % mesh % maxLevelEdgeTop % array(iEdge)+1, block % mesh % nVertLevels
+                 block % state % time_levs(1) % state % uBcl % array(k,iEdge) = 0.0
+                 block % state % time_levs(1) % state % u % array(k,iEdge) = 0.0
+               enddo
+            enddo
+
+            if (config_filter_btr_mode) then
+               ! filter uBtr out of initial condition
+                block % state % time_levs(1) % state % u % array(:,:) &amp;
+              = block % state % time_levs(1) % state % uBcl % array(:,:)
+
+               block % state % time_levs(1) % state % uBtr % array(:) = 0.0
+            endif 
+
+         endif
+
+!print *, '11 u ',minval(domain % blocklist % state % time_levs(1) % state % u % array(:,1:domain % blocklist % mesh % nEdgesSolve)), &amp;
+!                maxval(domain % blocklist % state % time_levs(1) % state % u % array(:,1:domain % blocklist % mesh % nEdgesSolve))
+!print *, '11 uBtr ',minval(domain % blocklist % state % time_levs(1) % state % uBtr % array(1:domain % blocklist % mesh % nEdgesSolve)), &amp;
+!                    maxval(domain % blocklist % state % time_levs(1) % state % uBtr % array(1:domain % blocklist % mesh % nEdgesSolve))
+!print *, '11 uBcl ',minval(domain % blocklist % state % time_levs(1) % state % uBcl % array(:,1:domain % blocklist % mesh % nEdgesSolve)), &amp;
+!                    maxval(domain % blocklist % state % time_levs(1) % state % uBcl % array(:,1:domain % blocklist % mesh % nEdgesSolve))
+
+
+! mrp temp testing - is uBcl vert sum zero?
+!            do iEdge=1,block % mesh % nEdges
+!              uhSum = (sshEdge + block % mesh % hZLevel % array(1)) * block % state % time_levs(1) % state % uBcl % array(1,iEdge)
+!              hSum  =  sshEdge + block % mesh % hZLevel % array(1)
+
+!              do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
+!                 uhSum = uhSum + block % mesh % hZLevel % array(k) *  block % state % time_levs(1) % state % uBcl % array(k,iEdge)
+!                 hSum  =  hSum + block % mesh % hZLevel % array(k)
+!              enddo
+!              block % state % time_levs(1) % state % FBtr % array(iEdge) = uhSum/hSum
+
+!           enddo ! iEdge
+
+!print *, 'uBcl vert sum IC',minval(block % state % time_levs(1) % state % FBtr % array(1:block % mesh % nEdgesSolve)), &amp;
+!                            maxval(block % state % time_levs(1) % state % FBtr % array(1:block % mesh % nEdgesSolve))
+
+! mrp temp testing - is uBcl vert sum zero? end
+
+      block =&gt; block % next
+
+   end do
+
+end subroutine init_ZLevel!}}}
+
+subroutine compute_maxLevel(domain)!{{{
+! Initialize maxLevel and bouncary grid variables.
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+
+   implicit none
+
+   type (domain_type), intent(inout) :: domain
+
+   integer :: i, iCell, iEdge, iVertex, k
+   type (block_type), pointer :: block
+
+   real (kind=RKIND), dimension(:,:), pointer :: h, u, u_src, rho
+   real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+   real (kind=RKIND) :: delta_rho, pi, latCenter, lonCenter, dist
+   real (kind=RKIND) :: centerx, centery
+   integer :: nCells, nEdges, nVertices, nVertLevels, vertexDegree
+
+   integer, dimension(:), pointer :: &amp;
+      maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &amp;
+      maxLevelVertexTop, maxLevelVertexBot
+   integer, dimension(:,:), pointer :: &amp;
+      cellsOnEdge, cellsOnVertex, boundaryEdge, boundaryCell, &amp;
+      boundaryVertex, verticesOnEdge
+
+   ! Initialize z-level grid variables from h, read in from input file.
+   block =&gt; domain % blocklist
+   do while (associated(block))
+
+      maxLevelCell =&gt; block % mesh % maxLevelCell % array
+      maxLevelEdgeTop =&gt; block % mesh % maxLevelEdgeTop % array
+      maxLevelEdgeBot =&gt; block % mesh % maxLevelEdgeBot % array
+      maxLevelVertexTop =&gt; block % mesh % maxLevelVertexTop % array
+      maxLevelVertexBot =&gt; block % mesh % maxLevelVertexBot % array
+      cellsOnEdge    =&gt; block % mesh % cellsOnEdge % array
+      cellsOnVertex  =&gt; block % mesh % cellsOnVertex % array
+      verticesOnEdge =&gt; block % mesh % verticesOnEdge % array
+      boundaryEdge   =&gt; block % mesh % boundaryEdge % array
+      boundaryCell   =&gt; block % mesh % boundaryCell % array
+      boundaryVertex =&gt; block % mesh % boundaryVertex % array
+
+      nCells      = block % mesh % nCells
+      nEdges      = block % mesh % nEdges
+      nVertices   = block % mesh % nVertices
+      nVertLevels = block % mesh % nVertLevels
+      vertexDegree = block % mesh % vertexDegree
+
+      ! for z-grids, maxLevelCell should be in input state
+      ! Isopycnal grid uses all vertical cells
+      if (config_vert_grid_type.eq.'isopycnal') then
+         maxLevelCell(1:nCells) = nVertLevels
+      endif
+      maxLevelCell(nCells+1) = 0
+
+      ! maxLevelEdgeTop is the minimum (shallowest) of the surrounding cells
+      do iEdge=1,nEdges
+         maxLevelEdgeTop(iEdge) = &amp;
+            min( maxLevelCell(cellsOnEdge(1,iEdge)), &amp;
+                 maxLevelCell(cellsOnEdge(2,iEdge)) )
+      end do 
+      maxLevelEdgeTop(nEdges+1) = 0
+
+      ! maxLevelEdgeBot is the maximum (deepest) of the surrounding cells
+      do iEdge=1,nEdges
+         maxLevelEdgeBot(iEdge) = &amp;
+            max( maxLevelCell(cellsOnEdge(1,iEdge)), &amp;
+                 maxLevelCell(cellsOnEdge(2,iEdge)) )
+      end do 
+      maxLevelEdgeBot(nEdges+1) = 0
+
+      ! maxLevelVertexBot is the maximum (deepest) of the surrounding cells
+      do iVertex = 1,nVertices
+         maxLevelVertexBot(iVertex) = maxLevelCell(cellsOnVertex(1,iVertex))
+         do i=2,vertexDegree
+            maxLevelVertexBot(iVertex) = &amp;
+               max( maxLevelVertexBot(iVertex), &amp;
+                    maxLevelCell(cellsOnVertex(i,iVertex)))
+         end do
+      end do 
+      maxLevelVertexBot(nVertices+1) = 0
+
+      ! maxLevelVertexTop is the minimum (shallowest) of the surrounding cells
+      do iVertex = 1,nVertices
+         maxLevelVertexTop(iVertex) = maxLevelCell(cellsOnVertex(1,iVertex))
+         do i=2,vertexDegree
+            maxLevelVertexTop(iVertex) = &amp;
+               min( maxLevelVertexTop(iVertex), &amp;
+                    maxLevelCell(cellsOnVertex(i,iVertex)))
+         end do
+      end do 
+      maxLevelVertexTop(nVertices+1) = 0
+
+      ! set boundary edge
+      boundaryEdge=1
+      do iEdge=1,nEdges
+         boundaryEdge(1:maxLevelEdgeTop(iEdge),iEdge)=0
+      end do 
+
+      !
+      ! Find cells and vertices that have an edge on the boundary
+      !
+      boundaryCell(:,:) = 0
+      do iEdge=1,nEdges
+         do k=1,nVertLevels
+            if (boundaryEdge(k,iEdge).eq.1) then
+               boundaryCell(k,cellsOnEdge(1,iEdge)) = 1
+               boundaryCell(k,cellsOnEdge(2,iEdge)) = 1
+               boundaryVertex(k,verticesOnEdge(1,iEdge)) = 1
+               boundaryVertex(k,verticesOnEdge(2,iEdge)) = 1
+            endif
+         end do
+      end do
+
+      block =&gt; block % next
+   end do
+
+   ! Note: We do not update halos on maxLevel* variables.  I want the
+   ! outside edge of a halo to be zero on each processor.
+
+end subroutine compute_maxLevel!}}}
+   
+   subroutine mpas_core_finalize(domain)!{{{
+   
+      use mpas_grid_types
+   
+      implicit none
+
+      integer :: ierr
+
+      type (domain_type), intent(inout) :: domain 
+
+      if (restart_frame &gt; 1) call mpas_output_state_finalize(restart_obj, domain % dminfo)
+
+      call mpas_destroy_clock(clock, ierr)
+
+   end subroutine mpas_core_finalize!}}}
+
+   subroutine compute_mesh_scaling(mesh)!{{{
+
+      use mpas_grid_types
+      use mpas_configure
+
+      implicit none
+
+      type (mesh_type), intent(inout) :: mesh
+
+      integer :: iEdge, cell1, cell2
+      real (kind=RKIND), dimension(:), pointer :: meshDensity, meshScalingDel2, meshScalingDel4
+
+      meshDensity =&gt; mesh % meshDensity % array
+      meshScalingDel2 =&gt; mesh % meshScalingDel2 % array
+      meshScalingDel4 =&gt; mesh % meshScalingDel4 % array
+
+      !
+      ! Compute the scaling factors to be used in the del2 and del4 dissipation
+      !
+      meshScalingDel2(:) = 1.0
+      meshScalingDel4(:) = 1.0
+      if (config_h_ScaleWithMesh) then
+         do iEdge=1,mesh%nEdges
+            cell1 = mesh % cellsOnEdge % array(1,iEdge)
+            cell2 = mesh % cellsOnEdge % array(2,iEdge)
+            meshScalingDel2(iEdge) = 1.0 / ( (meshDensity(cell1) + meshDensity(cell2) )/2.0)**(5.0/12.0)
+            meshScalingDel4(iEdge) = 1.0 / ( (meshDensity(cell1) + meshDensity(cell2) )/2.0)**(5.0/6.0)
+         end do
+      end if
+
+   end subroutine compute_mesh_scaling!}}}
+
+end module mpas_core
+
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_restoring.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_restoring.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_restoring.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,182 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_restoring
-!
-!&gt; \brief MPAS ocean restoring
-!&gt; \author Doug Jacobsen
-!&gt; \date   19 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  tendencies for restoring.
-!
-!-----------------------------------------------------------------------
-
-module ocn_restoring
-
-   use grid_types
-   use configure
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_restoring_tend, &amp;
-             ocn_restoring_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: restoringOn !&lt; Flag to turn on/off resotring
-
-   real (kind=RKIND) :: temperatureTimeScale, salinityTimeScale !&lt; restoring timescales
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_restoring_tend
-!
-!&gt; \brief   Computes tendency term for restoring
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the restoring tendency for tracers
-!&gt;  based on current state.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_restoring_tend(grid, h, indexT, indexS, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h    !&lt; Input: thickness
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-        tracers !&lt; Input: tracer quantities
-
-      integer, intent(in) :: indexT !&lt; Input: index for temperature
-      integer, intent(in) :: indexS !&lt; Input: index for salinity
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: Error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iCell, nCellsSolve, k
-
-      real (kind=RKIND), dimension(:), pointer :: temperatureRestore, salinityRestore
-
-      err = 0
-
-      if(.not.restoringOn) return
-
-      nCellsSolve = grid % nCellsSolve
-
-      temperatureRestore =&gt; grid % temperatureRestore % array
-      salinityRestore =&gt; grid % salinityRestore % array
-
-      k = 1  ! restoring only in top layer
-      do iCell=1,nCellsSolve
-
-        tend(indexT, k, iCell) = tend(indexT, k, iCell)  &amp;
-             - h(k,iCell)*(tracers(indexT, k, iCell) - temperatureRestore(iCell)) &amp;
-             / (temperatureTimeScale * 86400.0)
-
-        tend(indexS, k, iCell) = tend(indexS, k, iCell)  &amp;
-             - h(k,iCell)*(tracers(indexS, k, iCell) - salinityRestore(iCell)) &amp;
-             / (salinityTimeScale * 86400.0)
-
-!       write(6,10) iCell, tracers(indexT, k, iCell), &amp;
-!              temperatureRestore(iCell), tracers(indexT, k, iCell), &amp;
-!             (tracers(indexT, k, iCell) - temperatureRestore(iCell)) &amp;
-!             / (config_restoreT_timescale * 86400.0)
-
-      enddo
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_restoring_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_restoring_init
-!
-!&gt; \brief   Initializes ocean tracer restoring
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  restoring in the ocean. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_restoring_init(err)!{{{
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-      restoringOn = .false.
-
-      if(config_restoreTS) then
-          restoringOn = .true.
-          temperatureTimeScale = config_restoreT_timescale
-          salinityTimeScale = config_restoreS_timescale
-      endif
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_restoring_init!}}}
-
-!***********************************************************************
-
-end module ocn_restoring
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_restoring.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_restoring.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_restoring.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_restoring.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,182 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_restoring
+!
+!&gt; \brief MPAS ocean restoring
+!&gt; \author Doug Jacobsen
+!&gt; \date   19 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  tendencies for restoring.
+!
+!-----------------------------------------------------------------------
+
+module ocn_restoring
+
+   use mpas_grid_types
+   use mpas_configure
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_restoring_tend, &amp;
+             ocn_restoring_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: restoringOn !&lt; Flag to turn on/off resotring
+
+   real (kind=RKIND) :: temperatureTimeScale, salinityTimeScale !&lt; restoring timescales
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_restoring_tend
+!
+!&gt; \brief   Computes tendency term for restoring
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the restoring tendency for tracers
+!&gt;  based on current state.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_restoring_tend(grid, h, indexT, indexS, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h    !&lt; Input: thickness
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+        tracers !&lt; Input: tracer quantities
+
+      integer, intent(in) :: indexT !&lt; Input: index for temperature
+      integer, intent(in) :: indexS !&lt; Input: index for salinity
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: Error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iCell, nCellsSolve, k
+
+      real (kind=RKIND), dimension(:), pointer :: temperatureRestore, salinityRestore
+
+      err = 0
+
+      if(.not.restoringOn) return
+
+      nCellsSolve = grid % nCellsSolve
+
+      temperatureRestore =&gt; grid % temperatureRestore % array
+      salinityRestore =&gt; grid % salinityRestore % array
+
+      k = 1  ! restoring only in top layer
+      do iCell=1,nCellsSolve
+
+        tend(indexT, k, iCell) = tend(indexT, k, iCell)  &amp;
+             - h(k,iCell)*(tracers(indexT, k, iCell) - temperatureRestore(iCell)) &amp;
+             / (temperatureTimeScale * 86400.0)
+
+        tend(indexS, k, iCell) = tend(indexS, k, iCell)  &amp;
+             - h(k,iCell)*(tracers(indexS, k, iCell) - salinityRestore(iCell)) &amp;
+             / (salinityTimeScale * 86400.0)
+
+!       write(6,10) iCell, tracers(indexT, k, iCell), &amp;
+!              temperatureRestore(iCell), tracers(indexT, k, iCell), &amp;
+!             (tracers(indexT, k, iCell) - temperatureRestore(iCell)) &amp;
+!             / (config_restoreT_timescale * 86400.0)
+
+      enddo
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_restoring_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_restoring_init
+!
+!&gt; \brief   Initializes ocean tracer restoring
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  restoring in the ocean. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_restoring_init(err)!{{{
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+      restoringOn = .false.
+
+      if(config_restoreTS) then
+          restoringOn = .true.
+          temperatureTimeScale = config_restoreT_timescale
+          salinityTimeScale = config_restoreS_timescale
+      endif
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_restoring_init!}}}
+
+!***********************************************************************
+
+end module ocn_restoring
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tendency.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tendency.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tendency.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,1317 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tendency
-!
-!&gt; \brief MPAS ocean tendency driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   23 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the routines for computing
-!&gt;  various tendencies for the ocean. As well as routines
-!&gt;  for computing diagnostic variables, and other quantities
-!&gt;  such as wTop.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tendency
-
-   use grid_types
-   use configure
-   use constants
-   use timer
-
-   use ocn_thick_hadv
-   use ocn_thick_vadv
-
-   use ocn_vel_coriolis
-   use ocn_vel_pressure_grad
-   use ocn_vel_vadv
-   use ocn_vel_hmix
-   use ocn_vel_forcing
-
-   use ocn_tracer_hadv
-   use ocn_tracer_vadv
-   use ocn_tracer_hmix
-   use ocn_restoring
-
-   use ocn_equation_of_state
-   use ocn_vmix
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tend_h, &amp;
-             ocn_tend_u, &amp;
-             ocn_tend_scalar, &amp;
-             ocn_diagnostic_solve, &amp;
-             ocn_wtop, &amp;
-             ocn_fuperp
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tend_h
-!
-!&gt; \brief   Computes thickness tendency
-!&gt; \author  Doug Jacobsen
-!&gt; \date    23 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the thickness tendency for the ocean
-!
-!-----------------------------------------------------------------------
-
-   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
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      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
-
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
-        vertex1, vertex2, eoe, i, j, err
-
-! mrp 110512 I just split compute_tend into compute_tend_u and ocn_tend_h.
-!  Most of these variables can be removed, but at a later time.
-      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
-      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, &amp;
-        upstream_bias, wTopEdge, rho0Inv, r
-      real (kind=RKIND), dimension(:), pointer :: &amp;
-        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
-        zMidZLevel, zTopZLevel 
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &amp;
-        tend_h, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
-        MontPot, wTop, divergence, vertViscTopOfEdge
-      type (dm_info) :: dminfo
-
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
-        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
-      integer, dimension(:,:), pointer :: &amp;
-        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
-        edgesOnEdge, edgesOnVertex
-      real (kind=RKIND) :: u_diffusion
-      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
-
-      call timer_start(&quot;ocn_tend_h&quot;)
-
-      h           =&gt; s % h % array
-      u           =&gt; s % u % array
-      v           =&gt; s % v % array
-      wTop        =&gt; s % wTop % array
-      h_edge      =&gt; s % h_edge % array
-      circulation =&gt; s % circulation % array
-      vorticity   =&gt; s % vorticity % array
-      divergence  =&gt; s % divergence % array
-      ke          =&gt; s % ke % array
-      ke_edge     =&gt; s % ke_edge % array
-      pv_edge     =&gt; s % pv_edge % array
-      MontPot     =&gt; s % MontPot % array
-      pressure    =&gt; s % pressure % array
-      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      cellsOnVertex     =&gt; grid % cellsOnVertex % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
-      edgesOnCell       =&gt; grid % edgesOnCell % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      edgesOnVertex     =&gt; grid % edgesOnVertex % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      h_s               =&gt; grid % h_s % array
-      fVertex           =&gt; grid % fVertex % array
-      fEdge             =&gt; grid % fEdge % array
-      zMidZLevel        =&gt; grid % zMidZLevel % array
-      zTopZLevel        =&gt; grid % zTopZLevel % array
-      maxLevelCell      =&gt; grid % maxLevelCell % array
-      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
-      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
-
-      tend_h      =&gt; tend % h % array
-                  
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nEdgesSolve = grid % nEdgesSolve
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      !
-      ! height tendency: start accumulating tendency terms
-      !
-      tend_h = 0.0
-
-      !
-      ! height tendency: horizontal advection term -</font>
<font color="red">abla\cdot ( hu)
-      !
-      ! See Ringler et al. (2010) jcp paper, eqn 19, 21, and fig. 3. 
-      ! for explanation of divergence operator.
-      !
-      ! for z-level, only compute height tendency for top layer.
-
-      call timer_start(&quot;ocn_tend_h-horiz adv&quot;)
-
-      call ocn_thick_hadv_tend(grid, u, h_edge, tend_h, err)
-
-      call timer_stop(&quot;ocn_tend_h-horiz adv&quot;)
-
-      !
-      ! height tendency: vertical advection term -d/dz(hw)
-      !
-      ! Vertical advection computed for top layer of a z grid only.
-      call timer_start(&quot;ocn_tend_h-vert adv&quot;)
-
-      call ocn_thick_vadv_tend(grid, wtop, tend_h, err)
-
-      call timer_stop(&quot;ocn_tend_h-vert adv&quot;)
-      call timer_stop(&quot;ocn_tend_h&quot;)
-   
-   end subroutine ocn_tend_h!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tend_u
-!
-!&gt; \brief   Computes velocity tendency
-!&gt; \author  Doug Jacobsen
-!&gt; \date    23 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the velocity tendency for the ocean
-!
-!-----------------------------------------------------------------------
-
-   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
-
-! mrp 110512 I just split compute_tend into ocn_tend_u and compute_tend_h.
-!  Some of these variables can be removed, but at a later time.
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
-        vertex1, vertex2, eoe, i, j
-
-      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve, err
-      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, &amp;
-        upstream_bias, wTopEdge, rho0Inv, r, visc_vorticity_coef
-      real (kind=RKIND), dimension(:), pointer :: &amp;
-        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
-        zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &amp;
-        tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
-        MontPot, wTop, divergence, vertViscTopOfEdge
-      type (dm_info) :: dminfo
-
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
-        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
-      integer, dimension(:,:), pointer :: &amp;
-        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
-        edgesOnEdge, edgesOnVertex
-      real (kind=RKIND) :: u_diffusion
-      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
-
-
-      real (kind=RKIND), dimension(:,:), pointer :: u_src
-      real (kind=RKIND), parameter :: rho_ref = 1000.0
-
-      call timer_start(&quot;ocn_tend_u&quot;)
-
-      h           =&gt; s % h % array
-      u           =&gt; s % u % array
-      v           =&gt; s % v % array
-      wTop        =&gt; s % wTop % array
-      h_edge      =&gt; s % h_edge % array
-      circulation =&gt; s % circulation % array
-      vorticity   =&gt; s % vorticity % array
-      divergence  =&gt; s % divergence % array
-      ke          =&gt; s % ke % array
-      ke_edge     =&gt; s % ke_edge % array
-      pv_edge     =&gt; s % pv_edge % array
-      MontPot     =&gt; s % MontPot % array
-      pressure    =&gt; s % pressure % array
-      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      cellsOnVertex     =&gt; grid % cellsOnVertex % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
-      edgesOnCell       =&gt; grid % edgesOnCell % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      edgesOnVertex     =&gt; grid % edgesOnVertex % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      h_s               =&gt; grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
-      fVertex           =&gt; grid % fVertex % array
-      fEdge             =&gt; grid % fEdge % array
-      zMidZLevel        =&gt; grid % zMidZLevel % array
-      zTopZLevel        =&gt; grid % zTopZLevel % array
-      maxLevelCell      =&gt; grid % maxLevelCell % array
-      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
-      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
-
-      tend_u      =&gt; tend % u % array
-                  
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nEdgesSolve = grid % nEdgesSolve
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      u_src =&gt; grid % u_src % array
-
-      meshScalingDel2 =&gt; grid % meshScalingDel2 % array
-      meshScalingDel4 =&gt; grid % meshScalingDel4 % array
-
-      !
-      ! velocity tendency: start accumulating tendency terms
-      !
-      ! mrp 110516 efficiency: could remove next line and have first tend_u operation not be additive
-      tend_u(:,:) = 0.0
-
-      !
-      ! velocity tendency: nonlinear Coriolis term and grad of kinetic energy
-      !
-
-      call timer_start(&quot;ocn_tend_u-coriolis&quot;)
-
-      call ocn_vel_coriolis_tend(grid, pv_edge, h_edge, u, ke, tend_u, err)
-
-      call timer_stop(&quot;ocn_tend_u-coriolis&quot;)
-
-      !
-      ! velocity tendency: vertical advection term -w du/dz
-      !
-      call timer_start(&quot;ocn_tend_u-vert adv&quot;)
-
-      call ocn_vel_vadv_tend(grid, u, wtop, tend_u, err)
-
-      call timer_stop(&quot;ocn_tend_u-vert adv&quot;)
-
-      !
-      ! velocity tendency: pressure gradient
-      !
-      call timer_start(&quot;ocn_tend_u-pressure grad&quot;)
-
-      if (config_vert_grid_type.eq.'isopycnal') then
-          call ocn_vel_pressure_grad_tend(grid, MontPot, tend_u, err)
-      elseif (config_vert_grid_type.eq.'zlevel') then
-          call ocn_vel_pressure_grad_tend(grid, pressure, tend_u, err)
-      end if
-
-      call timer_stop(&quot;ocn_tend_u-pressure grad&quot;)
-
-      !
-      ! velocity tendency: del2 dissipation, </font>
<font color="black">u_2 </font>
<font color="red">abla^2 u
-      !   computed as </font>
<font color="black">u( </font>
<font color="black">abla divergence + k \times </font>
<font color="red">abla vorticity )
-      !   strictly only valid for config_h_mom_eddy_visc2 == constant
-      !
-      call timer_start(&quot;ocn_tend_u-horiz mix&quot;)
-
-      call ocn_vel_hmix_tend(grid, divergence, vorticity, tend_u, err)
-
-      call timer_stop(&quot;ocn_tend_u-horiz mix&quot;)
-
-      !
-      ! velocity tendency: forcing and bottom drag
-      !
-      ! mrp 101115 note: in order to include flux boundary conditions, we will need to 
-      ! know the bottom edge with nonzero velocity and place the drag there.
-
-      call timer_start(&quot;ocn_tend_u-forcings&quot;)
-
-      call ocn_vel_forcing_tend(grid, u, u_src, ke_edge, h_edge, tend_u, err)
-
-      call timer_stop(&quot;ocn_tend_u-forcings&quot;)
-
-      !
-      ! velocity tendency: vertical mixing d/dz( nu_v du/dz))
-      !
-      if (.not.config_implicit_vertical_mix) then
-          call timer_start(&quot;ocn_tend_u-explicit vert mix&quot;)
-
-          call ocn_vel_vmix_tend_explicit(grid, u, h_edge, vertvisctopofedge, tend_u, err)
-
-          call timer_stop(&quot;ocn_tend_u-explicit vert mix&quot;)
-      endif
-      call timer_stop(&quot;ocn_tend_u&quot;)
-
-   end subroutine ocn_tend_u!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tendSalar
-!
-!&gt; \brief   Computes scalar tendency
-!&gt; \author  Doug Jacobsen
-!&gt; \date    23 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  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
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      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
-
-      integer :: i, k, iCell, iEdge, iTracer, cell1, cell2, upwindCell,&amp;
-        nEdges, nCells, nCellsSolve, nVertLevels, num_tracers, err
-      real (kind=RKIND) :: invAreaCell1, invAreaCell2, tracer_turb_flux
-      real (kind=RKIND) :: flux, tracer_edge, r
-      real (kind=RKIND), dimension(:), pointer :: &amp;
-        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        u,h,wTop, h_edge, vertDiffTopOfCell
-      real (kind=RKIND), dimension(:,:,:), pointer :: &amp;
-        tracers, tend_tr
-      integer, dimension(:,:), pointer :: boundaryEdge
-      type (dm_info) :: dminfo
-
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
-        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
-      integer, dimension(:,:), pointer :: cellsOnEdge, boundaryCell
-      real (kind=RKIND), dimension(:), pointer :: zTopZLevel,zMidZLevel, &amp;
-         hRatioZLevelK, hRatioZLevelKm1, meshScalingDel2, meshScalingDel4
-      real (kind=RKIND), dimension(:), allocatable:: tracer2ndDer, tracersIn, tracersOut, posZMidZLevel, &amp;
-            posZTopZLevel
-      real (kind=RKIND), dimension(:,:), allocatable:: fluxVertTop, boundaryMask
-      real (kind=RKIND), dimension(:,:,:), allocatable::tr_flux, tr_div, delsq_tracer, tracerTop
-
-
-      real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      real (kind=RKIND) :: coef_3rd_order, flux3Coef, cSignWTop
-
-      integer :: index_temperature, index_salinity, rrr
-      real (kind=RKIND), dimension(:), pointer :: temperatureRestore, salinityRestore
-
-      call timer_start(&quot;ocn_tend_scalar&quot;)
-
-      u           =&gt; s % u % array
-      h           =&gt; s % h % array
-      boundaryCell=&gt; grid % boundaryCell % array
-      wTop        =&gt; s % wTop % array
-      tracers     =&gt; s % tracers % array
-      h_edge      =&gt; s % h_edge % array
-      vertDiffTopOfCell =&gt; d % vertDiffTopOfCell % array
-
-      tend_tr     =&gt; tend % tracers % array
-                  
-      areaCell          =&gt; grid % areaCell % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      dcEdge            =&gt; grid % dcEdge % array
-      zTopZLevel        =&gt; grid % zTopZLevel % array
-      zMidZLevel        =&gt; grid % zMidZLevel % array
-      hRatioZLevelK    =&gt; grid % hRatioZLevelK % array
-      hRatioZLevelKm1    =&gt; grid % hRatioZLevelKm1 % array
-      boundaryEdge      =&gt; grid % boundaryEdge % array
-      maxLevelCell      =&gt; grid % maxLevelCell % array
-      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
-      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
-
-      nEdges      = grid % nEdges
-      nCells      = grid % nCells
-      nCellsSolve = grid % nCellsSolve
-      nVertLevels = grid % nVertLevels
-      num_tracers = s % num_tracers
-
-      meshScalingDel2 =&gt; grid % meshScalingDel2 % array
-      meshScalingDel4 =&gt; grid % meshScalingDel4 % array
-
-
-      deriv_two   =&gt; grid % deriv_two % array
-
-      !
-      ! initialize tracer tendency (RHS of tracer equation) to zero.
-      !
-      tend_tr(:,:,:) = 0.0
-
-      !
-      ! tracer tendency: horizontal advection term -div( h \phi u)
-      !
-      ! mrp 101115 note: in order to include flux boundary conditions, we will need to 
-      ! assign h_edge for maxLevelEdgeTop:maxLevelEdgeBot in the compute_solve_diagnostics
-      ! 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 timer_start(&quot;ocn_tend_scalar-horiz adv&quot;)
-
-      call ocn_tracer_hadv_tend(grid, u, h_edge, tracers, tend_tr, err)
-
-      call timer_stop(&quot;ocn_tend_scalar-horiz adv&quot;)
-
-
-      !
-      ! tracer tendency: vertical advection term -d/dz( h \phi w)
-      !
-
-      call timer_start(&quot;ocn_tend_scalar-vert adv&quot;)
-
-      call ocn_tracer_vadv_tend(grid, wtop, tracers, tend_tr, err)
-
-      call timer_stop(&quot;ocn_tend_scalar-vert adv&quot;)
-
-      !
-      ! tracer tendency: del2 horizontal tracer diffusion, div(h \kappa_2 </font>
<font color="gray">abla \phi)
-      !
-      call timer_start(&quot;ocn_tend_scalar-horiz diff&quot;)
-
-      call ocn_tracer_hmix_tend(grid, h_edge, tracers, tend_tr, err)
-
-      call timer_stop(&quot;ocn_tend_scalar-horiz diff&quot;)
-
-! mrp 110516 printing
-!print *, 'tend_tr 1',minval(tend_tr(3,1,1:nCells)),&amp;
-!                   maxval(tend_tr(3,1,1:nCells))
-!print *, 'tracer  1',minval(tracers(3,1,1:nCells)),&amp;
-!                   maxval(tracers(3,1,1:nCells))
-! mrp 110516 printing end
-
-      !
-      ! tracer tendency: vertical diffusion h d/dz( \kappa_v d\phi/dz)
-      !
-      if (.not.config_implicit_vertical_mix) then
-         call timer_start(&quot;ocn_tend_scalar-explicit vert diff&quot;)
-
-         call ocn_tracer_vmix_tend_explicit(grid, h, vertdifftopofcell, tracers, tend_tr, err)
-
-         call timer_stop(&quot;ocn_tend_scalar-explicit vert diff&quot;)
-      endif
-
-! mrp 110516 printing
-!print *, 'tend_tr 2',minval(tend_tr(3,1,1:nCells)),&amp;
-!                   maxval(tend_tr(3,1,1:nCells))
-! mrp 110516 printing end
-
-      !
-      ! add restoring to T and S in top model layer
-      !
-      call timer_start(&quot;ocn_tend_scalar-restoring&quot;)
-
-      call ocn_restoring_tend(grid, h, s%index_temperature, s%index_salinity, tracers, tend_tr, err)
-
-      call timer_stop(&quot;ocn_tend_scalar-restoring&quot;)
-
- 10   format(2i8,10e20.10)
-      call timer_stop(&quot;ocn_tend_scalar&quot;)
-
-   end subroutine ocn_tend_scalar!}}}
-
-!***********************************************************************
-!
-!  routine ocn_diagnostic_solve
-!
-!&gt; \brief   Computes diagnostic variables
-!&gt; \author  Doug Jacobsen
-!&gt; \date    23 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the diagnostic variables for the ocean
-!
-!-----------------------------------------------------------------------
-
-   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
-
-
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
-      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, rho0Inv
-
-      integer :: nCells, nEdges, nVertices, nVertLevels, vertexDegree, fCoef, err
-
-
-      real (kind=RKIND), dimension(:), pointer :: &amp;
-        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
-        hZLevel
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, w, pressure,&amp;
-        circulation, vorticity, ke, ke_edge, MontPot, wTop, &amp;
-        pv_edge, pv_vertex, pv_cell, gradPVn, gradPVt, divergence, &amp;
-        rho, temperature, salinity
-      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
-      real (kind=RKIND), dimension(:), allocatable:: pTop
-      real (kind=RKIND), dimension(:,:), allocatable:: div_u
-      character :: c1*6
-
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, &amp;
-        verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex, &amp;
-        boundaryEdge, boundaryCell
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
-        maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &amp;
-        maxLevelVertexBot,  maxLevelVertexTop
-      real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      real (kind=RKIND) :: coef_3rd_order
-      real (kind=RKIND) :: r, h1, h2
-
-      call timer_start(&quot;ocn_diagnostic_solve&quot;)
-
-      h           =&gt; s % h % array
-      u           =&gt; s % u % array
-      v           =&gt; s % v % array
-      wTop        =&gt; s % wTop % array
-      h_edge      =&gt; s % h_edge % array
-      circulation =&gt; s % circulation % array
-      vorticity   =&gt; s % vorticity % array
-      divergence  =&gt; s % divergence % array
-      ke          =&gt; s % ke % array
-      ke_edge     =&gt; s % ke_edge % array
-      pv_edge     =&gt; s % pv_edge % array
-      pv_vertex   =&gt; s % pv_vertex % array
-      pv_cell     =&gt; s % pv_cell % array
-      gradPVn     =&gt; s % gradPVn % array
-      gradPVt     =&gt; s % gradPVt % array
-      rho         =&gt; s % rho % array
-      tracers     =&gt; s % tracers % array
-      MontPot     =&gt; s % MontPot % array
-      pressure    =&gt; s % pressure % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      cellsOnVertex     =&gt; grid % cellsOnVertex % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
-      edgesOnCell       =&gt; grid % edgesOnCell % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      edgesOnVertex     =&gt; grid % edgesOnVertex % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      h_s               =&gt; grid % h_s % array
-      fVertex           =&gt; grid % fVertex % array
-      fEdge             =&gt; grid % fEdge % array
-      hZLevel           =&gt; grid % hZLevel % array
-      deriv_two         =&gt; grid % deriv_two % array
-      maxLevelCell      =&gt; grid % maxLevelCell % array
-      maxLevelEdgeTop   =&gt; grid % maxLevelEdgeTop % array
-      maxLevelEdgeBot   =&gt; grid % maxLevelEdgeBot % array
-      maxLevelVertexBot =&gt; grid % maxLevelVertexBot % array
-      maxLevelVertexTop =&gt; grid % maxLevelVertexTop % array
-                  
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-      vertexDegree = grid % vertexDegree
-
-      boundaryEdge =&gt; grid % boundaryEdge % array
-      boundaryCell =&gt; grid % boundaryCell % array
-
-      !
-      ! Compute height on cell edges at velocity locations
-      !   Namelist options control the order of accuracy of the reconstructed h_edge value
-      !
-      ! mrp 101115 note: in order to include flux boundary conditions, we will need to 
-      ! assign h_edge for maxLevelEdgeTop:maxLevelEdgeBot in the following section
-
-      ! mrp 110516 efficiency note: For z-level, only do this on level 1.  h_edge for all
-      ! lower levels is defined by hZlevel.
-
-      call timer_start(&quot;ocn_diagnostic_solve-hEdge&quot;)
-
-      coef_3rd_order = 0.
-      if (config_thickness_adv_order == 3) coef_3rd_order = 1.0
-      if (config_thickness_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
-
-      if (config_thickness_adv_order == 2) then
-          call timer_start(&quot;ocn_diagnostic_solve-hEdge 2&quot;)
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            do k=1,maxLevelEdgeTop(iEdge)
-               h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
-            end do
-         end do
-          call timer_stop(&quot;ocn_diagnostic_solve-hEdge 2&quot;)
-
-      else if (config_thickness_adv_order == 3) then
-          call timer_start(&quot;ocn_diagnostic_solve-hEdge 3&quot;)
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-
-            do k=1,maxLevelEdgeTop(iEdge)
-
-               d2fdx2_cell1 = 0.0
-               d2fdx2_cell2 = 0.0
-
-               !-- if not a boundary cell
-               if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
-
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2)
-
-                  !-- all edges of cell 1
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                          d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                          deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (i,cell1))
-                  end do
-
-                  !-- all edges of cell 2
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                          d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                          deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
-                  end do
-
-               endif
-
-               !-- if u &gt; 0:
-               if (u(k,iEdge) &gt; 0) then
-                  h_edge(k,iEdge) =     &amp;
-                       0.5*(h(k,cell1) + h(k,cell2))      &amp;
-                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                       -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
-               !-- else u &lt;= 0:
-               else
-                  h_edge(k,iEdge) =     &amp;
-                       0.5*(h(k,cell1) + h(k,cell2))      &amp;
-                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                       +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
-               end if
-
-            end do   ! do k
-         end do         ! do iEdge
-
-          call timer_stop(&quot;ocn_diagnostic_solve-hEdge 3&quot;)
-      else  if (config_thickness_adv_order == 4) then
-          call timer_start(&quot;ocn_diagnostic_solve-hEdge 4&quot;)
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-
-            do k=1,maxLevelEdgeTop(iEdge)
-
-               d2fdx2_cell1 = 0.0
-               d2fdx2_cell2 = 0.0
-
-               !-- if not a boundary cell
-               if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
-
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2)
-
-                  !-- all edges of cell 1
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                          d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                          deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (i,cell1))
-                  end do
-
-                  !-- all edges of cell 2
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                          d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                          deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
-                  end do
-
-               endif
-
-               h_edge(k,iEdge) =   &amp;
-                    0.5*(h(k,cell1) + h(k,cell2))      &amp;
-                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.
-
-            end do   ! do k
-         end do         ! do iEdge
-
-         call timer_stop(&quot;ocn_diagnostic_solve-hEdge 4&quot;)
-      endif   ! if(config_thickness_adv_order == 2)
-      call timer_stop(&quot;ocn_diagnostic_solve-hEdge&quot;)
-
-      !
-      ! set the velocity and height at dummy address
-      !    used -1e34 so error clearly occurs if these values are used.
-      !
-!mrp 110516 change to zero, change back later:
-      u(:,nEdges+1) = -1e34
-      h(:,nCells+1) = -1e34
-      tracers(s % index_temperature,:,nCells+1) = -1e34
-      tracers(s % index_salinity,:,nCells+1) = -1e34
-
-      !
-      ! Compute circulation and relative vorticity at each vertex
-      !
-      circulation(:,:) = 0.0
-      do iEdge=1,nEdges
-         vertex1 = verticesOnEdge(1,iEdge)
-         vertex2 = verticesOnEdge(2,iEdge)
-         do k=1,maxLevelEdgeBot(iEdge)
-            circulation(k,vertex1) = circulation(k,vertex1) - dcEdge(iEdge) * u(k,iEdge)
-            circulation(k,vertex2) = circulation(k,vertex2) + dcEdge(iEdge) * u(k,iEdge)
-         end do
-      end do
-      do iVertex=1,nVertices
-         do k=1,maxLevelVertexBot(iVertex)
-            vorticity(k,iVertex) = circulation(k,iVertex) / areaTriangle(iVertex)
-         end do
-      end do
-
-      !
-      ! Compute the divergence at each cell center
-      !
-      divergence(:,:) = 0.0
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=1,maxLevelEdgeBot(iEdge)
-             divergence(k,cell1) = divergence(k,cell1) + u(k,iEdge)*dvEdge(iEdge)
-             divergence(k,cell2) = divergence(k,cell2) - u(k,iEdge)*dvEdge(iEdge)
-         enddo
-      end do
-      do iCell = 1,nCells
-         r = 1.0 / areaCell(iCell)
-         do k = 1,maxLevelCell(iCell)
-            divergence(k,iCell) = divergence(k,iCell) * r
-         enddo
-      enddo
-
-      !
-      ! Compute kinetic energy in each cell
-      !
-      ke(:,:) = 0.0
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=1,maxLevelEdgeBot(iEdge)
-              ke(k,cell1) = ke(k,cell1) + 0.25 * dcEdge(iEdge) * dvEdge(iEdge) * u(k,iEdge)**2.0
-              ke(k,cell2) = ke(k,cell2) + 0.25 * dcEdge(iEdge) * dvEdge(iEdge) * u(k,iEdge)**2.0
-         enddo
-      end do
-      do iCell = 1,nCells
-         do k = 1,maxLevelCell(iCell)
-            ke(k,iCell) = ke(k,iCell) / areaCell(iCell)
-         enddo
-      enddo
-
-      !
-      ! Compute v (tangential) velocities
-      !
-      v(:,:) = 0.0
-      do iEdge = 1,nEdges
-         do i=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(i,iEdge)
-            ! mrp 101115 note: in order to include flux boundary conditions,
-            ! the following loop may need to change to maxLevelEdgeBot
-            do k = 1,maxLevelEdgeTop(iEdge) 
-               v(k,iEdge) = v(k,iEdge) + weightsOnEdge(i,iEdge) * u(k, eoe)
-            end do
-         end do
-      end do
-
-      !
-      ! Compute ke on cell edges at velocity locations for quadratic bottom drag. 
-      !
-      ! mrp 101025 efficiency note: we could get rid of ke_edge completely by 
-      ! using sqrt(u(k,iEdge)**2 + v(k,iEdge)**2) in its place elsewhere.
-      ke_edge = 0.0  !mrp remove 0 for efficiency
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=1,maxLevelEdgeTop(iEdge)
-            ke_edge(k,iEdge) = 0.5 * (ke(k,cell1) + ke(k,cell2))
-         end do
-      end do
-
-      !
-      ! 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 )
-      !
-      if (trim(config_time_integration) == 'RK4') then
-         ! for RK4, PV is really PV = (eta+f)/h
-         fCoef = 1
-      elseif (trim(config_time_integration) == 'split_explicit' &amp;
-          .or.trim(config_time_integration) == 'unsplit_explicit') then
-         ! for split explicit, PV is eta/h because f is added separately to the momentum forcing.
-! mrp temp, new should be:
-         fCoef = 0
-! old, for testing:
-!         fCoef = 1
-      end if
-
-      do iVertex = 1,nVertices
-         do k=1,maxLevelVertexBot(iVertex)
-            h_vertex = 0.0
-            do i=1,vertexDegree
-               h_vertex = h_vertex + h(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
-            end do
-            h_vertex = h_vertex / areaTriangle(iVertex)
-
-            pv_vertex(k,iVertex) = (fCoef*fVertex(iVertex) + vorticity(k,iVertex)) / h_vertex
-         end do
-      end do
-
-      !
-      ! Compute pv at cell centers
-      !    ( this computes pv_cell for all real cells and distance-1 ghost cells )
-      !
-      pv_cell(:,:) = 0.0
-      do iVertex = 1,nVertices
-         do i=1,vertexDegree
-            iCell = cellsOnVertex(i,iVertex)
-            do k = 1,maxLevelCell(iCell)
-               pv_cell(k,iCell) = pv_cell(k,iCell)  &amp;
-                  + kiteAreasOnVertex(i, iVertex) * pv_vertex(k, iVertex) &amp;
-                    / areaCell(iCell)
-            enddo
-         enddo
-      enddo
-
-      !
-      ! Compute pv at the edges
-      !   ( this computes pv_edge at all edges bounding real cells )
-      !
-      pv_edge(:,:) = 0.0
-      do iVertex = 1,nVertices
-         do i=1,vertexDegree
-            iEdge = edgesOnVertex(i,iVertex)
-            do k=1,maxLevelEdgeBot(iEdge)
-               pv_edge(k,iEdge) =  pv_edge(k,iEdge) + 0.5 * pv_vertex(k,iVertex)
-            enddo
-        end do
-      end do
-
-      !
-      ! Compute gradient of PV in normal direction
-      !   ( this computes gradPVn for all edges bounding real cells )
-      !
-      gradPVn(:,:) = 0.0
-      do iEdge = 1,nEdges
-         do k=1,maxLevelEdgeTop(iEdge)
-            gradPVn(k,iEdge) = (  pv_cell(k,cellsOnEdge(2,iEdge)) &amp;
-                                - pv_cell(k,cellsOnEdge(1,iEdge))) &amp;
-                               / dcEdge(iEdge)
-         enddo
-      enddo
-
-      !
-      ! Compute gradient of PV in the tangent direction
-      !   ( this computes gradPVt at all edges bounding real cells and distance-1 ghost cells )
-      !
-      do iEdge = 1,nEdges
-         do k = 1,maxLevelEdgeBot(iEdge)
-           gradPVt(k,iEdge) = (  pv_vertex(k,verticesOnEdge(2,iEdge)) &amp;
-                               - pv_vertex(k,verticesOnEdge(1,iEdge))) &amp;
-                                 /dvEdge(iEdge)
-         enddo
-      enddo
-
-      !
-      ! Modify PV edge with upstream bias.
-      !
-      do iEdge = 1,nEdges
-         do k = 1,maxLevelEdgeBot(iEdge)
-           pv_edge(k,iEdge) = pv_edge(k,iEdge) &amp;
-             - 0.5 * dt* (  u(k,iEdge) * gradPVn(k,iEdge) &amp;
-                          + v(k,iEdge) * gradPVt(k,iEdge) )
-         enddo
-      enddo
-
-      !
-      ! equation of state
-      !
-      ! For an isopycnal model, density should remain constant.
-      ! For zlevel, calculate in-situ density
-      if (config_vert_grid_type.eq.'zlevel') then
-         call ocn_equation_of_state_rho(s, grid, 0, 'relative', err)
-      ! mrp 110324 In order to visualize rhoDisplaced, include the following
-         call ocn_equation_of_state_rho(s, grid, 1, 'relative', err)
-      endif
-
-      !
-      ! Pressure
-      ! This section must be after computing rho
-      !
-      if (config_vert_grid_type.eq.'isopycnal') then
-
-        ! For Isopycnal model.
-        ! Compute pressure at top of each layer, and then
-        ! Montgomery Potential.
-        allocate(pTop(nVertLevels))
-        do iCell=1,nCells
-
-           ! assume atmospheric pressure at the surface is zero for now.
-           pTop(1) = 0.0
-           ! For isopycnal mode, p is the Montgomery Potential.
-           ! At top layer it is g*SSH, where SSH may be off by a 
-           ! constant (ie, h_s can be relative to top or bottom)
-           MontPot(1,iCell) = gravity &amp;
-              * (h_s(iCell) + sum(h(1:nVertLevels,iCell)))
-
-           do k=2,nVertLevels
-              pTop(k) = pTop(k-1) + rho(k-1,iCell)*gravity* h(k-1,iCell)
-
-              ! from delta M = p delta / rho
-              MontPot(k,iCell) = MontPot(k-1,iCell) &amp;
-                 + pTop(k)*(1.0/rho(k,iCell) - 1.0/rho(k-1,iCell)) 
-           end do
-
-        end do
-        deallocate(pTop)
-
-      elseif (config_vert_grid_type.eq.'zlevel') then
-
-        ! For z-level model.
-        ! Compute pressure at middle of each level.  
-        ! At k=1, where p is pressure at a depth of hZLevel(1)/2, not
-        ! pressure at middle of layer including SSH.
-
-        do iCell=1,nCells
-           ! compute pressure for z-level coordinates
-           ! assume atmospheric pressure at the surface is zero for now.
-
-           pressure(1,iCell) = rho(1,iCell)*gravity &amp;
-              * (h(1,iCell)-0.5*hZLevel(1)) 
-
-           do k=2,maxLevelCell(iCell)
-              pressure(k,iCell) = pressure(k-1,iCell)  &amp;
-                + 0.5*gravity*(  rho(k-1,iCell)*hZLevel(k-1) &amp;
-                               + rho(k  ,iCell)*hZLevel(k  ))
-           end do
-
-        end do
-
-      endif
-
-      call ocn_wtop(s,grid)
-
-      call timer_stop(&quot;ocn_diagnostic_solve&quot;)
-
-   end subroutine ocn_diagnostic_solve!}}}
-
-!***********************************************************************
-!
-!  routine ocn_wtop
-!
-!&gt; \brief   Computes vertical velocity
-!&gt; \author  Doug Jacobsen
-!&gt; \date    23 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical velocity in the top layer for the ocean
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_wtop(s, grid)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute diagnostic fields used in the tendency computations
-   !
-   ! Input: grid - grid metadata
-   !
-   ! Output: s - computed diagnostics
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (state_type), intent(inout) :: s
-      type (mesh_type), intent(in) :: grid
-
-      ! mrp 110512 could clean this out, remove pointers?
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
-      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, rho0Inv
-
-      integer :: nCells, nEdges, nVertices, nVertLevels, vertexDegree
-
-
-      real (kind=RKIND), dimension(:), pointer :: &amp;
-        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
-        hZLevel
-      real (kind=RKIND), dimension(:,:), pointer :: u,wTop
-      real (kind=RKIND), dimension(:,:), allocatable:: div_u
-
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, &amp;
-        verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex, &amp;
-        boundaryEdge, boundaryCell
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
-        maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &amp;
-        maxLevelVertexBot,  maxLevelVertexTop
-
-        call timer_start(&quot;wTop&quot;)
-
-      u           =&gt; s % u % array
-      wTop        =&gt; s % wTop % array
-
-      areaCell          =&gt; grid % areaCell % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      hZLevel           =&gt; grid % hZLevel % array
-      maxLevelCell      =&gt; grid % maxLevelCell % array
-      maxLevelEdgeBot   =&gt; grid % maxLevelEdgeBot % array
-      dvEdge            =&gt; grid % dvEdge % array
-
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertLevels = grid % nVertLevels
-
-      !
-      ! vertical velocity through layer interface
-      !
-      if (config_vert_grid_type.eq.'isopycnal') then
-        ! set vertical velocity to zero in isopycnal case
-        wTop=0.0  
-
-      elseif (config_vert_grid_type.eq.'zlevel') then
-
-        !
-        ! Compute div(u) for each cell
-        ! See Ringler et al. (2010) jcp paper, eqn 19, 21, and fig. 3.
-        !
-        allocate(div_u(nVertLevels,nCells+1))
-        div_u(:,:) = 0.0
-        do iEdge=1,nEdges
-           cell1 = cellsOnEdge(1,iEdge)
-           cell2 = cellsOnEdge(2,iEdge)
-           do k=2,maxLevelEdgeBot(iEdge)
-              flux = u(k,iEdge) * dvEdge(iEdge) 
-              div_u(k,cell1) = div_u(k,cell1) + flux
-              div_u(k,cell2) = div_u(k,cell2) - flux
-           end do 
-        end do 
-
-        do iCell=1,nCells
-           ! Vertical velocity through layer interface at top and 
-           ! bottom is zero.
-           wTop(1,iCell) = 0.0
-           wTop(maxLevelCell(iCell)+1,iCell) = 0.0
-           do k=maxLevelCell(iCell),2,-1
-              wTop(k,iCell) = wTop(k+1,iCell) &amp;
-                 - div_u(k,iCell)/areaCell(iCell)*hZLevel(k)
-           end do
-        end do
-        deallocate(div_u)
-
-      endif
-
-      call timer_stop(&quot;wTop&quot;)
-
-   end subroutine ocn_wtop!}}}
-
-!***********************************************************************
-!
-!  routine ocn_fuperp
-!
-!&gt; \brief   Computes f u_perp
-!&gt; \author  Doug Jacobsen
-!&gt; \date    23 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes f u_perp for the ocean
-!
-!-----------------------------------------------------------------------
-
-   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
-
-! mrp 110512 I just split compute_tend into compute_tend_u and compute_tend_h.
-!  Some of these variables can be removed, but at a later time.
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
-        vertex1, vertex2, eoe, i, j
-
-      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
-      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, &amp;
-        upstream_bias, wTopEdge, rho0Inv, r
-      real (kind=RKIND), dimension(:), pointer :: &amp;
-        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
-        zMidZLevel, zTopZLevel 
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, uBcl, v, pressure, &amp;
-        tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
-        MontPot, wTop, divergence, vertViscTopOfEdge
-      type (dm_info) :: dminfo
-
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
-        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
-      integer, dimension(:,:), pointer :: &amp;
-        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
-        edgesOnEdge, edgesOnVertex
-      real (kind=RKIND) :: u_diffusion
-      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
-
-
-      real (kind=RKIND), dimension(:,:), pointer :: u_src
-      real (kind=RKIND), parameter :: rho_ref = 1000.0
-
-      call timer_start(&quot;ocn_fuperp&quot;)
-
-      h           =&gt; s % h % array
-      u           =&gt; s % u % array
-      uBcl        =&gt; s % uBcl % array
-      v           =&gt; s % v % array
-      wTop        =&gt; s % wTop % array
-      h_edge      =&gt; s % h_edge % array
-      circulation =&gt; s % circulation % array
-      vorticity   =&gt; s % vorticity % array
-      divergence  =&gt; s % divergence % array
-      ke          =&gt; s % ke % array
-      ke_edge     =&gt; s % ke_edge % array
-      pv_edge     =&gt; s % pv_edge % array
-      MontPot     =&gt; s % MontPot % array
-      pressure    =&gt; s % pressure % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      cellsOnVertex     =&gt; grid % cellsOnVertex % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
-      edgesOnCell       =&gt; grid % edgesOnCell % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      edgesOnVertex     =&gt; grid % edgesOnVertex % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      h_s               =&gt; grid % h_s % array
-      fVertex           =&gt; grid % fVertex % array
-      fEdge             =&gt; grid % fEdge % array
-      zMidZLevel        =&gt; grid % zMidZLevel % array
-      zTopZLevel        =&gt; grid % zTopZLevel % array
-      maxLevelCell      =&gt; grid % maxLevelCell % array
-      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
-      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
-
-                  
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nEdgesSolve = grid % nEdgesSolve
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      !
-      ! Put f*uBcl^{perp} in u as a work variable
-      !
-      do iEdge=1,grid % nEdgesSolve
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         do k=1,maxLevelEdgeTop(iEdge)
-
-            u(k,iEdge) = 0.0
-            do j = 1,nEdgesOnEdge(iEdge)
-               eoe = edgesOnEdge(j,iEdge)
-               u(k,iEdge) = u(k,iEdge) + weightsOnEdge(j,iEdge) * uBcl(k,eoe) * fEdge(eoe) 
-            end do
-         end do
-      end do
-
-      call timer_stop(&quot;ocn_fuperp&quot;)
-
-   end subroutine ocn_fuperp!}}}
-
-!***********************************************************************
-
-end module ocn_tendency
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tendency.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tendency.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tendency.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tendency.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,1317 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tendency
+!
+!&gt; \brief MPAS ocean tendency driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   23 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the routines for computing
+!&gt;  various tendencies for the ocean. As well as routines
+!&gt;  for computing diagnostic variables, and other quantities
+!&gt;  such as wTop.
+!
+!-----------------------------------------------------------------------
+
+module ocn_tendency
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+   use mpas_timer
+
+   use ocn_thick_hadv
+   use ocn_thick_vadv
+
+   use ocn_vel_coriolis
+   use ocn_vel_pressure_grad
+   use ocn_vel_vadv
+   use ocn_vel_hmix
+   use ocn_vel_forcing
+
+   use ocn_tracer_hadv
+   use ocn_tracer_vadv
+   use ocn_tracer_hmix
+   use ocn_restoring
+
+   use ocn_equation_of_state
+   use ocn_vmix
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tend_h, &amp;
+             ocn_tend_u, &amp;
+             ocn_tend_scalar, &amp;
+             ocn_diagnostic_solve, &amp;
+             ocn_wtop, &amp;
+             ocn_fuperp
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tend_h
+!
+!&gt; \brief   Computes thickness tendency
+!&gt; \author  Doug Jacobsen
+!&gt; \date    23 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the thickness tendency for the ocean
+!
+!-----------------------------------------------------------------------
+
+   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
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      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
+
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
+        vertex1, vertex2, eoe, i, j, err
+
+! mrp 110512 I just split compute_tend into compute_tend_u and ocn_tend_h.
+!  Most of these variables can be removed, but at a later time.
+      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
+      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, &amp;
+        upstream_bias, wTopEdge, rho0Inv, r
+      real (kind=RKIND), dimension(:), pointer :: &amp;
+        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
+        zMidZLevel, zTopZLevel 
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &amp;
+        tend_h, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
+        MontPot, wTop, divergence, vertViscTopOfEdge
+      type (dm_info) :: dminfo
+
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
+        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+      integer, dimension(:,:), pointer :: &amp;
+        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
+        edgesOnEdge, edgesOnVertex
+      real (kind=RKIND) :: u_diffusion
+      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
+
+      call mpas_timer_start(&quot;ocn_tend_h&quot;)
+
+      h           =&gt; s % h % array
+      u           =&gt; s % u % array
+      v           =&gt; s % v % array
+      wTop        =&gt; s % wTop % array
+      h_edge      =&gt; s % h_edge % array
+      circulation =&gt; s % circulation % array
+      vorticity   =&gt; s % vorticity % array
+      divergence  =&gt; s % divergence % array
+      ke          =&gt; s % ke % array
+      ke_edge     =&gt; s % ke_edge % array
+      pv_edge     =&gt; s % pv_edge % array
+      MontPot     =&gt; s % MontPot % array
+      pressure    =&gt; s % pressure % array
+      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
+
+      weightsOnEdge     =&gt; grid % weightsOnEdge % array
+      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      cellsOnVertex     =&gt; grid % cellsOnVertex % array
+      verticesOnEdge    =&gt; grid % verticesOnEdge % array
+      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
+      edgesOnCell       =&gt; grid % edgesOnCell % array
+      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
+      edgesOnEdge       =&gt; grid % edgesOnEdge % array
+      edgesOnVertex     =&gt; grid % edgesOnVertex % array
+      dcEdge            =&gt; grid % dcEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      areaCell          =&gt; grid % areaCell % array
+      areaTriangle      =&gt; grid % areaTriangle % array
+      h_s               =&gt; grid % h_s % array
+      fVertex           =&gt; grid % fVertex % array
+      fEdge             =&gt; grid % fEdge % array
+      zMidZLevel        =&gt; grid % zMidZLevel % array
+      zTopZLevel        =&gt; grid % zTopZLevel % array
+      maxLevelCell      =&gt; grid % maxLevelCell % array
+      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
+      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
+
+      tend_h      =&gt; tend % h % array
+                  
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nEdgesSolve = grid % nEdgesSolve
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+
+      !
+      ! height tendency: start accumulating tendency terms
+      !
+      tend_h = 0.0
+
+      !
+      ! height tendency: horizontal advection term -</font>
<font color="blue">abla\cdot ( hu)
+      !
+      ! See Ringler et al. (2010) jcp paper, eqn 19, 21, and fig. 3. 
+      ! for explanation of divergence operator.
+      !
+      ! for z-level, only compute height tendency for top layer.
+
+      call mpas_timer_start(&quot;ocn_tend_h-horiz adv&quot;)
+
+      call ocn_thick_hadv_tend(grid, u, h_edge, tend_h, err)
+
+      call mpas_timer_stop(&quot;ocn_tend_h-horiz adv&quot;)
+
+      !
+      ! height tendency: vertical advection term -d/dz(hw)
+      !
+      ! Vertical advection computed for top layer of a z grid only.
+      call mpas_timer_start(&quot;ocn_tend_h-vert adv&quot;)
+
+      call ocn_thick_vadv_tend(grid, wtop, tend_h, err)
+
+      call mpas_timer_stop(&quot;ocn_tend_h-vert adv&quot;)
+      call mpas_timer_stop(&quot;ocn_tend_h&quot;)
+   
+   end subroutine ocn_tend_h!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tend_u
+!
+!&gt; \brief   Computes velocity tendency
+!&gt; \author  Doug Jacobsen
+!&gt; \date    23 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the velocity tendency for the ocean
+!
+!-----------------------------------------------------------------------
+
+   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
+
+! mrp 110512 I just split compute_tend into ocn_tend_u and compute_tend_h.
+!  Some of these variables can be removed, but at a later time.
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
+        vertex1, vertex2, eoe, i, j
+
+      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve, err
+      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, &amp;
+        upstream_bias, wTopEdge, rho0Inv, r, visc_vorticity_coef
+      real (kind=RKIND), dimension(:), pointer :: &amp;
+        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
+        zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &amp;
+        tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
+        MontPot, wTop, divergence, vertViscTopOfEdge
+      type (dm_info) :: dminfo
+
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
+        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+      integer, dimension(:,:), pointer :: &amp;
+        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
+        edgesOnEdge, edgesOnVertex
+      real (kind=RKIND) :: u_diffusion
+      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
+
+
+      real (kind=RKIND), dimension(:,:), pointer :: u_src
+      real (kind=RKIND), parameter :: rho_ref = 1000.0
+
+      call mpas_timer_start(&quot;ocn_tend_u&quot;)
+
+      h           =&gt; s % h % array
+      u           =&gt; s % u % array
+      v           =&gt; s % v % array
+      wTop        =&gt; s % wTop % array
+      h_edge      =&gt; s % h_edge % array
+      circulation =&gt; s % circulation % array
+      vorticity   =&gt; s % vorticity % array
+      divergence  =&gt; s % divergence % array
+      ke          =&gt; s % ke % array
+      ke_edge     =&gt; s % ke_edge % array
+      pv_edge     =&gt; s % pv_edge % array
+      MontPot     =&gt; s % MontPot % array
+      pressure    =&gt; s % pressure % array
+      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
+
+      weightsOnEdge     =&gt; grid % weightsOnEdge % array
+      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      cellsOnVertex     =&gt; grid % cellsOnVertex % array
+      verticesOnEdge    =&gt; grid % verticesOnEdge % array
+      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
+      edgesOnCell       =&gt; grid % edgesOnCell % array
+      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
+      edgesOnEdge       =&gt; grid % edgesOnEdge % array
+      edgesOnVertex     =&gt; grid % edgesOnVertex % array
+      dcEdge            =&gt; grid % dcEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      areaCell          =&gt; grid % areaCell % array
+      areaTriangle      =&gt; grid % areaTriangle % array
+      h_s               =&gt; grid % h_s % array
+! mrp 110516 cleanup fvertex fedge not used in this subroutine
+      fVertex           =&gt; grid % fVertex % array
+      fEdge             =&gt; grid % fEdge % array
+      zMidZLevel        =&gt; grid % zMidZLevel % array
+      zTopZLevel        =&gt; grid % zTopZLevel % array
+      maxLevelCell      =&gt; grid % maxLevelCell % array
+      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
+      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
+
+      tend_u      =&gt; tend % u % array
+                  
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nEdgesSolve = grid % nEdgesSolve
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+
+      u_src =&gt; grid % u_src % array
+
+      meshScalingDel2 =&gt; grid % meshScalingDel2 % array
+      meshScalingDel4 =&gt; grid % meshScalingDel4 % array
+
+      !
+      ! velocity tendency: start accumulating tendency terms
+      !
+      ! mrp 110516 efficiency: could remove next line and have first tend_u operation not be additive
+      tend_u(:,:) = 0.0
+
+      !
+      ! velocity tendency: nonlinear Coriolis term and grad of kinetic energy
+      !
+
+      call mpas_timer_start(&quot;ocn_tend_u-coriolis&quot;)
+
+      call ocn_vel_coriolis_tend(grid, pv_edge, h_edge, u, ke, tend_u, err)
+
+      call mpas_timer_stop(&quot;ocn_tend_u-coriolis&quot;)
+
+      !
+      ! velocity tendency: vertical advection term -w du/dz
+      !
+      call mpas_timer_start(&quot;ocn_tend_u-vert adv&quot;)
+
+      call ocn_vel_vadv_tend(grid, u, wtop, tend_u, err)
+
+      call mpas_timer_stop(&quot;ocn_tend_u-vert adv&quot;)
+
+      !
+      ! velocity tendency: pressure gradient
+      !
+      call mpas_timer_start(&quot;ocn_tend_u-pressure grad&quot;)
+
+      if (config_vert_grid_type.eq.'isopycnal') then
+          call ocn_vel_pressure_grad_tend(grid, MontPot, tend_u, err)
+      elseif (config_vert_grid_type.eq.'zlevel') then
+          call ocn_vel_pressure_grad_tend(grid, pressure, tend_u, err)
+      end if
+
+      call mpas_timer_stop(&quot;ocn_tend_u-pressure grad&quot;)
+
+      !
+      ! velocity tendency: del2 dissipation, </font>
<font color="black">u_2 </font>
<font color="blue">abla^2 u
+      !   computed as </font>
<font color="black">u( </font>
<font color="black">abla divergence + k \times </font>
<font color="blue">abla vorticity )
+      !   strictly only valid for config_h_mom_eddy_visc2 == constant
+      !
+      call mpas_timer_start(&quot;ocn_tend_u-horiz mix&quot;)
+
+      call ocn_vel_hmix_tend(grid, divergence, vorticity, tend_u, err)
+
+      call mpas_timer_stop(&quot;ocn_tend_u-horiz mix&quot;)
+
+      !
+      ! velocity tendency: forcing and bottom drag
+      !
+      ! mrp 101115 note: in order to include flux boundary conditions, we will need to 
+      ! know the bottom edge with nonzero velocity and place the drag there.
+
+      call mpas_timer_start(&quot;ocn_tend_u-forcings&quot;)
+
+      call ocn_vel_forcing_tend(grid, u, u_src, ke_edge, h_edge, tend_u, err)
+
+      call mpas_timer_stop(&quot;ocn_tend_u-forcings&quot;)
+
+      !
+      ! velocity tendency: vertical mixing d/dz( nu_v du/dz))
+      !
+      if (.not.config_implicit_vertical_mix) then
+          call mpas_timer_start(&quot;ocn_tend_u-explicit vert mix&quot;)
+
+          call ocn_vel_vmix_tend_explicit(grid, u, h_edge, vertvisctopofedge, tend_u, err)
+
+          call mpas_timer_stop(&quot;ocn_tend_u-explicit vert mix&quot;)
+      endif
+      call mpas_timer_stop(&quot;ocn_tend_u&quot;)
+
+   end subroutine ocn_tend_u!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tendSalar
+!
+!&gt; \brief   Computes scalar tendency
+!&gt; \author  Doug Jacobsen
+!&gt; \date    23 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  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
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      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
+
+      integer :: i, k, iCell, iEdge, iTracer, cell1, cell2, upwindCell,&amp;
+        nEdges, nCells, nCellsSolve, nVertLevels, num_tracers, err
+      real (kind=RKIND) :: invAreaCell1, invAreaCell2, tracer_turb_flux
+      real (kind=RKIND) :: flux, tracer_edge, r
+      real (kind=RKIND), dimension(:), pointer :: &amp;
+        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        u,h,wTop, h_edge, vertDiffTopOfCell
+      real (kind=RKIND), dimension(:,:,:), pointer :: &amp;
+        tracers, tend_tr
+      integer, dimension(:,:), pointer :: boundaryEdge
+      type (dm_info) :: dminfo
+
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
+        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+      integer, dimension(:,:), pointer :: cellsOnEdge, boundaryCell
+      real (kind=RKIND), dimension(:), pointer :: zTopZLevel,zMidZLevel, &amp;
+         hRatioZLevelK, hRatioZLevelKm1, meshScalingDel2, meshScalingDel4
+      real (kind=RKIND), dimension(:), allocatable:: tracer2ndDer, tracersIn, tracersOut, posZMidZLevel, &amp;
+            posZTopZLevel
+      real (kind=RKIND), dimension(:,:), allocatable:: fluxVertTop, boundaryMask
+      real (kind=RKIND), dimension(:,:,:), allocatable::tr_flux, tr_div, delsq_tracer, tracerTop
+
+
+      real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2
+      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
+      real (kind=RKIND) :: coef_3rd_order, flux3Coef, cSignWTop
+
+      integer :: index_temperature, index_salinity, rrr
+      real (kind=RKIND), dimension(:), pointer :: temperatureRestore, salinityRestore
+
+      call mpas_timer_start(&quot;ocn_tend_scalar&quot;)
+
+      u           =&gt; s % u % array
+      h           =&gt; s % h % array
+      boundaryCell=&gt; grid % boundaryCell % array
+      wTop        =&gt; s % wTop % array
+      tracers     =&gt; s % tracers % array
+      h_edge      =&gt; s % h_edge % array
+      vertDiffTopOfCell =&gt; d % vertDiffTopOfCell % array
+
+      tend_tr     =&gt; tend % tracers % array
+                  
+      areaCell          =&gt; grid % areaCell % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      dcEdge            =&gt; grid % dcEdge % array
+      zTopZLevel        =&gt; grid % zTopZLevel % array
+      zMidZLevel        =&gt; grid % zMidZLevel % array
+      hRatioZLevelK    =&gt; grid % hRatioZLevelK % array
+      hRatioZLevelKm1    =&gt; grid % hRatioZLevelKm1 % array
+      boundaryEdge      =&gt; grid % boundaryEdge % array
+      maxLevelCell      =&gt; grid % maxLevelCell % array
+      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
+      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
+
+      nEdges      = grid % nEdges
+      nCells      = grid % nCells
+      nCellsSolve = grid % nCellsSolve
+      nVertLevels = grid % nVertLevels
+      num_tracers = s % num_tracers
+
+      meshScalingDel2 =&gt; grid % meshScalingDel2 % array
+      meshScalingDel4 =&gt; grid % meshScalingDel4 % array
+
+
+      deriv_two   =&gt; grid % deriv_two % array
+
+      !
+      ! initialize tracer tendency (RHS of tracer equation) to zero.
+      !
+      tend_tr(:,:,:) = 0.0
+
+      !
+      ! tracer tendency: horizontal advection term -div( h \phi u)
+      !
+      ! mrp 101115 note: in order to include flux boundary conditions, we will need to 
+      ! assign h_edge for maxLevelEdgeTop:maxLevelEdgeBot in the compute_solve_diagnostics
+      ! 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(&quot;ocn_tend_scalar-horiz adv&quot;)
+
+      call ocn_tracer_hadv_tend(grid, u, h_edge, tracers, tend_tr, err)
+
+      call mpas_timer_stop(&quot;ocn_tend_scalar-horiz adv&quot;)
+
+
+      !
+      ! tracer tendency: vertical advection term -d/dz( h \phi w)
+      !
+
+      call mpas_timer_start(&quot;ocn_tend_scalar-vert adv&quot;)
+
+      call ocn_tracer_vadv_tend(grid, wtop, tracers, tend_tr, err)
+
+      call mpas_timer_stop(&quot;ocn_tend_scalar-vert adv&quot;)
+
+      !
+      ! tracer tendency: del2 horizontal tracer diffusion, div(h \kappa_2 </font>
<font color="gray">abla \phi)
+      !
+      call mpas_timer_start(&quot;ocn_tend_scalar-horiz diff&quot;)
+
+      call ocn_tracer_hmix_tend(grid, h_edge, tracers, tend_tr, err)
+
+      call mpas_timer_stop(&quot;ocn_tend_scalar-horiz diff&quot;)
+
+! mrp 110516 printing
+!print *, 'tend_tr 1',minval(tend_tr(3,1,1:nCells)),&amp;
+!                   maxval(tend_tr(3,1,1:nCells))
+!print *, 'tracer  1',minval(tracers(3,1,1:nCells)),&amp;
+!                   maxval(tracers(3,1,1:nCells))
+! mrp 110516 printing end
+
+      !
+      ! tracer tendency: vertical diffusion h d/dz( \kappa_v d\phi/dz)
+      !
+      if (.not.config_implicit_vertical_mix) then
+         call mpas_timer_start(&quot;ocn_tend_scalar-explicit vert diff&quot;)
+
+         call ocn_tracer_vmix_tend_explicit(grid, h, vertdifftopofcell, tracers, tend_tr, err)
+
+         call mpas_timer_stop(&quot;ocn_tend_scalar-explicit vert diff&quot;)
+      endif
+
+! mrp 110516 printing
+!print *, 'tend_tr 2',minval(tend_tr(3,1,1:nCells)),&amp;
+!                   maxval(tend_tr(3,1,1:nCells))
+! mrp 110516 printing end
+
+      !
+      ! add restoring to T and S in top model layer
+      !
+      call mpas_timer_start(&quot;ocn_tend_scalar-restoring&quot;)
+
+      call ocn_restoring_tend(grid, h, s%index_temperature, s%index_salinity, tracers, tend_tr, err)
+
+      call mpas_timer_stop(&quot;ocn_tend_scalar-restoring&quot;)
+
+ 10   format(2i8,10e20.10)
+      call mpas_timer_stop(&quot;ocn_tend_scalar&quot;)
+
+   end subroutine ocn_tend_scalar!}}}
+
+!***********************************************************************
+!
+!  routine ocn_diagnostic_solve
+!
+!&gt; \brief   Computes diagnostic variables
+!&gt; \author  Doug Jacobsen
+!&gt; \date    23 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the diagnostic variables for the ocean
+!
+!-----------------------------------------------------------------------
+
+   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
+
+
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
+      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, rho0Inv
+
+      integer :: nCells, nEdges, nVertices, nVertLevels, vertexDegree, fCoef, err
+
+
+      real (kind=RKIND), dimension(:), pointer :: &amp;
+        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
+        hZLevel
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, w, pressure,&amp;
+        circulation, vorticity, ke, ke_edge, MontPot, wTop, &amp;
+        pv_edge, pv_vertex, pv_cell, gradPVn, gradPVt, divergence, &amp;
+        rho, temperature, salinity
+      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+      real (kind=RKIND), dimension(:), allocatable:: pTop
+      real (kind=RKIND), dimension(:,:), allocatable:: div_u
+      character :: c1*6
+
+      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, &amp;
+        verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex, &amp;
+        boundaryEdge, boundaryCell
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
+        maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &amp;
+        maxLevelVertexBot,  maxLevelVertexTop
+      real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2
+      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
+      real (kind=RKIND) :: coef_3rd_order
+      real (kind=RKIND) :: r, h1, h2
+
+      call mpas_timer_start(&quot;ocn_diagnostic_solve&quot;)
+
+      h           =&gt; s % h % array
+      u           =&gt; s % u % array
+      v           =&gt; s % v % array
+      wTop        =&gt; s % wTop % array
+      h_edge      =&gt; s % h_edge % array
+      circulation =&gt; s % circulation % array
+      vorticity   =&gt; s % vorticity % array
+      divergence  =&gt; s % divergence % array
+      ke          =&gt; s % ke % array
+      ke_edge     =&gt; s % ke_edge % array
+      pv_edge     =&gt; s % pv_edge % array
+      pv_vertex   =&gt; s % pv_vertex % array
+      pv_cell     =&gt; s % pv_cell % array
+      gradPVn     =&gt; s % gradPVn % array
+      gradPVt     =&gt; s % gradPVt % array
+      rho         =&gt; s % rho % array
+      tracers     =&gt; s % tracers % array
+      MontPot     =&gt; s % MontPot % array
+      pressure    =&gt; s % pressure % array
+
+      weightsOnEdge     =&gt; grid % weightsOnEdge % array
+      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      cellsOnVertex     =&gt; grid % cellsOnVertex % array
+      verticesOnEdge    =&gt; grid % verticesOnEdge % array
+      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
+      edgesOnCell       =&gt; grid % edgesOnCell % array
+      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
+      edgesOnEdge       =&gt; grid % edgesOnEdge % array
+      edgesOnVertex     =&gt; grid % edgesOnVertex % array
+      dcEdge            =&gt; grid % dcEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      areaCell          =&gt; grid % areaCell % array
+      areaTriangle      =&gt; grid % areaTriangle % array
+      h_s               =&gt; grid % h_s % array
+      fVertex           =&gt; grid % fVertex % array
+      fEdge             =&gt; grid % fEdge % array
+      hZLevel           =&gt; grid % hZLevel % array
+      deriv_two         =&gt; grid % deriv_two % array
+      maxLevelCell      =&gt; grid % maxLevelCell % array
+      maxLevelEdgeTop   =&gt; grid % maxLevelEdgeTop % array
+      maxLevelEdgeBot   =&gt; grid % maxLevelEdgeBot % array
+      maxLevelVertexBot =&gt; grid % maxLevelVertexBot % array
+      maxLevelVertexTop =&gt; grid % maxLevelVertexTop % array
+                  
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+      vertexDegree = grid % vertexDegree
+
+      boundaryEdge =&gt; grid % boundaryEdge % array
+      boundaryCell =&gt; grid % boundaryCell % array
+
+      !
+      ! Compute height on cell edges at velocity locations
+      !   Namelist options control the order of accuracy of the reconstructed h_edge value
+      !
+      ! mrp 101115 note: in order to include flux boundary conditions, we will need to 
+      ! assign h_edge for maxLevelEdgeTop:maxLevelEdgeBot in the following section
+
+      ! mrp 110516 efficiency note: For z-level, only do this on level 1.  h_edge for all
+      ! lower levels is defined by hZlevel.
+
+      call mpas_timer_start(&quot;ocn_diagnostic_solve-hEdge&quot;)
+
+      coef_3rd_order = 0.
+      if (config_thickness_adv_order == 3) coef_3rd_order = 1.0
+      if (config_thickness_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
+
+      if (config_thickness_adv_order == 2) then
+          call mpas_timer_start(&quot;ocn_diagnostic_solve-hEdge 2&quot;)
+
+         do iEdge=1,nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            do k=1,maxLevelEdgeTop(iEdge)
+               h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
+            end do
+         end do
+          call mpas_timer_stop(&quot;ocn_diagnostic_solve-hEdge 2&quot;)
+
+      else if (config_thickness_adv_order == 3) then
+          call mpas_timer_start(&quot;ocn_diagnostic_solve-hEdge 3&quot;)
+
+         do iEdge=1,nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+
+            do k=1,maxLevelEdgeTop(iEdge)
+
+               d2fdx2_cell1 = 0.0
+               d2fdx2_cell2 = 0.0
+
+               !-- if not a boundary cell
+               if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
+
+                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1)
+                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2)
+
+                  !-- all edges of cell 1
+                  do i=1, grid % nEdgesOnCell % array (cell1)
+                          d2fdx2_cell1 = d2fdx2_cell1 + &amp;
+                          deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (i,cell1))
+                  end do
+
+                  !-- all edges of cell 2
+                  do i=1, grid % nEdgesOnCell % array (cell2)
+                          d2fdx2_cell2 = d2fdx2_cell2 + &amp;
+                          deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
+                  end do
+
+               endif
+
+               !-- if u &gt; 0:
+               if (u(k,iEdge) &gt; 0) then
+                  h_edge(k,iEdge) =     &amp;
+                       0.5*(h(k,cell1) + h(k,cell2))      &amp;
+                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
+                       -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
+               !-- else u &lt;= 0:
+               else
+                  h_edge(k,iEdge) =     &amp;
+                       0.5*(h(k,cell1) + h(k,cell2))      &amp;
+                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
+                       +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
+               end if
+
+            end do   ! do k
+         end do         ! do iEdge
+
+          call mpas_timer_stop(&quot;ocn_diagnostic_solve-hEdge 3&quot;)
+      else  if (config_thickness_adv_order == 4) then
+          call mpas_timer_start(&quot;ocn_diagnostic_solve-hEdge 4&quot;)
+
+         do iEdge=1,nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+
+            do k=1,maxLevelEdgeTop(iEdge)
+
+               d2fdx2_cell1 = 0.0
+               d2fdx2_cell2 = 0.0
+
+               !-- if not a boundary cell
+               if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
+
+                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1)
+                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2)
+
+                  !-- all edges of cell 1
+                  do i=1, grid % nEdgesOnCell % array (cell1)
+                          d2fdx2_cell1 = d2fdx2_cell1 + &amp;
+                          deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (i,cell1))
+                  end do
+
+                  !-- all edges of cell 2
+                  do i=1, grid % nEdgesOnCell % array (cell2)
+                          d2fdx2_cell2 = d2fdx2_cell2 + &amp;
+                          deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
+                  end do
+
+               endif
+
+               h_edge(k,iEdge) =   &amp;
+                    0.5*(h(k,cell1) + h(k,cell2))      &amp;
+                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.
+
+            end do   ! do k
+         end do         ! do iEdge
+
+         call mpas_timer_stop(&quot;ocn_diagnostic_solve-hEdge 4&quot;)
+      endif   ! if(config_thickness_adv_order == 2)
+      call mpas_timer_stop(&quot;ocn_diagnostic_solve-hEdge&quot;)
+
+      !
+      ! set the velocity and height at dummy address
+      !    used -1e34 so error clearly occurs if these values are used.
+      !
+!mrp 110516 change to zero, change back later:
+      u(:,nEdges+1) = -1e34
+      h(:,nCells+1) = -1e34
+      tracers(s % index_temperature,:,nCells+1) = -1e34
+      tracers(s % index_salinity,:,nCells+1) = -1e34
+
+      !
+      ! Compute circulation and relative vorticity at each vertex
+      !
+      circulation(:,:) = 0.0
+      do iEdge=1,nEdges
+         vertex1 = verticesOnEdge(1,iEdge)
+         vertex2 = verticesOnEdge(2,iEdge)
+         do k=1,maxLevelEdgeBot(iEdge)
+            circulation(k,vertex1) = circulation(k,vertex1) - dcEdge(iEdge) * u(k,iEdge)
+            circulation(k,vertex2) = circulation(k,vertex2) + dcEdge(iEdge) * u(k,iEdge)
+         end do
+      end do
+      do iVertex=1,nVertices
+         do k=1,maxLevelVertexBot(iVertex)
+            vorticity(k,iVertex) = circulation(k,iVertex) / areaTriangle(iVertex)
+         end do
+      end do
+
+      !
+      ! Compute the divergence at each cell center
+      !
+      divergence(:,:) = 0.0
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         do k=1,maxLevelEdgeBot(iEdge)
+             divergence(k,cell1) = divergence(k,cell1) + u(k,iEdge)*dvEdge(iEdge)
+             divergence(k,cell2) = divergence(k,cell2) - u(k,iEdge)*dvEdge(iEdge)
+         enddo
+      end do
+      do iCell = 1,nCells
+         r = 1.0 / areaCell(iCell)
+         do k = 1,maxLevelCell(iCell)
+            divergence(k,iCell) = divergence(k,iCell) * r
+         enddo
+      enddo
+
+      !
+      ! Compute kinetic energy in each cell
+      !
+      ke(:,:) = 0.0
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         do k=1,maxLevelEdgeBot(iEdge)
+              ke(k,cell1) = ke(k,cell1) + 0.25 * dcEdge(iEdge) * dvEdge(iEdge) * u(k,iEdge)**2.0
+              ke(k,cell2) = ke(k,cell2) + 0.25 * dcEdge(iEdge) * dvEdge(iEdge) * u(k,iEdge)**2.0
+         enddo
+      end do
+      do iCell = 1,nCells
+         do k = 1,maxLevelCell(iCell)
+            ke(k,iCell) = ke(k,iCell) / areaCell(iCell)
+         enddo
+      enddo
+
+      !
+      ! Compute v (tangential) velocities
+      !
+      v(:,:) = 0.0
+      do iEdge = 1,nEdges
+         do i=1,nEdgesOnEdge(iEdge)
+            eoe = edgesOnEdge(i,iEdge)
+            ! mrp 101115 note: in order to include flux boundary conditions,
+            ! the following loop may need to change to maxLevelEdgeBot
+            do k = 1,maxLevelEdgeTop(iEdge) 
+               v(k,iEdge) = v(k,iEdge) + weightsOnEdge(i,iEdge) * u(k, eoe)
+            end do
+         end do
+      end do
+
+      !
+      ! Compute ke on cell edges at velocity locations for quadratic bottom drag. 
+      !
+      ! mrp 101025 efficiency note: we could get rid of ke_edge completely by 
+      ! using sqrt(u(k,iEdge)**2 + v(k,iEdge)**2) in its place elsewhere.
+      ke_edge = 0.0  !mrp remove 0 for efficiency
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         do k=1,maxLevelEdgeTop(iEdge)
+            ke_edge(k,iEdge) = 0.5 * (ke(k,cell1) + ke(k,cell2))
+         end do
+      end do
+
+      !
+      ! 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 )
+      !
+      if (trim(config_time_integration) == 'RK4') then
+         ! for RK4, PV is really PV = (eta+f)/h
+         fCoef = 1
+      elseif (trim(config_time_integration) == 'split_explicit' &amp;
+          .or.trim(config_time_integration) == 'unsplit_explicit') then
+         ! for split explicit, PV is eta/h because f is added separately to the momentum forcing.
+! mrp temp, new should be:
+         fCoef = 0
+! old, for testing:
+!         fCoef = 1
+      end if
+
+      do iVertex = 1,nVertices
+         do k=1,maxLevelVertexBot(iVertex)
+            h_vertex = 0.0
+            do i=1,vertexDegree
+               h_vertex = h_vertex + h(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
+            end do
+            h_vertex = h_vertex / areaTriangle(iVertex)
+
+            pv_vertex(k,iVertex) = (fCoef*fVertex(iVertex) + vorticity(k,iVertex)) / h_vertex
+         end do
+      end do
+
+      !
+      ! Compute pv at cell centers
+      !    ( this computes pv_cell for all real cells and distance-1 ghost cells )
+      !
+      pv_cell(:,:) = 0.0
+      do iVertex = 1,nVertices
+         do i=1,vertexDegree
+            iCell = cellsOnVertex(i,iVertex)
+            do k = 1,maxLevelCell(iCell)
+               pv_cell(k,iCell) = pv_cell(k,iCell)  &amp;
+                  + kiteAreasOnVertex(i, iVertex) * pv_vertex(k, iVertex) &amp;
+                    / areaCell(iCell)
+            enddo
+         enddo
+      enddo
+
+      !
+      ! Compute pv at the edges
+      !   ( this computes pv_edge at all edges bounding real cells )
+      !
+      pv_edge(:,:) = 0.0
+      do iVertex = 1,nVertices
+         do i=1,vertexDegree
+            iEdge = edgesOnVertex(i,iVertex)
+            do k=1,maxLevelEdgeBot(iEdge)
+               pv_edge(k,iEdge) =  pv_edge(k,iEdge) + 0.5 * pv_vertex(k,iVertex)
+            enddo
+        end do
+      end do
+
+      !
+      ! Compute gradient of PV in normal direction
+      !   ( this computes gradPVn for all edges bounding real cells )
+      !
+      gradPVn(:,:) = 0.0
+      do iEdge = 1,nEdges
+         do k=1,maxLevelEdgeTop(iEdge)
+            gradPVn(k,iEdge) = (  pv_cell(k,cellsOnEdge(2,iEdge)) &amp;
+                                - pv_cell(k,cellsOnEdge(1,iEdge))) &amp;
+                               / dcEdge(iEdge)
+         enddo
+      enddo
+
+      !
+      ! Compute gradient of PV in the tangent direction
+      !   ( this computes gradPVt at all edges bounding real cells and distance-1 ghost cells )
+      !
+      do iEdge = 1,nEdges
+         do k = 1,maxLevelEdgeBot(iEdge)
+           gradPVt(k,iEdge) = (  pv_vertex(k,verticesOnEdge(2,iEdge)) &amp;
+                               - pv_vertex(k,verticesOnEdge(1,iEdge))) &amp;
+                                 /dvEdge(iEdge)
+         enddo
+      enddo
+
+      !
+      ! Modify PV edge with upstream bias.
+      !
+      do iEdge = 1,nEdges
+         do k = 1,maxLevelEdgeBot(iEdge)
+           pv_edge(k,iEdge) = pv_edge(k,iEdge) &amp;
+             - 0.5 * dt* (  u(k,iEdge) * gradPVn(k,iEdge) &amp;
+                          + v(k,iEdge) * gradPVt(k,iEdge) )
+         enddo
+      enddo
+
+      !
+      ! equation of state
+      !
+      ! For an isopycnal model, density should remain constant.
+      ! For zlevel, calculate in-situ density
+      if (config_vert_grid_type.eq.'zlevel') then
+         call ocn_equation_of_state_rho(s, grid, 0, 'relative', err)
+      ! mrp 110324 In order to visualize rhoDisplaced, include the following
+         call ocn_equation_of_state_rho(s, grid, 1, 'relative', err)
+      endif
+
+      !
+      ! Pressure
+      ! This section must be after computing rho
+      !
+      if (config_vert_grid_type.eq.'isopycnal') then
+
+        ! For Isopycnal model.
+        ! Compute pressure at top of each layer, and then
+        ! Montgomery Potential.
+        allocate(pTop(nVertLevels))
+        do iCell=1,nCells
+
+           ! assume atmospheric pressure at the surface is zero for now.
+           pTop(1) = 0.0
+           ! For isopycnal mode, p is the Montgomery Potential.
+           ! At top layer it is g*SSH, where SSH may be off by a 
+           ! constant (ie, h_s can be relative to top or bottom)
+           MontPot(1,iCell) = gravity &amp;
+              * (h_s(iCell) + sum(h(1:nVertLevels,iCell)))
+
+           do k=2,nVertLevels
+              pTop(k) = pTop(k-1) + rho(k-1,iCell)*gravity* h(k-1,iCell)
+
+              ! from delta M = p delta / rho
+              MontPot(k,iCell) = MontPot(k-1,iCell) &amp;
+                 + pTop(k)*(1.0/rho(k,iCell) - 1.0/rho(k-1,iCell)) 
+           end do
+
+        end do
+        deallocate(pTop)
+
+      elseif (config_vert_grid_type.eq.'zlevel') then
+
+        ! For z-level model.
+        ! Compute pressure at middle of each level.  
+        ! At k=1, where p is pressure at a depth of hZLevel(1)/2, not
+        ! pressure at middle of layer including SSH.
+
+        do iCell=1,nCells
+           ! compute pressure for z-level coordinates
+           ! assume atmospheric pressure at the surface is zero for now.
+
+           pressure(1,iCell) = rho(1,iCell)*gravity &amp;
+              * (h(1,iCell)-0.5*hZLevel(1)) 
+
+           do k=2,maxLevelCell(iCell)
+              pressure(k,iCell) = pressure(k-1,iCell)  &amp;
+                + 0.5*gravity*(  rho(k-1,iCell)*hZLevel(k-1) &amp;
+                               + rho(k  ,iCell)*hZLevel(k  ))
+           end do
+
+        end do
+
+      endif
+
+      call ocn_wtop(s,grid)
+
+      call mpas_timer_stop(&quot;ocn_diagnostic_solve&quot;)
+
+   end subroutine ocn_diagnostic_solve!}}}
+
+!***********************************************************************
+!
+!  routine ocn_wtop
+!
+!&gt; \brief   Computes vertical velocity
+!&gt; \author  Doug Jacobsen
+!&gt; \date    23 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical velocity in the top layer for the ocean
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_wtop(s, grid)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Compute diagnostic fields used in the tendency computations
+   !
+   ! Input: grid - grid metadata
+   !
+   ! Output: s - computed diagnostics
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (state_type), intent(inout) :: s
+      type (mesh_type), intent(in) :: grid
+
+      ! mrp 110512 could clean this out, remove pointers?
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
+      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, rho0Inv
+
+      integer :: nCells, nEdges, nVertices, nVertLevels, vertexDegree
+
+
+      real (kind=RKIND), dimension(:), pointer :: &amp;
+        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
+        hZLevel
+      real (kind=RKIND), dimension(:,:), pointer :: u,wTop
+      real (kind=RKIND), dimension(:,:), allocatable:: div_u
+
+      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, &amp;
+        verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex, &amp;
+        boundaryEdge, boundaryCell
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
+        maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &amp;
+        maxLevelVertexBot,  maxLevelVertexTop
+
+        call mpas_timer_start(&quot;wTop&quot;)
+
+      u           =&gt; s % u % array
+      wTop        =&gt; s % wTop % array
+
+      areaCell          =&gt; grid % areaCell % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      hZLevel           =&gt; grid % hZLevel % array
+      maxLevelCell      =&gt; grid % maxLevelCell % array
+      maxLevelEdgeBot   =&gt; grid % maxLevelEdgeBot % array
+      dvEdge            =&gt; grid % dvEdge % array
+
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nVertLevels = grid % nVertLevels
+
+      !
+      ! vertical velocity through layer interface
+      !
+      if (config_vert_grid_type.eq.'isopycnal') then
+        ! set vertical velocity to zero in isopycnal case
+        wTop=0.0  
+
+      elseif (config_vert_grid_type.eq.'zlevel') then
+
+        !
+        ! Compute div(u) for each cell
+        ! See Ringler et al. (2010) jcp paper, eqn 19, 21, and fig. 3.
+        !
+        allocate(div_u(nVertLevels,nCells+1))
+        div_u(:,:) = 0.0
+        do iEdge=1,nEdges
+           cell1 = cellsOnEdge(1,iEdge)
+           cell2 = cellsOnEdge(2,iEdge)
+           do k=2,maxLevelEdgeBot(iEdge)
+              flux = u(k,iEdge) * dvEdge(iEdge) 
+              div_u(k,cell1) = div_u(k,cell1) + flux
+              div_u(k,cell2) = div_u(k,cell2) - flux
+           end do 
+        end do 
+
+        do iCell=1,nCells
+           ! Vertical velocity through layer interface at top and 
+           ! bottom is zero.
+           wTop(1,iCell) = 0.0
+           wTop(maxLevelCell(iCell)+1,iCell) = 0.0
+           do k=maxLevelCell(iCell),2,-1
+              wTop(k,iCell) = wTop(k+1,iCell) &amp;
+                 - div_u(k,iCell)/areaCell(iCell)*hZLevel(k)
+           end do
+        end do
+        deallocate(div_u)
+
+      endif
+
+      call mpas_timer_stop(&quot;wTop&quot;)
+
+   end subroutine ocn_wtop!}}}
+
+!***********************************************************************
+!
+!  routine ocn_fuperp
+!
+!&gt; \brief   Computes f u_perp
+!&gt; \author  Doug Jacobsen
+!&gt; \date    23 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes f u_perp for the ocean
+!
+!-----------------------------------------------------------------------
+
+   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
+
+! mrp 110512 I just split compute_tend into compute_tend_u and compute_tend_h.
+!  Some of these variables can be removed, but at a later time.
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
+        vertex1, vertex2, eoe, i, j
+
+      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
+      real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, &amp;
+        upstream_bias, wTopEdge, rho0Inv, r
+      real (kind=RKIND), dimension(:), pointer :: &amp;
+        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
+        zMidZLevel, zTopZLevel 
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, uBcl, v, pressure, &amp;
+        tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
+        MontPot, wTop, divergence, vertViscTopOfEdge
+      type (dm_info) :: dminfo
+
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
+        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+      integer, dimension(:,:), pointer :: &amp;
+        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
+        edgesOnEdge, edgesOnVertex
+      real (kind=RKIND) :: u_diffusion
+      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
+
+
+      real (kind=RKIND), dimension(:,:), pointer :: u_src
+      real (kind=RKIND), parameter :: rho_ref = 1000.0
+
+      call mpas_timer_start(&quot;ocn_fuperp&quot;)
+
+      h           =&gt; s % h % array
+      u           =&gt; s % u % array
+      uBcl        =&gt; s % uBcl % array
+      v           =&gt; s % v % array
+      wTop        =&gt; s % wTop % array
+      h_edge      =&gt; s % h_edge % array
+      circulation =&gt; s % circulation % array
+      vorticity   =&gt; s % vorticity % array
+      divergence  =&gt; s % divergence % array
+      ke          =&gt; s % ke % array
+      ke_edge     =&gt; s % ke_edge % array
+      pv_edge     =&gt; s % pv_edge % array
+      MontPot     =&gt; s % MontPot % array
+      pressure    =&gt; s % pressure % array
+
+      weightsOnEdge     =&gt; grid % weightsOnEdge % array
+      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      cellsOnVertex     =&gt; grid % cellsOnVertex % array
+      verticesOnEdge    =&gt; grid % verticesOnEdge % array
+      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
+      edgesOnCell       =&gt; grid % edgesOnCell % array
+      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
+      edgesOnEdge       =&gt; grid % edgesOnEdge % array
+      edgesOnVertex     =&gt; grid % edgesOnVertex % array
+      dcEdge            =&gt; grid % dcEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      areaCell          =&gt; grid % areaCell % array
+      areaTriangle      =&gt; grid % areaTriangle % array
+      h_s               =&gt; grid % h_s % array
+      fVertex           =&gt; grid % fVertex % array
+      fEdge             =&gt; grid % fEdge % array
+      zMidZLevel        =&gt; grid % zMidZLevel % array
+      zTopZLevel        =&gt; grid % zTopZLevel % array
+      maxLevelCell      =&gt; grid % maxLevelCell % array
+      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
+      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
+
+                  
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nEdgesSolve = grid % nEdgesSolve
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+
+      !
+      ! Put f*uBcl^{perp} in u as a work variable
+      !
+      do iEdge=1,grid % nEdgesSolve
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+
+         do k=1,maxLevelEdgeTop(iEdge)
+
+            u(k,iEdge) = 0.0
+            do j = 1,nEdgesOnEdge(iEdge)
+               eoe = edgesOnEdge(j,iEdge)
+               u(k,iEdge) = u(k,iEdge) + weightsOnEdge(j,iEdge) * uBcl(k,eoe) * fEdge(eoe) 
+            end do
+         end do
+      end do
+
+      call mpas_timer_stop(&quot;ocn_fuperp&quot;)
+
+   end subroutine ocn_fuperp!}}}
+
+!***********************************************************************
+
+end module ocn_tendency
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_test_cases.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_test_cases.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_test_cases.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,526 +0,0 @@
- module test_cases
-
-   use grid_types
-   use configure
-   use constants
-
-
-   contains
-
-
-   subroutine setup_sw_test_case(domain)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Configure grid metadata and model state for the shallow water test case 
-   !   specified in the namelist
-   !
-   ! Output: block - a subset (not necessarily proper) of the model domain to be
-   !                 initialized
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-
-      integer :: i, iCell, iEdge, iVtx, iLevel
-      type (block_type), pointer :: block_ptr
-      type (dm_info) :: dminfo
-
-      if (config_test_case == 0) then
-         write(0,*) 'Using initial conditions supplied in input file'
-
-      else if (config_test_case == 1) then
-         write(0,*) ' Setting up shallow water test case 1:'
-         write(0,*) ' Advection of Cosine Bell over the Pole'
-
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            call sw_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else if (config_test_case == 2) then
-         write(0,*) ' Setup shallow water test case 2: '// &amp;
-           'Global Steady State Nonlinear Zonal Geostrophic Flow'
-
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            call sw_test_case_2(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else if (config_test_case == 5) then
-         write(0,*) ' Setup shallow water test case 5:'// &amp;
-           ' Zonal Flow over an Isolated Mountain'
-
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            call sw_test_case_5(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else if (config_test_case == 6) then
-         write(0,*) ' Set up shallow water test case 6:'
-         write(0,*) ' Rossby-Haurwitz Wave'
-
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            call sw_test_case_6(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else
-         write(0,*) 'Abort: config_test_case=',config_test_case
-         write(0,*) 'Only test case 1, 2, 5, and 6 ', &amp;
-           'are currently supported.  '
-           call dmpar_abort(dminfo)
-      end if
-
-      block_ptr =&gt; domain % blocklist
-      do while (associated(block_ptr))
-
-        do i=2,nTimeLevs
-           call copy_state(block_ptr % state % time_levs(i) % state, &amp;
-                           block_ptr % state % time_levs(1) % state)
-        end do
-
-        block_ptr =&gt; block_ptr % next
-      end do
-
-   end subroutine setup_sw_test_case
-
-
-   subroutine sw_test_case_1(grid, state)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup shallow water test case 1: Advection of Cosine Bell over the Pole
-   !
-   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
-   !            Approximations to the Shallow Water Equations in Spherical 
-   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (mesh_type), intent(inout) :: grid
-      type (state_type), intent(inout) :: state
-
-      real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
-      real (kind=RKIND), parameter :: h0 = 1000.0
-      real (kind=RKIND), parameter :: theta_c = 0.0
-      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
-      real (kind=RKIND), parameter :: alpha = pii/4.0
-
-      integer :: iCell, iEdge, iVtx
-      real (kind=RKIND) :: r, u, v
-      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
-
-      !
-      ! Scale all distances and areas from a unit sphere to one with radius a
-      !
-      grid % xCell % array = grid % xCell % array * a
-      grid % yCell % array = grid % yCell % array * a
-      grid % zCell % array = grid % zCell % array * a
-      grid % xVertex % array = grid % xVertex % array * a
-      grid % yVertex % array = grid % yVertex % array * a
-      grid % zVertex % array = grid % zVertex % array * a
-      grid % xEdge % array = grid % xEdge % array * a
-      grid % yEdge % array = grid % yEdge % array * a
-      grid % zEdge % array = grid % zEdge % array * a
-      grid % dvEdge % array = grid % dvEdge % array * a
-      grid % dcEdge % array = grid % dcEdge % array * a
-      grid % areaCell % array = grid % areaCell % array * a**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
-      !
-      ! Initialize wind field
-      !
-      allocate(psiVertex(grid % nVertices))
-      do iVtx=1,grid % nVertices
-         psiVertex(iVtx) = -a * u0 * ( &amp;
-                                       sin(grid%latVertex%array(iVtx)) * cos(alpha) - &amp;
-                                       cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &amp;
-                                     )
-      end do
-      do iEdge=1,grid % nEdges
-         state % u % array(1,iEdge) = -1.0 * ( &amp;
-                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
-                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
-                                             ) / grid%dvEdge%array(iEdge)
-      end do
-      deallocate(psiVertex)
-
-      !
-      ! Initialize cosine bell at (theta_c, lambda_c)
-      !
-      do iCell=1,grid % nCells
-         r = sphere_distance(theta_c, lambda_c, grid % latCell % array(iCell), grid % lonCell % array(iCell), a) 
-         if (r &lt; a/3.0) then
-            state % h % array(1,iCell) = (h0 / 2.0) * (1.0 + cos(pii*r*3.0/a))
-         else
-            state % h % array(1,iCell) = 0.0
-         end if
-      end do
-
-   end subroutine sw_test_case_1
-
-
-   subroutine sw_test_case_2(grid, state)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup shallow water test case 2: Global Steady State Nonlinear Zonal 
-   !                                  Geostrophic Flow
-   !
-   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
-   !            Approximations to the Shallow Water Equations in Spherical 
-   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (mesh_type), intent(inout) :: grid
-      type (state_type), intent(inout) :: state
-
-      real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
-      real (kind=RKIND), parameter :: gh0 = 29400.0
-      real (kind=RKIND), parameter :: alpha = 0.0
-
-      integer :: iCell, iEdge, iVtx
-      real (kind=RKIND) :: u, v
-      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
-
-
-      !
-      ! Scale all distances and areas from a unit sphere to one with radius a
-      !
-      grid % xCell % array = grid % xCell % array * a
-      grid % yCell % array = grid % yCell % array * a
-      grid % zCell % array = grid % zCell % array * a
-      grid % xVertex % array = grid % xVertex % array * a
-      grid % yVertex % array = grid % yVertex % array * a
-      grid % zVertex % array = grid % zVertex % array * a
-      grid % xEdge % array = grid % xEdge % array * a
-      grid % yEdge % array = grid % yEdge % array * a
-      grid % zEdge % array = grid % zEdge % array * a
-      grid % dvEdge % array = grid % dvEdge % array * a
-      grid % dcEdge % array = grid % dcEdge % array * a
-      grid % areaCell % array = grid % areaCell % array * a**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-      
-
-      !
-      ! Initialize wind field
-      !
-      allocate(psiVertex(grid % nVertices))
-      do iVtx=1,grid % nVertices
-         psiVertex(iVtx) = -a * u0 * ( &amp;
-                                       sin(grid%latVertex%array(iVtx)) * cos(alpha) - &amp;
-                                       cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &amp;
-                                     )
-      end do
-      do iEdge=1,grid % nEdges
-         state % u % array(1,iEdge) = -1.0 * ( &amp;
-                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
-                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
-                                             ) / grid%dvEdge%array(iEdge)
-      end do
-      deallocate(psiVertex)
-
-      !
-      ! Generate rotated Coriolis field
-      !
-      do iEdge=1,grid % nEdges
-         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
-                                       ( -cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &amp;
-                                         sin(grid%latEdge%array(iEdge)) * cos(alpha) &amp;
-                                       )
-      end do
-      do iVtx=1,grid % nVertices
-         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
-                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &amp;
-                                          sin(grid%latVertex%array(iVtx)) * cos(alpha) &amp;
-                                         )
-      end do
-
-      !
-      ! Initialize height field (actually, fluid thickness field)
-      !
-      do iCell=1,grid % nCells
-         state % h % array(1,iCell) = (gh0 - (a * omega * u0 + 0.5 * u0**2.0) * &amp;
-                                             (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &amp;
-                                              sin(grid%latCell%array(iCell)) * cos(alpha) &amp;
-                                             )**2.0 &amp;
-                                      ) / &amp;
-                                      gravity
-      end do
-
-   end subroutine sw_test_case_2
-
-
-   subroutine sw_test_case_5(grid, state)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup shallow water test case 5: Zonal Flow over an Isolated Mountain
-   !
-   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
-   !            Approximations to the Shallow Water Equations in Spherical 
-   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (mesh_type), intent(inout) :: grid
-      type (state_type), intent(inout) :: state
-
-      real (kind=RKIND), parameter :: u0 = 20.
-      real (kind=RKIND), parameter :: gh0 = 5960.0*gravity
-!      real (kind=RKIND), parameter :: hs0 = 2000. original
-      real (kind=RKIND), parameter :: hs0 = 250.  !mrp 100204
-      real (kind=RKIND), parameter :: theta_c = pii/6.0
-      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
-      real (kind=RKIND), parameter :: rr = pii/9.0
-      real (kind=RKIND), parameter :: alpha = 0.0
-
-      integer :: iCell, iEdge, iVtx
-      real (kind=RKIND) :: r, u, v
-      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
-
-
-      !
-      ! Scale all distances and areas from a unit sphere to one with radius a
-      !
-      grid % xCell % array = grid % xCell % array * a
-      grid % yCell % array = grid % yCell % array * a
-      grid % zCell % array = grid % zCell % array * a
-      grid % xVertex % array = grid % xVertex % array * a
-      grid % yVertex % array = grid % yVertex % array * a
-      grid % zVertex % array = grid % zVertex % array * a
-      grid % xEdge % array = grid % xEdge % array * a
-      grid % yEdge % array = grid % yEdge % array * a
-      grid % zEdge % array = grid % zEdge % array * a
-      grid % dvEdge % array = grid % dvEdge % array * a
-      grid % dcEdge % array = grid % dcEdge % array * a
-      grid % areaCell % array = grid % areaCell % array * a**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
-      !
-      ! Initialize wind field
-      !
-      allocate(psiVertex(grid % nVertices))
-      do iVtx=1,grid % nVertices
-         psiVertex(iVtx) = -a * u0 * ( &amp;
-                                       sin(grid%latVertex%array(iVtx)) * cos(alpha) - &amp;
-                                       cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &amp;
-                                     )
-      end do
-      do iEdge=1,grid % nEdges
-         state % u % array(1,iEdge) = -1.0 * ( &amp;
-                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
-                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
-                                             ) / grid%dvEdge%array(iEdge)
-      end do
-      deallocate(psiVertex)
-
-      !
-      ! Generate rotated Coriolis field
-      !
-      do iEdge=1,grid % nEdges
-         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
-                                        (-cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &amp;
-                                         sin(grid%latEdge%array(iEdge)) * cos(alpha) &amp;
-                                        )
-      end do
-      do iVtx=1,grid % nVertices
-         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
-                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &amp;
-                                          sin(grid%latVertex%array(iVtx)) * cos(alpha) &amp;
-                                         )
-      end do
-
-      !
-      ! Initialize mountain
-      !
-      do iCell=1,grid % nCells
-         if (grid % lonCell % array(iCell) &lt; 0.0) grid % lonCell % array(iCell) = grid % lonCell % array(iCell) + 2.0 * pii
-         r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + (grid % latCell % array(iCell) - theta_c)**2.0))
-         grid % h_s % array(iCell) = hs0 * (1.0 - r/rr)
-      end do
-! output about mountain
-print *, 'h_s',minval(grid % h_s % array),sum(grid % h_s % array)/grid % nCells, maxval(grid % h_s % array)
-
-      !
-      ! Initialize tracer fields
-      !
-      do iCell=1,grid % nCells
-         r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + (grid % latCell % array(iCell) - theta_c)**2.0))
-         state % tracers % array(1,1,iCell) = 1.0 - r/rr
-      end do
-      do iCell=1,grid % nCells
-         r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + &amp;
-                      (grid % latCell % array(iCell) - theta_c - pii/6.0)**2.0 &amp;
-                     ) &amp;
-                 )
-         state % tracers % array(2,1,iCell) = 1.0 - r/rr
-      end do
-
-      !
-      ! Initialize height field (actually, fluid thickness field)
-      !
-      do iCell=1,grid % nCells
-         state % h % array(1,iCell) = (gh0 - (a * omega * u0 + 0.5 * u0**2.0) * &amp;
-                                         (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &amp;
-                                          sin(grid%latCell%array(iCell)) * cos(alpha) &amp;
-                                         )**2.0 &amp;
-                                      ) / &amp;
-                                      gravity
-         state % h % array(1,iCell) = state % h % array(1,iCell) - grid % h_s % array(iCell)
-      end do
-
-   end subroutine sw_test_case_5
-
-
-   subroutine sw_test_case_6(grid, state)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup shallow water test case 6: Rossby-Haurwitz Wave
-   !
-   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
-   !            Approximations to the Shallow Water Equations in Spherical 
-   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (mesh_type), intent(inout) :: grid
-      type (state_type), intent(inout) :: state
-
-      real (kind=RKIND), parameter :: h0 = 8000.0
-      real (kind=RKIND), parameter :: w = 7.848e-6
-      real (kind=RKIND), parameter :: K = 7.848e-6
-      real (kind=RKIND), parameter :: R = 4.0
-
-      integer :: iCell, iEdge, iVtx
-      real (kind=RKIND) :: u, v
-      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
-
-
-      !
-      ! Scale all distances and areas from a unit sphere to one with radius a
-      !
-      grid % xCell % array = grid % xCell % array * a
-      grid % yCell % array = grid % yCell % array * a
-      grid % zCell % array = grid % zCell % array * a
-      grid % xVertex % array = grid % xVertex % array * a
-      grid % yVertex % array = grid % yVertex % array * a
-      grid % zVertex % array = grid % zVertex % array * a
-      grid % xEdge % array = grid % xEdge % array * a
-      grid % yEdge % array = grid % yEdge % array * a
-      grid % zEdge % array = grid % zEdge % array * a
-      grid % dvEdge % array = grid % dvEdge % array * a
-      grid % dcEdge % array = grid % dcEdge % array * a
-      grid % areaCell % array = grid % areaCell % array * a**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
-      !
-      ! Initialize wind field
-      !
-      allocate(psiVertex(grid % nVertices))
-      do iVtx=1,grid % nVertices
-         psiVertex(iVtx) = -a * a * w * sin(grid%latVertex%array(iVtx)) + &amp;
-                            a *a * K * (cos(grid%latVertex%array(iVtx))**R) * &amp;
-                            sin(grid%latVertex%array(iVtx)) * cos(R * grid%lonVertex%array(iVtx))
-      end do
-      do iEdge=1,grid % nEdges
-         state % u % array(1,iEdge) = -1.0 * ( &amp;
-                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
-                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
-                                             ) / grid%dvEdge%array(iEdge)
-      end do
-      deallocate(psiVertex)
-
-      !
-      ! Initialize height field (actually, fluid thickness field)
-      !
-      do iCell=1,grid % nCells
-         state % h % array(1,iCell) = (gravity * h0 + a*a*AA(grid%latCell%array(iCell)) + &amp;
-                                                      a*a*BB(grid%latCell%array(iCell)) * cos(R*grid%lonCell%array(iCell)) + &amp;
-                                                      a*a*CC(grid%latCell%array(iCell)) * cos(2.0*R*grid%lonCell%array(iCell)) &amp;
-                                      ) / gravity
-      end do
-
-   end subroutine sw_test_case_6
-
-
-   real function sphere_distance(lat1, lon1, lat2, lon2, radius)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
-   !   sphere with given radius.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), intent(in) :: lat1, lon1, lat2, lon2, radius
-
-      real (kind=RKIND) :: arg1
-
-      arg1 = sqrt( sin(0.5*(lat2-lat1))**2 +  &amp;
-                   cos(lat1)*cos(lat2)*sin(0.5*(lon2-lon1))**2 )
-      sphere_distance = 2.*radius*asin(arg1)
-
-   end function sphere_distance
-
-
-   real function AA(theta)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! A, used in height field computation for Rossby-Haurwitz wave
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), parameter :: w = 7.848e-6
-      real (kind=RKIND), parameter :: K = 7.848e-6
-      real (kind=RKIND), parameter :: R = 4.0
-
-      real (kind=RKIND), intent(in) :: theta
-
-      AA = 0.5 * w * (2.0 * omega + w) * cos(theta)**2.0 + &amp;
-          0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 + 2.0*R**2.0 - R - 2.0 - 2.0*R**2*cos(theta)**-2.0)
-
-   end function AA
-
-   
-   real function BB(theta)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! B, used in height field computation for Rossby-Haurwitz wave
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), parameter :: w = 7.848e-6
-      real (kind=RKIND), parameter :: K = 7.848e-6
-      real (kind=RKIND), parameter :: R = 4.0
-
-      real (kind=RKIND), intent(in) :: theta
-
-      BB = (2.0*(omega + w)*K / ((R+1.0)*(R+2.0))) * cos(theta)**R * ((R**2.0 + 2.0*R + 2.0) - ((R+1.0)*cos(theta))**2.0)
-
-   end function BB
-
-
-   real function CC(theta)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! C, used in height field computation for Rossby-Haurwitz wave
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), parameter :: w = 7.848e-6
-      real (kind=RKIND), parameter :: K = 7.848e-6
-      real (kind=RKIND), parameter :: R = 4.0
-
-      real (kind=RKIND), intent(in) :: theta
-
-      CC = 0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 - R - 2.0)
-
-   end function CC
-
-end module test_cases

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_test_cases.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_test_cases.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_test_cases.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_test_cases.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,526 @@
+ module test_cases
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+
+
+   contains
+
+
+   subroutine setup_sw_test_case(domain)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Configure grid metadata and model state for the shallow water test case 
+   !   specified in the namelist
+   !
+   ! Output: block - a subset (not necessarily proper) of the model domain to be
+   !                 initialized
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+
+      integer :: i, iCell, iEdge, iVtx, iLevel
+      type (block_type), pointer :: block_ptr
+      type (dm_info) :: dminfo
+
+      if (config_test_case == 0) then
+         write(0,*) 'Using initial conditions supplied in input file'
+
+      else if (config_test_case == 1) then
+         write(0,*) ' Setting up shallow water test case 1:'
+         write(0,*) ' Advection of Cosine Bell over the Pole'
+
+         block_ptr =&gt; domain % blocklist
+         do while (associated(block_ptr))
+            call sw_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
+            block_ptr =&gt; block_ptr % next
+         end do
+
+      else if (config_test_case == 2) then
+         write(0,*) ' Setup shallow water test case 2: '// &amp;
+           'Global Steady State Nonlinear Zonal Geostrophic Flow'
+
+         block_ptr =&gt; domain % blocklist
+         do while (associated(block_ptr))
+            call sw_test_case_2(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
+            block_ptr =&gt; block_ptr % next
+         end do
+
+      else if (config_test_case == 5) then
+         write(0,*) ' Setup shallow water test case 5:'// &amp;
+           ' Zonal Flow over an Isolated Mountain'
+
+         block_ptr =&gt; domain % blocklist
+         do while (associated(block_ptr))
+            call sw_test_case_5(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
+            block_ptr =&gt; block_ptr % next
+         end do
+
+      else if (config_test_case == 6) then
+         write(0,*) ' Set up shallow water test case 6:'
+         write(0,*) ' Rossby-Haurwitz Wave'
+
+         block_ptr =&gt; domain % blocklist
+         do while (associated(block_ptr))
+            call sw_test_case_6(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
+            block_ptr =&gt; block_ptr % next
+         end do
+
+      else
+         write(0,*) 'Abort: config_test_case=',config_test_case
+         write(0,*) 'Only test case 1, 2, 5, and 6 ', &amp;
+           'are currently supported.  '
+           call mpas_dmpar_abort(dminfo)
+      end if
+
+      block_ptr =&gt; domain % blocklist
+      do while (associated(block_ptr))
+
+        do i=2,nTimeLevs
+           call mpas_copy_state(block_ptr % state % time_levs(i) % state, &amp;
+                           block_ptr % state % time_levs(1) % state)
+        end do
+
+        block_ptr =&gt; block_ptr % next
+      end do
+
+   end subroutine setup_sw_test_case
+
+
+   subroutine sw_test_case_1(grid, state)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Setup shallow water test case 1: Advection of Cosine Bell over the Pole
+   !
+   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
+   !            Approximations to the Shallow Water Equations in Spherical 
+   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (mesh_type), intent(inout) :: grid
+      type (state_type), intent(inout) :: state
+
+      real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
+      real (kind=RKIND), parameter :: h0 = 1000.0
+      real (kind=RKIND), parameter :: theta_c = 0.0
+      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
+      real (kind=RKIND), parameter :: alpha = pii/4.0
+
+      integer :: iCell, iEdge, iVtx
+      real (kind=RKIND) :: r, u, v
+      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
+
+      !
+      ! Scale all distances and areas from a unit sphere to one with radius a
+      !
+      grid % xCell % array = grid % xCell % array * a
+      grid % yCell % array = grid % yCell % array * a
+      grid % zCell % array = grid % zCell % array * a
+      grid % xVertex % array = grid % xVertex % array * a
+      grid % yVertex % array = grid % yVertex % array * a
+      grid % zVertex % array = grid % zVertex % array * a
+      grid % xEdge % array = grid % xEdge % array * a
+      grid % yEdge % array = grid % yEdge % array * a
+      grid % zEdge % array = grid % zEdge % array * a
+      grid % dvEdge % array = grid % dvEdge % array * a
+      grid % dcEdge % array = grid % dcEdge % array * a
+      grid % areaCell % array = grid % areaCell % array * a**2.0
+      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
+      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
+
+      !
+      ! Initialize wind field
+      !
+      allocate(psiVertex(grid % nVertices))
+      do iVtx=1,grid % nVertices
+         psiVertex(iVtx) = -a * u0 * ( &amp;
+                                       sin(grid%latVertex%array(iVtx)) * cos(alpha) - &amp;
+                                       cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &amp;
+                                     )
+      end do
+      do iEdge=1,grid % nEdges
+         state % u % array(1,iEdge) = -1.0 * ( &amp;
+                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
+                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
+                                             ) / grid%dvEdge%array(iEdge)
+      end do
+      deallocate(psiVertex)
+
+      !
+      ! Initialize cosine bell at (theta_c, lambda_c)
+      !
+      do iCell=1,grid % nCells
+         r = sphere_distance(theta_c, lambda_c, grid % latCell % array(iCell), grid % lonCell % array(iCell), a) 
+         if (r &lt; a/3.0) then
+            state % h % array(1,iCell) = (h0 / 2.0) * (1.0 + cos(pii*r*3.0/a))
+         else
+            state % h % array(1,iCell) = 0.0
+         end if
+      end do
+
+   end subroutine sw_test_case_1
+
+
+   subroutine sw_test_case_2(grid, state)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Setup shallow water test case 2: Global Steady State Nonlinear Zonal 
+   !                                  Geostrophic Flow
+   !
+   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
+   !            Approximations to the Shallow Water Equations in Spherical 
+   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (mesh_type), intent(inout) :: grid
+      type (state_type), intent(inout) :: state
+
+      real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
+      real (kind=RKIND), parameter :: gh0 = 29400.0
+      real (kind=RKIND), parameter :: alpha = 0.0
+
+      integer :: iCell, iEdge, iVtx
+      real (kind=RKIND) :: u, v
+      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
+
+
+      !
+      ! Scale all distances and areas from a unit sphere to one with radius a
+      !
+      grid % xCell % array = grid % xCell % array * a
+      grid % yCell % array = grid % yCell % array * a
+      grid % zCell % array = grid % zCell % array * a
+      grid % xVertex % array = grid % xVertex % array * a
+      grid % yVertex % array = grid % yVertex % array * a
+      grid % zVertex % array = grid % zVertex % array * a
+      grid % xEdge % array = grid % xEdge % array * a
+      grid % yEdge % array = grid % yEdge % array * a
+      grid % zEdge % array = grid % zEdge % array * a
+      grid % dvEdge % array = grid % dvEdge % array * a
+      grid % dcEdge % array = grid % dcEdge % array * a
+      grid % areaCell % array = grid % areaCell % array * a**2.0
+      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
+      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
+      
+
+      !
+      ! Initialize wind field
+      !
+      allocate(psiVertex(grid % nVertices))
+      do iVtx=1,grid % nVertices
+         psiVertex(iVtx) = -a * u0 * ( &amp;
+                                       sin(grid%latVertex%array(iVtx)) * cos(alpha) - &amp;
+                                       cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &amp;
+                                     )
+      end do
+      do iEdge=1,grid % nEdges
+         state % u % array(1,iEdge) = -1.0 * ( &amp;
+                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
+                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
+                                             ) / grid%dvEdge%array(iEdge)
+      end do
+      deallocate(psiVertex)
+
+      !
+      ! Generate rotated Coriolis field
+      !
+      do iEdge=1,grid % nEdges
+         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
+                                       ( -cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &amp;
+                                         sin(grid%latEdge%array(iEdge)) * cos(alpha) &amp;
+                                       )
+      end do
+      do iVtx=1,grid % nVertices
+         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
+                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &amp;
+                                          sin(grid%latVertex%array(iVtx)) * cos(alpha) &amp;
+                                         )
+      end do
+
+      !
+      ! Initialize height field (actually, fluid thickness field)
+      !
+      do iCell=1,grid % nCells
+         state % h % array(1,iCell) = (gh0 - (a * omega * u0 + 0.5 * u0**2.0) * &amp;
+                                             (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &amp;
+                                              sin(grid%latCell%array(iCell)) * cos(alpha) &amp;
+                                             )**2.0 &amp;
+                                      ) / &amp;
+                                      gravity
+      end do
+
+   end subroutine sw_test_case_2
+
+
+   subroutine sw_test_case_5(grid, state)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Setup shallow water test case 5: Zonal Flow over an Isolated Mountain
+   !
+   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
+   !            Approximations to the Shallow Water Equations in Spherical 
+   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (mesh_type), intent(inout) :: grid
+      type (state_type), intent(inout) :: state
+
+      real (kind=RKIND), parameter :: u0 = 20.
+      real (kind=RKIND), parameter :: gh0 = 5960.0*gravity
+!      real (kind=RKIND), parameter :: hs0 = 2000. original
+      real (kind=RKIND), parameter :: hs0 = 250.  !mrp 100204
+      real (kind=RKIND), parameter :: theta_c = pii/6.0
+      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
+      real (kind=RKIND), parameter :: rr = pii/9.0
+      real (kind=RKIND), parameter :: alpha = 0.0
+
+      integer :: iCell, iEdge, iVtx
+      real (kind=RKIND) :: r, u, v
+      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
+
+
+      !
+      ! Scale all distances and areas from a unit sphere to one with radius a
+      !
+      grid % xCell % array = grid % xCell % array * a
+      grid % yCell % array = grid % yCell % array * a
+      grid % zCell % array = grid % zCell % array * a
+      grid % xVertex % array = grid % xVertex % array * a
+      grid % yVertex % array = grid % yVertex % array * a
+      grid % zVertex % array = grid % zVertex % array * a
+      grid % xEdge % array = grid % xEdge % array * a
+      grid % yEdge % array = grid % yEdge % array * a
+      grid % zEdge % array = grid % zEdge % array * a
+      grid % dvEdge % array = grid % dvEdge % array * a
+      grid % dcEdge % array = grid % dcEdge % array * a
+      grid % areaCell % array = grid % areaCell % array * a**2.0
+      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
+      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
+
+      !
+      ! Initialize wind field
+      !
+      allocate(psiVertex(grid % nVertices))
+      do iVtx=1,grid % nVertices
+         psiVertex(iVtx) = -a * u0 * ( &amp;
+                                       sin(grid%latVertex%array(iVtx)) * cos(alpha) - &amp;
+                                       cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &amp;
+                                     )
+      end do
+      do iEdge=1,grid % nEdges
+         state % u % array(1,iEdge) = -1.0 * ( &amp;
+                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
+                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
+                                             ) / grid%dvEdge%array(iEdge)
+      end do
+      deallocate(psiVertex)
+
+      !
+      ! Generate rotated Coriolis field
+      !
+      do iEdge=1,grid % nEdges
+         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
+                                        (-cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &amp;
+                                         sin(grid%latEdge%array(iEdge)) * cos(alpha) &amp;
+                                        )
+      end do
+      do iVtx=1,grid % nVertices
+         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
+                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &amp;
+                                          sin(grid%latVertex%array(iVtx)) * cos(alpha) &amp;
+                                         )
+      end do
+
+      !
+      ! Initialize mountain
+      !
+      do iCell=1,grid % nCells
+         if (grid % lonCell % array(iCell) &lt; 0.0) grid % lonCell % array(iCell) = grid % lonCell % array(iCell) + 2.0 * pii
+         r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + (grid % latCell % array(iCell) - theta_c)**2.0))
+         grid % h_s % array(iCell) = hs0 * (1.0 - r/rr)
+      end do
+! output about mountain
+print *, 'h_s',minval(grid % h_s % array),sum(grid % h_s % array)/grid % nCells, maxval(grid % h_s % array)
+
+      !
+      ! Initialize tracer fields
+      !
+      do iCell=1,grid % nCells
+         r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + (grid % latCell % array(iCell) - theta_c)**2.0))
+         state % tracers % array(1,1,iCell) = 1.0 - r/rr
+      end do
+      do iCell=1,grid % nCells
+         r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + &amp;
+                      (grid % latCell % array(iCell) - theta_c - pii/6.0)**2.0 &amp;
+                     ) &amp;
+                 )
+         state % tracers % array(2,1,iCell) = 1.0 - r/rr
+      end do
+
+      !
+      ! Initialize height field (actually, fluid thickness field)
+      !
+      do iCell=1,grid % nCells
+         state % h % array(1,iCell) = (gh0 - (a * omega * u0 + 0.5 * u0**2.0) * &amp;
+                                         (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &amp;
+                                          sin(grid%latCell%array(iCell)) * cos(alpha) &amp;
+                                         )**2.0 &amp;
+                                      ) / &amp;
+                                      gravity
+         state % h % array(1,iCell) = state % h % array(1,iCell) - grid % h_s % array(iCell)
+      end do
+
+   end subroutine sw_test_case_5
+
+
+   subroutine sw_test_case_6(grid, state)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Setup shallow water test case 6: Rossby-Haurwitz Wave
+   !
+   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
+   !            Approximations to the Shallow Water Equations in Spherical 
+   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (mesh_type), intent(inout) :: grid
+      type (state_type), intent(inout) :: state
+
+      real (kind=RKIND), parameter :: h0 = 8000.0
+      real (kind=RKIND), parameter :: w = 7.848e-6
+      real (kind=RKIND), parameter :: K = 7.848e-6
+      real (kind=RKIND), parameter :: R = 4.0
+
+      integer :: iCell, iEdge, iVtx
+      real (kind=RKIND) :: u, v
+      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
+
+
+      !
+      ! Scale all distances and areas from a unit sphere to one with radius a
+      !
+      grid % xCell % array = grid % xCell % array * a
+      grid % yCell % array = grid % yCell % array * a
+      grid % zCell % array = grid % zCell % array * a
+      grid % xVertex % array = grid % xVertex % array * a
+      grid % yVertex % array = grid % yVertex % array * a
+      grid % zVertex % array = grid % zVertex % array * a
+      grid % xEdge % array = grid % xEdge % array * a
+      grid % yEdge % array = grid % yEdge % array * a
+      grid % zEdge % array = grid % zEdge % array * a
+      grid % dvEdge % array = grid % dvEdge % array * a
+      grid % dcEdge % array = grid % dcEdge % array * a
+      grid % areaCell % array = grid % areaCell % array * a**2.0
+      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
+      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
+
+      !
+      ! Initialize wind field
+      !
+      allocate(psiVertex(grid % nVertices))
+      do iVtx=1,grid % nVertices
+         psiVertex(iVtx) = -a * a * w * sin(grid%latVertex%array(iVtx)) + &amp;
+                            a *a * K * (cos(grid%latVertex%array(iVtx))**R) * &amp;
+                            sin(grid%latVertex%array(iVtx)) * cos(R * grid%lonVertex%array(iVtx))
+      end do
+      do iEdge=1,grid % nEdges
+         state % u % array(1,iEdge) = -1.0 * ( &amp;
+                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
+                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
+                                             ) / grid%dvEdge%array(iEdge)
+      end do
+      deallocate(psiVertex)
+
+      !
+      ! Initialize height field (actually, fluid thickness field)
+      !
+      do iCell=1,grid % nCells
+         state % h % array(1,iCell) = (gravity * h0 + a*a*AA(grid%latCell%array(iCell)) + &amp;
+                                                      a*a*BB(grid%latCell%array(iCell)) * cos(R*grid%lonCell%array(iCell)) + &amp;
+                                                      a*a*CC(grid%latCell%array(iCell)) * cos(2.0*R*grid%lonCell%array(iCell)) &amp;
+                                      ) / gravity
+      end do
+
+   end subroutine sw_test_case_6
+
+
+   real function sphere_distance(lat1, lon1, lat2, lon2, radius)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
+   !   sphere with given radius.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      real (kind=RKIND), intent(in) :: lat1, lon1, lat2, lon2, radius
+
+      real (kind=RKIND) :: arg1
+
+      arg1 = sqrt( sin(0.5*(lat2-lat1))**2 +  &amp;
+                   cos(lat1)*cos(lat2)*sin(0.5*(lon2-lon1))**2 )
+      sphere_distance = 2.*radius*asin(arg1)
+
+   end function sphere_distance
+
+
+   real function AA(theta)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! A, used in height field computation for Rossby-Haurwitz wave
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      real (kind=RKIND), parameter :: w = 7.848e-6
+      real (kind=RKIND), parameter :: K = 7.848e-6
+      real (kind=RKIND), parameter :: R = 4.0
+
+      real (kind=RKIND), intent(in) :: theta
+
+      AA = 0.5 * w * (2.0 * omega + w) * cos(theta)**2.0 + &amp;
+          0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 + 2.0*R**2.0 - R - 2.0 - 2.0*R**2*cos(theta)**-2.0)
+
+   end function AA
+
+   
+   real function BB(theta)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! B, used in height field computation for Rossby-Haurwitz wave
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      real (kind=RKIND), parameter :: w = 7.848e-6
+      real (kind=RKIND), parameter :: K = 7.848e-6
+      real (kind=RKIND), parameter :: R = 4.0
+
+      real (kind=RKIND), intent(in) :: theta
+
+      BB = (2.0*(omega + w)*K / ((R+1.0)*(R+2.0))) * cos(theta)**R * ((R**2.0 + 2.0*R + 2.0) - ((R+1.0)*cos(theta))**2.0)
+
+   end function BB
+
+
+   real function CC(theta)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! C, used in height field computation for Rossby-Haurwitz wave
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      real (kind=RKIND), parameter :: w = 7.848e-6
+      real (kind=RKIND), parameter :: K = 7.848e-6
+      real (kind=RKIND), parameter :: R = 4.0
+
+      real (kind=RKIND), intent(in) :: theta
+
+      CC = 0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 - R - 2.0)
+
+   end function CC
+
+end module test_cases

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_thick_hadv.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_thick_hadv.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_thick_hadv.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,209 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_thick_hadv
-!
-!&gt; \brief MPAS ocean horizontal advection for thickness
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the routine for computing 
-!&gt;  tendencies for thickness from horizontal advection
-!
-!-----------------------------------------------------------------------
-
-module ocn_thick_hadv
-
-   use grid_types
-   use configure
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_thick_hadv_tend, &amp;
-             ocn_thick_hadv_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_thick_hadv_tend
-!
-!&gt; \brief   Computes tendency term from horizontal advection of thickness
-!&gt; \author  Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the horizontal advection tendency for
-!&gt;  thicknes based on current state and user choices of forcings.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_thick_hadv_tend(grid, u, h_edge, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         u    !&lt; Input: velocity
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge     !&lt; Input: thickness at edge
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdges, cell1, cell2, nVertLevels, k
-      integer :: iCell, nCells
-
-      integer, dimension(:), pointer :: maxLevelEdgeTop
-      integer, dimension(:,:), pointer :: cellsOnEdge
-
-      real (kind=RKIND) :: flux
-      real (kind=RKIND), dimension(:), pointer :: dvEdge, areaCell
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      nEdges = grid % nEdges
-      nCells = grid % nCells
-      nVertLevels = grid % nVertLevels
-
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      dvEdge =&gt; grid % dvEdge % array
-      areaCell =&gt; grid % areaCell % array
-
-      if (config_vert_grid_type.eq.'isopycnal') then

-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            do k=1,nVertLevels
-               flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge)
-               tend(k,cell1) = tend(k,cell1) - flux
-               tend(k,cell2) = tend(k,cell2) + flux
-            end do
-         end do
-         do iCell=1,nCells
-            do k=1,nVertLevels
-               tend(k,iCell) = tend(k,iCell) / areaCell(iCell)
-            end do
-         end do
-
-      elseif (config_vert_grid_type.eq.'zlevel') then
-
-         do iEdge=1,nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            do k=1,min(1,maxLevelEdgeTop(iEdge))
-               flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge)
-               tend(k,cell1) = tend(k,cell1) - flux
-               tend(k,cell2) = tend(k,cell2) + flux
-            end do
-         end do
-         do iCell=1,nCells
-           tend(1,iCell) = tend(1,iCell) / areaCell(iCell)
-         end do
-
-      endif ! config_vert_grid_type
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_thick_hadv_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_thick_hadv_init
-!
-!&gt; \brief   Initializes ocean horizontal thickness advection
-!&gt; \author  Doug Jacobsen
-!&gt; \date    16 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes quantities related to horizontal thickness 
-!&gt;  advection in the ocean. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_thick_hadv_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_thick_hadv_init!}}}
-
-!***********************************************************************
-
-end module ocn_thick_hadv
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_thick_hadv.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_thick_hadv.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_thick_hadv.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_thick_hadv.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,209 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_thick_hadv
+!
+!&gt; \brief MPAS ocean horizontal advection for thickness
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the routine for computing 
+!&gt;  tendencies for thickness from horizontal advection
+!
+!-----------------------------------------------------------------------
+
+module ocn_thick_hadv
+
+   use mpas_grid_types
+   use mpas_configure
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_thick_hadv_tend, &amp;
+             ocn_thick_hadv_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_thick_hadv_tend
+!
+!&gt; \brief   Computes tendency term from horizontal advection of thickness
+!&gt; \author  Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the horizontal advection tendency for
+!&gt;  thicknes based on current state and user choices of forcings.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_thick_hadv_tend(grid, u, h_edge, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         u    !&lt; Input: velocity
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge     !&lt; Input: thickness at edge
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdges, cell1, cell2, nVertLevels, k
+      integer :: iCell, nCells
+
+      integer, dimension(:), pointer :: maxLevelEdgeTop
+      integer, dimension(:,:), pointer :: cellsOnEdge
+
+      real (kind=RKIND) :: flux
+      real (kind=RKIND), dimension(:), pointer :: dvEdge, areaCell
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      nEdges = grid % nEdges
+      nCells = grid % nCells
+      nVertLevels = grid % nVertLevels
+
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      dvEdge =&gt; grid % dvEdge % array
+      areaCell =&gt; grid % areaCell % array
+
+      if (config_vert_grid_type.eq.'isopycnal') then

+         do iEdge=1,nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            do k=1,nVertLevels
+               flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge)
+               tend(k,cell1) = tend(k,cell1) - flux
+               tend(k,cell2) = tend(k,cell2) + flux
+            end do
+         end do
+         do iCell=1,nCells
+            do k=1,nVertLevels
+               tend(k,iCell) = tend(k,iCell) / areaCell(iCell)
+            end do
+         end do
+
+      elseif (config_vert_grid_type.eq.'zlevel') then
+
+         do iEdge=1,nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            do k=1,min(1,maxLevelEdgeTop(iEdge))
+               flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge)
+               tend(k,cell1) = tend(k,cell1) - flux
+               tend(k,cell2) = tend(k,cell2) + flux
+            end do
+         end do
+         do iCell=1,nCells
+           tend(1,iCell) = tend(1,iCell) / areaCell(iCell)
+         end do
+
+      endif ! config_vert_grid_type
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_thick_hadv_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_thick_hadv_init
+!
+!&gt; \brief   Initializes ocean horizontal thickness advection
+!&gt; \author  Doug Jacobsen
+!&gt; \date    16 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes quantities related to horizontal thickness 
+!&gt;  advection in the ocean. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_thick_hadv_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_thick_hadv_init!}}}
+
+!***********************************************************************
+
+end module ocn_thick_hadv
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_thick_vadv.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_thick_vadv.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_thick_vadv.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,163 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_thick_vadv
-!
-!&gt; \brief MPAS ocean vertical advection for thickness
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the routine for computing 
-!&gt;  tendencies for thickness from vertical advection
-!
-!-----------------------------------------------------------------------
-
-module ocn_thick_vadv
-
-   use grid_types
-   use configure
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_thick_vadv_tend, &amp;
-             ocn_thick_vadv_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_thick_vadv_tend
-!
-!&gt; \brief   Computes tendency term from vertical advection of thickness
-!&gt; \author  Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical advection tendency for
-!&gt;  thicknes based on current state and user choices of forcings.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_thick_vadv_tend(grid, wTop, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         wTop     !&lt; Input: vertical velocity on top layer
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: Error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iCell, nCells
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      nCells = grid % nCells
-
-      if (config_vert_grid_type.eq.'zlevel') then
-        do iCell=1,nCells
-           tend(1,iCell) =   tend(1,iCell) + wTop(2,iCell)
-        end do
-      endif ! coordinate type
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_thick_vadv_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_thick_vadv_init
-!
-!&gt; \brief   Initializes ocean thickness vertical advection
-!&gt; \author  Doug Jacobsen
-!&gt; \date    16 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes quantities related to vertical advection of 
-!&gt;  thickness in the ocean. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_thick_vadv_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-      
-      err = 0
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_thick_vadv_init!}}}
-
-!***********************************************************************
-
-end module ocn_thick_vadv
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_thick_vadv.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_thick_vadv.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_thick_vadv.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_thick_vadv.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,163 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_thick_vadv
+!
+!&gt; \brief MPAS ocean vertical advection for thickness
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the routine for computing 
+!&gt;  tendencies for thickness from vertical advection
+!
+!-----------------------------------------------------------------------
+
+module ocn_thick_vadv
+
+   use mpas_grid_types
+   use mpas_configure
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_thick_vadv_tend, &amp;
+             ocn_thick_vadv_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_thick_vadv_tend
+!
+!&gt; \brief   Computes tendency term from vertical advection of thickness
+!&gt; \author  Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical advection tendency for
+!&gt;  thicknes based on current state and user choices of forcings.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_thick_vadv_tend(grid, wTop, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         wTop     !&lt; Input: vertical velocity on top layer
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: Error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iCell, nCells
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      nCells = grid % nCells
+
+      if (config_vert_grid_type.eq.'zlevel') then
+        do iCell=1,nCells
+           tend(1,iCell) =   tend(1,iCell) + wTop(2,iCell)
+        end do
+      endif ! coordinate type
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_thick_vadv_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_thick_vadv_init
+!
+!&gt; \brief   Initializes ocean thickness vertical advection
+!&gt; \author  Doug Jacobsen
+!&gt; \date    16 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes quantities related to vertical advection of 
+!&gt;  thickness in the ocean. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_thick_vadv_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+      
+      err = 0
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_thick_vadv_init!}}}
+
+!***********************************************************************
+
+end module ocn_thick_vadv
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_time_integration.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_time_integration.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_time_integration.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,136 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_time_integration
-!
-!&gt; \brief MPAS ocean time integration driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   26 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for calling
-!&gt;  the time integration scheme
-!
-!-----------------------------------------------------------------------
-
-module ocn_time_integration
-
-   use grid_types
-   use configure
-   use constants
-   use dmpar
-   use vector_reconstruction
-   use spline_interpolation
-   use timer
-
-   use ocn_time_integration_rk4
-   use ocn_time_integration_split
-
-   implicit none
-   private
-   save
-
-   public :: ocn_timestep, &amp;
-             ocn_timestep_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-    logical :: rk4On, splitOn
-
-   contains
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_timestep
-!
-!&gt; \brief MPAS ocean time integration driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   26 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This routine handles a single timestep for the ocean. It determines
-!&gt;  the time integrator that will be used for the run, and calls the
-!&gt;  appropriate one.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_timestep(domain, dt, timeStamp)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Advance model state forward in time by the specified time step
-   !
-   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
-   !                 plus grid meta-data
-   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
-   !                  model state advanced forward in time by dt seconds
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      real (kind=RKIND), intent(in) :: dt
-      character(len=*), intent(in) :: timeStamp
-
-      type (dm_info) :: dminfo
-      type (block_type), pointer :: block
-
-      if (rk4On) then
-         call ocn_time_integrator_rk4(domain, dt)
-      elseif (splitOn) then
-         call ocn_time_integrator_split(domain, dt)
-     endif
-
-     block =&gt; domain % blocklist
-     do while (associated(block))
-        block % state % time_levs(2) % state % xtime % scalar = timeStamp
-
-        if (isNaN(sum(block % state % time_levs(2) % state % u % array))) then
-           write(0,*) 'Abort: NaN detected'
-           call dmpar_abort(dminfo)
-        endif
-
-        block =&gt; block % next
-     end do
-
-   end subroutine ocn_timestep!}}}
-
-   subroutine ocn_timestep_init(err)!{{{
-
-      integer, intent(out) :: err
-
-      err = 0
-
-      rk4On = .false.
-      splitOn = .false.
-
-      if (trim(config_time_integration) == 'RK4') then
-          rk4On = .true.
-      elseif (trim(config_time_integration) == 'split_explicit' &amp;
-          .or.trim(config_time_integration) == 'unsplit_explicit') then
-          splitOn = .true.
-      else
-          err = 1
-          write(*,*) 'Incorrect choice for config_time_integration:', trim(config_time_integration)
-          write(*,*) '   choices are: RK4, split_explicit, unsplit_explicit'
-      endif
-
-
-   end subroutine ocn_timestep_init!}}}
-
-end module ocn_time_integration
-
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_time_integration.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_time_integration.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_time_integration.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_time_integration.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,136 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_time_integration
+!
+!&gt; \brief MPAS ocean time integration driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   26 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for calling
+!&gt;  the time integration scheme
+!
+!-----------------------------------------------------------------------
+
+module ocn_time_integration
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+   use mpas_dmpar
+   use mpas_vector_reconstruction
+   use mpas_spline_interpolation
+   use mpas_timer
+
+   use ocn_time_integration_rk4
+   use ocn_time_integration_split
+
+   implicit none
+   private
+   save
+
+   public :: ocn_timestep, &amp;
+             ocn_timestep_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+    logical :: rk4On, splitOn
+
+   contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_timestep
+!
+!&gt; \brief MPAS ocean time integration driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   26 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This routine handles a single timestep for the ocean. It determines
+!&gt;  the time integrator that will be used for the run, and calls the
+!&gt;  appropriate one.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_timestep(domain, dt, timeStamp)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Advance model state forward in time by the specified time step
+   !
+   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
+   !                 plus grid meta-data
+   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
+   !                  model state advanced forward in time by dt seconds
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+      real (kind=RKIND), intent(in) :: dt
+      character(len=*), intent(in) :: timeStamp
+
+      type (dm_info) :: dminfo
+      type (block_type), pointer :: block
+
+      if (rk4On) then
+         call ocn_time_integrator_rk4(domain, dt)
+      elseif (splitOn) then
+         call ocn_time_integrator_split(domain, dt)
+     endif
+
+     block =&gt; domain % blocklist
+     do while (associated(block))
+        block % state % time_levs(2) % state % xtime % scalar = timeStamp
+
+        if (isNaN(sum(block % state % time_levs(2) % state % u % array))) then
+           write(0,*) 'Abort: NaN detected'
+           call mpas_dmpar_abort(dminfo)
+        endif
+
+        block =&gt; block % next
+     end do
+
+   end subroutine ocn_timestep!}}}
+
+   subroutine ocn_timestep_init(err)!{{{
+
+      integer, intent(out) :: err
+
+      err = 0
+
+      rk4On = .false.
+      splitOn = .false.
+
+      if (trim(config_time_integration) == 'RK4') then
+          rk4On = .true.
+      elseif (trim(config_time_integration) == 'split_explicit' &amp;
+          .or.trim(config_time_integration) == 'unsplit_explicit') then
+          splitOn = .true.
+      else
+          err = 1
+          write(*,*) 'Incorrect choice for config_time_integration:', trim(config_time_integration)
+          write(*,*) '   choices are: RK4, split_explicit, unsplit_explicit'
+      endif
+
+
+   end subroutine ocn_timestep_init!}}}
+
+end module ocn_time_integration
+
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_time_integration_rk4.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_time_integration_rk4.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_time_integration_rk4.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,657 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_time_integration_rk4
-!
-!&gt; \brief MPAS ocean RK4 Time integration scheme
-!&gt; \author Doug Jacobsen
-!&gt; \date   26 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the RK4 time integration routine.
-!
-!-----------------------------------------------------------------------
-
-module ocn_time_integration_rk4
-
-   use grid_types
-   use configure
-   use constants
-   use dmpar
-   use vector_reconstruction
-   use spline_interpolation
-   use timer
-
-   use ocn_tendency
-
-   use ocn_equation_of_state
-   use ocn_Vmix
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_time_integrator_rk4
-
-   contains
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_time_integrator_rk4
-!
-!&gt; \brief MPAS ocean RK4 Time integration scheme
-!&gt; \author Doug Jacobsen
-!&gt; \date   26 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This routine integrates one timestep (dt) using an RK4 time integrator.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_time_integrator_rk4(domain, dt)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Advance model state forward in time by the specified time step using 
-   !   4th order Runge-Kutta
-   !
-   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
-   !                 plus grid meta-data
-   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
-   !                  model state advanced forward in time by dt seconds
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain !&lt; Input/Output: domain information
-      real (kind=RKIND), intent(in) :: dt !&lt; Input: timestep
-
-      integer :: iCell, k, i, err
-      type (block_type), pointer :: block
-      type (state_type) :: provis
-
-      integer :: rk_step, iEdge, cell1, cell2
-
-      real (kind=RKIND), dimension(4) :: rk_weights, rk_substep_weights
-
-      integer :: nCells, nEdges, nVertLevels, num_tracers
-      real (kind=RKIND) :: coef
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        u, h, h_edge, vertViscTopOfEdge, vertDiffTopOfCell, ke_edge
-      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
-      integer, dimension(:), pointer :: &amp; 
-        maxLevelCell, maxLevelEdgeTop
-      real (kind=RKIND), dimension(:), allocatable:: A,C,uTemp
-      real (kind=RKIND), dimension(:,:), allocatable:: tracersTemp
-
-
-      block =&gt; domain % blocklist
-      call allocate_state(provis, &amp;
-                          block % mesh % nCells, block % mesh % nEdges, block % mesh % maxEdges, block % mesh % maxEdges2, &amp;
-                          block % mesh % nVertices, block % mesh % vertexDegree, block % mesh % nVertLevels )
-
-      !
-      ! Initialize time_levs(2) with state at current time
-      ! Initialize first RK state
-      ! Couple tracers time_levs(2) with h in time-levels
-      ! Initialize RK weights
-      !
-      block =&gt; domain % blocklist
-      do while (associated(block))
-
-         block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
-         block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:)
-         do iCell=1,block % mesh % nCells  ! couple tracers to h
-           do k=1,block % mesh % maxLevelCell % array(iCell)
-             block % state % time_levs(2) % state % tracers % array(:,k,iCell) = block % state % time_levs(1) % state % tracers % array(:,k,iCell) &amp;
-                                                                       * block % state % time_levs(1) % state % h % array(k,iCell)
-            end do
-         end do
-
-         call copy_state(provis, block % state % time_levs(1) % state)
-
-         block =&gt; block % next
-      end do
-
-      rk_weights(1) = dt/6.
-      rk_weights(2) = dt/3.
-      rk_weights(3) = dt/3.
-      rk_weights(4) = dt/6.
-
-      rk_substep_weights(1) = dt/2.
-      rk_substep_weights(2) = dt/2.
-      rk_substep_weights(3) = dt
-      rk_substep_weights(4) = 0.
-
-
-      call timer_start(&quot;RK4-main loop&quot;)
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ! BEGIN RK loop 
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      do rk_step = 1, 4
-! ---  update halos for diagnostic variables
-
-        call timer_start(&quot;RK4-diagnostic halo update&quot;)
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call dmpar_exch_halo_field2dReal(domain % dminfo, provis % pv_edge % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
-                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
-           if (config_h_mom_eddy_visc4 &gt; 0.0) then
-              call dmpar_exch_halo_field2dReal(domain % dminfo, provis % divergence % array(:,:), &amp;
-                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-              call dmpar_exch_halo_field2dReal(domain % dminfo, provis % vorticity % array(:,:), &amp;
-                                               block % mesh % nVertLevels, block % mesh % nVertices, &amp;
-                                               block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
-           end if
-
-           block =&gt; block % next
-        end do
-        call timer_stop(&quot;RK4-diagnostic halo update&quot;)
-
-! ---  compute tendencies
-
-        call timer_start(&quot;RK4-tendency computations&quot;)
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           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_u(block % tend, provis, block % diagnostics, block % mesh)
-
-           ! mrp 110718 filter btr mode out of u_tend
-           ! still got h perturbations with just this alone.  Try to set uBtr=0 after full u computation
-           if (config_rk_filter_btr_mode) then
-               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 enforce_boundaryEdge(block % tend, block % mesh)
-           block =&gt; block % next
-        end do
-        call timer_stop(&quot;RK4-tendency computations&quot;)
-
-! ---  update halos for prognostic variables
-
-        call timer_start(&quot;RK4-pronostic halo update&quot;)
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % u % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
-                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % h % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % tracers % array(:,:,:), &amp;
-                                            block % tend % num_tracers, block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           block =&gt; block % next
-        end do
-        call timer_stop(&quot;RK4-pronostic halo update&quot;)
-
-! ---  compute next substep state
-
-        call timer_start(&quot;RK4-update diagnostic variables&quot;)
-        if (rk_step &lt; 4) then
-           block =&gt; domain % blocklist
-           do while (associated(block))
-
-              provis % u % array(:,:)       = block % state % time_levs(1) % state % u % array(:,:)  &amp;
-                                         + rk_substep_weights(rk_step) * block % tend % u % array(:,:)
-
-              provis % h % array(:,:)       = block % state % time_levs(1) % state % h % array(:,:)  &amp;
-                                         + rk_substep_weights(rk_step) * block % tend % h % array(:,:)
-              do iCell=1,block % mesh % nCells
-                 do k=1,block % mesh % maxLevelCell % array(iCell)
-                    provis % tracers % array(:,k,iCell) = ( &amp;
-                                                                      block % state % time_levs(1) % state % h % array(k,iCell) * &amp;
-                                                                      block % state % time_levs(1) % state % tracers % array(:,k,iCell)  &amp;
-                                      + rk_substep_weights(rk_step) * block % tend % tracers % array(:,k,iCell) &amp;
-                                                                     ) / provis % h % array(k,iCell)
-                 end do
-
-              end do
-              if (config_test_case == 1) then    ! For case 1, wind field should be fixed
-                 provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
-              end if
-
-              call ocn_diagnostic_solve(dt, provis, block % mesh)
-
-              block =&gt; block % next
-           end do
-        end if
-        call timer_stop(&quot;RK4-update diagnostic variables&quot;)
-
-
-
-!--- accumulate update (for RK4)
-
-        call timer_start(&quot;RK4-RK4 accumulate update&quot;)
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % u % array(:,:) &amp;
-                                   + rk_weights(rk_step) * block % tend % u % array(:,:) 
-
-           block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(2) % state % h % array(:,:) &amp;
-                                   + rk_weights(rk_step) * block % tend % h % array(:,:) 
-
-           do iCell=1,block % mesh % nCells
-              do k=1,block % mesh % maxLevelCell % array(iCell)
-                 block % state % time_levs(2) % state % tracers % array(:,k,iCell) =  &amp;
-                                                                       block % state % time_levs(2) % state % tracers % array(:,k,iCell) &amp;
-                                               + rk_weights(rk_step) * block % tend % tracers % array(:,k,iCell)
-              end do
-           end do
-
-           block =&gt; block % next
-        end do
-        call timer_stop(&quot;RK4-RK4 accumulate update&quot;)
-
-      end do
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ! END RK loop 
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      call timer_stop(&quot;RK4-main loop&quot;)
-
-      !
-      !  A little clean up at the end: decouple new scalar fields and compute diagnostics for new state
-      !
-      call timer_start(&quot;RK4-cleaup phase&quot;)
-      block =&gt; domain % blocklist
-      do while (associated(block))
-
-         u           =&gt; block % state % time_levs(2) % state % u % array
-         tracers     =&gt; block % state % time_levs(2) % state % tracers % array
-         h           =&gt; block % state % time_levs(2) % state % h % array
-         h_edge      =&gt; block % state % time_levs(2) % state % h_edge % array
-         ke_edge     =&gt; block % state % time_levs(2) % state % ke_edge % array
-         num_tracers = block % state % time_levs(2) % state % num_tracers
-         vertViscTopOfEdge =&gt; block % diagnostics % vertViscTopOfEdge % array
-         vertDiffTopOfCell =&gt; block % diagnostics % vertDiffTopOfCell % array
-         maxLevelCell    =&gt; block % mesh % maxLevelCell % array
-         maxLevelEdgeTop =&gt; block % mesh % maxLevelEdgeTop % array
-                  
-         nCells      = block % mesh % nCells
-         nEdges      = block % mesh % nEdges
-         nVertLevels = block % mesh % nVertLevels
-
-         do iCell=1,nCells
-            do k=1,maxLevelCell(iCell)
-               tracers(:,k,iCell) = tracers(:,k,iCell) / h(k,iCell)
-            end do
-         end do
-
-         if (config_implicit_vertical_mix) then
-            call timer_start(&quot;RK4-implicit vert mix&quot;)
-            allocate(A(nVertLevels),C(nVertLevels),uTemp(nVertLevels), &amp;
-               tracersTemp(num_tracers,nVertLevels))
-
-            call ocn_vmix_coefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
-
-            !
-            !  Implicit vertical solve for momentum
-            !
-            call ocn_vel_vmix_tend_implicit(block % mesh, dt, ke_edge, vertvisctopofedge, h, h_edge, u, err)
-
-          !  mrp 110718 filter btr mode out of u
-           if (config_rk_filter_btr_mode) then
-               call filter_btr_mode_u(block % state % time_levs(2) % state, block % mesh)
-               !block % tend % h % array(:,:) = 0.0 ! I should not need this
-           endif
-
-            !
-            !  Implicit vertical solve for tracers
-            !
-
-            call ocn_tracer_vmix_tend_implicit(block % mesh, dt, vertdifftopofcell, h, tracers, err)
-         end if
-
-         ! mrp 110725 momentum decay term
-         if (config_mom_decay) then
-             call timer_start(&quot;RK4-momentum decay&quot;)
-
-            !
-            !  Implicit solve for momentum decay
-            !
-            !  Add term to RHS of momentum equation: -1/gamma u
-            !
-            !  This changes the solve to:
-            !  u^{n+1} = u_provis^{n+1}/(1+dt/gamma)
-            !
-            coef = 1.0/(1.0 + dt/config_mom_decay_time)
-            do iEdge=1,block % mesh % nEdges
-               do k=1,maxLevelEdgeTop(iEdge)
-                  u(k,iEdge) = coef*u(k,iEdge) 
-               end do
-            end do
-
-            call timer_stop(&quot;RK4-momentum decay&quot;)
-         end if
-
-
-         if (config_test_case == 1) then    ! For case 1, wind field should be fixed
-            block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
-         end if
-
-         call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
-
-         call reconstruct(block % mesh, block % state % time_levs(2) % state % u % array,          &amp;
-                          block % state % time_levs(2) % state % uReconstructX % array,            &amp;
-                          block % state % time_levs(2) % state % uReconstructY % array,            &amp;
-                          block % state % time_levs(2) % state % uReconstructZ % array,            &amp;
-                          block % state % time_levs(2) % state % uReconstructZonal % array,        &amp;
-                          block % state % time_levs(2) % state % uReconstructMeridional % array    &amp;
-                         )
-
-         block =&gt; block % next
-      end do
-      call timer_stop(&quot;RK4-cleaup phase&quot;)
-
-      call deallocate_state(provis)
-
-   end subroutine ocn_time_integrator_rk4!}}}
-
-   subroutine filter_btr_mode_tend_u(tend, s, d, grid)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Filter and remove barotropic mode from the tendencies
-   !
-   ! 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
-
-! mrp 110512 I just split compute_tend into compute_tend_u and compute_tend_h.
-!  Some of these variables can be removed, but at a later time.
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
-        vertex1, vertex2, eoe, i, j
-
-      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
-      real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
-      real (kind=RKIND), dimension(:), pointer :: &amp;
-        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
-        zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &amp;
-        tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
-        MontPot, wTop, divergence, vertViscTopOfEdge
-      type (dm_info) :: dminfo
-
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
-        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
-      integer, dimension(:,:), pointer :: &amp;
-        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
-        edgesOnEdge, edgesOnVertex
-      real (kind=RKIND) :: u_diffusion
-      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
-
-
-      real (kind=RKIND), dimension(:,:), pointer :: u_src
-      real (kind=RKIND), parameter :: rho_ref = 1000.0
-
-      call timer_start(&quot;filter_btr_mode_tend_u&quot;)
-
-      h           =&gt; s % h % array
-      u           =&gt; s % u % array
-      v           =&gt; s % v % array
-      wTop        =&gt; s % wTop % array
-      h_edge      =&gt; s % h_edge % array
-      circulation =&gt; s % circulation % array
-      vorticity   =&gt; s % vorticity % array
-      divergence  =&gt; s % divergence % array
-      ke          =&gt; s % ke % array
-      ke_edge     =&gt; s % ke_edge % array
-      pv_edge     =&gt; s % pv_edge % array
-      MontPot     =&gt; s % MontPot % array
-      pressure    =&gt; s % pressure % array
-      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      cellsOnVertex     =&gt; grid % cellsOnVertex % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
-      edgesOnCell       =&gt; grid % edgesOnCell % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      edgesOnVertex     =&gt; grid % edgesOnVertex % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      h_s               =&gt; grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
-      fVertex           =&gt; grid % fVertex % array
-      fEdge             =&gt; grid % fEdge % array
-      zMidZLevel        =&gt; grid % zMidZLevel % array
-      zTopZLevel        =&gt; grid % zTopZLevel % array
-      maxLevelCell      =&gt; grid % maxLevelCell % array
-      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
-      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
-
-      tend_u      =&gt; tend % u % array
-                  
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nEdgesSolve = grid % nEdgesSolve
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      u_src =&gt; grid % u_src % array
-
-           do iEdge=1,grid % nEdges
-
-              ! I am using hZLevel here.  This assumes that SSH is zero everywhere already,
-              ! which should be the case if the barotropic mode is filtered.
-              ! The more general case is to use sshEdge or h_edge.
-              uhSum = (grid % hZLevel % array(1)) * tend_u(1,iEdge)
-              hSum  =  grid % hZLevel % array(1)
-
-              do k=2,grid % maxLevelEdgeTop % array(iEdge)
-                 uhSum = uhSum + grid % hZLevel % array(k) * tend_u(k,iEdge)
-                 hSum  =  hSum + grid % hZLevel % array(k)
-              enddo
-
-              vertSum = uhSum/hSum
-
-              do k=1,grid % maxLevelEdgeTop % array(iEdge)
-                 tend_u(k,iEdge) = tend_u(k,iEdge) - vertSum
-              enddo
-
-           enddo ! iEdge
-
-      call timer_stop(&quot;filter_btr_mode_tend_u&quot;)
-
-   end subroutine filter_btr_mode_tend_u!}}}
-
-   subroutine filter_btr_mode_u(s, grid)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Filter and remove barotropic mode.
-   !
-   ! 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
-
-! mrp 110512 I just split compute_tend into compute_tend_u and compute_tend_h.
-!  Some of these variables can be removed, but at a later time.
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
-        vertex1, vertex2, eoe, i, j
-
-      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
-      real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
-      real (kind=RKIND), dimension(:), pointer :: &amp;
-        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
-        zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &amp;
-        tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
-        MontPot, wTop, divergence, vertViscTopOfEdge
-      type (dm_info) :: dminfo
-
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
-        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
-      integer, dimension(:,:), pointer :: &amp;
-        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
-        edgesOnEdge, edgesOnVertex
-      real (kind=RKIND) :: u_diffusion
-      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
-
-
-      real (kind=RKIND), dimension(:,:), pointer :: u_src
-      real (kind=RKIND), parameter :: rho_ref = 1000.0
-
-      call timer_start(&quot;filter_btr_mode_u&quot;)
-
-      h           =&gt; s % h % array
-      u           =&gt; s % u % array
-      v           =&gt; s % v % array
-      wTop        =&gt; s % wTop % array
-      h_edge      =&gt; s % h_edge % array
-      circulation =&gt; s % circulation % array
-      vorticity   =&gt; s % vorticity % array
-      divergence  =&gt; s % divergence % array
-      ke          =&gt; s % ke % array
-      ke_edge     =&gt; s % ke_edge % array
-      pv_edge     =&gt; s % pv_edge % array
-      MontPot     =&gt; s % MontPot % array
-      pressure    =&gt; s % pressure % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      cellsOnVertex     =&gt; grid % cellsOnVertex % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
-      edgesOnCell       =&gt; grid % edgesOnCell % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      edgesOnVertex     =&gt; grid % edgesOnVertex % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      h_s               =&gt; grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
-      fVertex           =&gt; grid % fVertex % array
-      fEdge             =&gt; grid % fEdge % array
-      zMidZLevel        =&gt; grid % zMidZLevel % array
-      zTopZLevel        =&gt; grid % zTopZLevel % array
-      maxLevelCell      =&gt; grid % maxLevelCell % array
-      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
-      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
-
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nEdgesSolve = grid % nEdgesSolve
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      u_src =&gt; grid % u_src % array
-
-           do iEdge=1,grid % nEdges
-
-              ! I am using hZLevel here.  This assumes that SSH is zero everywhere already,
-              ! which should be the case if the barotropic mode is filtered.
-              ! The more general case is to use sshedge or h_edge.
-              uhSum = (grid % hZLevel % array(1)) * u(1,iEdge)
-              hSum  =  grid % hZLevel % array(1)
-
-              do k=2,grid % maxLevelEdgeTop % array(iEdge)
-                 uhSum = uhSum + grid % hZLevel % array(k) * u(k,iEdge)
-                 hSum  =  hSum + grid % hZLevel % array(k)
-              enddo
-
-              vertSum = uhSum/hSum
-              do k=1,grid % maxLevelEdgeTop % array(iEdge)
-                 u(k,iEdge) = u(k,iEdge) - vertSum
-              enddo
-
-           enddo ! iEdge
-
-      call timer_stop(&quot;filter_btr_mode_u&quot;)
-
-   end subroutine filter_btr_mode_u!}}}
-
-   subroutine enforce_boundaryEdge(tend, grid)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Enforce any boundary conditions on the normal velocity at each edge
-   !
-   ! Input: grid - grid metadata
-   !
-   ! Output: tend_u set to zero at boundaryEdge == 1 locations
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-      implicit none
-
-      type (tend_type), intent(inout) :: tend
-      type (mesh_type), intent(in) :: grid
-
-      integer, dimension(:,:), pointer :: boundaryEdge
-      real (kind=RKIND), dimension(:,:), pointer :: tend_u
-      integer :: nCells, nEdges, nVertices, nVertLevels
-      integer :: iEdge, k
-
-      call timer_start(&quot;enforce_boundaryEdge&quot;)
-
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      boundaryEdge         =&gt; grid % boundaryEdge % array
-      tend_u      =&gt; tend % u % array
-
-      if(maxval(boundaryEdge).le.0) return
-
-      do iEdge = 1,nEdges
-        do k = 1,nVertLevels
-
-          if(boundaryEdge(k,iEdge).eq.1) then
-             tend_u(k,iEdge) = 0.0
-          endif
-
-        enddo
-       enddo
-      call timer_stop(&quot;enforce_boundaryEdge&quot;)
-
-   end subroutine enforce_boundaryEdge!}}}
-
-end module ocn_time_integration_rk4
-
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_time_integration_rk4.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_time_integration_rk4.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_time_integration_rk4.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_time_integration_rk4.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,657 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_time_integration_rk4
+!
+!&gt; \brief MPAS ocean RK4 Time integration scheme
+!&gt; \author Doug Jacobsen
+!&gt; \date   26 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the RK4 time integration routine.
+!
+!-----------------------------------------------------------------------
+
+module ocn_time_integration_rk4
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+   use mpas_dmpar
+   use mpas_vector_reconstruction
+   use mpas_spline_interpolation
+   use mpas_timer
+
+   use ocn_tendency
+
+   use ocn_equation_of_state
+   use ocn_Vmix
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_time_integrator_rk4
+
+   contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_time_integrator_rk4
+!
+!&gt; \brief MPAS ocean RK4 Time integration scheme
+!&gt; \author Doug Jacobsen
+!&gt; \date   26 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This routine integrates one timestep (dt) using an RK4 time integrator.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_time_integrator_rk4(domain, dt)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Advance model state forward in time by the specified time step using 
+   !   4th order Runge-Kutta
+   !
+   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
+   !                 plus grid meta-data
+   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
+   !                  model state advanced forward in time by dt seconds
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain !&lt; Input/Output: domain information
+      real (kind=RKIND), intent(in) :: dt !&lt; Input: timestep
+
+      integer :: iCell, k, i, err
+      type (block_type), pointer :: block
+      type (state_type) :: provis
+
+      integer :: rk_step, iEdge, cell1, cell2
+
+      real (kind=RKIND), dimension(4) :: rk_weights, rk_substep_weights
+
+      integer :: nCells, nEdges, nVertLevels, num_tracers
+      real (kind=RKIND) :: coef
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        u, h, h_edge, vertViscTopOfEdge, vertDiffTopOfCell, ke_edge
+      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+      integer, dimension(:), pointer :: &amp; 
+        maxLevelCell, maxLevelEdgeTop
+      real (kind=RKIND), dimension(:), allocatable:: A,C,uTemp
+      real (kind=RKIND), dimension(:,:), allocatable:: tracersTemp
+
+
+      block =&gt; domain % blocklist
+      call mpas_allocate_state(provis, &amp;
+                          block % mesh % nCells, block % mesh % nEdges, block % mesh % maxEdges, block % mesh % maxEdges2, &amp;
+                          block % mesh % nVertices, block % mesh % vertexDegree, block % mesh % nVertLevels )
+
+      !
+      ! Initialize time_levs(2) with state at current time
+      ! Initialize first RK state
+      ! Couple tracers time_levs(2) with h in time-levels
+      ! Initialize RK weights
+      !
+      block =&gt; domain % blocklist
+      do while (associated(block))
+
+         block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+         block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:)
+         do iCell=1,block % mesh % nCells  ! couple tracers to h
+           do k=1,block % mesh % maxLevelCell % array(iCell)
+             block % state % time_levs(2) % state % tracers % array(:,k,iCell) = block % state % time_levs(1) % state % tracers % array(:,k,iCell) &amp;
+                                                                       * block % state % time_levs(1) % state % h % array(k,iCell)
+            end do
+         end do
+
+         call mpas_copy_state(provis, block % state % time_levs(1) % state)
+
+         block =&gt; block % next
+      end do
+
+      rk_weights(1) = dt/6.
+      rk_weights(2) = dt/3.
+      rk_weights(3) = dt/3.
+      rk_weights(4) = dt/6.
+
+      rk_substep_weights(1) = dt/2.
+      rk_substep_weights(2) = dt/2.
+      rk_substep_weights(3) = dt
+      rk_substep_weights(4) = 0.
+
+
+      call mpas_timer_start(&quot;RK4-main loop&quot;)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! BEGIN RK loop 
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      do rk_step = 1, 4
+! ---  update halos for diagnostic variables
+
+        call mpas_timer_start(&quot;RK4-diagnostic halo update&quot;)
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, provis % pv_edge % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
+                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+           if (config_h_mom_eddy_visc4 &gt; 0.0) then
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &amp;
+                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &amp;
+                                               block % mesh % nVertLevels, block % mesh % nVertices, &amp;
+                                               block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
+           end if
+
+           block =&gt; block % next
+        end do
+        call mpas_timer_stop(&quot;RK4-diagnostic halo update&quot;)
+
+! ---  compute tendencies
+
+        call mpas_timer_start(&quot;RK4-tendency computations&quot;)
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           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_u(block % tend, provis, block % diagnostics, block % mesh)
+
+           ! mrp 110718 filter btr mode out of u_tend
+           ! still got h perturbations with just this alone.  Try to set uBtr=0 after full u computation
+           if (config_rk_filter_btr_mode) then
+               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 enforce_boundaryEdge(block % tend, block % mesh)
+           block =&gt; block % next
+        end do
+        call mpas_timer_stop(&quot;RK4-tendency computations&quot;)
+
+! ---  update halos for prognostic variables
+
+        call mpas_timer_start(&quot;RK4-pronostic halo update&quot;)
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % tend % u % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
+                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % tend % h % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           call mpas_dmpar_exch_halo_field3d_real(domain % dminfo, block % tend % tracers % array(:,:,:), &amp;
+                                            block % tend % num_tracers, block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           block =&gt; block % next
+        end do
+        call mpas_timer_stop(&quot;RK4-pronostic halo update&quot;)
+
+! ---  compute next substep state
+
+        call mpas_timer_start(&quot;RK4-update diagnostic variables&quot;)
+        if (rk_step &lt; 4) then
+           block =&gt; domain % blocklist
+           do while (associated(block))
+
+              provis % u % array(:,:)       = block % state % time_levs(1) % state % u % array(:,:)  &amp;
+                                         + rk_substep_weights(rk_step) * block % tend % u % array(:,:)
+
+              provis % h % array(:,:)       = block % state % time_levs(1) % state % h % array(:,:)  &amp;
+                                         + rk_substep_weights(rk_step) * block % tend % h % array(:,:)
+              do iCell=1,block % mesh % nCells
+                 do k=1,block % mesh % maxLevelCell % array(iCell)
+                    provis % tracers % array(:,k,iCell) = ( &amp;
+                                                                      block % state % time_levs(1) % state % h % array(k,iCell) * &amp;
+                                                                      block % state % time_levs(1) % state % tracers % array(:,k,iCell)  &amp;
+                                      + rk_substep_weights(rk_step) * block % tend % tracers % array(:,k,iCell) &amp;
+                                                                     ) / provis % h % array(k,iCell)
+                 end do
+
+              end do
+              if (config_test_case == 1) then    ! For case 1, wind field should be fixed
+                 provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+              end if
+
+              call ocn_diagnostic_solve(dt, provis, block % mesh)
+
+              block =&gt; block % next
+           end do
+        end if
+        call mpas_timer_stop(&quot;RK4-update diagnostic variables&quot;)
+
+
+
+!--- accumulate update (for RK4)
+
+        call mpas_timer_start(&quot;RK4-RK4 accumulate update&quot;)
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % u % array(:,:) &amp;
+                                   + rk_weights(rk_step) * block % tend % u % array(:,:) 
+
+           block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(2) % state % h % array(:,:) &amp;
+                                   + rk_weights(rk_step) * block % tend % h % array(:,:) 
+
+           do iCell=1,block % mesh % nCells
+              do k=1,block % mesh % maxLevelCell % array(iCell)
+                 block % state % time_levs(2) % state % tracers % array(:,k,iCell) =  &amp;
+                                                                       block % state % time_levs(2) % state % tracers % array(:,k,iCell) &amp;
+                                               + rk_weights(rk_step) * block % tend % tracers % array(:,k,iCell)
+              end do
+           end do
+
+           block =&gt; block % next
+        end do
+        call mpas_timer_stop(&quot;RK4-RK4 accumulate update&quot;)
+
+      end do
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! END RK loop 
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      call mpas_timer_stop(&quot;RK4-main loop&quot;)
+
+      !
+      !  A little clean up at the end: decouple new scalar fields and compute diagnostics for new state
+      !
+      call mpas_timer_start(&quot;RK4-cleaup phase&quot;)
+      block =&gt; domain % blocklist
+      do while (associated(block))
+
+         u           =&gt; block % state % time_levs(2) % state % u % array
+         tracers     =&gt; block % state % time_levs(2) % state % tracers % array
+         h           =&gt; block % state % time_levs(2) % state % h % array
+         h_edge      =&gt; block % state % time_levs(2) % state % h_edge % array
+         ke_edge     =&gt; block % state % time_levs(2) % state % ke_edge % array
+         num_tracers = block % state % time_levs(2) % state % num_tracers
+         vertViscTopOfEdge =&gt; block % diagnostics % vertViscTopOfEdge % array
+         vertDiffTopOfCell =&gt; block % diagnostics % vertDiffTopOfCell % array
+         maxLevelCell    =&gt; block % mesh % maxLevelCell % array
+         maxLevelEdgeTop =&gt; block % mesh % maxLevelEdgeTop % array
+                  
+         nCells      = block % mesh % nCells
+         nEdges      = block % mesh % nEdges
+         nVertLevels = block % mesh % nVertLevels
+
+         do iCell=1,nCells
+            do k=1,maxLevelCell(iCell)
+               tracers(:,k,iCell) = tracers(:,k,iCell) / h(k,iCell)
+            end do
+         end do
+
+         if (config_implicit_vertical_mix) then
+            call mpas_timer_start(&quot;RK4-implicit vert mix&quot;)
+            allocate(A(nVertLevels),C(nVertLevels),uTemp(nVertLevels), &amp;
+               tracersTemp(num_tracers,nVertLevels))
+
+            call ocn_vmix_coefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
+
+            !
+            !  Implicit vertical solve for momentum
+            !
+            call ocn_vel_vmix_tend_implicit(block % mesh, dt, ke_edge, vertvisctopofedge, h, h_edge, u, err)
+
+          !  mrp 110718 filter btr mode out of u
+           if (config_rk_filter_btr_mode) then
+               call filter_btr_mode_u(block % state % time_levs(2) % state, block % mesh)
+               !block % tend % h % array(:,:) = 0.0 ! I should not need this
+           endif
+
+            !
+            !  Implicit vertical solve for tracers
+            !
+
+            call ocn_tracer_vmix_tend_implicit(block % mesh, dt, vertdifftopofcell, h, tracers, err)
+         end if
+
+         ! mrp 110725 momentum decay term
+         if (config_mom_decay) then
+             call mpas_timer_start(&quot;RK4-momentum decay&quot;)
+
+            !
+            !  Implicit solve for momentum decay
+            !
+            !  Add term to RHS of momentum equation: -1/gamma u
+            !
+            !  This changes the solve to:
+            !  u^{n+1} = u_provis^{n+1}/(1+dt/gamma)
+            !
+            coef = 1.0/(1.0 + dt/config_mom_decay_time)
+            do iEdge=1,block % mesh % nEdges
+               do k=1,maxLevelEdgeTop(iEdge)
+                  u(k,iEdge) = coef*u(k,iEdge) 
+               end do
+            end do
+
+            call mpas_timer_stop(&quot;RK4-momentum decay&quot;)
+         end if
+
+
+         if (config_test_case == 1) then    ! For case 1, wind field should be fixed
+            block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+         end if
+
+         call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
+
+         call mpas_reconstruct(block % mesh, block % state % time_levs(2) % state % u % array,          &amp;
+                          block % state % time_levs(2) % state % uReconstructX % array,            &amp;
+                          block % state % time_levs(2) % state % uReconstructY % array,            &amp;
+                          block % state % time_levs(2) % state % uReconstructZ % array,            &amp;
+                          block % state % time_levs(2) % state % uReconstructZonal % array,        &amp;
+                          block % state % time_levs(2) % state % uReconstructMeridional % array    &amp;
+                         )
+
+         block =&gt; block % next
+      end do
+      call mpas_timer_stop(&quot;RK4-cleaup phase&quot;)
+
+      call mpas_deallocate_state(provis)
+
+   end subroutine ocn_time_integrator_rk4!}}}
+
+   subroutine filter_btr_mode_tend_u(tend, s, d, grid)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Filter and remove barotropic mode from the tendencies
+   !
+   ! 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
+
+! mrp 110512 I just split compute_tend into compute_tend_u and compute_tend_h.
+!  Some of these variables can be removed, but at a later time.
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
+        vertex1, vertex2, eoe, i, j
+
+      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
+      real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
+      real (kind=RKIND), dimension(:), pointer :: &amp;
+        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
+        zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &amp;
+        tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
+        MontPot, wTop, divergence, vertViscTopOfEdge
+      type (dm_info) :: dminfo
+
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
+        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+      integer, dimension(:,:), pointer :: &amp;
+        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
+        edgesOnEdge, edgesOnVertex
+      real (kind=RKIND) :: u_diffusion
+      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
+
+
+      real (kind=RKIND), dimension(:,:), pointer :: u_src
+      real (kind=RKIND), parameter :: rho_ref = 1000.0
+
+      call mpas_timer_start(&quot;filter_btr_mode_tend_u&quot;)
+
+      h           =&gt; s % h % array
+      u           =&gt; s % u % array
+      v           =&gt; s % v % array
+      wTop        =&gt; s % wTop % array
+      h_edge      =&gt; s % h_edge % array
+      circulation =&gt; s % circulation % array
+      vorticity   =&gt; s % vorticity % array
+      divergence  =&gt; s % divergence % array
+      ke          =&gt; s % ke % array
+      ke_edge     =&gt; s % ke_edge % array
+      pv_edge     =&gt; s % pv_edge % array
+      MontPot     =&gt; s % MontPot % array
+      pressure    =&gt; s % pressure % array
+      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
+
+      weightsOnEdge     =&gt; grid % weightsOnEdge % array
+      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      cellsOnVertex     =&gt; grid % cellsOnVertex % array
+      verticesOnEdge    =&gt; grid % verticesOnEdge % array
+      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
+      edgesOnCell       =&gt; grid % edgesOnCell % array
+      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
+      edgesOnEdge       =&gt; grid % edgesOnEdge % array
+      edgesOnVertex     =&gt; grid % edgesOnVertex % array
+      dcEdge            =&gt; grid % dcEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      areaCell          =&gt; grid % areaCell % array
+      areaTriangle      =&gt; grid % areaTriangle % array
+      h_s               =&gt; grid % h_s % array
+! mrp 110516 cleanup fvertex fedge not used in this subroutine
+      fVertex           =&gt; grid % fVertex % array
+      fEdge             =&gt; grid % fEdge % array
+      zMidZLevel        =&gt; grid % zMidZLevel % array
+      zTopZLevel        =&gt; grid % zTopZLevel % array
+      maxLevelCell      =&gt; grid % maxLevelCell % array
+      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
+      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
+
+      tend_u      =&gt; tend % u % array
+                  
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nEdgesSolve = grid % nEdgesSolve
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+
+      u_src =&gt; grid % u_src % array
+
+           do iEdge=1,grid % nEdges
+
+              ! I am using hZLevel here.  This assumes that SSH is zero everywhere already,
+              ! which should be the case if the barotropic mode is filtered.
+              ! The more general case is to use sshEdge or h_edge.
+              uhSum = (grid % hZLevel % array(1)) * tend_u(1,iEdge)
+              hSum  =  grid % hZLevel % array(1)
+
+              do k=2,grid % maxLevelEdgeTop % array(iEdge)
+                 uhSum = uhSum + grid % hZLevel % array(k) * tend_u(k,iEdge)
+                 hSum  =  hSum + grid % hZLevel % array(k)
+              enddo
+
+              vertSum = uhSum/hSum
+
+              do k=1,grid % maxLevelEdgeTop % array(iEdge)
+                 tend_u(k,iEdge) = tend_u(k,iEdge) - vertSum
+              enddo
+
+           enddo ! iEdge
+
+      call mpas_timer_stop(&quot;filter_btr_mode_tend_u&quot;)
+
+   end subroutine filter_btr_mode_tend_u!}}}
+
+   subroutine filter_btr_mode_u(s, grid)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Filter and remove barotropic mode.
+   !
+   ! 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
+
+! mrp 110512 I just split compute_tend into compute_tend_u and compute_tend_h.
+!  Some of these variables can be removed, but at a later time.
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
+        vertex1, vertex2, eoe, i, j
+
+      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
+      real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
+      real (kind=RKIND), dimension(:), pointer :: &amp;
+        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
+        zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &amp;
+        tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
+        MontPot, wTop, divergence, vertViscTopOfEdge
+      type (dm_info) :: dminfo
+
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
+        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+      integer, dimension(:,:), pointer :: &amp;
+        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
+        edgesOnEdge, edgesOnVertex
+      real (kind=RKIND) :: u_diffusion
+      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
+
+
+      real (kind=RKIND), dimension(:,:), pointer :: u_src
+      real (kind=RKIND), parameter :: rho_ref = 1000.0
+
+      call mpas_timer_start(&quot;filter_btr_mode_u&quot;)
+
+      h           =&gt; s % h % array
+      u           =&gt; s % u % array
+      v           =&gt; s % v % array
+      wTop        =&gt; s % wTop % array
+      h_edge      =&gt; s % h_edge % array
+      circulation =&gt; s % circulation % array
+      vorticity   =&gt; s % vorticity % array
+      divergence  =&gt; s % divergence % array
+      ke          =&gt; s % ke % array
+      ke_edge     =&gt; s % ke_edge % array
+      pv_edge     =&gt; s % pv_edge % array
+      MontPot     =&gt; s % MontPot % array
+      pressure    =&gt; s % pressure % array
+
+      weightsOnEdge     =&gt; grid % weightsOnEdge % array
+      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      cellsOnVertex     =&gt; grid % cellsOnVertex % array
+      verticesOnEdge    =&gt; grid % verticesOnEdge % array
+      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
+      edgesOnCell       =&gt; grid % edgesOnCell % array
+      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
+      edgesOnEdge       =&gt; grid % edgesOnEdge % array
+      edgesOnVertex     =&gt; grid % edgesOnVertex % array
+      dcEdge            =&gt; grid % dcEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      areaCell          =&gt; grid % areaCell % array
+      areaTriangle      =&gt; grid % areaTriangle % array
+      h_s               =&gt; grid % h_s % array
+! mrp 110516 cleanup fvertex fedge not used in this subroutine
+      fVertex           =&gt; grid % fVertex % array
+      fEdge             =&gt; grid % fEdge % array
+      zMidZLevel        =&gt; grid % zMidZLevel % array
+      zTopZLevel        =&gt; grid % zTopZLevel % array
+      maxLevelCell      =&gt; grid % maxLevelCell % array
+      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
+      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
+
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nEdgesSolve = grid % nEdgesSolve
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+
+      u_src =&gt; grid % u_src % array
+
+           do iEdge=1,grid % nEdges
+
+              ! I am using hZLevel here.  This assumes that SSH is zero everywhere already,
+              ! which should be the case if the barotropic mode is filtered.
+              ! The more general case is to use sshedge or h_edge.
+              uhSum = (grid % hZLevel % array(1)) * u(1,iEdge)
+              hSum  =  grid % hZLevel % array(1)
+
+              do k=2,grid % maxLevelEdgeTop % array(iEdge)
+                 uhSum = uhSum + grid % hZLevel % array(k) * u(k,iEdge)
+                 hSum  =  hSum + grid % hZLevel % array(k)
+              enddo
+
+              vertSum = uhSum/hSum
+              do k=1,grid % maxLevelEdgeTop % array(iEdge)
+                 u(k,iEdge) = u(k,iEdge) - vertSum
+              enddo
+
+           enddo ! iEdge
+
+      call mpas_timer_stop(&quot;filter_btr_mode_u&quot;)
+
+   end subroutine filter_btr_mode_u!}}}
+
+   subroutine enforce_boundaryEdge(tend, grid)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Enforce any boundary conditions on the normal velocity at each edge
+   !
+   ! Input: grid - grid metadata
+   !
+   ! Output: tend_u set to zero at boundaryEdge == 1 locations
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+      implicit none
+
+      type (tend_type), intent(inout) :: tend
+      type (mesh_type), intent(in) :: grid
+
+      integer, dimension(:,:), pointer :: boundaryEdge
+      real (kind=RKIND), dimension(:,:), pointer :: tend_u
+      integer :: nCells, nEdges, nVertices, nVertLevels
+      integer :: iEdge, k
+
+      call mpas_timer_start(&quot;enforce_boundaryEdge&quot;)
+
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+
+      boundaryEdge         =&gt; grid % boundaryEdge % array
+      tend_u      =&gt; tend % u % array
+
+      if(maxval(boundaryEdge).le.0) return
+
+      do iEdge = 1,nEdges
+        do k = 1,nVertLevels
+
+          if(boundaryEdge(k,iEdge).eq.1) then
+             tend_u(k,iEdge) = 0.0
+          endif
+
+        enddo
+       enddo
+      call mpas_timer_stop(&quot;enforce_boundaryEdge&quot;)
+
+   end subroutine enforce_boundaryEdge!}}}
+
+end module ocn_time_integration_rk4
+
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_time_integration_split.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_time_integration_split.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_time_integration_split.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,1534 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_time_integration_split
-!
-!&gt; \brief MPAS ocean split explicit time integration scheme
-!&gt; \author Doug Jacobsen
-!&gt; \date   26 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the routine for the split explicit
-!&gt;  time integration scheme
-!
-!-----------------------------------------------------------------------
-
-
-module ocn_time_integration_split
-
-   use grid_types
-   use configure
-   use constants
-   use dmpar
-   use vector_reconstruction
-   use spline_interpolation
-   use timer
-
-   use ocn_tendency
-
-   use ocn_equation_of_state
-   use ocn_vmix
-
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_time_integrator_split
-
-   contains
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_time_integration_split
-!
-!&gt; \brief MPAS ocean split explicit time integration scheme
-!&gt; \author Doug Jacobsen
-!&gt; \date   26 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This routine integrates a single time step (dt) using a
-!&gt;  split explicit time integrator.
-!
-!-----------------------------------------------------------------------
-
-subroutine ocn_time_integrator_split(domain, dt)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Advance model state forward in time by the specified time step using 
-   !   Split_Explicit timestepping scheme
-   !
-   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
-   !                 plus grid meta-data
-   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
-   !                  model state advanced forward in time by dt seconds
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      real (kind=RKIND), intent(in) :: dt
-
-      type (dm_info) :: dminfo
-      integer :: iCell, i,k,j, iEdge, cell1, cell2, split_explicit_step, split, &amp;
-        eoe, oldBtrSubcycleTime, newBtrSubcycleTime, uPerpTime, BtrCorIter, &amp;
-        n_bcl_iter(config_n_ts_iter), &amp;
-        vertex1, vertex2, iVertex
-
-      type (block_type), pointer :: block
-      real (kind=RKIND) :: uhSum, hSum, sshEdge, flux, &amp;
-         uPerp, uCorr, tracerTemp, coef, FBtr_coeff, sshCell1, sshCell2
-      real (kind=RKIND), dimension(:), pointer :: sshNew
-
-      integer :: num_tracers, ucorr_coef, err
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        u, h, h_edge, ke_edge, vertViscTopOfEdge, vertDiffTopOfCell
-      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
-      integer, dimension(:), pointer :: &amp; 
-        maxLevelCell, maxLevelEdgeTop
-      real (kind=RKIND), dimension(:), allocatable:: A,C,uTemp, hNew
-      real (kind=RKIND), dimension(:,:), allocatable:: tracersTemp
-
-      call timer_start(&quot;split_explicit_timestep&quot;)
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !
-      !  Prep variables before first iteration
-      !
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      block =&gt; domain % blocklist
-      do while (associated(block))
-
-         do iEdge=1,block % mesh % nEdges
-
-            ! The baroclinic velocity needs be recomputed at the beginning of a 
-            ! timestep because the implicit vertical mixing is conducted on the
-            ! total u.  We keep uBtr from the previous timestep.
-              block % state % time_levs(1) % state % uBcl % array(:,iEdge) &amp;
-            = block % state % time_levs(1) % state % u % array(:,iEdge) &amp;
-            - block % state % time_levs(1) % state % uBtr % array(iEdge)
-
-              block % state % time_levs(2) % state % u % array(:,iEdge) &amp;
-            = block % state % time_levs(1) % state % u % array(:,iEdge)
-
-              block % state % time_levs(2) % state % uBcl % array(:,iEdge) &amp;
-            = block % state % time_levs(1) % state % uBcl % array(:,iEdge)
-
-         enddo ! iEdge
-
-         ! Initialize * variables that are used compute baroclinic tendencies below.
-           block % state % time_levs(2) % state % ssh % array(:) &amp;
-         = block % state % time_levs(1) % state % ssh % array(:)
-
-           block % state % time_levs(2) % state % h_edge % array(:,:) &amp;
-         = block % state % time_levs(1) % state % h_edge % array(:,:)
-
-         do iCell=1,block % mesh % nCells  ! couple tracers to h
-           ! change to maxLevelCell % array(iCell) ?
-           do k=1,block % mesh % nVertLevels
-
-                block % state % time_levs(2) % state % tracers % array(:,k,iCell) &amp; 
-              = block % state % time_levs(1) % state % tracers % array(:,k,iCell) 
-            end do
-
-         end do
-
-         block =&gt; block % next
-      end do
-
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ! BEGIN large iteration loop 
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      n_bcl_iter = config_n_bcl_iter_mid
-      n_bcl_iter(1) = config_n_bcl_iter_beg
-      n_bcl_iter(config_n_ts_iter) = config_n_bcl_iter_end
-
-      do split_explicit_step = 1, config_n_ts_iter
-! ---  update halos for diagnostic variables
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % pv_edge % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
-                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
-           if (config_h_mom_eddy_visc4 &gt; 0.0) then
-              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &amp;
-                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &amp;
-                                               block % mesh % nVertLevels, block % mesh % nVertices, &amp;
-                                               block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
-           end if
-
-           block =&gt; block % next
-        end do
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !
-      !  Stage 1: Baroclinic velocity (3D) prediction, explicit with long timestep
-      !
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      ! compute velocity tendencies, T(u*,w*,p*)
-
-      block =&gt; domain % blocklist
-      do while (associated(block))
-         if (.not.config_implicit_vertical_mix) then
-            call ocn_vmix_coefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
-         end if
-         call ocn_tend_u(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
-         call enforce_boundaryEdge(block % tend, block % mesh)
-         block =&gt; block % next
-      end do
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ! BEGIN baroclinic iterations on linear Coriolis term
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      do j=1,n_bcl_iter(split_explicit_step)
-
-         ! Use this G coefficient to avoid an if statement within the iEdge loop.
-         if     (trim(config_time_integration) == 'unsplit_explicit') then
-            split = 0
-         elseif (trim(config_time_integration) == 'split_explicit') then
-            split = 1
-         endif
-
-         block =&gt; domain % blocklist
-         do while (associated(block))
-           allocate(uTemp(block % mesh % nVertLevels))
-
-           ! Put f*uBcl^{perp} in uNew as a work variable
-           call ocn_fuperp(block % state % time_levs(2) % state , block % mesh)
-
-           do iEdge=1,block % mesh % nEdges
-              cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
-              cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-
-              uTemp = 0.0  ! could put this after with uTemp(maxleveledgetop+1:nvertlevels)=0
-              do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
-
-                 ! uBclNew = uBclOld + dt*(-f*uBclPerp + T(u*,w*,p*) + g*grad(SSH*) )
-                 ! Here uNew is a work variable containing -fEdge(iEdge)*uBclPerp(k,iEdge)
-                 uTemp(k) &amp;
-                 = block % state % time_levs(1) % state % uBcl % array(k,iEdge) &amp;
-                 + dt * (block % tend % u % array (k,iEdge) &amp;
-                      + block % state % time_levs(2) % state % u % array (k,iEdge) &amp;  ! this is f*uBcl^{perp}
-                      + split*gravity &amp;
-                        *(  block % state % time_levs(2) % state % ssh % array(cell2) &amp;
-                          - block % state % time_levs(2) % state % ssh % array(cell1) ) &amp;
-                          /block % mesh % dcEdge % array(iEdge) )
-              enddo
-
-              ! Compute GBtrForcing, the vertically averaged forcing
-              sshEdge = 0.5*( &amp;
-                  block % state % time_levs(1) % state % ssh % array(cell1) &amp; 
-                + block % state % time_levs(1) % state % ssh % array(cell2) ) 
-
-              uhSum = (sshEdge + block % mesh % hZLevel % array(1)) * uTemp(1)
-              hSum  =  sshEdge + block % mesh % hZLevel % array(1)
-
-              do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
-                 uhSum = uhSum + block % mesh % hZLevel % array(k) * uTemp(k)
-                 hSum  =  hSum + block % mesh % hZLevel % array(k)
-              enddo
-              block % state % time_levs(1) % state % GBtrForcing % array(iEdge) = split*uhSum/hSum/dt
-
-
-              do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
-                 ! These two steps are together here:
-                 !{\bf u}'_{k,n+1} = {\bf u}'_{k,n} - \Delta t {\overline {\bf G}}
-                 !{\bf u}'_{k,n+1/2} = \frac{1}{2}\left({\bf u}^{'}_{k,n} +{\bf u}'_{k,n+1}\right) 
-                 ! so that uBclNew is at time n+1/2
-                block % state % time_levs(2) % state % uBcl % array(k,iEdge) &amp;
-                  = 0.5*( &amp;
-                  block % state % time_levs(1) % state % uBcl % array(k,iEdge) &amp;
-                  + uTemp(k) - dt * block % state % time_levs(1) % state % GBtrForcing % array(iEdge))
-              enddo
-
-           enddo ! iEdge
-
-           deallocate(uTemp)
-
-           block =&gt; block % next
-         end do
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % uBcl % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
-                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
-           block =&gt; block % next
-        end do
-
-      enddo  ! do j=1,config_n_bcl_iter
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ! END baroclinic iterations on linear Coriolis term
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !
-      !  Stage 2: Barotropic velocity (2D) prediction, explicitly subcycled
-      !
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      oldBtrSubcycleTime = 1
-      newBtrSubcycleTime = 2
-
-      if (trim(config_time_integration) == 'unsplit_explicit') then
-
-         block =&gt; domain % blocklist
-         do while (associated(block))
-
-            ! For Split_Explicit unsplit, simply set uBtrNew=0, uBtrSubcycle=0, and uNew=uBclNew
-            block % state % time_levs(2) % state % uBtr % array(:) = 0.0
-
-            block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:) = 0.0
-
-               block % state % time_levs(2) % state % u    % array(:,:) &amp;
-             = block % state % time_levs(2) % state % uBcl % array(:,:) 
-
-            block =&gt; block % next
-         end do  ! block
-
-      elseif (trim(config_time_integration) == 'split_explicit') then
-
-         ! Initialize variables for barotropic subcycling
-         block =&gt; domain % blocklist
-         do while (associated(block))
-
-        if (config_filter_btr_mode) then
-          block % state % time_levs(1) % state % GBtrForcing % array(:) = 0.0
-        endif
-
-            do iCell=1,block % mesh % nCells
-              ! sshSubcycleOld = sshOld  
-                block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &amp; 
-              = block % state % time_levs(1) % state % ssh % array(iCell)  
-
-              ! sshNew = sshOld  This is the first for the summation
-                block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
-              = block % state % time_levs(1) % state % ssh % array(iCell)  
-            enddo
-
-           do iEdge=1,block % mesh % nEdges
-
-              ! uBtrSubcycleOld = uBtrOld 
-                block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
-              = block % state % time_levs(1) % state % uBtr % array(iEdge) 
-
-              ! uBtrNew = BtrOld  This is the first for the summation
-                block % state % time_levs(2) % state % uBtr % array(iEdge) &amp;
-              = block % state % time_levs(1) % state % uBtr % array(iEdge) 
-
-              ! FBtr = 0  
-              block % state % time_levs(1) % state % FBtr % array(iEdge) = 0.0
-            enddo
-
-            block =&gt; block % next
-         end do  ! block
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ! BEGIN Barotropic subcycle loop
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-         do j=1,config_n_btr_subcycles*config_btr_subcycle_loop_factor
-
-            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-            ! Barotropic subcycle: initial solve for velecity
-            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-          if (config_btr_gam1_uWt1&gt;1.0e-12) then  ! only do this part if it is needed in next SSH solve
-            uPerpTime = oldBtrSubcycleTime
-
-            block =&gt; domain % blocklist
-            do while (associated(block))
-
-         do iEdge=1,block % mesh % nEdges
-
-               cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
-               cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-
-            ! Compute -f*uPerp
-            uPerp = 0.0
-            do i = 1,block % mesh % nEdgesOnEdge % array(iEdge)
-               eoe = block % mesh % edgesOnEdge % array(i,iEdge)
-               uPerp = uPerp + block % mesh % weightsOnEdge % array(i,iEdge) &amp;
-                  * block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &amp;
-                  * block % mesh % fEdge  % array(eoe)
-            end do
-
-          ! mrp 110606 efficiency note: could make this a 1D integer factor instead of an if statement.
-          if (block % mesh % boundaryEdge % array(1,iEdge).eq.1) then
-                block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) = 0.0
-          else
-
-             ! uBtrNew = uBtrOld + dt*(-f*uBtroldPerp - g*grad(SSH) + G)
-                block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
-              = block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
-              + dt/config_n_btr_subcycles *( &amp;
-                        uPerp &amp;
-                      - gravity &amp;
-                        *(  block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) &amp;
-                          - block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) ) &amp;
-                          /block % mesh % dcEdge % array(iEdge) &amp;
-                      + block % state % time_levs(1) % state % GBtrForcing % array(iEdge) )
-
-          endif
-
-         end do
-
-         !  Implicit solve for barotropic momentum decay
-         if ( config_btr_mom_decay) then
-            !
-            !  Add term to RHS of momentum equation: -1/gamma u
-            !
-            !  This changes the solve to:
-            !  u^{n+1} = u_provis^{n+1}/(1+dt/gamma)
-            !
-            coef = 1.0/(1.0 + dt/config_n_btr_subcycles/config_btr_mom_decay_time)
-            do iEdge=1,block % mesh % nEdges
-                block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
-              = block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
-              * coef
-            end do
-
-          endif
-
-
-               block =&gt; block % next
-            end do  ! block
-
-
-            !   boundary update on uBtrNew
-            block =&gt; domain % blocklist
-            do while (associated(block))
-
-           call dmpar_exch_halo_field1dReal(domain % dminfo, &amp;
-              block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:), &amp;
-              block % mesh % nEdges, &amp;
-              block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
-               block =&gt; block % next
-            end do  ! block
-
-          endif ! config_btr_gam1_uWt1&gt;1.0e-12
-
-
-            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-            ! Barotropic subcycle: Compute thickness flux and new SSH: PREDICTOR
-            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-            block =&gt; domain % blocklist
-            do while (associated(block))
-
-           block % tend % ssh % array(:) = 0.0
-
-           if (config_btr_solve_SSH2) then
-             ! If config_btr_solve_SSH2=.true., then do NOT accumulate FBtr in this SSH predictor 
-             ! section, because it will be accumulated in the SSH corrector section.
-             FBtr_coeff = 0.0
-           else
-             ! otherwise, DO accumulate FBtr in this SSH predictor section
-             FBtr_coeff = 1.0
-           endif
-
-           ! config_btr_gam1_uWt1 sets the forward weighting of velocity in the SSH computation
-           ! config_btr_gam1_uWt1=  1     flux = uBtrNew*H
-           ! config_btr_gam1_uWt1=0.5     flux = 1/2*(uBtrNew+uBtrOld)*H
-           ! config_btr_gam1_uWt1=  0     flux = uBtrOld*H
-           do iEdge=1,block % mesh % nEdges
-              cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
-              cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-
-              sshEdge = 0.5 &amp;
-                 *(  block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &amp;
-                   + block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) )
-              hSum = sum(block % mesh % hZLevel % array (1:block % mesh % maxLevelEdgeTop % array(iEdge)))
-
-              flux = ((1.0-config_btr_gam1_uWt1) &amp; 
-                        * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
-                       + config_btr_gam1_uWt1 &amp;
-                        * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) &amp;
-                    * (sshEdge + hSum)
-
-               block % tend % ssh % array(cell1) = block % tend % ssh % array(cell1) &amp;
-                 - flux * block % mesh % dvEdge % array(iEdge) 
-               block % tend % ssh % array(cell2) = block % tend % ssh % array(cell2) &amp;
-                 + flux * block % mesh % dvEdge % array(iEdge) 
-
-               block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
-             = block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
-             + FBtr_coeff*flux
-         end do

-         ! SSHnew = SSHold + dt/J*(-div(Flux))
-         do iCell=1,block % mesh % nCells 
-
-                block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell) &amp; 
-              = block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &amp; 
-              + dt/config_n_btr_subcycles &amp;
-                * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
-
-         end do
-
-               block =&gt; block % next
-            end do  ! block
-
-            !   boundary update on SSHnew
-            block =&gt; domain % blocklist
-            do while (associated(block))
-
-!              block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &amp;
-
-           call dmpar_exch_halo_field1dReal(domain % dminfo, &amp;
-              block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &amp;
-              block % mesh % nCells, &amp;
-              block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-
-               block =&gt; block % next
-            end do  ! block
-
-
-! mrp 110801 begin
-! This whole section, bounded by 'mrp 110801', may be deleted later if it is found
-! that barotropic del2 is not useful.
-            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-            ! Barotropic subcycle: compute btr_divergence and btr_vorticity for del2(u_btr) 
-            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-            block =&gt; domain % blocklist
-            do while (associated(block))
-      block % state % time_levs(1) % state % u_diffusionBtr % array(:) = 0.0
-      if ( config_btr_mom_eddy_visc2 &gt; 0.0 ) then
-      !
-      ! Compute circulation and relative vorticity at each vertex
-      !
-      block % state % time_levs(1) % state % circulationBtr % array(:) = 0.0
-      do iEdge=1,block % mesh % nEdges
-         vertex1 = block % mesh % verticesOnEdge % array(1,iEdge)
-         vertex2 = block % mesh % verticesOnEdge % array(2,iEdge)
-             block % state % time_levs(1) % state % circulationBtr % array(vertex1) &amp;
-           = block % state % time_levs(1) % state % circulationBtr % array(vertex1) &amp;
-           - block % mesh % dcEdge % array (iEdge) &amp;
-            *block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
-
-             block % state % time_levs(1) % state % circulationBtr % array(vertex2) &amp;
-           = block % state % time_levs(1) % state % circulationBtr % array(vertex2) &amp;
-           + block % mesh % dcEdge % array (iEdge) &amp;
-            *block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
-      end do 
-      do iVertex=1,block % mesh % nVertices
-            block % state % time_levs(1) % state % vorticityBtr % array(iVertex) &amp;
-          = block % state % time_levs(1) % state % circulationBtr % array(iVertex) / block % mesh % areaTriangle % array (iVertex)
-      end do
-
-      !
-      ! Compute the divergence at each cell center
-      !
-      block % state % time_levs(1) % state % divergenceBtr % array(:) = 0.0
-      do iEdge=1,block % mesh % nEdges
-         cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
-         cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-             block % state % time_levs(1) % state % divergenceBtr % array (cell1) &amp;
-           = block % state % time_levs(1) % state % divergenceBtr % array (cell1) &amp;
-           + block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
-            *block % mesh % dvEdge % array(iEdge)
-
-             block % state % time_levs(1) % state % divergenceBtr % array (cell2) &amp;
-           = block % state % time_levs(1) % state % divergenceBtr % array (cell2) &amp;
-           - block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
-            *block % mesh % dvEdge % array(iEdge)
-      end do
-      do iCell = 1,block % mesh % nCells
-         block % state % time_levs(1) % state % divergenceBtr % array(iCell) &amp;
-       = block % state % time_levs(1) % state % divergenceBtr % array(iCell) &amp;
-        /block % mesh % areaCell % array(iCell)
-      enddo
-
-      !
-      ! Compute Btr diffusion
-      !
-         do iEdge=1,block % mesh % nEdgesSolve
-            cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
-            cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-            vertex1 = block % mesh % verticesOnEdge % array(1,iEdge)
-            vertex2 = block % mesh % verticesOnEdge % array(2,iEdge)
-
-               ! Here -( vorticityBtr(vertex2) - vorticityBtr(vertex1) ) / dvEdge % array (iEdge)
-               ! is - </font>
<font color="red">abla vorticity pointing from vertex 2 to vertex 1, or equivalently 
-               !    + k \times </font>
<font color="gray">abla vorticity pointing from cell1 to cell2.
-
-               block % state % time_levs(1) % state % u_diffusionBtr % array(iEdge) = block % mesh % meshScalingDel2 % array (iEdge) * config_btr_mom_eddy_visc2 * &amp;
-                   (( block % state % time_levs(1) % state % divergenceBtr % array(cell2)  - block % state % time_levs(1) % state % divergenceBtr % array(cell1) ) / block % mesh % dcEdge % array (iEdge)  &amp;
-                  -( block % state % time_levs(1) % state % vorticityBtr % array(vertex2) - block % state % time_levs(1) % state % vorticityBtr % array(vertex1) ) / block % mesh % dvEdge % array (iEdge))
-
-         end do
-      end if
-               block =&gt; block % next
-            end do  ! block
-! mrp 110801 end
-
-
-            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-            ! Barotropic subcycle: Final solve for velocity.  Iterate for Coriolis term.
-            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-       do BtrCorIter=1,config_n_btr_cor_iter
-
-          uPerpTime = newBtrSubcycleTime
-
-          block =&gt; domain % blocklist
-          do while (associated(block))
-
-         do iEdge=1,block % mesh % nEdges 
-
-               cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
-               cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-
-            ! Compute -f*uPerp
-            uPerp = 0.0
-            do i = 1,block % mesh % nEdgesOnEdge % array(iEdge)
-               eoe = block % mesh % edgesOnEdge % array(i,iEdge)
-               uPerp = uPerp + block % mesh % weightsOnEdge % array(i,iEdge) &amp;
-                  * block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &amp;
-                  * block % mesh % fEdge  % array(eoe) 
-            end do
-
-          ! mrp 110606 efficiency note: could make this a 1D integer factor instead of an if statement.
-          if (block % mesh % boundaryEdge % array(1,iEdge).eq.1) then
-                block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) = 0.0
-          else
-
-             ! uBtrNew = uBtrOld + dt*(-f*uBtroldPerp - g*grad(SSH) + G)
-
-             sshCell1 = &amp;
-               (1-config_btr_gam2_SSHWt1)*block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &amp;
-                + config_btr_gam2_SSHWt1 *block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell1)
-
-             sshCell2 = &amp;
-               (1-config_btr_gam2_SSHWt1)*block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) &amp;
-                + config_btr_gam2_SSHWt1 *block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell2)
-
-                block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp; 
-              = block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp; 
-              + dt/config_n_btr_subcycles *( &amp;
-                        uPerp &amp;
-                      - gravity &amp;
-                        *(  sshCell2 &amp;
-                          - sshCell1 )&amp;
-                          /block % mesh % dcEdge % array(iEdge) &amp;
-                      + block % state % time_levs(1) % state % GBtrForcing % array(iEdge) &amp;
-                      + block % state % time_levs(1) % state % u_diffusionBtr % array(iEdge))
-                      ! added del2 diffusion to btr solve
-
-          endif
-
-         end do
-
-            !  Implicit solve for barotropic momentum decay
-         if ( config_btr_mom_decay) then
-            !  Add term to RHS of momentum equation: -1/gamma u
-            !
-            !  This changes the solve to:
-            !  u^{n+1} = u_provis^{n+1}/(1+dt/gamma)
-            !
-            coef = 1.0/(1.0 + dt/config_n_btr_subcycles/config_btr_mom_decay_time)
-            do iEdge=1,block % mesh % nEdges 
-                block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp; 
-              = block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
-              * coef
-            end do
-
-         endif
-
-               block =&gt; block % next
-            end do  ! block
-
-
-            !   boundary update on uBtrNew
-            block =&gt; domain % blocklist
-            do while (associated(block))
-
-               call dmpar_exch_halo_field1dReal(domain % dminfo, &amp;
-                  block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:), &amp;
-                  block % mesh % nEdges, &amp;
-                  block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
-               block =&gt; block % next
-            end do  ! block
-
-       end do !do BtrCorIter=1,config_n_btr_cor_iter
-
-            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-            ! Barotropic subcycle: Compute thickness flux and new SSH: CORRECTOR
-            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-        if (config_btr_solve_SSH2) then
-
-            block =&gt; domain % blocklist
-            do while (associated(block))
-
-           block % tend % ssh % array(:) = 0.0
-
-           ! config_btr_gam3_uWt2 sets the forward weighting of velocity in the SSH computation
-           ! config_btr_gam3_uWt2=  1     flux = uBtrNew*H
-           ! config_btr_gam3_uWt2=0.5     flux = 1/2*(uBtrNew+uBtrOld)*H
-           ! config_btr_gam3_uWt2=  0     flux = uBtrOld*H
-
-           do iEdge=1,block % mesh % nEdges
-              cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
-              cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-
-              sshEdge = 0.5 &amp;
-                 *(  block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &amp;
-                   + block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) )
-              hSum = sum(block % mesh % hZLevel % array (1:block % mesh % maxLevelEdgeTop % array(iEdge)))
-
-              flux = ((1.0-config_btr_gam3_uWt2) &amp; 
-                        * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
-                       + config_btr_gam3_uWt2 &amp;
-                        * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) &amp;
-                    * (sshEdge + hSum)
-
-               block % tend % ssh % array(cell1) = block % tend % ssh % array(cell1) &amp;
-                 - flux * block % mesh % dvEdge % array(iEdge) 
-               block % tend % ssh % array(cell2) = block % tend % ssh % array(cell2) &amp;
-                 + flux * block % mesh % dvEdge % array(iEdge) 
-
-               block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
-             = block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
-             + flux
-
-
-         end do

-         ! SSHnew = SSHold + dt/J*(-div(Flux))
-         do iCell=1,block % mesh % nCells 
-
-                block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell) &amp; 
-              = block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &amp; 
-              + dt/config_n_btr_subcycles &amp;
-                * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
-
-         end do
-
-               block =&gt; block % next
-            end do  ! block
-
-            !   boundary update on SSHnew
-            block =&gt; domain % blocklist
-            do while (associated(block))
-
-           call dmpar_exch_halo_field1dReal(domain % dminfo, &amp;
-              block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &amp;
-              block % mesh % nCells, &amp;
-              block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-
-               block =&gt; block % next
-            end do  ! block
-
-        endif ! config_btr_solve_SSH2
-
-            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-            ! Barotropic subcycle: Accumulate running sums, advance timestep pointers
-            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-            block =&gt; domain % blocklist
-            do while (associated(block))
-
-         ! Accumulate SSH in running sum over the subcycles.
-         do iCell=1,block % mesh % nCells 
-                block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
-              = block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
-              + block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell)  
-         end do
-
-            ! uBtrNew = uBtrNew + uBtrSubcycleNEW
-            ! This accumulates the sum.
-            ! If the Barotropic Coriolis iteration is limited to one, this could 
-            ! be merged with the above code.
-         do iEdge=1,block % mesh % nEdges 
-
-                block % state % time_levs(2) % state % uBtr % array(iEdge) &amp; 
-              = block % state % time_levs(2) % state % uBtr % array(iEdge) &amp; 
-              + block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)  
-
-            end do  ! iEdge
-               block =&gt; block % next
-         end do  ! block
-
-            ! advance time pointers
-            oldBtrSubcycleTime = mod(oldBtrSubcycleTime,2)+1
-            newBtrSubcycleTime = mod(newBtrSubcycleTime,2)+1
-
-         end do ! j=1,config_n_btr_subcycles
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ! END Barotropic subcycle loop
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-            ! Normalize Barotropic subcycle sums: ssh, uBtr, and F
-            block =&gt; domain % blocklist
-            do while (associated(block))
-
-         do iEdge=1,block % mesh % nEdges
-               block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
-             = block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
-             / (config_n_btr_subcycles*config_btr_subcycle_loop_factor)
-
-                block % state % time_levs(2) % state % uBtr % array(iEdge) &amp; 
-              = block % state % time_levs(2) % state % uBtr % array(iEdge) &amp; 
-             / (config_n_btr_subcycles*config_btr_subcycle_loop_factor + 1)
-         end do
-
-        if (config_SSH_from=='avg_of_SSH_subcycles') then
-         do iCell=1,block % mesh % nCells 
-                block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
-              = block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
-             / (config_n_btr_subcycles*config_btr_subcycle_loop_factor + 1)
-         end do
-        elseif (config_SSH_from=='avg_flux') then
-           ! see below
-        else
-         write(0,*) 'Abort: Unknown config_SSH_from option: '&amp;
-           //trim(config_SSH_from)
-         call dmpar_abort(dminfo)
-        endif
-
-               block =&gt; block % next
-            end do  ! block
-
-
-            ! boundary update on F
-            block =&gt; domain % blocklist
-            do while (associated(block))
-
-           call dmpar_exch_halo_field1dReal(domain % dminfo, &amp;
-              block % state % time_levs(1) % state % FBtr % array(:), &amp;
-              block % mesh % nEdges, &amp;
-              block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
-               block =&gt; block % next
-            end do  ! block
-
-
-            ! Check that you can compute SSH using the total sum or the individual increments
-            ! over the barotropic subcycles.
-            ! efficiency: This next block of code is really a check for debugging, and can 
-            ! be removed later.
-            block =&gt; domain % blocklist
-            do while (associated(block))
-
-               allocate(uTemp(block % mesh % nVertLevels))
-
-        if (config_SSH_from=='avg_flux') then
-           ! Accumulate fluxes in the tend % ssh variable
-           block % tend % ssh % array(:) = 0.0
-           do iEdge=1,block % mesh % nEdges
-              cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
-              cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-
-                 block % tend % ssh % array(cell1) &amp;
-               = block % tend % ssh % array(cell1) &amp;
-               - block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
-                    * block % mesh % dvEdge % array(iEdge)
-
-
-                 block % tend % ssh % array(cell2) &amp;
-               = block % tend % ssh % array(cell2) &amp;
-               + block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
-                    * block % mesh % dvEdge % array(iEdge)
-
-          end do
-
-         do iCell=1,block % mesh % nCells 

-             ! SSHnew = SSHold + dt*(-div(Flux))
-                block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
-              = block % state % time_levs(1) % state % ssh % array(iCell) &amp; 
-              + dt &amp;
-                * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
-         end do
-       endif
-
-         ! Correction velocity    uCorr = (Flux - Sum(h u*))/H
-         ! or, for the full latex version:
-         !u^{corr} = \left( {\overline {\bf F}} 
-         !  - \sum_{k=1}^{N^{edge}} \left(\zeta_{k,n}^{*\;edge}+\Delta z_k\right)  u_k^* \right)
-         !\left/ \sum_{k=1}^{N^{edge}} \left(\zeta_{k,n}^{*\;edge}+\Delta z_k\right)   \right. 
-
-          if (config_u_correction) then
-             ucorr_coef = 1
-          else
-             ucorr_coef = 0
-          endif
-
-           do iEdge=1,block % mesh % nEdges
-              cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
-              cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-
-              sshEdge = 0.5 &amp;
-                 *(  block % state % time_levs(2) % state % ssh % array(cell1) &amp;
-                   + block % state % time_levs(2) % state % ssh % array(cell2) )
-
-             ! This is u*
-               uTemp(:) &amp;
-             = block % state % time_levs(2) % state % uBtr % array(iEdge) &amp;
-             + block % state % time_levs(2) % state % uBcl % array(:,iEdge) 
-
-              uhSum = (sshEdge + block % mesh % hZLevel % array(1)) * uTemp(1)
-              hSum  =  sshEdge + block % mesh % hZLevel % array(1)
-
-              do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
-                 uhSum = uhSum + block % mesh % hZLevel % array(k) * uTemp(k)
-                 hSum  =  hSum + block % mesh % hZLevel % array(k)
-              enddo
-
-            uCorr =   ucorr_coef*(( block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
-                      - uhSum)/hSum)
-
-              ! put u^{tr}, the velocity for tracer transport, in uNew
-          ! mrp 060611 not sure if boundary enforcement is needed here.  
-          if (block % mesh % boundaryEdge % array(1,iEdge).eq.1) then
-              block % state % time_levs(2) % state % u % array(:,iEdge) = 0.0
-          else
-            do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
-              block % state % time_levs(2) % state % u % array(k,iEdge) = uTemp(k) + uCorr
-            enddo
-            do k=block % mesh % maxLevelEdgeTop % array(iEdge)+1,block % mesh % nVertLevels
-              block % state % time_levs(2) % state % u % array(k,iEdge) = 0.0
-            enddo
-          endif
-
-         ! Put new sshEdge values in h_edge array, for the OcnTendScalar call below.
-             block % state % time_levs(2) % state % h_edge % array(1,iEdge) &amp;
-           = sshEdge + block % mesh % hZLevel % array(1)
-
-           do k=2,block % mesh % nVertLevels
-             block % state % time_levs(2) % state % h_edge % array(k,iEdge) &amp;
-           = block % mesh % hZLevel % array(k)
-           enddo
-
-          end do ! iEdge
-
-         ! Put new SSH values in h array, for the OcnTendScalar call below.
-         do iCell=1,block % mesh % nCells 
-             block % state % time_levs(2) % state % h % array(1,iCell) &amp;
-           = block % state % time_levs(2) % state % ssh % array(iCell) &amp;
-           + block % mesh % hZLevel % array(1)
-
-           ! mrp 110601 efficiency note: Since h just moves back and forth between pointers,
-           ! this is not necessary once initialized.
-           do k=2,block % mesh % nVertLevels
-             block % state % time_levs(2) % state % h % array(k,iCell) &amp;
-           = block % mesh % hZLevel % array(k)
-           enddo
-         enddo ! iCell
-
-           deallocate(uTemp)
-
-               block =&gt; block % next
-            end do  ! block
-
-
-      endif ! split_explicit
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !
-      !  Stage 3: Tracer, density, pressure, vertical velocity prediction
-      !
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-         block =&gt; domain % blocklist
-         do while (associated(block))
-
-           call ocn_wtop(block % state % time_levs(2) % state, block % mesh)
-
-      if (trim(config_time_integration) == 'unsplit_explicit') then
-           call ocn_tend_h(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
-      endif
-
-           call ocn_tend_scalar(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
-
-           block =&gt; block % next
-         end do
-
-        ! ---  update halos for prognostic variables
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % h % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % tracers % array(:,:,:), &amp;
-                                            block % tend % num_tracers, block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           block =&gt; block % next
-        end do
-
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           allocate(hNew(block % mesh % nVertLevels))
-
-        if (trim(config_new_btr_variables_from) == 'last_subcycle') then
-           ! This points to the last barotropic SSH subcycle
-           sshNew =&gt; block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array
-        elseif (trim(config_new_btr_variables_from) == 'btr_avg') then
-           ! This points to the tendency variable SSH*
-           sshNew =&gt; block % state % time_levs(2) % state % ssh % array
-        endif
-
-      if (trim(config_time_integration) == 'unsplit_explicit') then
-
-         do iCell=1,block % mesh % nCells
-           ! this is h_{n+1}
-             block % state % time_levs(2) % state % h % array(:,iCell) &amp;
-           = block % state % time_levs(1) % state % h % array(:,iCell) &amp;
-           + dt* block % tend % h % array(:,iCell) 
-
-            ! this is only for the hNew computation below, so there is the correct
-            ! value in the ssh variable for unsplit_explicit case.
-            block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &amp;
-          = block % state % time_levs(2) % state % h % array(1,iCell) &amp;
-          - block % mesh % hZLevel % array(1)
-           end do ! iCell
-
-      endif ! unsplit_explicit
-
-           ! Only need T &amp; S for earlier iterations,
-           ! then all the tracers needed the last time through.
-         if (split_explicit_step &lt; config_n_ts_iter) then
-
-           hNew(:) = block % mesh % hZLevel % array(:)
-           do iCell=1,block % mesh % nCells
-              ! sshNew is a pointer, defined above.
-              hNew(1) =  sshNew(iCell) + block % mesh % hZLevel % array(1)
-              do k=1,block % mesh % maxLevelCell % array(iCell)
-                 do i=1,2
-                ! This is Phi at n+1
-                tracerTemp &amp;
-                = (  block % state % time_levs(1) % state % tracers % array(i,k,iCell) &amp;
-                   * block % state % time_levs(1) % state % h % array(k,iCell) &amp;
-                 + dt * block % tend % tracers % array(i,k,iCell) &amp;
-                  ) / hNew(k)
-
-                ! This is Phi at n+1/2
-                   block % state % time_levs(2) % state % tracers % array(i,k,iCell)  &amp;
-                 = 0.5*( &amp;
-                   block % state % time_levs(1) % state % tracers % array(i,k,iCell) &amp;
-                 + tracerTemp )
-                 enddo
-              end do
-           end do ! iCell
-
-
-          if (trim(config_time_integration) == 'unsplit_explicit') then
-
-            ! compute h*, which is h at n+1/2 and put into array hNew
-            ! on last iteration, hNew remains at n+1
-           do iCell=1,block % mesh % nCells
-                 block % state % time_levs(2) % state % h % array(1,iCell) &amp;
-                 = 0.5*( &amp;
-                 block % state % time_levs(2) % state % h % array(1,iCell) &amp;
-               + block % state % time_levs(1) % state % h % array(1,iCell) )
-
-           end do ! iCell
-          endif ! unsplit_explicit
-
-          ! compute u*, the velocity for tendency terms.  Put in uNew.
-          ! uBclNew is at time n+1/2 here.
-          ! This overwrites u^{tr}, the tracer transport velocity, which was in uNew.
-          ! The following must occur after  call OcnTendScalar
-           do iEdge=1,block % mesh % nEdges
-               block % state % time_levs(2) % state % u    % array(:,iEdge) &amp;
-             = block % state % time_levs(2) % state % uBtr % array(iEdge) &amp;
-             + block % state % time_levs(2) % state % uBcl % array(:,iEdge) 
-           end do ! iEdge
-
-         ! mrp 110512  I really only need this to compute h_edge, density, pressure.
-         ! I can par this down later.
-         call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)

-
-         elseif (split_explicit_step == config_n_ts_iter) then
-
-           hNew(:) = block % mesh % hZLevel % array(:)
-           do iCell=1,block % mesh % nCells
-              ! sshNew is a pointer, defined above.
-              hNew(1) =  sshNew(iCell) + block % mesh % hZLevel % array(1)
-              do k=1,block % mesh % maxLevelCell % array(iCell)
-                 do i=1,block % state % time_levs(1) % state % num_tracers
-                ! This is Phi at n+1
-                   block % state % time_levs(2) % state % tracers % array(i,k,iCell)  &amp;
-                = (  block % state % time_levs(1) % state % tracers % array(i,k,iCell) &amp;
-                   * block % state % time_levs(1) % state % h % array(k,iCell) &amp;
-                 + dt * block % tend % tracers % array(i,k,iCell) &amp;
-                  ) / hNew(k)
-
-                 enddo
-              end do
-           end do
-
-         endif ! split_explicit_step
-           deallocate(hNew)
-
-         block =&gt; block % next
-       end do
-
-      end do  ! split_explicit_step = 1, config_n_ts_iter
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ! END large iteration loop 
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      !
-      !  A little clean up at the end: decouple new scalar fields and compute diagnostics for new state
-      !
-      block =&gt; domain % blocklist
-      do while (associated(block))
-
-        if (trim(config_new_btr_variables_from) == 'last_subcycle') then
-         do iEdge=1,block % mesh % nEdges
-               ! uBtrNew = uBtrSubcycleNew  (old here is because counter already flipped)
-               ! This line is not needed if u is resplit at the beginning of the timestep.
-                block % state % time_levs(2) % state % uBtr % array(iEdge) &amp; 
-              = block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)  
-         enddo ! iEdges
-        elseif (trim(config_new_btr_variables_from) == 'btr_avg') then
-               ! uBtrNew from u*.  this is done above, so u* is already in
-               ! block % state % time_levs(2) % state % uBtr % array(iEdge) 
-        else
-         write(0,*) 'Abort: Unknown config_new_btr_variables_from: '&amp;
-           //trim(config_time_integration)
-         call dmpar_abort(dminfo)
-       endif
-
-         ! Recompute final u to go on to next step.
-         ! u_{n+1} = uBtr_{n+1} + uBcl_{n+1} 
-         ! Right now uBclNew is at time n+1/2, so back compute to get uBcl at time n+1
-         !   using uBcl_{n+1/2} = 1/2*(uBcl_n + u_Bcl_{n+1})
-         ! so the following lines are
-         ! u_{n+1} = uBtr_{n+1} + 2*uBcl_{n+1/2} - uBcl_n
-         ! note that uBcl is recomputed at the beginning of the next timestep due to Imp Vert mixing,
-         ! so uBcl does not have to be recomputed here.
-
-         do iEdge=1,block % mesh % nEdges
-            do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
-
-               block % state % time_levs(2) % state % u % array(k,iEdge) &amp; 
-            =  block % state % time_levs(2) % state % uBtr % array(iEdge) &amp;
-            +2*block % state % time_levs(2) % state % uBcl % array(k,iEdge) &amp;
-            -  block % state % time_levs(1) % state % uBcl % array(k,iEdge)
-            enddo
-            ! mrp 110607 zero out velocity below land edges. efficiency: this may not be required.
-            do k=block % mesh % maxLevelEdgeTop % array(iEdge) + 1, block % mesh % nVertLevels
-               block % state % time_levs(2) % state % u % array(k,iEdge) = 0.0
-            enddo
-
-         enddo ! iEdges
-
-        if (trim(config_time_integration) == 'split_explicit') then
-
-        if (trim(config_new_btr_variables_from) == 'last_subcycle') then
-         do iCell=1,block % mesh % nCells
-         ! SSH for the next step is from the end of the barotropic subcycle.
-               block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
-            =  block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) 
-         end do ! iCell
-        elseif (trim(config_new_btr_variables_from) == 'btr_avg') then
-               ! sshNew from ssh*.  This is done above, so ssh* is already in
-               ! block % state % time_levs(2) % state % ssh % array(iCell) 
-        endif
-
-         do iCell=1,block % mesh % nCells
-         ! Put new SSH values in h array, for the OcnTendScalar call below.
-             block % state % time_levs(2) % state % h % array(1,iCell) &amp;
-           = block % state % time_levs(2) % state % ssh % array(iCell) &amp;
-           + block % mesh % hZLevel % array(1)
-
-           ! mrp 110601 efficiency note: Since h just moves back and forth between pointers,
-           ! this is not necessary once initialized.
-           do k=2,block % mesh % nVertLevels
-             block % state % time_levs(2) % state % h % array(k,iCell) &amp;
-           = block % mesh % hZLevel % array(k)
-           end do
-         end do ! iCell
-       end if ! split_explicit

-       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-       !
-       !  Implicit vertical mixing, done after timestep is complete
-       !
-       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-         u           =&gt; block % state % time_levs(2) % state % u % array
-         tracers     =&gt; block % state % time_levs(2) % state % tracers % array
-         h           =&gt; block % state % time_levs(2) % state % h % array
-         h_edge      =&gt; block % state % time_levs(2) % state % h_edge % array
-         ke_edge     =&gt; block % state % time_levs(2) % state % ke_edge % array
-         num_tracers = block % state % time_levs(2) % state % num_tracers
-         vertViscTopOfEdge =&gt; block % diagnostics % vertViscTopOfEdge % array
-         vertDiffTopOfCell =&gt; block % diagnostics % vertDiffTopOfCell % array
-         maxLevelCell    =&gt; block % mesh % maxLevelCell % array
-         maxLevelEdgeTop =&gt; block % mesh % maxLevelEdgeTop % array
-
-         if (config_implicit_vertical_mix) then
-            allocate(A(block % mesh % nVertLevels),C(block % mesh % nVertLevels),uTemp(block % mesh % nVertLevels), &amp;
-               tracersTemp(num_tracers,block % mesh % nVertLevels))
-
-            call ocn_vmix_coefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
-
-            !
-            !  Implicit vertical solve for momentum
-            !
-
-            call ocn_vel_vmix_tend_implicit(block % mesh, dt, ke_edge, vertvisctopofedge, h, h_edge, u, err)
-
-            !
-            !  Implicit vertical solve for tracers
-            !
-            call ocn_tracer_vmix_tend_implicit(block % mesh, dt, vertdifftopofcell, h, tracers, err)
-         end if
-
-         ! mrp 110725 adding momentum decay term
-         if (config_mom_decay) then
-
-            !
-            !  Implicit solve for momentum decay
-            !
-            !  Add term to RHS of momentum equation: -1/gamma u
-            !
-            !  This changes the solve to:
-            !  u^{n+1} = u_provis^{n+1}/(1+dt/gamma)
-            !
-            coef = 1.0/(1.0 + dt/config_mom_decay_time)
-            do iEdge=1,block % mesh % nEdges
-               do k=1,maxLevelEdgeTop(iEdge)
-                  u(k,iEdge) = coef*u(k,iEdge) 
-               end do
-            end do
-
-         end if
-
-         if (config_test_case == 1) then    ! For case 1, wind field should be fixed
-            block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
-         end if
-
-         call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
-
-         call reconstruct(block % mesh, block % state % time_levs(2) % state % u % array,          &amp;
-                          block % state % time_levs(2) % state % uReconstructX % array,            &amp;
-                          block % state % time_levs(2) % state % uReconstructY % array,            &amp;
-                          block % state % time_levs(2) % state % uReconstructZ % array,            &amp;
-                          block % state % time_levs(2) % state % uReconstructZonal % array,        &amp;
-                          block % state % time_levs(2) % state % uReconstructMeridional % array    &amp;
-                         )
-
-         block =&gt; block % next
-      end do
-      call timer_stop(&quot;split_explicit_timestep&quot;)
-
-   end subroutine ocn_time_integrator_split!}}}
-
-   subroutine filter_btr_mode_tend_u(tend, s, d, grid)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Filter and remove barotropic mode from the tendencies
-   !
-   ! 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
-
-! mrp 110512 I just split compute_tend into compute_tend_u and compute_tend_h.
-!  Some of these variables can be removed, but at a later time.
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
-        vertex1, vertex2, eoe, i, j
-
-      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
-      real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
-      real (kind=RKIND), dimension(:), pointer :: &amp;
-        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
-        zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &amp;
-        tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
-        MontPot, wTop, divergence, vertViscTopOfEdge
-      type (dm_info) :: dminfo
-
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
-        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
-      integer, dimension(:,:), pointer :: &amp;
-        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
-        edgesOnEdge, edgesOnVertex
-      real (kind=RKIND) :: u_diffusion
-      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
-
-
-      real (kind=RKIND), dimension(:,:), pointer :: u_src
-      real (kind=RKIND), parameter :: rho_ref = 1000.0
-
-      call timer_start(&quot;filter_btr_mode_tend_u&quot;)
-
-      h           =&gt; s % h % array
-      u           =&gt; s % u % array
-      v           =&gt; s % v % array
-      wTop        =&gt; s % wTop % array
-      h_edge      =&gt; s % h_edge % array
-      circulation =&gt; s % circulation % array
-      vorticity   =&gt; s % vorticity % array
-      divergence  =&gt; s % divergence % array
-      ke          =&gt; s % ke % array
-      ke_edge     =&gt; s % ke_edge % array
-      pv_edge     =&gt; s % pv_edge % array
-      MontPot     =&gt; s % MontPot % array
-      pressure    =&gt; s % pressure % array
-      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      cellsOnVertex     =&gt; grid % cellsOnVertex % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
-      edgesOnCell       =&gt; grid % edgesOnCell % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      edgesOnVertex     =&gt; grid % edgesOnVertex % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      h_s               =&gt; grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
-      fVertex           =&gt; grid % fVertex % array
-      fEdge             =&gt; grid % fEdge % array
-      zMidZLevel        =&gt; grid % zMidZLevel % array
-      zTopZLevel        =&gt; grid % zTopZLevel % array
-      maxLevelCell      =&gt; grid % maxLevelCell % array
-      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
-      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
-
-      tend_u      =&gt; tend % u % array
-                  
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nEdgesSolve = grid % nEdgesSolve
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      u_src =&gt; grid % u_src % array
-
-           do iEdge=1,grid % nEdges
-
-              ! I am using hZLevel here.  This assumes that SSH is zero everywhere already,
-              ! which should be the case if the barotropic mode is filtered.
-              ! The more general case is to use sshEdge or h_edge.
-              uhSum = (grid % hZLevel % array(1)) * tend_u(1,iEdge)
-              hSum  =  grid % hZLevel % array(1)
-
-              do k=2,grid % maxLevelEdgeTop % array(iEdge)
-                 uhSum = uhSum + grid % hZLevel % array(k) * tend_u(k,iEdge)
-                 hSum  =  hSum + grid % hZLevel % array(k)
-              enddo
-
-              vertSum = uhSum/hSum
-
-              do k=1,grid % maxLevelEdgeTop % array(iEdge)
-                 tend_u(k,iEdge) = tend_u(k,iEdge) - vertSum
-              enddo
-
-           enddo ! iEdge
-
-      call timer_stop(&quot;filter_btr_mode_tend_u&quot;)
-
-   end subroutine filter_btr_mode_tend_u!}}}
-
-   subroutine filter_btr_mode_u(s, grid)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Filter and remove barotropic mode.
-   !
-   ! 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
-
-! mrp 110512 I just split compute_tend into compute_tend_u and compute_tend_h.
-!  Some of these variables can be removed, but at a later time.
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
-        vertex1, vertex2, eoe, i, j
-
-      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
-      real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
-      real (kind=RKIND), dimension(:), pointer :: &amp;
-        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
-        zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &amp;
-        tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
-        MontPot, wTop, divergence, vertViscTopOfEdge
-      type (dm_info) :: dminfo
-
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
-        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
-      integer, dimension(:,:), pointer :: &amp;
-        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
-        edgesOnEdge, edgesOnVertex
-      real (kind=RKIND) :: u_diffusion
-      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
-
-
-      real (kind=RKIND), dimension(:,:), pointer :: u_src
-      real (kind=RKIND), parameter :: rho_ref = 1000.0
-
-      call timer_start(&quot;filter_btr_mode_u&quot;)
-
-      h           =&gt; s % h % array
-      u           =&gt; s % u % array
-      v           =&gt; s % v % array
-      wTop        =&gt; s % wTop % array
-      h_edge      =&gt; s % h_edge % array
-      circulation =&gt; s % circulation % array
-      vorticity   =&gt; s % vorticity % array
-      divergence  =&gt; s % divergence % array
-      ke          =&gt; s % ke % array
-      ke_edge     =&gt; s % ke_edge % array
-      pv_edge     =&gt; s % pv_edge % array
-      MontPot     =&gt; s % MontPot % array
-      pressure    =&gt; s % pressure % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      cellsOnVertex     =&gt; grid % cellsOnVertex % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
-      edgesOnCell       =&gt; grid % edgesOnCell % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      edgesOnVertex     =&gt; grid % edgesOnVertex % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      h_s               =&gt; grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
-      fVertex           =&gt; grid % fVertex % array
-      fEdge             =&gt; grid % fEdge % array
-      zMidZLevel        =&gt; grid % zMidZLevel % array
-      zTopZLevel        =&gt; grid % zTopZLevel % array
-      maxLevelCell      =&gt; grid % maxLevelCell % array
-      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
-      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
-
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nEdgesSolve = grid % nEdgesSolve
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      u_src =&gt; grid % u_src % array
-
-           do iEdge=1,grid % nEdges
-
-              ! I am using hZLevel here.  This assumes that SSH is zero everywhere already,
-              ! which should be the case if the barotropic mode is filtered.
-              ! The more general case is to use sshedge or h_edge.
-              uhSum = (grid % hZLevel % array(1)) * u(1,iEdge)
-              hSum  =  grid % hZLevel % array(1)
-
-              do k=2,grid % maxLevelEdgeTop % array(iEdge)
-                 uhSum = uhSum + grid % hZLevel % array(k) * u(k,iEdge)
-                 hSum  =  hSum + grid % hZLevel % array(k)
-              enddo
-
-              vertSum = uhSum/hSum
-              do k=1,grid % maxLevelEdgeTop % array(iEdge)
-                 u(k,iEdge) = u(k,iEdge) - vertSum
-              enddo
-
-           enddo ! iEdge
-
-      call timer_stop(&quot;filter_btr_mode_u&quot;)
-
-   end subroutine filter_btr_mode_u!}}}
-
-   subroutine enforce_boundaryEdge(tend, grid)!{{{
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Enforce any boundary conditions on the normal velocity at each edge
-   !
-   ! Input: grid - grid metadata
-   !
-   ! Output: tend_u set to zero at boundaryEdge == 1 locations
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-      implicit none
-
-      type (tend_type), intent(inout) :: tend
-      type (mesh_type), intent(in) :: grid
-
-      integer, dimension(:,:), pointer :: boundaryEdge
-      real (kind=RKIND), dimension(:,:), pointer :: tend_u
-      integer :: nCells, nEdges, nVertices, nVertLevels
-      integer :: iEdge, k
-
-      call timer_start(&quot;enforce_boundaryEdge&quot;)
-
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      boundaryEdge         =&gt; grid % boundaryEdge % array
-      tend_u      =&gt; tend % u % array
-
-      if(maxval(boundaryEdge).le.0) return
-
-      do iEdge = 1,nEdges
-        do k = 1,nVertLevels
-
-          if(boundaryEdge(k,iEdge).eq.1) then
-             tend_u(k,iEdge) = 0.0
-          endif
-
-        enddo
-       enddo
-      call timer_stop(&quot;enforce_boundaryEdge&quot;)
-
-   end subroutine enforce_boundaryEdge!}}}
-
-end module ocn_time_integration_split
-
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_time_integration_split.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_time_integration_split.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_time_integration_split.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_time_integration_split.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,1534 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_time_integration_split
+!
+!&gt; \brief MPAS ocean split explicit time integration scheme
+!&gt; \author Doug Jacobsen
+!&gt; \date   26 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the routine for the split explicit
+!&gt;  time integration scheme
+!
+!-----------------------------------------------------------------------
+
+
+module ocn_time_integration_split
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+   use mpas_dmpar
+   use mpas_vector_reconstruction
+   use mpas_spline_interpolation
+   use mpas_timer
+
+   use ocn_tendency
+
+   use ocn_equation_of_state
+   use ocn_vmix
+
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_time_integrator_split
+
+   contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_time_integration_split
+!
+!&gt; \brief MPAS ocean split explicit time integration scheme
+!&gt; \author Doug Jacobsen
+!&gt; \date   26 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This routine integrates a single time step (dt) using a
+!&gt;  split explicit time integrator.
+!
+!-----------------------------------------------------------------------
+
+subroutine ocn_time_integrator_split(domain, dt)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Advance model state forward in time by the specified time step using 
+   !   Split_Explicit timestepping scheme
+   !
+   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
+   !                 plus grid meta-data
+   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
+   !                  model state advanced forward in time by dt seconds
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+      real (kind=RKIND), intent(in) :: dt
+
+      type (dm_info) :: dminfo
+      integer :: iCell, i,k,j, iEdge, cell1, cell2, split_explicit_step, split, &amp;
+        eoe, oldBtrSubcycleTime, newBtrSubcycleTime, uPerpTime, BtrCorIter, &amp;
+        n_bcl_iter(config_n_ts_iter), &amp;
+        vertex1, vertex2, iVertex
+
+      type (block_type), pointer :: block
+      real (kind=RKIND) :: uhSum, hSum, sshEdge, flux, &amp;
+         uPerp, uCorr, tracerTemp, coef, FBtr_coeff, sshCell1, sshCell2
+      real (kind=RKIND), dimension(:), pointer :: sshNew
+
+      integer :: num_tracers, ucorr_coef, err
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        u, h, h_edge, ke_edge, vertViscTopOfEdge, vertDiffTopOfCell
+      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+      integer, dimension(:), pointer :: &amp; 
+        maxLevelCell, maxLevelEdgeTop
+      real (kind=RKIND), dimension(:), allocatable:: A,C,uTemp, hNew
+      real (kind=RKIND), dimension(:,:), allocatable:: tracersTemp
+
+      call mpas_timer_start(&quot;split_explicit_timestep&quot;)
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !
+      !  Prep variables before first iteration
+      !
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      block =&gt; domain % blocklist
+      do while (associated(block))
+
+         do iEdge=1,block % mesh % nEdges
+
+            ! The baroclinic velocity needs be recomputed at the beginning of a 
+            ! timestep because the implicit vertical mixing is conducted on the
+            ! total u.  We keep uBtr from the previous timestep.
+              block % state % time_levs(1) % state % uBcl % array(:,iEdge) &amp;
+            = block % state % time_levs(1) % state % u % array(:,iEdge) &amp;
+            - block % state % time_levs(1) % state % uBtr % array(iEdge)
+
+              block % state % time_levs(2) % state % u % array(:,iEdge) &amp;
+            = block % state % time_levs(1) % state % u % array(:,iEdge)
+
+              block % state % time_levs(2) % state % uBcl % array(:,iEdge) &amp;
+            = block % state % time_levs(1) % state % uBcl % array(:,iEdge)
+
+         enddo ! iEdge
+
+         ! Initialize * variables that are used compute baroclinic tendencies below.
+           block % state % time_levs(2) % state % ssh % array(:) &amp;
+         = block % state % time_levs(1) % state % ssh % array(:)
+
+           block % state % time_levs(2) % state % h_edge % array(:,:) &amp;
+         = block % state % time_levs(1) % state % h_edge % array(:,:)
+
+         do iCell=1,block % mesh % nCells  ! couple tracers to h
+           ! change to maxLevelCell % array(iCell) ?
+           do k=1,block % mesh % nVertLevels
+
+                block % state % time_levs(2) % state % tracers % array(:,k,iCell) &amp; 
+              = block % state % time_levs(1) % state % tracers % array(:,k,iCell) 
+            end do
+
+         end do
+
+         block =&gt; block % next
+      end do
+
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! BEGIN large iteration loop 
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      n_bcl_iter = config_n_bcl_iter_mid
+      n_bcl_iter(1) = config_n_bcl_iter_beg
+      n_bcl_iter(config_n_ts_iter) = config_n_bcl_iter_end
+
+      do split_explicit_step = 1, config_n_ts_iter
+! ---  update halos for diagnostic variables
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % pv_edge % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
+                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+           if (config_h_mom_eddy_visc4 &gt; 0.0) then
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &amp;
+                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &amp;
+                                               block % mesh % nVertLevels, block % mesh % nVertices, &amp;
+                                               block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
+           end if
+
+           block =&gt; block % next
+        end do
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !
+      !  Stage 1: Baroclinic velocity (3D) prediction, explicit with long timestep
+      !
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      ! compute velocity tendencies, T(u*,w*,p*)
+
+      block =&gt; domain % blocklist
+      do while (associated(block))
+         if (.not.config_implicit_vertical_mix) then
+            call ocn_vmix_coefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
+         end if
+         call ocn_tend_u(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
+         call enforce_boundaryEdge(block % tend, block % mesh)
+         block =&gt; block % next
+      end do
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! BEGIN baroclinic iterations on linear Coriolis term
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      do j=1,n_bcl_iter(split_explicit_step)
+
+         ! Use this G coefficient to avoid an if statement within the iEdge loop.
+         if     (trim(config_time_integration) == 'unsplit_explicit') then
+            split = 0
+         elseif (trim(config_time_integration) == 'split_explicit') then
+            split = 1
+         endif
+
+         block =&gt; domain % blocklist
+         do while (associated(block))
+           allocate(uTemp(block % mesh % nVertLevels))
+
+           ! Put f*uBcl^{perp} in uNew as a work variable
+           call ocn_fuperp(block % state % time_levs(2) % state , block % mesh)
+
+           do iEdge=1,block % mesh % nEdges
+              cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+              cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+
+              uTemp = 0.0  ! could put this after with uTemp(maxleveledgetop+1:nvertlevels)=0
+              do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
+
+                 ! uBclNew = uBclOld + dt*(-f*uBclPerp + T(u*,w*,p*) + g*grad(SSH*) )
+                 ! Here uNew is a work variable containing -fEdge(iEdge)*uBclPerp(k,iEdge)
+                 uTemp(k) &amp;
+                 = block % state % time_levs(1) % state % uBcl % array(k,iEdge) &amp;
+                 + dt * (block % tend % u % array (k,iEdge) &amp;
+                      + block % state % time_levs(2) % state % u % array (k,iEdge) &amp;  ! this is f*uBcl^{perp}
+                      + split*gravity &amp;
+                        *(  block % state % time_levs(2) % state % ssh % array(cell2) &amp;
+                          - block % state % time_levs(2) % state % ssh % array(cell1) ) &amp;
+                          /block % mesh % dcEdge % array(iEdge) )
+              enddo
+
+              ! Compute GBtrForcing, the vertically averaged forcing
+              sshEdge = 0.5*( &amp;
+                  block % state % time_levs(1) % state % ssh % array(cell1) &amp; 
+                + block % state % time_levs(1) % state % ssh % array(cell2) ) 
+
+              uhSum = (sshEdge + block % mesh % hZLevel % array(1)) * uTemp(1)
+              hSum  =  sshEdge + block % mesh % hZLevel % array(1)
+
+              do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
+                 uhSum = uhSum + block % mesh % hZLevel % array(k) * uTemp(k)
+                 hSum  =  hSum + block % mesh % hZLevel % array(k)
+              enddo
+              block % state % time_levs(1) % state % GBtrForcing % array(iEdge) = split*uhSum/hSum/dt
+
+
+              do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
+                 ! These two steps are together here:
+                 !{\bf u}'_{k,n+1} = {\bf u}'_{k,n} - \Delta t {\overline {\bf G}}
+                 !{\bf u}'_{k,n+1/2} = \frac{1}{2}\left({\bf u}^{'}_{k,n} +{\bf u}'_{k,n+1}\right) 
+                 ! so that uBclNew is at time n+1/2
+                block % state % time_levs(2) % state % uBcl % array(k,iEdge) &amp;
+                  = 0.5*( &amp;
+                  block % state % time_levs(1) % state % uBcl % array(k,iEdge) &amp;
+                  + uTemp(k) - dt * block % state % time_levs(1) % state % GBtrForcing % array(iEdge))
+              enddo
+
+           enddo ! iEdge
+
+           deallocate(uTemp)
+
+           block =&gt; block % next
+         end do
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % uBcl % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
+                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+           block =&gt; block % next
+        end do
+
+      enddo  ! do j=1,config_n_bcl_iter
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! END baroclinic iterations on linear Coriolis term
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !
+      !  Stage 2: Barotropic velocity (2D) prediction, explicitly subcycled
+      !
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      oldBtrSubcycleTime = 1
+      newBtrSubcycleTime = 2
+
+      if (trim(config_time_integration) == 'unsplit_explicit') then
+
+         block =&gt; domain % blocklist
+         do while (associated(block))
+
+            ! For Split_Explicit unsplit, simply set uBtrNew=0, uBtrSubcycle=0, and uNew=uBclNew
+            block % state % time_levs(2) % state % uBtr % array(:) = 0.0
+
+            block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:) = 0.0
+
+               block % state % time_levs(2) % state % u    % array(:,:) &amp;
+             = block % state % time_levs(2) % state % uBcl % array(:,:) 
+
+            block =&gt; block % next
+         end do  ! block
+
+      elseif (trim(config_time_integration) == 'split_explicit') then
+
+         ! Initialize variables for barotropic subcycling
+         block =&gt; domain % blocklist
+         do while (associated(block))
+
+        if (config_filter_btr_mode) then
+          block % state % time_levs(1) % state % GBtrForcing % array(:) = 0.0
+        endif
+
+            do iCell=1,block % mesh % nCells
+              ! sshSubcycleOld = sshOld  
+                block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &amp; 
+              = block % state % time_levs(1) % state % ssh % array(iCell)  
+
+              ! sshNew = sshOld  This is the first for the summation
+                block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
+              = block % state % time_levs(1) % state % ssh % array(iCell)  
+            enddo
+
+           do iEdge=1,block % mesh % nEdges
+
+              ! uBtrSubcycleOld = uBtrOld 
+                block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
+              = block % state % time_levs(1) % state % uBtr % array(iEdge) 
+
+              ! uBtrNew = BtrOld  This is the first for the summation
+                block % state % time_levs(2) % state % uBtr % array(iEdge) &amp;
+              = block % state % time_levs(1) % state % uBtr % array(iEdge) 
+
+              ! FBtr = 0  
+              block % state % time_levs(1) % state % FBtr % array(iEdge) = 0.0
+            enddo
+
+            block =&gt; block % next
+         end do  ! block
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! BEGIN Barotropic subcycle loop
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+         do j=1,config_n_btr_subcycles*config_btr_subcycle_loop_factor
+
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+            ! Barotropic subcycle: initial solve for velecity
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+          if (config_btr_gam1_uWt1&gt;1.0e-12) then  ! only do this part if it is needed in next SSH solve
+            uPerpTime = oldBtrSubcycleTime
+
+            block =&gt; domain % blocklist
+            do while (associated(block))
+
+         do iEdge=1,block % mesh % nEdges
+
+               cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+               cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+
+            ! Compute -f*uPerp
+            uPerp = 0.0
+            do i = 1,block % mesh % nEdgesOnEdge % array(iEdge)
+               eoe = block % mesh % edgesOnEdge % array(i,iEdge)
+               uPerp = uPerp + block % mesh % weightsOnEdge % array(i,iEdge) &amp;
+                  * block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &amp;
+                  * block % mesh % fEdge  % array(eoe)
+            end do
+
+          ! mrp 110606 efficiency note: could make this a 1D integer factor instead of an if statement.
+          if (block % mesh % boundaryEdge % array(1,iEdge).eq.1) then
+                block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) = 0.0
+          else
+
+             ! uBtrNew = uBtrOld + dt*(-f*uBtroldPerp - g*grad(SSH) + G)
+                block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
+              = block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
+              + dt/config_n_btr_subcycles *( &amp;
+                        uPerp &amp;
+                      - gravity &amp;
+                        *(  block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) &amp;
+                          - block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) ) &amp;
+                          /block % mesh % dcEdge % array(iEdge) &amp;
+                      + block % state % time_levs(1) % state % GBtrForcing % array(iEdge) )
+
+          endif
+
+         end do
+
+         !  Implicit solve for barotropic momentum decay
+         if ( config_btr_mom_decay) then
+            !
+            !  Add term to RHS of momentum equation: -1/gamma u
+            !
+            !  This changes the solve to:
+            !  u^{n+1} = u_provis^{n+1}/(1+dt/gamma)
+            !
+            coef = 1.0/(1.0 + dt/config_n_btr_subcycles/config_btr_mom_decay_time)
+            do iEdge=1,block % mesh % nEdges
+                block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
+              = block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
+              * coef
+            end do
+
+          endif
+
+
+               block =&gt; block % next
+            end do  ! block
+
+
+            !   boundary update on uBtrNew
+            block =&gt; domain % blocklist
+            do while (associated(block))
+
+           call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &amp;
+              block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:), &amp;
+              block % mesh % nEdges, &amp;
+              block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+               block =&gt; block % next
+            end do  ! block
+
+          endif ! config_btr_gam1_uWt1&gt;1.0e-12
+
+
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+            ! Barotropic subcycle: Compute thickness flux and new SSH: PREDICTOR
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+            block =&gt; domain % blocklist
+            do while (associated(block))
+
+           block % tend % ssh % array(:) = 0.0
+
+           if (config_btr_solve_SSH2) then
+             ! If config_btr_solve_SSH2=.true., then do NOT accumulate FBtr in this SSH predictor 
+             ! section, because it will be accumulated in the SSH corrector section.
+             FBtr_coeff = 0.0
+           else
+             ! otherwise, DO accumulate FBtr in this SSH predictor section
+             FBtr_coeff = 1.0
+           endif
+
+           ! config_btr_gam1_uWt1 sets the forward weighting of velocity in the SSH computation
+           ! config_btr_gam1_uWt1=  1     flux = uBtrNew*H
+           ! config_btr_gam1_uWt1=0.5     flux = 1/2*(uBtrNew+uBtrOld)*H
+           ! config_btr_gam1_uWt1=  0     flux = uBtrOld*H
+           do iEdge=1,block % mesh % nEdges
+              cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+              cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+
+              sshEdge = 0.5 &amp;
+                 *(  block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &amp;
+                   + block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) )
+              hSum = sum(block % mesh % hZLevel % array (1:block % mesh % maxLevelEdgeTop % array(iEdge)))
+
+              flux = ((1.0-config_btr_gam1_uWt1) &amp; 
+                        * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
+                       + config_btr_gam1_uWt1 &amp;
+                        * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) &amp;
+                    * (sshEdge + hSum)
+
+               block % tend % ssh % array(cell1) = block % tend % ssh % array(cell1) &amp;
+                 - flux * block % mesh % dvEdge % array(iEdge) 
+               block % tend % ssh % array(cell2) = block % tend % ssh % array(cell2) &amp;
+                 + flux * block % mesh % dvEdge % array(iEdge) 
+
+               block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
+             = block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
+             + FBtr_coeff*flux
+         end do

+         ! SSHnew = SSHold + dt/J*(-div(Flux))
+         do iCell=1,block % mesh % nCells 
+
+                block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell) &amp; 
+              = block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &amp; 
+              + dt/config_n_btr_subcycles &amp;
+                * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
+
+         end do
+
+               block =&gt; block % next
+            end do  ! block
+
+            !   boundary update on SSHnew
+            block =&gt; domain % blocklist
+            do while (associated(block))
+
+!              block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &amp;
+
+           call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &amp;
+              block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &amp;
+              block % mesh % nCells, &amp;
+              block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+
+               block =&gt; block % next
+            end do  ! block
+
+
+! mrp 110801 begin
+! This whole section, bounded by 'mrp 110801', may be deleted later if it is found
+! that barotropic del2 is not useful.
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+            ! Barotropic subcycle: compute btr_divergence and btr_vorticity for del2(u_btr) 
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+            block =&gt; domain % blocklist
+            do while (associated(block))
+      block % state % time_levs(1) % state % u_diffusionBtr % array(:) = 0.0
+      if ( config_btr_mom_eddy_visc2 &gt; 0.0 ) then
+      !
+      ! Compute circulation and relative vorticity at each vertex
+      !
+      block % state % time_levs(1) % state % circulationBtr % array(:) = 0.0
+      do iEdge=1,block % mesh % nEdges
+         vertex1 = block % mesh % verticesOnEdge % array(1,iEdge)
+         vertex2 = block % mesh % verticesOnEdge % array(2,iEdge)
+             block % state % time_levs(1) % state % circulationBtr % array(vertex1) &amp;
+           = block % state % time_levs(1) % state % circulationBtr % array(vertex1) &amp;
+           - block % mesh % dcEdge % array (iEdge) &amp;
+            *block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
+
+             block % state % time_levs(1) % state % circulationBtr % array(vertex2) &amp;
+           = block % state % time_levs(1) % state % circulationBtr % array(vertex2) &amp;
+           + block % mesh % dcEdge % array (iEdge) &amp;
+            *block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
+      end do 
+      do iVertex=1,block % mesh % nVertices
+            block % state % time_levs(1) % state % vorticityBtr % array(iVertex) &amp;
+          = block % state % time_levs(1) % state % circulationBtr % array(iVertex) / block % mesh % areaTriangle % array (iVertex)
+      end do
+
+      !
+      ! Compute the divergence at each cell center
+      !
+      block % state % time_levs(1) % state % divergenceBtr % array(:) = 0.0
+      do iEdge=1,block % mesh % nEdges
+         cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+         cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+             block % state % time_levs(1) % state % divergenceBtr % array (cell1) &amp;
+           = block % state % time_levs(1) % state % divergenceBtr % array (cell1) &amp;
+           + block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
+            *block % mesh % dvEdge % array(iEdge)
+
+             block % state % time_levs(1) % state % divergenceBtr % array (cell2) &amp;
+           = block % state % time_levs(1) % state % divergenceBtr % array (cell2) &amp;
+           - block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
+            *block % mesh % dvEdge % array(iEdge)
+      end do
+      do iCell = 1,block % mesh % nCells
+         block % state % time_levs(1) % state % divergenceBtr % array(iCell) &amp;
+       = block % state % time_levs(1) % state % divergenceBtr % array(iCell) &amp;
+        /block % mesh % areaCell % array(iCell)
+      enddo
+
+      !
+      ! Compute Btr diffusion
+      !
+         do iEdge=1,block % mesh % nEdgesSolve
+            cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+            cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+            vertex1 = block % mesh % verticesOnEdge % array(1,iEdge)
+            vertex2 = block % mesh % verticesOnEdge % array(2,iEdge)
+
+               ! Here -( vorticityBtr(vertex2) - vorticityBtr(vertex1) ) / dvEdge % array (iEdge)
+               ! is - </font>
<font color="blue">abla vorticity pointing from vertex 2 to vertex 1, or equivalently 
+               !    + k \times </font>
<font color="gray">abla vorticity pointing from cell1 to cell2.
+
+               block % state % time_levs(1) % state % u_diffusionBtr % array(iEdge) = block % mesh % meshScalingDel2 % array (iEdge) * config_btr_mom_eddy_visc2 * &amp;
+                   (( block % state % time_levs(1) % state % divergenceBtr % array(cell2)  - block % state % time_levs(1) % state % divergenceBtr % array(cell1) ) / block % mesh % dcEdge % array (iEdge)  &amp;
+                  -( block % state % time_levs(1) % state % vorticityBtr % array(vertex2) - block % state % time_levs(1) % state % vorticityBtr % array(vertex1) ) / block % mesh % dvEdge % array (iEdge))
+
+         end do
+      end if
+               block =&gt; block % next
+            end do  ! block
+! mrp 110801 end
+
+
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+            ! Barotropic subcycle: Final solve for velocity.  Iterate for Coriolis term.
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+       do BtrCorIter=1,config_n_btr_cor_iter
+
+          uPerpTime = newBtrSubcycleTime
+
+          block =&gt; domain % blocklist
+          do while (associated(block))
+
+         do iEdge=1,block % mesh % nEdges 
+
+               cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+               cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+
+            ! Compute -f*uPerp
+            uPerp = 0.0
+            do i = 1,block % mesh % nEdgesOnEdge % array(iEdge)
+               eoe = block % mesh % edgesOnEdge % array(i,iEdge)
+               uPerp = uPerp + block % mesh % weightsOnEdge % array(i,iEdge) &amp;
+                  * block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &amp;
+                  * block % mesh % fEdge  % array(eoe) 
+            end do
+
+          ! mrp 110606 efficiency note: could make this a 1D integer factor instead of an if statement.
+          if (block % mesh % boundaryEdge % array(1,iEdge).eq.1) then
+                block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) = 0.0
+          else
+
+             ! uBtrNew = uBtrOld + dt*(-f*uBtroldPerp - g*grad(SSH) + G)
+
+             sshCell1 = &amp;
+               (1-config_btr_gam2_SSHWt1)*block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &amp;
+                + config_btr_gam2_SSHWt1 *block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell1)
+
+             sshCell2 = &amp;
+               (1-config_btr_gam2_SSHWt1)*block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) &amp;
+                + config_btr_gam2_SSHWt1 *block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell2)
+
+                block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp; 
+              = block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp; 
+              + dt/config_n_btr_subcycles *( &amp;
+                        uPerp &amp;
+                      - gravity &amp;
+                        *(  sshCell2 &amp;
+                          - sshCell1 )&amp;
+                          /block % mesh % dcEdge % array(iEdge) &amp;
+                      + block % state % time_levs(1) % state % GBtrForcing % array(iEdge) &amp;
+                      + block % state % time_levs(1) % state % u_diffusionBtr % array(iEdge))
+                      ! added del2 diffusion to btr solve
+
+          endif
+
+         end do
+
+            !  Implicit solve for barotropic momentum decay
+         if ( config_btr_mom_decay) then
+            !  Add term to RHS of momentum equation: -1/gamma u
+            !
+            !  This changes the solve to:
+            !  u^{n+1} = u_provis^{n+1}/(1+dt/gamma)
+            !
+            coef = 1.0/(1.0 + dt/config_n_btr_subcycles/config_btr_mom_decay_time)
+            do iEdge=1,block % mesh % nEdges 
+                block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp; 
+              = block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
+              * coef
+            end do
+
+         endif
+
+               block =&gt; block % next
+            end do  ! block
+
+
+            !   boundary update on uBtrNew
+            block =&gt; domain % blocklist
+            do while (associated(block))
+
+               call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &amp;
+                  block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:), &amp;
+                  block % mesh % nEdges, &amp;
+                  block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+               block =&gt; block % next
+            end do  ! block
+
+       end do !do BtrCorIter=1,config_n_btr_cor_iter
+
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+            ! Barotropic subcycle: Compute thickness flux and new SSH: CORRECTOR
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        if (config_btr_solve_SSH2) then
+
+            block =&gt; domain % blocklist
+            do while (associated(block))
+
+           block % tend % ssh % array(:) = 0.0
+
+           ! config_btr_gam3_uWt2 sets the forward weighting of velocity in the SSH computation
+           ! config_btr_gam3_uWt2=  1     flux = uBtrNew*H
+           ! config_btr_gam3_uWt2=0.5     flux = 1/2*(uBtrNew+uBtrOld)*H
+           ! config_btr_gam3_uWt2=  0     flux = uBtrOld*H
+
+           do iEdge=1,block % mesh % nEdges
+              cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+              cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+
+              sshEdge = 0.5 &amp;
+                 *(  block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &amp;
+                   + block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) )
+              hSum = sum(block % mesh % hZLevel % array (1:block % mesh % maxLevelEdgeTop % array(iEdge)))
+
+              flux = ((1.0-config_btr_gam3_uWt2) &amp; 
+                        * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &amp;
+                       + config_btr_gam3_uWt2 &amp;
+                        * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) &amp;
+                    * (sshEdge + hSum)
+
+               block % tend % ssh % array(cell1) = block % tend % ssh % array(cell1) &amp;
+                 - flux * block % mesh % dvEdge % array(iEdge) 
+               block % tend % ssh % array(cell2) = block % tend % ssh % array(cell2) &amp;
+                 + flux * block % mesh % dvEdge % array(iEdge) 
+
+               block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
+             = block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
+             + flux
+
+
+         end do

+         ! SSHnew = SSHold + dt/J*(-div(Flux))
+         do iCell=1,block % mesh % nCells 
+
+                block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell) &amp; 
+              = block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &amp; 
+              + dt/config_n_btr_subcycles &amp;
+                * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
+
+         end do
+
+               block =&gt; block % next
+            end do  ! block
+
+            !   boundary update on SSHnew
+            block =&gt; domain % blocklist
+            do while (associated(block))
+
+           call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &amp;
+              block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &amp;
+              block % mesh % nCells, &amp;
+              block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+
+               block =&gt; block % next
+            end do  ! block
+
+        endif ! config_btr_solve_SSH2
+
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+            ! Barotropic subcycle: Accumulate running sums, advance timestep pointers
+            !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+            block =&gt; domain % blocklist
+            do while (associated(block))
+
+         ! Accumulate SSH in running sum over the subcycles.
+         do iCell=1,block % mesh % nCells 
+                block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
+              = block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
+              + block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell)  
+         end do
+
+            ! uBtrNew = uBtrNew + uBtrSubcycleNEW
+            ! This accumulates the sum.
+            ! If the Barotropic Coriolis iteration is limited to one, this could 
+            ! be merged with the above code.
+         do iEdge=1,block % mesh % nEdges 
+
+                block % state % time_levs(2) % state % uBtr % array(iEdge) &amp; 
+              = block % state % time_levs(2) % state % uBtr % array(iEdge) &amp; 
+              + block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)  
+
+            end do  ! iEdge
+               block =&gt; block % next
+         end do  ! block
+
+            ! advance time pointers
+            oldBtrSubcycleTime = mod(oldBtrSubcycleTime,2)+1
+            newBtrSubcycleTime = mod(newBtrSubcycleTime,2)+1
+
+         end do ! j=1,config_n_btr_subcycles
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! END Barotropic subcycle loop
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+            ! Normalize Barotropic subcycle sums: ssh, uBtr, and F
+            block =&gt; domain % blocklist
+            do while (associated(block))
+
+         do iEdge=1,block % mesh % nEdges
+               block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
+             = block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
+             / (config_n_btr_subcycles*config_btr_subcycle_loop_factor)
+
+                block % state % time_levs(2) % state % uBtr % array(iEdge) &amp; 
+              = block % state % time_levs(2) % state % uBtr % array(iEdge) &amp; 
+             / (config_n_btr_subcycles*config_btr_subcycle_loop_factor + 1)
+         end do
+
+        if (config_SSH_from=='avg_of_SSH_subcycles') then
+         do iCell=1,block % mesh % nCells 
+                block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
+              = block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
+             / (config_n_btr_subcycles*config_btr_subcycle_loop_factor + 1)
+         end do
+        elseif (config_SSH_from=='avg_flux') then
+           ! see below
+        else
+         write(0,*) 'Abort: Unknown config_SSH_from option: '&amp;
+           //trim(config_SSH_from)
+         call mpas_dmpar_abort(dminfo)
+        endif
+
+               block =&gt; block % next
+            end do  ! block
+
+
+            ! boundary update on F
+            block =&gt; domain % blocklist
+            do while (associated(block))
+
+           call mpas_dmpar_exch_halo_field1d_real(domain % dminfo, &amp;
+              block % state % time_levs(1) % state % FBtr % array(:), &amp;
+              block % mesh % nEdges, &amp;
+              block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+               block =&gt; block % next
+            end do  ! block
+
+
+            ! Check that you can compute SSH using the total sum or the individual increments
+            ! over the barotropic subcycles.
+            ! efficiency: This next block of code is really a check for debugging, and can 
+            ! be removed later.
+            block =&gt; domain % blocklist
+            do while (associated(block))
+
+               allocate(uTemp(block % mesh % nVertLevels))
+
+        if (config_SSH_from=='avg_flux') then
+           ! Accumulate fluxes in the tend % ssh variable
+           block % tend % ssh % array(:) = 0.0
+           do iEdge=1,block % mesh % nEdges
+              cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+              cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+
+                 block % tend % ssh % array(cell1) &amp;
+               = block % tend % ssh % array(cell1) &amp;
+               - block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
+                    * block % mesh % dvEdge % array(iEdge)
+
+
+                 block % tend % ssh % array(cell2) &amp;
+               = block % tend % ssh % array(cell2) &amp;
+               + block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
+                    * block % mesh % dvEdge % array(iEdge)
+
+          end do
+
+         do iCell=1,block % mesh % nCells 

+             ! SSHnew = SSHold + dt*(-div(Flux))
+                block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
+              = block % state % time_levs(1) % state % ssh % array(iCell) &amp; 
+              + dt &amp;
+                * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
+         end do
+       endif
+
+         ! Correction velocity    uCorr = (Flux - Sum(h u*))/H
+         ! or, for the full latex version:
+         !u^{corr} = \left( {\overline {\bf F}} 
+         !  - \sum_{k=1}^{N^{edge}} \left(\zeta_{k,n}^{*\;edge}+\Delta z_k\right)  u_k^* \right)
+         !\left/ \sum_{k=1}^{N^{edge}} \left(\zeta_{k,n}^{*\;edge}+\Delta z_k\right)   \right. 
+
+          if (config_u_correction) then
+             ucorr_coef = 1
+          else
+             ucorr_coef = 0
+          endif
+
+           do iEdge=1,block % mesh % nEdges
+              cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+              cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+
+              sshEdge = 0.5 &amp;
+                 *(  block % state % time_levs(2) % state % ssh % array(cell1) &amp;
+                   + block % state % time_levs(2) % state % ssh % array(cell2) )
+
+             ! This is u*
+               uTemp(:) &amp;
+             = block % state % time_levs(2) % state % uBtr % array(iEdge) &amp;
+             + block % state % time_levs(2) % state % uBcl % array(:,iEdge) 
+
+              uhSum = (sshEdge + block % mesh % hZLevel % array(1)) * uTemp(1)
+              hSum  =  sshEdge + block % mesh % hZLevel % array(1)
+
+              do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
+                 uhSum = uhSum + block % mesh % hZLevel % array(k) * uTemp(k)
+                 hSum  =  hSum + block % mesh % hZLevel % array(k)
+              enddo
+
+            uCorr =   ucorr_coef*(( block % state % time_levs(1) % state % FBtr % array(iEdge) &amp;
+                      - uhSum)/hSum)
+
+              ! put u^{tr}, the velocity for tracer transport, in uNew
+          ! mrp 060611 not sure if boundary enforcement is needed here.  
+          if (block % mesh % boundaryEdge % array(1,iEdge).eq.1) then
+              block % state % time_levs(2) % state % u % array(:,iEdge) = 0.0
+          else
+            do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
+              block % state % time_levs(2) % state % u % array(k,iEdge) = uTemp(k) + uCorr
+            enddo
+            do k=block % mesh % maxLevelEdgeTop % array(iEdge)+1,block % mesh % nVertLevels
+              block % state % time_levs(2) % state % u % array(k,iEdge) = 0.0
+            enddo
+          endif
+
+         ! Put new sshEdge values in h_edge array, for the OcnTendScalar call below.
+             block % state % time_levs(2) % state % h_edge % array(1,iEdge) &amp;
+           = sshEdge + block % mesh % hZLevel % array(1)
+
+           do k=2,block % mesh % nVertLevels
+             block % state % time_levs(2) % state % h_edge % array(k,iEdge) &amp;
+           = block % mesh % hZLevel % array(k)
+           enddo
+
+          end do ! iEdge
+
+         ! Put new SSH values in h array, for the OcnTendScalar call below.
+         do iCell=1,block % mesh % nCells 
+             block % state % time_levs(2) % state % h % array(1,iCell) &amp;
+           = block % state % time_levs(2) % state % ssh % array(iCell) &amp;
+           + block % mesh % hZLevel % array(1)
+
+           ! mrp 110601 efficiency note: Since h just moves back and forth between pointers,
+           ! this is not necessary once initialized.
+           do k=2,block % mesh % nVertLevels
+             block % state % time_levs(2) % state % h % array(k,iCell) &amp;
+           = block % mesh % hZLevel % array(k)
+           enddo
+         enddo ! iCell
+
+           deallocate(uTemp)
+
+               block =&gt; block % next
+            end do  ! block
+
+
+      endif ! split_explicit
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !
+      !  Stage 3: Tracer, density, pressure, vertical velocity prediction
+      !
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+         block =&gt; domain % blocklist
+         do while (associated(block))
+
+           call ocn_wtop(block % state % time_levs(2) % state, block % mesh)
+
+      if (trim(config_time_integration) == 'unsplit_explicit') then
+           call ocn_tend_h(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
+      endif
+
+           call ocn_tend_scalar(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
+
+           block =&gt; block % next
+         end do
+
+        ! ---  update halos for prognostic variables
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % tend % h % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           call mpas_dmpar_exch_halo_field3d_real(domain % dminfo, block % tend % tracers % array(:,:,:), &amp;
+                                            block % tend % num_tracers, block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           block =&gt; block % next
+        end do
+
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           allocate(hNew(block % mesh % nVertLevels))
+
+        if (trim(config_new_btr_variables_from) == 'last_subcycle') then
+           ! This points to the last barotropic SSH subcycle
+           sshNew =&gt; block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array
+        elseif (trim(config_new_btr_variables_from) == 'btr_avg') then
+           ! This points to the tendency variable SSH*
+           sshNew =&gt; block % state % time_levs(2) % state % ssh % array
+        endif
+
+      if (trim(config_time_integration) == 'unsplit_explicit') then
+
+         do iCell=1,block % mesh % nCells
+           ! this is h_{n+1}
+             block % state % time_levs(2) % state % h % array(:,iCell) &amp;
+           = block % state % time_levs(1) % state % h % array(:,iCell) &amp;
+           + dt* block % tend % h % array(:,iCell) 
+
+            ! this is only for the hNew computation below, so there is the correct
+            ! value in the ssh variable for unsplit_explicit case.
+            block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &amp;
+          = block % state % time_levs(2) % state % h % array(1,iCell) &amp;
+          - block % mesh % hZLevel % array(1)
+           end do ! iCell
+
+      endif ! unsplit_explicit
+
+           ! Only need T &amp; S for earlier iterations,
+           ! then all the tracers needed the last time through.
+         if (split_explicit_step &lt; config_n_ts_iter) then
+
+           hNew(:) = block % mesh % hZLevel % array(:)
+           do iCell=1,block % mesh % nCells
+              ! sshNew is a pointer, defined above.
+              hNew(1) =  sshNew(iCell) + block % mesh % hZLevel % array(1)
+              do k=1,block % mesh % maxLevelCell % array(iCell)
+                 do i=1,2
+                ! This is Phi at n+1
+                tracerTemp &amp;
+                = (  block % state % time_levs(1) % state % tracers % array(i,k,iCell) &amp;
+                   * block % state % time_levs(1) % state % h % array(k,iCell) &amp;
+                 + dt * block % tend % tracers % array(i,k,iCell) &amp;
+                  ) / hNew(k)
+
+                ! This is Phi at n+1/2
+                   block % state % time_levs(2) % state % tracers % array(i,k,iCell)  &amp;
+                 = 0.5*( &amp;
+                   block % state % time_levs(1) % state % tracers % array(i,k,iCell) &amp;
+                 + tracerTemp )
+                 enddo
+              end do
+           end do ! iCell
+
+
+          if (trim(config_time_integration) == 'unsplit_explicit') then
+
+            ! compute h*, which is h at n+1/2 and put into array hNew
+            ! on last iteration, hNew remains at n+1
+           do iCell=1,block % mesh % nCells
+                 block % state % time_levs(2) % state % h % array(1,iCell) &amp;
+                 = 0.5*( &amp;
+                 block % state % time_levs(2) % state % h % array(1,iCell) &amp;
+               + block % state % time_levs(1) % state % h % array(1,iCell) )
+
+           end do ! iCell
+          endif ! unsplit_explicit
+
+          ! compute u*, the velocity for tendency terms.  Put in uNew.
+          ! uBclNew is at time n+1/2 here.
+          ! This overwrites u^{tr}, the tracer transport velocity, which was in uNew.
+          ! The following must occur after  call OcnTendScalar
+           do iEdge=1,block % mesh % nEdges
+               block % state % time_levs(2) % state % u    % array(:,iEdge) &amp;
+             = block % state % time_levs(2) % state % uBtr % array(iEdge) &amp;
+             + block % state % time_levs(2) % state % uBcl % array(:,iEdge) 
+           end do ! iEdge
+
+         ! mrp 110512  I really only need this to compute h_edge, density, pressure.
+         ! I can par this down later.
+         call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)

+
+         elseif (split_explicit_step == config_n_ts_iter) then
+
+           hNew(:) = block % mesh % hZLevel % array(:)
+           do iCell=1,block % mesh % nCells
+              ! sshNew is a pointer, defined above.
+              hNew(1) =  sshNew(iCell) + block % mesh % hZLevel % array(1)
+              do k=1,block % mesh % maxLevelCell % array(iCell)
+                 do i=1,block % state % time_levs(1) % state % num_tracers
+                ! This is Phi at n+1
+                   block % state % time_levs(2) % state % tracers % array(i,k,iCell)  &amp;
+                = (  block % state % time_levs(1) % state % tracers % array(i,k,iCell) &amp;
+                   * block % state % time_levs(1) % state % h % array(k,iCell) &amp;
+                 + dt * block % tend % tracers % array(i,k,iCell) &amp;
+                  ) / hNew(k)
+
+                 enddo
+              end do
+           end do
+
+         endif ! split_explicit_step
+           deallocate(hNew)
+
+         block =&gt; block % next
+       end do
+
+      end do  ! split_explicit_step = 1, config_n_ts_iter
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! END large iteration loop 
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      !
+      !  A little clean up at the end: decouple new scalar fields and compute diagnostics for new state
+      !
+      block =&gt; domain % blocklist
+      do while (associated(block))
+
+        if (trim(config_new_btr_variables_from) == 'last_subcycle') then
+         do iEdge=1,block % mesh % nEdges
+               ! uBtrNew = uBtrSubcycleNew  (old here is because counter already flipped)
+               ! This line is not needed if u is resplit at the beginning of the timestep.
+                block % state % time_levs(2) % state % uBtr % array(iEdge) &amp; 
+              = block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)  
+         enddo ! iEdges
+        elseif (trim(config_new_btr_variables_from) == 'btr_avg') then
+               ! uBtrNew from u*.  this is done above, so u* is already in
+               ! block % state % time_levs(2) % state % uBtr % array(iEdge) 
+        else
+         write(0,*) 'Abort: Unknown config_new_btr_variables_from: '&amp;
+           //trim(config_time_integration)
+         call mpas_dmpar_abort(dminfo)
+       endif
+
+         ! Recompute final u to go on to next step.
+         ! u_{n+1} = uBtr_{n+1} + uBcl_{n+1} 
+         ! Right now uBclNew is at time n+1/2, so back compute to get uBcl at time n+1
+         !   using uBcl_{n+1/2} = 1/2*(uBcl_n + u_Bcl_{n+1})
+         ! so the following lines are
+         ! u_{n+1} = uBtr_{n+1} + 2*uBcl_{n+1/2} - uBcl_n
+         ! note that uBcl is recomputed at the beginning of the next timestep due to Imp Vert mixing,
+         ! so uBcl does not have to be recomputed here.
+
+         do iEdge=1,block % mesh % nEdges
+            do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
+
+               block % state % time_levs(2) % state % u % array(k,iEdge) &amp; 
+            =  block % state % time_levs(2) % state % uBtr % array(iEdge) &amp;
+            +2*block % state % time_levs(2) % state % uBcl % array(k,iEdge) &amp;
+            -  block % state % time_levs(1) % state % uBcl % array(k,iEdge)
+            enddo
+            ! mrp 110607 zero out velocity below land edges. efficiency: this may not be required.
+            do k=block % mesh % maxLevelEdgeTop % array(iEdge) + 1, block % mesh % nVertLevels
+               block % state % time_levs(2) % state % u % array(k,iEdge) = 0.0
+            enddo
+
+         enddo ! iEdges
+
+        if (trim(config_time_integration) == 'split_explicit') then
+
+        if (trim(config_new_btr_variables_from) == 'last_subcycle') then
+         do iCell=1,block % mesh % nCells
+         ! SSH for the next step is from the end of the barotropic subcycle.
+               block % state % time_levs(2) % state % ssh % array(iCell) &amp; 
+            =  block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) 
+         end do ! iCell
+        elseif (trim(config_new_btr_variables_from) == 'btr_avg') then
+               ! sshNew from ssh*.  This is done above, so ssh* is already in
+               ! block % state % time_levs(2) % state % ssh % array(iCell) 
+        endif
+
+         do iCell=1,block % mesh % nCells
+         ! Put new SSH values in h array, for the OcnTendScalar call below.
+             block % state % time_levs(2) % state % h % array(1,iCell) &amp;
+           = block % state % time_levs(2) % state % ssh % array(iCell) &amp;
+           + block % mesh % hZLevel % array(1)
+
+           ! mrp 110601 efficiency note: Since h just moves back and forth between pointers,
+           ! this is not necessary once initialized.
+           do k=2,block % mesh % nVertLevels
+             block % state % time_levs(2) % state % h % array(k,iCell) &amp;
+           = block % mesh % hZLevel % array(k)
+           end do
+         end do ! iCell
+       end if ! split_explicit

+       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+       !
+       !  Implicit vertical mixing, done after timestep is complete
+       !
+       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+         u           =&gt; block % state % time_levs(2) % state % u % array
+         tracers     =&gt; block % state % time_levs(2) % state % tracers % array
+         h           =&gt; block % state % time_levs(2) % state % h % array
+         h_edge      =&gt; block % state % time_levs(2) % state % h_edge % array
+         ke_edge     =&gt; block % state % time_levs(2) % state % ke_edge % array
+         num_tracers = block % state % time_levs(2) % state % num_tracers
+         vertViscTopOfEdge =&gt; block % diagnostics % vertViscTopOfEdge % array
+         vertDiffTopOfCell =&gt; block % diagnostics % vertDiffTopOfCell % array
+         maxLevelCell    =&gt; block % mesh % maxLevelCell % array
+         maxLevelEdgeTop =&gt; block % mesh % maxLevelEdgeTop % array
+
+         if (config_implicit_vertical_mix) then
+            allocate(A(block % mesh % nVertLevels),C(block % mesh % nVertLevels),uTemp(block % mesh % nVertLevels), &amp;
+               tracersTemp(num_tracers,block % mesh % nVertLevels))
+
+            call ocn_vmix_coefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
+
+            !
+            !  Implicit vertical solve for momentum
+            !
+
+            call ocn_vel_vmix_tend_implicit(block % mesh, dt, ke_edge, vertvisctopofedge, h, h_edge, u, err)
+
+            !
+            !  Implicit vertical solve for tracers
+            !
+            call ocn_tracer_vmix_tend_implicit(block % mesh, dt, vertdifftopofcell, h, tracers, err)
+         end if
+
+         ! mrp 110725 adding momentum decay term
+         if (config_mom_decay) then
+
+            !
+            !  Implicit solve for momentum decay
+            !
+            !  Add term to RHS of momentum equation: -1/gamma u
+            !
+            !  This changes the solve to:
+            !  u^{n+1} = u_provis^{n+1}/(1+dt/gamma)
+            !
+            coef = 1.0/(1.0 + dt/config_mom_decay_time)
+            do iEdge=1,block % mesh % nEdges
+               do k=1,maxLevelEdgeTop(iEdge)
+                  u(k,iEdge) = coef*u(k,iEdge) 
+               end do
+            end do
+
+         end if
+
+         if (config_test_case == 1) then    ! For case 1, wind field should be fixed
+            block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+         end if
+
+         call ocn_diagnostic_solve(dt, block % state % time_levs(2) % state, block % mesh)
+
+         call mpas_reconstruct(block % mesh, block % state % time_levs(2) % state % u % array,          &amp;
+                          block % state % time_levs(2) % state % uReconstructX % array,            &amp;
+                          block % state % time_levs(2) % state % uReconstructY % array,            &amp;
+                          block % state % time_levs(2) % state % uReconstructZ % array,            &amp;
+                          block % state % time_levs(2) % state % uReconstructZonal % array,        &amp;
+                          block % state % time_levs(2) % state % uReconstructMeridional % array    &amp;
+                         )
+
+         block =&gt; block % next
+      end do
+      call mpas_timer_stop(&quot;split_explicit_timestep&quot;)
+
+   end subroutine ocn_time_integrator_split!}}}
+
+   subroutine filter_btr_mode_tend_u(tend, s, d, grid)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Filter and remove barotropic mode from the tendencies
+   !
+   ! 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
+
+! mrp 110512 I just split compute_tend into compute_tend_u and compute_tend_h.
+!  Some of these variables can be removed, but at a later time.
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
+        vertex1, vertex2, eoe, i, j
+
+      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
+      real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
+      real (kind=RKIND), dimension(:), pointer :: &amp;
+        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
+        zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &amp;
+        tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
+        MontPot, wTop, divergence, vertViscTopOfEdge
+      type (dm_info) :: dminfo
+
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
+        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+      integer, dimension(:,:), pointer :: &amp;
+        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
+        edgesOnEdge, edgesOnVertex
+      real (kind=RKIND) :: u_diffusion
+      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
+
+
+      real (kind=RKIND), dimension(:,:), pointer :: u_src
+      real (kind=RKIND), parameter :: rho_ref = 1000.0
+
+      call mpas_timer_start(&quot;filter_btr_mode_tend_u&quot;)
+
+      h           =&gt; s % h % array
+      u           =&gt; s % u % array
+      v           =&gt; s % v % array
+      wTop        =&gt; s % wTop % array
+      h_edge      =&gt; s % h_edge % array
+      circulation =&gt; s % circulation % array
+      vorticity   =&gt; s % vorticity % array
+      divergence  =&gt; s % divergence % array
+      ke          =&gt; s % ke % array
+      ke_edge     =&gt; s % ke_edge % array
+      pv_edge     =&gt; s % pv_edge % array
+      MontPot     =&gt; s % MontPot % array
+      pressure    =&gt; s % pressure % array
+      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
+
+      weightsOnEdge     =&gt; grid % weightsOnEdge % array
+      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      cellsOnVertex     =&gt; grid % cellsOnVertex % array
+      verticesOnEdge    =&gt; grid % verticesOnEdge % array
+      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
+      edgesOnCell       =&gt; grid % edgesOnCell % array
+      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
+      edgesOnEdge       =&gt; grid % edgesOnEdge % array
+      edgesOnVertex     =&gt; grid % edgesOnVertex % array
+      dcEdge            =&gt; grid % dcEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      areaCell          =&gt; grid % areaCell % array
+      areaTriangle      =&gt; grid % areaTriangle % array
+      h_s               =&gt; grid % h_s % array
+! mrp 110516 cleanup fvertex fedge not used in this subroutine
+      fVertex           =&gt; grid % fVertex % array
+      fEdge             =&gt; grid % fEdge % array
+      zMidZLevel        =&gt; grid % zMidZLevel % array
+      zTopZLevel        =&gt; grid % zTopZLevel % array
+      maxLevelCell      =&gt; grid % maxLevelCell % array
+      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
+      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
+
+      tend_u      =&gt; tend % u % array
+                  
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nEdgesSolve = grid % nEdgesSolve
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+
+      u_src =&gt; grid % u_src % array
+
+           do iEdge=1,grid % nEdges
+
+              ! I am using hZLevel here.  This assumes that SSH is zero everywhere already,
+              ! which should be the case if the barotropic mode is filtered.
+              ! The more general case is to use sshEdge or h_edge.
+              uhSum = (grid % hZLevel % array(1)) * tend_u(1,iEdge)
+              hSum  =  grid % hZLevel % array(1)
+
+              do k=2,grid % maxLevelEdgeTop % array(iEdge)
+                 uhSum = uhSum + grid % hZLevel % array(k) * tend_u(k,iEdge)
+                 hSum  =  hSum + grid % hZLevel % array(k)
+              enddo
+
+              vertSum = uhSum/hSum
+
+              do k=1,grid % maxLevelEdgeTop % array(iEdge)
+                 tend_u(k,iEdge) = tend_u(k,iEdge) - vertSum
+              enddo
+
+           enddo ! iEdge
+
+      call mpas_timer_stop(&quot;filter_btr_mode_tend_u&quot;)
+
+   end subroutine filter_btr_mode_tend_u!}}}
+
+   subroutine filter_btr_mode_u(s, grid)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Filter and remove barotropic mode.
+   !
+   ! 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
+
+! mrp 110512 I just split compute_tend into compute_tend_u and compute_tend_h.
+!  Some of these variables can be removed, but at a later time.
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, &amp;
+        vertex1, vertex2, eoe, i, j
+
+      integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
+      real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
+      real (kind=RKIND), dimension(:), pointer :: &amp;
+        h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
+        zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &amp;
+        tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &amp;
+        MontPot, wTop, divergence, vertViscTopOfEdge
+      type (dm_info) :: dminfo
+
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &amp;
+        maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+      integer, dimension(:,:), pointer :: &amp;
+        cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &amp;
+        edgesOnEdge, edgesOnVertex
+      real (kind=RKIND) :: u_diffusion
+      real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
+
+
+      real (kind=RKIND), dimension(:,:), pointer :: u_src
+      real (kind=RKIND), parameter :: rho_ref = 1000.0
+
+      call mpas_timer_start(&quot;filter_btr_mode_u&quot;)
+
+      h           =&gt; s % h % array
+      u           =&gt; s % u % array
+      v           =&gt; s % v % array
+      wTop        =&gt; s % wTop % array
+      h_edge      =&gt; s % h_edge % array
+      circulation =&gt; s % circulation % array
+      vorticity   =&gt; s % vorticity % array
+      divergence  =&gt; s % divergence % array
+      ke          =&gt; s % ke % array
+      ke_edge     =&gt; s % ke_edge % array
+      pv_edge     =&gt; s % pv_edge % array
+      MontPot     =&gt; s % MontPot % array
+      pressure    =&gt; s % pressure % array
+
+      weightsOnEdge     =&gt; grid % weightsOnEdge % array
+      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      cellsOnVertex     =&gt; grid % cellsOnVertex % array
+      verticesOnEdge    =&gt; grid % verticesOnEdge % array
+      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
+      edgesOnCell       =&gt; grid % edgesOnCell % array
+      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
+      edgesOnEdge       =&gt; grid % edgesOnEdge % array
+      edgesOnVertex     =&gt; grid % edgesOnVertex % array
+      dcEdge            =&gt; grid % dcEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      areaCell          =&gt; grid % areaCell % array
+      areaTriangle      =&gt; grid % areaTriangle % array
+      h_s               =&gt; grid % h_s % array
+! mrp 110516 cleanup fvertex fedge not used in this subroutine
+      fVertex           =&gt; grid % fVertex % array
+      fEdge             =&gt; grid % fEdge % array
+      zMidZLevel        =&gt; grid % zMidZLevel % array
+      zTopZLevel        =&gt; grid % zTopZLevel % array
+      maxLevelCell      =&gt; grid % maxLevelCell % array
+      maxLevelEdgeTop      =&gt; grid % maxLevelEdgeTop % array
+      maxLevelVertexBot    =&gt; grid % maxLevelVertexBot % array
+
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nEdgesSolve = grid % nEdgesSolve
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+
+      u_src =&gt; grid % u_src % array
+
+           do iEdge=1,grid % nEdges
+
+              ! I am using hZLevel here.  This assumes that SSH is zero everywhere already,
+              ! which should be the case if the barotropic mode is filtered.
+              ! The more general case is to use sshedge or h_edge.
+              uhSum = (grid % hZLevel % array(1)) * u(1,iEdge)
+              hSum  =  grid % hZLevel % array(1)
+
+              do k=2,grid % maxLevelEdgeTop % array(iEdge)
+                 uhSum = uhSum + grid % hZLevel % array(k) * u(k,iEdge)
+                 hSum  =  hSum + grid % hZLevel % array(k)
+              enddo
+
+              vertSum = uhSum/hSum
+              do k=1,grid % maxLevelEdgeTop % array(iEdge)
+                 u(k,iEdge) = u(k,iEdge) - vertSum
+              enddo
+
+           enddo ! iEdge
+
+      call mpas_timer_stop(&quot;filter_btr_mode_u&quot;)
+
+   end subroutine filter_btr_mode_u!}}}
+
+   subroutine enforce_boundaryEdge(tend, grid)!{{{
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Enforce any boundary conditions on the normal velocity at each edge
+   !
+   ! Input: grid - grid metadata
+   !
+   ! Output: tend_u set to zero at boundaryEdge == 1 locations
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+      implicit none
+
+      type (tend_type), intent(inout) :: tend
+      type (mesh_type), intent(in) :: grid
+
+      integer, dimension(:,:), pointer :: boundaryEdge
+      real (kind=RKIND), dimension(:,:), pointer :: tend_u
+      integer :: nCells, nEdges, nVertices, nVertLevels
+      integer :: iEdge, k
+
+      call mpas_timer_start(&quot;enforce_boundaryEdge&quot;)
+
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+
+      boundaryEdge         =&gt; grid % boundaryEdge % array
+      tend_u      =&gt; tend % u % array
+
+      if(maxval(boundaryEdge).le.0) return
+
+      do iEdge = 1,nEdges
+        do k = 1,nVertLevels
+
+          if(boundaryEdge(k,iEdge).eq.1) then
+             tend_u(k,iEdge) = 0.0
+          endif
+
+        enddo
+       enddo
+      call mpas_timer_stop(&quot;enforce_boundaryEdge&quot;)
+
+   end subroutine enforce_boundaryEdge!}}}
+
+end module ocn_time_integration_split
+
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,180 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_hadv
-!
-!&gt; \brief MPAS ocean horizontal tracer advection driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  horizontal advection tendencies.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_hadv
-
-   use grid_types
-   use configure
-
-   use ocn_tracer_hadv2
-   use ocn_tracer_hadv3
-   use ocn_tracer_hadv4
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_hadv_tend, &amp;
-             ocn_tracer_hadv_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hadv_tend
-!
-!&gt; \brief   Computes tendency term for horizontal tracer advection
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the horizontal advection tendency for tracer
-!&gt;  based on current state and user choices of advection parameterization.
-!&gt;  Multiple parameterizations may be chosen and added together.  These
-!&gt;  tendencies are generally computed by calling the specific routine
-!&gt;  for the chosen parameterization, so this routine is primarily a
-!&gt;  driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hadv_tend(grid, u, h_edge, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         u    !&lt; Input: velocity
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge     !&lt; Input: thickness at edge
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-         tracers     !&lt; Input: tracers
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: Error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: err1, err2, err3
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      call ocn_tracer_hadv2_tend(grid, u, h_edge, tracers, tend, err1)
-      call ocn_tracer_hadv3_tend(grid, u, h_edge, tracers, tend, err2)
-      call ocn_tracer_hadv4_tend(grid, u, h_edge, tracers, tend, err3)
-
-      err = err1 .or. err2 .or. err3
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hadv_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hadv_init
-!
-!&gt; \brief   Initializes ocean tracer horizontal advection quantities
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  horizontal velocity advection in the ocean. Since a variety of 
-!&gt;  parameterizations are available, this routine primarily calls the
-!&gt;  individual init routines for each parameterization. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hadv_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: Error flag
-
-      integer :: err1, err2, err3
-
-      call ocn_tracer_hadv2_init(err1)
-      call ocn_tracer_hadv3_init(err2)
-      call ocn_tracer_hadv4_init(err3)
-
-      err = err1 .or. err2 .or. err3
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hadv_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_hadv
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmetho=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,180 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_hadv
+!
+!&gt; \brief MPAS ocean horizontal tracer advection driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  horizontal advection tendencies.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_hadv
+
+   use mpas_grid_types
+   use mpas_configure
+
+   use ocn_tracer_hadv2
+   use ocn_tracer_hadv3
+   use ocn_tracer_hadv4
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_hadv_tend, &amp;
+             ocn_tracer_hadv_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hadv_tend
+!
+!&gt; \brief   Computes tendency term for horizontal tracer advection
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the horizontal advection tendency for tracer
+!&gt;  based on current state and user choices of advection parameterization.
+!&gt;  Multiple parameterizations may be chosen and added together.  These
+!&gt;  tendencies are generally computed by calling the specific routine
+!&gt;  for the chosen parameterization, so this routine is primarily a
+!&gt;  driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hadv_tend(grid, u, h_edge, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         u    !&lt; Input: velocity
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge     !&lt; Input: thickness at edge
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+         tracers     !&lt; Input: tracers
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: Error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: err1, err2, err3
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      call ocn_tracer_hadv2_tend(grid, u, h_edge, tracers, tend, err1)
+      call ocn_tracer_hadv3_tend(grid, u, h_edge, tracers, tend, err2)
+      call ocn_tracer_hadv4_tend(grid, u, h_edge, tracers, tend, err3)
+
+      err = err1 .or. err2 .or. err3
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hadv_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hadv_init
+!
+!&gt; \brief   Initializes ocean tracer horizontal advection quantities
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  horizontal velocity advection in the ocean. Since a variety of 
+!&gt;  parameterizations are available, this routine primarily calls the
+!&gt;  individual init routines for each parameterization. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hadv_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: Error flag
+
+      integer :: err1, err2, err3
+
+      call ocn_tracer_hadv2_init(err1)
+      call ocn_tracer_hadv3_init(err2)
+      call ocn_tracer_hadv4_init(err3)
+
+      err = err1 .or. err2 .or. err3
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hadv_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_hadv
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmetho=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv2.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv2.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv2.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,200 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_hadv2
-!
-!&gt; \brief MPAS ocean horizontal tracer advection 2nd order
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  horizontal advection tendencies.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_hadv2
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_hadv2_tend, &amp;
-             ocn_tracer_hadv2_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: hadv2On !&lt; Flag to turn on/off 2nd order hadv
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hadv2_tend
-!
-!&gt; \brief   Computes tendency term for horizontal tracer advection 2nd order
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the horizontal advection tendency for tracer
-!&gt;  based on current state using a 2nd order formulation.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hadv2_tend(grid, u, h_edge, tracers , tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         u    !&lt; Input: tracer
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge     !&lt; Input: thickness at edge
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-        tracers     !&lt; Input: tracers
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: tracer tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: Error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdges, cell1, cell2, iTracer, num_tracers, k
-
-      integer, dimension(:), pointer :: maxLevelEdgeTop
-      integer, dimension(:,:), pointer :: cellsOnEdge
-
-      real (kind=RKIND) :: flux, tracer_edge
-
-      real (kind=RKIND), dimension(:), pointer :: dvEdge, areaCell
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not.hadv2On) return
-
-      call timer_start(&quot;compute_scalar_tend-horiz adv 2&quot;)
-
-      nEdges = grid % nEdges
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      dvEdge =&gt; grid % dvEdge % array
-      areaCell =&gt; grid % areaCell % array
-      num_tracers = size(tracers, 1)
-
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=1,maxLevelEdgeTop(iEdge)
-            do iTracer=1,num_tracers
-               tracer_edge = 0.5 * (tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))
-               flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge) * tracer_edge
-               tend(iTracer,k,cell1) = tend(iTracer,k,cell1) - flux/areaCell(cell1)
-               tend(iTracer,k,cell2) = tend(iTracer,k,cell2) + flux/areaCell(cell2)
-            end do
-         end do
-      end do
-
-      call timer_stop(&quot;compute_scalar_tend-horiz adv 2&quot;)
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hadv2_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hadv2_init
-!
-!&gt; \brief   Initializes ocean tracer horizontal advection quantities
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  2nd order horizontal tracer advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hadv2_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: Error flag
-
-      err = 0
-      hadv2On = .false.
-
-      if (config_tracer_adv_order == 2) then
-          hadv2On = .true.
-      end if
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hadv2_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_hadv2
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv2.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv2.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv2.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv2.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,200 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_hadv2
+!
+!&gt; \brief MPAS ocean horizontal tracer advection 2nd order
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  horizontal advection tendencies.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_hadv2
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_hadv2_tend, &amp;
+             ocn_tracer_hadv2_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: hadv2On !&lt; Flag to turn on/off 2nd order hadv
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hadv2_tend
+!
+!&gt; \brief   Computes tendency term for horizontal tracer advection 2nd order
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the horizontal advection tendency for tracer
+!&gt;  based on current state using a 2nd order formulation.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hadv2_tend(grid, u, h_edge, tracers , tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         u    !&lt; Input: tracer
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge     !&lt; Input: thickness at edge
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+        tracers     !&lt; Input: tracers
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: tracer tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: Error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdges, cell1, cell2, iTracer, num_tracers, k
+
+      integer, dimension(:), pointer :: maxLevelEdgeTop
+      integer, dimension(:,:), pointer :: cellsOnEdge
+
+      real (kind=RKIND) :: flux, tracer_edge
+
+      real (kind=RKIND), dimension(:), pointer :: dvEdge, areaCell
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not.hadv2On) return
+
+      call mpas_timer_start(&quot;compute_scalar_tend-horiz adv 2&quot;)
+
+      nEdges = grid % nEdges
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      dvEdge =&gt; grid % dvEdge % array
+      areaCell =&gt; grid % areaCell % array
+      num_tracers = size(tracers, 1)
+
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         do k=1,maxLevelEdgeTop(iEdge)
+            do iTracer=1,num_tracers
+               tracer_edge = 0.5 * (tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))
+               flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge) * tracer_edge
+               tend(iTracer,k,cell1) = tend(iTracer,k,cell1) - flux/areaCell(cell1)
+               tend(iTracer,k,cell2) = tend(iTracer,k,cell2) + flux/areaCell(cell2)
+            end do
+         end do
+      end do
+
+      call mpas_timer_stop(&quot;compute_scalar_tend-horiz adv 2&quot;)
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hadv2_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hadv2_init
+!
+!&gt; \brief   Initializes ocean tracer horizontal advection quantities
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  2nd order horizontal tracer advection in the ocean.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hadv2_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: Error flag
+
+      err = 0
+      hadv2On = .false.
+
+      if (config_tracer_adv_order == 2) then
+          hadv2On = .true.
+      end if
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hadv2_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_hadv2
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv3.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv3.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv3.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,248 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_hadv3
-!
-!&gt; \brief MPAS ocean horizontal tracer advection 3rd order
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  horizontal advection tendencies.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_hadv3
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_hadv3_tend, &amp;
-             ocn_tracer_hadv3_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: hadv3On !&lt; Flag to turn on/off 3rd order hadv
-   real (kind=RKIND) :: coef_3rd_order !&lt; Coefficient for 3rd order hadv
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hadv3_tend
-!
-!&gt; \brief   Computes tendency term for horizontal tracer advection 3rd order
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the horizontal advection tendency for tracer
-!&gt;  based on current state using a 3rd order formulation.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hadv3_tend(grid, u, h_edge, tracers , tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         u    !&lt; Input: tracer
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge     !&lt; Input: thickness at edge
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-        tracers     !&lt; Input: tracers
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: tracer tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdges, cell1, cell2, iTracer, num_tracers, i, k
-
-      integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnCell
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnCell, &amp;
-                                          boundaryCell
-
-      real (kind=RKIND) :: flux, tracer_edge, d2fdx2_cell1, d2fdx2_cell2
-
-      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not.hadv3On) return
-
-      nEdges = grid % nEdges
-      num_tracers = size(tracers, dim=1)
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-      nEdgesOnCell =&gt; grid % nEdgesOnCell % array
-      boundaryCell =&gt; grid % boundaryCell % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      cellsOnCell =&gt; grid % cellsOnCell % array
-      dvEdge =&gt; grid % dvEdge % array
-      dcEdge =&gt; grid % dcEdge % array
-      areaCell =&gt; grid % areaCell % array
-      deriv_two =&gt; grid % deriv_two % array
-
-      call timer_start(&quot;compute_scalar_tend-horiz adv 3&quot;)
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         do k=1,maxLevelEdgeTop(iEdge)
-
-            d2fdx2_cell1 = 0.0
-            d2fdx2_cell2 = 0.0
-
-            do iTracer=1,num_tracers
-
-               !-- if not a boundary cell
-               if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
-
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * tracers(iTracer,k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * tracers(iTracer,k,cell2)
-
-                  !-- all edges of cell 1
-                  do i=1,nEdgesOnCell(cell1)
-                     d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                     deriv_two(i+1,1,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell1))
-                  end do
-
-                  !-- all edges of cell 2
-                  do i=1,nEdgesOnCell(cell2)
-                     d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                     deriv_two(i+1,2,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell2))
-                  end do
-
-               endif
-
-               !-- if u &gt; 0:
-               if (u(k,iEdge) &gt; 0) then
-                  flux = dvEdge(iEdge) * u(k,iEdge) * h_edge(k,iEdge) * (          &amp;
-                       0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))      &amp;
-                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                       -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-               !-- else u &lt;= 0:
-               else
-                  flux = dvEdge(iEdge) *  u(k,iEdge) * h_edge(k,iEdge) * (          &amp;
-                       0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))      &amp;
-                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                       +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-               end if
-
-               !-- update tendency
-               tend(iTracer,k,cell1) = tend(iTracer,k,cell1) - flux/areaCell(cell1)
-               tend(iTracer,k,cell2) = tend(iTracer,k,cell2) + flux/areaCell(cell2)
-            enddo
-         end do
-      end do
-      call timer_stop(&quot;compute_scalar_tend-horiz adv 3&quot;)
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hadv3_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hadv3_init
-!
-!&gt; \brief   Initializes ocean tracer horizontal advection quantities
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  3rd order horizontal tracer advection in the ocean. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hadv3_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-      hadv3On = .false.
-
-      if (config_tracer_adv_order == 3) then
-          hadv3On = .true.
-
-          coef_3rd_order = 1.0
-          if (config_monotonic) coef_3rd_order = 0.25
-      end if
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hadv3_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_hadv3
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv3.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv3.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv3.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv3.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,248 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_hadv3
+!
+!&gt; \brief MPAS ocean horizontal tracer advection 3rd order
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  horizontal advection tendencies.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_hadv3
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_hadv3_tend, &amp;
+             ocn_tracer_hadv3_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: hadv3On !&lt; Flag to turn on/off 3rd order hadv
+   real (kind=RKIND) :: coef_3rd_order !&lt; Coefficient for 3rd order hadv
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hadv3_tend
+!
+!&gt; \brief   Computes tendency term for horizontal tracer advection 3rd order
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the horizontal advection tendency for tracer
+!&gt;  based on current state using a 3rd order formulation.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hadv3_tend(grid, u, h_edge, tracers , tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         u    !&lt; Input: tracer
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge     !&lt; Input: thickness at edge
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+        tracers     !&lt; Input: tracers
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: tracer tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdges, cell1, cell2, iTracer, num_tracers, i, k
+
+      integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnCell
+      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnCell, &amp;
+                                          boundaryCell
+
+      real (kind=RKIND) :: flux, tracer_edge, d2fdx2_cell1, d2fdx2_cell2
+
+      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
+      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not.hadv3On) return
+
+      nEdges = grid % nEdges
+      num_tracers = size(tracers, dim=1)
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+      nEdgesOnCell =&gt; grid % nEdgesOnCell % array
+      boundaryCell =&gt; grid % boundaryCell % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      cellsOnCell =&gt; grid % cellsOnCell % array
+      dvEdge =&gt; grid % dvEdge % array
+      dcEdge =&gt; grid % dcEdge % array
+      areaCell =&gt; grid % areaCell % array
+      deriv_two =&gt; grid % deriv_two % array
+
+      call mpas_timer_start(&quot;compute_scalar_tend-horiz adv 3&quot;)
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+
+         do k=1,maxLevelEdgeTop(iEdge)
+
+            d2fdx2_cell1 = 0.0
+            d2fdx2_cell2 = 0.0
+
+            do iTracer=1,num_tracers
+
+               !-- if not a boundary cell
+               if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
+
+                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * tracers(iTracer,k,cell1)
+                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * tracers(iTracer,k,cell2)
+
+                  !-- all edges of cell 1
+                  do i=1,nEdgesOnCell(cell1)
+                     d2fdx2_cell1 = d2fdx2_cell1 + &amp;
+                     deriv_two(i+1,1,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell1))
+                  end do
+
+                  !-- all edges of cell 2
+                  do i=1,nEdgesOnCell(cell2)
+                     d2fdx2_cell2 = d2fdx2_cell2 + &amp;
+                     deriv_two(i+1,2,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell2))
+                  end do
+
+               endif
+
+               !-- if u &gt; 0:
+               if (u(k,iEdge) &gt; 0) then
+                  flux = dvEdge(iEdge) * u(k,iEdge) * h_edge(k,iEdge) * (          &amp;
+                       0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))      &amp;
+                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
+                       -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
+               !-- else u &lt;= 0:
+               else
+                  flux = dvEdge(iEdge) *  u(k,iEdge) * h_edge(k,iEdge) * (          &amp;
+                       0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))      &amp;
+                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
+                       +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
+               end if
+
+               !-- update tendency
+               tend(iTracer,k,cell1) = tend(iTracer,k,cell1) - flux/areaCell(cell1)
+               tend(iTracer,k,cell2) = tend(iTracer,k,cell2) + flux/areaCell(cell2)
+            enddo
+         end do
+      end do
+      call mpas_timer_stop(&quot;compute_scalar_tend-horiz adv 3&quot;)
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hadv3_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hadv3_init
+!
+!&gt; \brief   Initializes ocean tracer horizontal advection quantities
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  3rd order horizontal tracer advection in the ocean. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hadv3_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+      hadv3On = .false.
+
+      if (config_tracer_adv_order == 3) then
+          hadv3On = .true.
+
+          coef_3rd_order = 1.0
+          if (config_monotonic) coef_3rd_order = 0.25
+      end if
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hadv3_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_hadv3
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv4.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv4.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv4.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,233 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_hadv4
-!
-!&gt; \brief MPAS ocean horizontal tracer advection 4th order
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  horizontal advection tendencies.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_hadv4
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_hadv4_tend, &amp;
-             ocn_tracer_hadv4_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: hadv4On !&lt; Flag to turning on/off 4th order hadv
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hadv4_tend
-!
-!&gt; \brief   Computes tendency term for horizontal tracer advection 4th order
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the horizontal advection tendency for tracer
-!&gt;  based on current state using a 4th order formulation.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hadv4_tend(grid, u, h_edge, tracers , tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         u    !&lt; Input: tracer
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge     !&lt; Input: thickness at edge
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-        tracers     !&lt; Input: tracers
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: tracer tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdges, cell1, cell2, iTracer, num_tracers, i, k
-
-      integer, dimension(:), pointer :: maxLevelEdgeTop
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnCell, boundaryCell
-
-      real (kind=RKIND) :: flux, tracer_edge, d2fdx2_cell1, d2fdx2_cell2
-
-      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not.hadv4On) return
-
-      nEdges = grid % nEdges
-      num_tracers = size(tracers, dim=1)
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-      boundaryCell =&gt; grid % boundaryCell % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      cellsOnCell =&gt; grid % cellsOnCell % array
-      dvEdge =&gt; grid % dvEdge % array
-      dcEdge =&gt; grid % dcEdge % array
-      areaCell =&gt; grid % areaCell % array
-      deriv_two =&gt; grid % deriv_two % array
-
-      call timer_start(&quot;compute_scalar_tend-horiz adv 4&quot;)
-
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         do k=1,maxLevelEdgeTop(iEdge)
-
-            d2fdx2_cell1 = 0.0
-            d2fdx2_cell2 = 0.0
-
-            do iTracer=1,num_tracers
-
-               !-- if not a boundary cell
-               if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
-
-                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * tracers(iTracer,k,cell1)
-                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * tracers(iTracer,k,cell2)
-
-                  !-- all edges of cell 1
-                  do i=1, grid % nEdgesOnCell % array (cell1)
-                     d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                     deriv_two(i+1,1,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell1))
-                  end do
-
-                  !-- all edges of cell 2
-                  do i=1, grid % nEdgesOnCell % array (cell2)
-                      d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                      deriv_two(i+1,2,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell2))
-                  end do
-
-               endif
-
-               flux = dvEdge(iEdge) *  u(k,iEdge) * h_edge(k,iEdge) * (          &amp;
-                    0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))      &amp;
-                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
-
-               !-- update tendency
-               tend(iTracer,k,cell1) = tend(iTracer,k,cell1) - flux/areaCell(cell1)
-               tend(iTracer,k,cell2) = tend(iTracer,k,cell2) + flux/areaCell(cell2)
-            enddo
-         end do
-      end do
-      call timer_stop(&quot;compute_scalar_tend-horiz adv 4&quot;)
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hadv4_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hadv4_init
-!
-!&gt; \brief   Initializes ocean tracer horizontal advection quantities
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes the 4th order formulation for 
-!&gt;  horizontal tracer advection in the ocean. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hadv4_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: Error flag
-
-      err = 0
-      hadv4On = .false.
-
-      if (config_tracer_adv_order == 4) then
-          hadv4On = .true.
-      end if
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hadv4_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_hadv4
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv4.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_hadv4.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv4.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hadv4.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,233 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_hadv4
+!
+!&gt; \brief MPAS ocean horizontal tracer advection 4th order
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  horizontal advection tendencies.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_hadv4
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_hadv4_tend, &amp;
+             ocn_tracer_hadv4_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: hadv4On !&lt; Flag to turning on/off 4th order hadv
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hadv4_tend
+!
+!&gt; \brief   Computes tendency term for horizontal tracer advection 4th order
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the horizontal advection tendency for tracer
+!&gt;  based on current state using a 4th order formulation.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hadv4_tend(grid, u, h_edge, tracers , tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         u    !&lt; Input: tracer
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge     !&lt; Input: thickness at edge
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+        tracers     !&lt; Input: tracers
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: tracer tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdges, cell1, cell2, iTracer, num_tracers, i, k
+
+      integer, dimension(:), pointer :: maxLevelEdgeTop
+      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnCell, boundaryCell
+
+      real (kind=RKIND) :: flux, tracer_edge, d2fdx2_cell1, d2fdx2_cell2
+
+      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
+      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not.hadv4On) return
+
+      nEdges = grid % nEdges
+      num_tracers = size(tracers, dim=1)
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+      boundaryCell =&gt; grid % boundaryCell % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      cellsOnCell =&gt; grid % cellsOnCell % array
+      dvEdge =&gt; grid % dvEdge % array
+      dcEdge =&gt; grid % dcEdge % array
+      areaCell =&gt; grid % areaCell % array
+      deriv_two =&gt; grid % deriv_two % array
+
+      call mpas_timer_start(&quot;compute_scalar_tend-horiz adv 4&quot;)
+
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+
+         do k=1,maxLevelEdgeTop(iEdge)
+
+            d2fdx2_cell1 = 0.0
+            d2fdx2_cell2 = 0.0
+
+            do iTracer=1,num_tracers
+
+               !-- if not a boundary cell
+               if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
+
+                  d2fdx2_cell1 = deriv_two(1,1,iEdge) * tracers(iTracer,k,cell1)
+                  d2fdx2_cell2 = deriv_two(1,2,iEdge) * tracers(iTracer,k,cell2)
+
+                  !-- all edges of cell 1
+                  do i=1, grid % nEdgesOnCell % array (cell1)
+                     d2fdx2_cell1 = d2fdx2_cell1 + &amp;
+                     deriv_two(i+1,1,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell1))
+                  end do
+
+                  !-- all edges of cell 2
+                  do i=1, grid % nEdgesOnCell % array (cell2)
+                      d2fdx2_cell2 = d2fdx2_cell2 + &amp;
+                      deriv_two(i+1,2,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell2))
+                  end do
+
+               endif
+
+               flux = dvEdge(iEdge) *  u(k,iEdge) * h_edge(k,iEdge) * (          &amp;
+                    0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))      &amp;
+                       -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
+
+               !-- update tendency
+               tend(iTracer,k,cell1) = tend(iTracer,k,cell1) - flux/areaCell(cell1)
+               tend(iTracer,k,cell2) = tend(iTracer,k,cell2) + flux/areaCell(cell2)
+            enddo
+         end do
+      end do
+      call mpas_timer_stop(&quot;compute_scalar_tend-horiz adv 4&quot;)
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hadv4_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hadv4_init
+!
+!&gt; \brief   Initializes ocean tracer horizontal advection quantities
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes the 4th order formulation for 
+!&gt;  horizontal tracer advection in the ocean. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hadv4_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: Error flag
+
+      err = 0
+      hadv4On = .false.
+
+      if (config_tracer_adv_order == 4) then
+          hadv4On = .true.
+      end if
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hadv4_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_hadv4
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_hmix.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,174 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_hmix
-!
-!&gt; \brief MPAS ocean horizontal tracer mixing driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   19 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  horizontal mixing tendencies.  
-!&gt;
-!&gt;  It provides an init and a tend function. Each are described below.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_hmix
-
-   use grid_types
-   use configure
-   use ocn_tracer_hmix_del2
-   use ocn_tracer_hmix_del4
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_hmix_tend, &amp;
-             ocn_tracer_hmix_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hmix_tend
-!
-!&gt; \brief   Computes tendency term for horizontal tracer mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the horizontal mixing tendency for tracer
-!&gt;  based on current state and user choices of mixing parameterization.
-!&gt;  Multiple parameterizations may be chosen and added together.  These
-!&gt;  tendencies are generally computed by calling the specific routine
-!&gt;  for the chosen parameterization, so this routine is primarily a
-!&gt;  driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hmix_tend(grid, h_edge, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge    !&lt; Input: thickness at edge
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-        tracers !&lt; Input: tracer quantities
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: err1, err2
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      call ocn_tracer_hmix_del2_tend(grid, h_edge, tracers, tend, err1)
-      call ocn_tracer_hmix_del4_tend(grid, h_edge, tracers, tend, err2)
-
-      err = err1 .or. err2
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hmix_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hmix_init
-!
-!&gt; \brief   Initializes ocean tracer horizontal mixing quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  horizontal velocity mixing in the ocean. Since a variety of 
-!&gt;  parameterizations are available, this routine primarily calls the
-!&gt;  individual init routines for each parameterization. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hmix_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      integer :: err1, err2
-
-      call ocn_tracer_hmix_del2_init(err1)
-      call ocn_tracer_hmix_del4_init(err2)
-
-      err = err1 .or. err2
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hmix_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_hmix
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_hmix.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,174 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_hmix
+!
+!&gt; \brief MPAS ocean horizontal tracer mixing driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   19 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  horizontal mixing tendencies.  
+!&gt;
+!&gt;  It provides an init and a tend function. Each are described below.
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_hmix
+
+   use mpas_grid_types
+   use mpas_configure
+   use ocn_tracer_hmix_del2
+   use ocn_tracer_hmix_del4
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_hmix_tend, &amp;
+             ocn_tracer_hmix_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hmix_tend
+!
+!&gt; \brief   Computes tendency term for horizontal tracer mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the horizontal mixing tendency for tracer
+!&gt;  based on current state and user choices of mixing parameterization.
+!&gt;  Multiple parameterizations may be chosen and added together.  These
+!&gt;  tendencies are generally computed by calling the specific routine
+!&gt;  for the chosen parameterization, so this routine is primarily a
+!&gt;  driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hmix_tend(grid, h_edge, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge    !&lt; Input: thickness at edge
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+        tracers !&lt; Input: tracer quantities
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: err1, err2
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      call ocn_tracer_hmix_del2_tend(grid, h_edge, tracers, tend, err1)
+      call ocn_tracer_hmix_del4_tend(grid, h_edge, tracers, tend, err2)
+
+      err = err1 .or. err2
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hmix_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hmix_init
+!
+!&gt; \brief   Initializes ocean tracer horizontal mixing quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  horizontal velocity mixing in the ocean. Since a variety of 
+!&gt;  parameterizations are available, this routine primarily calls the
+!&gt;  individual init routines for each parameterization. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hmix_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      integer :: err1, err2
+
+      call ocn_tracer_hmix_del2_init(err1)
+      call ocn_tracer_hmix_del4_init(err2)
+
+      err = err1 .or. err2
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hmix_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_hmix
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix_del2.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_hmix_del2.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix_del2.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,232 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_hmix_del2
-!
-!&gt; \brief MPAS ocean horizontal tracer mixing driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   19 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  horizontal mixing tendencies.  
-!&gt;
-!&gt;  It provides an init and a tend function. Each are described below.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_hmix_del2
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_hmix_del2_tend, &amp;
-             ocn_tracer_hmix_del2_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: del2On
-
-   real (kind=RKIND) :: eddyDiff2
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hmix_del2_tend
-!
-!&gt; \brief   Computes laplacian tendency term for horizontal tracer mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the horizontal mixing tendency for tracers
-!&gt;  based on current state using a laplacian parameterization.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hmix_del2_tend(grid, h_edge, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge    !&lt; Input: thickness at edge
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-        tracers !&lt; Input: tracer quantities
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdges, nVertLevels, cell1, cell2
-      integer :: k, iTracer, num_tracers
-
-      integer, dimension(:,:), allocatable :: boundaryMask
-
-      integer, dimension(:), pointer :: maxLevelEdgeTop
-      integer, dimension(:,:), pointer :: cellsOnEdge, boundaryEdge
-
-      real (kind=RKIND) :: invAreaCell1, invAreaCell2
-      real (kind=RKIND) :: tracer_turb_flux, flux
-
-      real (kind=RKIND), dimension(:), pointer :: areaCell, dvEdge, dcEdge
-      real (kind=RKIND), dimension(:), pointer :: meshScalingDel2
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if (.not.del2On) return
-
-      call timer_start(&quot;compute_scalar_tend-horiz diff 2&quot;)
-
-      nEdges = grid % nEdges
-      nVertLevels = grid % nVertLevels
-      num_tracers = size(tracers, dim=1)
-
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      boundaryEdge =&gt; grid % boundaryEdge % array
-      areaCell =&gt; grid % areaCell % array
-      dvEdge =&gt; grid % dvEdge % array
-      dcEdge =&gt; grid % dcEdge % array
-      meshScalingDel2 =&gt; grid % meshScalingDel2 % array
-
-      !
-      ! compute a boundary mask to enforce insulating boundary conditions in the horizontal
-      !
-      allocate(boundaryMask(nVertLevels, nEdges+1))
-      boundaryMask = 1.0
-      where(boundaryEdge.eq.1) boundaryMask=0.0
-
-      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)
-           do iTracer=1,num_tracers
-              ! \kappa_2 </font>
<font color="red">abla \phi on edge
-              tracer_turb_flux = meshScalingDel2(iEdge) * eddyDiff2 &amp;
-                 *(  tracers(iTracer,k,cell2) &amp;
-                   - tracers(iTracer,k,cell1))/dcEdge(iEdge)
-
-              ! div(h \kappa_2 </font>
<font color="gray">abla \phi) at cell center
-              flux = dvEdge (iEdge) * h_edge(k,iEdge) &amp;
-                 * tracer_turb_flux * boundaryMask(k, iEdge)
-              tend(iTracer,k,cell1) = tend(iTracer,k,cell1) + flux * invAreaCell1
-              tend(iTracer,k,cell2) = tend(iTracer,k,cell2) - flux * invAreaCell2
-           end do
-         end do
-
-      end do
-
-      deallocate(boundaryMask)
-      call timer_stop(&quot;compute_scalar_tend-horiz diff 2&quot;)
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hmix_del2_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hmix_del2_init
-!
-!&gt; \brief   Initializes ocean tracer horizontal mixing quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  laplacian horizontal velocity mixing in the ocean. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hmix_del2_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-
-      del2on = .false.
-
-      if ( config_h_tracer_eddy_diff2 &gt; 0.0 ) then
-          del2On = .true.
-          eddyDiff2 = config_h_tracer_eddy_diff2
-      endif
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hmix_del2_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_hmix_del2
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix_del2.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_hmix_del2.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix_del2.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix_del2.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,232 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_hmix_del2
+!
+!&gt; \brief MPAS ocean horizontal tracer mixing driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   19 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  horizontal mixing tendencies.  
+!&gt;
+!&gt;  It provides an init and a tend function. Each are described below.
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_hmix_del2
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_hmix_del2_tend, &amp;
+             ocn_tracer_hmix_del2_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: del2On
+
+   real (kind=RKIND) :: eddyDiff2
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hmix_del2_tend
+!
+!&gt; \brief   Computes laplacian tendency term for horizontal tracer mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the horizontal mixing tendency for tracers
+!&gt;  based on current state using a laplacian parameterization.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hmix_del2_tend(grid, h_edge, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge    !&lt; Input: thickness at edge
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+        tracers !&lt; Input: tracer quantities
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdges, nVertLevels, cell1, cell2
+      integer :: k, iTracer, num_tracers
+
+      integer, dimension(:,:), allocatable :: boundaryMask
+
+      integer, dimension(:), pointer :: maxLevelEdgeTop
+      integer, dimension(:,:), pointer :: cellsOnEdge, boundaryEdge
+
+      real (kind=RKIND) :: invAreaCell1, invAreaCell2
+      real (kind=RKIND) :: tracer_turb_flux, flux
+
+      real (kind=RKIND), dimension(:), pointer :: areaCell, dvEdge, dcEdge
+      real (kind=RKIND), dimension(:), pointer :: meshScalingDel2
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if (.not.del2On) return
+
+      call mpas_timer_start(&quot;compute_scalar_tend-horiz diff 2&quot;)
+
+      nEdges = grid % nEdges
+      nVertLevels = grid % nVertLevels
+      num_tracers = size(tracers, dim=1)
+
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      boundaryEdge =&gt; grid % boundaryEdge % array
+      areaCell =&gt; grid % areaCell % array
+      dvEdge =&gt; grid % dvEdge % array
+      dcEdge =&gt; grid % dcEdge % array
+      meshScalingDel2 =&gt; grid % meshScalingDel2 % array
+
+      !
+      ! compute a boundary mask to enforce insulating boundary conditions in the horizontal
+      !
+      allocate(boundaryMask(nVertLevels, nEdges+1))
+      boundaryMask = 1.0
+      where(boundaryEdge.eq.1) boundaryMask=0.0
+
+      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)
+           do iTracer=1,num_tracers
+              ! \kappa_2 </font>
<font color="blue">abla \phi on edge
+              tracer_turb_flux = meshScalingDel2(iEdge) * eddyDiff2 &amp;
+                 *(  tracers(iTracer,k,cell2) &amp;
+                   - tracers(iTracer,k,cell1))/dcEdge(iEdge)
+
+              ! div(h \kappa_2 </font>
<font color="gray">abla \phi) at cell center
+              flux = dvEdge (iEdge) * h_edge(k,iEdge) &amp;
+                 * tracer_turb_flux * boundaryMask(k, iEdge)
+              tend(iTracer,k,cell1) = tend(iTracer,k,cell1) + flux * invAreaCell1
+              tend(iTracer,k,cell2) = tend(iTracer,k,cell2) - flux * invAreaCell2
+           end do
+         end do
+
+      end do
+
+      deallocate(boundaryMask)
+      call mpas_timer_stop(&quot;compute_scalar_tend-horiz diff 2&quot;)
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hmix_del2_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hmix_del2_init
+!
+!&gt; \brief   Initializes ocean tracer horizontal mixing quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  laplacian horizontal velocity mixing in the ocean. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hmix_del2_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+
+      del2on = .false.
+
+      if ( config_h_tracer_eddy_diff2 &gt; 0.0 ) then
+          del2On = .true.
+          eddyDiff2 = config_h_tracer_eddy_diff2
+      endif
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hmix_del2_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_hmix_del2
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix_del4.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_hmix_del4.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix_del4.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,263 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_hmix_del4
-!
-!&gt; \brief MPAS ocean horizontal tracer mixing driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   19 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  horizontal mixing tendencies.  
-!&gt;
-!&gt;  It provides an init and a tend function. Each are described below.
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_hmix_del4
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_hmix_del4_tend, &amp;
-             ocn_tracer_hmix_del4_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: Del4On
-
-   real (kind=RKIND) :: eddyDiff4
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hmix_del4_tend
-!
-!&gt; \brief   Computes biharmonic tendency term for horizontal tracer mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the horizontal mixing tendency for tracers
-!&gt;  based on current state using a biharmonic parameterization.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hmix_del4_tend(grid, h_edge, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge    !&lt; Input: thickness at edge
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-        tracers !&lt; Input: tracer quantities
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdges, num_tracers, nVertLevels, nCells
-      integer :: iTracer, k, iCell, cell1, cell2
-
-      integer, dimension(:,:), allocatable :: boundaryMask
-
-      integer, dimension(:), pointer :: maxLevelEdgeTop, maxLevelCell
-      integer, dimension(:,:), pointer :: boundaryEdge, cellsOnEdge
-
-      real (kind=RKIND) :: invAreaCell1, invAreaCell2, r, tracer_turb_flux, flux
-
-      real (kind=RKIND), dimension(:,:,:), allocatable :: delsq_tracer
-
-      real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, areaCell, meshScalingDel4
-
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if (.not.Del4On) return
-
-      call timer_start(&quot;compute_scalar_tend-horiz diff 4&quot;)
-
-      nEdges = grid % nEdges
-      nCells = grid % nCells
-      num_tracers = size(tracers, dim=1)
-      nVertLevels = grid % nVertLevels
-
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-      maxLevelCell =&gt; grid % maxLevelCell % array
-      boundaryEdge =&gt; grid % boundaryEdge % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-
-      dcEdge =&gt; grid % dcEdge % array
-      dvEdge =&gt; grid % dvEdge % array
-      areaCell =&gt; grid % areaCell % array
-      meshScalingDel4 =&gt; grid % meshScalingDel4 % array
-
-      allocate(boundaryMask(nVertLevels, nEdges+1))
-      boundaryMask = 1.0
-      where(boundaryEdge.eq.1) boundaryMask=0.0
-
-      allocate(delsq_tracer(num_tracers,nVertLevels, nCells+1))
-
-      delsq_tracer(:,:,:) = 0.
-
-      ! first del2: div(h </font>
<font color="red">abla \phi) at cell center
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         do k=1,maxLevelEdgeTop(iEdge)
-           do iTracer=1,num_tracers
-              delsq_tracer(iTracer,k,cell1) = delsq_tracer(iTracer,k,cell1) &amp;
-                 + dvEdge(iEdge)*h_edge(k,iEdge) &amp;
-                   *(tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) &amp;
-                   /dcEdge(iEdge) * boundaryMask(k,iEdge)
-              delsq_tracer(iTracer,k,cell2) = delsq_tracer(iTracer,k,cell2) &amp;
-                 - dvEdge(iEdge)*h_edge(k,iEdge) &amp;
-                 *(tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) &amp;
-                 /dcEdge(iEdge) * boundaryMask(k,iEdge)
-           end do
-         end do
-      end do
-
-      do iCell = 1,nCells
-         r = 1.0 / areaCell(iCell)
-         do k=1,maxLevelCell(iCell)
-            do iTracer=1,num_tracers
-               delsq_tracer(iTracer,k,iCell) = delsq_tracer(iTracer,k,iCell) * r
-            end do
-         end do
-      end do
-
-      ! second del2: div(h </font>
<font color="gray">abla [delsq_tracer]) at cell center
-      do iEdge=1,grid % nEdges
-         cell1 = grid % cellsOnEdge % array(1,iEdge)
-         cell2 = grid % cellsOnEdge % array(2,iEdge)
-         invAreaCell1 = 1.0 / areaCell(cell1)
-         invAreaCell2 = 1.0 / areaCell(cell2)
-
-         do k=1,maxLevelEdgeTop(iEdge)
-            do iTracer=1,num_tracers
-               tracer_turb_flux = meshScalingDel4(iEdge) * eddyDiff4 &amp;
-                  *(  delsq_tracer(iTracer,k,cell2)  &amp;
-                    - delsq_tracer(iTracer,k,cell1))/dcEdge(iEdge)
-               flux = dvEdge (iEdge) * tracer_turb_flux
-
-               tend(iTracer,k,cell1) = tend(iTracer,k,cell1) &amp; 
-                  - flux * invAreaCell1 * boundaryMask(k,iEdge)
-               tend(iTracer,k,cell2) = tend(iTracer,k,cell2) &amp;
-                  + flux * invAreaCell2 * boundaryMask(k,iEdge)
-
-            enddo
-         enddo
-      end do
-
-      deallocate(delsq_tracer)
-      call timer_stop(&quot;compute_scalar_tend-horiz diff 4&quot;)
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hmix_del4_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_hmix_del4_init
-!
-!&gt; \brief   Initializes ocean tracer horizontal mixing quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  biharmonic horizontal velocity mixing in the ocean. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_hmix_del4_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-      Del4on = .false.
-
-      if ( config_h_tracer_eddy_diff4 &gt; 0.0 ) then
-          Del4On = .true.
-          eddyDiff4 = config_h_tracer_eddy_diff4
-      endif
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_hmix_del4_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_hmix_del4
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix_del4.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_hmix_del4.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix_del4.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_hmix_del4.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,263 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_hmix_del4
+!
+!&gt; \brief MPAS ocean horizontal tracer mixing driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   19 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  horizontal mixing tendencies.  
+!&gt;
+!&gt;  It provides an init and a tend function. Each are described below.
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_hmix_del4
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_hmix_del4_tend, &amp;
+             ocn_tracer_hmix_del4_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: Del4On
+
+   real (kind=RKIND) :: eddyDiff4
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hmix_del4_tend
+!
+!&gt; \brief   Computes biharmonic tendency term for horizontal tracer mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the horizontal mixing tendency for tracers
+!&gt;  based on current state using a biharmonic parameterization.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hmix_del4_tend(grid, h_edge, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge    !&lt; Input: thickness at edge
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+        tracers !&lt; Input: tracer quantities
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdges, num_tracers, nVertLevels, nCells
+      integer :: iTracer, k, iCell, cell1, cell2
+
+      integer, dimension(:,:), allocatable :: boundaryMask
+
+      integer, dimension(:), pointer :: maxLevelEdgeTop, maxLevelCell
+      integer, dimension(:,:), pointer :: boundaryEdge, cellsOnEdge
+
+      real (kind=RKIND) :: invAreaCell1, invAreaCell2, r, tracer_turb_flux, flux
+
+      real (kind=RKIND), dimension(:,:,:), allocatable :: delsq_tracer
+
+      real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, areaCell, meshScalingDel4
+
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if (.not.Del4On) return
+
+      call mpas_timer_start(&quot;compute_scalar_tend-horiz diff 4&quot;)
+
+      nEdges = grid % nEdges
+      nCells = grid % nCells
+      num_tracers = size(tracers, dim=1)
+      nVertLevels = grid % nVertLevels
+
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+      maxLevelCell =&gt; grid % maxLevelCell % array
+      boundaryEdge =&gt; grid % boundaryEdge % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+
+      dcEdge =&gt; grid % dcEdge % array
+      dvEdge =&gt; grid % dvEdge % array
+      areaCell =&gt; grid % areaCell % array
+      meshScalingDel4 =&gt; grid % meshScalingDel4 % array
+
+      allocate(boundaryMask(nVertLevels, nEdges+1))
+      boundaryMask = 1.0
+      where(boundaryEdge.eq.1) boundaryMask=0.0
+
+      allocate(delsq_tracer(num_tracers,nVertLevels, nCells+1))
+
+      delsq_tracer(:,:,:) = 0.
+
+      ! first del2: div(h </font>
<font color="blue">abla \phi) at cell center
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+
+         do k=1,maxLevelEdgeTop(iEdge)
+           do iTracer=1,num_tracers
+              delsq_tracer(iTracer,k,cell1) = delsq_tracer(iTracer,k,cell1) &amp;
+                 + dvEdge(iEdge)*h_edge(k,iEdge) &amp;
+                   *(tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) &amp;
+                   /dcEdge(iEdge) * boundaryMask(k,iEdge)
+              delsq_tracer(iTracer,k,cell2) = delsq_tracer(iTracer,k,cell2) &amp;
+                 - dvEdge(iEdge)*h_edge(k,iEdge) &amp;
+                 *(tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) &amp;
+                 /dcEdge(iEdge) * boundaryMask(k,iEdge)
+           end do
+         end do
+      end do
+
+      do iCell = 1,nCells
+         r = 1.0 / areaCell(iCell)
+         do k=1,maxLevelCell(iCell)
+            do iTracer=1,num_tracers
+               delsq_tracer(iTracer,k,iCell) = delsq_tracer(iTracer,k,iCell) * r
+            end do
+         end do
+      end do
+
+      ! second del2: div(h </font>
<font color="gray">abla [delsq_tracer]) at cell center
+      do iEdge=1,grid % nEdges
+         cell1 = grid % cellsOnEdge % array(1,iEdge)
+         cell2 = grid % cellsOnEdge % array(2,iEdge)
+         invAreaCell1 = 1.0 / areaCell(cell1)
+         invAreaCell2 = 1.0 / areaCell(cell2)
+
+         do k=1,maxLevelEdgeTop(iEdge)
+            do iTracer=1,num_tracers
+               tracer_turb_flux = meshScalingDel4(iEdge) * eddyDiff4 &amp;
+                  *(  delsq_tracer(iTracer,k,cell2)  &amp;
+                    - delsq_tracer(iTracer,k,cell1))/dcEdge(iEdge)
+               flux = dvEdge (iEdge) * tracer_turb_flux
+
+               tend(iTracer,k,cell1) = tend(iTracer,k,cell1) &amp; 
+                  - flux * invAreaCell1 * boundaryMask(k,iEdge)
+               tend(iTracer,k,cell2) = tend(iTracer,k,cell2) &amp;
+                  + flux * invAreaCell2 * boundaryMask(k,iEdge)
+
+            enddo
+         enddo
+      end do
+
+      deallocate(delsq_tracer)
+      call mpas_timer_stop(&quot;compute_scalar_tend-horiz diff 4&quot;)
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hmix_del4_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_hmix_del4_init
+!
+!&gt; \brief   Initializes ocean tracer horizontal mixing quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  biharmonic horizontal velocity mixing in the ocean. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_hmix_del4_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+      Del4on = .false.
+
+      if ( config_h_tracer_eddy_diff4 &gt; 0.0 ) then
+          Del4On = .true.
+          eddyDiff4 = config_h_tracer_eddy_diff4
+      endif
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_hmix_del4_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_hmix_del4
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,185 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_vadv
-!
-!&gt; \brief MPAS ocean vertical tracer advection driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  vertical advection tendencies.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv
-
-   use grid_types
-   use configure
-
-   use ocn_tracer_vadv_stencil
-   use ocn_tracer_vadv_spline
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_vadv_tend, &amp;
-             ocn_tracer_vadv_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: vadvOn
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_tend
-!
-!&gt; \brief   Computes tendency term for vertical tracer advection
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical advection tendency for tracer
-!&gt;  based on current state and user choices of advection parameterization.
-!&gt;  Multiple parameterizations may be chosen and added together.  These
-!&gt;  tendencies are generally computed by calling the specific routine
-!&gt;  for the chosen parameterization, so this routine is primarily a
-!&gt;  driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_tend(grid, wTop, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         wTop    !&lt; Input: vertical tracer in top layer
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-         tracers     !&lt; Input: tracers
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: tracer tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: err1, err2
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not.vadvOn) return
-
-      call ocn_tracer_vadv_stencil_tend(grid, wTop, tracers, tend, err1)
-      call ocn_tracer_vadv_spline_tend(grid, wTop, tracers, tend, err2)
-
-      err = err1 .or. err2
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_init
-!
-!&gt; \brief   Initializes ocean tracer vertical advection quantities
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  vertical tracer advection in the ocean. Since a variety of 
-!&gt;  parameterizations are available, this routine primarily calls the
-!&gt;  individual init routines for each parameterization. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      integer :: err1, err2
-
-      vadvOn = .false.
-
-      if (config_vert_grid_type.eq.'zlevel') then
-          vadvOn = .true.
-          call ocn_tracer_vadv_stencil_init(err1)
-          call ocn_tracer_vadv_spline_init(err2)
-
-          err = err1 .or. err2
-      endif
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,185 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_vadv
+!
+!&gt; \brief MPAS ocean vertical tracer advection driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  vertical advection tendencies.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_vadv
+
+   use mpas_grid_types
+   use mpas_configure
+
+   use ocn_tracer_vadv_stencil
+   use ocn_tracer_vadv_spline
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_vadv_tend, &amp;
+             ocn_tracer_vadv_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: vadvOn
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_tend
+!
+!&gt; \brief   Computes tendency term for vertical tracer advection
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical advection tendency for tracer
+!&gt;  based on current state and user choices of advection parameterization.
+!&gt;  Multiple parameterizations may be chosen and added together.  These
+!&gt;  tendencies are generally computed by calling the specific routine
+!&gt;  for the chosen parameterization, so this routine is primarily a
+!&gt;  driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_tend(grid, wTop, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         wTop    !&lt; Input: vertical tracer in top layer
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+         tracers     !&lt; Input: tracers
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: tracer tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: err1, err2
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not.vadvOn) return
+
+      call ocn_tracer_vadv_stencil_tend(grid, wTop, tracers, tend, err1)
+      call ocn_tracer_vadv_spline_tend(grid, wTop, tracers, tend, err2)
+
+      err = err1 .or. err2
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_init
+!
+!&gt; \brief   Initializes ocean tracer vertical advection quantities
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  vertical tracer advection in the ocean. Since a variety of 
+!&gt;  parameterizations are available, this routine primarily calls the
+!&gt;  individual init routines for each parameterization. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      integer :: err1, err2
+
+      vadvOn = .false.
+
+      if (config_vert_grid_type.eq.'zlevel') then
+          vadvOn = .true.
+          call ocn_tracer_vadv_stencil_init(err1)
+          call ocn_tracer_vadv_spline_init(err2)
+
+          err = err1 .or. err2
+      endif
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_vadv
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_spline.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,186 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_vadv_spline
-!
-!&gt; \brief MPAS ocean vertical tracer advection driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  vertical advection tendencies.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_spline
-
-   use grid_types
-   use configure
-
-   use ocn_tracer_vadv_spline2
-   use ocn_tracer_vadv_spline3
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_vadv_spline_tend, &amp;
-             ocn_tracer_vadv_spline_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: splineOn
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_spline_tend
-!
-!&gt; \brief   Computes tendency term for vertical tracer advection
-!&gt; \author  Doug Jacobsen
-!&gt; \date    16 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical advection tendency for tracer
-!&gt;  based on current state and user choices of advection parameterization.
-!&gt;  Multiple parameterizations may be chosen and added together.  These
-!&gt;  tendencies are generally computed by calling the specific routine
-!&gt;  for the chosen parameterization, so this routine is primarily a
-!&gt;  driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_spline_tend(grid, wTop, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         wTop    !&lt; Input: vertical tracer in top layer
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-         tracers     !&lt; Input: tracers
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: tracer tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: err1, err2
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not.splineOn) return
-
-      call ocn_tracer_vadv_spline2_tend(grid, wTop, tracers, tend, err1)
-      call ocn_tracer_vadv_spline3_tend(grid, wTop, tracers, tend, err2)
-
-      err = err1 .or. err2
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_spline_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_spline_init
-!
-!&gt; \brief   Initializes ocean tracer vertical advection quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    16 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  vertical tracer advection in the ocean. Since a variety of 
-!&gt;  parameterizations are available, this routine primarily calls the
-!&gt;  individual init routines for each parameterization. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_spline_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      integer :: err1, err2
-
-      splineOn = .false.
-
-      if(config_vert_tracer_adv.eq.'spline') then
-         splineOn = .true.
-
-         call ocn_tracer_vadv_spline2_init(err1)
-         call ocn_tracer_vadv_spline3_init(err2)
-
-         err = err1 .or. err2
-      endif
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_spline_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_spline
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_spline.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,186 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_vadv_spline
+!
+!&gt; \brief MPAS ocean vertical tracer advection driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  vertical advection tendencies.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_vadv_spline
+
+   use mpas_grid_types
+   use mpas_configure
+
+   use ocn_tracer_vadv_spline2
+   use ocn_tracer_vadv_spline3
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_vadv_spline_tend, &amp;
+             ocn_tracer_vadv_spline_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: splineOn
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_spline_tend
+!
+!&gt; \brief   Computes tendency term for vertical tracer advection
+!&gt; \author  Doug Jacobsen
+!&gt; \date    16 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical advection tendency for tracer
+!&gt;  based on current state and user choices of advection parameterization.
+!&gt;  Multiple parameterizations may be chosen and added together.  These
+!&gt;  tendencies are generally computed by calling the specific routine
+!&gt;  for the chosen parameterization, so this routine is primarily a
+!&gt;  driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_spline_tend(grid, wTop, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         wTop    !&lt; Input: vertical tracer in top layer
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+         tracers     !&lt; Input: tracers
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: tracer tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: err1, err2
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not.splineOn) return
+
+      call ocn_tracer_vadv_spline2_tend(grid, wTop, tracers, tend, err1)
+      call ocn_tracer_vadv_spline3_tend(grid, wTop, tracers, tend, err2)
+
+      err = err1 .or. err2
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_spline_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_spline_init
+!
+!&gt; \brief   Initializes ocean tracer vertical advection quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    16 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  vertical tracer advection in the ocean. Since a variety of 
+!&gt;  parameterizations are available, this routine primarily calls the
+!&gt;  individual init routines for each parameterization. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_spline_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      integer :: err1, err2
+
+      splineOn = .false.
+
+      if(config_vert_tracer_adv.eq.'spline') then
+         splineOn = .true.
+
+         call ocn_tracer_vadv_spline2_init(err1)
+         call ocn_tracer_vadv_spline3_init(err2)
+
+         err = err1 .or. err2
+      endif
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_spline_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_vadv_spline
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,214 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_vadv_spline2
-!
-!&gt; \brief MPAS ocean vertical tracer advection driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  vertical advection tendencies.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_spline2
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_vadv_spline2_tend, &amp;
-             ocn_tracer_vadv_spline2_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: spline2On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_spline2_tend
-!
-!&gt; \brief   Computes tendency term for vertical tracer advection 2nd order spline
-!&gt; \author  Doug Jacobsen
-!&gt; \date    16 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical advection tendency for tracer
-!&gt;  based on current state using a 2nd order spline.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_spline2_tend(grid, wTop, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         wTop    !&lt; Input: vertical tracer in top layer
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-         tracers     !&lt; Input: tracers
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: tracer tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iCell, nCells, nCellsSolve, k, iTracer, num_tracers, nVertLevels
-
-      integer, dimension(:), pointer :: maxLevelCell
-
-      real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, hRatioZLevelKm1
-
-      real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not.spline2On) return
-      ! Compute tracerTop using linear interpolation.
-
-      call timer_start(&quot;compute_scalar_tend-vert adv spline 2&quot;)
-
-      nCells = grid % nCells
-      nCellsSolve = grid % nCellsSolve
-      nVertLevels = grid % nVertLevels
-      num_tracers = size(tracers, 1)
-      maxLevelCell =&gt; grid % maxLevelCell % array
-
-      hRatioZLevelK =&gt; grid % hRatioZLevelK % array
-      hRatioZLevelKm1 =&gt; grid % hRatioZLevelKm1 % array
-
-      allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
-
-      do iCell=1,nCellsSolve 
-         do k=2,maxLevelCell(iCell)
-            do iTracer=1,num_tracers
-               ! Note hRatio on the k side is multiplied by tracer at k-1
-               ! and hRatio on the Km1 (k-1) side is mult. by tracer at k.
-               tracerTop(iTracer,k,iCell) = &amp;
-                    hRatioZLevelK(k)  *tracers(iTracer,k-1,iCell) &amp;
-                  + hRatioZLevelKm1(k)*tracers(iTracer,k  ,iCell)
-            end do
-         end do
-      end do
-
-      do iCell=1,nCellsSolve 
-         do k=1,maxLevelCell(iCell)  
-            do iTracer=1,num_tracers
-               tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &amp;
-                  - (   wTop(k  ,iCell)*tracerTop(iTracer,k  ,iCell) &amp;
-                      - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
-            end do
-         end do
-      end do
-
-      deallocate(tracerTop)
-
-      call timer_stop(&quot;compute_scalar_tend-vert adv spline 2&quot;)
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_spline2_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_spline2_init
-!
-!&gt; \brief   Initializes ocean tracer vertical advection quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    16 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  2nd order spline based vertical tracer advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_spline2_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-
-      spline2On = .false.
-
-      if(config_vert_tracer_adv_order.eq.2) then
-        spline2On = .true.
-      endif
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_spline2_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_spline2
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,214 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_vadv_spline2
+!
+!&gt; \brief MPAS ocean vertical tracer advection driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  vertical advection tendencies.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_vadv_spline2
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_vadv_spline2_tend, &amp;
+             ocn_tracer_vadv_spline2_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: spline2On
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_spline2_tend
+!
+!&gt; \brief   Computes tendency term for vertical tracer advection 2nd order spline
+!&gt; \author  Doug Jacobsen
+!&gt; \date    16 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical advection tendency for tracer
+!&gt;  based on current state using a 2nd order spline.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_spline2_tend(grid, wTop, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         wTop    !&lt; Input: vertical tracer in top layer
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+         tracers     !&lt; Input: tracers
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: tracer tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iCell, nCells, nCellsSolve, k, iTracer, num_tracers, nVertLevels
+
+      integer, dimension(:), pointer :: maxLevelCell
+
+      real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, hRatioZLevelKm1
+
+      real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not.spline2On) return
+      ! Compute tracerTop using linear interpolation.
+
+      call mpas_timer_start(&quot;compute_scalar_tend-vert adv spline 2&quot;)
+
+      nCells = grid % nCells
+      nCellsSolve = grid % nCellsSolve
+      nVertLevels = grid % nVertLevels
+      num_tracers = size(tracers, 1)
+      maxLevelCell =&gt; grid % maxLevelCell % array
+
+      hRatioZLevelK =&gt; grid % hRatioZLevelK % array
+      hRatioZLevelKm1 =&gt; grid % hRatioZLevelKm1 % array
+
+      allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
+
+      do iCell=1,nCellsSolve 
+         do k=2,maxLevelCell(iCell)
+            do iTracer=1,num_tracers
+               ! Note hRatio on the k side is multiplied by tracer at k-1
+               ! and hRatio on the Km1 (k-1) side is mult. by tracer at k.
+               tracerTop(iTracer,k,iCell) = &amp;
+                    hRatioZLevelK(k)  *tracers(iTracer,k-1,iCell) &amp;
+                  + hRatioZLevelKm1(k)*tracers(iTracer,k  ,iCell)
+            end do
+         end do
+      end do
+
+      do iCell=1,nCellsSolve 
+         do k=1,maxLevelCell(iCell)  
+            do iTracer=1,num_tracers
+               tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &amp;
+                  - (   wTop(k  ,iCell)*tracerTop(iTracer,k  ,iCell) &amp;
+                      - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
+            end do
+         end do
+      end do
+
+      deallocate(tracerTop)
+
+      call mpas_timer_stop(&quot;compute_scalar_tend-vert adv spline 2&quot;)
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_spline2_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_spline2_init
+!
+!&gt; \brief   Initializes ocean tracer vertical advection quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    16 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  2nd order spline based vertical tracer advection in the ocean.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_spline2_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+
+      spline2On = .false.
+
+      if(config_vert_tracer_adv_order.eq.2) then
+        spline2On = .true.
+      endif
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_spline2_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_vadv_spline2
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,243 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_vadv_spline3
-!
-!&gt; \brief MPAS ocean vertical tracer advection driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  vertical advection tendencies.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_spline3
-
-   use grid_types
-   use configure
-   use timer
-   use spline_interpolation
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_vadv_spline3_tend, &amp;
-             ocn_tracer_vadv_spline3_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: spline3On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_spline3_tend
-!
-!&gt; \brief   Computes tendency term for vertical tracer advection 3rd order spline
-!&gt; \author  Doug Jacobsen
-!&gt; \date    16 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical advection tendency for tracer
-!&gt;  based on current state using a 3rd order spline.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_spline3_tend(grid, wTop, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         wTop    !&lt; Input: vertical tracer in top layer
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-         tracers     !&lt; Input: tracers
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: tracer tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iCell, nCells, nCellsSolve, k, iTracer, num_tracers, nVertLevels
-
-      integer, dimension(:), pointer :: maxLevelCell
-
-      real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, &amp;
-            hRatioZLevelKm1, zTopZLevel, zMidZLevel
-
-      real (kind=RKIND), dimension(:), allocatable :: tracer2ndDer,  &amp;
-            tracersIn, tracersOut, posZMidZLevel, posZTopZLevel
-      real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not.spline3On) return
-      ! Compute tracerTop using linear interpolation.
-
-      call timer_start(&quot;compute_scalar_tend-vert adv spline 3&quot;)
-
-      nCells = grid % nCells
-      nCellsSolve = grid % nCellsSolve
-      nVertLevels = grid % nVertLevels
-      num_tracers = size(tracers, 1)
-      maxLevelCell =&gt; grid % maxLevelCell % array
-
-      hRatioZLevelK =&gt; grid % hRatioZLevelK % array
-      hRatioZLevelKm1 =&gt; grid % hRatioZLevelKm1 % array
-      zMidZLevel =&gt; grid % zMidZLevel % array
-      zTopZLevel =&gt; grid % zTopZLevel % array
-
-      allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
-
-      ! Compute tracerTop using cubic spline interpolation.
-
-      allocate(tracer2ndDer(nVertLevels))
-      allocate(tracersIn(nVertLevels),tracersOut(nVertLevels), &amp;
-            posZMidZLevel(nVertLevels), posZTopZLevel(nVertLevels-1))
-
-      ! For the ocean, zlevel coordinates are negative and decreasing, 
-      ! but spline functions assume increasing, so flip to positive.
-
-      posZMidZLevel = -zMidZLevel(1:nVertLevels)
-      posZTopZLevel = -zTopZLevel(2:nVertLevels)
-
-      do iCell=1,nCellsSolve 
-         ! mrp 110201 efficiency note: push tracer loop down
-         ! into spline subroutines to improve efficiency
-         do iTracer=1,num_tracers
-
-            ! Place data in arrays to avoid creating new temporary arrays for every 
-            ! subroutine call.  
-            tracersIn(1:maxLevelCell(iCell))=tracers(iTracer,1:maxLevelCell(iCell),iCell)
-
-            call CubicSplineCoefficients(posZMidZLevel, &amp;
-               tracersIn, maxLevelCell(iCell), tracer2ndDer)
-
-            call InterpolateCubicSpline( &amp;
-               posZMidZLevel, tracersIn, tracer2ndDer, maxLevelCell(iCell), &amp;
-               posZTopZLevel, tracersOut, maxLevelCell(iCell)-1 )
-
-            tracerTop(iTracer,2:maxLevelCell(iCell),iCell) = tracersOut(1:maxLevelCell(iCell)-1)
-
-         end do
-      end do
-
-      do iCell=1,nCellsSolve 
-         do k=1,maxLevelCell(iCell)  
-            do iTracer=1,num_tracers
-               tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &amp;
-                  - (   wTop(k  ,iCell)*tracerTop(iTracer,k  ,iCell) &amp;
-                      - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
-            end do
-         end do
-      end do
-
-      deallocate(tracer2ndDer)
-      deallocate(tracersIn,tracersOut, posZMidZLevel, posZTopZLevel)
-      deallocate(tracerTop)
-
-      call timer_stop(&quot;compute_scalar_tend-vert adv spline 3&quot;)
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_spline3_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_spline3_init
-!
-!&gt; \brief   Initializes ocean tracer vertical advection quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    16 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  3rd order spline based vertical tracer advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_spline3_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-
-      spline3On = .false.
-
-      if(config_vert_tracer_adv_order.eq.3) then
-        spline3On = .true.
-      endif
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_spline3_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_spline3
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,243 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_vadv_spline3
+!
+!&gt; \brief MPAS ocean vertical tracer advection driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  vertical advection tendencies.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_vadv_spline3
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+   use mpas_spline_interpolation
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_vadv_spline3_tend, &amp;
+             ocn_tracer_vadv_spline3_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: spline3On
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_spline3_tend
+!
+!&gt; \brief   Computes tendency term for vertical tracer advection 3rd order spline
+!&gt; \author  Doug Jacobsen
+!&gt; \date    16 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical advection tendency for tracer
+!&gt;  based on current state using a 3rd order spline.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_spline3_tend(grid, wTop, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         wTop    !&lt; Input: vertical tracer in top layer
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+         tracers     !&lt; Input: tracers
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: tracer tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iCell, nCells, nCellsSolve, k, iTracer, num_tracers, nVertLevels
+
+      integer, dimension(:), pointer :: maxLevelCell
+
+      real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, &amp;
+            hRatioZLevelKm1, zTopZLevel, zMidZLevel
+
+      real (kind=RKIND), dimension(:), allocatable :: tracer2ndDer,  &amp;
+            tracersIn, tracersOut, posZMidZLevel, posZTopZLevel
+      real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not.spline3On) return
+      ! Compute tracerTop using linear interpolation.
+
+      call mpas_timer_start(&quot;compute_scalar_tend-vert adv spline 3&quot;)
+
+      nCells = grid % nCells
+      nCellsSolve = grid % nCellsSolve
+      nVertLevels = grid % nVertLevels
+      num_tracers = size(tracers, 1)
+      maxLevelCell =&gt; grid % maxLevelCell % array
+
+      hRatioZLevelK =&gt; grid % hRatioZLevelK % array
+      hRatioZLevelKm1 =&gt; grid % hRatioZLevelKm1 % array
+      zMidZLevel =&gt; grid % zMidZLevel % array
+      zTopZLevel =&gt; grid % zTopZLevel % array
+
+      allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
+
+      ! Compute tracerTop using cubic spline interpolation.
+
+      allocate(tracer2ndDer(nVertLevels))
+      allocate(tracersIn(nVertLevels),tracersOut(nVertLevels), &amp;
+            posZMidZLevel(nVertLevels), posZTopZLevel(nVertLevels-1))
+
+      ! For the ocean, zlevel coordinates are negative and decreasing, 
+      ! but spline functions assume increasing, so flip to positive.
+
+      posZMidZLevel = -zMidZLevel(1:nVertLevels)
+      posZTopZLevel = -zTopZLevel(2:nVertLevels)
+
+      do iCell=1,nCellsSolve 
+         ! mrp 110201 efficiency note: push tracer loop down
+         ! into spline subroutines to improve efficiency
+         do iTracer=1,num_tracers
+
+            ! Place data in arrays to avoid creating new temporary arrays for every 
+            ! subroutine call.  
+            tracersIn(1:maxLevelCell(iCell))=tracers(iTracer,1:maxLevelCell(iCell),iCell)
+
+            call mpas_cubic_spline_coefficients(posZMidZLevel, &amp;
+               tracersIn, maxLevelCell(iCell), tracer2ndDer)
+
+            call mpas_interpolate_cubic_spline( &amp;
+               posZMidZLevel, tracersIn, tracer2ndDer, maxLevelCell(iCell), &amp;
+               posZTopZLevel, tracersOut, maxLevelCell(iCell)-1 )
+
+            tracerTop(iTracer,2:maxLevelCell(iCell),iCell) = tracersOut(1:maxLevelCell(iCell)-1)
+
+         end do
+      end do
+
+      do iCell=1,nCellsSolve 
+         do k=1,maxLevelCell(iCell)  
+            do iTracer=1,num_tracers
+               tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &amp;
+                  - (   wTop(k  ,iCell)*tracerTop(iTracer,k  ,iCell) &amp;
+                      - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
+            end do
+         end do
+      end do
+
+      deallocate(tracer2ndDer)
+      deallocate(tracersIn,tracersOut, posZMidZLevel, posZTopZLevel)
+      deallocate(tracerTop)
+
+      call mpas_timer_stop(&quot;compute_scalar_tend-vert adv spline 3&quot;)
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_spline3_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_spline3_init
+!
+!&gt; \brief   Initializes ocean tracer vertical advection quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    16 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  3rd order spline based vertical tracer advection in the ocean.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_spline3_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+
+      spline3On = .false.
+
+      if(config_vert_tracer_adv_order.eq.3) then
+        spline3On = .true.
+      endif
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_spline3_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_vadv_spline3
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,191 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_vadv_stencil
-!
-!&gt; \brief MPAS ocean vertical tracer advection driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  vertical advection tendencies.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_stencil
-
-   use grid_types
-   use configure
-
-   use ocn_tracer_vadv_stencil2
-   use ocn_tracer_vadv_stencil3
-   use ocn_tracer_vadv_stencil4
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_vadv_stencil_tend, &amp;
-             ocn_tracer_vadv_stencil_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: stencilOn
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_stencil_tend
-!
-!&gt; \brief   Computes tendency term for vertical tracer advection
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical advection tendency for tracers
-!&gt;  based on current state and user choices of stencil based advection parameterization.
-!&gt;  Multiple parameterizations may be chosen and added together.  These
-!&gt;  tendencies are generally computed by calling the specific routine
-!&gt;  for the chosen parameterization, so this routine is primarily a
-!&gt;  driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_stencil_tend(grid, wTop, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         wTop    !&lt; Input: vertical tracer in top layer
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-         tracers     !&lt; Input: tracers
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: tracer tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: err1, err2, err3
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not. stencilOn) return
-
-      call ocn_tracer_vadv_stencil2_tend(grid, wTop, tracers, tend, err1)
-      call ocn_tracer_vadv_stencil3_tend(grid, wTop, tracers, tend, err1)
-      call ocn_tracer_vadv_stencil4_tend(grid, wTop, tracers, tend, err1)
-
-      err = err1 .or. err2 .or. err3
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_stencil_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_stencil_init
-!
-!&gt; \brief   Initializes ocean tracer vertical advection quantities
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  stencil based vertical tracer advection in the ocean. Since a variety of 
-!&gt;  parameterizations are available, this routine primarily calls the
-!&gt;  individual init routines for each parameterization. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_stencil_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      integer :: err1, err2, err3
-
-      err = 0
-
-      stencilOn = .false.
-
-      if (config_vert_tracer_adv.eq.'stencil') then
-         stencilOn = .true.
-
-         call ocn_tracer_vadv_stencil2_init(err1)
-         call ocn_tracer_vadv_stencil3_init(err2)
-         call ocn_tracer_vadv_stencil4_init(err3)
-
-         err = err1 .or. err2 .or. err3
-      endif
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_stencil_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_stencil
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,191 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_vadv_stencil
+!
+!&gt; \brief MPAS ocean vertical tracer advection driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  vertical advection tendencies.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_vadv_stencil
+
+   use mpas_grid_types
+   use mpas_configure
+
+   use ocn_tracer_vadv_stencil2
+   use ocn_tracer_vadv_stencil3
+   use ocn_tracer_vadv_stencil4
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_vadv_stencil_tend, &amp;
+             ocn_tracer_vadv_stencil_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: stencilOn
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_stencil_tend
+!
+!&gt; \brief   Computes tendency term for vertical tracer advection
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical advection tendency for tracers
+!&gt;  based on current state and user choices of stencil based advection parameterization.
+!&gt;  Multiple parameterizations may be chosen and added together.  These
+!&gt;  tendencies are generally computed by calling the specific routine
+!&gt;  for the chosen parameterization, so this routine is primarily a
+!&gt;  driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_stencil_tend(grid, wTop, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         wTop    !&lt; Input: vertical tracer in top layer
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+         tracers     !&lt; Input: tracers
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: tracer tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: err1, err2, err3
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not. stencilOn) return
+
+      call ocn_tracer_vadv_stencil2_tend(grid, wTop, tracers, tend, err1)
+      call ocn_tracer_vadv_stencil3_tend(grid, wTop, tracers, tend, err1)
+      call ocn_tracer_vadv_stencil4_tend(grid, wTop, tracers, tend, err1)
+
+      err = err1 .or. err2 .or. err3
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_stencil_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_stencil_init
+!
+!&gt; \brief   Initializes ocean tracer vertical advection quantities
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  stencil based vertical tracer advection in the ocean. Since a variety of 
+!&gt;  parameterizations are available, this routine primarily calls the
+!&gt;  individual init routines for each parameterization. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_stencil_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      integer :: err1, err2, err3
+
+      err = 0
+
+      stencilOn = .false.
+
+      if (config_vert_tracer_adv.eq.'stencil') then
+         stencilOn = .true.
+
+         call ocn_tracer_vadv_stencil2_init(err1)
+         call ocn_tracer_vadv_stencil3_init(err2)
+         call ocn_tracer_vadv_stencil4_init(err3)
+
+         err = err1 .or. err2 .or. err3
+      endif
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_stencil_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_vadv_stencil
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,212 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_vadv_stencil2
-!
-!&gt; \brief MPAS ocean vertical tracer advection driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  vertical advection tendencies.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_stencil2
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_vadv_stencil2_tend, &amp;
-             ocn_tracer_vadv_stencil2_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: stencil2On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_stencil2_tend
-!
-!&gt; \brief   Computes tendency term for vertical tracer advection 2nd order stencil
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical advection tendency for tracer
-!&gt;  based on current state using a 2nd order stencil.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_stencil2_tend(grid, wTop, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         wTop    !&lt; Input: vertical tracer in top layer
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-         tracers     !&lt; Input: tracers
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: tracer tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: nCellsSolve, iCell, k, iTracer, num_tracers, nVertLevels
-      integer :: nCells
-
-      integer, dimension(:), pointer :: maxLevelCell
-
-      real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
-
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not. stencil2On) return
-
-
-      call timer_start(&quot;compute_scalar_tend-vert adv stencil 2&quot;)
-
-      nCells = grid % nCells
-      nCellsSolve = grid % nCellsSolve
-      num_tracers = size(tracers, 1)
-      nVertLevels = grid % nVertLevels
-      maxLevelCell =&gt; grid % maxLevelCell % array
-
-      allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
-
-      ! Compute tracerTop using centered stencil, a simple average.
-
-      do iCell=1,nCellsSolve 
-         do k=2,maxLevelCell(iCell)
-            do iTracer=1,num_tracers
-               tracerTop(iTracer,k,iCell) = &amp;
-                  ( tracers(iTracer,k-1,iCell) &amp;
-                   +tracers(iTracer,k  ,iCell))/2.0
-            end do
-         end do
-      end do
-
-      do iCell=1,nCellsSolve 
-         do k=1,maxLevelCell(iCell)  
-            do iTracer=1,num_tracers
-               tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &amp;
-                  - (   wTop(k  ,iCell)*tracerTop(iTracer,k  ,iCell) &amp;
-                      - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
-            end do
-         end do
-      end do
-
-      deallocate(tracerTop)
-      call timer_stop(&quot;compute_scalar_tend-vert adv stencil 2&quot;)
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_stencil2_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_stencil2_init
-!
-!&gt; \brief   Initializes ocean tracer vertical advection quantities
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  a 2nd order stencil based vertical tracer advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_stencil2_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      integer :: err1, err2, err3
-
-      err = 0
-      stencil2On = .false.
-
-      if(config_vert_tracer_adv_order.eq.2) then
-          stencil2On = .true.
-      endif
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_stencil2_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_stencil2
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,212 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_vadv_stencil2
+!
+!&gt; \brief MPAS ocean vertical tracer advection driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  vertical advection tendencies.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_vadv_stencil2
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_vadv_stencil2_tend, &amp;
+             ocn_tracer_vadv_stencil2_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: stencil2On
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_stencil2_tend
+!
+!&gt; \brief   Computes tendency term for vertical tracer advection 2nd order stencil
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical advection tendency for tracer
+!&gt;  based on current state using a 2nd order stencil.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_stencil2_tend(grid, wTop, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         wTop    !&lt; Input: vertical tracer in top layer
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+         tracers     !&lt; Input: tracers
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: tracer tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: nCellsSolve, iCell, k, iTracer, num_tracers, nVertLevels
+      integer :: nCells
+
+      integer, dimension(:), pointer :: maxLevelCell
+
+      real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
+
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not. stencil2On) return
+
+
+      call mpas_timer_start(&quot;compute_scalar_tend-vert adv stencil 2&quot;)
+
+      nCells = grid % nCells
+      nCellsSolve = grid % nCellsSolve
+      num_tracers = size(tracers, 1)
+      nVertLevels = grid % nVertLevels
+      maxLevelCell =&gt; grid % maxLevelCell % array
+
+      allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
+
+      ! Compute tracerTop using centered stencil, a simple average.
+
+      do iCell=1,nCellsSolve 
+         do k=2,maxLevelCell(iCell)
+            do iTracer=1,num_tracers
+               tracerTop(iTracer,k,iCell) = &amp;
+                  ( tracers(iTracer,k-1,iCell) &amp;
+                   +tracers(iTracer,k  ,iCell))/2.0
+            end do
+         end do
+      end do
+
+      do iCell=1,nCellsSolve 
+         do k=1,maxLevelCell(iCell)  
+            do iTracer=1,num_tracers
+               tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &amp;
+                  - (   wTop(k  ,iCell)*tracerTop(iTracer,k  ,iCell) &amp;
+                      - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
+            end do
+         end do
+      end do
+
+      deallocate(tracerTop)
+      call mpas_timer_stop(&quot;compute_scalar_tend-vert adv stencil 2&quot;)
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_stencil2_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_stencil2_init
+!
+!&gt; \brief   Initializes ocean tracer vertical advection quantities
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  a 2nd order stencil based vertical tracer advection in the ocean.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_stencil2_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      integer :: err1, err2, err3
+
+      err = 0
+      stencil2On = .false.
+
+      if(config_vert_tracer_adv_order.eq.2) then
+          stencil2On = .true.
+      endif
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_stencil2_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_vadv_stencil2
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,233 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_vadv_stencil3
-!
-!&gt; \brief MPAS ocean vertical tracer advection driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  vertical advection tendencies.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_stencil3
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_vadv_stencil3_tend, &amp;
-             ocn_tracer_vadv_stencil3_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: stencil3On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_stencil3_tend
-!
-!&gt; \brief   Computes tendency term for vertical tracer advection 3rd order stencil
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical advection tendency for tracer
-!&gt;  based on current state using a 3rd order stencil.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_stencil3_tend(grid, wTop, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         wTop    !&lt; Input: vertical tracer in top layer
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-         tracers     !&lt; Input: tracers
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: tracer tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: nCellsSolve, iCell, k, iTracer, num_tracers, nVertLevels
-      integer :: nCells
-
-      integer, dimension(:), pointer :: maxLevelCell
-
-      real (kind=RKIND) :: cSignWTop, flux3Coef
-      real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, hRatioZLevelKm1
-      real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
-
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not. stencil3On) return
-
-      nCells = grid % nCells
-      nCellsSolve = grid % nCellsSolve
-      num_tracers = size(tracers, 1)
-      nVertLevels = grid % nVertLevels
-      maxLevelCell =&gt; grid % maxLevelCell % array
-      hRatioZLevelK =&gt; grid % hRatioZLevelK % array
-      hRatioZLevelKm1 =&gt; grid % hRatioZLevelKm1 % array
-
-      call timer_start(&quot;compute_scalar_tend-vert adv stencil 3&quot;)
-
-      allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
-
-      ! Compute tracerTop using 3rd order stencil.  This is the same
-      ! as 4th order, but includes upwinding.
-
-      ! Hardwire flux3Coeff at 1.0 for now.  Could add this to the 
-      ! namelist, if desired.
-      flux3Coef = 1.0
-      do iCell=1,nCellsSolve 
-         k=2
-         do iTracer=1,num_tracers
-           tracerTop(iTracer,k,iCell) = &amp;
-                hRatioZLevelK(k)  *tracers(iTracer,k-1,iCell) &amp;
-              + hRatioZLevelKm1(k)*tracers(iTracer,k  ,iCell)
-         end do
-         do k=3,maxLevelCell(iCell)-1
-            cSignWTop = sign(flux3Coef,wTop(k,iCell))
-            do iTracer=1,num_tracers
-               tracerTop(iTracer,k,iCell) = &amp;
-                  ( (-1.+   cSignWTop)*tracers(iTracer,k-2,iCell) &amp;
-                   +( 7.-3.*cSignWTop)*tracers(iTracer,k-1,iCell) &amp;
-                   +( 7.+3.*cSignWTop)*tracers(iTracer,k  ,iCell) &amp;
-                   +(-1.-   cSignWTop)*tracers(iTracer,k+1,iCell) &amp;
-                  )/12.
-            end do
-         end do
-         k=maxLevelCell(iCell)
-            do iTracer=1,num_tracers
-              tracerTop(iTracer,k,iCell) = &amp;
-                   hRatioZLevelK(k)  *tracers(iTracer,k-1,iCell) &amp;
-                 + hRatioZLevelKm1(k)*tracers(iTracer,k  ,iCell)
-            end do
-      end do
-
-      do iCell=1,nCellsSolve 
-         do k=1,maxLevelCell(iCell)  
-            do iTracer=1,num_tracers
-               tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &amp;
-                  - (   wTop(k  ,iCell)*tracerTop(iTracer,k  ,iCell) &amp;
-                      - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
-            end do
-         end do
-      end do
-
-      deallocate(tracerTop)
-      call timer_stop(&quot;compute_scalar_tend-vert adv stencil 3&quot;)
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_stencil3_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_stencil3_init
-!
-!&gt; \brief   Initializes ocean tracer vertical advection quantities
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  3rd order stencil based vertical tracer advection in the ocean. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_stencil3_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-      stencil3On = .false.
-
-      if(config_vert_tracer_adv_order.eq.3) then
-          stencil3On = .true.
-      endif
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_stencil3_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_stencil3
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,233 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_vadv_stencil3
+!
+!&gt; \brief MPAS ocean vertical tracer advection driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  vertical advection tendencies.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_vadv_stencil3
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_vadv_stencil3_tend, &amp;
+             ocn_tracer_vadv_stencil3_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: stencil3On
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_stencil3_tend
+!
+!&gt; \brief   Computes tendency term for vertical tracer advection 3rd order stencil
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical advection tendency for tracer
+!&gt;  based on current state using a 3rd order stencil.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_stencil3_tend(grid, wTop, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         wTop    !&lt; Input: vertical tracer in top layer
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+         tracers     !&lt; Input: tracers
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: tracer tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: nCellsSolve, iCell, k, iTracer, num_tracers, nVertLevels
+      integer :: nCells
+
+      integer, dimension(:), pointer :: maxLevelCell
+
+      real (kind=RKIND) :: cSignWTop, flux3Coef
+      real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, hRatioZLevelKm1
+      real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
+
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not. stencil3On) return
+
+      nCells = grid % nCells
+      nCellsSolve = grid % nCellsSolve
+      num_tracers = size(tracers, 1)
+      nVertLevels = grid % nVertLevels
+      maxLevelCell =&gt; grid % maxLevelCell % array
+      hRatioZLevelK =&gt; grid % hRatioZLevelK % array
+      hRatioZLevelKm1 =&gt; grid % hRatioZLevelKm1 % array
+
+      call mpas_timer_start(&quot;compute_scalar_tend-vert adv stencil 3&quot;)
+
+      allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
+
+      ! Compute tracerTop using 3rd order stencil.  This is the same
+      ! as 4th order, but includes upwinding.
+
+      ! Hardwire flux3Coeff at 1.0 for now.  Could add this to the 
+      ! namelist, if desired.
+      flux3Coef = 1.0
+      do iCell=1,nCellsSolve 
+         k=2
+         do iTracer=1,num_tracers
+           tracerTop(iTracer,k,iCell) = &amp;
+                hRatioZLevelK(k)  *tracers(iTracer,k-1,iCell) &amp;
+              + hRatioZLevelKm1(k)*tracers(iTracer,k  ,iCell)
+         end do
+         do k=3,maxLevelCell(iCell)-1
+            cSignWTop = sign(flux3Coef,wTop(k,iCell))
+            do iTracer=1,num_tracers
+               tracerTop(iTracer,k,iCell) = &amp;
+                  ( (-1.+   cSignWTop)*tracers(iTracer,k-2,iCell) &amp;
+                   +( 7.-3.*cSignWTop)*tracers(iTracer,k-1,iCell) &amp;
+                   +( 7.+3.*cSignWTop)*tracers(iTracer,k  ,iCell) &amp;
+                   +(-1.-   cSignWTop)*tracers(iTracer,k+1,iCell) &amp;
+                  )/12.
+            end do
+         end do
+         k=maxLevelCell(iCell)
+            do iTracer=1,num_tracers
+              tracerTop(iTracer,k,iCell) = &amp;
+                   hRatioZLevelK(k)  *tracers(iTracer,k-1,iCell) &amp;
+                 + hRatioZLevelKm1(k)*tracers(iTracer,k  ,iCell)
+            end do
+      end do
+
+      do iCell=1,nCellsSolve 
+         do k=1,maxLevelCell(iCell)  
+            do iTracer=1,num_tracers
+               tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &amp;
+                  - (   wTop(k  ,iCell)*tracerTop(iTracer,k  ,iCell) &amp;
+                      - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
+            end do
+         end do
+      end do
+
+      deallocate(tracerTop)
+      call mpas_timer_stop(&quot;compute_scalar_tend-vert adv stencil 3&quot;)
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_stencil3_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_stencil3_init
+!
+!&gt; \brief   Initializes ocean tracer vertical advection quantities
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  3rd order stencil based vertical tracer advection in the ocean. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_stencil3_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+      stencil3On = .false.
+
+      if(config_vert_tracer_adv_order.eq.3) then
+          stencil3On = .true.
+      endif
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_stencil3_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_vadv_stencil3
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,228 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_tracer_vadv_stencil4
-!
-!&gt; \brief MPAS ocean vertical tracer advection driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  vertical advection tendencies.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_tracer_vadv_stencil4
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_tracer_vadv_stencil4_tend, &amp;
-             ocn_tracer_vadv_stencil4_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: stencil4On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_stencil4_tend
-!
-!&gt; \brief   Computes tendency term for vertical tracer advection 4th order stencil
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical advection tendency for tracer
-!&gt;  based on current state using a 4th order stencil.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_stencil4_tend(grid, wTop, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         wTop    !&lt; Input: vertical tracer in top layer
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-         tracers     !&lt; Input: tracers
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: tracer tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: nCellsSolve, iCell, k, iTracer, num_tracers, nVertLevels
-      integer :: nCells
-
-      integer, dimension(:), pointer :: maxLevelCell
-
-      real (kind=RKIND) :: cSingWTop, flux3Coef
-      real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, hRatioZLevelKm1
-      real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
-
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not. Stencil4On) return
-
-      call timer_start(&quot;compute_scalar_tend-vert adv stencil 4&quot;)
-
-      nCells = grid % nCells
-      nCellsSolve = grid % nCellsSolve
-      num_tracers = size(tracers, 1)
-      nVertLevels = grid % nVertLevels
-      maxLevelCell =&gt; grid % maxLevelCell % array
-      hRatioZLevelK =&gt; grid % hRatioZLevelK % array
-      hRatioZLevelKm1 =&gt; grid % hRatioZLevelKm1 % array
-
-      allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
-
-      ! Compute tracerTop using 4rd order stencil [-1 7 7 -1]
-
-      do iCell=1,nCellsSolve 
-         k=2
-            do iTracer=1,num_tracers
-              tracerTop(iTracer,k,iCell) = &amp;
-                   hRatioZLevelK(k)  *tracers(iTracer,k-1,iCell) &amp;
-                 + hRatioZLevelKm1(k)*tracers(iTracer,k  ,iCell)
-            end do
-         do k=3,maxLevelCell(iCell)-1
-            do iTracer=1,num_tracers
-               tracerTop(iTracer,k,iCell) = &amp;
-                  (-   tracers(iTracer,k-2,iCell) &amp;
-                   +7.*tracers(iTracer,k-1,iCell) &amp;
-                   +7.*tracers(iTracer,k  ,iCell) &amp;
-                   -   tracers(iTracer,k+1,iCell) &amp;
-                  )/12.
-            end do
-         end do
-         k=maxLevelCell(iCell)
-            do iTracer=1,num_tracers
-              tracerTop(iTracer,k,iCell) = &amp;
-                   hRatioZLevelK(k)  *tracers(iTracer,k-1,iCell) &amp;
-                 + hRatioZLevelKm1(k)*tracers(iTracer,k  ,iCell)
-            end do
-      end do
-
-      do iCell=1,nCellsSolve 
-         do k=1,maxLevelCell(iCell)  
-            do iTracer=1,num_tracers
-               tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &amp;
-                      - (   wTop(k  ,iCell)*tracerTop(iTracer,k  ,iCell) &amp;
-                      - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
-            end do
-         end do
-      end do
-
-      deallocate(tracerTop)
-      call timer_stop(&quot;compute_scalar_tend-vert adv stencil 4&quot;)
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_stencil4_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vadv_stencil4_init
-!
-!&gt; \brief   Initializes ocean tracer vertical advection quantities
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  4th order stencil based vertical tracer advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vadv_stencil4_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-      stencil4On = .false.
-
-      if(config_vert_tracer_adv_order.eq.4) then
-          stencil4On = .true.
-      endif
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vadv_stencil4_init!}}}
-
-!***********************************************************************
-
-end module ocn_tracer_vadv_stencil4
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,228 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_tracer_vadv_stencil4
+!
+!&gt; \brief MPAS ocean vertical tracer advection driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  vertical advection tendencies.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_tracer_vadv_stencil4
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_tracer_vadv_stencil4_tend, &amp;
+             ocn_tracer_vadv_stencil4_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: stencil4On
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_stencil4_tend
+!
+!&gt; \brief   Computes tendency term for vertical tracer advection 4th order stencil
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical advection tendency for tracer
+!&gt;  based on current state using a 4th order stencil.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_stencil4_tend(grid, wTop, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         wTop    !&lt; Input: vertical tracer in top layer
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+         tracers     !&lt; Input: tracers
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: tracer tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: nCellsSolve, iCell, k, iTracer, num_tracers, nVertLevels
+      integer :: nCells
+
+      integer, dimension(:), pointer :: maxLevelCell
+
+      real (kind=RKIND) :: cSingWTop, flux3Coef
+      real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, hRatioZLevelKm1
+      real (kind=RKIND), dimension(:,:,:), allocatable :: tracerTop
+
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not. Stencil4On) return
+
+      call mpas_timer_start(&quot;compute_scalar_tend-vert adv stencil 4&quot;)
+
+      nCells = grid % nCells
+      nCellsSolve = grid % nCellsSolve
+      num_tracers = size(tracers, 1)
+      nVertLevels = grid % nVertLevels
+      maxLevelCell =&gt; grid % maxLevelCell % array
+      hRatioZLevelK =&gt; grid % hRatioZLevelK % array
+      hRatioZLevelKm1 =&gt; grid % hRatioZLevelKm1 % array
+
+      allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
+
+      ! Compute tracerTop using 4rd order stencil [-1 7 7 -1]
+
+      do iCell=1,nCellsSolve 
+         k=2
+            do iTracer=1,num_tracers
+              tracerTop(iTracer,k,iCell) = &amp;
+                   hRatioZLevelK(k)  *tracers(iTracer,k-1,iCell) &amp;
+                 + hRatioZLevelKm1(k)*tracers(iTracer,k  ,iCell)
+            end do
+         do k=3,maxLevelCell(iCell)-1
+            do iTracer=1,num_tracers
+               tracerTop(iTracer,k,iCell) = &amp;
+                  (-   tracers(iTracer,k-2,iCell) &amp;
+                   +7.*tracers(iTracer,k-1,iCell) &amp;
+                   +7.*tracers(iTracer,k  ,iCell) &amp;
+                   -   tracers(iTracer,k+1,iCell) &amp;
+                  )/12.
+            end do
+         end do
+         k=maxLevelCell(iCell)
+            do iTracer=1,num_tracers
+              tracerTop(iTracer,k,iCell) = &amp;
+                   hRatioZLevelK(k)  *tracers(iTracer,k-1,iCell) &amp;
+                 + hRatioZLevelKm1(k)*tracers(iTracer,k  ,iCell)
+            end do
+      end do
+
+      do iCell=1,nCellsSolve 
+         do k=1,maxLevelCell(iCell)  
+            do iTracer=1,num_tracers
+               tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &amp;
+                      - (   wTop(k  ,iCell)*tracerTop(iTracer,k  ,iCell) &amp;
+                      - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
+            end do
+         end do
+      end do
+
+      deallocate(tracerTop)
+      call mpas_timer_stop(&quot;compute_scalar_tend-vert adv stencil 4&quot;)
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_stencil4_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vadv_stencil4_init
+!
+!&gt; \brief   Initializes ocean tracer vertical advection quantities
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  4th order stencil based vertical tracer advection in the ocean.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vadv_stencil4_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+      stencil4On = .false.
+
+      if(config_vert_tracer_adv_order.eq.4) then
+          stencil4On = .true.
+      endif
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vadv_stencil4_init!}}}
+
+!***********************************************************************
+
+end module ocn_tracer_vadv_stencil4
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_vel_coriolis.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_vel_coriolis.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_coriolis.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,191 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_vel_coriolis
-!
-!&gt; \brief MPAS ocean horizontal momentum mixing driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   15 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the routine for computing 
-!&gt;  tendencies from the coriolis force.  
-!&gt;
-!
-!-----------------------------------------------------------------------
-
-module ocn_vel_coriolis
-
-   use grid_types
-   use configure
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_vel_coriolis_tend, &amp;
-             ocn_vel_coriolis_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_vel_coriolis_tend
-!
-!&gt; \brief   Computes tendency term for coriolis force
-!&gt; \author  Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the coriolis tendency for momentum
-!&gt;  based on current state.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_coriolis_tend(grid, pv_edge, h_edge, u, ke, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         pv_edge  !&lt; Input: Potential vorticity on edge
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge  !&lt; Input: Thickness on edge
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         u  !&lt; Input: Horizontal velocity
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         ke  !&lt; Input: Kinetic Energy
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnEdge
-      integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnEdge
-      real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge
-      real (kind=RKIND), dimension(:), pointer :: dcEdge
-
-      integer :: j, k
-      integer :: cell1, cell2, nEdgesSolve, iEdge, eoe
-      real (kind=RKIND) :: workpv, q
-
-      err = 0
-
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-      nEdgesOnEdge =&gt; grid % nEdgesOnEdge % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      edgesOnEdge =&gt; grid % edgesOnEdge % array
-      weightsOnEdge =&gt; grid % weightsOnEdge % array
-      dcEdge =&gt; grid % dcEdge % array
-
-      nEdgesSolve = grid % nEdgesSolve
-
-      do iEdge=1,grid % nEdgesSolve
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         do k=1,maxLevelEdgeTop(iEdge)
-
-            q = 0.0
-            do j = 1,nEdgesOnEdge(iEdge)
-               eoe = edgesOnEdge(j,iEdge)
-               workpv = 0.5 * (pv_edge(k,iEdge) + pv_edge(k,eoe))
-               q = q + weightsOnEdge(j,iEdge) * u(k,eoe) * workpv * h_edge(k,eoe) 
-            end do
-
-           tend(k,iEdge) = tend(k,iEdge)     &amp;
-                  + q     &amp;
-                  - (   ke(k,cell2) - ke(k,cell1) ) / dcEdge(iEdge)
-
-         end do
-      end do
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_coriolis_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_coriolis_init
-!
-!&gt; \brief   Initializes ocean momentum horizontal mixing quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  horizontal velocity mixing in the ocean. Since a variety of 
-!&gt;  parameterizations are available, this routine primarily calls the
-!&gt;  individual init routines for each parameterization. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_coriolis_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! Output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_coriolis_init!}}}
-
-!***********************************************************************
-
-end module ocn_vel_coriolis
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_vel_coriolis.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_vel_coriolis.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_vel_coriolis.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_coriolis.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,191 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_vel_coriolis
+!
+!&gt; \brief MPAS ocean horizontal momentum mixing driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   15 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the routine for computing 
+!&gt;  tendencies from the coriolis force.  
+!&gt;
+!
+!-----------------------------------------------------------------------
+
+module ocn_vel_coriolis
+
+   use mpas_grid_types
+   use mpas_configure
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_vel_coriolis_tend, &amp;
+             ocn_vel_coriolis_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_vel_coriolis_tend
+!
+!&gt; \brief   Computes tendency term for coriolis force
+!&gt; \author  Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the coriolis tendency for momentum
+!&gt;  based on current state.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_coriolis_tend(grid, pv_edge, h_edge, u, ke, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         pv_edge  !&lt; Input: Potential vorticity on edge
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge  !&lt; Input: Thickness on edge
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         u  !&lt; Input: Horizontal velocity
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         ke  !&lt; Input: Kinetic Energy
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnEdge
+      integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnEdge
+      real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge
+      real (kind=RKIND), dimension(:), pointer :: dcEdge
+
+      integer :: j, k
+      integer :: cell1, cell2, nEdgesSolve, iEdge, eoe
+      real (kind=RKIND) :: workpv, q
+
+      err = 0
+
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+      nEdgesOnEdge =&gt; grid % nEdgesOnEdge % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      edgesOnEdge =&gt; grid % edgesOnEdge % array
+      weightsOnEdge =&gt; grid % weightsOnEdge % array
+      dcEdge =&gt; grid % dcEdge % array
+
+      nEdgesSolve = grid % nEdgesSolve
+
+      do iEdge=1,grid % nEdgesSolve
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+
+         do k=1,maxLevelEdgeTop(iEdge)
+
+            q = 0.0
+            do j = 1,nEdgesOnEdge(iEdge)
+               eoe = edgesOnEdge(j,iEdge)
+               workpv = 0.5 * (pv_edge(k,iEdge) + pv_edge(k,eoe))
+               q = q + weightsOnEdge(j,iEdge) * u(k,eoe) * workpv * h_edge(k,eoe) 
+            end do
+
+           tend(k,iEdge) = tend(k,iEdge)     &amp;
+                  + q     &amp;
+                  - (   ke(k,cell2) - ke(k,cell1) ) / dcEdge(iEdge)
+
+         end do
+      end do
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_coriolis_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_coriolis_init
+!
+!&gt; \brief   Initializes ocean momentum horizontal mixing quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  horizontal velocity mixing in the ocean. Since a variety of 
+!&gt;  parameterizations are available, this routine primarily calls the
+!&gt;  individual init routines for each parameterization. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_coriolis_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! Output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_coriolis_init!}}}
+
+!***********************************************************************
+
+end module ocn_vel_coriolis
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_vel_forcing.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,180 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_vel_forcing
-!
-!&gt; \brief MPAS ocean forcing driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  tendencies from forcings.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_vel_forcing
-
-   use grid_types
-   use configure
-
-   use ocn_vel_forcing_windstress
-   use ocn_vel_forcing_bottomdrag
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_vel_forcing_tend, &amp;
-             ocn_vel_forcing_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_vel_forcing_tend
-!
-!&gt; \brief   Computes tendency term from forcings
-!&gt; \author  Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the forcing tendency for momentum
-!&gt;  based on current state and user choices of forcings.
-!&gt;  Multiple forcings may be chosen and added together.  These
-!&gt;  tendencies are generally computed by calling the specific routine
-!&gt;  for the chosen forcing, so this routine is primarily a
-!&gt;  driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_forcing_tend(grid, u, u_src, ke_edge, h_edge, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         u    !&lt; Input: velocity
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         u_src     !&lt; Input: wind stress
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         ke_edge     !&lt; Input: kinetic energy at edge
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge     !&lt; Input: thickness at edge
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: err1, err2
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      call ocn_vel_forcing_windstress_tend(grid, u_src, h_edge, tend, err1)
-      call ocn_vel_forcing_bottomdrag_tend(grid, u, ke_edge, h_edge, tend, err2)
-
-      err = err1 .or. err2
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_forcing_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_forcing_init
-!
-!&gt; \brief   Initializes ocean forcings
-!&gt; \author  Doug Jacobsen
-!&gt; \date    16 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes quantities related to forcings 
-!&gt;  in the ocean. Since a multiple forcings are available, 
-!&gt;  this routine primarily calls the
-!&gt;  individual init routines for each forcing. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_forcing_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      integer :: err1, err2
-
-      call ocn_vel_forcing_windstress_init(err1)
-      call ocn_vel_forcing_bottomdrag_init(err2)
-
-      err = err1 .or. err2
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_forcing_init!}}}
-
-!***********************************************************************
-
-end module ocn_vel_forcing
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_vel_forcing.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,180 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_vel_forcing
+!
+!&gt; \brief MPAS ocean forcing driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  tendencies from forcings.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_vel_forcing
+
+   use mpas_grid_types
+   use mpas_configure
+
+   use ocn_vel_forcing_windstress
+   use ocn_vel_forcing_bottomdrag
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_vel_forcing_tend, &amp;
+             ocn_vel_forcing_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_vel_forcing_tend
+!
+!&gt; \brief   Computes tendency term from forcings
+!&gt; \author  Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the forcing tendency for momentum
+!&gt;  based on current state and user choices of forcings.
+!&gt;  Multiple forcings may be chosen and added together.  These
+!&gt;  tendencies are generally computed by calling the specific routine
+!&gt;  for the chosen forcing, so this routine is primarily a
+!&gt;  driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_forcing_tend(grid, u, u_src, ke_edge, h_edge, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         u    !&lt; Input: velocity
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         u_src     !&lt; Input: wind stress
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         ke_edge     !&lt; Input: kinetic energy at edge
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge     !&lt; Input: thickness at edge
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: err1, err2
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      call ocn_vel_forcing_windstress_tend(grid, u_src, h_edge, tend, err1)
+      call ocn_vel_forcing_bottomdrag_tend(grid, u, ke_edge, h_edge, tend, err2)
+
+      err = err1 .or. err2
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_forcing_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_forcing_init
+!
+!&gt; \brief   Initializes ocean forcings
+!&gt; \author  Doug Jacobsen
+!&gt; \date    16 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes quantities related to forcings 
+!&gt;  in the ocean. Since a multiple forcings are available, 
+!&gt;  this routine primarily calls the
+!&gt;  individual init routines for each forcing. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_forcing_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      integer :: err1, err2
+
+      call ocn_vel_forcing_windstress_init(err1)
+      call ocn_vel_forcing_bottomdrag_init(err2)
+
+      err = err1 .or. err2
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_forcing_init!}}}
+
+!***********************************************************************
+
+end module ocn_vel_forcing
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,201 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_vel_forcing_bottomdrag
-!
-!&gt; \brief MPAS ocean bottom drag
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the routine for computing 
-!&gt;  tendencies from bottom drag.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_vel_forcing_bottomdrag
-
-   use grid_types
-   use configure
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_vel_forcing_bottomdrag_tend, &amp;
-             ocn_vel_forcing_bottomdrag_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: bottomDragOn
-   real (kind=RKIND) :: bottomDragCoef
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_vel_forcing_bottomdrag_tend
-!
-!&gt; \brief   Computes tendency term from bottom drag
-!&gt; \author  Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the bottom drag tendency for momentum
-!&gt;  based on current state.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_forcing_bottomdrag_tend(grid, u, ke_edge, h_edge, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         u    !&lt; Input: velocity 
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         ke_edge     !&lt; Input: kinetic energy at edge
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge     !&lt; Input: thickness at edge
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdgesSolve, k
-      integer, dimension(:), pointer :: maxLevelEdgeTop
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not.bottomDragOn) return
-
-      nEdgesSolve = grid % nEdgesSolve
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-
-      do iEdge=1,grid % nEdgesSolve
-
-        k = maxLevelEdgeTop(iEdge)
-
-        ! efficiency note: it would be nice to avoid this
-        ! if within a do.  This could be done with
-        ! k =  max(maxLevelEdgeTop(iEdge),1)
-        ! and then tend_u(1,iEdge) is just not used for land cells.
-
-        if (k&gt;0) then
-           ! bottom drag is the same as POP:
-           ! -c |u| u  where c is unitless and 1.0e-3.
-           ! see POP Reference guide, section 3.4.4.
-
-           tend(k,iEdge) = tend(k,iEdge)  &amp;
-               -bottomDragCoef*u(k,iEdge) &amp;
-               *sqrt(2.0*ke_edge(k,iEdge))/h_edge(k,iEdge)
-
-        endif
-
-      enddo
-
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_forcing_bottomdrag_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_forcing_bottomdrag_init
-!
-!&gt; \brief   Initializes ocean bottom drag
-!&gt; \author  Doug Jacobsen
-!&gt; \date    16 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes quantities related to bottom drag 
-!&gt;  in the ocean. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_forcing_bottomdrag_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-
-      err = 0
-
-      bottomDragOn = .false.
-
-      if (.not.config_implicit_vertical_mix) then
-          bottomDragOn = .true.
-          bottomDragCoef = config_bottom_drag_coeff
-      endif
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_forcing_bottomdrag_init!}}}
-
-!***********************************************************************
-
-end module ocn_vel_forcing_bottomdrag
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,201 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_vel_forcing_bottomdrag
+!
+!&gt; \brief MPAS ocean bottom drag
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the routine for computing 
+!&gt;  tendencies from bottom drag.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_vel_forcing_bottomdrag
+
+   use mpas_grid_types
+   use mpas_configure
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_vel_forcing_bottomdrag_tend, &amp;
+             ocn_vel_forcing_bottomdrag_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: bottomDragOn
+   real (kind=RKIND) :: bottomDragCoef
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_vel_forcing_bottomdrag_tend
+!
+!&gt; \brief   Computes tendency term from bottom drag
+!&gt; \author  Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the bottom drag tendency for momentum
+!&gt;  based on current state.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_forcing_bottomdrag_tend(grid, u, ke_edge, h_edge, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         u    !&lt; Input: velocity 
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         ke_edge     !&lt; Input: kinetic energy at edge
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge     !&lt; Input: thickness at edge
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdgesSolve, k
+      integer, dimension(:), pointer :: maxLevelEdgeTop
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not.bottomDragOn) return
+
+      nEdgesSolve = grid % nEdgesSolve
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+
+      do iEdge=1,grid % nEdgesSolve
+
+        k = maxLevelEdgeTop(iEdge)
+
+        ! efficiency note: it would be nice to avoid this
+        ! if within a do.  This could be done with
+        ! k =  max(maxLevelEdgeTop(iEdge),1)
+        ! and then tend_u(1,iEdge) is just not used for land cells.
+
+        if (k&gt;0) then
+           ! bottom drag is the same as POP:
+           ! -c |u| u  where c is unitless and 1.0e-3.
+           ! see POP Reference guide, section 3.4.4.
+
+           tend(k,iEdge) = tend(k,iEdge)  &amp;
+               -bottomDragCoef*u(k,iEdge) &amp;
+               *sqrt(2.0*ke_edge(k,iEdge))/h_edge(k,iEdge)
+
+        endif
+
+      enddo
+
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_forcing_bottomdrag_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_forcing_bottomdrag_init
+!
+!&gt; \brief   Initializes ocean bottom drag
+!&gt; \author  Doug Jacobsen
+!&gt; \date    16 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes quantities related to bottom drag 
+!&gt;  in the ocean. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_forcing_bottomdrag_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+
+      err = 0
+
+      bottomDragOn = .false.
+
+      if (.not.config_implicit_vertical_mix) then
+          bottomDragOn = .true.
+          bottomDragCoef = config_bottom_drag_coeff
+      endif
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_forcing_bottomdrag_init!}}}
+
+!***********************************************************************
+
+end module ocn_vel_forcing_bottomdrag
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing_windstress.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_vel_forcing_windstress.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing_windstress.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,190 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_vel_forcing_windstress
-!
-!&gt; \brief MPAS ocean wind stress
-!&gt; \author Doug Jacobsen
-!&gt; \date   16 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the routine for computing 
-!&gt;  tendencies from wind stress.  
-!
-!-----------------------------------------------------------------------
-
-module ocn_vel_forcing_windstress
-
-   use grid_types
-   use configure
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_vel_forcing_windstress_tend, &amp;
-             ocn_vel_forcing_windstress_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: windStressOn
-   real (kind=RKIND) :: rho_ref
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_vel_forcing_windstress_tend
-!
-!&gt; \brief   Computes tendency term from wind stress
-!&gt; \author  Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the wind stress tendency for momentum
-!&gt;  based on current state.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_forcing_windstress_tend(grid, u_src, h_edge, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         u_src    !&lt; Input: wind stress
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge     !&lt; Input: thickness at edge
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdgesSolve, k
-      integer, dimension(:), pointer :: maxLevelEdgeTop
-
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not.windStressOn) return
-
-      nEdgesSolve = grid % nEdgesSolve
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-
-      do iEdge=1,nEdgesSolve
-
-        k = maxLevelEdgeTop(iEdge)
-
-        ! efficiency note: it would be nice to avoid this
-        ! if within a do.  This could be done with
-        ! k =  max(maxLevelEdgeTop(iEdge),1)
-        ! and then tend_u(1,iEdge) is just not used for land cells.
-
-        if (k&gt;0) then
-           ! forcing in top layer only
-           tend(1,iEdge) =  tend(1,iEdge) &amp;
-              + u_src(1,iEdge)/rho_ref/h_edge(1,iEdge)
-        endif
-
-      enddo
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_forcing_windstress_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_forcing_windstress_init
-!
-!&gt; \brief   Initializes ocean wind stress forcing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    16 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes quantities related to wind stress 
-!&gt;  in the ocean. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_forcing_windstress_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-
-      windStressOn = .true.
-      rho_ref = 1000.0
-
-      err = 0
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_forcing_windstress_init!}}}
-
-!***********************************************************************
-
-end module ocn_vel_forcing_windstress
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing_windstress.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_vel_forcing_windstress.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing_windstress.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_forcing_windstress.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,190 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_vel_forcing_windstress
+!
+!&gt; \brief MPAS ocean wind stress
+!&gt; \author Doug Jacobsen
+!&gt; \date   16 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the routine for computing 
+!&gt;  tendencies from wind stress.  
+!
+!-----------------------------------------------------------------------
+
+module ocn_vel_forcing_windstress
+
+   use mpas_grid_types
+   use mpas_configure
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_vel_forcing_windstress_tend, &amp;
+             ocn_vel_forcing_windstress_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: windStressOn
+   real (kind=RKIND) :: rho_ref
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_vel_forcing_windstress_tend
+!
+!&gt; \brief   Computes tendency term from wind stress
+!&gt; \author  Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the wind stress tendency for momentum
+!&gt;  based on current state.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_forcing_windstress_tend(grid, u_src, h_edge, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         u_src    !&lt; Input: wind stress
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge     !&lt; Input: thickness at edge
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdgesSolve, k
+      integer, dimension(:), pointer :: maxLevelEdgeTop
+
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not.windStressOn) return
+
+      nEdgesSolve = grid % nEdgesSolve
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+
+      do iEdge=1,nEdgesSolve
+
+        k = maxLevelEdgeTop(iEdge)
+
+        ! efficiency note: it would be nice to avoid this
+        ! if within a do.  This could be done with
+        ! k =  max(maxLevelEdgeTop(iEdge),1)
+        ! and then tend_u(1,iEdge) is just not used for land cells.
+
+        if (k&gt;0) then
+           ! forcing in top layer only
+           tend(1,iEdge) =  tend(1,iEdge) &amp;
+              + u_src(1,iEdge)/rho_ref/h_edge(1,iEdge)
+        endif
+
+      enddo
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_forcing_windstress_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_forcing_windstress_init
+!
+!&gt; \brief   Initializes ocean wind stress forcing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    16 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes quantities related to wind stress 
+!&gt;  in the ocean. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_forcing_windstress_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+
+      windStressOn = .true.
+      rho_ref = 1000.0
+
+      err = 0
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_forcing_windstress_init!}}}
+
+!***********************************************************************
+
+end module ocn_vel_forcing_windstress
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_vel_hmix.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,175 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_vel_hmix
-!
-!&gt; \brief MPAS ocean horizontal momentum mixing driver
-!&gt; \author Phil Jones, Doug Jacobsen
-!&gt; \date   15 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the main driver routine for computing 
-!&gt;  horizontal mixing tendencies.  
-!&gt;
-!&gt;  It provides an init and a tend function. Each are described below.
-!
-!-----------------------------------------------------------------------
-
-module ocn_vel_hmix
-
-   use grid_types
-   use configure
-   use ocn_vel_hmix_del2
-   use ocn_vel_hmix_del4
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_vel_hmix_tend, &amp;
-             ocn_vel_hmix_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_vel_hmix_tend
-!
-!&gt; \brief   Computes tendency term for horizontal momentum mixing
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the horizontal mixing tendency for momentum
-!&gt;  based on current state and user choices of mixing parameterization.
-!&gt;  Multiple parameterizations may be chosen and added together.  These
-!&gt;  tendencies are generally computed by calling the specific routine
-!&gt;  for the chosen parameterization, so this routine is primarily a
-!&gt;  driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_hmix_tend(grid, divergence, vorticity, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         divergence    !&lt; Input: velocity divergence
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         vorticity     !&lt; Input: vorticity
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: err1, err2
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      call ocn_vel_hmix_del2_tend(grid, divergence, vorticity, tend, err1)
-      call ocn_vel_hmix_del4_tend(grid, divergence, vorticity, tend, err2)
-
-      err = err1 .or. err2
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_hmix_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_hmix_init
-!
-!&gt; \brief   Initializes ocean momentum horizontal mixing quantities
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  horizontal velocity mixing in the ocean. Since a variety of 
-!&gt;  parameterizations are available, this routine primarily calls the
-!&gt;  individual init routines for each parameterization. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_hmix_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      integer :: err1, err2
-
-      call ocn_vel_hmix_del2_init(err1)
-      call ocn_vel_hmix_del4_init(err2)
-
-      err = err1 .or. err2
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_hmix_init!}}}
-
-!***********************************************************************
-
-end module ocn_vel_hmix
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_vel_hmix.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,175 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_vel_hmix
+!
+!&gt; \brief MPAS ocean horizontal momentum mixing driver
+!&gt; \author Phil Jones, Doug Jacobsen
+!&gt; \date   15 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the main driver routine for computing 
+!&gt;  horizontal mixing tendencies.  
+!&gt;
+!&gt;  It provides an init and a tend function. Each are described below.
+!
+!-----------------------------------------------------------------------
+
+module ocn_vel_hmix
+
+   use mpas_grid_types
+   use mpas_configure
+   use ocn_vel_hmix_del2
+   use ocn_vel_hmix_del4
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_vel_hmix_tend, &amp;
+             ocn_vel_hmix_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_vel_hmix_tend
+!
+!&gt; \brief   Computes tendency term for horizontal momentum mixing
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the horizontal mixing tendency for momentum
+!&gt;  based on current state and user choices of mixing parameterization.
+!&gt;  Multiple parameterizations may be chosen and added together.  These
+!&gt;  tendencies are generally computed by calling the specific routine
+!&gt;  for the chosen parameterization, so this routine is primarily a
+!&gt;  driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_hmix_tend(grid, divergence, vorticity, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         divergence    !&lt; Input: velocity divergence
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         vorticity     !&lt; Input: vorticity
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: err1, err2
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      call ocn_vel_hmix_del2_tend(grid, divergence, vorticity, tend, err1)
+      call ocn_vel_hmix_del4_tend(grid, divergence, vorticity, tend, err2)
+
+      err = err1 .or. err2
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_hmix_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_hmix_init
+!
+!&gt; \brief   Initializes ocean momentum horizontal mixing quantities
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  horizontal velocity mixing in the ocean. Since a variety of 
+!&gt;  parameterizations are available, this routine primarily calls the
+!&gt;  individual init routines for each parameterization. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_hmix_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      integer :: err1, err2
+
+      call ocn_vel_hmix_del2_init(err1)
+      call ocn_vel_hmix_del4_init(err2)
+
+      err = err1 .or. err2
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_hmix_init!}}}
+
+!***********************************************************************
+
+end module ocn_vel_hmix
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix_del2.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_vel_hmix_del2.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix_del2.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,225 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_vel_hmix_del2
-!
-!&gt; \brief Ocean horizontal mixing - Laplacian parameterization 
-!&gt; \author Phil Jones, Doug Jacobsen
-!&gt; \date   15 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains routines for computing horizontal mixing 
-!&gt;  tendencies using a Laplacian formulation.
-!
-!-----------------------------------------------------------------------
-
-module ocn_vel_hmix_del2
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_vel_hmix_del2_tend, &amp;
-             ocn_vel_hmix_del2_init
-
-   !-------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: &amp;
-      hmixDel2On         !&lt; local flag to determine whether del2 chosen
-
-   real (kind=RKIND) :: &amp;
-      eddyVisc2,        &amp;!&lt; base eddy diffusivity for Laplacian
-      viscVortCoef
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_vel_hmix_del2_tend
-!
-!&gt; \brief   Computes tendency term for Laplacian horizontal momentum mixing
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    22 August 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the horizontal mixing tendency for momentum
-!&gt;  based on a Laplacian form for the mixing, \f$</font>
<font color="black">u_2 </font>
<font color="red">abla^2 u\f$
-!&gt;  This tendency takes the
-!&gt;  form \f$</font>
<font color="black">u( </font>
<font color="black">abla divergence + k \times </font>
<font color="red">abla vorticity )\f$,
-!&gt;  where \f$</font>
<font color="red">u\f$ is a viscosity and \f$k\f$ is the vertical unit vector.
-!&gt;  This form is strictly only valid for constant \f$</font>
<font color="red">u\f$ .
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_hmix_del2_tend(grid, divergence, vorticity, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         divergence      !&lt; Input: velocity divergence
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         vorticity       !&lt; Input: vorticity
-
-      type (mesh_type), intent(in) :: &amp;
-         grid            !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         tend             !&lt; Input/Output: velocity tendency
-
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdgesSolve, cell1, cell2, vertex1, vertex2
-      integer :: k
-      integer, dimension(:), pointer :: maxLevelEdgeTop
-      integer, dimension(:,:), pointer :: cellsOnEdge, verticesOnEdge
-
-      real (kind=RKIND) :: u_diffusion
-      real (kind=RKIND), dimension(:), pointer :: meshScalingDel2, &amp;
-              dcEdge, dvEdge
-
-      !-----------------------------------------------------------------
-      !
-      ! exit if this mixing is not selected
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not.hmixDel2On) return
-
-      call timer_start(&quot;compute_tend_u-horiz mix-del2&quot;)
-      
-      nEdgesSolve = grid % nEdgesSolve
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      verticesOnEdge =&gt; grid % verticesOnEdge % array
-      meshScalingDel2 =&gt; grid % meshScalingDel2 % array
-      dcEdge =&gt; grid % dcEdge % array
-      dvEdge =&gt; grid % dvEdge % array
-
-      do iEdge=1,nEdgesSolve
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         vertex1 = verticesOnEdge(1,iEdge)
-         vertex2 = verticesOnEdge(2,iEdge)
-
-         do k=1,maxLevelEdgeTop(iEdge)
-
-            ! Here -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
-            ! is - </font>
<font color="red">abla vorticity pointing from vertex 2 to vertex 1, or equivalently 
-            !    + k \times </font>
<font color="gray">abla vorticity pointing from cell1 to cell2.
-
-            u_diffusion = ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-                          -viscVortCoef &amp;
-                          *( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
-
-            u_diffusion = meshScalingDel2(iEdge) * eddyVisc2 * u_diffusion
-
-            tend(k,iEdge) = tend(k,iEdge) + u_diffusion
-
-         end do
-      end do
-
-      call timer_stop(&quot;compute_tend_u-horiz mix-del2&quot;)
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_hmix_del2_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_hmix_del2_init
-!
-!&gt; \brief   Initializes ocean momentum Laplacian horizontal mixing
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  Laplacian horizontal momentum mixing in the ocean.  
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_hmix_del2_init(err)!{{{
-
-
-   integer, intent(out) :: err !&lt; Output: error flag
-
-   !--------------------------------------------------------------------
-   !
-   ! set some local module variables based on input config choices
-   !
-   !--------------------------------------------------------------------
-
-   err = 0
-
-   hmixDel2On = .false.
-
-   if ( config_h_mom_eddy_visc2 &gt; 0.0 ) then
-      hmixDel2On = .true.
-      eddyVisc2 = config_h_mom_eddy_visc2
-
-
-      if (config_visc_vorticity_term) then
-         viscVortCoef = 1.0
-      else
-         viscVortCoef = 0.0
-      endif
-   endif
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_hmix_del2_init!}}}
-
-!***********************************************************************
-
-end module ocn_vel_hmix_del2
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix_del2.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_vel_hmix_del2.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix_del2.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix_del2.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,225 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_vel_hmix_del2
+!
+!&gt; \brief Ocean horizontal mixing - Laplacian parameterization 
+!&gt; \author Phil Jones, Doug Jacobsen
+!&gt; \date   15 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains routines for computing horizontal mixing 
+!&gt;  tendencies using a Laplacian formulation.
+!
+!-----------------------------------------------------------------------
+
+module ocn_vel_hmix_del2
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_vel_hmix_del2_tend, &amp;
+             ocn_vel_hmix_del2_init
+
+   !-------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: &amp;
+      hmixDel2On         !&lt; local flag to determine whether del2 chosen
+
+   real (kind=RKIND) :: &amp;
+      eddyVisc2,        &amp;!&lt; base eddy diffusivity for Laplacian
+      viscVortCoef
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_vel_hmix_del2_tend
+!
+!&gt; \brief   Computes tendency term for Laplacian horizontal momentum mixing
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    22 August 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the horizontal mixing tendency for momentum
+!&gt;  based on a Laplacian form for the mixing, \f$</font>
<font color="black">u_2 </font>
<font color="blue">abla^2 u\f$
+!&gt;  This tendency takes the
+!&gt;  form \f$</font>
<font color="black">u( </font>
<font color="black">abla divergence + k \times </font>
<font color="blue">abla vorticity )\f$,
+!&gt;  where \f$</font>
<font color="blue">u\f$ is a viscosity and \f$k\f$ is the vertical unit vector.
+!&gt;  This form is strictly only valid for constant \f$</font>
<font color="blue">u\f$ .
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_hmix_del2_tend(grid, divergence, vorticity, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         divergence      !&lt; Input: velocity divergence
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         vorticity       !&lt; Input: vorticity
+
+      type (mesh_type), intent(in) :: &amp;
+         grid            !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         tend             !&lt; Input/Output: velocity tendency
+
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdgesSolve, cell1, cell2, vertex1, vertex2
+      integer :: k
+      integer, dimension(:), pointer :: maxLevelEdgeTop
+      integer, dimension(:,:), pointer :: cellsOnEdge, verticesOnEdge
+
+      real (kind=RKIND) :: u_diffusion
+      real (kind=RKIND), dimension(:), pointer :: meshScalingDel2, &amp;
+              dcEdge, dvEdge
+
+      !-----------------------------------------------------------------
+      !
+      ! exit if this mixing is not selected
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not.hmixDel2On) return
+
+      call mpas_timer_start(&quot;compute_tend_u-horiz mix-del2&quot;)
+      
+      nEdgesSolve = grid % nEdgesSolve
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      verticesOnEdge =&gt; grid % verticesOnEdge % array
+      meshScalingDel2 =&gt; grid % meshScalingDel2 % array
+      dcEdge =&gt; grid % dcEdge % array
+      dvEdge =&gt; grid % dvEdge % array
+
+      do iEdge=1,nEdgesSolve
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         vertex1 = verticesOnEdge(1,iEdge)
+         vertex2 = verticesOnEdge(2,iEdge)
+
+         do k=1,maxLevelEdgeTop(iEdge)
+
+            ! Here -( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
+            ! is - </font>
<font color="blue">abla vorticity pointing from vertex 2 to vertex 1, or equivalently 
+            !    + k \times </font>
<font color="gray">abla vorticity pointing from cell1 to cell2.
+
+            u_diffusion = ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
+                          -viscVortCoef &amp;
+                          *( vorticity(k,vertex2) - vorticity(k,vertex1) ) / dvEdge(iEdge)
+
+            u_diffusion = meshScalingDel2(iEdge) * eddyVisc2 * u_diffusion
+
+            tend(k,iEdge) = tend(k,iEdge) + u_diffusion
+
+         end do
+      end do
+
+      call mpas_timer_stop(&quot;compute_tend_u-horiz mix-del2&quot;)
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_hmix_del2_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_hmix_del2_init
+!
+!&gt; \brief   Initializes ocean momentum Laplacian horizontal mixing
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  Laplacian horizontal momentum mixing in the ocean.  
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_hmix_del2_init(err)!{{{
+
+
+   integer, intent(out) :: err !&lt; Output: error flag
+
+   !--------------------------------------------------------------------
+   !
+   ! set some local module variables based on input config choices
+   !
+   !--------------------------------------------------------------------
+
+   err = 0
+
+   hmixDel2On = .false.
+
+   if ( config_h_mom_eddy_visc2 &gt; 0.0 ) then
+      hmixDel2On = .true.
+      eddyVisc2 = config_h_mom_eddy_visc2
+
+
+      if (config_visc_vorticity_term) then
+         viscVortCoef = 1.0
+      else
+         viscVortCoef = 0.0
+      endif
+   endif
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_hmix_del2_init!}}}
+
+!***********************************************************************
+
+end module ocn_vel_hmix_del2
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix_del4.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_vel_hmix_del4.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix_del4.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,300 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_vel_hmix_del4
-!
-!&gt; \brief Ocean horizontal mixing - biharmonic parameterization
-!&gt; \author Phil Jones, Doug Jacobsen
-!&gt; \date   15 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains routines and variables for computing 
-!&gt;  horizontal mixing tendencies using a biharmonic formulation. 
-!
-!-----------------------------------------------------------------------
-
-module ocn_vel_hmix_del4
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_vel_hmix_del4_tend, &amp;
-             ocn_vel_hmix_del4_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: &amp;
-      hmixDel4On       !&lt; local flag to determine whether del4 chosen
-
-   real (kind=RKIND) :: &amp;
-      eddyVisc4,        &amp;!&lt; base eddy diffusivity for biharmonic
-      viscVortCoef
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_vel_hmix_del4_tend
-!
-!&gt; \brief   Computes tendency term for biharmonic horizontal momentum mixing
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the horizontal mixing tendency for momentum
-!&gt;  based on a biharmonic form for the mixing.  This mixing tendency
-!&gt;  takes the form  \f$-</font>
<font color="black">u_4 </font>
<font color="red">abla^4 u\f$
-!&gt;  but is computed as 
-!&gt;  \f$</font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="red">abla vorticity\f$
-!&gt;  applied recursively.
-!&gt;  This formulation is only valid for constant \f$</font>
<font color="red">u_4\f$ .
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_hmix_del4_tend(grid, divergence, vorticity, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         divergence      !&lt; Input: velocity divergence
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         vorticity       !&lt; Input: vorticity
-
-      type (mesh_type), intent(in) :: &amp;
-         grid           !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         tend       !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-    
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdges, cell1, cell2, vertex1, vertex2, k
-      integer :: iCell, iVertex
-      integer :: nVertices, nVertLevels, nCells
-
-      integer, dimension(:), pointer :: maxLevelEdgeTop, maxLevelVertexBot, &amp;
-            maxLevelCell
-      integer, dimension(:,:), pointer :: cellsOnEdge, verticesOnEdge
-
-
-      real (kind=RKIND) :: u_diffusion, r
-      real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, areaTriangle, &amp;
-            meshScalingDel4, areaCell
-
-      real (kind=RKIND), dimension(:,:), allocatable :: delsq_divergence, &amp;
-            delsq_u, delsq_circulation, delsq_vorticity
-
-      err = 0
-
-      if(.not.hmixDel4On) return
-
-      call timer_start(&quot;compute_tend-horiz mix-del4&quot;)
-
-      nCells = grid % nCells
-      nEdges = grid % nEdges
-      nVertices = grid % nVertices
-      nVertLevels = grid % nVertLevels
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-      maxLevelVertexBot =&gt; grid % maxLevelVertexBot % array
-      maxLevelCell =&gt; grid % maxLevelCell % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      verticesOnEdge =&gt; grid % verticesOnEdge % array
-      dcEdge =&gt; grid % dcEdge % array
-      dvEdge =&gt; grid % dvEdge % array
-      areaTriangle =&gt; grid % areaTriangle % array
-      areaCell =&gt; grid % areaCell % array
-      meshScalingDel4 =&gt; grid % meshScalingDel4 % array
-
-      allocate(delsq_divergence(nVertLevels, nCells+1))
-      allocate(delsq_u(nVertLevels, nEdges+1))
-      allocate(delsq_circulation(nVertLevels, nVertices+1))
-      allocate(delsq_vorticity(nVertLevels, nVertices+1))
-
-      delsq_u(:,:) = 0.0
-
-      ! Compute </font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="red">abla vorticity
-      do iEdge=1,grid % nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         vertex1 = verticesOnEdge(1,iEdge)
-         vertex2 = verticesOnEdge(2,iEdge)
-
-         do k=1,maxLevelEdgeTop(iEdge)
-
-            delsq_u(k,iEdge) = &amp; 
-               ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-               -viscVortCoef &amp;
-               *( vorticity(k,vertex2) - vorticity(k,vertex1)) / dvEdge(iEdge)
-
-         end do
-      end do
-
-      ! vorticity using </font>
<font color="red">abla^2 u
-      delsq_circulation(:,:) = 0.0
-      do iEdge=1,nEdges
-         vertex1 = verticesOnEdge(1,iEdge)
-         vertex2 = verticesOnEdge(2,iEdge)
-         do k=1,maxLevelEdgeTop(iEdge)
-            delsq_circulation(k,vertex1) = delsq_circulation(k,vertex1) &amp;
-               - dcEdge(iEdge) * delsq_u(k,iEdge)
-            delsq_circulation(k,vertex2) = delsq_circulation(k,vertex2) &amp;
-               + dcEdge(iEdge) * delsq_u(k,iEdge)
-         end do
-      end do
-      do iVertex=1,nVertices
-         r = 1.0 / areaTriangle(iVertex)
-         do k=1,maxLevelVertexBot(iVertex)
-            delsq_vorticity(k,iVertex) = delsq_circulation(k,iVertex) * r
-         end do
-      end do
-
-      ! Divergence using </font>
<font color="red">abla^2 u
-      delsq_divergence(:,:) = 0.0
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=1,maxLevelEdgeTop(iEdge)
-           delsq_divergence(k,cell1) = delsq_divergence(k,cell1) &amp;
-             + delsq_u(k,iEdge)*dvEdge(iEdge)
-           delsq_divergence(k,cell2) = delsq_divergence(k,cell2) &amp;
-             - delsq_u(k,iEdge)*dvEdge(iEdge)
-         end do
-      end do
-      do iCell = 1,nCells
-         r = 1.0 / areaCell(iCell)
-         do k = 1,maxLevelCell(iCell)
-            delsq_divergence(k,iCell) = delsq_divergence(k,iCell) * r
-         end do
-      end do
-
-      ! Compute - \kappa </font>
<font color="red">abla^4 u 
-      ! as  </font>
<font color="black">abla div(</font>
<font color="black">abla^2 u) + k \times </font>
<font color="black">abla ( k \cross curl(</font>
<font color="gray">abla^2 u) )
-      do iEdge=1,grid % nEdgesSolve
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         vertex1 = verticesOnEdge(1,iEdge)
-         vertex2 = verticesOnEdge(2,iEdge)
-
-         do k=1,maxLevelEdgeTop(iEdge)
-            delsq_u(k,iEdge) = &amp; 
-               ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-              -( vorticity(k,vertex2) - vorticity(k,vertex1)) / dvEdge(iEdge)
-
-            u_diffusion = (  delsq_divergence(k,cell2) &amp;
-                           - delsq_divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-                         -viscVortCoef &amp;
-                         *(  delsq_vorticity(k,vertex2) &amp;
-                           - delsq_vorticity(k,vertex1) ) / dvEdge(iEdge)
-
-            u_diffusion = meshScalingDel4(iEdge) * eddyVisc4 * u_diffusion
-
-            tend(k,iEdge) = tend(k,iEdge) - u_diffusion
-         end do
-      end do
-
-      deallocate(delsq_divergence)
-      deallocate(delsq_u)
-      deallocate(delsq_circulation)
-      deallocate(delsq_vorticity)
-
-      call timer_stop(&quot;compute_tend-horiz mix-del4&quot;)
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_hmix_del4_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_hmix_del4_init
-!
-!&gt; \brief   Initializes ocean momentum biharmonic horizontal mixing
-!&gt; \author  Phil Jones, Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  biharmonic horizontal tracer mixing in the ocean.  
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_hmix_del4_init(err)!{{{
-
-   integer, intent(out) :: err !&lt; Output: error flag
-
-   !--------------------------------------------------------------------
-   !
-   ! set some local module variables based on input config choices
-   !
-   !--------------------------------------------------------------------
-
-   err = 0
-
-   hmixDel4On = .false.
-
-   if ( config_h_mom_eddy_visc4 &gt; 0.0 ) then
-      hmixDel4On = .true.
-      eddyVisc4 = config_h_mom_eddy_visc4
-      if (config_visc_vorticity_term) then
-         viscVortCoef = 1.0
-      else
-         viscVortCoef = 0.0
-      endif
-
-   endif
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_hmix_del4_init!}}}
-
-!***********************************************************************
-
-end module ocn_vel_hmix_del4
-
-!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix_del4.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_vel_hmix_del4.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix_del4.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_hmix_del4.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,300 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_vel_hmix_del4
+!
+!&gt; \brief Ocean horizontal mixing - biharmonic parameterization
+!&gt; \author Phil Jones, Doug Jacobsen
+!&gt; \date   15 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains routines and variables for computing 
+!&gt;  horizontal mixing tendencies using a biharmonic formulation. 
+!
+!-----------------------------------------------------------------------
+
+module ocn_vel_hmix_del4
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_vel_hmix_del4_tend, &amp;
+             ocn_vel_hmix_del4_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: &amp;
+      hmixDel4On       !&lt; local flag to determine whether del4 chosen
+
+   real (kind=RKIND) :: &amp;
+      eddyVisc4,        &amp;!&lt; base eddy diffusivity for biharmonic
+      viscVortCoef
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_vel_hmix_del4_tend
+!
+!&gt; \brief   Computes tendency term for biharmonic horizontal momentum mixing
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the horizontal mixing tendency for momentum
+!&gt;  based on a biharmonic form for the mixing.  This mixing tendency
+!&gt;  takes the form  \f$-</font>
<font color="black">u_4 </font>
<font color="blue">abla^4 u\f$
+!&gt;  but is computed as 
+!&gt;  \f$</font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="blue">abla vorticity\f$
+!&gt;  applied recursively.
+!&gt;  This formulation is only valid for constant \f$</font>
<font color="blue">u_4\f$ .
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_hmix_del4_tend(grid, divergence, vorticity, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         divergence      !&lt; Input: velocity divergence
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         vorticity       !&lt; Input: vorticity
+
+      type (mesh_type), intent(in) :: &amp;
+         grid           !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         tend       !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+    
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdges, cell1, cell2, vertex1, vertex2, k
+      integer :: iCell, iVertex
+      integer :: nVertices, nVertLevels, nCells
+
+      integer, dimension(:), pointer :: maxLevelEdgeTop, maxLevelVertexBot, &amp;
+            maxLevelCell
+      integer, dimension(:,:), pointer :: cellsOnEdge, verticesOnEdge
+
+
+      real (kind=RKIND) :: u_diffusion, r
+      real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, areaTriangle, &amp;
+            meshScalingDel4, areaCell
+
+      real (kind=RKIND), dimension(:,:), allocatable :: delsq_divergence, &amp;
+            delsq_u, delsq_circulation, delsq_vorticity
+
+      err = 0
+
+      if(.not.hmixDel4On) return
+
+      call mpas_timer_start(&quot;compute_tend-horiz mix-del4&quot;)
+
+      nCells = grid % nCells
+      nEdges = grid % nEdges
+      nVertices = grid % nVertices
+      nVertLevels = grid % nVertLevels
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+      maxLevelVertexBot =&gt; grid % maxLevelVertexBot % array
+      maxLevelCell =&gt; grid % maxLevelCell % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      verticesOnEdge =&gt; grid % verticesOnEdge % array
+      dcEdge =&gt; grid % dcEdge % array
+      dvEdge =&gt; grid % dvEdge % array
+      areaTriangle =&gt; grid % areaTriangle % array
+      areaCell =&gt; grid % areaCell % array
+      meshScalingDel4 =&gt; grid % meshScalingDel4 % array
+
+      allocate(delsq_divergence(nVertLevels, nCells+1))
+      allocate(delsq_u(nVertLevels, nEdges+1))
+      allocate(delsq_circulation(nVertLevels, nVertices+1))
+      allocate(delsq_vorticity(nVertLevels, nVertices+1))
+
+      delsq_u(:,:) = 0.0
+
+      ! Compute </font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="blue">abla vorticity
+      do iEdge=1,grid % nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         vertex1 = verticesOnEdge(1,iEdge)
+         vertex2 = verticesOnEdge(2,iEdge)
+
+         do k=1,maxLevelEdgeTop(iEdge)
+
+            delsq_u(k,iEdge) = &amp; 
+               ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
+               -viscVortCoef &amp;
+               *( vorticity(k,vertex2) - vorticity(k,vertex1)) / dvEdge(iEdge)
+
+         end do
+      end do
+
+      ! vorticity using </font>
<font color="blue">abla^2 u
+      delsq_circulation(:,:) = 0.0
+      do iEdge=1,nEdges
+         vertex1 = verticesOnEdge(1,iEdge)
+         vertex2 = verticesOnEdge(2,iEdge)
+         do k=1,maxLevelEdgeTop(iEdge)
+            delsq_circulation(k,vertex1) = delsq_circulation(k,vertex1) &amp;
+               - dcEdge(iEdge) * delsq_u(k,iEdge)
+            delsq_circulation(k,vertex2) = delsq_circulation(k,vertex2) &amp;
+               + dcEdge(iEdge) * delsq_u(k,iEdge)
+         end do
+      end do
+      do iVertex=1,nVertices
+         r = 1.0 / areaTriangle(iVertex)
+         do k=1,maxLevelVertexBot(iVertex)
+            delsq_vorticity(k,iVertex) = delsq_circulation(k,iVertex) * r
+         end do
+      end do
+
+      ! Divergence using </font>
<font color="blue">abla^2 u
+      delsq_divergence(:,:) = 0.0
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         do k=1,maxLevelEdgeTop(iEdge)
+           delsq_divergence(k,cell1) = delsq_divergence(k,cell1) &amp;
+             + delsq_u(k,iEdge)*dvEdge(iEdge)
+           delsq_divergence(k,cell2) = delsq_divergence(k,cell2) &amp;
+             - delsq_u(k,iEdge)*dvEdge(iEdge)
+         end do
+      end do
+      do iCell = 1,nCells
+         r = 1.0 / areaCell(iCell)
+         do k = 1,maxLevelCell(iCell)
+            delsq_divergence(k,iCell) = delsq_divergence(k,iCell) * r
+         end do
+      end do
+
+      ! Compute - \kappa </font>
<font color="blue">abla^4 u 
+      ! as  </font>
<font color="black">abla div(</font>
<font color="black">abla^2 u) + k \times </font>
<font color="black">abla ( k \cross curl(</font>
<font color="gray">abla^2 u) )
+      do iEdge=1,grid % nEdgesSolve
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         vertex1 = verticesOnEdge(1,iEdge)
+         vertex2 = verticesOnEdge(2,iEdge)
+
+         do k=1,maxLevelEdgeTop(iEdge)
+            delsq_u(k,iEdge) = &amp; 
+               ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
+              -( vorticity(k,vertex2) - vorticity(k,vertex1)) / dvEdge(iEdge)
+
+            u_diffusion = (  delsq_divergence(k,cell2) &amp;
+                           - delsq_divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
+                         -viscVortCoef &amp;
+                         *(  delsq_vorticity(k,vertex2) &amp;
+                           - delsq_vorticity(k,vertex1) ) / dvEdge(iEdge)
+
+            u_diffusion = meshScalingDel4(iEdge) * eddyVisc4 * u_diffusion
+
+            tend(k,iEdge) = tend(k,iEdge) - u_diffusion
+         end do
+      end do
+
+      deallocate(delsq_divergence)
+      deallocate(delsq_u)
+      deallocate(delsq_circulation)
+      deallocate(delsq_vorticity)
+
+      call mpas_timer_stop(&quot;compute_tend-horiz mix-del4&quot;)
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_hmix_del4_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_hmix_del4_init
+!
+!&gt; \brief   Initializes ocean momentum biharmonic horizontal mixing
+!&gt; \author  Phil Jones, Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  biharmonic horizontal tracer mixing in the ocean.  
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_hmix_del4_init(err)!{{{
+
+   integer, intent(out) :: err !&lt; Output: error flag
+
+   !--------------------------------------------------------------------
+   !
+   ! set some local module variables based on input config choices
+   !
+   !--------------------------------------------------------------------
+
+   err = 0
+
+   hmixDel4On = .false.
+
+   if ( config_h_mom_eddy_visc4 &gt; 0.0 ) then
+      hmixDel4On = .true.
+      eddyVisc4 = config_h_mom_eddy_visc4
+      if (config_visc_vorticity_term) then
+         viscVortCoef = 1.0
+      else
+         viscVortCoef = 0.0
+      endif
+
+   endif
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_hmix_del4_init!}}}
+
+!***********************************************************************
+
+end module ocn_vel_hmix_del4
+
+!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_vel_pressure_grad.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_vel_pressure_grad.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_pressure_grad.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,195 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_vel_pressure_grad
-!
-!&gt; \brief MPAS ocean pressure gradient module
-!&gt; \author Doug Jacobsen
-!&gt; \date   15 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the routine for computing 
-!&gt;  tendencie from the horizontal pressure gradient.
-!&gt;
-!
-!-----------------------------------------------------------------------
-
-module ocn_vel_pressure_grad
-
-   use grid_types
-   use configure
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_vel_pressure_grad_tend, &amp;
-             ocn_vel_pressure_grad_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   real (kind=RKIND) :: rho0Inv
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_vel_pressure_grad_tend
-!
-!&gt; \brief   Computes tendency term for horizontal pressure gradient
-!&gt; \author  Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the pressure gradient tendency for momentum
-!&gt;  based on current state.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_pressure_grad_tend(grid, pressure, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         pressure !&lt; Input: Pressure field or Mongomery potential
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: nEdgesSolve, iEdge, k, cell1, cell2
-      integer, dimension(:), pointer :: maxLevelEdgeTop
-      integer, dimension(:,:), pointer :: cellsOnEdge
-
-      real (kind=RKIND), dimension(:), pointer :: dcEdge
-
-      err = 0
-
-      nEdgesSolve = grid % nEdgesSolve
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      dcEdge =&gt; grid % dcEdge % array
-
-      if (config_vert_grid_type.eq.'isopycnal') then
-        do iEdge=1,nEdgesSolve
-          cell1 = cellsOnEdge(1,iEdge)
-          cell2 = cellsOnEdge(2,iEdge)
-          do k=1,maxLevelEdgeTop(iEdge)
-             tend(k,iEdge) = tend(k,iEdge)     &amp;
-               - (pressure(k,cell2) - pressure(k,cell1))/dcEdge(iEdge)
-           end do
-        enddo
-      elseif (config_vert_grid_type.eq.'zlevel') then
-        do iEdge=1,nEdgesSolve
-          cell1 = cellsOnEdge(1,iEdge)
-          cell2 = cellsOnEdge(2,iEdge)
-          do k=1,maxLevelEdgeTop(iEdge)
-
-            tend(k,iEdge) = tend(k,iEdge)     &amp;
-              - rho0Inv*(  pressure(k,cell2) &amp;
-                         - pressure(k,cell1) )/dcEdge(iEdge)
-          end do
-
-        enddo
-      endif
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_pressure_grad_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_pressure_grad_init
-!
-!&gt; \brief   Initializes ocean momentum horizontal pressure gradient
-!&gt; \author  Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes parameters required for the computation of the
-!&gt;  horizontal pressure gradient.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_pressure_grad_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-
-      !-----------------------------------------------------------------
-      !
-      ! Output Variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if (config_vert_grid_type.eq.'isopycnal') then
-        rho0Inv = 1.0
-      elseif (config_vert_grid_type.eq.'zlevel') then
-        rho0Inv = 1.0/config_rho0
-      end if
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_pressure_grad_init!}}}
-
-!***********************************************************************
-
-end module ocn_vel_pressure_grad
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_vel_pressure_grad.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_vel_pressure_grad.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_vel_pressure_grad.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_pressure_grad.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,195 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_vel_pressure_grad
+!
+!&gt; \brief MPAS ocean pressure gradient module
+!&gt; \author Doug Jacobsen
+!&gt; \date   15 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the routine for computing 
+!&gt;  tendencie from the horizontal pressure gradient.
+!&gt;
+!
+!-----------------------------------------------------------------------
+
+module ocn_vel_pressure_grad
+
+   use mpas_grid_types
+   use mpas_configure
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_vel_pressure_grad_tend, &amp;
+             ocn_vel_pressure_grad_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   real (kind=RKIND) :: rho0Inv
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_vel_pressure_grad_tend
+!
+!&gt; \brief   Computes tendency term for horizontal pressure gradient
+!&gt; \author  Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the pressure gradient tendency for momentum
+!&gt;  based on current state.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_pressure_grad_tend(grid, pressure, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         pressure !&lt; Input: Pressure field or Mongomery potential
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: nEdgesSolve, iEdge, k, cell1, cell2
+      integer, dimension(:), pointer :: maxLevelEdgeTop
+      integer, dimension(:,:), pointer :: cellsOnEdge
+
+      real (kind=RKIND), dimension(:), pointer :: dcEdge
+
+      err = 0
+
+      nEdgesSolve = grid % nEdgesSolve
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      dcEdge =&gt; grid % dcEdge % array
+
+      if (config_vert_grid_type.eq.'isopycnal') then
+        do iEdge=1,nEdgesSolve
+          cell1 = cellsOnEdge(1,iEdge)
+          cell2 = cellsOnEdge(2,iEdge)
+          do k=1,maxLevelEdgeTop(iEdge)
+             tend(k,iEdge) = tend(k,iEdge)     &amp;
+               - (pressure(k,cell2) - pressure(k,cell1))/dcEdge(iEdge)
+           end do
+        enddo
+      elseif (config_vert_grid_type.eq.'zlevel') then
+        do iEdge=1,nEdgesSolve
+          cell1 = cellsOnEdge(1,iEdge)
+          cell2 = cellsOnEdge(2,iEdge)
+          do k=1,maxLevelEdgeTop(iEdge)
+
+            tend(k,iEdge) = tend(k,iEdge)     &amp;
+              - rho0Inv*(  pressure(k,cell2) &amp;
+                         - pressure(k,cell1) )/dcEdge(iEdge)
+          end do
+
+        enddo
+      endif
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_pressure_grad_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_pressure_grad_init
+!
+!&gt; \brief   Initializes ocean momentum horizontal pressure gradient
+!&gt; \author  Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes parameters required for the computation of the
+!&gt;  horizontal pressure gradient.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_pressure_grad_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+
+      !-----------------------------------------------------------------
+      !
+      ! Output Variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if (config_vert_grid_type.eq.'isopycnal') then
+        rho0Inv = 1.0
+      elseif (config_vert_grid_type.eq.'zlevel') then
+        rho0Inv = 1.0/config_rho0
+      end if
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_pressure_grad_init!}}}
+
+!***********************************************************************
+
+end module ocn_vel_pressure_grad
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_vel_vadv.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_vel_vadv.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_vadv.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,195 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_vel_vadv
-!
-!&gt; \brief MPAS ocean vertical advection 
-!&gt; \author Doug Jacobsen
-!&gt; \date   15 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the routine for computing 
-!&gt;  tendencies for vertical advection.
-!&gt;
-!
-!-----------------------------------------------------------------------
-
-module ocn_vel_vadv
-
-   use grid_types
-   use configure
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_vel_vadv_tend, &amp;
-             ocn_vel_vadv_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: velVadvOn
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_vel_vadv_tend
-!
-!&gt; \brief   Computes tendency term for vertical advection
-!&gt; \author  Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical advection tendency for momentum
-!&gt;  based on current state.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_vadv_tend(grid, u, wTop, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         u     !&lt; Input: Horizontal velocity
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         wTop  !&lt; Input: Vertical velocity on top layer
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: velocity tendency
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdgesSolve, cell1, cell2, k
-      integer :: nVertLevels
-      integer, dimension(:), pointer :: maxLevelEdgeTop
-      integer, dimension(:,:), pointer :: cellsOnEdge
-
-      real :: wTopEdge
-      real, dimension(:), allocatable :: w_dudzTopEdge
-      real, dimension(:), pointer :: zMidZLevel
-
-      if(.not.velVadvOn) return
-
-      err = 0
-
-      nVertLevels = grid % nVertLevels
-      nEdgesSolve = grid % nEdgesSolve
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      zMidZLevel =&gt; grid % zMidZLevel % array
-
-      allocate(w_dudzTopEdge(nVertLevels+1))
-      w_dudzTopEdge(1) = 0.0
-      do iEdge=1,nEdgesSolve
-        cell1 = cellsOnEdge(1,iEdge)
-        cell2 = cellsOnEdge(2,iEdge)
-
-        do k=2,maxLevelEdgeTop(iEdge)
-          ! Average w from cell center to edge
-          wTopEdge = 0.5*(wTop(k,cell1)+wTop(k,cell2))
-
-          ! compute dudz at vertical interface with first order derivative.
-          w_dudzTopEdge(k) = wTopEdge * (u(k-1,iEdge)-u(k,iEdge)) &amp;
-                       / (zMidZLevel(k-1) - zMidZLevel(k))
-        end do
-        w_dudzTopEdge(maxLevelEdgeTop(iEdge)+1) = 0.0
-        ! Average w*du/dz from vertical interface to vertical middle of cell
-        do k=1,maxLevelEdgeTop(iEdge)
-
-          tend(k,iEdge) = tend(k,iEdge) &amp;
-             - 0.5 * (w_dudzTopEdge(k) + w_dudzTopEdge(k+1))
-        enddo
-      enddo
-      deallocate(w_dudzTopEdge)
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_vadv_tend!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_vadv_init
-!
-!&gt; \brief   Initializes ocean momentum vertical advection
-!&gt; \author  Doug Jacobsen
-!&gt; \date    15 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  vertical velocity advection in the ocean. 
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_vadv_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! Output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-      velVadvOn = .false.
-
-      if (config_vert_grid_type.eq.'zlevel') then
-          velVadvOn = .true.
-      end if
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_vadv_init!}}}
-
-!***********************************************************************
-
-end module ocn_vel_vadv
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_vel_vadv.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_vel_vadv.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_vel_vadv.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vel_vadv.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,195 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_vel_vadv
+!
+!&gt; \brief MPAS ocean vertical advection 
+!&gt; \author Doug Jacobsen
+!&gt; \date   15 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the routine for computing 
+!&gt;  tendencies for vertical advection.
+!&gt;
+!
+!-----------------------------------------------------------------------
+
+module ocn_vel_vadv
+
+   use mpas_grid_types
+   use mpas_configure
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_vel_vadv_tend, &amp;
+             ocn_vel_vadv_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: velVadvOn
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_vel_vadv_tend
+!
+!&gt; \brief   Computes tendency term for vertical advection
+!&gt; \author  Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical advection tendency for momentum
+!&gt;  based on current state.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_vadv_tend(grid, u, wTop, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         u     !&lt; Input: Horizontal velocity
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         wTop  !&lt; Input: Vertical velocity on top layer
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: velocity tendency
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdgesSolve, cell1, cell2, k
+      integer :: nVertLevels
+      integer, dimension(:), pointer :: maxLevelEdgeTop
+      integer, dimension(:,:), pointer :: cellsOnEdge
+
+      real :: wTopEdge
+      real, dimension(:), allocatable :: w_dudzTopEdge
+      real, dimension(:), pointer :: zMidZLevel
+
+      if(.not.velVadvOn) return
+
+      err = 0
+
+      nVertLevels = grid % nVertLevels
+      nEdgesSolve = grid % nEdgesSolve
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      zMidZLevel =&gt; grid % zMidZLevel % array
+
+      allocate(w_dudzTopEdge(nVertLevels+1))
+      w_dudzTopEdge(1) = 0.0
+      do iEdge=1,nEdgesSolve
+        cell1 = cellsOnEdge(1,iEdge)
+        cell2 = cellsOnEdge(2,iEdge)
+
+        do k=2,maxLevelEdgeTop(iEdge)
+          ! Average w from cell center to edge
+          wTopEdge = 0.5*(wTop(k,cell1)+wTop(k,cell2))
+
+          ! compute dudz at vertical interface with first order derivative.
+          w_dudzTopEdge(k) = wTopEdge * (u(k-1,iEdge)-u(k,iEdge)) &amp;
+                       / (zMidZLevel(k-1) - zMidZLevel(k))
+        end do
+        w_dudzTopEdge(maxLevelEdgeTop(iEdge)+1) = 0.0
+        ! Average w*du/dz from vertical interface to vertical middle of cell
+        do k=1,maxLevelEdgeTop(iEdge)
+
+          tend(k,iEdge) = tend(k,iEdge) &amp;
+             - 0.5 * (w_dudzTopEdge(k) + w_dudzTopEdge(k+1))
+        enddo
+      enddo
+      deallocate(w_dudzTopEdge)
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_vadv_tend!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_vadv_init
+!
+!&gt; \brief   Initializes ocean momentum vertical advection
+!&gt; \author  Doug Jacobsen
+!&gt; \date    15 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  vertical velocity advection in the ocean. 
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_vadv_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! Output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+      velVadvOn = .false.
+
+      if (config_vert_grid_type.eq.'zlevel') then
+          velVadvOn = .true.
+      end if
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_vadv_init!}}}
+
+!***********************************************************************
+
+end module ocn_vel_vadv
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_vmix.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_vmix.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vmix.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,724 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_vmix
-!
-!&gt; \brief MPAS ocean vertical mixing driver
-!&gt; \author Doug Jacobsen
-!&gt; \date   19 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module is the main driver for 
-!&gt;  vertical mixing in the ocean. 
-!&gt;
-!
-!-----------------------------------------------------------------------
-
-module ocn_vmix
-
-   use grid_types
-   use configure
-   use timer
-
-   use ocn_vmix_coefs_const
-   use ocn_vmix_coefs_tanh
-   use ocn_vmix_coefs_rich
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   private :: tridiagonal_solve, &amp;
-              tridiagonal_solve_mult
-
-   public :: ocn_vmix_coefs, &amp;
-             ocn_vel_vmix_tend_explicit, &amp;
-             ocn_tracer_vmix_tend_explicit, &amp;
-             ocn_vel_vmix_tend_implicit, &amp;
-             ocn_tracer_vmix_tend_implicit, &amp;
-             ocn_vmix_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: explicitOn, implicitOn
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_vmix_coefs
-!
-!&gt; \brief   Computes coefficients for vertical mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical mixing coefficients for momentum
-!&gt;  and tracers based user choices of mixing parameterization.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vmix_coefs(grid, s, d, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      type (state_type), intent(inout) :: &amp;
-         s             !&lt; Input/Output: state information
-
-      type (diagnostics_type), intent(inout) :: &amp;
-         d             !&lt; Input/Output: diagnostic information
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: err1, err2, err3
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing coefficients
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      call ocn_vmix_coefs_const_build(grid, s, d, err1)
-      call ocn_vmix_coefs_tanh_build(grid, s, d, err2)
-      call ocn_vmix_coefs_rich_build(grid, s, d, err3)
-
-      err = err1 .or. err2 .or. err3
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vmix_coefs!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_vmix_tendExplict
-!
-!&gt; \brief   Computes tendencies for explict momentum vertical mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the tendencies for explicit vertical mixing for momentum
-!&gt;  using computed coefficients.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_vmix_tend_explicit(grid, u, h_edge, vertViscTopOfEdge, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         u             !&lt; Input: velocity
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge        !&lt; Input: thickness at edge
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         vertViscTopOfEdge !&lt; Input: vertical mixing coefficients
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: tendency information
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdgesSolve, k, nVertLevels
-
-      integer, dimension(:), pointer :: maxLevelEdgeTop
-
-      real (kind=RKIND), dimension(:), allocatable :: fluxVertTop
-
-      err = 0
-
-      if(implicitOn) return
-
-      call timer_start(&quot;compute_tend_u-explicit vert mix&quot;)
-
-      nEdgessolve = grid % nEdgesSolve
-      nVertLevels = grid % nVertLevels
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-
-      allocate(fluxVertTop(nVertLevels+1))
-      fluxVertTop(1) = 0.0
-      do iEdge=1,nEdgesSolve
-         do k=2,maxLevelEdgeTop(iEdge)
-           fluxVertTop(k) = vertViscTopOfEdge(k,iEdge) &amp;
-              * ( u(k-1,iEdge) - u(k,iEdge) ) &amp;
-              * 2 / (h_edge(k-1,iEdge) + h_edge(k,iEdge))
-         enddo
-         fluxVertTop(maxLevelEdgeTop(iEdge)+1) = 0.0
-
-         do k=1,maxLevelEdgeTop(iEdge)
-           tend(k,iEdge) = tend(k,iEdge) &amp;
-             + (fluxVertTop(k) - fluxVertTop(k+1)) &amp;
-             / h_edge(k,iEdge)
-         enddo
-
-      end do
-      deallocate(fluxVertTop)
-
-      call timer_stop(&quot;compute_tend_u-explicit vert mix&quot;)
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_vmix_tend_explicit!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_vmix_tend_implicit
-!
-!&gt; \brief   Computes tendencies for implicit momentum vertical mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the tendencies for implicit vertical mixing for momentum
-!&gt;  using computed coefficients.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_vmix_tend_implicit(grid, dt, ke_edge, vertViscTopOfEdge, h, h_edge, u, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         ke_edge        !&lt; Input: kinetic energy at edge
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         vertViscTopOfEdge !&lt; Input: vertical mixing coefficients
-
-      real (kind=RKIND), intent(in) :: &amp;
-         dt            !&lt; Input: time step
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h             !&lt; Input: thickness at cell center
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         u             !&lt; Input: velocity
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
-         h_edge        !&lt; Input: thickness at edge
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdges, k, cell1, cell2, nVertLevels
-
-      integer, dimension(:), pointer :: maxLevelEdgeTop
-
-      integer, dimension(:,:), pointer :: cellsOnEdge
-
-      real (kind=RKIND), dimension(:), allocatable :: A, C, uTemp
-
-      err = 0
-
-      if(explicitOn) return
-
-      nEdges = grid % nEdges
-      nVertLevels = grid % nVertLevels
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-
-      allocate(A(nVertLevels),C(nVertLevels),uTemp(nVertLevels)) 
-
-      do iEdge=1,nEdges
-        if (maxLevelEdgeTop(iEdge).gt.0) then
-
-         ! Compute A(k), C(k) for momentum
-         ! mrp 110315 efficiency note: for z-level, could precompute
-         ! -2.0*dt/(h(k)_h(k+1))/h(k) in setup
-         ! h_edge is computed in compute_solve_diag, and is not available yet.
-         ! This could be removed if hZLevel used instead.
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=1,maxLevelEdgeTop(iEdge)
-            h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
-         end do
-
-         do k=1,maxLevelEdgeTop(iEdge)-1
-            A(k) = -2.0*dt*vertViscTopOfEdge(k+1,iEdge) &amp;
-               / (h_edge(k,iEdge) + h_edge(k+1,iEdge)) &amp;
-               / h_edge(k,iEdge)
-         enddo
-         A(maxLevelEdgeTop(iEdge)) = -dt*config_bottom_drag_coeff  &amp;
-            *sqrt(2.0*ke_edge(k,iEdge))/h_edge(k,iEdge)
-
-         C(1) = 1 - A(1)
-         do k=2,maxLevelEdgeTop(iEdge)
-            C(k) = 1 - A(k) - A(k-1)
-         enddo
-
-         call tridiagonal_solve(A,C,A,u(:,iEdge),uTemp,maxLevelEdgeTop(iEdge))
-
-         u(1:maxLevelEdgeTop(iEdge),iEdge) = uTemp(1:maxLevelEdgeTop(iEdge))
-         u(maxLevelEdgeTop(iEdge)+1:nVertLevels,iEdge) = 0.0
-
-        end if
-      end do
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_vmix_tend_implicit!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vmix_tendExplict
-!
-!&gt; \brief   Computes tendencies for explict tracer vertical mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the tendencies for explicit vertical mixing for
-!&gt;  tracers using computed coefficients.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vmix_tend_explicit(grid, h, vertDiffTopOfCell, tracers, tend, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h        !&lt; Input: thickness at cell center
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         vertDiffTopOfCell !&lt; Input: vertical mixing coefficients
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
-         tracers             !&lt; Input: tracers
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tend          !&lt; Input/Output: tendency information
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iCell, nCellsSolve, k, iTracer, num_tracers, nVertLevels
-
-      integer, dimension(:), pointer :: maxLevelCell
-
-      real (kind=RKIND), dimension(:,:), allocatable :: fluxVertTop
-
-      err = 0
-
-      if(implicitOn) return
-
-      call timer_start(&quot;compute_scalar_tend-explicit vert diff&quot;)
-
-      nCellsSolve = grid % nCellsSolve
-      nVertLevels = grid % nVertLevels
-      num_tracers = size(tracers, dim=1)
-
-      maxLevelCell =&gt; grid % maxLevelCell % array
-
-      allocate(fluxVertTop(num_tracers,nVertLevels+1))
-      fluxVertTop(:,1) = 0.0
-      do iCell=1,nCellsSolve 
-
-         do k=2,maxLevelCell(iCell)
-           do iTracer=1,num_tracers
-             ! compute \kappa_v d\phi/dz
-             fluxVertTop(iTracer,k) = vertDiffTopOfCell(k,iCell) &amp;
-                * (   tracers(iTracer,k-1,iCell)    &amp;
-                    - tracers(iTracer,k  ,iCell) )  &amp;
-                * 2 / (h(k-1,iCell) + h(k,iCell))
-
-           enddo
-         enddo
-         fluxVertTop(:,maxLevelCell(iCell)+1) = 0.0
-
-         do k=1,maxLevelCell(iCell)
-           do iTracer=1,num_tracers
-             ! This is h d/dz( fluxVertTop) but h and dz cancel, so 
-             ! reduces to delta( fluxVertTop)
-             tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &amp;
-               + fluxVertTop(iTracer,k) - fluxVertTop(iTracer,k+1)
-           enddo
-         enddo
-!print '(a,50e12.2)', 'fluxVertTop',fluxVertTop(3,1:maxLevelCell(iCell)+1)
-!print '(a,50e12.2)', 'tend_tr    ',tend_tr(3,1,1:maxLevelCell(iCell))
-      enddo ! iCell loop
-      deallocate(fluxVertTop)
-
-      call timer_stop(&quot;compute_scalar_tend-explicit vert diff&quot;)
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vmix_tend_explicit!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vmix_tend_implicit
-!
-!&gt; \brief   Computes tendencies for implicit tracer vertical mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the tendencies for implicit vertical mixing for
-!&gt;  tracers using computed coefficients.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vmix_tend_implicit(grid, dt, vertDiffTopOfCell, h, tracers, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         vertDiffTopOfCell !&lt; Input: vertical mixing coefficients
-
-      real (kind=RKIND), intent(in) :: &amp;
-         dt            !&lt; Input: time step
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h             !&lt; Input: thickness at cell center
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
-         tracers        !&lt; Input: tracers
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iCell, nCells, k, nVertLevels, num_tracers
-
-      integer, dimension(:), pointer :: maxLevelCell
-
-      real (kind=RKIND), dimension(:), allocatable :: A, C
-      real (kind=RKIND), dimension(:,:), allocatable :: tracersTemp
-
-      err = 0
-
-      if(explicitOn) return
-
-      nCells = grid % nCells
-      nVertLevels = grid % nVertLevels
-      num_tracers = size(tracers, dim=1)
-      maxLevelCell =&gt; grid % maxLevelCell % array
-
-      allocate(A(nVertLevels),C(nVertLevels), tracersTemp(num_tracers,nVertLevels))
-
-      do iCell=1,nCells
-         ! Compute A(k), C(k) for tracers
-         ! mrp 110315 efficiency note: for z-level, could precompute
-         ! -2.0*dt/(h(k)_h(k+1))/h(k) in setup
-         do k=1,maxLevelCell(iCell)-1
-            A(k) = -2.0*dt*vertDiffTopOfCell(k+1,iCell) &amp;
-                 / (h(k,iCell) + h(k+1,iCell)) / h(k,iCell)
-         enddo
-
-         A(maxLevelCell(iCell)) = 0.0
-
-         C(1) = 1 - A(1)
-         do k=2,maxLevelCell(iCell)
-            C(k) = 1 - A(k) - A(k-1)
-         enddo
-
-         call tridiagonal_solve_mult(A,C,A,tracers(:,:,iCell), &amp;
-              tracersTemp, maxLevelCell(iCell), nVertLevels,num_tracers)
-
-         tracers(:,1:maxLevelCell(iCell),iCell) = tracersTemp(:,1:maxLevelCell(iCell))
-         tracers(:,maxLevelCell(iCell)+1:nVertLevels,iCell) = -1e34
-      end do
-      deallocate(A,C,tracersTemp)
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vmix_tend_implicit!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vmix_init
-!
-!&gt; \brief   Initializes ocean vertical mixing quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  vertical mixing in the ocean. This primarily determines if
-!&gt;  explicit or implicit vertical mixing is to be used.
-!
-!-----------------------------------------------------------------------
-
-
-   subroutine ocn_vmix_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      integer :: err1, err2, err3
-
-      err = 0
-
-      explicitOn = .true.
-      implicitOn = .false.
-
-      if(config_implicit_vertical_mix) then
-          explicitOn = .false.
-          implicitOn =.true.
-      end if
-
-      call ocn_vmix_coefs_const_init(err1)
-      call ocn_vmix_coefs_tanh_init(err2)
-      call ocn_vmix_coefs_rich_init(err3)
-
-      err = err .or. err1 .or. err2 .or. err3
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vmix_init!}}}
-
-subroutine tridiagonal_solve(a,b,c,r,x,n)!{{{
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Solve the matrix equation Ax=r for x, where A is tridiagonal.
-! A is an nxn matrix, with:
-!   a sub-diagonal, filled from 1:n-1 (a(1) appears on row 2)
-!   b diagonal, filled from 1:n
-!   c sup-diagonal, filled from 1:n-1  (c(1) apears on row 1)
-!
-! Input: a,b,c,r,n
-!
-! Output: x
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

-   implicit none
-
-   integer,intent(in) :: n
-   real (KIND=RKIND), dimension(n), intent(in) :: a,b,c,r
-   real (KIND=RKIND), dimension(n), intent(out) :: x
-   real (KIND=RKIND), dimension(n) :: bTemp,rTemp
-   real (KIND=RKIND) :: m
-   integer i
-
-   call timer_start(&quot;tridiagonal_solve&quot;)

-   ! Use work variables for b and r
-   bTemp(1) = b(1)
-   rTemp(1) = r(1)

-   ! First pass: set the coefficients
-   do i = 2,n
-      m = a(i-1)/bTemp(i-1)
-      bTemp(i) = b(i) - m*c(i-1)
-      rTemp(i) = r(i) - m*rTemp(i-1)
-   end do 

-   x(n) = rTemp(n)/bTemp(n)
-   ! Second pass: back-substition
-   do i = n-1, 1, -1
-      x(i) = (rTemp(i) - c(i)*x(i+1))/bTemp(i)
-   end do
-
-   call timer_stop(&quot;tridiagonal_solve&quot;)

-end subroutine tridiagonal_solve!}}}
-
-subroutine tridiagonal_solve_mult(a,b,c,r,x,n,nDim,nSystems)!{{{
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! Solve the matrix equation Ax=r for x, where A is tridiagonal.
-! A is an nxn matrix, with:
-!   a sub-diagonal, filled from 1:n-1 (a(1) appears on row 2)
-!   b diagonal, filled from 1:n
-!   c sup-diagonal, filled from 1:n-1  (c(1) apears on row 1)
-!
-! Input: a,b,c,r,n
-!
-! Output: x
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

-   implicit none
-
-   integer,intent(in) :: n, nDim, nSystems
-   real (KIND=RKIND), dimension(n), intent(in) :: a,b,c
-   real (KIND=RKIND), dimension(nSystems,nDim), intent(in) :: r
-   real (KIND=RKIND), dimension(nSystems,nDim), intent(out) :: x
-   real (KIND=RKIND), dimension(n) :: bTemp
-   real (KIND=RKIND), dimension(nSystems,n) :: rTemp
-   real (KIND=RKIND) :: m
-   integer i,j
-
-   call timer_start(&quot;tridiagonal_solve_mult&quot;)

-   ! Use work variables for b and r
-   bTemp(1) = b(1)
-   do j = 1,nSystems
-      rTemp(j,1) = r(j,1)
-   end do

-   ! First pass: set the coefficients
-   do i = 2,n
-      m = a(i-1)/bTemp(i-1)
-      bTemp(i) = b(i) - m*c(i-1)
-      do j = 1,nSystems
-         rTemp(j,i) = r(j,i) - m*rTemp(j,i-1)
-      end do 
-   end do 

-   do j = 1,nSystems
-      x(j,n) = rTemp(j,n)/bTemp(n)
-   end do
-   ! Second pass: back-substition
-   do i = n-1, 1, -1
-      do j = 1,nSystems
-         x(j,i) = (rTemp(j,i) - c(i)*x(j,i+1))/bTemp(i)
-      end do
-   end do

-   call timer_stop(&quot;tridiagonal_solve_mult&quot;)
-
-end subroutine tridiagonal_solve_mult!}}}
-
-!***********************************************************************
-
-end module ocn_vmix
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_vmix.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_vmix.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_vmix.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vmix.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,724 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_vmix
+!
+!&gt; \brief MPAS ocean vertical mixing driver
+!&gt; \author Doug Jacobsen
+!&gt; \date   19 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module is the main driver for 
+!&gt;  vertical mixing in the ocean. 
+!&gt;
+!
+!-----------------------------------------------------------------------
+
+module ocn_vmix
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   use ocn_vmix_coefs_const
+   use ocn_vmix_coefs_tanh
+   use ocn_vmix_coefs_rich
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   private :: tridiagonal_solve, &amp;
+              tridiagonal_solve_mult
+
+   public :: ocn_vmix_coefs, &amp;
+             ocn_vel_vmix_tend_explicit, &amp;
+             ocn_tracer_vmix_tend_explicit, &amp;
+             ocn_vel_vmix_tend_implicit, &amp;
+             ocn_tracer_vmix_tend_implicit, &amp;
+             ocn_vmix_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: explicitOn, implicitOn
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_vmix_coefs
+!
+!&gt; \brief   Computes coefficients for vertical mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical mixing coefficients for momentum
+!&gt;  and tracers based user choices of mixing parameterization.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vmix_coefs(grid, s, d, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      type (state_type), intent(inout) :: &amp;
+         s             !&lt; Input/Output: state information
+
+      type (diagnostics_type), intent(inout) :: &amp;
+         d             !&lt; Input/Output: diagnostic information
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: err1, err2, err3
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing coefficients
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      call ocn_vmix_coefs_const_build(grid, s, d, err1)
+      call ocn_vmix_coefs_tanh_build(grid, s, d, err2)
+      call ocn_vmix_coefs_rich_build(grid, s, d, err3)
+
+      err = err1 .or. err2 .or. err3
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vmix_coefs!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_vmix_tendExplict
+!
+!&gt; \brief   Computes tendencies for explict momentum vertical mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the tendencies for explicit vertical mixing for momentum
+!&gt;  using computed coefficients.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_vmix_tend_explicit(grid, u, h_edge, vertViscTopOfEdge, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         u             !&lt; Input: velocity
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge        !&lt; Input: thickness at edge
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         vertViscTopOfEdge !&lt; Input: vertical mixing coefficients
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: tendency information
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdgesSolve, k, nVertLevels
+
+      integer, dimension(:), pointer :: maxLevelEdgeTop
+
+      real (kind=RKIND), dimension(:), allocatable :: fluxVertTop
+
+      err = 0
+
+      if(implicitOn) return
+
+      call mpas_timer_start(&quot;compute_tend_u-explicit vert mix&quot;)
+
+      nEdgessolve = grid % nEdgesSolve
+      nVertLevels = grid % nVertLevels
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+
+      allocate(fluxVertTop(nVertLevels+1))
+      fluxVertTop(1) = 0.0
+      do iEdge=1,nEdgesSolve
+         do k=2,maxLevelEdgeTop(iEdge)
+           fluxVertTop(k) = vertViscTopOfEdge(k,iEdge) &amp;
+              * ( u(k-1,iEdge) - u(k,iEdge) ) &amp;
+              * 2 / (h_edge(k-1,iEdge) + h_edge(k,iEdge))
+         enddo
+         fluxVertTop(maxLevelEdgeTop(iEdge)+1) = 0.0
+
+         do k=1,maxLevelEdgeTop(iEdge)
+           tend(k,iEdge) = tend(k,iEdge) &amp;
+             + (fluxVertTop(k) - fluxVertTop(k+1)) &amp;
+             / h_edge(k,iEdge)
+         enddo
+
+      end do
+      deallocate(fluxVertTop)
+
+      call mpas_timer_stop(&quot;compute_tend_u-explicit vert mix&quot;)
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_vmix_tend_explicit!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_vmix_tend_implicit
+!
+!&gt; \brief   Computes tendencies for implicit momentum vertical mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the tendencies for implicit vertical mixing for momentum
+!&gt;  using computed coefficients.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_vmix_tend_implicit(grid, dt, ke_edge, vertViscTopOfEdge, h, h_edge, u, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         ke_edge        !&lt; Input: kinetic energy at edge
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         vertViscTopOfEdge !&lt; Input: vertical mixing coefficients
+
+      real (kind=RKIND), intent(in) :: &amp;
+         dt            !&lt; Input: time step
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h             !&lt; Input: thickness at cell center
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         u             !&lt; Input: velocity
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: &amp;
+         h_edge        !&lt; Input: thickness at edge
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdges, k, cell1, cell2, nVertLevels
+
+      integer, dimension(:), pointer :: maxLevelEdgeTop
+
+      integer, dimension(:,:), pointer :: cellsOnEdge
+
+      real (kind=RKIND), dimension(:), allocatable :: A, C, uTemp
+
+      err = 0
+
+      if(explicitOn) return
+
+      nEdges = grid % nEdges
+      nVertLevels = grid % nVertLevels
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+
+      allocate(A(nVertLevels),C(nVertLevels),uTemp(nVertLevels)) 
+
+      do iEdge=1,nEdges
+        if (maxLevelEdgeTop(iEdge).gt.0) then
+
+         ! Compute A(k), C(k) for momentum
+         ! mrp 110315 efficiency note: for z-level, could precompute
+         ! -2.0*dt/(h(k)_h(k+1))/h(k) in setup
+         ! h_edge is computed in compute_solve_diag, and is not available yet.
+         ! This could be removed if hZLevel used instead.
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         do k=1,maxLevelEdgeTop(iEdge)
+            h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
+         end do
+
+         do k=1,maxLevelEdgeTop(iEdge)-1
+            A(k) = -2.0*dt*vertViscTopOfEdge(k+1,iEdge) &amp;
+               / (h_edge(k,iEdge) + h_edge(k+1,iEdge)) &amp;
+               / h_edge(k,iEdge)
+         enddo
+         A(maxLevelEdgeTop(iEdge)) = -dt*config_bottom_drag_coeff  &amp;
+            *sqrt(2.0*ke_edge(k,iEdge))/h_edge(k,iEdge)
+
+         C(1) = 1 - A(1)
+         do k=2,maxLevelEdgeTop(iEdge)
+            C(k) = 1 - A(k) - A(k-1)
+         enddo
+
+         call tridiagonal_solve(A,C,A,u(:,iEdge),uTemp,maxLevelEdgeTop(iEdge))
+
+         u(1:maxLevelEdgeTop(iEdge),iEdge) = uTemp(1:maxLevelEdgeTop(iEdge))
+         u(maxLevelEdgeTop(iEdge)+1:nVertLevels,iEdge) = 0.0
+
+        end if
+      end do
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_vmix_tend_implicit!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vmix_tendExplict
+!
+!&gt; \brief   Computes tendencies for explict tracer vertical mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the tendencies for explicit vertical mixing for
+!&gt;  tracers using computed coefficients.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vmix_tend_explicit(grid, h, vertDiffTopOfCell, tracers, tend, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h        !&lt; Input: thickness at cell center
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         vertDiffTopOfCell !&lt; Input: vertical mixing coefficients
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: &amp;
+         tracers             !&lt; Input: tracers
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tend          !&lt; Input/Output: tendency information
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iCell, nCellsSolve, k, iTracer, num_tracers, nVertLevels
+
+      integer, dimension(:), pointer :: maxLevelCell
+
+      real (kind=RKIND), dimension(:,:), allocatable :: fluxVertTop
+
+      err = 0
+
+      if(implicitOn) return
+
+      call mpas_timer_start(&quot;compute_scalar_tend-explicit vert diff&quot;)
+
+      nCellsSolve = grid % nCellsSolve
+      nVertLevels = grid % nVertLevels
+      num_tracers = size(tracers, dim=1)
+
+      maxLevelCell =&gt; grid % maxLevelCell % array
+
+      allocate(fluxVertTop(num_tracers,nVertLevels+1))
+      fluxVertTop(:,1) = 0.0
+      do iCell=1,nCellsSolve 
+
+         do k=2,maxLevelCell(iCell)
+           do iTracer=1,num_tracers
+             ! compute \kappa_v d\phi/dz
+             fluxVertTop(iTracer,k) = vertDiffTopOfCell(k,iCell) &amp;
+                * (   tracers(iTracer,k-1,iCell)    &amp;
+                    - tracers(iTracer,k  ,iCell) )  &amp;
+                * 2 / (h(k-1,iCell) + h(k,iCell))
+
+           enddo
+         enddo
+         fluxVertTop(:,maxLevelCell(iCell)+1) = 0.0
+
+         do k=1,maxLevelCell(iCell)
+           do iTracer=1,num_tracers
+             ! This is h d/dz( fluxVertTop) but h and dz cancel, so 
+             ! reduces to delta( fluxVertTop)
+             tend(iTracer,k,iCell) = tend(iTracer,k,iCell) &amp;
+               + fluxVertTop(iTracer,k) - fluxVertTop(iTracer,k+1)
+           enddo
+         enddo
+!print '(a,50e12.2)', 'fluxVertTop',fluxVertTop(3,1:maxLevelCell(iCell)+1)
+!print '(a,50e12.2)', 'tend_tr    ',tend_tr(3,1,1:maxLevelCell(iCell))
+      enddo ! iCell loop
+      deallocate(fluxVertTop)
+
+      call mpas_timer_stop(&quot;compute_scalar_tend-explicit vert diff&quot;)
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vmix_tend_explicit!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vmix_tend_implicit
+!
+!&gt; \brief   Computes tendencies for implicit tracer vertical mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the tendencies for implicit vertical mixing for
+!&gt;  tracers using computed coefficients.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vmix_tend_implicit(grid, dt, vertDiffTopOfCell, h, tracers, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         vertDiffTopOfCell !&lt; Input: vertical mixing coefficients
+
+      real (kind=RKIND), intent(in) :: &amp;
+         dt            !&lt; Input: time step
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h             !&lt; Input: thickness at cell center
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:,:), intent(inout) :: &amp;
+         tracers        !&lt; Input: tracers
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iCell, nCells, k, nVertLevels, num_tracers
+
+      integer, dimension(:), pointer :: maxLevelCell
+
+      real (kind=RKIND), dimension(:), allocatable :: A, C
+      real (kind=RKIND), dimension(:,:), allocatable :: tracersTemp
+
+      err = 0
+
+      if(explicitOn) return
+
+      nCells = grid % nCells
+      nVertLevels = grid % nVertLevels
+      num_tracers = size(tracers, dim=1)
+      maxLevelCell =&gt; grid % maxLevelCell % array
+
+      allocate(A(nVertLevels),C(nVertLevels), tracersTemp(num_tracers,nVertLevels))
+
+      do iCell=1,nCells
+         ! Compute A(k), C(k) for tracers
+         ! mrp 110315 efficiency note: for z-level, could precompute
+         ! -2.0*dt/(h(k)_h(k+1))/h(k) in setup
+         do k=1,maxLevelCell(iCell)-1
+            A(k) = -2.0*dt*vertDiffTopOfCell(k+1,iCell) &amp;
+                 / (h(k,iCell) + h(k+1,iCell)) / h(k,iCell)
+         enddo
+
+         A(maxLevelCell(iCell)) = 0.0
+
+         C(1) = 1 - A(1)
+         do k=2,maxLevelCell(iCell)
+            C(k) = 1 - A(k) - A(k-1)
+         enddo
+
+         call tridiagonal_solve_mult(A,C,A,tracers(:,:,iCell), &amp;
+              tracersTemp, maxLevelCell(iCell), nVertLevels,num_tracers)
+
+         tracers(:,1:maxLevelCell(iCell),iCell) = tracersTemp(:,1:maxLevelCell(iCell))
+         tracers(:,maxLevelCell(iCell)+1:nVertLevels,iCell) = -1e34
+      end do
+      deallocate(A,C,tracersTemp)
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vmix_tend_implicit!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vmix_init
+!
+!&gt; \brief   Initializes ocean vertical mixing quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  vertical mixing in the ocean. This primarily determines if
+!&gt;  explicit or implicit vertical mixing is to be used.
+!
+!-----------------------------------------------------------------------
+
+
+   subroutine ocn_vmix_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      integer :: err1, err2, err3
+
+      err = 0
+
+      explicitOn = .true.
+      implicitOn = .false.
+
+      if(config_implicit_vertical_mix) then
+          explicitOn = .false.
+          implicitOn =.true.
+      end if
+
+      call ocn_vmix_coefs_const_init(err1)
+      call ocn_vmix_coefs_tanh_init(err2)
+      call ocn_vmix_coefs_rich_init(err3)
+
+      err = err .or. err1 .or. err2 .or. err3
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vmix_init!}}}
+
+subroutine tridiagonal_solve(a,b,c,r,x,n)!{{{
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Solve the matrix equation Ax=r for x, where A is tridiagonal.
+! A is an nxn matrix, with:
+!   a sub-diagonal, filled from 1:n-1 (a(1) appears on row 2)
+!   b diagonal, filled from 1:n
+!   c sup-diagonal, filled from 1:n-1  (c(1) apears on row 1)
+!
+! Input: a,b,c,r,n
+!
+! Output: x
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

+   implicit none
+
+   integer,intent(in) :: n
+   real (KIND=RKIND), dimension(n), intent(in) :: a,b,c,r
+   real (KIND=RKIND), dimension(n), intent(out) :: x
+   real (KIND=RKIND), dimension(n) :: bTemp,rTemp
+   real (KIND=RKIND) :: m
+   integer i
+
+   call mpas_timer_start(&quot;tridiagonal_solve&quot;)

+   ! Use work variables for b and r
+   bTemp(1) = b(1)
+   rTemp(1) = r(1)

+   ! First pass: set the coefficients
+   do i = 2,n
+      m = a(i-1)/bTemp(i-1)
+      bTemp(i) = b(i) - m*c(i-1)
+      rTemp(i) = r(i) - m*rTemp(i-1)
+   end do 

+   x(n) = rTemp(n)/bTemp(n)
+   ! Second pass: back-substition
+   do i = n-1, 1, -1
+      x(i) = (rTemp(i) - c(i)*x(i+1))/bTemp(i)
+   end do
+
+   call mpas_timer_stop(&quot;tridiagonal_solve&quot;)

+end subroutine tridiagonal_solve!}}}
+
+subroutine tridiagonal_solve_mult(a,b,c,r,x,n,nDim,nSystems)!{{{
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Solve the matrix equation Ax=r for x, where A is tridiagonal.
+! A is an nxn matrix, with:
+!   a sub-diagonal, filled from 1:n-1 (a(1) appears on row 2)
+!   b diagonal, filled from 1:n
+!   c sup-diagonal, filled from 1:n-1  (c(1) apears on row 1)
+!
+! Input: a,b,c,r,n
+!
+! Output: x
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

+   implicit none
+
+   integer,intent(in) :: n, nDim, nSystems
+   real (KIND=RKIND), dimension(n), intent(in) :: a,b,c
+   real (KIND=RKIND), dimension(nSystems,nDim), intent(in) :: r
+   real (KIND=RKIND), dimension(nSystems,nDim), intent(out) :: x
+   real (KIND=RKIND), dimension(n) :: bTemp
+   real (KIND=RKIND), dimension(nSystems,n) :: rTemp
+   real (KIND=RKIND) :: m
+   integer i,j
+
+   call mpas_timer_start(&quot;tridiagonal_solve_mult&quot;)

+   ! Use work variables for b and r
+   bTemp(1) = b(1)
+   do j = 1,nSystems
+      rTemp(j,1) = r(j,1)
+   end do

+   ! First pass: set the coefficients
+   do i = 2,n
+      m = a(i-1)/bTemp(i-1)
+      bTemp(i) = b(i) - m*c(i-1)
+      do j = 1,nSystems
+         rTemp(j,i) = r(j,i) - m*rTemp(j,i-1)
+      end do 
+   end do 

+   do j = 1,nSystems
+      x(j,n) = rTemp(j,n)/bTemp(n)
+   end do
+   ! Second pass: back-substition
+   do i = n-1, 1, -1
+      do j = 1,nSystems
+         x(j,i) = (rTemp(j,i) - c(i)*x(j,i+1))/bTemp(i)
+      end do
+   end do

+   call mpas_timer_stop(&quot;tridiagonal_solve_mult&quot;)
+
+end subroutine tridiagonal_solve_mult!}}}
+
+!***********************************************************************
+
+end module ocn_vmix
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_const.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_vmix_coefs_const.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_const.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,306 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_vmix_coefs_const
-!
-!&gt; \brief MPAS ocean vertical mixing coefficients
-!&gt; \author Doug Jacobsen
-!&gt; \date   19 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the routines for computing 
-!&gt;  constant vertical mixing coefficients.  
-!&gt;
-!
-!-----------------------------------------------------------------------
-
-module ocn_vmix_coefs_const
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   private :: ocn_vel_vmix_coefs_const, &amp;
-              ocn_tracer_vmix_coefs_const
-
-   public :: ocn_vmix_coefs_const_build, &amp;
-             ocn_vmix_coefs_const_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: constViscOn, constDiffOn
-
-   real (kind=RKIND) :: constVisc, constDiff
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_vmix_coefs_const_build
-!
-!&gt; \brief   Computes coefficients for vertical mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical mixing coefficients for momentum
-!&gt;  and tracers based user choices of mixing parameterization.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vmix_coefs_const_build(grid, s, d, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      type (state_type), intent(inout) :: &amp;
-         s             !&lt; Input/Output: state information
-
-      type (diagnostics_type), intent(inout) :: &amp;
-         d             !&lt; Input/Output: diagnostic information
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: err1, err2
-
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        vertViscTopOfEdge, vertDiffTopOfCell
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-      if((.not.constViscOn) .and. (.not.constDiffOn)) return
-
-      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
-      vertDiffTopOfCell =&gt; d % vertDiffTopOfCell % array
-
-      call ocn_vel_vmix_coefs_const(grid, vertViscTopOfEdge, err1)
-      call ocn_tracer_vmix_coefs_const(grid, vertDiffTopOfCell, err2)
-
-      err = err1 .or. err2
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vmix_coefs_const_build!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_vmix_coefs_const
-!
-!&gt; \brief   Computes coefficients for vertical momentum mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the constant vertical mixing coefficients for momentum
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_vmix_coefs_const(grid, vertViscTopOfEdge, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(out) :: vertViscTopOfEdge !&lt; Output: vertical viscosity
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not.constViscOn) return
-
-      vertViscTopOfEdge = constVisc
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_vmix_coefs_const!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vmix_coefs_const
-!
-!&gt; \brief   Computes coefficients for vertical tracer mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the constant vertical mixing coefficients for tracers
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vmix_coefs_const(grid, vertDiffTopOfCell, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(out) :: vertDiffTopOfCell !&lt; Output: Vertical diffusion
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-
-      if(.not.constDiffOn) return
-
-      vertDiffTopOfCell = constDiff
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vmix_coefs_const!}}}
-
-
-!***********************************************************************
-!
-!  routine ocn_vmix_coefs_const_init
-!
-!&gt; \brief   Initializes ocean momentum vertical mixing quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  vertical velocity mixing in the ocean. Since a variety of 
-!&gt;  parameterizations are available, this routine primarily calls the
-!&gt;  individual init routines for each parameterization. 
-!
-!-----------------------------------------------------------------------
-
-
-   subroutine ocn_vmix_coefs_const_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-
-      constViscOn = .false.
-      constDiffOn = .false.
-
-      if (config_vert_visc_type.eq.'const') then
-          constViscOn = .true.
-          constVisc = config_vert_visc
-      endif
-
-      if (config_vert_diff_type.eq.'const') then
-          constDiffOn = .true.
-          constDiff = config_vert_diff
-      endif
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vmix_coefs_const_init!}}}
-
-!***********************************************************************
-
-end module ocn_vmix_coefs_const
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_const.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_vmix_coefs_const.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_const.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_const.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,306 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_vmix_coefs_const
+!
+!&gt; \brief MPAS ocean vertical mixing coefficients
+!&gt; \author Doug Jacobsen
+!&gt; \date   19 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the routines for computing 
+!&gt;  constant vertical mixing coefficients.  
+!&gt;
+!
+!-----------------------------------------------------------------------
+
+module ocn_vmix_coefs_const
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   private :: ocn_vel_vmix_coefs_const, &amp;
+              ocn_tracer_vmix_coefs_const
+
+   public :: ocn_vmix_coefs_const_build, &amp;
+             ocn_vmix_coefs_const_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: constViscOn, constDiffOn
+
+   real (kind=RKIND) :: constVisc, constDiff
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_vmix_coefs_const_build
+!
+!&gt; \brief   Computes coefficients for vertical mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical mixing coefficients for momentum
+!&gt;  and tracers based user choices of mixing parameterization.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vmix_coefs_const_build(grid, s, d, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      type (state_type), intent(inout) :: &amp;
+         s             !&lt; Input/Output: state information
+
+      type (diagnostics_type), intent(inout) :: &amp;
+         d             !&lt; Input/Output: diagnostic information
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: err1, err2
+
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        vertViscTopOfEdge, vertDiffTopOfCell
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+      if((.not.constViscOn) .and. (.not.constDiffOn)) return
+
+      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
+      vertDiffTopOfCell =&gt; d % vertDiffTopOfCell % array
+
+      call ocn_vel_vmix_coefs_const(grid, vertViscTopOfEdge, err1)
+      call ocn_tracer_vmix_coefs_const(grid, vertDiffTopOfCell, err2)
+
+      err = err1 .or. err2
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vmix_coefs_const_build!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_vmix_coefs_const
+!
+!&gt; \brief   Computes coefficients for vertical momentum mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the constant vertical mixing coefficients for momentum
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_vmix_coefs_const(grid, vertViscTopOfEdge, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(out) :: vertViscTopOfEdge !&lt; Output: vertical viscosity
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not.constViscOn) return
+
+      vertViscTopOfEdge = constVisc
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_vmix_coefs_const!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vmix_coefs_const
+!
+!&gt; \brief   Computes coefficients for vertical tracer mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the constant vertical mixing coefficients for tracers
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vmix_coefs_const(grid, vertDiffTopOfCell, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(out) :: vertDiffTopOfCell !&lt; Output: Vertical diffusion
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+
+      if(.not.constDiffOn) return
+
+      vertDiffTopOfCell = constDiff
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vmix_coefs_const!}}}
+
+
+!***********************************************************************
+!
+!  routine ocn_vmix_coefs_const_init
+!
+!&gt; \brief   Initializes ocean momentum vertical mixing quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  vertical velocity mixing in the ocean. Since a variety of 
+!&gt;  parameterizations are available, this routine primarily calls the
+!&gt;  individual init routines for each parameterization. 
+!
+!-----------------------------------------------------------------------
+
+
+   subroutine ocn_vmix_coefs_const_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+
+      constViscOn = .false.
+      constDiffOn = .false.
+
+      if (config_vert_visc_type.eq.'const') then
+          constViscOn = .true.
+          constVisc = config_vert_visc
+      endif
+
+      if (config_vert_diff_type.eq.'const') then
+          constDiffOn = .true.
+          constDiff = config_vert_diff
+      endif
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vmix_coefs_const_init!}}}
+
+!***********************************************************************
+
+end module ocn_vmix_coefs_const
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_rich.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_vmix_coefs_rich.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_rich.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,601 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_vmix_coefs_rich
-!
-!&gt; \brief MPAS ocean vertical mixing coefficients
-!&gt; \author Doug Jacobsen
-!&gt; \date   19 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the routines for computing 
-!&gt;  richardson vertical mixing coefficients.  
-!&gt;
-!
-!-----------------------------------------------------------------------
-
-module ocn_vmix_coefs_rich
-
-   use grid_types
-   use configure
-   use constants
-   use timer
-
-   use ocn_equation_of_state
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_vmix_coefs_rich_build, &amp;
-             ocn_vmix_coefs_rich_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: richViscOn, richDiffOn
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_vmix_coefs_rich_build
-!
-!&gt; \brief   Computes coefficients for vertical mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical mixing coefficients for momentum
-!&gt;  and tracers based user choices of mixing parameterization.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vmix_coefs_rich_build(grid, s, d, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      type (state_type), intent(inout) :: &amp;
-         s             !&lt; Input/Output: state information
-
-      type (diagnostics_type), intent(inout) :: &amp;
-         d             !&lt; Input/Output: diagnostic information
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: err1, err2, err3, indexT, indexS
-
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        vertViscTopOfEdge, vertDiffTopOfCell, u, h, h_edge, rho, rhoDisplaced
-
-      real (kind=RKIND), dimension(:,:), pointer :: RiTopOfEdge, RiTopOfCell
-
-      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-      if((.not.richViscOn) .and. (.not.richDiffOn)) return
-
-      indexT = s%index_temperature
-      indexS = s%index_salinity
-
-      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
-      vertDiffTopOfCell =&gt; d % vertDiffTopOfCell % array
-      RiTopOfEdge =&gt; d % RiTopOfEdge % array
-      RiTopOfCell =&gt; d % RiTopOfCell % array
-
-      u =&gt; s % u % array
-      h =&gt; s % h % array
-      h_edge =&gt; s % h_edge % array
-      rho =&gt; s % rho % array
-      rhoDisplaced =&gt; s % rhoDisplaced % array
-      tracers =&gt; s % tracers % array
-
-      call ocn_equation_of_state_rho(s, grid, 0, 'relative', err)
-      call ocn_equation_of_state_rho(s, grid, 1, 'relative', err)
-
-      call ocn_vmix_get_rich_numbers(grid, indexT, indexS, u, h, h_edge, &amp; 
-                                  rho, rhoDisplaced, tracers, RiTopOfEdge, RiTopOfCell, err1)
-
-      call ocn_vel_vmix_coefs_rich(grid, RiTopOfEdge, h_edge, vertViscTopOfEdge, err2)
-      call ocn_tracer_vmix_coefs_rich(grid, RiTopOfCell, h, vertDiffTopOfCell, err3)
-
-      err = err1 .or. err2 .or. err3
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vmix_coefs_rich_build!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_vmix_coefs_rich
-!
-!&gt; \brief   Computes coefficients for vertical momentum mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the richardson vertical mixing coefficients for momentum
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_vmix_coefs_rich(grid, RiTopOfEdge, h_edge, vertViscTopOfEdge, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h_edge        !&lt; Input: thickness at edge
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         RiTopOfEdge   !&lt; Richardson number at top of edge
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(out) :: vertViscTopOfEdge !&lt; Output: vertical viscosity
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iEdge, nEdges, k
-
-      integer, dimension(:), pointer :: maxLevelEdgeTop
-
-      err = 0
-
-      if(.not.richViscOn) return
-
-      nEdges = grid % nEdges
-
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-
-      vertViscTopOfEdge = 0.0
-      do iEdge = 1,nEdges
-         do k = 2,maxLevelEdgeTop(iEdge)
-            ! mrp 110324 efficiency note: this if is inside iEdge and k loops.
-            ! Perhaps there is a more efficient way to do this.
-            if (RiTopOfEdge(k,iEdge)&gt;0.0) then
-               vertViscTopOfEdge(k,iEdge) = config_bkrd_vert_visc &amp;
-                  + config_rich_mix / (1.0 + 5.0*RiTopOfEdge(k,iEdge))**2
-            ! maltrud do limiting of coefficient--should not be necessary
-            ! also probably better logic could be found
-               if (vertViscTopOfEdge(k,iEdge) &gt; config_convective_visc) then
-                   if( config_implicit_vertical_mix) then
-                      vertViscTopOfEdge(k,iEdge) = config_convective_visc
-                   else
-                      vertViscTopOfEdge(k,iEdge) = &amp;
-                      ((h_edge(k-1,iEdge)+h_edge(k,iEdge))/2.0)**2/config_dt/4.0
-                   end if
-               end if
-            else
-               ! mrp 110324 efficiency note: this if is inside iCell and k loops.
-               if (config_implicit_vertical_mix) then
-                  ! for Ri&lt;0 and implicit mix, use convective diffusion
-                  vertViscTopOfEdge(k,iEdge) = config_convective_visc
-               else
-                  ! for Ri&lt;0 and explicit vertical mix, 
-                  ! use maximum diffusion allowed by CFL criterion
-                  ! mrp 110324 efficiency note: for z-level, could use fixed
-                  ! grid array hMeanTopZLevel and compute maxdiff on startup.
-                  vertViscTopOfEdge(k,iEdge) = &amp;
-                      ((h_edge(k-1,iEdge)+h_edge(k,iEdge))/2.0)**2/config_dt/4.0
-               end if
-            end if
-         end do
-      end do
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_vmix_coefs_rich!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vmix_coefs_rich
-!
-!&gt; \brief   Computes coefficients for vertical tracer mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the richardson vertical mixing coefficients for tracers
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vmix_coefs_rich(grid, RiTopOfCell, h, vertDiffTopOfCell, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         h             !&lt; Input: thickness at cell center
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
-         RiTopOfCell   !&lt; Input: Richardson number at top of cell
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(out) :: vertDiffTopOfCell !&lt; Output: vertical diffusions
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: iCell, nCells, k
-
-      integer, dimension(:), pointer :: maxLevelCell
-
-      real (kind=RKIND) :: coef
-
-      err = 0
-
-      if(.not.richDiffOn) return
-
-      nCells = grid % nCells
-
-      maxLevelCell =&gt; grid % maxLevelCell % array
-
-      vertDiffTopOfCell = 0.0
-      coef = -gravity/1000.0/2.0
-      do iCell = 1,nCells
-         do k = 2,maxLevelCell(iCell)
-            ! mrp 110324 efficiency note: this if is inside iCell and k loops.
-            ! Perhaps there is a more efficient way to do this.
-            if (RiTopOfCell(k,iCell)&gt;0.0) then
-               vertDiffTopOfCell(k,iCell) = config_bkrd_vert_diff &amp;
-                  + (config_bkrd_vert_visc &amp; 
-                     + config_rich_mix / (1.0 + 5.0*RiTopOfCell(k,iCell))**2) &amp;
-                  / (1.0 + 5.0*RiTopOfCell(k,iCell))
-            ! maltrud do limiting of coefficient--should not be necessary
-            ! also probably better logic could be found
-               if (vertDiffTopOfCell(k,iCell) &gt; config_convective_diff) then
-                  if (config_implicit_vertical_mix) then
-                     vertDiffTopOfCell(k,iCell) = config_convective_diff
-                  else
-                     vertDiffTopOfCell(k,iCell) = &amp;
-                        ((h(k-1,iCell)+h(k,iCell))/2.0)**2/config_dt/4.0
-                  end if
-               end if
-             else
-               ! mrp 110324 efficiency note: this if is inside iCell and k loops.
-               if (config_implicit_vertical_mix) then
-                  ! for Ri&lt;0 and implicit mix, use convective diffusion
-                  vertDiffTopOfCell(k,iCell) = config_convective_diff
-               else
-                  ! for Ri&lt;0 and explicit vertical mix, 
-                  ! use maximum diffusion allowed by CFL criterion
-                  ! mrp 110324 efficiency note: for z-level, could use fixed
-                  ! grid array hMeanTopZLevel and compute maxdiff on startup.
-                  vertDiffTopOfCell(k,iCell) = &amp;
-                     ((h(k-1,iCell)+h(k,iCell))/2.0)**2/config_dt/4.0
-               end if
-            end if
-         end do
-      end do
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vmix_coefs_rich!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vmix_get_rich_numbers
-!
-!&gt; \brief   Build richardson numbers for vertical mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine builds the arrays needed for richardson number vertical
-!&gt;  mixing coefficients.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vmix_get_rich_numbers(grid, indexT, indexS, u, h, h_edge, &amp; !{{{
-                                 rho, rhoDisplaced, tracers, RiTopOfEdge, RiTopOfCell, err)
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      integer, intent(in) :: indexT !&lt; Input: index for temperature
-      integer, intent(in) :: indexS !&lt; Input: index for salinity
-
-      real (kind=RKIND), dimension(:,:), intent(in) :: u       !&lt; Input: horizontal velocity
-      real (kind=RKIND), dimension(:,:), intent(in) :: h       !&lt; Input: thickness
-      real (kind=RKIND), dimension(:,:), intent(in) :: h_edge  !&lt; Input: thickness at edge 
-
-      real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !&lt; Input: tracers
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(inout) :: rho    !&lt; Input/output: density
-      real (kind=RKIND), dimension(:,:), intent(inout) :: rhoDisplaced    !&lt; Input/output: displaced density
-      real (kind=RKIND), dimension(:,:), intent(inout) :: RiTopOfEdge     !&lt; Input/output: Richardson number top of cell
-      real (kind=RKIND), dimension(:,:), intent(inout) :: RiTopOfCell     !&lt; Input/output: Richardson number top of cell
-
-      integer, intent(inout) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: nVertLevels, nCells, nEdges, iCell, iEdge, k
-      integer :: cell1, cell2
-
-      integer, dimension(:), pointer :: maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot
-      integer, dimension(:,:), pointer :: cellsOnEdge
-
-      real (kind=RKIND) :: coef
-      real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, areaCell
-      real (kind=RKIND), dimension(:,:), allocatable :: drhoTopOfCell, du2TopOfCell, &amp;
-                                                        drhoTopOfEdge, du2TopOfEdge
-
-      err = 0
-
-      if(.not.richViscOn .and. .not.richDiffOn) return
-
-      nVertLevels = grid % nVertLevels
-      nCells = grid % nCells
-      nEdges = grid % nEdges
-
-      maxLevelCell =&gt; grid % maxLevelCell % array
-      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
-      maxLevelEdgeBot =&gt; grid % maxLevelEdgeBot % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      dvEdge =&gt; grid % dvEdge % array
-      dcEdge =&gt; grid % dcEdge % array
-      areaCell =&gt; grid % areaCell % array
-
-      allocate( &amp;
-         drhoTopOfCell(nVertLevels+1,nCells+1), drhoTopOfEdge(nVertLevels+1,nEdges+1), &amp;
-         du2TopOfCell(nVertLevels+1,nCells+1), du2TopOfEdge(nVertLevels+1,nEdges+1))
-
-      ! compute density of parcel displaced to next deeper z-level,
-      ! in state % rhoDisplaced
-!maltrud make sure rho is current--check this for redundancy
-!     call OcnEquationOfStateRho(grid, 'relative', 0, indexT, indexS, &amp;
-!              tracers, rho, err) 
-      ! mrp 110324 In order to visualize rhoDisplaced, include the following
-!     call OcnEquationOfStateRho(grid, 'relative', 1, indexT, indexS, &amp;
-!              tracers, rhoDisplaced, err) 
-
-
-      ! drhoTopOfCell(k) = $\rho^*_{k-1}-\rho^*_k$
-      drhoTopOfCell = 0.0
-      do iCell=1,nCells
-         do k=2,maxLevelCell(iCell)
-            drhoTopOfCell(k,iCell) = rho(k-1,iCell) - rhoDisplaced(k-1,iCell)
-          end do
-      end do
-
-      ! interpolate drhoTopOfCell to drhoTopOfEdge
-      drhoTopOfEdge = 0.0
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=2,maxLevelEdgeTop(iEdge)
-            drhoTopOfEdge(k,iEdge) = &amp;
-               (drhoTopOfCell(k,cell1) + &amp;
-                drhoTopOfCell(k,cell2))/2  
-         end do
-       end do
-
-      ! du2TopOfEdge(k) = $u_{k-1}-u_k$
-      du2TopOfEdge=0.0
-      do iEdge=1,nEdges
-         do k=2,maxLevelEdgeTop(iEdge)
-            du2TopOfEdge(k,iEdge) = (u(k-1,iEdge) - u(k,iEdge))**2
-         end do
-      end do
-
-      ! interpolate du2TopOfEdge to du2TopOfCell
-      du2TopOfCell = 0.0
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=2,maxLevelEdgeBot(iEdge)
-            du2TopOfCell(k,cell1) = du2TopOfCell(k,cell1) &amp;
-               + 0.5 * dcEdge(iEdge) * dvEdge(iEdge) * du2TopOfEdge(k,iEdge)
-            du2TopOfCell(k,cell2) = du2TopOfCell(k,cell2) &amp;
-               + 0.5 * dcEdge(iEdge) * dvEdge(iEdge) * du2TopOfEdge(k,iEdge)
-         end do
-      end do
-      do iCell = 1,nCells
-         do k = 2,maxLevelCell(iCell)
-            du2TopOfCell(k,iCell) = du2TopOfCell(k,iCell) / areaCell(iCell)
-         end do
-      end do
-
-      ! compute RiTopOfEdge using drhoTopOfEdge and du2TopOfEdge
-      ! coef = -g/rho_0/2
-      RiTopOfEdge = 0.0
-      coef = -gravity/1000.0/2.0
-      do iEdge = 1,nEdges
-         do k = 2,maxLevelEdgeTop(iEdge)
-            RiTopOfEdge(k,iEdge) = coef*drhoTopOfEdge(k,iEdge) &amp;
-               *(h_edge(k-1,iEdge)+h_edge(k,iEdge)) &amp;
-               / (du2TopOfEdge(k,iEdge) + 1e-20)
-         end do
-      end do
-
-      ! compute RiTopOfCell using drhoTopOfCell and du2TopOfCell
-      ! coef = -g/rho_0/2
-      RiTopOfCell = 0.0
-      coef = -gravity/1000.0/2.0
-      do iCell = 1,nCells
-         do k = 2,maxLevelCell(iCell)
-            RiTopOfCell(k,iCell) = coef*drhoTopOfCell(k,iCell) &amp;
-               *(h(k-1,iCell)+h(k,iCell)) &amp;
-               / (du2TopOfCell(k,iCell) + 1e-20)
-         end do
-      end do
-
-      deallocate(drhoTopOfCell, drhoTopOfEdge, &amp;
-        du2TopOfCell, du2TopOfEdge)
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vmix_get_rich_numbers!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vmix_coefs_rich_init
-!
-!&gt; \brief   Initializes ocean momentum vertical mixing quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  vertical velocity mixing in the ocean. Since a variety of 
-!&gt;  parameterizations are available, this routine primarily calls the
-!&gt;  individual init routines for each parameterization. 
-!
-!-----------------------------------------------------------------------
-
-
-   subroutine ocn_vmix_coefs_rich_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-
-      richViscOn = .false.
-      richDiffOn = .false.
-
-      if (config_vert_visc_type.eq.'rich') then
-          richViscOn = .true.
-      endif
-
-      if (config_vert_diff_type.eq.'rich') then
-          richDiffOn = .true.
-      endif
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vmix_coefs_rich_init!}}}
-
-!***********************************************************************
-
-end module ocn_vmix_coefs_rich
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_rich.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_vmix_coefs_rich.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_rich.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_rich.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,601 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_vmix_coefs_rich
+!
+!&gt; \brief MPAS ocean vertical mixing coefficients
+!&gt; \author Doug Jacobsen
+!&gt; \date   19 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the routines for computing 
+!&gt;  richardson vertical mixing coefficients.  
+!&gt;
+!
+!-----------------------------------------------------------------------
+
+module ocn_vmix_coefs_rich
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+   use mpas_timer
+
+   use ocn_equation_of_state
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_vmix_coefs_rich_build, &amp;
+             ocn_vmix_coefs_rich_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: richViscOn, richDiffOn
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_vmix_coefs_rich_build
+!
+!&gt; \brief   Computes coefficients for vertical mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical mixing coefficients for momentum
+!&gt;  and tracers based user choices of mixing parameterization.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vmix_coefs_rich_build(grid, s, d, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      type (state_type), intent(inout) :: &amp;
+         s             !&lt; Input/Output: state information
+
+      type (diagnostics_type), intent(inout) :: &amp;
+         d             !&lt; Input/Output: diagnostic information
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: err1, err2, err3, indexT, indexS
+
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        vertViscTopOfEdge, vertDiffTopOfCell, u, h, h_edge, rho, rhoDisplaced
+
+      real (kind=RKIND), dimension(:,:), pointer :: RiTopOfEdge, RiTopOfCell
+
+      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+      if((.not.richViscOn) .and. (.not.richDiffOn)) return
+
+      indexT = s%index_temperature
+      indexS = s%index_salinity
+
+      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
+      vertDiffTopOfCell =&gt; d % vertDiffTopOfCell % array
+      RiTopOfEdge =&gt; d % RiTopOfEdge % array
+      RiTopOfCell =&gt; d % RiTopOfCell % array
+
+      u =&gt; s % u % array
+      h =&gt; s % h % array
+      h_edge =&gt; s % h_edge % array
+      rho =&gt; s % rho % array
+      rhoDisplaced =&gt; s % rhoDisplaced % array
+      tracers =&gt; s % tracers % array
+
+      call ocn_equation_of_state_rho(s, grid, 0, 'relative', err)
+      call ocn_equation_of_state_rho(s, grid, 1, 'relative', err)
+
+      call ocn_vmix_get_rich_numbers(grid, indexT, indexS, u, h, h_edge, &amp; 
+                                  rho, rhoDisplaced, tracers, RiTopOfEdge, RiTopOfCell, err1)
+
+      call ocn_vel_vmix_coefs_rich(grid, RiTopOfEdge, h_edge, vertViscTopOfEdge, err2)
+      call ocn_tracer_vmix_coefs_rich(grid, RiTopOfCell, h, vertDiffTopOfCell, err3)
+
+      err = err1 .or. err2 .or. err3
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vmix_coefs_rich_build!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_vmix_coefs_rich
+!
+!&gt; \brief   Computes coefficients for vertical momentum mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the richardson vertical mixing coefficients for momentum
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_vmix_coefs_rich(grid, RiTopOfEdge, h_edge, vertViscTopOfEdge, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h_edge        !&lt; Input: thickness at edge
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         RiTopOfEdge   !&lt; Richardson number at top of edge
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(out) :: vertViscTopOfEdge !&lt; Output: vertical viscosity
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iEdge, nEdges, k
+
+      integer, dimension(:), pointer :: maxLevelEdgeTop
+
+      err = 0
+
+      if(.not.richViscOn) return
+
+      nEdges = grid % nEdges
+
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+
+      vertViscTopOfEdge = 0.0
+      do iEdge = 1,nEdges
+         do k = 2,maxLevelEdgeTop(iEdge)
+            ! mrp 110324 efficiency note: this if is inside iEdge and k loops.
+            ! Perhaps there is a more efficient way to do this.
+            if (RiTopOfEdge(k,iEdge)&gt;0.0) then
+               vertViscTopOfEdge(k,iEdge) = config_bkrd_vert_visc &amp;
+                  + config_rich_mix / (1.0 + 5.0*RiTopOfEdge(k,iEdge))**2
+            ! maltrud do limiting of coefficient--should not be necessary
+            ! also probably better logic could be found
+               if (vertViscTopOfEdge(k,iEdge) &gt; config_convective_visc) then
+                   if( config_implicit_vertical_mix) then
+                      vertViscTopOfEdge(k,iEdge) = config_convective_visc
+                   else
+                      vertViscTopOfEdge(k,iEdge) = &amp;
+                      ((h_edge(k-1,iEdge)+h_edge(k,iEdge))/2.0)**2/config_dt/4.0
+                   end if
+               end if
+            else
+               ! mrp 110324 efficiency note: this if is inside iCell and k loops.
+               if (config_implicit_vertical_mix) then
+                  ! for Ri&lt;0 and implicit mix, use convective diffusion
+                  vertViscTopOfEdge(k,iEdge) = config_convective_visc
+               else
+                  ! for Ri&lt;0 and explicit vertical mix, 
+                  ! use maximum diffusion allowed by CFL criterion
+                  ! mrp 110324 efficiency note: for z-level, could use fixed
+                  ! grid array hMeanTopZLevel and compute maxdiff on startup.
+                  vertViscTopOfEdge(k,iEdge) = &amp;
+                      ((h_edge(k-1,iEdge)+h_edge(k,iEdge))/2.0)**2/config_dt/4.0
+               end if
+            end if
+         end do
+      end do
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_vmix_coefs_rich!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vmix_coefs_rich
+!
+!&gt; \brief   Computes coefficients for vertical tracer mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the richardson vertical mixing coefficients for tracers
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vmix_coefs_rich(grid, RiTopOfCell, h, vertDiffTopOfCell, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         h             !&lt; Input: thickness at cell center
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: &amp;
+         RiTopOfCell   !&lt; Input: Richardson number at top of cell
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(out) :: vertDiffTopOfCell !&lt; Output: vertical diffusions
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: iCell, nCells, k
+
+      integer, dimension(:), pointer :: maxLevelCell
+
+      real (kind=RKIND) :: coef
+
+      err = 0
+
+      if(.not.richDiffOn) return
+
+      nCells = grid % nCells
+
+      maxLevelCell =&gt; grid % maxLevelCell % array
+
+      vertDiffTopOfCell = 0.0
+      coef = -gravity/1000.0/2.0
+      do iCell = 1,nCells
+         do k = 2,maxLevelCell(iCell)
+            ! mrp 110324 efficiency note: this if is inside iCell and k loops.
+            ! Perhaps there is a more efficient way to do this.
+            if (RiTopOfCell(k,iCell)&gt;0.0) then
+               vertDiffTopOfCell(k,iCell) = config_bkrd_vert_diff &amp;
+                  + (config_bkrd_vert_visc &amp; 
+                     + config_rich_mix / (1.0 + 5.0*RiTopOfCell(k,iCell))**2) &amp;
+                  / (1.0 + 5.0*RiTopOfCell(k,iCell))
+            ! maltrud do limiting of coefficient--should not be necessary
+            ! also probably better logic could be found
+               if (vertDiffTopOfCell(k,iCell) &gt; config_convective_diff) then
+                  if (config_implicit_vertical_mix) then
+                     vertDiffTopOfCell(k,iCell) = config_convective_diff
+                  else
+                     vertDiffTopOfCell(k,iCell) = &amp;
+                        ((h(k-1,iCell)+h(k,iCell))/2.0)**2/config_dt/4.0
+                  end if
+               end if
+             else
+               ! mrp 110324 efficiency note: this if is inside iCell and k loops.
+               if (config_implicit_vertical_mix) then
+                  ! for Ri&lt;0 and implicit mix, use convective diffusion
+                  vertDiffTopOfCell(k,iCell) = config_convective_diff
+               else
+                  ! for Ri&lt;0 and explicit vertical mix, 
+                  ! use maximum diffusion allowed by CFL criterion
+                  ! mrp 110324 efficiency note: for z-level, could use fixed
+                  ! grid array hMeanTopZLevel and compute maxdiff on startup.
+                  vertDiffTopOfCell(k,iCell) = &amp;
+                     ((h(k-1,iCell)+h(k,iCell))/2.0)**2/config_dt/4.0
+               end if
+            end if
+         end do
+      end do
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vmix_coefs_rich!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vmix_get_rich_numbers
+!
+!&gt; \brief   Build richardson numbers for vertical mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine builds the arrays needed for richardson number vertical
+!&gt;  mixing coefficients.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vmix_get_rich_numbers(grid, indexT, indexS, u, h, h_edge, &amp; !{{{
+                                 rho, rhoDisplaced, tracers, RiTopOfEdge, RiTopOfCell, err)
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      integer, intent(in) :: indexT !&lt; Input: index for temperature
+      integer, intent(in) :: indexS !&lt; Input: index for salinity
+
+      real (kind=RKIND), dimension(:,:), intent(in) :: u       !&lt; Input: horizontal velocity
+      real (kind=RKIND), dimension(:,:), intent(in) :: h       !&lt; Input: thickness
+      real (kind=RKIND), dimension(:,:), intent(in) :: h_edge  !&lt; Input: thickness at edge 
+
+      real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers !&lt; Input: tracers
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(inout) :: rho    !&lt; Input/output: density
+      real (kind=RKIND), dimension(:,:), intent(inout) :: rhoDisplaced    !&lt; Input/output: displaced density
+      real (kind=RKIND), dimension(:,:), intent(inout) :: RiTopOfEdge     !&lt; Input/output: Richardson number top of cell
+      real (kind=RKIND), dimension(:,:), intent(inout) :: RiTopOfCell     !&lt; Input/output: Richardson number top of cell
+
+      integer, intent(inout) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: nVertLevels, nCells, nEdges, iCell, iEdge, k
+      integer :: cell1, cell2
+
+      integer, dimension(:), pointer :: maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot
+      integer, dimension(:,:), pointer :: cellsOnEdge
+
+      real (kind=RKIND) :: coef
+      real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, areaCell
+      real (kind=RKIND), dimension(:,:), allocatable :: drhoTopOfCell, du2TopOfCell, &amp;
+                                                        drhoTopOfEdge, du2TopOfEdge
+
+      err = 0
+
+      if(.not.richViscOn .and. .not.richDiffOn) return
+
+      nVertLevels = grid % nVertLevels
+      nCells = grid % nCells
+      nEdges = grid % nEdges
+
+      maxLevelCell =&gt; grid % maxLevelCell % array
+      maxLevelEdgeTop =&gt; grid % maxLevelEdgeTop % array
+      maxLevelEdgeBot =&gt; grid % maxLevelEdgeBot % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      dvEdge =&gt; grid % dvEdge % array
+      dcEdge =&gt; grid % dcEdge % array
+      areaCell =&gt; grid % areaCell % array
+
+      allocate( &amp;
+         drhoTopOfCell(nVertLevels+1,nCells+1), drhoTopOfEdge(nVertLevels+1,nEdges+1), &amp;
+         du2TopOfCell(nVertLevels+1,nCells+1), du2TopOfEdge(nVertLevels+1,nEdges+1))
+
+      ! compute density of parcel displaced to next deeper z-level,
+      ! in state % rhoDisplaced
+!maltrud make sure rho is current--check this for redundancy
+!     call OcnEquationOfStateRho(grid, 'relative', 0, indexT, indexS, &amp;
+!              tracers, rho, err) 
+      ! mrp 110324 In order to visualize rhoDisplaced, include the following
+!     call OcnEquationOfStateRho(grid, 'relative', 1, indexT, indexS, &amp;
+!              tracers, rhoDisplaced, err) 
+
+
+      ! drhoTopOfCell(k) = $\rho^*_{k-1}-\rho^*_k$
+      drhoTopOfCell = 0.0
+      do iCell=1,nCells
+         do k=2,maxLevelCell(iCell)
+            drhoTopOfCell(k,iCell) = rho(k-1,iCell) - rhoDisplaced(k-1,iCell)
+          end do
+      end do
+
+      ! interpolate drhoTopOfCell to drhoTopOfEdge
+      drhoTopOfEdge = 0.0
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         do k=2,maxLevelEdgeTop(iEdge)
+            drhoTopOfEdge(k,iEdge) = &amp;
+               (drhoTopOfCell(k,cell1) + &amp;
+                drhoTopOfCell(k,cell2))/2  
+         end do
+       end do
+
+      ! du2TopOfEdge(k) = $u_{k-1}-u_k$
+      du2TopOfEdge=0.0
+      do iEdge=1,nEdges
+         do k=2,maxLevelEdgeTop(iEdge)
+            du2TopOfEdge(k,iEdge) = (u(k-1,iEdge) - u(k,iEdge))**2
+         end do
+      end do
+
+      ! interpolate du2TopOfEdge to du2TopOfCell
+      du2TopOfCell = 0.0
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         do k=2,maxLevelEdgeBot(iEdge)
+            du2TopOfCell(k,cell1) = du2TopOfCell(k,cell1) &amp;
+               + 0.5 * dcEdge(iEdge) * dvEdge(iEdge) * du2TopOfEdge(k,iEdge)
+            du2TopOfCell(k,cell2) = du2TopOfCell(k,cell2) &amp;
+               + 0.5 * dcEdge(iEdge) * dvEdge(iEdge) * du2TopOfEdge(k,iEdge)
+         end do
+      end do
+      do iCell = 1,nCells
+         do k = 2,maxLevelCell(iCell)
+            du2TopOfCell(k,iCell) = du2TopOfCell(k,iCell) / areaCell(iCell)
+         end do
+      end do
+
+      ! compute RiTopOfEdge using drhoTopOfEdge and du2TopOfEdge
+      ! coef = -g/rho_0/2
+      RiTopOfEdge = 0.0
+      coef = -gravity/1000.0/2.0
+      do iEdge = 1,nEdges
+         do k = 2,maxLevelEdgeTop(iEdge)
+            RiTopOfEdge(k,iEdge) = coef*drhoTopOfEdge(k,iEdge) &amp;
+               *(h_edge(k-1,iEdge)+h_edge(k,iEdge)) &amp;
+               / (du2TopOfEdge(k,iEdge) + 1e-20)
+         end do
+      end do
+
+      ! compute RiTopOfCell using drhoTopOfCell and du2TopOfCell
+      ! coef = -g/rho_0/2
+      RiTopOfCell = 0.0
+      coef = -gravity/1000.0/2.0
+      do iCell = 1,nCells
+         do k = 2,maxLevelCell(iCell)
+            RiTopOfCell(k,iCell) = coef*drhoTopOfCell(k,iCell) &amp;
+               *(h(k-1,iCell)+h(k,iCell)) &amp;
+               / (du2TopOfCell(k,iCell) + 1e-20)
+         end do
+      end do
+
+      deallocate(drhoTopOfCell, drhoTopOfEdge, &amp;
+        du2TopOfCell, du2TopOfEdge)
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vmix_get_rich_numbers!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vmix_coefs_rich_init
+!
+!&gt; \brief   Initializes ocean momentum vertical mixing quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  vertical velocity mixing in the ocean. Since a variety of 
+!&gt;  parameterizations are available, this routine primarily calls the
+!&gt;  individual init routines for each parameterization. 
+!
+!-----------------------------------------------------------------------
+
+
+   subroutine ocn_vmix_coefs_rich_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+
+      richViscOn = .false.
+      richDiffOn = .false.
+
+      if (config_vert_visc_type.eq.'rich') then
+          richViscOn = .true.
+      endif
+
+      if (config_vert_diff_type.eq.'rich') then
+          richDiffOn = .true.
+      endif
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vmix_coefs_rich_init!}}}
+
+!***********************************************************************
+
+end module ocn_vmix_coefs_rich
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F
===================================================================
--- trunk/mpas/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,329 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-!  ocn_vmix_coefs_tanh
-!
-!&gt; \brief MPAS ocean vertical mixing coefficients
-!&gt; \author Doug Jacobsen
-!&gt; \date   19 September 2011
-!&gt; \version SVN:$Id:$
-!&gt; \details
-!&gt;  This module contains the routines for computing 
-!&gt;  tanhant vertical mixing coefficients.  
-!&gt;
-!
-!-----------------------------------------------------------------------
-
-module ocn_vmix_coefs_tanh
-
-   use grid_types
-   use configure
-   use timer
-
-   implicit none
-   private
-   save
-
-   !--------------------------------------------------------------------
-   !
-   ! Public parameters
-   !
-   !--------------------------------------------------------------------
-
-   !--------------------------------------------------------------------
-   !
-   ! Public member functions
-   !
-   !--------------------------------------------------------------------
-
-   public :: ocn_vmix_coefs_tanh_build, &amp;
-             ocn_vmix_coefs_tanh_init
-
-   !--------------------------------------------------------------------
-   !
-   ! Private module variables
-   !
-   !--------------------------------------------------------------------
-
-   logical :: tanhViscOn, tanhDiffOn
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-!  routine ocn_vmix_coefs_tanh_build
-!
-!&gt; \brief   Computes coefficients for vertical mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the vertical mixing coefficients for momentum
-!&gt;  and tracers based user choices of mixing parameterization.
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vmix_coefs_tanh_build(grid, s, d, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      type (state_type), intent(inout) :: &amp;
-         s             !&lt; Input/Output: state information
-
-      type (diagnostics_type), intent(inout) :: &amp;
-         d             !&lt; Input/Output: diagnostic information
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: err1, err2
-
-      real (kind=RKIND), dimension(:,:), pointer :: &amp;
-        vertViscTopOfEdge, vertDiffTopOfCell
-
-      !-----------------------------------------------------------------
-      !
-      ! call relevant routines for computing tendencies
-      ! note that the user can choose multiple options and the 
-      !   tendencies will be added together
-      !
-      !-----------------------------------------------------------------
-
-      err = 0
-      if((.not.tanhViscOn) .and. (.not.tanhDiffOn)) return
-
-      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
-      vertDiffTopOfCell =&gt; d % vertDiffTopOfCell % array
-
-      call ocn_vel_vmix_coefs_tanh(grid, vertViscTopOfEdge, err1)
-      call ocn_tracer_vmix_coefs_tanh(grid, vertDiffTopOfCell, err2)
-
-      err = err1 .or. err2
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vmix_coefs_tanh_build!}}}
-
-!***********************************************************************
-!
-!  routine ocn_vel_vmix_coefs_tanh
-!
-!&gt; \brief   Computes coefficients for vertical momentum mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the tanh vertical mixing coefficients for momentum
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_vel_vmix_coefs_tanh(grid, vertViscTopOfEdge, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(out) :: vertViscTopOfEdge !&lt; Output: Vertical viscosity
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: k, nVertLevels
-
-      real (kind=RKIND), dimension(:), pointer :: zTopZLevel
-
-      err = 0
-
-      if(.not.tanhViscOn) return
-
-      nVertLevels = grid % nVertLevels
-      zTopZLevel =&gt; grid % zTopZLevel % array
-
-      do k=1,nVertLevels+1
-          vertViscTopOfEdge(k,:) = -(config_max_visc_tanh-config_min_visc_tanh)/2.0 &amp;
-            *tanh(-(zTopZLevel(k)-config_ZMid_tanh) &amp;
-                  /config_zWidth_tanh) &amp;
-            + (config_max_visc_tanh+config_min_visc_tanh)/2
-      end do
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vel_vmix_coefs_tanh!}}}
-
-!***********************************************************************
-!
-!  routine ocn_tracer_vmix_coefs_tanh
-!
-!&gt; \brief   Computes coefficients for vertical tracer mixing
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine computes the tanh vertical mixing coefficients for tracers
-!
-!-----------------------------------------------------------------------
-
-   subroutine ocn_tracer_vmix_coefs_tanh(grid, vertDiffTopOfCell, err)!{{{
-
-      !-----------------------------------------------------------------
-      !
-      ! input variables
-      !
-      !-----------------------------------------------------------------
-
-      type (mesh_type), intent(in) :: &amp;
-         grid          !&lt; Input: grid information
-
-      !-----------------------------------------------------------------
-      !
-      ! input/output variables
-      !
-      !-----------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! output variables
-      !
-      !-----------------------------------------------------------------
-
-      real (kind=RKIND), dimension(:,:), intent(out) :: vertDiffTopOfCell !&lt; Output: Vertical diffusion
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      !-----------------------------------------------------------------
-      !
-      ! local variables
-      !
-      !-----------------------------------------------------------------
-
-      integer :: k, nVertLevels
-
-      real (kind=RKIND), dimension(:), pointer :: zTopZLevel
-
-      err = 0
-
-      if(.not.tanhDiffOn) return
-
-      nVertLevels = grid % nVertLevels
-      zTopZLevel =&gt; grid % zTopZLevel % array
-
-      do k=1,nVertLevels+1
-         vertDiffTopOfCell(k,:) = -(config_max_diff_tanh-config_min_diff_tanh)/2.0 &amp;
-            *tanh(-(zTopZLevel(k)-config_ZMid_tanh) &amp;
-                  /config_zWidth_tanh) &amp;
-            + (config_max_diff_tanh+config_min_diff_tanh)/2
-      end do
-
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_tracer_vmix_coefs_tanh!}}}
-
-
-!***********************************************************************
-!
-!  routine ocn_vmix_coefs_tanh_init
-!
-!&gt; \brief   Initializes ocean vertical mixing quantities
-!&gt; \author  Doug Jacobsen
-!&gt; \date    19 September 2011
-!&gt; \version SVN:$Id$
-!&gt; \details 
-!&gt;  This routine initializes a variety of quantities related to 
-!&gt;  tanh vertical mixing in the ocean. 
-!
-!-----------------------------------------------------------------------
-
-
-   subroutine ocn_vmix_coefs_tanh_init(err)!{{{
-
-   !--------------------------------------------------------------------
-
-      !-----------------------------------------------------------------
-      !
-      ! call individual init routines for each parameterization
-      !
-      !-----------------------------------------------------------------
-
-      integer, intent(out) :: err !&lt; Output: error flag
-
-      err = 0
-
-      tanhViscOn = .false.
-      tanhDiffOn = .false.
-
-      if (config_vert_visc_type.eq.'tanh') then
-          tanhViscOn = .true.
-      endif
-
-      if (config_vert_diff_type.eq.'tanh') then
-          tanhDiffOn = .true.
-      endif
-
-      if(tanhViscOn .or. tanhDiffOn) then
-         if (config_vert_grid_type.ne.'zlevel') then
-            write(0,*) 'Abort: config_vert_diff_type.eq.tanh may only', &amp;
-                       ' use config_vert_grid_type of zlevel at this time'
-            err = 1
-         endif
-      endif
-
-   !--------------------------------------------------------------------
-
-   end subroutine ocn_vmix_coefs_tanh_init!}}}
-
-!***********************************************************************
-
-end module ocn_vmix_coefs_tanh
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-
-! vim: foldmethod=marker

Copied: branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F (from rev 1114, trunk/mpas/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F)
===================================================================
--- branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F                                (rev 0)
+++ branches/source_condensing/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,329 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+!  ocn_vmix_coefs_tanh
+!
+!&gt; \brief MPAS ocean vertical mixing coefficients
+!&gt; \author Doug Jacobsen
+!&gt; \date   19 September 2011
+!&gt; \version SVN:$Id:$
+!&gt; \details
+!&gt;  This module contains the routines for computing 
+!&gt;  tanhant vertical mixing coefficients.  
+!&gt;
+!
+!-----------------------------------------------------------------------
+
+module ocn_vmix_coefs_tanh
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_timer
+
+   implicit none
+   private
+   save
+
+   !--------------------------------------------------------------------
+   !
+   ! Public parameters
+   !
+   !--------------------------------------------------------------------
+
+   !--------------------------------------------------------------------
+   !
+   ! Public member functions
+   !
+   !--------------------------------------------------------------------
+
+   public :: ocn_vmix_coefs_tanh_build, &amp;
+             ocn_vmix_coefs_tanh_init
+
+   !--------------------------------------------------------------------
+   !
+   ! Private module variables
+   !
+   !--------------------------------------------------------------------
+
+   logical :: tanhViscOn, tanhDiffOn
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+!  routine ocn_vmix_coefs_tanh_build
+!
+!&gt; \brief   Computes coefficients for vertical mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the vertical mixing coefficients for momentum
+!&gt;  and tracers based user choices of mixing parameterization.
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vmix_coefs_tanh_build(grid, s, d, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      type (state_type), intent(inout) :: &amp;
+         s             !&lt; Input/Output: state information
+
+      type (diagnostics_type), intent(inout) :: &amp;
+         d             !&lt; Input/Output: diagnostic information
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: err1, err2
+
+      real (kind=RKIND), dimension(:,:), pointer :: &amp;
+        vertViscTopOfEdge, vertDiffTopOfCell
+
+      !-----------------------------------------------------------------
+      !
+      ! call relevant routines for computing tendencies
+      ! note that the user can choose multiple options and the 
+      !   tendencies will be added together
+      !
+      !-----------------------------------------------------------------
+
+      err = 0
+      if((.not.tanhViscOn) .and. (.not.tanhDiffOn)) return
+
+      vertViscTopOfEdge =&gt; d % vertViscTopOfEdge % array
+      vertDiffTopOfCell =&gt; d % vertDiffTopOfCell % array
+
+      call ocn_vel_vmix_coefs_tanh(grid, vertViscTopOfEdge, err1)
+      call ocn_tracer_vmix_coefs_tanh(grid, vertDiffTopOfCell, err2)
+
+      err = err1 .or. err2
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vmix_coefs_tanh_build!}}}
+
+!***********************************************************************
+!
+!  routine ocn_vel_vmix_coefs_tanh
+!
+!&gt; \brief   Computes coefficients for vertical momentum mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the tanh vertical mixing coefficients for momentum
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_vel_vmix_coefs_tanh(grid, vertViscTopOfEdge, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(out) :: vertViscTopOfEdge !&lt; Output: Vertical viscosity
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: k, nVertLevels
+
+      real (kind=RKIND), dimension(:), pointer :: zTopZLevel
+
+      err = 0
+
+      if(.not.tanhViscOn) return
+
+      nVertLevels = grid % nVertLevels
+      zTopZLevel =&gt; grid % zTopZLevel % array
+
+      do k=1,nVertLevels+1
+          vertViscTopOfEdge(k,:) = -(config_max_visc_tanh-config_min_visc_tanh)/2.0 &amp;
+            *tanh(-(zTopZLevel(k)-config_ZMid_tanh) &amp;
+                  /config_zWidth_tanh) &amp;
+            + (config_max_visc_tanh+config_min_visc_tanh)/2
+      end do
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vel_vmix_coefs_tanh!}}}
+
+!***********************************************************************
+!
+!  routine ocn_tracer_vmix_coefs_tanh
+!
+!&gt; \brief   Computes coefficients for vertical tracer mixing
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine computes the tanh vertical mixing coefficients for tracers
+!
+!-----------------------------------------------------------------------
+
+   subroutine ocn_tracer_vmix_coefs_tanh(grid, vertDiffTopOfCell, err)!{{{
+
+      !-----------------------------------------------------------------
+      !
+      ! input variables
+      !
+      !-----------------------------------------------------------------
+
+      type (mesh_type), intent(in) :: &amp;
+         grid          !&lt; Input: grid information
+
+      !-----------------------------------------------------------------
+      !
+      ! input/output variables
+      !
+      !-----------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! output variables
+      !
+      !-----------------------------------------------------------------
+
+      real (kind=RKIND), dimension(:,:), intent(out) :: vertDiffTopOfCell !&lt; Output: Vertical diffusion
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      !-----------------------------------------------------------------
+      !
+      ! local variables
+      !
+      !-----------------------------------------------------------------
+
+      integer :: k, nVertLevels
+
+      real (kind=RKIND), dimension(:), pointer :: zTopZLevel
+
+      err = 0
+
+      if(.not.tanhDiffOn) return
+
+      nVertLevels = grid % nVertLevels
+      zTopZLevel =&gt; grid % zTopZLevel % array
+
+      do k=1,nVertLevels+1
+         vertDiffTopOfCell(k,:) = -(config_max_diff_tanh-config_min_diff_tanh)/2.0 &amp;
+            *tanh(-(zTopZLevel(k)-config_ZMid_tanh) &amp;
+                  /config_zWidth_tanh) &amp;
+            + (config_max_diff_tanh+config_min_diff_tanh)/2
+      end do
+
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_tracer_vmix_coefs_tanh!}}}
+
+
+!***********************************************************************
+!
+!  routine ocn_vmix_coefs_tanh_init
+!
+!&gt; \brief   Initializes ocean vertical mixing quantities
+!&gt; \author  Doug Jacobsen
+!&gt; \date    19 September 2011
+!&gt; \version SVN:$Id$
+!&gt; \details 
+!&gt;  This routine initializes a variety of quantities related to 
+!&gt;  tanh vertical mixing in the ocean. 
+!
+!-----------------------------------------------------------------------
+
+
+   subroutine ocn_vmix_coefs_tanh_init(err)!{{{
+
+   !--------------------------------------------------------------------
+
+      !-----------------------------------------------------------------
+      !
+      ! call individual init routines for each parameterization
+      !
+      !-----------------------------------------------------------------
+
+      integer, intent(out) :: err !&lt; Output: error flag
+
+      err = 0
+
+      tanhViscOn = .false.
+      tanhDiffOn = .false.
+
+      if (config_vert_visc_type.eq.'tanh') then
+          tanhViscOn = .true.
+      endif
+
+      if (config_vert_diff_type.eq.'tanh') then
+          tanhDiffOn = .true.
+      endif
+
+      if(tanhViscOn .or. tanhDiffOn) then
+         if (config_vert_grid_type.ne.'zlevel') then
+            write(0,*) 'Abort: config_vert_diff_type.eq.tanh may only', &amp;
+                       ' use config_vert_grid_type of zlevel at this time'
+            err = 1
+         endif
+      endif
+
+   !--------------------------------------------------------------------
+
+   end subroutine ocn_vmix_coefs_tanh_init!}}}
+
+!***********************************************************************
+
+end module ocn_vmix_coefs_tanh
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+
+! vim: foldmethod=marker

Deleted: branches/source_condensing/src/core_sw/Makefile
===================================================================
--- trunk/mpas/src/core_sw/Makefile        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_sw/Makefile        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,30 +0,0 @@
-.SUFFIXES: .F .o
-
-OBJS =         module_mpas_core.o \
-        module_test_cases.o \
-        module_advection.o \
-        module_time_integration.o \
-        module_global_diagnostics.o
-
-all: core_sw
-
-core_sw: $(OBJS)
-        ar -ru libdycore.a $(OBJS)
-
-module_test_cases.o:
-
-module_advection.o:
-
-module_time_integration.o:
-
-module_global_diagnostics.o:
-
-module_mpas_core.o: module_global_diagnostics.o module_test_cases.o module_time_integration.o module_advection.o
-
-clean:
-        $(RM) *.o *.mod *.f90 libdycore.a
-
-.F.o:
-        $(RM) $@ $*.mod
-        $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $&lt; &gt; $*.f90
-        $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework -I../operators -I../external/esmf_time_f90

Copied: branches/source_condensing/src/core_sw/Makefile (from rev 1114, trunk/mpas/src/core_sw/Makefile)
===================================================================
--- branches/source_condensing/src/core_sw/Makefile                                (rev 0)
+++ branches/source_condensing/src/core_sw/Makefile        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,30 @@
+.SUFFIXES: .F .o
+
+OBJS =         mpas_sw_mpas_core.o \
+        mpas_sw_test_cases.o \
+        mpas_sw_advection.o \
+        mpas_sw_time_integration.o \
+        mpas_sw_global_diagnostics.o
+
+all: core_sw
+
+core_sw: $(OBJS)
+        ar -ru libdycore.a $(OBJS)
+
+mpas_sw_test_cases.o:
+
+mpas_sw_advection.o:
+
+mpas_sw_time_integration.o:
+
+mpas_sw_global_diagnostics.o:
+
+mpas_sw_mpas_core.o: mpas_sw_global_diagnostics.o mpas_sw_test_cases.o mpas_sw_time_integration.o mpas_sw_advection.o
+
+clean:
+        $(RM) *.o *.mod *.f90 libdycore.a
+
+.F.o:
+        $(RM) $@ $*.mod
+        $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $&lt; &gt; $*.f90
+        $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework -I../operators -I../external/esmf_time_f90

Deleted: branches/source_condensing/src/core_sw/module_advection.F
===================================================================
--- trunk/mpas/src/core_sw/module_advection.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_sw/module_advection.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,933 +0,0 @@
-module advection
-
-   use grid_types
-   use configure
-   use constants
-
-
-   contains
-
-
-   subroutine initialize_advection_rk( grid )
-                                      
-!
-! compute the cell coefficients for the polynomial fit.
-! this is performed during setup for model integration.
-! WCS, 31 August 2009
-!
-      implicit none
-
-      type (mesh_type), intent(in) :: grid
-
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      integer, dimension(:,:), pointer :: advCells
-
-!  local variables
-
-      real (kind=RKIND), dimension(2, grid % nEdges) :: thetae
-      real (kind=RKIND), dimension(grid % nEdges) :: xe, ye
-      real (kind=RKIND), dimension(grid % nCells) :: theta_abs
-
-      real (kind=RKIND), dimension(25) :: xc, yc, zc ! cell center coordinates
-      real (kind=RKIND), dimension(25) :: thetav, thetat, dl_sphere
-      real (kind=RKIND) :: xm, ym, zm, dl, xec, yec, zec
-      real (kind=RKIND) :: thetae_tmp, xe_tmp, ye_tmp
-      real (kind=RKIND) :: xv1, xv2, yv1, yv2, zv1, zv2
-      integer :: i, j, k, ip1, ip2, m, n, ip1a, ii
-      integer :: iCell, iEdge
-      real (kind=RKIND) :: pii
-      real (kind=RKIND) :: x0, y0, x1, y1, x2, y2, x3, y3, x4, y4, x5, y5
-      real (kind=RKIND) :: pdx1, pdx2, pdx3, pdy1, pdy2, pdy3, dx1, dx2, dy1, dy2
-      real (kind=RKIND) :: angv1, angv2, dl1, dl2
-      real (kind=RKIND), dimension(25) :: dxe, dye, x2v, y2v, xp, yp
-      
-      real (kind=RKIND) :: amatrix(25,25), bmatrix(25,25), wmatrix(25,25)
-      real (kind=RKIND) :: length_scale
-      integer :: ma,na, cell_add, mw, nn
-      integer, dimension(25) :: cell_list
-
-
-      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
-
-      logical, parameter :: reset_poly = .true.
-
-      real (kind=RKIND) :: rcell, cos2t, costsint, sin2t
-      real (kind=RKIND), dimension(grid%maxEdges) :: angle_2d
-
-!---
-
-      pii = 2.*asin(1.0)
-
-      advCells =&gt; grid % advCells % array
-      deriv_two =&gt; grid % deriv_two % array
-      deriv_two(:,:,:) = 0.
-
-      do iCell = 1, grid % nCells !  is this correct? - we need first halo cell also...
-
-         cell_list(1) = iCell
-         do i=2, grid % nEdgesOnCell % array(iCell)+1
-            cell_list(i) = grid % CellsOnCell % array(i-1,iCell)
-         end do
-         n = grid % nEdgesOnCell % array(iCell) + 1
-
-         if ( polynomial_order &gt; 2 ) then
-            do i=2,grid % nEdgesOnCell % array(iCell) + 1
-               do j=1,grid % nEdgesOnCell % array ( cell_list(i) )
-                  cell_add = grid % CellsOnCell % array (j,cell_list(i))
-                  add_the_cell = .true.
-                  do k=1,n
-                     if ( cell_add == cell_list(k) ) add_the_cell = .false.
-                  end do
-                  if (add_the_cell) then
-                     n = n+1
-                     cell_list(n) = cell_add
-                  end if
-               end do
-            end do
-         end if

-         advCells(1,iCell) = n
-
-!  check to see if we are reaching outside the halo
-
-         do_the_cell = .true.
-         do i=1,n
-            if (cell_list(i) &gt; grid % nCells) do_the_cell = .false.
-         end do
-
-
-         if ( .not. do_the_cell ) cycle
-
-
-!  compute poynomial fit for this cell if all needed neighbors exist
-         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
-            end do
-
-            theta_abs(iCell) =  pii/2. - sphere_angle( xc(1), yc(1), zc(1),  &amp;
-                                                       xc(2), yc(2), zc(2),  &amp;
-                                                       0.,    0.,    1.      ) 
-
-! angles from cell center to neighbor centers (thetav)
-
-            do i=1,n-1
-   
-               ip2 = i+2
-               if (ip2 &gt; n) ip2 = 2
-    
-               thetav(i) = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
-                                         xc(i+1), yc(i+1), zc(i+1),  &amp;
-                                         xc(ip2), yc(ip2), zc(ip2)   )
-
-               dl_sphere(i) = a*arc_length( xc(1),   yc(1),   zc(1),  &amp;
-                                            xc(i+1), yc(i+1), zc(i+1) )
-            end do
-
-            length_scale = 1.
-            do i=1,n-1
-               dl_sphere(i) = dl_sphere(i)/length_scale
-            end do
-
-!            thetat(1) = 0.  !  this defines the x direction, cell center 1 -&gt; 
-            thetat(1) = theta_abs(iCell)  !  this defines the x direction, longitude line
-            do i=2,n-1
-               thetat(i) = thetat(i-1) + thetav(i-1)
-            end do
-   
-            do i=1,n-1
-               xp(i) = cos(thetat(i)) * dl_sphere(i)
-               yp(i) = sin(thetat(i)) * dl_sphere(i)
-            end do
-
-         else     ! On an x-y plane
-
-            do i=1,n-1
-
-               angle_2d(i) = grid%angleEdge%array(grid % EdgesOnCell % array(i,iCell))
-               iEdge = grid % EdgesOnCell % array(i,iCell)
-               if ( iCell .ne. grid % CellsOnEdge % array(1,iEdge)) &amp;
-                  angle_2d(i) = angle_2d(i) - pii
-
-!               xp(i) = grid % xCell % array(cell_list(i)) - grid % xCell % array(iCell)
-!               yp(i) = grid % yCell % array(cell_list(i)) - grid % yCell % array(iCell)
-
-               xp(i) = grid % dcEdge % array(grid % EdgesOnCell % array(i,iCell)) * cos(angle_2d(i))
-               yp(i) = grid % dcEdge % array(grid % EdgesOnCell % array(i,iCell)) * sin(angle_2d(i))
-
-            end do
-
-         end if
-
-
-         ma = n-1
-         mw = grid % nEdgesOnCell % array (iCell)
-
-         bmatrix = 0.
-         amatrix = 0.
-         wmatrix = 0.
-
-         if (polynomial_order == 2) then
-            na = 6
-            ma = ma+1
-  
-            amatrix(1,1) = 1.
-            wmatrix(1,1) = 1.
-            do i=2,ma
-               amatrix(i,1) = 1.
-               amatrix(i,2) = xp(i-1)
-               amatrix(i,3) = yp(i-1)
-               amatrix(i,4) = xp(i-1)**2
-               amatrix(i,5) = xp(i-1) * yp(i-1)
-               amatrix(i,6) = yp(i-1)**2
-   
-               wmatrix(i,i) = 1.
-            end do

-         else if (polynomial_order == 3) then
-            na = 10
-            ma = ma+1
-  
-            amatrix(1,1) = 1.
-            wmatrix(1,1) = 1.
-            do i=2,ma
-               amatrix(i,1) = 1.
-               amatrix(i,2) = xp(i-1)
-               amatrix(i,3) = yp(i-1)
-   
-               amatrix(i,4) = xp(i-1)**2
-               amatrix(i,5) = xp(i-1) * yp(i-1)
-               amatrix(i,6) = yp(i-1)**2
-   
-               amatrix(i,7) = xp(i-1)**3
-               amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
-               amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
-               amatrix(i,10) = yp(i-1)**3
-   
-               wmatrix(i,i) = 1.

-            end do
-
-         else
-            na = 15
-            ma = ma+1
-  
-            amatrix(1,1) = 1.
-            wmatrix(1,1) = 1.
-            do i=2,ma
-               amatrix(i,1) = 1.
-               amatrix(i,2) = xp(i-1)
-               amatrix(i,3) = yp(i-1)
-   
-               amatrix(i,4) = xp(i-1)**2
-               amatrix(i,5) = xp(i-1) * yp(i-1)
-               amatrix(i,6) = yp(i-1)**2
-   
-               amatrix(i,7) = xp(i-1)**3
-               amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
-               amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
-               amatrix(i,10) = yp(i-1)**3
-   
-               amatrix(i,11) = xp(i-1)**4
-               amatrix(i,12) = yp(i-1) * (xp(i-1)**3)
-               amatrix(i,13) = (xp(i-1)**2)*(yp(i-1)**2)
-               amatrix(i,14) = xp(i-1) * (yp(i-1)**3)
-               amatrix(i,15) = yp(i-1)**4
-   
-               wmatrix(i,i) = 1.
-  
-            end do

-            do i=1,mw
-               wmatrix(i,i) = 1.
-            end do

-         end if

-         call poly_fit_2( amatrix, bmatrix, wmatrix, ma, na, 25 )
-
-         do i=1,grid % nEdgesOnCell % array (iCell)
-            ip1 = i+1
-            if (ip1 &gt; n-1) ip1 = 1
-  
-            iEdge = grid % EdgesOnCell % array (i,iCell)
-            xv1 = grid % xVertex % array(grid % verticesOnEdge % array (1,iedge))/a
-            yv1 = grid % yVertex % array(grid % verticesOnEdge % array (1,iedge))/a
-            zv1 = grid % zVertex % array(grid % verticesOnEdge % array (1,iedge))/a
-            xv2 = grid % xVertex % array(grid % verticesOnEdge % array (2,iedge))/a
-            yv2 = grid % yVertex % array(grid % verticesOnEdge % array (2,iedge))/a
-            zv2 = grid % zVertex % array(grid % verticesOnEdge % array (2,iedge))/a
-  
-            if ( grid % on_a_sphere ) then
-               call arc_bisect( xv1, yv1, zv1,  &amp;
-                                xv2, yv2, zv2,  &amp;
-                                xec, yec, zec   )
-  
-               thetae_tmp = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
-                                          xc(i+1), yc(i+1), zc(i+1),  &amp;
-                                          xec,     yec,     zec       )
-               thetae_tmp = thetae_tmp + thetat(i)
-               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
-                  thetae(1,grid % EdgesOnCell % array (i,iCell)) = thetae_tmp
-               else
-                  thetae(2,grid % EdgesOnCell % array (i,iCell)) = thetae_tmp
-               end if
-!            else
-!
-!               xe(grid % EdgesOnCell % array (i,iCell)) = 0.5 * (xv1 + xv2)
-!               ye(grid % EdgesOnCell % array (i,iCell)) = 0.5 * (yv1 + yv2)
-
-            end if
-  
-         end do
-
-!  fill second derivative stencil for rk advection 
-
-         do i=1, grid % nEdgesOnCell % array (iCell)
-            iEdge = grid % EdgesOnCell % array (i,iCell)
-  
-  
-            if ( grid % on_a_sphere ) then
-               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
-  
-                  cos2t = cos(thetae(1,grid % EdgesOnCell % array (i,iCell)))
-                  sin2t = sin(thetae(1,grid % EdgesOnCell % array (i,iCell)))
-                  costsint = cos2t*sin2t
-                  cos2t = cos2t**2
-                  sin2t = sin2t**2
-   
-                  do j=1,n
-                     deriv_two(j,1,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
-                                            + 2.*costsint*bmatrix(5,j)  &amp;
-                                            + 2.*sin2t*bmatrix(6,j)
-                  end do
-               else
-     
-                  cos2t = cos(thetae(2,grid % EdgesOnCell % array (i,iCell)))
-                  sin2t = sin(thetae(2,grid % EdgesOnCell % array (i,iCell)))
-                  costsint = cos2t*sin2t
-                  cos2t = cos2t**2
-                  sin2t = sin2t**2
-      
-                  do j=1,n
-                     deriv_two(j,2,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
-                                            + 2.*costsint*bmatrix(5,j)  &amp;
-                                            + 2.*sin2t*bmatrix(6,j)
-                  end do
-               end if
-
-            else
-
-               cos2t = cos(angle_2d(i))
-               sin2t = sin(angle_2d(i))
-               costsint = cos2t*sin2t
-               cos2t = cos2t**2
-               sin2t = sin2t**2
-
-!               do j=1,n
-!
-!                  deriv_two(j,1,iEdge) =   2.*xe(iEdge)*xe(iEdge)*bmatrix(4,j)  &amp;
-!                                         + 2.*xe(iEdge)*ye(iEdge)*bmatrix(5,j)  &amp;
-!                                         + 2.*ye(iEdge)*ye(iEdge)*bmatrix(6,j)
-!               end do
-
-               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
-                  do j=1,n
-                     deriv_two(j,1,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
-                                            + 2.*costsint*bmatrix(5,j)  &amp;
-                                            + 2.*sin2t*bmatrix(6,j)
-                  end do
-               else
-                  do j=1,n
-                     deriv_two(j,2,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
-                                            + 2.*costsint*bmatrix(5,j)  &amp;
-                                            + 2.*sin2t*bmatrix(6,j)
-                  end do
-               end if
-
-            end if
-         end do

-      end do ! end of loop over cells
-
-      if (debug) stop
-
-
-!      write(0,*) ' check for deriv2 coefficients, iEdge 4 '
-!
-!      iEdge = 4
-!      j = 1
-!      iCell = grid % cellsOnEdge % array(1,iEdge)
-!      write(0,*) ' j, icell, coef ',j,iCell,deriv_two(j,1,iEdge)
-!      do j=2,7
-!         write(0,*) ' j, icell, coef ',j,grid % CellsOnCell % array(j-1,iCell),deriv_two(j,1,iEdge)
-!      end do
-!
-!      j = 1
-!      iCell = grid % cellsOnEdge % array(2,iEdge)
-!      write(0,*) ' j, icell, coef ',j,iCell,deriv_two(j,2,iEdge)
-!      do j=2,7
-!         write(0,*) ' j, icell, coef ',j,grid % CellsOnCell % array(j-1,iCell),deriv_two(j,2,iEdge)
-!      end do
-!      stop
-
-   end subroutine initialize_advection_rk
-
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! FUNCTION SPHERE_ANGLE
-   !
-   ! Computes the angle between arcs AB and AC, given points A, B, and C
-   ! Equation numbers w.r.t. http://mathworld.wolfram.com/SphericalTrigonometry.html
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   real function sphere_angle(ax, ay, az, bx, by, bz, cx, cy, cz)
-   
-      implicit none
-   
-      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz, cx, cy, cz
-   
-      real (kind=RKIND) :: a, b, c          ! Side lengths of spherical triangle ABC
-   
-      real (kind=RKIND) :: ABx, ABy, ABz    ! The components of the vector AB
-      real (kind=RKIND) :: mAB              ! The magnitude of AB
-      real (kind=RKIND) :: ACx, ACy, ACz    ! The components of the vector AC
-      real (kind=RKIND) :: mAC              ! The magnitude of AC
-   
-      real (kind=RKIND) :: Dx               ! The i-components of the cross product AB x AC
-      real (kind=RKIND) :: Dy               ! The j-components of the cross product AB x AC
-      real (kind=RKIND) :: Dz               ! The k-components of the cross product AB x AC
-   
-      real (kind=RKIND) :: s                ! Semiperimeter of the triangle
-      real (kind=RKIND) :: sin_angle
-   
-      a = acos(max(min(bx*cx + by*cy + bz*cz,1.0),-1.0))      ! Eqn. (3)
-      b = acos(max(min(ax*cx + ay*cy + az*cz,1.0),-1.0))      ! Eqn. (2)
-      c = acos(max(min(ax*bx + ay*by + az*bz,1.0),-1.0))      ! Eqn. (1)
-   
-      ABx = bx - ax
-      ABy = by - ay
-      ABz = bz - az
-   
-      ACx = cx - ax
-      ACy = cy - ay
-      ACz = cz - az
-   
-      Dx =   (ABy * ACz) - (ABz * ACy)
-      Dy = -((ABx * ACz) - (ABz * ACx))
-      Dz =   (ABx * ACy) - (ABy * ACx)
-   
-      s = 0.5*(a + b + c)
-!      sin_angle = sqrt((sin(s-b)*sin(s-c))/(sin(b)*sin(c)))   ! Eqn. (28)
-      sin_angle = sqrt(min(1.,max(0.,(sin(s-b)*sin(s-c))/(sin(b)*sin(c)))))   ! Eqn. (28)
-   
-      if ((Dx*ax + Dy*ay + Dz*az) &gt;= 0.0) then
-         sphere_angle =  2.0 * asin(max(min(sin_angle,1.0),-1.0))
-      else
-         sphere_angle = -2.0 * asin(max(min(sin_angle,1.0),-1.0))
-      end if
-   
-   end function sphere_angle
-   
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! FUNCTION PLANE_ANGLE
-   !
-   ! Computes the angle between vectors AB and AC, given points A, B, and C, and
-   !   a vector (u,v,w) normal to the plane.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   real function plane_angle(ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w)
-   
-      implicit none
-   
-      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w
-   
-      real (kind=RKIND) :: ABx, ABy, ABz    ! The components of the vector AB
-      real (kind=RKIND) :: mAB              ! The magnitude of AB
-      real (kind=RKIND) :: ACx, ACy, ACz    ! The components of the vector AC
-      real (kind=RKIND) :: mAC              ! The magnitude of AC
-   
-      real (kind=RKIND) :: Dx               ! The i-components of the cross product AB x AC
-      real (kind=RKIND) :: Dy               ! The j-components of the cross product AB x AC
-      real (kind=RKIND) :: Dz               ! The k-components of the cross product AB x AC
-   
-      real (kind=RKIND) :: cos_angle
-   
-      ABx = bx - ax
-      ABy = by - ay
-      ABz = bz - az
-      mAB = sqrt(ABx**2.0 + ABy**2.0 + ABz**2.0)
-   
-      ACx = cx - ax
-      ACy = cy - ay
-      ACz = cz - az
-      mAC = sqrt(ACx**2.0 + ACy**2.0 + ACz**2.0)
-   
-   
-      Dx =   (ABy * ACz) - (ABz * ACy)
-      Dy = -((ABx * ACz) - (ABz * ACx))
-      Dz =   (ABx * ACy) - (ABy * ACx)
-   
-      cos_angle = (ABx*ACx + ABy*ACy + ABz*ACz) / (mAB * mAC)
-   
-      if ((Dx*u + Dy*v + Dz*w) &gt;= 0.0) then
-         plane_angle =  acos(max(min(cos_angle,1.0),-1.0))
-      else
-         plane_angle = -acos(max(min(cos_angle,1.0),-1.0))
-      end if
-   
-   end function plane_angle
-
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! FUNCTION ARC_LENGTH
-   !
-   ! Returns the length of the great circle arc from A=(ax, ay, az) to 
-   !    B=(bx, by, bz). It is assumed that both A and B lie on the surface of the
-   !    same sphere centered at the origin.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   real function arc_length(ax, ay, az, bx, by, bz)
-   
-      implicit none
-   
-      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz
-   
-      real (kind=RKIND) :: r, c
-      real (kind=RKIND) :: cx, cy, cz
-   
-      cx = bx - ax
-      cy = by - ay
-      cz = bz - az
-
-!      r = ax*ax + ay*ay + az*az
-!      c = cx*cx + cy*cy + cz*cz
-!
-!      arc_length = sqrt(r) * acos(1.0 - c/(2.0*r))
-
-      r = sqrt(ax*ax + ay*ay + az*az)
-      c = sqrt(cx*cx + cy*cy + cz*cz)
-!      arc_length = sqrt(r) * 2.0 * asin(c/(2.0*r))
-      arc_length = r * 2.0 * asin(c/(2.0*r))
-
-   end function arc_length
-   
-   
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! SUBROUTINE ARC_BISECT
-   !
-   ! Returns the point C=(cx, cy, cz) that bisects the great circle arc from
-   !   A=(ax, ay, az) to B=(bx, by, bz). It is assumed that A and B lie on the
-   !   surface of a sphere centered at the origin.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   subroutine arc_bisect(ax, ay, az, bx, by, bz, cx, cy, cz)
-   
-      implicit none
-   
-      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz
-      real (kind=RKIND), intent(out) :: cx, cy, cz
-   
-      real (kind=RKIND) :: r           ! Radius of the sphere
-      real (kind=RKIND) :: d           
-   
-      r = sqrt(ax*ax + ay*ay + az*az)
-   
-      cx = 0.5*(ax + bx)
-      cy = 0.5*(ay + by)
-      cz = 0.5*(az + bz)
-   
-      if (cx == 0. .and. cy == 0. .and. cz == 0.) then
-         write(0,*) 'Error: arc_bisect: A and B are diametrically opposite'
-      else
-         d = sqrt(cx*cx + cy*cy + cz*cz)
-         cx = r * cx / d
-         cy = r * cy / d
-         cz = r * cz / d
-      end if
-   
-   end subroutine arc_bisect
-
-
-   subroutine poly_fit_2(a_in,b_out,weights_in,m,n,ne)
-
-      implicit none
-
-      integer, intent(in) :: m,n,ne
-      real (kind=RKIND), dimension(ne,ne), intent(in) :: a_in, weights_in
-      real (kind=RKIND), dimension(ne,ne), intent(out) :: b_out
-   
-      ! local storage
-   
-      real (kind=RKIND), dimension(m,n)  :: a
-      real (kind=RKIND), dimension(n,m)  :: b
-      real (kind=RKIND), dimension(m,m)  :: w,wt,h
-      real (kind=RKIND), dimension(n,m)  :: at, ath
-      real (kind=RKIND), dimension(n,n)  :: ata, ata_inv, atha, atha_inv
-      integer, dimension(n) :: indx
-      integer :: i,j
-   
-      if ( (ne&lt;n) .or. (ne&lt;m) ) then
-         write(6,*) ' error in poly_fit_2 inversion ',m,n,ne
-         stop
-      end if
-   
-!      a(1:m,1:n) = a_in(1:n,1:m) 
-      a(1:m,1:n) = a_in(1:m,1:n)
-      w(1:m,1:m) = weights_in(1:m,1:m) 
-      b_out(:,:) = 0.   
-
-      wt = transpose(w)
-      h = matmul(wt,w)
-      at = transpose(a)
-      ath = matmul(at,h)
-      atha = matmul(ath,a)
-      
-      ata = matmul(at,a)
-
-!      if (m == n) then
-!         call migs(a,n,b,indx)
-!      else
-
-         call migs(atha,n,atha_inv,indx)
-
-         b = matmul(atha_inv,ath)
-
-!         call migs(ata,n,ata_inv,indx)
-!         b = matmul(ata_inv,at)
-!      end if
-      b_out(1:n,1:m) = b(1:n,1:m)
-
-!     do i=1,n
-!        write(6,*) ' i, indx ',i,indx(i)
-!     end do
-!
-!     write(6,*) ' '
-
-   end subroutine poly_fit_2
-
-
-! Updated 10/24/2001.
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!   Program 4.4   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!                                                                       !
-! Please Note:                                                          !
-!                                                                       !
-! (1) This computer program is written by Tao Pang in conjunction with  !
-!     his book, &quot;An Introduction to Computational Physics,&quot; published   !
-!     by Cambridge University Press in 1997.                            !
-!                                                                       !
-! (2) No warranties, express or implied, are made for this program.     !
-!                                                                       !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-SUBROUTINE MIGS (A,N,X,INDX)
-!
-! Subroutine to invert matrix A(N,N) with the inverse stored
-! in X(N,N) in the output.  Copyright (c) Tao Pang 2001.
-!
-  IMPLICIT NONE
-  INTEGER, INTENT (IN) :: N
-  INTEGER :: I,J,K
-  INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
-  REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N):: A
-  REAL (kind=RKIND), INTENT (OUT), DIMENSION (N,N):: X
-  REAL (kind=RKIND), DIMENSION (N,N) :: B
-!
-  DO I = 1, N
-    DO J = 1, N
-      B(I,J) = 0.0
-    END DO
-  END DO
-  DO I = 1, N
-    B(I,I) = 1.0
-  END DO
-!
-  CALL ELGS (A,N,INDX)
-!
-  DO I = 1, N-1
-    DO J = I+1, N
-      DO K = 1, N
-        B(INDX(J),K) = B(INDX(J),K)-A(INDX(J),I)*B(INDX(I),K)
-      END DO
-    END DO
-  END DO
-!
-  DO I = 1, N
-    X(N,I) = B(INDX(N),I)/A(INDX(N),N)
-    DO J = N-1, 1, -1
-      X(J,I) = B(INDX(J),I)
-      DO K = J+1, N
-        X(J,I) = X(J,I)-A(INDX(J),K)*X(K,I)
-      END DO
-      X(J,I) =  X(J,I)/A(INDX(J),J)
-    END DO
-  END DO
-END SUBROUTINE MIGS
-
-
-SUBROUTINE ELGS (A,N,INDX)
-!
-! Subroutine to perform the partial-pivoting Gaussian elimination.
-! A(N,N) is the original matrix in the input and transformed matrix
-! plus the pivoting element ratios below the diagonal in the output.
-! INDX(N) records the pivoting order.  Copyright (c) Tao Pang 2001.
-!
-  IMPLICIT NONE
-  INTEGER, INTENT (IN) :: N
-  INTEGER :: I,J,K,ITMP
-  INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
-  REAL (kind=RKIND) :: C1,PI,PI1,PJ
-  REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
-  REAL (kind=RKIND), DIMENSION (N) :: C
-!
-! Initialize the index
-!
-  DO I = 1, N
-    INDX(I) = I
-  END DO
-!
-! Find the rescaling factors, one from each row
-!
-  DO I = 1, N
-    C1= 0.0
-    DO J = 1, N
-      C1 = MAX(C1,ABS(A(I,J)))
-    END DO
-    C(I) = C1
-  END DO
-!
-! Search the pivoting (largest) element from each column
-!
-  DO J = 1, N-1
-    PI1 = 0.0
-    DO I = J, N
-      PI = ABS(A(INDX(I),J))/C(INDX(I))
-      IF (PI.GT.PI1) THEN
-        PI1 = PI
-        K   = I
-      ENDIF
-    END DO
-!
-! Interchange the rows via INDX(N) to record pivoting order
-!
-    ITMP    = INDX(J)
-    INDX(J) = INDX(K)
-    INDX(K) = ITMP
-    DO I = J+1, N
-      PJ  = A(INDX(I),J)/A(INDX(J),J)
-!
-! Record pivoting ratios below the diagonal
-!
-      A(INDX(I),J) = PJ
-!
-! Modify other elements accordingly
-!
-      DO K = J+1, N
-        A(INDX(I),K) = A(INDX(I),K)-PJ*A(INDX(J),K)
-      END DO
-    END DO
-  END DO
-!
-END SUBROUTINE ELGS
-
-!-------------------------------------------------------------
-
-   subroutine initialize_deformation_weights( grid )
-                                      
-!
-! compute the cell coefficients for the deformation calculations
-! WCS, 13 July 2010
-!
-      implicit none
-
-      type (mesh_type), intent(in) :: grid
-
-      real (kind=RKIND), dimension(:,:), pointer :: defc_a, defc_b
-      integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
-
-!  local variables
-
-      real (kind=RKIND), dimension(2, grid % nEdges) :: thetae
-      real (kind=RKIND), dimension(grid % nEdges) :: xe, ye
-      real (kind=RKIND), dimension(grid % nCells) :: theta_abs
-
-      real (kind=RKIND), dimension(25) :: xc, yc, zc ! cell center coordinates
-      real (kind=RKIND), dimension(25) :: thetav, thetat, dl_sphere
-      real (kind=RKIND) :: xm, ym, zm, dl, xec, yec, zec
-      real (kind=RKIND) :: thetae_tmp, xe_tmp, ye_tmp
-      real (kind=RKIND) :: xv1, xv2, yv1, yv2, zv1, zv2
-      integer :: i, j, k, ip1, ip2, m, n, ip1a, ii
-      integer :: iCell, iEdge
-      real (kind=RKIND) :: pii
-      real (kind=RKIND) :: x0, y0, x1, y1, x2, y2, x3, y3, x4, y4, x5, y5
-      real (kind=RKIND) :: pdx1, pdx2, pdx3, pdy1, pdy2, pdy3, dx1, dx2, dy1, dy2
-      real (kind=RKIND) :: angv1, angv2, dl1, dl2
-      real (kind=RKIND), dimension(25) :: dxe, dye, x2v, y2v, xp, yp, xpt, ypt
-      
-      real (kind=RKIND) :: length_scale
-      integer :: ma,na, cell_add, mw, nn
-      integer, dimension(25) :: cell_list
-
-      integer :: cell1, cell2, iv
-      logical :: do_the_cell
-      real (kind=RKIND) :: area_cell, sint2, cost2, sint_cost, sumw1, sumw2, xptt, area_cellt
-
-      logical, parameter :: debug = .false.
-
-      if (debug) write(0,*) ' in def weight calc '
-
-      defc_a =&gt; grid % defc_a % array
-      defc_b =&gt; grid % defc_b % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      edgesOnCell =&gt; grid % edgesOnCell % array
-
-      defc_a(:,:) = 0.
-      defc_b(:,:) = 0.
-
-      pii = 2.*asin(1.0)
-
-      if (debug) write(0,*) ' beginning cell loop '
-
-      do iCell = 1, grid % nCells
-
-         if (debug) write(0,*) ' cell loop ', iCell
-
-         cell_list(1) = iCell
-         do i=2, grid % nEdgesOnCell % array(iCell)+1
-            cell_list(i) = grid % CellsOnCell % array(i-1,iCell)
-         end do
-         n = grid % nEdgesOnCell % array(iCell) + 1
-
-!  check to see if we are reaching outside the halo
-
-         if (debug) write(0,*) ' points ', n
-
-         do_the_cell = .true.
-         do i=1,n
-            if (cell_list(i) &gt; grid % nCells) do_the_cell = .false.
-         end do
-
-
-         if (.not. do_the_cell) cycle
-
-
-!  compute poynomial fit for this cell if all needed neighbors exist
-         if (grid % on_a_sphere) then
-
-            xc(1) = grid % xCell % array(iCell)/a
-            yc(1) = grid % yCell % array(iCell)/a
-            zc(1) = grid % zCell % array(iCell)/a
-
-
-            do i=2,n
-               iv = grid % verticesOnCell % array(i-1,iCell)
-               xc(i) = grid % xVertex % array(iv)/a
-               yc(i) = grid % yVertex % array(iv)/a
-               zc(i) = grid % zVertex % array(iv)/a
-            end do
-
-            theta_abs(iCell) =  pii/2. - sphere_angle( xc(1), yc(1), zc(1),  &amp;
-                                                       xc(2), yc(2), zc(2),  &amp;
-                                                       0.,    0.,    1.      ) 
-
-! angles from cell center to neighbor centers (thetav)
-
-            do i=1,n-1
-   
-               ip2 = i+2
-               if (ip2 &gt; n) ip2 = 2
-    
-               thetav(i) = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
-                                         xc(i+1), yc(i+1), zc(i+1),  &amp;
-                                         xc(ip2), yc(ip2), zc(ip2)   )
-
-               dl_sphere(i) = a*arc_length( xc(1),   yc(1),   zc(1),  &amp;
-                                            xc(i+1), yc(i+1), zc(i+1) )
-            end do
-
-            length_scale = 1.
-            do i=1,n-1
-               dl_sphere(i) = dl_sphere(i)/length_scale
-            end do
-
-            thetat(1) = 0.  !  this defines the x direction, cell center 1 -&gt; 
-!            thetat(1) = theta_abs(iCell)  !  this defines the x direction, longitude line
-            do i=2,n-1
-               thetat(i) = thetat(i-1) + thetav(i-1)
-            end do
-   
-            do i=1,n-1
-               xp(i) = cos(thetat(i)) * dl_sphere(i)
-               yp(i) = sin(thetat(i)) * dl_sphere(i)
-            end do
-
-         else     ! On an x-y plane
-
-            xp(1) = grid % xCell % array(iCell)
-            yp(1) = grid % yCell % array(iCell)
-
-
-            do i=2,n
-               iv = grid % verticesOnCell % array(i-1,iCell)
-               xp(i) = grid % xVertex % array(iv)
-               yp(i) = grid % yVertex % array(iv)
-            end do
-
-         end if
-
-!         thetat(1) = 0.
-         thetat(1) = theta_abs(iCell)
-         do i=2,n-1
-            ip1 = i+1
-            if (ip1 == n) ip1 = 1
-            thetat(i) = plane_angle( 0.,0.,0.,  &amp;
-                                     xp(i)-xp(i-1), yp(i)-yp(i-1), 0.,  &amp;
-                                     xp(ip1)-xp(i), yp(ip1)-yp(i), 0.,  &amp;
-                                     0., 0., 1.)
-            thetat(i) = thetat(i) + thetat(i-1)
-         end do
-
-         area_cell = 0.
-         area_cellt = 0.
-         do i=1,n-1
-            ip1 = i+1
-            if (ip1 == n) ip1 = 1
-            dl = sqrt((xp(ip1)-xp(i))**2 + (yp(ip1)-yp(i))**2)
-            area_cell = area_cell + 0.25*(xp(i)+xp(ip1))*(yp(ip1)-yp(i)) - 0.25*(yp(i)+yp(ip1))*(xp(ip1)-xp(i))
-            area_cellt = area_cellt + (0.25*(xp(i)+xp(ip1))*cos(thetat(i)) + 0.25*(yp(i)+yp(ip1))*sin(thetat(i)))*dl
-         end do
-         if (debug) write(0,*) ' area_cell, area_cellt ',area_cell, area_cellt,area_cell-area_cellt
-
-         do i=1,n-1
-            ip1 = i+1
-            if (ip1 == n) ip1 = 1
-            dl = sqrt((xp(ip1)-xp(i))**2 + (yp(ip1)-yp(i))**2)
-            sint2 = (sin(thetat(i)))**2
-            cost2 = (cos(thetat(i)))**2
-            sint_cost = sin(thetat(i))*cos(thetat(i))
-            defc_a(i,iCell) = dl*(cost2 - sint2)/area_cell
-            defc_b(i,iCell) = dl*2.*sint_cost/area_cell
-            if (cellsOnEdge(1,EdgesOnCell(i,iCell)) /= iCell) then
-               defc_a(i,iCell) = - defc_a(i,iCell)
-               defc_b(i,iCell) = - defc_b(i,iCell)
-            end if

-         end do
-
-      end do
-
-      if (debug) write(0,*) ' exiting def weight calc '
-
-   end subroutine initialize_deformation_weights
-
-end module advection

Deleted: branches/source_condensing/src/core_sw/module_global_diagnostics.F
===================================================================
--- trunk/mpas/src/core_sw/module_global_diagnostics.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_sw/module_global_diagnostics.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,384 +0,0 @@
-module global_diagnostics
-
-   use grid_types
-   use configure
-   use constants
-   use dmpar
-
-   implicit none
-   save
-   public
-
-   contains
-
-   subroutine computeGlobalDiagnostics(dminfo, state, grid, timeIndex, dt)
-
-      ! Note: this routine assumes that there is only one block per processor. No looping
-      ! is preformed over blocks.
-      ! dminfo is the domain info needed for global communication
-      ! state contains the state variables needed to compute global diagnostics
-      ! grid conains the meta data about the grid
-      ! timeIndex is the current time step counter
-      ! dt is the duration of each time step
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !                            INSTRUCTIONS                               !
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ! To add a new Diagnostic as a Global Stat, follow these steps.
-      ! 1. Define the array to integrate, and the variable for the value above.
-      ! 2. Allocate the array with the correct dimensions.
-      ! 3. Fill the array with the data to be integrated.
-      !     eg. GlobalFluidThickness = Sum(h dA)/Sum(dA), See below for array filling
-      ! 4. Call Function to compute Global Stat that you want.
-      ! 5. Finish computing the global stat/integral
-      ! 6. Write out your global stat to the file
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      type (state_type), intent(inout) :: state
-      type (mesh_type), intent(in) :: grid
-      integer, intent(in) :: timeIndex
-      real (kind=RKIND), intent(in) :: dt
-
-      integer :: nVertLevels, nCellsSolve, nEdgesSolve, nVerticesSolve, nCellsGlobal, nEdgesGlobal, nVerticesGlobal, iTracer
-      integer :: nCells
-
-      ! Step 1
-      ! 1. Define the array to integrate, and the variable for the value to be stored in after the integration
-      real (kind=RKIND), dimension(:), pointer ::  areaCell, dcEdge, dvEdge, areaTriangle, h_s, fCell, fEdge
-      real (kind=RKIND), dimension(:,:), pointer :: h, u, v, h_edge, pv_edge, pv_vertex, pv_cell, h_vertex, weightsOnEdge
-
-      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
-
-      real (kind=RKIND), dimension(:), allocatable :: volumeWeightedPotentialEnergyReservoir, averageThickness
-      real (kind=RKIND), dimension(:), allocatable :: potentialEnstrophyReservior, areaEdge, h_s_edge
-
-      real (kind=RKIND), dimension(:,:), allocatable :: cellVolume, cellArea, volumeWeightedPotentialVorticity
-      real (kind=RKIND), dimension(:,:), allocatable :: volumeWeightedPotentialEnstrophy, vertexVolume, volumeWeightedKineticEnergy 
-      real (kind=RKIND), dimension(:,:), allocatable :: volumeWeightedPotentialEnergy, volumeWeightedPotentialEnergyTopography 
-      real (kind=RKIND), dimension(:,:), allocatable :: keTend_CoriolisForce, keTend_PressureGradient 
-      real (kind=RKIND), dimension(:,:), allocatable ::peTend_DivThickness, refAreaWeightedSurfaceHeight, refAreaWeightedSurfaceHeight_edge
-
-      real (kind=RKIND) :: sumCellVolume, sumCellArea, sumVertexVolume, sumrefAreaWeightedSurfaceHeight
-
-      real (kind=RKIND) :: globalFluidThickness, globalPotentialVorticity, globalPotentialEnstrophy, globalEnergy 
-      real (kind=RKIND) :: globalCoriolisEnergyTendency, globalKEPETendency, globalPotentialEnstrophyReservoir 
-      real (kind=RKIND) :: globalKineticEnergy, globalPotentialEnergy, globalPotentialEnergyReservoir
-      real (kind=RKIND) :: globalKineticEnergyTendency, globalPotentialEnergyTendency
-      real (kind=RKIND) ::  global_temp, workpv, q
-      real (kind=RKIND) :: volumeCellGlobal, volumeEdgeGlobal, CFLNumberGlobal
-
-      integer :: elementIndex, variableIndex, nVariables, nSums, nMaxes, nMins
-      integer :: timeLevel, eoe, iLevel, iCell, iEdge, iVertex
-      integer :: fileID, iCell1, iCell2, j
-
-      integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell, edgesOnEdge
-      integer, dimension(:), pointer :: nEdgesOnEdge
-      
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      edgesOnCell =&gt; grid % edgesOnCell % array
-
-      nVertLevels = grid % nVertLevels
-      nCellsSolve = grid % nCellsSolve
-      nEdgesSolve = grid % nEdgesSolve
-      nVerticesSolve = grid % nVerticesSolve
-      nCells = grid % nCells
-
-      h_s =&gt; grid % h_s % array
-      areaCell =&gt; grid % areaCell % array
-      dcEdge =&gt; grid % dcEdge % array
-      dvEdge =&gt; grid % dvEdge % array
-      areaTriangle =&gt; grid % areaTriangle % array
-      fCell =&gt; grid % fCell % array
-      fEdge =&gt; grid % fEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-
-      allocate(areaEdge(1:nEdgesSolve))
-      areaEdge = dcEdge(1:nEdgesSolve)*dvEdge(1:nEdgesSolve)
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-
-      h =&gt; state % h % array
-      u =&gt; state % u % array
-      v =&gt; state % v % array
-      tracers =&gt; state % tracers % array
-      h_edge =&gt; state % h_edge % array
-      h_vertex =&gt; state % h_vertex % array
-      pv_edge =&gt; state % pv_edge % array
-      pv_vertex =&gt; state % pv_vertex % array
-      pv_cell =&gt; state % pv_cell % array
-
-      ! Step 2
-      ! 2. Allocate the array with the correct dimensions.
-      allocate(cellVolume(nVertLevels,nCellsSolve))
-      allocate(cellArea(nVertLevels,nCellsSolve))
-      allocate(refAreaWeightedSurfaceHeight(nVertLevels,nCellsSolve))
-      allocate(refAreaWeightedSurfaceHeight_edge(nVertLevels,nEdgesSolve))
-      allocate(volumeWeightedPotentialVorticity(nVertLevels,nVerticesSolve))
-      allocate(volumeWeightedPotentialEnstrophy(nVertLevels,nVerticesSolve))
-      allocate(potentialEnstrophyReservior(nCellsSolve))
-      allocate(vertexVolume(nVertLevels,nVerticesSolve))
-      allocate(volumeWeightedKineticEnergy(nVertLevels,nEdgesSolve))
-      allocate(volumeWeightedPotentialEnergy(nVertLevels,nCellsSolve))
-      allocate(volumeWeightedPotentialEnergyTopography(nVertLevels,nCellsSolve))
-      allocate(volumeWeightedPotentialEnergyReservoir(nCellsSolve))
-      allocate(keTend_CoriolisForce(nVertLevels,nEdgesSolve))
-      allocate(keTend_PressureGradient(nVertLevels,nEdgesSolve))
-      allocate(peTend_DivThickness(nVertLevels,nCells))
-
-      allocate(averageThickness(nCellsSolve))
-
-      allocate(h_s_edge(nEdgesSOlve))
-
-
-      cellVolume = 0
-      refAreaWeightedSurfaceHeight = 0
-      refAreaWeightedSurfaceHeight_edge = 0
-      vertexVolume = 0
-      cellArea = 0
-      averageThickness = 0
-      volumeWeightedPotentialVorticity = 0
-      volumeWeightedPotentialEnstrophy = 0
-      volumeWeightedKineticEnergy = 0
-      volumeWeightedPotentialEnergy = 0
-      volumeWeightedPotentialEnergyTopography = 0
-      volumeWeightedPotentialEnergyReservoir = 0
-      keTend_PressureGradient = 0
-      peTend_DivThickness = 0
-      keTend_CoriolisForce = 0
-      h_s_edge = 0
-
-      ! Build Arrays for Global Integrals
-      ! Step 3
-      ! 3. Fill the array with the data to be integrated.
-      !     eg. GlobalFluidThickness = Sum(h dA)/Sum(dA), See below for array filling
-      do iLevel = 1,nVertLevels
-        ! eg. GlobalFluidThickness top (Sum( h dA)) = Sum(cellVolume)
-        cellVolume(iLevel,:) = h(iLevel,1:nCellsSolve)*areaCell(1:nCellsSolve)
-        ! eg. GlobalFluidThickness bot (Sum(dA)) = Sum(cellArea)
-        cellArea(iLevel,:) = areaCell(1:nCellsSolve)
-        volumeWeightedPotentialVorticity(iLevel,:) = pv_vertex(iLevel,1:nVerticesSolve) &amp;
-                *h_vertex(iLevel,1:nVerticesSolve)*areaTriangle(1:nVerticesSolve) 
-        volumeWeightedPotentialEnstrophy(iLevel,:) = pv_vertex(iLevel,1:nVerticesSolve) &amp; 
-                *pv_vertex(iLevel,1:nVerticesSolve)*h_vertex(iLevel,1:nVerticesSolve)*areaTriangle(1:nVerticesSolve)
-        vertexVolume(iLevel,:) = h_vertex(iLevel,1:nVerticesSolve)*areaTriangle(1:nVerticesSolve)
-        volumeWeightedKineticEnergy(iLevel,:) = u(iLevel,1:nEdgesSolve)*u(iLevel,1:nEdgesSolve) &amp;
-                *h_edge(iLevel,1:nEdgesSolve)*areaEdge(1:nEdgesSolve)*0.5
-        volumeWeightedPotentialEnergy(iLevel,:) = gravity*h(iLevel,1:nCellsSolve)*h(iLevel,1:nCellsSolve)*areaCell(1:nCellsSolve)*0.5
-        volumeWeightedPotentialEnergyTopography(iLevel,:) = gravity*h(iLevel,1:nCellsSolve)*h_s(1:nCellsSolve)*areaCell(1:nCellsSolve)
-        refAreaWeightedSurfaceHeight(iLevel,:) = areaCell(1:nCellsSolve)*(h(iLevel,1:nCellsSolve)+h_s(1:nCellsSolve))
-
-        do iEdge = 1,nEdgesSolve
-            q = 0.0
-            do j = 1,nEdgesOnEdge(iEdge)
-               eoe = edgesOnEdge(j,iEdge)
-               workpv = 0.5 * (pv_edge(iLevel,iEdge) + pv_edge(iLevel,eoe))
-               q = q + weightsOnEdge(j,iEdge) * u(iLevel,eoe) * workpv * h_edge(iLevel,eoe) 
-            end do
-            keTend_CoriolisForce(iLevel,iEdge) = h_edge(iLevel,iEdge) * u(iLevel,iEdge) * q * areaEdge(iEdge)
-
-            iCell1 = cellsOnEdge(1,iEdge)
-            iCell2 = cellsOnEdge(2,iEdge)
-
-            refAreaWeightedSurfaceHeight_edge(iLevel,iEdge) = areaEdge(iEdge)*(h_edge(iLevel,iEdge) + 0.5*(h_s(iCell1) + h_s(iCell2)))
-
-            keTend_PressureGradient(iLevel,iEdge) = areaEdge(iEdge)*h_edge(iLevel,iEdge)*u(iLevel,iEdge) &amp;
-                        *gravity*(h(iLevel,iCell2)+h_s(iCell2) - h(iLevel,iCell1)-h_s(iCell1))/dcEdge(iEdge)
-            peTend_DivThickness(iLevel,iCell1) = peTend_DivThickness(iLevel,iCell1) &amp;
-                        + h_edge(iLevel,iEdge)*u(iLevel,iEdge)*dvEdge(iEdge)
-            peTend_DivThickness(iLevel,iCell2) = peTend_DivThickness(iLevel,iCell2) &amp;
-                        - h_edge(iLevel,iEdge)*u(iLevel,iEdge)*dvEdge(iEdge)
-        end do
-
-        peTend_DivThickness(iLevel,:) = peTend_DivThickness(iLevel,1:nCells)*gravity &amp;
-                   *(h(iLevel,1:nCells)+h_s(1:nCells))
-      end do
-
-      do iEdge = 1,nEdgesSolve
-          iCell1 = cellsOnEdge(1,iEdge)
-          iCell2 = cellsOnEdge(2,iEdge)
-          
-          h_s_edge(iEdge) = 0.5*(h_s(iCell1) + h_s(iCell2))
-      end do
-
-      ! Step 4
-      ! 4. Call Function to compute Global Stat that you want.
-      ! Computing Kinetic and Potential Energy Tendency Terms
-      call computeGlobalSum(dminfo, nVertLevels, nEdgesSolve, keTend_PressureGradient, globalKineticEnergyTendency)
-      call computeGlobalSum(dminfo, nVertLevels, nCells, peTend_DivThickness, globalPotentialEnergyTendency)
-
-      ! Computing top and bottom of global mass integral
-      call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, cellVolume, sumCellVolume)
-      call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, cellArea, sumCellArea)
-
-      globalKineticEnergyTendency = globalKineticEnergyTendency / sumCellVolume
-      globalPotentialEnergyTendency = globalPotentialEnergyTendency / sumCellVolume
-
-      ! Step 5
-      ! 5. Finish computing the global stat/integral
-      globalFluidThickness = sumCellVolume/sumCellArea
-
-      ! Compute Average Sea Surface Height for Potential Energy and Enstrophy
-      ! Reservoir computations
-      call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, refAreaWeightedSurfaceHeight, sumrefAreaWeightedSurfaceHeight)
-
-      averageThickness(:) = (sumrefAreaWeightedSurfaceHeight/sumCellArea)-h_s(1:nCellsSolve)
-
-      ! Compute Volume Weighted Averages of Potential Vorticity and Potential Enstrophy
-      call computeGlobalSum(dminfo, nVertLevels, nVerticesSolve, volumeWeightedPotentialVorticity, globalPotentialVorticity)
-      call computeGlobalSum(dminfo, nVertLevels, nVerticesSolve, volumeWeightedPotentialEnstrophy, globalPotentialEnstrophy)
-      call computeGlobalSum(dminfo, nVertLevels, nVerticesSolve, vertexVolume, sumVertexVolume)
-
-      globalPotentialVorticity = globalPotentialVorticity/sumVertexVolume
-      globalPotentialEnstrophy = globalPotentialEnstrophy/sumVertexVolume
-
-      ! Compte Potential Enstrophy Reservior
-      potentialEnstrophyReservior(:) = areaCell(:)*fCell(:)*fCell(:)/averageThickness
-      call computeGlobalSum(dminfo, 1, nCellsSolve, potentialEnstrophyReservior, globalPotentialEnstrophyReservoir)
-      globalPotentialEnstrophyReservoir = globalPotentialEnstrophyReservoir/sumCellVolume
-
-      globalPotentialEnstrophy = globalPotentialEnstrophy - globalPotentialEnstrophyReservoir
-
-      ! Compute Kinetic and Potential Energy terms to be combined into total energy
-      call computeGlobalSum(dminfo, nVertLevels, nEdgesSolve, volumeWeightedKineticEnergy, globalKineticEnergy)
-      call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, volumeWeightedPotentialEnergy, globalPotentialEnergy)
-      call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, volumeWeightedPotentialEnergyTopography, global_temp)
-
-      globalKineticEnergy = globalKineticEnergy/sumCellVolume
-      globalPotentialEnergy = (globalPotentialEnergy + global_temp)/sumCellVolume
-
-      ! Compute Potential energy reservoir to be subtracted from potential energy term
-      volumeWeightedPotentialEnergyReservoir(1:nCellsSolve) = areaCell(1:nCellsSolve)*averageThickness*averageThickness*gravity*0.5
-      call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, volumeWeightedPotentialEnergyReservoir, globalPotentialEnergyReservoir)
-      volumeWeightedPotentialEnergyReservoir(1:nCellsSolve) = areaCell(1:nCellsSolve)*averageThickness*h_s(1:nCellsSolve)*gravity
-      call computeGlobalSum(dminfo, nVertLevels, nCellsSolve, volumeWeightedPotentialEnergyReservoir, global_temp)
-
-      globalPotentialEnergyReservoir = (globalPotentialEnergyReservoir + global_temp)/sumCellVolume
-
-      globalPotentialEnergy = globalPotentialEnergy - globalPotentialEnergyReservoir
-      globalEnergy = globalKineticEnergy + globalPotentialEnergy
-
-      ! Compute Coriolis energy tendency term
-      call computeGlobalSum(dminfo, nVertLevels, nEdgesSolve, keTend_CoriolisForce, globalCoriolisEnergyTendency)
-      globalCoriolisEnergyTendency = globalCoriolisEnergyTendency/sumCellVolume
-
-      ! Step 6
-      ! 6. Write out your global stat to the file
-      if (dminfo % my_proc_id == IO_NODE) then
-         fileID = getFreeUnit()
-
-         if (timeIndex/config_stats_interval == 1) then
-             open(fileID, file='GlobalIntegrals.txt',STATUS='unknown')
-         else
-             open(fileID, file='GlobalIntegrals.txt',POSITION='append')
-         endif 
-         write(fileID,'(1i0, 100es24.16)') timeIndex, timeIndex*dt, globalFluidThickness, globalPotentialVorticity, globalPotentialEnstrophy, &amp;
-                        globalEnergy, globalCoriolisEnergyTendency, globalKineticEnergyTendency+globalPotentialEnergyTendency, &amp;
-                        globalKineticEnergy, globalPotentialEnergy
-         close(fileID)
-      end if
-
-      deallocate(areaEdge)
-   end subroutine computeGlobalDiagnostics
-
-   integer function getFreeUnit()
-      implicit none
-
-      integer :: index
-      logical :: isOpened
-
-      getFreeUnit = 0
-      do index = 1,99
-         if((index /= 5) .and. (index /= 6)) then
-            inquire(unit = index, opened = isOpened)
-            if( .not. isOpened) then
-               getFreeUnit = index
-               return
-            end if
-         end if
-      end do
-   end function getFreeUnit
-
-   subroutine computeGlobalSum(dminfo, nVertLevels, nElements, field, globalSum)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: globalSum
-
-      real (kind=RKIND) :: localSum
-
-      localSum = sum(field)
-      call dmpar_sum_real(dminfo, localSum, globalSum)
-
-   end subroutine computeGlobalSum
-
-   subroutine computeGlobalMin(dminfo, nVertLevels, nElements, field, globalMin)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: globalMin
-
-      real (kind=RKIND) :: localMin
-
-      localMin = minval(field)
-      call dmpar_min_real(dminfo, localMin, globalMin)
-
-   end subroutine computeGlobalMin
-
-   subroutine computeGlobalMax(dminfo, nVertLevels, nElements, field, globalMax)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: globalMax
-
-      real (kind=RKIND) :: localMax
-
-      localMax = maxval(field)
-      call dmpar_max_real(dminfo, localMax, globalMax)
-
-   end subroutine computeGlobalMax
-
-   subroutine computeGlobalVertSumHorizMin(dminfo, nVertLevels, nElements, field, globalMin)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: globalMin
-
-      real (kind=RKIND) :: localMin
-
-      localMin = minval(sum(field,1))
-      call dmpar_min_real(dminfo, localMin, globalMin)
-
-   end subroutine computeGlobalVertSumHorizMin
-
-   subroutine computeGlobalVertSumHorizMax(dminfo, nVertLevels, nElements, field, globalMax)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nVertLevels, nElements
-      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
-      real (kind=RKIND), intent(out) :: globalMax
-
-      real (kind=RKIND) :: localMax
-
-      localMax = maxval(sum(field,1))
-      call dmpar_max_real(dminfo, localMax, globalMax)
-
-   end subroutine computeGlobalVertSumHorizMax
-
-end module global_diagnostics

Deleted: branches/source_condensing/src/core_sw/module_mpas_core.F
===================================================================
--- trunk/mpas/src/core_sw/module_mpas_core.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_sw/module_mpas_core.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,382 +0,0 @@
-module mpas_core
-
-   use mpas_framework
-   use mpas_timekeeping
-
-   type (io_output_object) :: restart_obj
-   integer :: restart_frame
-   integer :: current_outfile_frames
-
-   type (MPAS_Clock_type) :: clock
-
-   integer, parameter :: outputAlarmID = 1
-   integer, parameter :: restartAlarmID = 2
-   !integer, parameter :: statsAlarmID = 3
-
-   contains
-
-   subroutine mpas_core_init(domain, startTimeStamp)
-   
-      use configure
-      use grid_types
-      use test_cases
-   
-      implicit none
-   
-      type (domain_type), intent(inout) :: domain
-      character(len=*), intent(out) :: startTimeStamp
-   
-      real (kind=RKIND) :: dt
-      type (block_type), pointer :: block
-
-
-      if (.not. config_do_restart) call setup_sw_test_case(domain)
-
-      !
-      ! Initialize core
-      !
-      dt = config_dt
-
-      call simulation_clock_init(domain, dt, startTimeStamp)
-
-      block =&gt; domain % blocklist
-      do while (associated(block))
-         call mpas_init_block(block, block % mesh, dt)
-         block % state % time_levs(1) % state % xtime % scalar = startTimeStamp
-         block =&gt; block % next
-      end do
-
-      restart_frame = 1
-      current_outfile_frames = 0
-
-   end subroutine mpas_core_init
-
-
-   subroutine simulation_clock_init(domain, dt, startTimeStamp)
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      real (kind=RKIND), intent(in) :: dt
-      character(len=*), intent(out) :: startTimeStamp
-
-      type (MPAS_Time_Type) :: startTime, stopTime, alarmStartTime
-      type (MPAS_TimeInterval_type) :: runDuration, timeStep, alarmTimeStep
-      integer :: ierr
-
-      call MPAS_setTime(curr_time=startTime, dateTimeString=config_start_time, ierr=ierr)
-      call MPAS_setTimeInterval(timeStep, dt=dt, ierr=ierr)
-
-      if (trim(config_run_duration) /= &quot;none&quot;) then
-         call MPAS_setTimeInterval(runDuration, timeString=config_run_duration, ierr=ierr)
-         call MPAS_createClock(clock, startTime=startTime, timeStep=timeStep, runDuration=runDuration, ierr=ierr)
-
-         if (trim(config_stop_time) /= &quot;none&quot;) then
-            call MPAS_setTime(curr_time=stopTime, dateTimeString=config_stop_time, ierr=ierr)
-            if(startTime + runduration /= stopTime) then
-               write(0,*) 'Warning: config_run_duration and config_stop_time are inconsitent: using config_run_duration.'
-            end if
-         end if
-      else if (trim(config_stop_time) /= &quot;none&quot;) then
-         call MPAS_setTime(curr_time=stopTime, dateTimeString=config_stop_time, ierr=ierr)
-         call MPAS_createClock(clock, startTime=startTime, timeStep=timeStep, stopTime=stopTime, ierr=ierr)
-      else
-          write(0,*) 'Error: Neither config_run_duration nor config_stop_time were specified.'
-          call dmpar_abort(domain % dminfo)
-      end if
-
-      ! set output alarm
-      call MPAS_setTimeInterval(alarmTimeStep, timeString=config_output_interval, ierr=ierr)
-      alarmStartTime = startTime + alarmTimeStep
-      call MPAS_addClockAlarm(clock, outputAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
-
-      ! set restart alarm, if necessary
-      if (trim(config_restart_interval) /= &quot;none&quot;) then
-         call MPAS_setTimeInterval(alarmTimeStep, timeString=config_restart_interval, ierr=ierr)
-         alarmStartTime = startTime + alarmTimeStep
-         call MPAS_addClockAlarm(clock, restartAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
-      end if
-
-      !TODO: use this code if we desire to convert config_stats_interval to alarms 
-      !(must also change config_stats_interval type to character) 
-      ! set stats alarm, if necessary
-      !if (trim(config_stats_interval) /= &quot;none&quot;) then      
-      !   call MPAS_setTimeInterval(alarmTimeStep, timeString=config_stats_interval, ierr=ierr)
-      !   alarmStartTime = startTime + alarmTimeStep
-      !   call MPAS_addClockAlarm(clock, statsAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
-      !end if
-
-      call MPAS_getTime(curr_time=startTime, dateTimeString=startTimeStamp, ierr=ierr)
-
-   end subroutine simulation_clock_init
-
-
-   subroutine mpas_init_block(block, mesh, dt)
-   
-      use grid_types
-      use time_integration
-      use RBF_interpolation
-      use vector_reconstruction
-   
-      implicit none
-   
-      type (block_type), intent(inout) :: block
-      type (mesh_type), intent(inout) :: mesh
-      real (kind=RKIND), intent(in) :: dt
-   
-
-      call compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
-      call compute_mesh_scaling(mesh) 
-
-      call rbfInterp_initialize(mesh)
-      call init_reconstruct(mesh)
-      call reconstruct(mesh, block % state % time_levs(1) % state % u % array,                  &amp;
-                       block % state % time_levs(1) % state % uReconstructX % array,            &amp;
-                       block % state % time_levs(1) % state % uReconstructY % array,            &amp;
-                       block % state % time_levs(1) % state % uReconstructZ % array,            &amp;
-                       block % state % time_levs(1) % state % uReconstructZonal % array,        &amp;
-                       block % state % time_levs(1) % state % uReconstructMeridional % array    &amp;
-                      )
-
-   
-   end subroutine mpas_init_block
-   
-   
-   subroutine mpas_core_run(domain, output_obj, output_frame)
-   
-      use grid_types
-      use io_output
-      use timer
-   
-      implicit none
-   
-      type (domain_type), intent(inout) :: domain
-      type (io_output_object), intent(inout) :: output_obj
-      integer, intent(inout) :: output_frame
-
-      integer :: itimestep
-      real (kind=RKIND) :: dt
-      type (block_type), pointer :: block_ptr
-
-      type (MPAS_Time_Type) :: currTime
-      character(len=32) :: timeStamp
-      integer :: ierr
-   
-      ! Eventually, dt should be domain specific
-      dt = config_dt
-
-      currTime = MPAS_getClockTime(clock, MPAS_NOW, ierr)
-      call MPAS_getTime(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)         
-      write(0,*) 'Initial timestep ', timeStamp
-
-      call write_output_frame(output_obj, output_frame, domain)
-
-      ! During integration, time level 1 stores the model state at the beginning of the
-      !   time step, and time level 2 stores the state advanced dt in time by timestep(...)
-      itimestep = 0
-      do while (.not. MPAS_isClockStopTime(clock))
-
-         itimestep = itimestep + 1
-         call MPAS_advanceClock(clock)
-
-         currTime = MPAS_getClockTime(clock, MPAS_NOW, ierr)
-         call MPAS_getTime(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)         
-         write(0,*) 'Doing timestep ', timeStamp
-
-         call timer_start(&quot;time integration&quot;)
-         call mpas_timestep(domain, itimestep, dt, timeStamp)
-         call timer_stop(&quot;time integration&quot;)
-
-         ! Move time level 2 fields back into time level 1 for next time step
-         call shift_time_levels_state(domain % blocklist % state)
-
-         !TODO: MPAS_getClockRingingAlarms is probably faster than multiple MPAS_isAlarmRinging...
-
-         if (MPAS_isAlarmRinging(clock, outputAlarmID, ierr=ierr)) then
-            call MPAS_resetClockAlarm(clock, outputAlarmID, ierr=ierr)
-            if(output_frame == 1) call output_state_init(output_obj, domain, &quot;OUTPUT&quot;, trim(timeStamp)) ! output_frame will always be &gt; 1 here unless it is reset after the output file is finalized
-            call write_output_frame(output_obj, output_frame, domain)
-         end if
-
-         if (MPAS_isAlarmRinging(clock, restartAlarmID, ierr=ierr)) then
-            call MPAS_resetClockAlarm(clock, restartAlarmID, ierr=ierr)
-            if (restart_frame == 1) call output_state_init(restart_obj, domain, &quot;RESTART&quot;)
-            call output_state_for_domain(restart_obj, domain, restart_frame)
-            restart_frame = restart_frame + 1
-         end if
-
-      end do
-
-   end subroutine mpas_core_run
-   
-   
-   subroutine write_output_frame(output_obj, output_frame, domain)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute diagnostic fields for a domain and write model state to output file
-   !
-   ! Input/Output: domain - contains model state; diagnostic field are computed
-   !                        before returning
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   
-      use grid_types
-      use io_output
-   
-      implicit none
-
-      type (io_output_object), intent(inout) :: output_obj
-      integer, intent(inout) :: output_frame
-      type (domain_type), intent(inout) :: domain
-   
-      integer :: i, j, k
-      integer :: eoe
-      type (block_type), pointer :: block_ptr
-   
-      block_ptr =&gt; domain % blocklist
-      do while (associated(block_ptr))
-         call compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
-         block_ptr =&gt; block_ptr % next
-      end do
-   
-      call output_state_for_domain(output_obj, domain, output_frame)
-      output_frame = output_frame + 1
-
-      ! if the maximum number of frames per outfile has been reached, finalize outfile and reset frame   
-      if (config_frames_per_outfile &gt; 0) then
-         current_outfile_frames = current_outfile_frames + 1            
-         if(current_outfile_frames &gt;= config_frames_per_outfile) then
-            current_outfile_frames = 0
-            call output_state_finalize(output_obj, domain % dminfo)
-            output_frame = 1
-         end if
-      end if
-
-   end subroutine write_output_frame
-   
-   
-   subroutine compute_output_diagnostics(state, grid)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute diagnostic fields for a domain
-   !
-   ! Input: state - contains model prognostic fields
-   !        grid  - contains grid metadata
-   !
-   ! Output: state - upon returning, diagnostic fields will have be computed
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   
-      use grid_types
-   
-      implicit none
-   
-      type (state_type), intent(inout) :: state
-      type (mesh_type), intent(in) :: grid
-   
-      integer :: i, eoe
-      integer :: iEdge, k
-   
-   end subroutine compute_output_diagnostics
-   
-   
-   subroutine mpas_timestep(domain, itimestep, dt, timeStamp)
-   
-      use grid_types
-      use time_integration
-      use timer
-      use global_diagnostics
-   
-      implicit none
-   
-      type (domain_type), intent(inout) :: domain 
-      integer, intent(in) :: itimestep
-      real (kind=RKIND), intent(in) :: dt
-      character(len=*), intent(in) :: timeStamp
-      
-      type (block_type), pointer :: block_ptr
-      integer :: ierr
-   
-      call timestep(domain, dt, timeStamp)
-   
-      if(config_stats_interval .gt. 0) then
-          if(mod(itimestep, config_stats_interval) == 0) then
-              block_ptr =&gt; domain % blocklist
-              if(associated(block_ptr % next)) then
-                  write(0,*) 'Error: computeGlobalDiagnostics assumes ',&amp;
-                             'that there is only one block per processor.'
-              end if
-   
-              call timer_start(&quot;global_diagnostics&quot;)
-              call computeGlobalDiagnostics(domain % dminfo, &amp;
-                       block_ptr % state % time_levs(2) % state, block_ptr % mesh, &amp;
-                       itimestep, dt)
-              call timer_stop(&quot;global_diagnostics&quot;)
-          end if
-      end if
-
-      !TODO: replace the above code block with this if we desire to convert config_stats_interval to use alarms
-      !if (MPAS_isAlarmRinging(clock, statsAlarmID, ierr=ierr)) then
-      !   call MPAS_resetClockAlarm(clock, statsAlarmID, ierr=ierr)
-
-      !   block_ptr =&gt; domain % blocklist
-      !   if(associated(block_ptr % next)) then
-      !      write(0,*) 'Error: computeGlobalDiagnostics assumes ',&amp;
-      !                 'that there is only one block per processor.'
-      !   end if
-
-      !   call timer_start(&quot;global_diagnostics&quot;)
-      !   call computeGlobalDiagnostics(domain % dminfo, &amp;
-      !            block_ptr % state % time_levs(2) % state, block_ptr % mesh, &amp;
-      !            timeStamp, dt)
-      !   call timer_stop(&quot;global_diagnostics&quot;)
-      !end if
-   
-   end subroutine mpas_timestep
-   
-   
-   subroutine mpas_core_finalize(domain)
-   
-      use grid_types
-   
-      implicit none
-
-      integer :: ierr
-
-      type (domain_type), intent(inout) :: domain 
-
-      if (restart_frame &gt; 1) call output_state_finalize(restart_obj, domain % dminfo)
-
-      call MPAS_destroyClock(clock, ierr)
-
-   end subroutine mpas_core_finalize
-
-
-   subroutine compute_mesh_scaling(mesh)
-
-      use grid_types
-
-      implicit none
-
-      type (mesh_type), intent(inout) :: mesh
-
-      integer :: iEdge, cell1, cell2
-      real (kind=RKIND), dimension(:), pointer :: meshDensity, meshScalingDel2, meshScalingDel4
-
-      meshDensity =&gt; mesh % meshDensity % array
-      meshScalingDel2 =&gt; mesh % meshScalingDel2 % array
-      meshScalingDel4 =&gt; mesh % meshScalingDel4 % array
-
-      !
-      ! Compute the scaling factors to be used in the del2 and del4 dissipation
-      !
-      meshScalingDel2(:) = 1.0
-      meshScalingDel4(:) = 1.0
-      if (config_h_ScaleWithMesh) then
-         do iEdge=1,mesh%nEdges
-            cell1 = mesh % cellsOnEdge % array(1,iEdge)
-            cell2 = mesh % cellsOnEdge % array(2,iEdge)
-            meshScalingDel2(iEdge) = 1.0 / ( (meshDensity(cell1) + meshDensity(cell2) )/2.0)**(5.0/12.0)
-            meshScalingDel4(iEdge) = 1.0 / ( (meshDensity(cell1) + meshDensity(cell2) )/2.0)**(5.0/6.0)
-         end do
-      end if
-
-   end subroutine compute_mesh_scaling
-
-end module mpas_core

Deleted: branches/source_condensing/src/core_sw/module_test_cases.F
===================================================================
--- trunk/mpas/src/core_sw/module_test_cases.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_sw/module_test_cases.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,527 +0,0 @@
-module test_cases
-
-   use grid_types
-   use configure
-   use constants
-
-
-   contains
-
-
-   subroutine setup_sw_test_case(domain)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Configure grid metadata and model state for the shallow water test case 
-   !   specified in the namelist
-   !
-   ! Output: block - a subset (not necessarily proper) of the model domain to be
-   !                 initialized
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-
-      integer :: i
-      type (block_type), pointer :: block_ptr
-
-      if (config_test_case == 0) then
-         write(0,*) 'Using initial conditions supplied in input file'
-
-      else if (config_test_case == 1) then
-         write(0,*) 'Setting up shallow water test case 1'
-         write(0,*) ' -- Advection of Cosine Bell over the Pole'
-
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            call sw_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
-            do i=2,nTimeLevs
-               call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
-            end do
-
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else if (config_test_case == 2) then
-         write(0,*) 'Setting up shallow water test case 2'
-         write(0,*) ' -- Setup shallow water test case 2: Global Steady State Nonlinear Zonal Geostrophic Flow'
-
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            call sw_test_case_2(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
-            do i=2,nTimeLevs
-               call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
-            end do
-
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else if (config_test_case == 5) then
-         write(0,*) 'Setting up shallow water test case 5'
-         write(0,*) ' -- Setup shallow water test case 5: Zonal Flow over an Isolated Mountain'
-
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            call sw_test_case_5(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
-            do i=2,nTimeLevs
-               call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
-            end do
-
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else if (config_test_case == 6) then
-         write(0,*) 'Setting up shallow water test case 6'
-         write(0,*) ' -- Rossby-Haurwitz Wave'
-
-         block_ptr =&gt; domain % blocklist
-         do while (associated(block_ptr))
-            call sw_test_case_6(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
-            do i=2,nTimeLevs
-               call copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
-            end do
-
-            block_ptr =&gt; block_ptr % next
-         end do
-
-      else
-         write(0,*) 'Only test case 1, 2, 5, and 6 are currently supported.'
-         stop
-      end if
-
-   end subroutine setup_sw_test_case
-
-
-   subroutine sw_test_case_1(grid, state)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup shallow water test case 1: Advection of Cosine Bell over the Pole
-   !
-   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
-   !            Approximations to the Shallow Water Equations in Spherical 
-   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (mesh_type), intent(inout) :: grid
-      type (state_type), intent(inout) :: state
-
-      real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
-      real (kind=RKIND), parameter :: h0 = 1000.0
-      real (kind=RKIND), parameter :: theta_c = 0.0
-      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
-      real (kind=RKIND), parameter :: alpha = pii/4.0
-
-      integer :: iCell, iEdge, iVtx
-      real (kind=RKIND) :: r, u, v
-      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
-
-      !
-      ! Scale all distances and areas from a unit sphere to one with radius a
-      !
-      grid % xCell % array = grid % xCell % array * a
-      grid % yCell % array = grid % yCell % array * a
-      grid % zCell % array = grid % zCell % array * a
-      grid % xVertex % array = grid % xVertex % array * a
-      grid % yVertex % array = grid % yVertex % array * a
-      grid % zVertex % array = grid % zVertex % array * a
-      grid % xEdge % array = grid % xEdge % array * a
-      grid % yEdge % array = grid % yEdge % array * a
-      grid % zEdge % array = grid % zEdge % array * a
-      grid % dvEdge % array = grid % dvEdge % array * a
-      grid % dcEdge % array = grid % dcEdge % array * a
-      grid % areaCell % array = grid % areaCell % array * a**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
-      !
-      ! Initialize wind field
-      !
-      allocate(psiVertex(grid % nVertices))
-      do iVtx=1,grid % nVertices
-         psiVertex(iVtx) = -a * u0 * ( &amp;
-                                       sin(grid%latVertex%array(iVtx)) * cos(alpha) - &amp;
-                                       cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &amp;
-                                     )
-      end do
-      do iEdge=1,grid % nEdges
-         state % u % array(1,iEdge) = -1.0 * ( &amp;
-                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
-                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
-                                             ) / grid%dvEdge%array(iEdge)
-      end do
-      deallocate(psiVertex)
-
-      !
-      ! Initialize cosine bell at (theta_c, lambda_c)
-      !
-      do iCell=1,grid % nCells
-         r = sphere_distance(theta_c, lambda_c, grid % latCell % array(iCell), grid % lonCell % array(iCell), a) 
-         if (r &lt; a/3.0) then
-            state % h % array(1,iCell) = (h0 / 2.0) * (1.0 + cos(pii*r*3.0/a))
-         else
-            state % h % array(1,iCell) = 0.0
-         end if
-      end do
-
-   end subroutine sw_test_case_1
-
-
-   subroutine sw_test_case_2(grid, state)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup shallow water test case 2: Global Steady State Nonlinear Zonal 
-   !                                  Geostrophic Flow
-   !
-   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
-   !            Approximations to the Shallow Water Equations in Spherical 
-   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (mesh_type), intent(inout) :: grid
-      type (state_type), intent(inout) :: state
-
-      real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
-      real (kind=RKIND), parameter :: gh0 = 29400.0
-      real (kind=RKIND), parameter :: alpha = 0.0
-
-      integer :: iCell, iEdge, iVtx
-      real (kind=RKIND) :: u, v
-      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
-
-
-      !
-      ! Scale all distances and areas from a unit sphere to one with radius a
-      !
-      grid % xCell % array = grid % xCell % array * a
-      grid % yCell % array = grid % yCell % array * a
-      grid % zCell % array = grid % zCell % array * a
-      grid % xVertex % array = grid % xVertex % array * a
-      grid % yVertex % array = grid % yVertex % array * a
-      grid % zVertex % array = grid % zVertex % array * a
-      grid % xEdge % array = grid % xEdge % array * a
-      grid % yEdge % array = grid % yEdge % array * a
-      grid % zEdge % array = grid % zEdge % array * a
-      grid % dvEdge % array = grid % dvEdge % array * a
-      grid % dcEdge % array = grid % dcEdge % array * a
-      grid % areaCell % array = grid % areaCell % array * a**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-      
-
-      !
-      ! Initialize wind field
-      !
-      allocate(psiVertex(grid % nVertices))
-      do iVtx=1,grid % nVertices
-         psiVertex(iVtx) = -a * u0 * ( &amp;
-                                       sin(grid%latVertex%array(iVtx)) * cos(alpha) - &amp;
-                                       cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &amp;
-                                     )
-      end do
-      do iEdge=1,grid % nEdges
-         state % u % array(1,iEdge) = -1.0 * ( &amp;
-                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
-                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
-                                             ) / grid%dvEdge%array(iEdge)
-      end do
-      deallocate(psiVertex)
-
-      !
-      ! Generate rotated Coriolis field
-      !
-      do iEdge=1,grid % nEdges
-         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
-                                       ( -cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &amp;
-                                         sin(grid%latEdge%array(iEdge)) * cos(alpha) &amp;
-                                       )
-      end do
-      do iVtx=1,grid % nVertices
-         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
-                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &amp;
-                                          sin(grid%latVertex%array(iVtx)) * cos(alpha) &amp;
-                                         )
-      end do
-
-      !
-      ! Initialize height field (actually, fluid thickness field)
-      !
-      do iCell=1,grid % nCells
-         state % h % array(1,iCell) = (gh0 - (a * omega * u0 + 0.5 * u0**2.0) * &amp;
-                                             (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &amp;
-                                              sin(grid%latCell%array(iCell)) * cos(alpha) &amp;
-                                             )**2.0 &amp;
-                                      ) / &amp;
-                                      gravity
-      end do
-
-   end subroutine sw_test_case_2
-
-
-   subroutine sw_test_case_5(grid, state)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup shallow water test case 5: Zonal Flow over an Isolated Mountain
-   !
-   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
-   !            Approximations to the Shallow Water Equations in Spherical 
-   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (mesh_type), intent(inout) :: grid
-      type (state_type), intent(inout) :: state
-
-      real (kind=RKIND), parameter :: u0 = 20.
-      real (kind=RKIND), parameter :: gh0 = 5960.0*gravity
-      real (kind=RKIND), parameter :: hs0 = 2000.
-      real (kind=RKIND), parameter :: theta_c = pii/6.0
-      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
-      real (kind=RKIND), parameter :: rr = pii/9.0
-      real (kind=RKIND), parameter :: alpha = 0.0
-
-      integer :: iCell, iEdge, iVtx
-      real (kind=RKIND) :: r, u, v
-      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
-
-
-      !
-      ! Scale all distances and areas from a unit sphere to one with radius a
-      !
-      grid % xCell % array = grid % xCell % array * a
-      grid % yCell % array = grid % yCell % array * a
-      grid % zCell % array = grid % zCell % array * a
-      grid % xVertex % array = grid % xVertex % array * a
-      grid % yVertex % array = grid % yVertex % array * a
-      grid % zVertex % array = grid % zVertex % array * a
-      grid % xEdge % array = grid % xEdge % array * a
-      grid % yEdge % array = grid % yEdge % array * a
-      grid % zEdge % array = grid % zEdge % array * a
-      grid % dvEdge % array = grid % dvEdge % array * a
-      grid % dcEdge % array = grid % dcEdge % array * a
-      grid % areaCell % array = grid % areaCell % array * a**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
-      !
-      ! Initialize wind field
-      !
-      allocate(psiVertex(grid % nVertices))
-      do iVtx=1,grid % nVertices
-         psiVertex(iVtx) = -a * u0 * ( &amp;
-                                       sin(grid%latVertex%array(iVtx)) * cos(alpha) - &amp;
-                                       cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &amp;
-                                     )
-      end do
-      do iEdge=1,grid % nEdges
-         state % u % array(1,iEdge) = -1.0 * ( &amp;
-                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
-                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
-                                             ) / grid%dvEdge%array(iEdge)
-      end do
-      deallocate(psiVertex)
-
-      !
-      ! Generate rotated Coriolis field
-      !
-      do iEdge=1,grid % nEdges
-         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
-                                        (-cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &amp;
-                                         sin(grid%latEdge%array(iEdge)) * cos(alpha) &amp;
-                                        )
-      end do
-      do iVtx=1,grid % nVertices
-         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
-                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &amp;
-                                          sin(grid%latVertex%array(iVtx)) * cos(alpha) &amp;
-                                         )
-      end do
-
-      !
-      ! Initialize mountain
-      !
-      do iCell=1,grid % nCells
-         if (grid % lonCell % array(iCell) &lt; 0.0) grid % lonCell % array(iCell) = grid % lonCell % array(iCell) + 2.0 * pii
-         r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + (grid % latCell % array(iCell) - theta_c)**2.0))
-         grid % h_s % array(iCell) = hs0 * (1.0 - r/rr)
-      end do
-
-      !
-      ! Initialize tracer fields
-      !
-      do iCell=1,grid % nCells
-         r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + (grid % latCell % array(iCell) - theta_c)**2.0))
-         state % tracers % array(1,1,iCell) = 1.0 - r/rr
-      end do
-      if (grid%nTracers &gt; 1) then
-         do iCell=1,grid % nCells
-            r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + &amp;
-                         (grid % latCell % array(iCell) - theta_c - pii/6.0)**2.0 &amp;
-                        ) &amp;
-                    )
-            state % tracers % array(2,1,iCell) = 1.0 - r/rr
-         end do
-      end if
-
-      !
-      ! Initialize height field (actually, fluid thickness field)
-      !
-      do iCell=1,grid % nCells
-         state % h % array(1,iCell) = (gh0 - (a * omega * u0 + 0.5 * u0**2.0) * &amp;
-                                         (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &amp;
-                                          sin(grid%latCell%array(iCell)) * cos(alpha) &amp;
-                                         )**2.0 &amp;
-                                      ) / &amp;
-                                      gravity
-         state % h % array(1,iCell) = state % h % array(1,iCell) - grid % h_s % array(iCell)
-      end do
-
-   end subroutine sw_test_case_5
-
-
-   subroutine sw_test_case_6(grid, state)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Setup shallow water test case 6: Rossby-Haurwitz Wave
-   !
-   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
-   !            Approximations to the Shallow Water Equations in Spherical 
-   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      type (mesh_type), intent(inout) :: grid
-      type (state_type), intent(inout) :: state
-
-      real (kind=RKIND), parameter :: h0 = 8000.0
-      real (kind=RKIND), parameter :: w = 7.848e-6
-      real (kind=RKIND), parameter :: K = 7.848e-6
-      real (kind=RKIND), parameter :: R = 4.0
-
-      integer :: iCell, iEdge, iVtx
-      real (kind=RKIND) :: u, v
-      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
-
-
-      !
-      ! Scale all distances and areas from a unit sphere to one with radius a
-      !
-      grid % xCell % array = grid % xCell % array * a
-      grid % yCell % array = grid % yCell % array * a
-      grid % zCell % array = grid % zCell % array * a
-      grid % xVertex % array = grid % xVertex % array * a
-      grid % yVertex % array = grid % yVertex % array * a
-      grid % zVertex % array = grid % zVertex % array * a
-      grid % xEdge % array = grid % xEdge % array * a
-      grid % yEdge % array = grid % yEdge % array * a
-      grid % zEdge % array = grid % zEdge % array * a
-      grid % dvEdge % array = grid % dvEdge % array * a
-      grid % dcEdge % array = grid % dcEdge % array * a
-      grid % areaCell % array = grid % areaCell % array * a**2.0
-      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
-      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
-
-      !
-      ! Initialize wind field
-      !
-      allocate(psiVertex(grid % nVertices))
-      do iVtx=1,grid % nVertices
-         psiVertex(iVtx) = -a * a * w * sin(grid%latVertex%array(iVtx)) + &amp;
-                            a *a * K * (cos(grid%latVertex%array(iVtx))**R) * &amp;
-                            sin(grid%latVertex%array(iVtx)) * cos(R * grid%lonVertex%array(iVtx))
-      end do
-      do iEdge=1,grid % nEdges
-         state % u % array(1,iEdge) = -1.0 * ( &amp;
-                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
-                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
-                                             ) / grid%dvEdge%array(iEdge)
-      end do
-      deallocate(psiVertex)
-
-      !
-      ! Initialize height field (actually, fluid thickness field)
-      !
-      do iCell=1,grid % nCells
-         state % h % array(1,iCell) = (gravity * h0 + a*a*AA(grid%latCell%array(iCell)) + &amp;
-                                                      a*a*BB(grid%latCell%array(iCell)) * cos(R*grid%lonCell%array(iCell)) + &amp;
-                                                      a*a*CC(grid%latCell%array(iCell)) * cos(2.0*R*grid%lonCell%array(iCell)) &amp;
-                                      ) / gravity
-      end do
-
-   end subroutine sw_test_case_6
-
-
-   real function sphere_distance(lat1, lon1, lat2, lon2, radius)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
-   !   sphere with given radius.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), intent(in) :: lat1, lon1, lat2, lon2, radius
-
-      real (kind=RKIND) :: arg1
-
-      arg1 = sqrt( sin(0.5*(lat2-lat1))**2 +  &amp;
-                   cos(lat1)*cos(lat2)*sin(0.5*(lon2-lon1))**2 )
-      sphere_distance = 2.*radius*asin(arg1)
-
-   end function sphere_distance
-
-
-   real function AA(theta)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! A, used in height field computation for Rossby-Haurwitz wave
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), parameter :: w = 7.848e-6
-      real (kind=RKIND), parameter :: K = 7.848e-6
-      real (kind=RKIND), parameter :: R = 4.0
-
-      real (kind=RKIND), intent(in) :: theta
-
-      AA = 0.5 * w * (2.0 * omega + w) * cos(theta)**2.0 + &amp;
-          0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 + 2.0*R**2.0 - R - 2.0 - 2.0*R**2.0 * cos(theta)**(-2.0))
-
-   end function AA
-
-   
-   real function BB(theta)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! B, used in height field computation for Rossby-Haurwitz wave
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), parameter :: w = 7.848e-6
-      real (kind=RKIND), parameter :: K = 7.848e-6
-      real (kind=RKIND), parameter :: R = 4.0
-
-      real (kind=RKIND), intent(in) :: theta
-
-      BB = (2.0*(omega + w)*K / ((R+1.0)*(R+2.0))) * cos(theta)**R * ((R**2.0 + 2.0*R + 2.0) - ((R+1.0)*cos(theta))**2.0)
-
-   end function BB
-
-
-   real function CC(theta)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! C, used in height field computation for Rossby-Haurwitz wave
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      implicit none
-
-      real (kind=RKIND), parameter :: w = 7.848e-6
-      real (kind=RKIND), parameter :: K = 7.848e-6
-      real (kind=RKIND), parameter :: R = 4.0
-
-      real (kind=RKIND), intent(in) :: theta
-
-      CC = 0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 - R - 2.0)
-
-   end function CC
-
-end module test_cases

Deleted: branches/source_condensing/src/core_sw/module_time_integration.F
===================================================================
--- trunk/mpas/src/core_sw/module_time_integration.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/core_sw/module_time_integration.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,1287 +0,0 @@
-module time_integration
-
-   use vector_reconstruction
-   use grid_types
-   use configure
-   use constants
-   use dmpar
-
-
-   contains
-
-
-   subroutine timestep(domain, dt, timeStamp)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Advance model state forward in time by the specified time step
-   !
-   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
-   !                 plus grid meta-data
-   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
-   !                  model state advanced forward in time by dt seconds
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      real (kind=RKIND), intent(in) :: dt
-      character(len=*), intent(in) :: timeStamp
-
-      type (block_type), pointer :: block
-
-      if (trim(config_time_integration) == 'RK4') then
-         call rk4(domain, dt)
-      else
-         write(0,*) 'Unknown time integration option '//trim(config_time_integration)
-         write(0,*) 'Currently, only ''RK4'' is supported.'
-         stop
-      end if
-
-      block =&gt; domain % blocklist
-      do while (associated(block))
-         block % state % time_levs(2) % state % xtime % scalar = timeStamp 
-         block =&gt; block % next
-      end do
-
-   end subroutine timestep
-
-
-   subroutine rk4(domain, dt)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Advance model state forward in time by the specified time step using 
-   !   4th order Runge-Kutta
-   !
-   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
-   !                 plus grid meta-data
-   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
-   !                  model state advanced forward in time by dt seconds
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (domain_type), intent(inout) :: domain
-      real (kind=RKIND), intent(in) :: dt
-
-      integer :: iCell, k
-      type (block_type), pointer :: block
-      type (state_type) :: provis
-
-      integer :: rk_step
-
-      real (kind=RKIND), dimension(4) :: rk_weights, rk_substep_weights
-
-      block =&gt; domain % blocklist
-      call allocate_state(provis, &amp;
-                          block % mesh % nCells, block % mesh % nEdges, block % mesh % maxEdges, block % mesh % maxEdges2, &amp;
-                          block % mesh % nVertices, block % mesh % vertexDegree, block % mesh % nVertLevels, &amp;
-                          block % mesh % nTracers)
-
-      !
-      ! Initialize time_levs(2) with state at current time
-      ! Initialize first RK state
-      ! Couple tracers time_levs(2) with h in time-levels
-      ! Initialize RK weights
-      !
-      block =&gt; domain % blocklist
-      do while (associated(block))
-
-         block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
-         block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:)
-         do iCell=1,block % mesh % nCells  ! couple tracers to h
-           do k=1,block % mesh % nVertLevels
-             block % state % time_levs(2) % state % tracers % array(:,k,iCell) = block % state % time_levs(1) % state % tracers % array(:,k,iCell) &amp;
-                                                                       * block % state % time_levs(1) % state % h % array(k,iCell)
-            end do
-         end do
-
-         call copy_state(provis, block % state % time_levs(1) % state)
-
-         block =&gt; block % next
-      end do
-
-      rk_weights(1) = dt/6.
-      rk_weights(2) = dt/3.
-      rk_weights(3) = dt/3.
-      rk_weights(4) = dt/6.
-
-      rk_substep_weights(1) = dt/2.
-      rk_substep_weights(2) = dt/2.
-      rk_substep_weights(3) = dt
-      rk_substep_weights(4) = 0.
-
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-      ! BEGIN RK loop 
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-      do rk_step = 1, 4
-
-! ---  update halos for diagnostic variables
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call dmpar_exch_halo_field2dReal(domain % dminfo, provis % pv_edge % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
-                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
-           if (config_h_mom_eddy_visc4 &gt; 0.0) then
-              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &amp;
-                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-              call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &amp;
-                                               block % mesh % nVertLevels, block % mesh % nVertices, &amp;
-                                               block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
-           end if
-
-           block =&gt; block % next
-        end do
-
-! ---  compute tendencies
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call compute_tend(block % tend, provis, block % mesh)
-           call compute_scalar_tend(block % tend, provis, block % mesh)
-           call enforce_boundaryEdge(block % tend, block % mesh)
-           block =&gt; block % next
-        end do
-
-! ---  update halos for prognostic variables
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % u % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
-                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-           call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % h % array(:,:), &amp;
-                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % tracers % array(:,:,:), &amp;
-                                            block % mesh % nTracers, block % mesh % nVertLevels, block % mesh % nCells, &amp;
-                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-           block =&gt; block % next
-        end do
-
-! ---  compute next substep state
-
-        if (rk_step &lt; 4) then
-           block =&gt; domain % blocklist
-           do while (associated(block))
-              provis % u % array(:,:)       = block % state % time_levs(1) % state % u % array(:,:)  &amp;
-                                            + rk_substep_weights(rk_step) * block % tend % u % array(:,:)
-              provis % h % array(:,:)       = block % state % time_levs(1) % state % h % array(:,:)  &amp;
-                                            + rk_substep_weights(rk_step) * block % tend % h % array(:,:)
-              do iCell=1,block % mesh % nCells
-                 do k=1,block % mesh % nVertLevels
-                    provis % tracers % array(:,k,iCell) = ( &amp;
-                                                           block % state % time_levs(1) % state % h % array(k,iCell) * &amp;
-                                                           block % state % time_levs(1) % state % tracers % array(:,k,iCell)  &amp;
-                                      + rk_substep_weights(rk_step) * block % tend % tracers % array(:,k,iCell) &amp;
-                                                          ) / provis % h % array(k,iCell)
-                 end do
-              end do
-              if (config_test_case == 1) then    ! For case 1, wind field should be fixed
-                 provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
-              end if
-              call compute_solve_diagnostics(dt, provis, block % mesh)
-              block =&gt; block % next
-           end do
-        end if
-
-!--- accumulate update (for RK4)
-
-        block =&gt; domain % blocklist
-        do while (associated(block))
-           block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % u % array(:,:) &amp;
-                                   + rk_weights(rk_step) * block % tend % u % array(:,:) 
-           block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(2) % state % h % array(:,:) &amp;
-                                   + rk_weights(rk_step) * block % tend % h % array(:,:) 
-           do iCell=1,block % mesh % nCells
-              do k=1,block % mesh % nVertLevels
-                 block % state % time_levs(2) % state % tracers % array(:,k,iCell) =  &amp;
-                                                                       block % state % time_levs(2) % state % tracers % array(:,k,iCell) &amp;
-                                               + rk_weights(rk_step) * block % tend % tracers % array(:,k,iCell)
-              end do
-           end do
-           block =&gt; block % next
-        end do
-
-      end do
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-      ! END RK loop 
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-
-      !
-      !  A little clean up at the end: decouple new scalar fields and compute diagnostics for new state
-      !
-      block =&gt; domain % blocklist
-      do while (associated(block))
-         do iCell=1,block % mesh % nCells
-            do k=1,block % mesh % nVertLevels
-               block % state % time_levs(2) % state % tracers % array(:,k,iCell) = &amp;
-                                                                     block % state % time_levs(2) % state % tracers % array(:,k,iCell)  &amp;
-                                                                   / block % state % time_levs(2) % state % h % array(k,iCell)
-            end do
-         end do
-
-         if (config_test_case == 1) then    ! For case 1, wind field should be fixed
-            block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
-         end if
-
-         call compute_solve_diagnostics(dt, block % state % time_levs(2) % state, block % mesh)
-
-         call reconstruct(block % mesh, block % state % time_levs(2) % state % u % array,          &amp;
-                          block % state % time_levs(2) % state % uReconstructX % array,            &amp;
-                          block % state % time_levs(2) % state % uReconstructY % array,            &amp;
-                          block % state % time_levs(2) % state % uReconstructZ % array,            &amp;
-                          block % state % time_levs(2) % state % uReconstructZonal % array,        &amp;
-                          block % state % time_levs(2) % state % uReconstructMeridional % array    &amp;
-                         )
-
-         block =&gt; block % next
-      end do
-
-      call deallocate_state(provis)
-
-   end subroutine rk4
-
-
-   subroutine compute_tend(tend, s, 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 (mesh_type), intent(in) :: grid
-
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
-      real (kind=RKIND) :: flux, vorticity_abs, workpv, q, upstream_bias
-
-      integer :: nCells, nEdges, nVertices, nVertLevels
-      real (kind=RKIND), dimension(:), pointer :: h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
-                                                  meshScalingDel2, meshScalingDel4
-      real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, tend_h, tend_u, &amp;
-                                                    circulation, vorticity, ke, pv_edge, divergence, h_vertex
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
-      real (kind=RKIND) :: r, u_diffusion
-
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
-      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
-
-      real (kind=RKIND), dimension(:,:), pointer :: u_src
-      real (kind=RKIND), parameter :: rho_ref = 1000.0
-      real (kind=RKIND) :: ke_edge
-
-
-      h           =&gt; s % h % array
-      u           =&gt; s % u % array
-      v           =&gt; s % v % array
-      h_edge      =&gt; s % h_edge % array
-      circulation =&gt; s % circulation % array
-      vorticity   =&gt; s % vorticity % array
-      divergence  =&gt; s % divergence % array
-      ke          =&gt; s % ke % array
-      pv_edge     =&gt; s % pv_edge % array
-      vh          =&gt; s % vh % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      cellsOnVertex     =&gt; grid % cellsOnVertex % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
-      edgesOnCell       =&gt; grid % edgesOnCell % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      edgesOnVertex     =&gt; grid % edgesOnVertex % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      h_s               =&gt; grid % h_s % array
-      fVertex           =&gt; grid % fVertex % array
-      fEdge             =&gt; grid % fEdge % array
-
-      tend_h      =&gt; tend % h % array
-      tend_u      =&gt; tend % u % array
-                  
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      u_src =&gt; grid % u_src % array
-
-      meshScalingDel2 =&gt; grid % meshScalingDel2 % array
-      meshScalingDel4 =&gt; grid % meshScalingDel4 % array
-
-
-      !
-      ! Compute height tendency for each cell
-      !
-      tend_h(:,:) = 0.0
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         do k=1,nVertLevels
-            flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge)
-            tend_h(k,cell1) = tend_h(k,cell1) - flux
-            tend_h(k,cell2) = tend_h(k,cell2) + flux
-         end do
-      end do 
-      do iCell=1,grid % nCellsSolve
-         do k=1,nVertLevels
-            tend_h(k,iCell) = tend_h(k,iCell) / areaCell(iCell)
-         end do
-      end do
-
-#ifdef LANL_FORMULATION
-      !
-      ! Compute u (normal) velocity tendency for each edge (cell face)
-      !
-      tend_u(:,:) = 0.0
-      do iEdge=1,grid % nEdgesSolve
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         vertex1 = verticesOnEdge(1,iEdge)
-         vertex2 = verticesOnEdge(2,iEdge)
-         
-         do k=1,nVertLevels
-            q = 0.0
-            do j = 1,nEdgesOnEdge(iEdge)
-               eoe = edgesOnEdge(j,iEdge)
-               workpv = 0.5 * (pv_edge(k,iEdge) + pv_edge(k,eoe))
-               q = q + weightsOnEdge(j,iEdge) * u(k,eoe) * workpv * h_edge(k,eoe) 
-            end do
-
-            tend_u(k,iEdge) =       &amp;
-                              q     &amp;
-                              - (   ke(k,cell2) - ke(k,cell1) + &amp;
-                                    gravity * (h(k,cell2) + h_s(cell2) - h(k,cell1) - h_s(cell1)) &amp;
-                                  ) / dcEdge(iEdge)
-         end do
-      end do
-
-
-#endif
-
-#ifdef NCAR_FORMULATION
-      !
-      ! Compute u (normal) velocity tendency for each edge (cell face)
-      !
-      tend_u(:,:) = 0.0
-      do iEdge=1,grid % nEdgesSolve
-         vertex1 = verticesOnEdge(1,iEdge)
-         vertex2 = verticesOnEdge(2,iEdge)
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-
-         do k=1,nVertLevels
-            vorticity_abs = fEdge(iEdge) + (circulation(k,vertex1) + circulation(k,vertex2)) / &amp;
-                                           (areaTriangle(vertex1) + areaTriangle(vertex2))
-
-            workpv = 2.0 * vorticity_abs / (h(k,cell1) + h(k,cell2))
-
-            tend_u(k,iEdge) = workpv * vh(k,iEdge) - &amp;
-                              (ke(k,cell2) - ke(k,cell1) + &amp;
-                                 gravity * (h(k,cell2) + h_s(cell2) - h(k,cell1) - h_s(cell1)) &amp;
-                              ) / &amp;
-                              dcEdge(iEdge)
-         end do
-      end do
-#endif
-
-     ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="red">abla vorticity
-     !                    only valid for visc == constant
-     if (config_h_mom_eddy_visc2 &gt; 0.0) then
-        do iEdge=1,grid % nEdgesSolve
-           cell1 = cellsOnEdge(1,iEdge)
-           cell2 = cellsOnEdge(2,iEdge)
-           vertex1 = verticesOnEdge(1,iEdge)
-           vertex2 = verticesOnEdge(2,iEdge)
-
-           do k=1,nVertLevels
-              u_diffusion =   ( divergence(k,cell2)  -  divergence(k,cell1) ) / dcEdge(iEdge) &amp;
-                   -(vorticity(k,vertex2)  - vorticity(k,vertex1) ) / dvEdge(iEdge)
-              u_diffusion = meshScalingDel2(iEdge) * config_h_mom_eddy_visc2 * u_diffusion
-              tend_u(k,iEdge) = tend_u(k,iEdge) + u_diffusion
-           end do
-        end do
-     end if
-
-     !
-     ! velocity tendency: del4 dissipation, -</font>
<font color="black">u_4 </font>
<font color="red">abla^4 u
-     !   computed as </font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="red">abla vorticity
-     !   applied recursively.
-     !   strictly only valid for h_mom_eddy_visc4 == constant
-     !
-     if (config_h_mom_eddy_visc4 &gt; 0.0) then
-        allocate(delsq_divergence(nVertLevels, nCells+1))
-        allocate(delsq_u(nVertLevels, nEdges+1))
-        allocate(delsq_circulation(nVertLevels, nVertices+1))
-        allocate(delsq_vorticity(nVertLevels, nVertices+1))
-
-        delsq_u(:,:) = 0.0
-
-        ! Compute </font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="red">abla vorticity
-        do iEdge=1,grid % nEdges
-           cell1 = cellsOnEdge(1,iEdge)
-           cell2 = cellsOnEdge(2,iEdge)
-           vertex1 = verticesOnEdge(1,iEdge)
-           vertex2 = verticesOnEdge(2,iEdge)
-
-           do k=1,nVertLevels
-
-              delsq_u(k,iEdge) = ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-                   -( vorticity(k,vertex2) - vorticity(k,vertex1)) / dvEdge(iEdge)
-
-           end do
-        end do
-
-        ! vorticity using </font>
<font color="red">abla^2 u
-        delsq_circulation(:,:) = 0.0
-        do iEdge=1,nEdges
-           vertex1 = verticesOnEdge(1,iEdge)
-           vertex2 = verticesOnEdge(2,iEdge)
-           do k=1,nVertLevels
-              delsq_circulation(k,vertex1) = delsq_circulation(k,vertex1) &amp;
-                   - dcEdge(iEdge) * delsq_u(k,iEdge)
-              delsq_circulation(k,vertex2) = delsq_circulation(k,vertex2) &amp;
-                   + dcEdge(iEdge) * delsq_u(k,iEdge)
-           end do
-        end do
-        do iVertex=1,nVertices
-           r = 1.0 / areaTriangle(iVertex)
-           do k=1,nVertLevels
-              delsq_vorticity(k,iVertex) = delsq_circulation(k,iVertex) * r
-           end do
-        end do
-
-        ! Divergence using </font>
<font color="red">abla^2 u
-        delsq_divergence(:,:) = 0.0
-        do iEdge=1,nEdges
-           cell1 = cellsOnEdge(1,iEdge)
-           cell2 = cellsOnEdge(2,iEdge)
-           do k=1,nVertLevels
-              delsq_divergence(k,cell1) = delsq_divergence(k,cell1) &amp;
-                   + delsq_u(k,iEdge)*dvEdge(iEdge)
-              delsq_divergence(k,cell2) = delsq_divergence(k,cell2) &amp;
-                   - delsq_u(k,iEdge)*dvEdge(iEdge)
-           end do
-        end do
-        do iCell = 1,nCells
-           r = 1.0 / areaCell(iCell)
-           do k = 1,nVertLevels
-              delsq_divergence(k,iCell) = delsq_divergence(k,iCell) * r
-           end do
-        end do
-
-        ! Compute - \kappa </font>
<font color="red">abla^4 u 
-        ! as  </font>
<font color="black">abla div(</font>
<font color="black">abla^2 u) + k \times </font>
<font color="black">abla ( k \cross curl(</font>
<font color="red">abla^2 u) )
-        do iEdge=1,grid % nEdgesSolve
-           cell1 = cellsOnEdge(1,iEdge)
-           cell2 = cellsOnEdge(2,iEdge)
-           vertex1 = verticesOnEdge(1,iEdge)
-           vertex2 = verticesOnEdge(2,iEdge)
-
-           do k=1,nVertLevels
-
-              u_diffusion = (  delsq_divergence(k,cell2) &amp;
-                   - delsq_divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
-                   -(  delsq_vorticity(k,vertex2) &amp;
-                   - delsq_vorticity(k,vertex1) ) / dvEdge(iEdge)
-
-              u_diffusion = meshScalingDel4(iEdge) * config_h_mom_eddy_visc4 * u_diffusion
-              tend_u(k,iEdge) = tend_u(k,iEdge) - u_diffusion
-
-           end do
-        end do
-
-        deallocate(delsq_divergence)
-        deallocate(delsq_u)
-        deallocate(delsq_circulation)
-        deallocate(delsq_vorticity)
-
-     end if
-
-     ! Compute u (velocity) tendency from wind stress (u_src)
-     if(config_wind_stress) then
-         do iEdge=1,grid % nEdges
-            tend_u(1,iEdge) =  tend_u(1,iEdge) &amp;
-                  + u_src(1,iEdge)/rho_ref/h_edge(1,iEdge)
-         end do
-     endif
-
-     if (config_bottom_drag) then
-         do iEdge=1,grid % nEdges
-             ! bottom drag is the same as POP:
-             ! -c |u| u  where c is unitless and 1.0e-3.
-             ! see POP Reference guide, section 3.4.4.
-             ke_edge = 0.5 * ( ke(1,cellsOnEdge(1,iEdge)) &amp;
-                   + ke(1,cellsOnEdge(2,iEdge)))
-
-             tend_u(1,iEdge) = tend_u(1,iEdge)  &amp;
-                  - 1.0e-3*u(1,iEdge) &amp;
-                  *sqrt(2.0*ke_edge)/h_edge(1,iEdge)
-         end do
-     endif

-   end subroutine compute_tend
-
-
-   subroutine compute_scalar_tend(tend, s, grid)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   !
-   ! Input: s - current model state
-   !        grid - grid metadata
-   !
-   ! Output: tend - computed scalar tendencies
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-      implicit none
-
-      type (tend_type), intent(inout) :: tend
-      type (state_type), intent(in) :: s
-      type (mesh_type), intent(in) :: grid
-
-      integer :: iCell, iEdge, k, iTracer, cell1, cell2, i
-      real (kind=RKIND) :: flux, tracer_edge, r
-      real (kind=RKIND) :: invAreaCell1, invAreaCell2, tracer_turb_flux
-      integer, dimension(:,:), pointer :: boundaryEdge
-      real (kind=RKIND), dimension(:,:), allocatable :: boundaryMask
-      real (kind=RKIND), dimension(:,:,:), allocatable:: delsq_tracer
-      
-      real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2
-      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
-      real (kind=RKIND), dimension(:,:,:), pointer :: tracers, tracer_tend
-      integer, dimension(:,:), pointer :: cellsOnEdge, boundaryCell
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      real (kind=RKIND) :: coef_3rd_order
-      real (kind=RKIND), dimension(:,:), pointer :: u, h_edge
-
-      u           =&gt; s % u % array
-      h_edge      =&gt; s % h_edge % array
-      dcEdge      =&gt; grid % dcEdge % array
-      deriv_two   =&gt; grid % deriv_two % array
-      dvEdge      =&gt; grid % dvEdge % array
-      tracers     =&gt; s % tracers % array
-      cellsOnEdge =&gt; grid % cellsOnEdge % array
-      boundaryCell=&gt; grid % boundaryCell % array
-      boundaryEdge=&gt; grid % boundaryEdge % array
-      areaCell    =&gt; grid % areaCell % array
-      tracer_tend =&gt; tend % tracers % array
-
-      coef_3rd_order = 0.
-      if (config_tracer_adv_order == 3) coef_3rd_order = 1.0
-      if (config_tracer_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
-
-
-      tracer_tend(:,:,:) = 0.0
-
-      if (config_tracer_adv_order == 2) then
-
-      do iEdge=1,grid % nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= grid%nCells .and. cell2 &lt;= grid%nCells) then
-               do k=1,grid % nVertLevels
-                  do iTracer=1,grid % nTracers
-                     tracer_edge = 0.5 * (tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))
-                     flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge) * tracer_edge
-                     tracer_tend(iTracer,k,cell1) = tracer_tend(iTracer,k,cell1) - flux/areaCell(cell1)
-                     tracer_tend(iTracer,k,cell2) = tracer_tend(iTracer,k,cell2) + flux/areaCell(cell2)
-                  end do 
-               end do 
-            end if
-      end do 
-
-      else if (config_tracer_adv_order == 3) then
-
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-
-            !-- if a cell not on the most outside ring of the halo
-            if (cell1 &lt;= grid%nCells .and. cell2 &lt;= grid%nCells) then
-
-               do k=1,grid % nVertLevels
-
-                  d2fdx2_cell1 = 0.0
-                  d2fdx2_cell2 = 0.0
-
-                  do iTracer=1,grid % nTracers

-                     !-- if not a boundary cell
-                     if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
-
-                        d2fdx2_cell1 = deriv_two(1,1,iEdge) * tracers(iTracer,k,cell1)
-                        d2fdx2_cell2 = deriv_two(1,2,iEdge) * tracers(iTracer,k,cell2)
-
-                        !-- all edges of cell 1
-                        do i=1, grid % nEdgesOnCell % array (cell1)
-                                d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                                deriv_two(i+1,1,iEdge) * tracers(iTracer,k,grid % CellsOnCell % array (i,cell1))
-                        end do
-
-                        !-- all edges of cell 2
-                        do i=1, grid % nEdgesOnCell % array (cell2)
-                                d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                                deriv_two(i+1,2,iEdge) * tracers(iTracer,k,grid % CellsOnCell % array (i,cell2))
-                        end do
-
-                     endif
-
-                     !-- if u &gt; 0:
-                     if (u(k,iEdge) &gt; 0) then
-                        flux = dvEdge(iEdge) * u(k,iEdge) * h_edge(k,iEdge) * (          &amp;
-                             0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))      &amp;
-                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                             -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                     !-- else u &lt;= 0:
-                     else
-                        flux = dvEdge(iEdge) *  u(k,iEdge) * h_edge(k,iEdge) * (          &amp;
-                             0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))      &amp;
-                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                             +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
-                     end if
-
-                     !-- update tendency
-                     tracer_tend(iTracer,k,cell1) = tracer_tend(iTracer,k,cell1) - flux/areaCell(cell1)
-                     tracer_tend(iTracer,k,cell2) = tracer_tend(iTracer,k,cell2) + flux/areaCell(cell2)
-                  enddo
-               end do
-            end if
-         end do
-
-      else  if (config_tracer_adv_order == 4) then
-
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-
-            !-- if an edge is not on the outer-most ring of the halo
-            if (cell1 &lt;= grid%nCells .and. cell2 &lt;= grid%nCells) then
-
-               do k=1,grid % nVertLevels
-
-                  d2fdx2_cell1 = 0.0
-                  d2fdx2_cell2 = 0.0
-
-                  do iTracer=1,grid % nTracers
-
-                     !-- if not a boundary cell
-                     if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
-
-                        d2fdx2_cell1 = deriv_two(1,1,iEdge) * tracers(iTracer,k,cell1)
-                        d2fdx2_cell2 = deriv_two(1,2,iEdge) * tracers(iTracer,k,cell2)
-
-                        !-- all edges of cell 1
-                        do i=1, grid % nEdgesOnCell % array (cell1)
-                                d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                                deriv_two(i+1,1,iEdge) * tracers(iTracer,k,grid % CellsOnCell % array (i,cell1))
-                        end do
-
-                        !-- all edges of cell 2
-                        do i=1, grid % nEdgesOnCell % array (cell2)
-                                d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                                deriv_two(i+1,2,iEdge) * tracers(iTracer,k,grid % CellsOnCell % array (i,cell2))
-                        end do
-
-                     endif
-
-                     flux = dvEdge(iEdge) *  u(k,iEdge) * h_edge(k,iEdge) * (          &amp;
-                          0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))      &amp;
-                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
-
-                     !-- update tendency
-                     tracer_tend(iTracer,k,cell1) = tracer_tend(iTracer,k,cell1) - flux/areaCell(cell1)
-                     tracer_tend(iTracer,k,cell2) = tracer_tend(iTracer,k,cell2) + flux/areaCell(cell2)
-                  enddo
-               end do
-            end if
-         end do
-
-      endif   ! if (config_tracer_adv_order == 2 )
-
-      !
-      ! tracer tendency: del2 horizontal tracer diffusion, div(h \kappa_2 </font>
<font color="red">abla \phi)
-      !
-      if ( config_h_tracer_eddy_diff2 &gt; 0.0 ) then
-
-         !
-         ! compute a boundary mask to enforce insulating boundary conditions in the horizontal
-         !
-         allocate(boundaryMask(grid % nVertLevels, grid % nEdges+1))
-         boundaryMask = 1.0
-         where(boundaryEdge.eq.1) boundaryMask=0.0
-
-         do iEdge=1,grid % nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            invAreaCell1 = 1.0/areaCell(cell1)
-            invAreaCell2 = 1.0/areaCell(cell2)
-
-            do k=1,grid % nVertLevels
-              do iTracer=1, grid % nTracers
-                 ! \kappa_2 </font>
<font color="red">abla \phi on edge
-                 tracer_turb_flux = config_h_tracer_eddy_diff2 &amp;
-                    *( tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) / dcEdge(iEdge)
-
-                 ! div(h \kappa_2 </font>
<font color="red">abla \phi) at cell center
-                 flux = dvEdge(iEdge) * h_edge(k,iEdge) * tracer_turb_flux * boundaryMask(k, iEdge)
-                 tracer_tend(iTracer,k,cell1) = tracer_tend(iTracer,k,cell1) + flux * invAreaCell1
-                 tracer_tend(iTracer,k,cell2) = tracer_tend(iTracer,k,cell2) - flux * invAreaCell2
-              end do
-            end do
-
-         end do
-
-        deallocate(boundaryMask)
-
-      end if
-
-      !
-      ! tracer tendency: del4 horizontal tracer diffusion, &amp;
-      !    div(h \kappa_4 </font>
<font color="black">abla [div(h </font>
<font color="red">abla \phi)])
-      !
-      if ( config_h_tracer_eddy_diff4 &gt; 0.0 ) then
-
-         !
-         ! compute a boundary mask to enforce insulating boundary conditions in the horizontal
-         !
-         allocate(boundaryMask(grid % nVertLevels, grid % nEdges+1))
-         boundaryMask = 1.0
-         where(boundaryEdge.eq.1) boundaryMask=0.0
-
-         allocate(delsq_tracer(grid % nTracers, grid % nVertLevels, grid % nCells+1))
-
-         delsq_tracer(:,:,:) = 0.
-
-         ! first del2: div(h </font>
<font color="red">abla \phi) at cell center
-         do iEdge=1,grid % nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-
-            do k=1,grid % nVertLevels
-              do iTracer=1, grid % nTracers
-                 delsq_tracer(iTracer,k,cell1) = delsq_tracer(iTracer,k,cell1) &amp;
-                    + dvEdge(iEdge) * h_edge(k,iEdge) * (tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) / dcEdge(iEdge) * boundaryMask(k,iEdge)
-                 delsq_tracer(iTracer,k,cell2) = delsq_tracer(iTracer,k,cell2) &amp;
-                    - dvEdge(iEdge) * h_edge(k,iEdge) * (tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) / dcEdge(iEdge) * boundaryMask(k,iEdge)
-              end do
-            end do
-
-         end do
-
-         do iCell = 1, grid % nCells
-            r = 1.0 / grid % areaCell % array(iCell)
-            do k=1,grid % nVertLevels
-            do iTracer=1,grid % nTracers
-               delsq_tracer(iTracer,k,iCell) = delsq_tracer(iTracer,k,iCell) * r
-            end do
-            end do
-         end do
-
-         ! second del2: div(h </font>
<font color="gray">abla [delsq_tracer]) at cell center
-         do iEdge=1,grid % nEdges
-            cell1 = grid % cellsOnEdge % array(1,iEdge)
-            cell2 = grid % cellsOnEdge % array(2,iEdge)
-            invAreaCell1 = 1.0 / grid % areaCell % array(cell1)
-            invAreaCell2 = 1.0 / grid % areaCell % array(cell2)
-
-            do k=1,grid % nVertLevels
-            do iTracer=1,grid % nTracers
-               tracer_turb_flux = config_h_tracer_eddy_diff4 * (delsq_tracer(iTracer,k,cell2) - delsq_tracer(iTracer,k,cell1)) / dcEdge(iEdge)
-               flux = dvEdge(iEdge) * tracer_turb_flux
-               tracer_tend(iTracer,k,cell1) = tracer_tend(iTracer,k,cell1) - flux * invAreaCell1 * boundaryMask(k,iEdge)
-               tracer_tend(iTracer,k,cell2) = tracer_tend(iTracer,k,cell2) + flux * invAreaCell2 * boundaryMask(k,iEdge)
-            end do
-            enddo
-
-         end do
-
-         deallocate(delsq_tracer)
-         deallocate(boundaryMask)
-
-      end if
-
-   end subroutine compute_scalar_tend
-
-
-   subroutine compute_solve_diagnostics(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
-
-
-      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
-      real (kind=RKIND) :: flux, vorticity_abs, workpv
-
-      integer :: nCells, nEdges, nVertices, nVertLevels
-      real (kind=RKIND), dimension(:), pointer :: h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
-      real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, tend_h, tend_u, &amp;
-                                                    circulation, vorticity, ke, pv_edge, pv_vertex, pv_cell, gradPVn, gradPVt, divergence, &amp;
-                                                    h_vertex, vorticity_cell
-      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex, boundaryEdge, boundaryCell
-      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
-      real (kind=RKIND) :: r, h1, h2
-      real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2
-      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
-      real (kind=RKIND) :: coef_3rd_order
-
-      h           =&gt; s % h % array
-      u           =&gt; s % u % array
-      v           =&gt; s % v % array
-      vh          =&gt; s % vh % array
-      h_edge      =&gt; s % h_edge % array
-      h_vertex    =&gt; s % h_vertex % array
-      tend_h      =&gt; s % h % array
-      tend_u      =&gt; s % u % array
-      circulation =&gt; s % circulation % array
-      vorticity   =&gt; s % vorticity % array
-      divergence  =&gt; s % divergence % array
-      ke          =&gt; s % ke % array
-      pv_edge     =&gt; s % pv_edge % array
-      pv_vertex   =&gt; s % pv_vertex % array
-      pv_cell     =&gt; s % pv_cell % array
-      vorticity_cell =&gt; s % vorticity_cell % array
-      gradPVn     =&gt; s % gradPVn % array
-      gradPVt     =&gt; s % gradPVt % array
-
-      weightsOnEdge     =&gt; grid % weightsOnEdge % array
-      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
-      cellsOnEdge       =&gt; grid % cellsOnEdge % array
-      cellsOnVertex     =&gt; grid % cellsOnVertex % array
-      verticesOnEdge    =&gt; grid % verticesOnEdge % array
-      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
-      edgesOnCell       =&gt; grid % edgesOnCell % array
-      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
-      edgesOnEdge       =&gt; grid % edgesOnEdge % array
-      edgesOnVertex     =&gt; grid % edgesOnVertex % array
-      dcEdge            =&gt; grid % dcEdge % array
-      dvEdge            =&gt; grid % dvEdge % array
-      areaCell          =&gt; grid % areaCell % array
-      areaTriangle      =&gt; grid % areaTriangle % array
-      h_s               =&gt; grid % h_s % array
-      fVertex           =&gt; grid % fVertex % array
-      fEdge             =&gt; grid % fEdge % array
-      deriv_two         =&gt; grid % deriv_two % array
-                  
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      boundaryEdge =&gt; grid % boundaryEdge % array
-      boundaryCell =&gt; grid % boundaryCell % array
-
-      !
-      ! Find those cells that have an edge on the boundary
-      !
-      boundaryCell(:,:) = 0
-      do iEdge=1,nEdges
-       do k=1,nVertLevels
-         if(boundaryEdge(k,iEdge).eq.1) then
-           cell1 = cellsOnEdge(1,iEdge)
-           cell2 = cellsOnEdge(2,iEdge)
-           boundaryCell(k,cell1) = 1
-           boundaryCell(k,cell2) = 1
-         endif
-       enddo
-      enddo
-
-      !
-      ! Compute height on cell edges at velocity locations
-      !   Namelist options control the order of accuracy of the reconstructed h_edge value
-      !
-
-      coef_3rd_order = 0.
-      if (config_thickness_adv_order == 3) coef_3rd_order = 1.0
-      if (config_thickness_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
-
-      if (config_thickness_adv_order == 2) then
-
-         do iEdge=1,grid % nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-            if (cell1 &lt;= grid%nCells .and. cell2 &lt;= grid%nCells) then
-               do k=1,grid % nVertLevels
-                  h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
-               end do 
-            end if
-         end do 
-
-      else if (config_thickness_adv_order == 3) then
-
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-
-            !-- if a cell not on the most outside ring of the halo
-            if (cell1 &lt;= grid%nCells .and. cell2 &lt;= grid%nCells) then
-
-               do k=1,grid % nVertLevels
-
-                  d2fdx2_cell1 = 0.0
-                  d2fdx2_cell2 = 0.0
-
-                  !-- if not a boundary cell
-                  if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
-
-                     d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1)
-                     d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2)
-
-                     !-- all edges of cell 1
-                     do i=1, grid % nEdgesOnCell % array (cell1)
-                             d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                             deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (i,cell1))
-                     end do
-
-                     !-- all edges of cell 2
-                     do i=1, grid % nEdgesOnCell % array (cell2)
-                             d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                             deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
-                     end do
-
-                  endif
-
-                  !-- if u &gt; 0:
-                  if (u(k,iEdge) &gt; 0) then
-                     h_edge(k,iEdge) =     &amp;
-                          0.5*(h(k,cell1) + h(k,cell2))      &amp;
-                          -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                          -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
-                  !-- else u &lt;= 0:
-                  else
-                     h_edge(k,iEdge) =     &amp;
-                          0.5*(h(k,cell1) + h(k,cell2))      &amp;
-                          -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
-                          +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
-                  end if
-
-               end do   ! do k
-            end if      ! if (cell1 &lt;=
-         end do         ! do iEdge
-
-      else  if (config_thickness_adv_order == 4) then
-
-         do iEdge=1,grid%nEdges
-            cell1 = cellsOnEdge(1,iEdge)
-            cell2 = cellsOnEdge(2,iEdge)
-
-            !-- if a cell not on the most outside ring of the halo
-            if (cell1 &lt;= grid%nCells .and. cell2 &lt;= grid%nCells) then
-
-               do k=1,grid % nVertLevels
-
-                  d2fdx2_cell1 = 0.0
-                  d2fdx2_cell2 = 0.0
-
-                  !-- if not a boundary cell
-                  if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
-
-                     d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1)
-                     d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2)
-
-                     !-- all edges of cell 1
-                     do i=1, grid % nEdgesOnCell % array (cell1)
-                             d2fdx2_cell1 = d2fdx2_cell1 + &amp;
-                             deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (i,cell1))
-                     end do
-
-                     !-- all edges of cell 2
-                     do i=1, grid % nEdgesOnCell % array (cell2)
-                             d2fdx2_cell2 = d2fdx2_cell2 + &amp;
-                             deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
-                     end do
-
-                  endif
-
-                  h_edge(k,iEdge) =   &amp;
-                       0.5*(h(k,cell1) + h(k,cell2))      &amp;
-                          -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.
-
-               end do   ! do k
-            end if      ! if (cell1 &lt;=
-         end do         ! do iEdge
-
-      endif   ! if(config_thickness_adv_order == 2)
-
-      !
-      ! set the velocity in the nEdges+1 slot to zero, this is a dummy address
-      !    used to when reading for edges that do not exist
-      !
-      u(:,nEdges+1) = 0.0
-
-      !
-      ! Compute circulation and relative vorticity at each vertex
-      !
-      circulation(:,:) = 0.0
-      do iEdge=1,nEdges
-         do k=1,nVertLevels
-            circulation(k,verticesOnEdge(1,iEdge)) = circulation(k,verticesOnEdge(1,iEdge)) - dcEdge(iEdge) * u(k,iEdge)
-            circulation(k,verticesOnEdge(2,iEdge)) = circulation(k,verticesOnEdge(2,iEdge)) + dcEdge(iEdge) * u(k,iEdge)
-         end do
-      end do
-      do iVertex=1,nVertices
-         do k=1,nVertLevels
-            vorticity(k,iVertex) = circulation(k,iVertex) / areaTriangle(iVertex)
-         end do
-      end do
-
-
-      !
-      ! Compute the divergence at each cell center
-      !
-      divergence(:,:) = 0.0
-      do iEdge=1,nEdges
-         cell1 = cellsOnEdge(1,iEdge)
-         cell2 = cellsOnEdge(2,iEdge)
-         if (cell1 &lt;= nCells) then
-            do k=1,nVertLevels
-              divergence(k,cell1) = divergence(k,cell1) + u(k,iEdge)*dvEdge(iEdge)
-            enddo
-         endif
-         if(cell2 &lt;= nCells) then
-            do k=1,nVertLevels
-              divergence(k,cell2) = divergence(k,cell2) - u(k,iEdge)*dvEdge(iEdge)
-            enddo
-         end if
-      end do
-      do iCell = 1,nCells
-        r = 1.0 / areaCell(iCell)
-        do k = 1,nVertLevels
-           divergence(k,iCell) = divergence(k,iCell) * r
-        enddo
-      enddo
-
-      !
-      ! Compute kinetic energy in each cell
-      !
-      ke(:,:) = 0.0
-      do iCell=1,nCells
-         do i=1,nEdgesOnCell(iCell)
-            iEdge = edgesOnCell(i,iCell)
-            do k=1,nVertLevels
-               ke(k,iCell) = ke(k,iCell) + 0.25 * dcEdge(iEdge) * dvEdge(iEdge) * u(k,iEdge)**2.0
-            end do
-         end do
-         do k=1,nVertLevels
-            ke(k,iCell) = ke(k,iCell) / areaCell(iCell)
-         end do
-      end do
-
-      !
-      ! Compute v (tangential) velocities
-      !
-      v(:,:) = 0.0
-      do iEdge = 1,nEdges
-         do i=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(i,iEdge)
-            do k = 1,nVertLevels
-               v(k,iEdge) = v(k,iEdge) + weightsOnEdge(i,iEdge) * u(k, eoe)
-            end do
-         end do
-      end do
-
-#ifdef NCAR_FORMULATION
-      !
-      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
-      !
-      vh(:,:) = 0.0
-      do iEdge=1,grid % nEdgesSolve
-         do j=1,nEdgesOnEdge(iEdge)
-            eoe = edgesOnEdge(j,iEdge)
-            do k=1,nVertLevels
-               vh(k,iEdge) = vh(k,iEdge) + weightsOnEdge(j,iEdge) * u(k,eoe) * h_edge(k,eoe)
-            end do
-         end do
-      end do
-#endif
-
-
-      !
-      ! 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 )
-      !
-      do iVertex = 1,nVertices
-         do k=1,nVertLevels
-            h_vertex(k,iVertex) = 0.0
-            do i=1,grid % vertexDegree
-               h_vertex(k,iVertex) = h_vertex(k,iVertex) + h(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
-            end do
-            h_vertex(k,iVertex) = h_vertex(k,iVertex) / areaTriangle(iVertex)
-
-            pv_vertex(k,iVertex) = (fVertex(iVertex) + vorticity(k,iVertex)) / h_vertex(k,iVertex)
-         end do
-      end do
-
-
-      !
-      ! Compute gradient of PV in the tangent direction
-      !   ( this computes gradPVt at all edges bounding real cells and distance-1 ghost cells )
-      !
-      do iEdge = 1,nEdges
-         do k = 1,nVertLevels
-           gradPVt(k,iEdge) = (pv_vertex(k,verticesOnEdge(2,iEdge)) - pv_vertex(k,verticesOnEdge(1,iEdge))) / &amp;
-                              dvEdge(iEdge)
-         enddo
-      enddo
-
-      !
-      ! Compute pv at the edges
-      !   ( this computes pv_edge at all edges bounding real cells )
-      !
-      pv_edge(:,:) = 0.0
-      do iVertex = 1,nVertices
-        do i=1,grid % vertexDegree
-           iEdge = edgesOnVertex(i,iVertex)
-           do k=1,nVertLevels
-              pv_edge(k,iEdge) =  pv_edge(k,iEdge)  + 0.5 * pv_vertex(k,iVertex)
-           end do
-        end do
-      end do
-
-
-      !
-      ! Modify PV edge with upstream bias. 
-      !
-      do iEdge = 1,nEdges
-         do k = 1,nVertLevels
-           pv_edge(k,iEdge) = pv_edge(k,iEdge) - config_apvm_upwinding * v(k,iEdge) * dt * gradPVt(k,iEdge)
-         enddo
-      enddo
-
-
-      !
-      ! Compute pv at cell centers
-      !    ( this computes pv_cell for all real cells and distance-1 ghost cells )
-      !
-      pv_cell(:,:) = 0.0
-      vorticity_cell(:,:) = 0.0
-      do iVertex = 1, nVertices
-       do i=1,grid % vertexDegree
-         iCell = cellsOnVertex(i,iVertex)
-         if (iCell &lt;= nCells) then
-           do k = 1,nVertLevels
-             pv_cell(k,iCell) = pv_cell(k,iCell) + kiteAreasOnVertex(i, iVertex) * pv_vertex(k, iVertex) / areaCell(iCell)
-             vorticity_cell(k,iCell) = vorticity_cell(k,iCell) + kiteAreasOnVertex(i, iVertex) * vorticity(k, iVertex) / areaCell(iCell)
-           enddo
-         endif
-       enddo
-      enddo
-
-
-      !
-      ! Compute gradient of PV in normal direction
-      !   ( this computes gradPVn for all edges bounding real cells )
-      !
-      gradPVn(:,:) = 0.0
-      do iEdge = 1,nEdges
-        if( cellsOnEdge(1,iEdge) &lt;= nCells .and. cellsOnEdge(2,iEdge) &lt;= nCells) then
-          do k = 1,nVertLevels
-            gradPVn(k,iEdge) = (pv_cell(k,cellsOnEdge(2,iEdge)) - pv_cell(k,cellsOnEdge(1,iEdge))) / &amp;
-                                 dcEdge(iEdge)
-          enddo
-        endif
-      enddo
-
-      ! Modify PV edge with upstream bias.
-      !
-      do iEdge = 1,nEdges
-         do k = 1,nVertLevels
-           pv_edge(k,iEdge) = pv_edge(k,iEdge) - config_apvm_upwinding * u(k,iEdge) * dt * gradPVn(k,iEdge)
-         enddo
-      enddo
-
-      !
-      ! set pv_edge = fEdge / h_edge at boundary points
-      !
-   !  if (maxval(boundaryEdge).ge.0) then
-   !  do iEdge = 1,nEdges
-   !     cell1 = cellsOnEdge(1,iEdge)
-   !     cell2 = cellsOnEdge(2,iEdge)
-   !     do k = 1,nVertLevels
-   !       if(boundaryEdge(k,iEdge).eq.1) then
-   !         v(k,iEdge) = 0.0
-   !         if(cell1.gt.0) then
-   !            h1 = h(k,cell1)
-   !            pv_edge(k,iEdge) = fEdge(iEdge) / h1
-   !            h_edge(k,iEdge) = h1
-   !         else
-   !            h2 = h(k,cell2)
-   !            pv_edge(k,iEdge) = fEdge(iEdge) / h2
-   !            h_edge(k,iEdge) = h2
-   !         endif
-   !       endif
-   !     enddo
-   !  enddo
-   !  endif
-
-
-   end subroutine compute_solve_diagnostics
-
-
-   subroutine enforce_boundaryEdge(tend, grid)
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   ! Enforce any boundary conditions on the normal velocity at each edge
-   !
-   ! Input: grid - grid metadata
-   !
-   ! Output: tend_u set to zero at boundaryEdge == 1 locations
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-      implicit none
-
-      type (tend_type), intent(inout) :: tend
-      type (mesh_type), intent(in) :: grid
-
-      integer, dimension(:,:), pointer :: boundaryEdge
-      real (kind=RKIND), dimension(:,:), pointer :: tend_u
-      integer :: nCells, nEdges, nVertices, nVertLevels
-      integer :: iEdge, k
-
-      nCells      = grid % nCells
-      nEdges      = grid % nEdges
-      nVertices   = grid % nVertices
-      nVertLevels = grid % nVertLevels
-
-      boundaryEdge         =&gt; grid % boundaryEdge % array
-      tend_u               =&gt; tend % u % array
-
-      if(maxval(boundaryEdge).le.0) return
-
-      do iEdge = 1,nEdges
-        do k = 1,nVertLevels
-
-          if(boundaryEdge(k,iEdge).eq.1) then
-             tend_u(k,iEdge) = 0.0
-          endif
-
-        enddo
-       enddo
-
-   end subroutine enforce_boundaryEdge
-
-
-end module time_integration

Copied: branches/source_condensing/src/core_sw/mpas_sw_advection.F (from rev 1114, trunk/mpas/src/core_sw/mpas_sw_advection.F)
===================================================================
--- branches/source_condensing/src/core_sw/mpas_sw_advection.F                                (rev 0)
+++ branches/source_condensing/src/core_sw/mpas_sw_advection.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,933 @@
+module sw_advection
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+
+
+   contains
+
+
+   subroutine sw_initialize_advection_rk( grid )
+                                      
+!
+! compute the cell coefficients for the polynomial fit.
+! this is performed during setup for model integration.
+! WCS, 31 August 2009
+!
+      implicit none
+
+      type (mesh_type), intent(in) :: grid
+
+      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
+      integer, dimension(:,:), pointer :: advCells
+
+!  local variables
+
+      real (kind=RKIND), dimension(2, grid % nEdges) :: thetae
+      real (kind=RKIND), dimension(grid % nEdges) :: xe, ye
+      real (kind=RKIND), dimension(grid % nCells) :: theta_abs
+
+      real (kind=RKIND), dimension(25) :: xc, yc, zc ! cell center coordinates
+      real (kind=RKIND), dimension(25) :: thetav, thetat, dl_sphere
+      real (kind=RKIND) :: xm, ym, zm, dl, xec, yec, zec
+      real (kind=RKIND) :: thetae_tmp, xe_tmp, ye_tmp
+      real (kind=RKIND) :: xv1, xv2, yv1, yv2, zv1, zv2
+      integer :: i, j, k, ip1, ip2, m, n, ip1a, ii
+      integer :: iCell, iEdge
+      real (kind=RKIND) :: pii
+      real (kind=RKIND) :: x0, y0, x1, y1, x2, y2, x3, y3, x4, y4, x5, y5
+      real (kind=RKIND) :: pdx1, pdx2, pdx3, pdy1, pdy2, pdy3, dx1, dx2, dy1, dy2
+      real (kind=RKIND) :: angv1, angv2, dl1, dl2
+      real (kind=RKIND), dimension(25) :: dxe, dye, x2v, y2v, xp, yp
+      
+      real (kind=RKIND) :: amatrix(25,25), bmatrix(25,25), wmatrix(25,25)
+      real (kind=RKIND) :: length_scale
+      integer :: ma,na, cell_add, mw, nn
+      integer, dimension(25) :: cell_list
+
+
+      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
+
+      logical, parameter :: reset_poly = .true.
+
+      real (kind=RKIND) :: rcell, cos2t, costsint, sin2t
+      real (kind=RKIND), dimension(grid%maxEdges) :: angle_2d
+
+!---
+
+      pii = 2.*asin(1.0)
+
+      advCells =&gt; grid % advCells % array
+      deriv_two =&gt; grid % deriv_two % array
+      deriv_two(:,:,:) = 0.
+
+      do iCell = 1, grid % nCells !  is this correct? - we need first halo cell also...
+
+         cell_list(1) = iCell
+         do i=2, grid % nEdgesOnCell % array(iCell)+1
+            cell_list(i) = grid % CellsOnCell % array(i-1,iCell)
+         end do
+         n = grid % nEdgesOnCell % array(iCell) + 1
+
+         if ( polynomial_order &gt; 2 ) then
+            do i=2,grid % nEdgesOnCell % array(iCell) + 1
+               do j=1,grid % nEdgesOnCell % array ( cell_list(i) )
+                  cell_add = grid % CellsOnCell % array (j,cell_list(i))
+                  add_the_cell = .true.
+                  do k=1,n
+                     if ( cell_add == cell_list(k) ) add_the_cell = .false.
+                  end do
+                  if (add_the_cell) then
+                     n = n+1
+                     cell_list(n) = cell_add
+                  end if
+               end do
+            end do
+         end if

+         advCells(1,iCell) = n
+
+!  check to see if we are reaching outside the halo
+
+         do_the_cell = .true.
+         do i=1,n
+            if (cell_list(i) &gt; grid % nCells) do_the_cell = .false.
+         end do
+
+
+         if ( .not. do_the_cell ) cycle
+
+
+!  compute poynomial fit for this cell if all needed neighbors exist
+         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
+            end do
+
+            theta_abs(iCell) =  pii/2. - sphere_angle( xc(1), yc(1), zc(1),  &amp;
+                                                       xc(2), yc(2), zc(2),  &amp;
+                                                       0.,    0.,    1.      ) 
+
+! angles from cell center to neighbor centers (thetav)
+
+            do i=1,n-1
+   
+               ip2 = i+2
+               if (ip2 &gt; n) ip2 = 2
+    
+               thetav(i) = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
+                                         xc(i+1), yc(i+1), zc(i+1),  &amp;
+                                         xc(ip2), yc(ip2), zc(ip2)   )
+
+               dl_sphere(i) = a*arc_length( xc(1),   yc(1),   zc(1),  &amp;
+                                            xc(i+1), yc(i+1), zc(i+1) )
+            end do
+
+            length_scale = 1.
+            do i=1,n-1
+               dl_sphere(i) = dl_sphere(i)/length_scale
+            end do
+
+!            thetat(1) = 0.  !  this defines the x direction, cell center 1 -&gt; 
+            thetat(1) = theta_abs(iCell)  !  this defines the x direction, longitude line
+            do i=2,n-1
+               thetat(i) = thetat(i-1) + thetav(i-1)
+            end do
+   
+            do i=1,n-1
+               xp(i) = cos(thetat(i)) * dl_sphere(i)
+               yp(i) = sin(thetat(i)) * dl_sphere(i)
+            end do
+
+         else     ! On an x-y plane
+
+            do i=1,n-1
+
+               angle_2d(i) = grid%angleEdge%array(grid % EdgesOnCell % array(i,iCell))
+               iEdge = grid % EdgesOnCell % array(i,iCell)
+               if ( iCell .ne. grid % CellsOnEdge % array(1,iEdge)) &amp;
+                  angle_2d(i) = angle_2d(i) - pii
+
+!               xp(i) = grid % xCell % array(cell_list(i)) - grid % xCell % array(iCell)
+!               yp(i) = grid % yCell % array(cell_list(i)) - grid % yCell % array(iCell)
+
+               xp(i) = grid % dcEdge % array(grid % EdgesOnCell % array(i,iCell)) * cos(angle_2d(i))
+               yp(i) = grid % dcEdge % array(grid % EdgesOnCell % array(i,iCell)) * sin(angle_2d(i))
+
+            end do
+
+         end if
+
+
+         ma = n-1
+         mw = grid % nEdgesOnCell % array (iCell)
+
+         bmatrix = 0.
+         amatrix = 0.
+         wmatrix = 0.
+
+         if (polynomial_order == 2) then
+            na = 6
+            ma = ma+1
+  
+            amatrix(1,1) = 1.
+            wmatrix(1,1) = 1.
+            do i=2,ma
+               amatrix(i,1) = 1.
+               amatrix(i,2) = xp(i-1)
+               amatrix(i,3) = yp(i-1)
+               amatrix(i,4) = xp(i-1)**2
+               amatrix(i,5) = xp(i-1) * yp(i-1)
+               amatrix(i,6) = yp(i-1)**2
+   
+               wmatrix(i,i) = 1.
+            end do

+         else if (polynomial_order == 3) then
+            na = 10
+            ma = ma+1
+  
+            amatrix(1,1) = 1.
+            wmatrix(1,1) = 1.
+            do i=2,ma
+               amatrix(i,1) = 1.
+               amatrix(i,2) = xp(i-1)
+               amatrix(i,3) = yp(i-1)
+   
+               amatrix(i,4) = xp(i-1)**2
+               amatrix(i,5) = xp(i-1) * yp(i-1)
+               amatrix(i,6) = yp(i-1)**2
+   
+               amatrix(i,7) = xp(i-1)**3
+               amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
+               amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
+               amatrix(i,10) = yp(i-1)**3
+   
+               wmatrix(i,i) = 1.

+            end do
+
+         else
+            na = 15
+            ma = ma+1
+  
+            amatrix(1,1) = 1.
+            wmatrix(1,1) = 1.
+            do i=2,ma
+               amatrix(i,1) = 1.
+               amatrix(i,2) = xp(i-1)
+               amatrix(i,3) = yp(i-1)
+   
+               amatrix(i,4) = xp(i-1)**2
+               amatrix(i,5) = xp(i-1) * yp(i-1)
+               amatrix(i,6) = yp(i-1)**2
+   
+               amatrix(i,7) = xp(i-1)**3
+               amatrix(i,8) = yp(i-1) * (xp(i-1)**2)
+               amatrix(i,9) = xp(i-1) * (yp(i-1)**2)
+               amatrix(i,10) = yp(i-1)**3
+   
+               amatrix(i,11) = xp(i-1)**4
+               amatrix(i,12) = yp(i-1) * (xp(i-1)**3)
+               amatrix(i,13) = (xp(i-1)**2)*(yp(i-1)**2)
+               amatrix(i,14) = xp(i-1) * (yp(i-1)**3)
+               amatrix(i,15) = yp(i-1)**4
+   
+               wmatrix(i,i) = 1.
+  
+            end do

+            do i=1,mw
+               wmatrix(i,i) = 1.
+            end do

+         end if

+         call sw_poly_fit_2( amatrix, bmatrix, wmatrix, ma, na, 25 )
+
+         do i=1,grid % nEdgesOnCell % array (iCell)
+            ip1 = i+1
+            if (ip1 &gt; n-1) ip1 = 1
+  
+            iEdge = grid % EdgesOnCell % array (i,iCell)
+            xv1 = grid % xVertex % array(grid % verticesOnEdge % array (1,iedge))/a
+            yv1 = grid % yVertex % array(grid % verticesOnEdge % array (1,iedge))/a
+            zv1 = grid % zVertex % array(grid % verticesOnEdge % array (1,iedge))/a
+            xv2 = grid % xVertex % array(grid % verticesOnEdge % array (2,iedge))/a
+            yv2 = grid % yVertex % array(grid % verticesOnEdge % array (2,iedge))/a
+            zv2 = grid % zVertex % array(grid % verticesOnEdge % array (2,iedge))/a
+  
+            if ( grid % on_a_sphere ) then
+               call sw_arc_bisect( xv1, yv1, zv1,  &amp;
+                                xv2, yv2, zv2,  &amp;
+                                xec, yec, zec   )
+  
+               thetae_tmp = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
+                                          xc(i+1), yc(i+1), zc(i+1),  &amp;
+                                          xec,     yec,     zec       )
+               thetae_tmp = thetae_tmp + thetat(i)
+               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
+                  thetae(1,grid % EdgesOnCell % array (i,iCell)) = thetae_tmp
+               else
+                  thetae(2,grid % EdgesOnCell % array (i,iCell)) = thetae_tmp
+               end if
+!            else
+!
+!               xe(grid % EdgesOnCell % array (i,iCell)) = 0.5 * (xv1 + xv2)
+!               ye(grid % EdgesOnCell % array (i,iCell)) = 0.5 * (yv1 + yv2)
+
+            end if
+  
+         end do
+
+!  fill second derivative stencil for rk advection 
+
+         do i=1, grid % nEdgesOnCell % array (iCell)
+            iEdge = grid % EdgesOnCell % array (i,iCell)
+  
+  
+            if ( grid % on_a_sphere ) then
+               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
+  
+                  cos2t = cos(thetae(1,grid % EdgesOnCell % array (i,iCell)))
+                  sin2t = sin(thetae(1,grid % EdgesOnCell % array (i,iCell)))
+                  costsint = cos2t*sin2t
+                  cos2t = cos2t**2
+                  sin2t = sin2t**2
+   
+                  do j=1,n
+                     deriv_two(j,1,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
+                                            + 2.*costsint*bmatrix(5,j)  &amp;
+                                            + 2.*sin2t*bmatrix(6,j)
+                  end do
+               else
+     
+                  cos2t = cos(thetae(2,grid % EdgesOnCell % array (i,iCell)))
+                  sin2t = sin(thetae(2,grid % EdgesOnCell % array (i,iCell)))
+                  costsint = cos2t*sin2t
+                  cos2t = cos2t**2
+                  sin2t = sin2t**2
+      
+                  do j=1,n
+                     deriv_two(j,2,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
+                                            + 2.*costsint*bmatrix(5,j)  &amp;
+                                            + 2.*sin2t*bmatrix(6,j)
+                  end do
+               end if
+
+            else
+
+               cos2t = cos(angle_2d(i))
+               sin2t = sin(angle_2d(i))
+               costsint = cos2t*sin2t
+               cos2t = cos2t**2
+               sin2t = sin2t**2
+
+!               do j=1,n
+!
+!                  deriv_two(j,1,iEdge) =   2.*xe(iEdge)*xe(iEdge)*bmatrix(4,j)  &amp;
+!                                         + 2.*xe(iEdge)*ye(iEdge)*bmatrix(5,j)  &amp;
+!                                         + 2.*ye(iEdge)*ye(iEdge)*bmatrix(6,j)
+!               end do
+
+               if (iCell == grid % cellsOnEdge % array(1,iEdge)) then
+                  do j=1,n
+                     deriv_two(j,1,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
+                                            + 2.*costsint*bmatrix(5,j)  &amp;
+                                            + 2.*sin2t*bmatrix(6,j)
+                  end do
+               else
+                  do j=1,n
+                     deriv_two(j,2,iEdge) =   2.*cos2t*bmatrix(4,j)  &amp;
+                                            + 2.*costsint*bmatrix(5,j)  &amp;
+                                            + 2.*sin2t*bmatrix(6,j)
+                  end do
+               end if
+
+            end if
+         end do

+      end do ! end of loop over cells
+
+      if (debug) stop
+
+
+!      write(0,*) ' check for deriv2 coefficients, iEdge 4 '
+!
+!      iEdge = 4
+!      j = 1
+!      iCell = grid % cellsOnEdge % array(1,iEdge)
+!      write(0,*) ' j, icell, coef ',j,iCell,deriv_two(j,1,iEdge)
+!      do j=2,7
+!         write(0,*) ' j, icell, coef ',j,grid % CellsOnCell % array(j-1,iCell),deriv_two(j,1,iEdge)
+!      end do
+!
+!      j = 1
+!      iCell = grid % cellsOnEdge % array(2,iEdge)
+!      write(0,*) ' j, icell, coef ',j,iCell,deriv_two(j,2,iEdge)
+!      do j=2,7
+!         write(0,*) ' j, icell, coef ',j,grid % CellsOnCell % array(j-1,iCell),deriv_two(j,2,iEdge)
+!      end do
+!      stop
+
+   end subroutine sw_initialize_advection_rk
+
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! FUNCTION SPHERE_ANGLE
+   !
+   ! Computes the angle between arcs AB and AC, given points A, B, and C
+   ! Equation numbers w.r.t. http://mathworld.wolfram.com/SphericalTrigonometry.html
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   real function sphere_angle(ax, ay, az, bx, by, bz, cx, cy, cz)
+   
+      implicit none
+   
+      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz, cx, cy, cz
+   
+      real (kind=RKIND) :: a, b, c          ! Side lengths of spherical triangle ABC
+   
+      real (kind=RKIND) :: ABx, ABy, ABz    ! The components of the vector AB
+      real (kind=RKIND) :: mAB              ! The magnitude of AB
+      real (kind=RKIND) :: ACx, ACy, ACz    ! The components of the vector AC
+      real (kind=RKIND) :: mAC              ! The magnitude of AC
+   
+      real (kind=RKIND) :: Dx               ! The i-components of the cross product AB x AC
+      real (kind=RKIND) :: Dy               ! The j-components of the cross product AB x AC
+      real (kind=RKIND) :: Dz               ! The k-components of the cross product AB x AC
+   
+      real (kind=RKIND) :: s                ! Semiperimeter of the triangle
+      real (kind=RKIND) :: sin_angle
+   
+      a = acos(max(min(bx*cx + by*cy + bz*cz,1.0),-1.0))      ! Eqn. (3)
+      b = acos(max(min(ax*cx + ay*cy + az*cz,1.0),-1.0))      ! Eqn. (2)
+      c = acos(max(min(ax*bx + ay*by + az*bz,1.0),-1.0))      ! Eqn. (1)
+   
+      ABx = bx - ax
+      ABy = by - ay
+      ABz = bz - az
+   
+      ACx = cx - ax
+      ACy = cy - ay
+      ACz = cz - az
+   
+      Dx =   (ABy * ACz) - (ABz * ACy)
+      Dy = -((ABx * ACz) - (ABz * ACx))
+      Dz =   (ABx * ACy) - (ABy * ACx)
+   
+      s = 0.5*(a + b + c)
+!      sin_angle = sqrt((sin(s-b)*sin(s-c))/(sin(b)*sin(c)))   ! Eqn. (28)
+      sin_angle = sqrt(min(1.,max(0.,(sin(s-b)*sin(s-c))/(sin(b)*sin(c)))))   ! Eqn. (28)
+   
+      if ((Dx*ax + Dy*ay + Dz*az) &gt;= 0.0) then
+         sphere_angle =  2.0 * asin(max(min(sin_angle,1.0),-1.0))
+      else
+         sphere_angle = -2.0 * asin(max(min(sin_angle,1.0),-1.0))
+      end if
+   
+   end function sphere_angle
+   
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! FUNCTION PLANE_ANGLE
+   !
+   ! Computes the angle between vectors AB and AC, given points A, B, and C, and
+   !   a vector (u,v,w) normal to the plane.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   real function plane_angle(ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w)
+   
+      implicit none
+   
+      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz, cx, cy, cz, u, v, w
+   
+      real (kind=RKIND) :: ABx, ABy, ABz    ! The components of the vector AB
+      real (kind=RKIND) :: mAB              ! The magnitude of AB
+      real (kind=RKIND) :: ACx, ACy, ACz    ! The components of the vector AC
+      real (kind=RKIND) :: mAC              ! The magnitude of AC
+   
+      real (kind=RKIND) :: Dx               ! The i-components of the cross product AB x AC
+      real (kind=RKIND) :: Dy               ! The j-components of the cross product AB x AC
+      real (kind=RKIND) :: Dz               ! The k-components of the cross product AB x AC
+   
+      real (kind=RKIND) :: cos_angle
+   
+      ABx = bx - ax
+      ABy = by - ay
+      ABz = bz - az
+      mAB = sqrt(ABx**2.0 + ABy**2.0 + ABz**2.0)
+   
+      ACx = cx - ax
+      ACy = cy - ay
+      ACz = cz - az
+      mAC = sqrt(ACx**2.0 + ACy**2.0 + ACz**2.0)
+   
+   
+      Dx =   (ABy * ACz) - (ABz * ACy)
+      Dy = -((ABx * ACz) - (ABz * ACx))
+      Dz =   (ABx * ACy) - (ABy * ACx)
+   
+      cos_angle = (ABx*ACx + ABy*ACy + ABz*ACz) / (mAB * mAC)
+   
+      if ((Dx*u + Dy*v + Dz*w) &gt;= 0.0) then
+         plane_angle =  acos(max(min(cos_angle,1.0),-1.0))
+      else
+         plane_angle = -acos(max(min(cos_angle,1.0),-1.0))
+      end if
+   
+   end function plane_angle
+
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! FUNCTION ARC_LENGTH
+   !
+   ! Returns the length of the great circle arc from A=(ax, ay, az) to 
+   !    B=(bx, by, bz). It is assumed that both A and B lie on the surface of the
+   !    same sphere centered at the origin.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   real function arc_length(ax, ay, az, bx, by, bz)
+   
+      implicit none
+   
+      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz
+   
+      real (kind=RKIND) :: r, c
+      real (kind=RKIND) :: cx, cy, cz
+   
+      cx = bx - ax
+      cy = by - ay
+      cz = bz - az
+
+!      r = ax*ax + ay*ay + az*az
+!      c = cx*cx + cy*cy + cz*cz
+!
+!      arc_length = sqrt(r) * acos(1.0 - c/(2.0*r))
+
+      r = sqrt(ax*ax + ay*ay + az*az)
+      c = sqrt(cx*cx + cy*cy + cz*cz)
+!      arc_length = sqrt(r) * 2.0 * asin(c/(2.0*r))
+      arc_length = r * 2.0 * asin(c/(2.0*r))
+
+   end function arc_length
+   
+   
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! subroutine sw_arc_bisect
+   !
+   ! Returns the point C=(cx, cy, cz) that bisects the great circle arc from
+   !   A=(ax, ay, az) to B=(bx, by, bz). It is assumed that A and B lie on the
+   !   surface of a sphere centered at the origin.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   subroutine sw_arc_bisect(ax, ay, az, bx, by, bz, cx, cy, cz)
+   
+      implicit none
+   
+      real (kind=RKIND), intent(in) :: ax, ay, az, bx, by, bz
+      real (kind=RKIND), intent(out) :: cx, cy, cz
+   
+      real (kind=RKIND) :: r           ! Radius of the sphere
+      real (kind=RKIND) :: d           
+   
+      r = sqrt(ax*ax + ay*ay + az*az)
+   
+      cx = 0.5*(ax + bx)
+      cy = 0.5*(ay + by)
+      cz = 0.5*(az + bz)
+   
+      if (cx == 0. .and. cy == 0. .and. cz == 0.) then
+         write(0,*) 'Error: arc_bisect: A and B are diametrically opposite'
+      else
+         d = sqrt(cx*cx + cy*cy + cz*cz)
+         cx = r * cx / d
+         cy = r * cy / d
+         cz = r * cz / d
+      end if
+   
+   end subroutine sw_arc_bisect
+
+
+   subroutine sw_poly_fit_2(a_in,b_out,weights_in,m,n,ne)
+
+      implicit none
+
+      integer, intent(in) :: m,n,ne
+      real (kind=RKIND), dimension(ne,ne), intent(in) :: a_in, weights_in
+      real (kind=RKIND), dimension(ne,ne), intent(out) :: b_out
+   
+      ! local storage
+   
+      real (kind=RKIND), dimension(m,n)  :: a
+      real (kind=RKIND), dimension(n,m)  :: b
+      real (kind=RKIND), dimension(m,m)  :: w,wt,h
+      real (kind=RKIND), dimension(n,m)  :: at, ath
+      real (kind=RKIND), dimension(n,n)  :: ata, ata_inv, atha, atha_inv
+      integer, dimension(n) :: indx
+      integer :: i,j
+   
+      if ( (ne&lt;n) .or. (ne&lt;m) ) then
+         write(6,*) ' error in poly_fit_2 inversion ',m,n,ne
+         stop
+      end if
+   
+!      a(1:m,1:n) = a_in(1:n,1:m) 
+      a(1:m,1:n) = a_in(1:m,1:n)
+      w(1:m,1:m) = weights_in(1:m,1:m) 
+      b_out(:,:) = 0.   
+
+      wt = transpose(w)
+      h = matmul(wt,w)
+      at = transpose(a)
+      ath = matmul(at,h)
+      atha = matmul(ath,a)
+      
+      ata = matmul(at,a)
+
+!      if (m == n) then
+!         call sw_migs(a,n,b,indx)
+!      else
+
+         call sw_migs(atha,n,atha_inv,indx)
+
+         b = matmul(atha_inv,ath)
+
+!         call sw_migs(ata,n,ata_inv,indx)
+!         b = matmul(ata_inv,at)
+!      end if
+      b_out(1:n,1:m) = b(1:n,1:m)
+
+!     do i=1,n
+!        write(6,*) ' i, indx ',i,indx(i)
+!     end do
+!
+!     write(6,*) ' '
+
+   end subroutine sw_poly_fit_2
+
+
+! Updated 10/24/2001.
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!   Program 4.4   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!                                                                       !
+! Please Note:                                                          !
+!                                                                       !
+! (1) This computer program is written by Tao Pang in conjunction with  !
+!     his book, &quot;An Introduction to Computational Physics,&quot; published   !
+!     by Cambridge University Press in 1997.                            !
+!                                                                       !
+! (2) No warranties, express or implied, are made for this program.     !
+!                                                                       !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+subroutine sw_migs (A,N,X,INDX)
+!
+! subroutine to invert matrix A(N,N) with the inverse stored
+! in X(N,N) in the output.  Copyright (c) Tao Pang 2001.
+!
+  IMPLICIT NONE
+  INTEGER, INTENT (IN) :: N
+  INTEGER :: I,J,K
+  INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
+  REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N):: A
+  REAL (kind=RKIND), INTENT (OUT), DIMENSION (N,N):: X
+  REAL (kind=RKIND), DIMENSION (N,N) :: B
+!
+  DO I = 1, N
+    DO J = 1, N
+      B(I,J) = 0.0
+    END DO
+  END DO
+  DO I = 1, N
+    B(I,I) = 1.0
+  END DO
+!
+  call sw_elgs (A,N,INDX)
+!
+  DO I = 1, N-1
+    DO J = I+1, N
+      DO K = 1, N
+        B(INDX(J),K) = B(INDX(J),K)-A(INDX(J),I)*B(INDX(I),K)
+      END DO
+    END DO
+  END DO
+!
+  DO I = 1, N
+    X(N,I) = B(INDX(N),I)/A(INDX(N),N)
+    DO J = N-1, 1, -1
+      X(J,I) = B(INDX(J),I)
+      DO K = J+1, N
+        X(J,I) = X(J,I)-A(INDX(J),K)*X(K,I)
+      END DO
+      X(J,I) =  X(J,I)/A(INDX(J),J)
+    END DO
+  END DO
+end subroutine sw_migs
+
+
+subroutine sw_elgs (A,N,INDX)
+!
+! subroutine to perform the partial-pivoting Gaussian elimination.
+! A(N,N) is the original matrix in the input and transformed matrix
+! plus the pivoting element ratios below the diagonal in the output.
+! INDX(N) records the pivoting order.  Copyright (c) Tao Pang 2001.
+!
+  IMPLICIT NONE
+  INTEGER, INTENT (IN) :: N
+  INTEGER :: I,J,K,ITMP
+  INTEGER, INTENT (OUT), DIMENSION (N) :: INDX
+  REAL (kind=RKIND) :: C1,PI,PI1,PJ
+  REAL (kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
+  REAL (kind=RKIND), DIMENSION (N) :: C
+!
+! Initialize the index
+!
+  DO I = 1, N
+    INDX(I) = I
+  END DO
+!
+! Find the rescaling factors, one from each row
+!
+  DO I = 1, N
+    C1= 0.0
+    DO J = 1, N
+      C1 = MAX(C1,ABS(A(I,J)))
+    END DO
+    C(I) = C1
+  END DO
+!
+! Search the pivoting (largest) element from each column
+!
+  DO J = 1, N-1
+    PI1 = 0.0
+    DO I = J, N
+      PI = ABS(A(INDX(I),J))/C(INDX(I))
+      IF (PI.GT.PI1) THEN
+        PI1 = PI
+        K   = I
+      ENDIF
+    END DO
+!
+! Interchange the rows via INDX(N) to record pivoting order
+!
+    ITMP    = INDX(J)
+    INDX(J) = INDX(K)
+    INDX(K) = ITMP
+    DO I = J+1, N
+      PJ  = A(INDX(I),J)/A(INDX(J),J)
+!
+! Record pivoting ratios below the diagonal
+!
+      A(INDX(I),J) = PJ
+!
+! Modify other elements accordingly
+!
+      DO K = J+1, N
+        A(INDX(I),K) = A(INDX(I),K)-PJ*A(INDX(J),K)
+      END DO
+    END DO
+  END DO
+!
+end subroutine sw_elgs
+
+!-------------------------------------------------------------
+
+   subroutine sw_initialize_deformation_weights( grid )
+                                      
+!
+! compute the cell coefficients for the deformation calculations
+! WCS, 13 July 2010
+!
+      implicit none
+
+      type (mesh_type), intent(in) :: grid
+
+      real (kind=RKIND), dimension(:,:), pointer :: defc_a, defc_b
+      integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
+
+!  local variables
+
+      real (kind=RKIND), dimension(2, grid % nEdges) :: thetae
+      real (kind=RKIND), dimension(grid % nEdges) :: xe, ye
+      real (kind=RKIND), dimension(grid % nCells) :: theta_abs
+
+      real (kind=RKIND), dimension(25) :: xc, yc, zc ! cell center coordinates
+      real (kind=RKIND), dimension(25) :: thetav, thetat, dl_sphere
+      real (kind=RKIND) :: xm, ym, zm, dl, xec, yec, zec
+      real (kind=RKIND) :: thetae_tmp, xe_tmp, ye_tmp
+      real (kind=RKIND) :: xv1, xv2, yv1, yv2, zv1, zv2
+      integer :: i, j, k, ip1, ip2, m, n, ip1a, ii
+      integer :: iCell, iEdge
+      real (kind=RKIND) :: pii
+      real (kind=RKIND) :: x0, y0, x1, y1, x2, y2, x3, y3, x4, y4, x5, y5
+      real (kind=RKIND) :: pdx1, pdx2, pdx3, pdy1, pdy2, pdy3, dx1, dx2, dy1, dy2
+      real (kind=RKIND) :: angv1, angv2, dl1, dl2
+      real (kind=RKIND), dimension(25) :: dxe, dye, x2v, y2v, xp, yp, xpt, ypt
+      
+      real (kind=RKIND) :: length_scale
+      integer :: ma,na, cell_add, mw, nn
+      integer, dimension(25) :: cell_list
+
+      integer :: cell1, cell2, iv
+      logical :: do_the_cell
+      real (kind=RKIND) :: area_cell, sint2, cost2, sint_cost, sumw1, sumw2, xptt, area_cellt
+
+      logical, parameter :: debug = .false.
+
+      if (debug) write(0,*) ' in def weight calc '
+
+      defc_a =&gt; grid % defc_a % array
+      defc_b =&gt; grid % defc_b % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      edgesOnCell =&gt; grid % edgesOnCell % array
+
+      defc_a(:,:) = 0.
+      defc_b(:,:) = 0.
+
+      pii = 2.*asin(1.0)
+
+      if (debug) write(0,*) ' beginning cell loop '
+
+      do iCell = 1, grid % nCells
+
+         if (debug) write(0,*) ' cell loop ', iCell
+
+         cell_list(1) = iCell
+         do i=2, grid % nEdgesOnCell % array(iCell)+1
+            cell_list(i) = grid % CellsOnCell % array(i-1,iCell)
+         end do
+         n = grid % nEdgesOnCell % array(iCell) + 1
+
+!  check to see if we are reaching outside the halo
+
+         if (debug) write(0,*) ' points ', n
+
+         do_the_cell = .true.
+         do i=1,n
+            if (cell_list(i) &gt; grid % nCells) do_the_cell = .false.
+         end do
+
+
+         if (.not. do_the_cell) cycle
+
+
+!  compute poynomial fit for this cell if all needed neighbors exist
+         if (grid % on_a_sphere) then
+
+            xc(1) = grid % xCell % array(iCell)/a
+            yc(1) = grid % yCell % array(iCell)/a
+            zc(1) = grid % zCell % array(iCell)/a
+
+
+            do i=2,n
+               iv = grid % verticesOnCell % array(i-1,iCell)
+               xc(i) = grid % xVertex % array(iv)/a
+               yc(i) = grid % yVertex % array(iv)/a
+               zc(i) = grid % zVertex % array(iv)/a
+            end do
+
+            theta_abs(iCell) =  pii/2. - sphere_angle( xc(1), yc(1), zc(1),  &amp;
+                                                       xc(2), yc(2), zc(2),  &amp;
+                                                       0.,    0.,    1.      ) 
+
+! angles from cell center to neighbor centers (thetav)
+
+            do i=1,n-1
+   
+               ip2 = i+2
+               if (ip2 &gt; n) ip2 = 2
+    
+               thetav(i) = sphere_angle( xc(1),   yc(1),   zc(1),    &amp;
+                                         xc(i+1), yc(i+1), zc(i+1),  &amp;
+                                         xc(ip2), yc(ip2), zc(ip2)   )
+
+               dl_sphere(i) = a*arc_length( xc(1),   yc(1),   zc(1),  &amp;
+                                            xc(i+1), yc(i+1), zc(i+1) )
+            end do
+
+            length_scale = 1.
+            do i=1,n-1
+               dl_sphere(i) = dl_sphere(i)/length_scale
+            end do
+
+            thetat(1) = 0.  !  this defines the x direction, cell center 1 -&gt; 
+!            thetat(1) = theta_abs(iCell)  !  this defines the x direction, longitude line
+            do i=2,n-1
+               thetat(i) = thetat(i-1) + thetav(i-1)
+            end do
+   
+            do i=1,n-1
+               xp(i) = cos(thetat(i)) * dl_sphere(i)
+               yp(i) = sin(thetat(i)) * dl_sphere(i)
+            end do
+
+         else     ! On an x-y plane
+
+            xp(1) = grid % xCell % array(iCell)
+            yp(1) = grid % yCell % array(iCell)
+
+
+            do i=2,n
+               iv = grid % verticesOnCell % array(i-1,iCell)
+               xp(i) = grid % xVertex % array(iv)
+               yp(i) = grid % yVertex % array(iv)
+            end do
+
+         end if
+
+!         thetat(1) = 0.
+         thetat(1) = theta_abs(iCell)
+         do i=2,n-1
+            ip1 = i+1
+            if (ip1 == n) ip1 = 1
+            thetat(i) = plane_angle( 0.,0.,0.,  &amp;
+                                     xp(i)-xp(i-1), yp(i)-yp(i-1), 0.,  &amp;
+                                     xp(ip1)-xp(i), yp(ip1)-yp(i), 0.,  &amp;
+                                     0., 0., 1.)
+            thetat(i) = thetat(i) + thetat(i-1)
+         end do
+
+         area_cell = 0.
+         area_cellt = 0.
+         do i=1,n-1
+            ip1 = i+1
+            if (ip1 == n) ip1 = 1
+            dl = sqrt((xp(ip1)-xp(i))**2 + (yp(ip1)-yp(i))**2)
+            area_cell = area_cell + 0.25*(xp(i)+xp(ip1))*(yp(ip1)-yp(i)) - 0.25*(yp(i)+yp(ip1))*(xp(ip1)-xp(i))
+            area_cellt = area_cellt + (0.25*(xp(i)+xp(ip1))*cos(thetat(i)) + 0.25*(yp(i)+yp(ip1))*sin(thetat(i)))*dl
+         end do
+         if (debug) write(0,*) ' area_cell, area_cellt ',area_cell, area_cellt,area_cell-area_cellt
+
+         do i=1,n-1
+            ip1 = i+1
+            if (ip1 == n) ip1 = 1
+            dl = sqrt((xp(ip1)-xp(i))**2 + (yp(ip1)-yp(i))**2)
+            sint2 = (sin(thetat(i)))**2
+            cost2 = (cos(thetat(i)))**2
+            sint_cost = sin(thetat(i))*cos(thetat(i))
+            defc_a(i,iCell) = dl*(cost2 - sint2)/area_cell
+            defc_b(i,iCell) = dl*2.*sint_cost/area_cell
+            if (cellsOnEdge(1,EdgesOnCell(i,iCell)) /= iCell) then
+               defc_a(i,iCell) = - defc_a(i,iCell)
+               defc_b(i,iCell) = - defc_b(i,iCell)
+            end if

+         end do
+
+      end do
+
+      if (debug) write(0,*) ' exiting def weight calc '
+
+   end subroutine sw_initialize_deformation_weights
+
+end module sw_advection

Copied: branches/source_condensing/src/core_sw/mpas_sw_global_diagnostics.F (from rev 1114, trunk/mpas/src/core_sw/mpas_sw_global_diagnostics.F)
===================================================================
--- branches/source_condensing/src/core_sw/mpas_sw_global_diagnostics.F                                (rev 0)
+++ branches/source_condensing/src/core_sw/mpas_sw_global_diagnostics.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,384 @@
+module sw_global_diagnostics
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+   use mpas_dmpar
+
+   implicit none
+   save
+   public
+
+   contains
+
+   subroutine sw_compute_global_diagnostics(dminfo, state, grid, timeIndex, dt)
+
+      ! Note: this routine assumes that there is only one block per processor. No looping
+      ! is preformed over blocks.
+      ! dminfo is the domain info needed for global communication
+      ! state contains the state variables needed to compute global diagnostics
+      ! grid conains the meta data about the grid
+      ! timeIndex is the current time step counter
+      ! dt is the duration of each time step
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !                            INSTRUCTIONS                               !
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ! To add a new Diagnostic as a Global Stat, follow these steps.
+      ! 1. Define the array to integrate, and the variable for the value above.
+      ! 2. Allocate the array with the correct dimensions.
+      ! 3. Fill the array with the data to be integrated.
+      !     eg. GlobalFluidThickness = Sum(h dA)/Sum(dA), See below for array filling
+      ! 4. Call Function to compute Global Stat that you want.
+      ! 5. Finish computing the global stat/integral
+      ! 6. Write out your global stat to the file
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      type (state_type), intent(inout) :: state
+      type (mesh_type), intent(in) :: grid
+      integer, intent(in) :: timeIndex
+      real (kind=RKIND), intent(in) :: dt
+
+      integer :: nVertLevels, nCellsSolve, nEdgesSolve, nVerticesSolve, nCellsGlobal, nEdgesGlobal, nVerticesGlobal, iTracer
+      integer :: nCells
+
+      ! Step 1
+      ! 1. Define the array to integrate, and the variable for the value to be stored in after the integration
+      real (kind=RKIND), dimension(:), pointer ::  areaCell, dcEdge, dvEdge, areaTriangle, h_s, fCell, fEdge
+      real (kind=RKIND), dimension(:,:), pointer :: h, u, v, h_edge, pv_edge, pv_vertex, pv_cell, h_vertex, weightsOnEdge
+
+      real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+
+      real (kind=RKIND), dimension(:), allocatable :: volumeWeightedPotentialEnergyReservoir, averageThickness
+      real (kind=RKIND), dimension(:), allocatable :: potentialEnstrophyReservior, areaEdge, h_s_edge
+
+      real (kind=RKIND), dimension(:,:), allocatable :: cellVolume, cellArea, volumeWeightedPotentialVorticity
+      real (kind=RKIND), dimension(:,:), allocatable :: volumeWeightedPotentialEnstrophy, vertexVolume, volumeWeightedKineticEnergy 
+      real (kind=RKIND), dimension(:,:), allocatable :: volumeWeightedPotentialEnergy, volumeWeightedPotentialEnergyTopography 
+      real (kind=RKIND), dimension(:,:), allocatable :: keTend_CoriolisForce, keTend_PressureGradient 
+      real (kind=RKIND), dimension(:,:), allocatable ::peTend_DivThickness, refAreaWeightedSurfaceHeight, refAreaWeightedSurfaceHeight_edge
+
+      real (kind=RKIND) :: sumCellVolume, sumCellArea, sumVertexVolume, sumrefAreaWeightedSurfaceHeight
+
+      real (kind=RKIND) :: globalFluidThickness, globalPotentialVorticity, globalPotentialEnstrophy, globalEnergy 
+      real (kind=RKIND) :: globalCoriolisEnergyTendency, globalKEPETendency, globalPotentialEnstrophyReservoir 
+      real (kind=RKIND) :: globalKineticEnergy, globalPotentialEnergy, globalPotentialEnergyReservoir
+      real (kind=RKIND) :: globalKineticEnergyTendency, globalPotentialEnergyTendency
+      real (kind=RKIND) ::  global_temp, workpv, q
+      real (kind=RKIND) :: volumeCellGlobal, volumeEdgeGlobal, CFLNumberGlobal
+
+      integer :: elementIndex, variableIndex, nVariables, nSums, nMaxes, nMins
+      integer :: timeLevel, eoe, iLevel, iCell, iEdge, iVertex
+      integer :: fileID, iCell1, iCell2, j
+
+      integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell, edgesOnEdge
+      integer, dimension(:), pointer :: nEdgesOnEdge
+      
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      edgesOnCell =&gt; grid % edgesOnCell % array
+
+      nVertLevels = grid % nVertLevels
+      nCellsSolve = grid % nCellsSolve
+      nEdgesSolve = grid % nEdgesSolve
+      nVerticesSolve = grid % nVerticesSolve
+      nCells = grid % nCells
+
+      h_s =&gt; grid % h_s % array
+      areaCell =&gt; grid % areaCell % array
+      dcEdge =&gt; grid % dcEdge % array
+      dvEdge =&gt; grid % dvEdge % array
+      areaTriangle =&gt; grid % areaTriangle % array
+      fCell =&gt; grid % fCell % array
+      fEdge =&gt; grid % fEdge % array
+      edgesOnEdge       =&gt; grid % edgesOnEdge % array
+      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
+
+      allocate(areaEdge(1:nEdgesSolve))
+      areaEdge = dcEdge(1:nEdgesSolve)*dvEdge(1:nEdgesSolve)
+      weightsOnEdge     =&gt; grid % weightsOnEdge % array
+
+      h =&gt; state % h % array
+      u =&gt; state % u % array
+      v =&gt; state % v % array
+      tracers =&gt; state % tracers % array
+      h_edge =&gt; state % h_edge % array
+      h_vertex =&gt; state % h_vertex % array
+      pv_edge =&gt; state % pv_edge % array
+      pv_vertex =&gt; state % pv_vertex % array
+      pv_cell =&gt; state % pv_cell % array
+
+      ! Step 2
+      ! 2. Allocate the array with the correct dimensions.
+      allocate(cellVolume(nVertLevels,nCellsSolve))
+      allocate(cellArea(nVertLevels,nCellsSolve))
+      allocate(refAreaWeightedSurfaceHeight(nVertLevels,nCellsSolve))
+      allocate(refAreaWeightedSurfaceHeight_edge(nVertLevels,nEdgesSolve))
+      allocate(volumeWeightedPotentialVorticity(nVertLevels,nVerticesSolve))
+      allocate(volumeWeightedPotentialEnstrophy(nVertLevels,nVerticesSolve))
+      allocate(potentialEnstrophyReservior(nCellsSolve))
+      allocate(vertexVolume(nVertLevels,nVerticesSolve))
+      allocate(volumeWeightedKineticEnergy(nVertLevels,nEdgesSolve))
+      allocate(volumeWeightedPotentialEnergy(nVertLevels,nCellsSolve))
+      allocate(volumeWeightedPotentialEnergyTopography(nVertLevels,nCellsSolve))
+      allocate(volumeWeightedPotentialEnergyReservoir(nCellsSolve))
+      allocate(keTend_CoriolisForce(nVertLevels,nEdgesSolve))
+      allocate(keTend_PressureGradient(nVertLevels,nEdgesSolve))
+      allocate(peTend_DivThickness(nVertLevels,nCells))
+
+      allocate(averageThickness(nCellsSolve))
+
+      allocate(h_s_edge(nEdgesSOlve))
+
+
+      cellVolume = 0
+      refAreaWeightedSurfaceHeight = 0
+      refAreaWeightedSurfaceHeight_edge = 0
+      vertexVolume = 0
+      cellArea = 0
+      averageThickness = 0
+      volumeWeightedPotentialVorticity = 0
+      volumeWeightedPotentialEnstrophy = 0
+      volumeWeightedKineticEnergy = 0
+      volumeWeightedPotentialEnergy = 0
+      volumeWeightedPotentialEnergyTopography = 0
+      volumeWeightedPotentialEnergyReservoir = 0
+      keTend_PressureGradient = 0
+      peTend_DivThickness = 0
+      keTend_CoriolisForce = 0
+      h_s_edge = 0
+
+      ! Build Arrays for Global Integrals
+      ! Step 3
+      ! 3. Fill the array with the data to be integrated.
+      !     eg. GlobalFluidThickness = Sum(h dA)/Sum(dA), See below for array filling
+      do iLevel = 1,nVertLevels
+        ! eg. GlobalFluidThickness top (Sum( h dA)) = Sum(cellVolume)
+        cellVolume(iLevel,:) = h(iLevel,1:nCellsSolve)*areaCell(1:nCellsSolve)
+        ! eg. GlobalFluidThickness bot (Sum(dA)) = Sum(cellArea)
+        cellArea(iLevel,:) = areaCell(1:nCellsSolve)
+        volumeWeightedPotentialVorticity(iLevel,:) = pv_vertex(iLevel,1:nVerticesSolve) &amp;
+                *h_vertex(iLevel,1:nVerticesSolve)*areaTriangle(1:nVerticesSolve) 
+        volumeWeightedPotentialEnstrophy(iLevel,:) = pv_vertex(iLevel,1:nVerticesSolve) &amp; 
+                *pv_vertex(iLevel,1:nVerticesSolve)*h_vertex(iLevel,1:nVerticesSolve)*areaTriangle(1:nVerticesSolve)
+        vertexVolume(iLevel,:) = h_vertex(iLevel,1:nVerticesSolve)*areaTriangle(1:nVerticesSolve)
+        volumeWeightedKineticEnergy(iLevel,:) = u(iLevel,1:nEdgesSolve)*u(iLevel,1:nEdgesSolve) &amp;
+                *h_edge(iLevel,1:nEdgesSolve)*areaEdge(1:nEdgesSolve)*0.5
+        volumeWeightedPotentialEnergy(iLevel,:) = gravity*h(iLevel,1:nCellsSolve)*h(iLevel,1:nCellsSolve)*areaCell(1:nCellsSolve)*0.5
+        volumeWeightedPotentialEnergyTopography(iLevel,:) = gravity*h(iLevel,1:nCellsSolve)*h_s(1:nCellsSolve)*areaCell(1:nCellsSolve)
+        refAreaWeightedSurfaceHeight(iLevel,:) = areaCell(1:nCellsSolve)*(h(iLevel,1:nCellsSolve)+h_s(1:nCellsSolve))
+
+        do iEdge = 1,nEdgesSolve
+            q = 0.0
+            do j = 1,nEdgesOnEdge(iEdge)
+               eoe = edgesOnEdge(j,iEdge)
+               workpv = 0.5 * (pv_edge(iLevel,iEdge) + pv_edge(iLevel,eoe))
+               q = q + weightsOnEdge(j,iEdge) * u(iLevel,eoe) * workpv * h_edge(iLevel,eoe) 
+            end do
+            keTend_CoriolisForce(iLevel,iEdge) = h_edge(iLevel,iEdge) * u(iLevel,iEdge) * q * areaEdge(iEdge)
+
+            iCell1 = cellsOnEdge(1,iEdge)
+            iCell2 = cellsOnEdge(2,iEdge)
+
+            refAreaWeightedSurfaceHeight_edge(iLevel,iEdge) = areaEdge(iEdge)*(h_edge(iLevel,iEdge) + 0.5*(h_s(iCell1) + h_s(iCell2)))
+
+            keTend_PressureGradient(iLevel,iEdge) = areaEdge(iEdge)*h_edge(iLevel,iEdge)*u(iLevel,iEdge) &amp;
+                        *gravity*(h(iLevel,iCell2)+h_s(iCell2) - h(iLevel,iCell1)-h_s(iCell1))/dcEdge(iEdge)
+            peTend_DivThickness(iLevel,iCell1) = peTend_DivThickness(iLevel,iCell1) &amp;
+                        + h_edge(iLevel,iEdge)*u(iLevel,iEdge)*dvEdge(iEdge)
+            peTend_DivThickness(iLevel,iCell2) = peTend_DivThickness(iLevel,iCell2) &amp;
+                        - h_edge(iLevel,iEdge)*u(iLevel,iEdge)*dvEdge(iEdge)
+        end do
+
+        peTend_DivThickness(iLevel,:) = peTend_DivThickness(iLevel,1:nCells)*gravity &amp;
+                   *(h(iLevel,1:nCells)+h_s(1:nCells))
+      end do
+
+      do iEdge = 1,nEdgesSolve
+          iCell1 = cellsOnEdge(1,iEdge)
+          iCell2 = cellsOnEdge(2,iEdge)
+          
+          h_s_edge(iEdge) = 0.5*(h_s(iCell1) + h_s(iCell2))
+      end do
+
+      ! Step 4
+      ! 4. Call Function to compute Global Stat that you want.
+      ! Computing Kinetic and Potential Energy Tendency Terms
+      call sw_compute_global_sum(dminfo, nVertLevels, nEdgesSolve, keTend_PressureGradient, globalKineticEnergyTendency)
+      call sw_compute_global_sum(dminfo, nVertLevels, nCells, peTend_DivThickness, globalPotentialEnergyTendency)
+
+      ! Computing top and bottom of global mass integral
+      call sw_compute_global_sum(dminfo, nVertLevels, nCellsSolve, cellVolume, sumCellVolume)
+      call sw_compute_global_sum(dminfo, nVertLevels, nCellsSolve, cellArea, sumCellArea)
+
+      globalKineticEnergyTendency = globalKineticEnergyTendency / sumCellVolume
+      globalPotentialEnergyTendency = globalPotentialEnergyTendency / sumCellVolume
+
+      ! Step 5
+      ! 5. Finish computing the global stat/integral
+      globalFluidThickness = sumCellVolume/sumCellArea
+
+      ! Compute Average Sea Surface Height for Potential Energy and Enstrophy
+      ! Reservoir computations
+      call sw_compute_global_sum(dminfo, nVertLevels, nCellsSolve, refAreaWeightedSurfaceHeight, sumrefAreaWeightedSurfaceHeight)
+
+      averageThickness(:) = (sumrefAreaWeightedSurfaceHeight/sumCellArea)-h_s(1:nCellsSolve)
+
+      ! Compute Volume Weighted Averages of Potential Vorticity and Potential Enstrophy
+      call sw_compute_global_sum(dminfo, nVertLevels, nVerticesSolve, volumeWeightedPotentialVorticity, globalPotentialVorticity)
+      call sw_compute_global_sum(dminfo, nVertLevels, nVerticesSolve, volumeWeightedPotentialEnstrophy, globalPotentialEnstrophy)
+      call sw_compute_global_sum(dminfo, nVertLevels, nVerticesSolve, vertexVolume, sumVertexVolume)
+
+      globalPotentialVorticity = globalPotentialVorticity/sumVertexVolume
+      globalPotentialEnstrophy = globalPotentialEnstrophy/sumVertexVolume
+
+      ! Compte Potential Enstrophy Reservior
+      potentialEnstrophyReservior(:) = areaCell(:)*fCell(:)*fCell(:)/averageThickness
+      call sw_compute_global_sum(dminfo, 1, nCellsSolve, potentialEnstrophyReservior, globalPotentialEnstrophyReservoir)
+      globalPotentialEnstrophyReservoir = globalPotentialEnstrophyReservoir/sumCellVolume
+
+      globalPotentialEnstrophy = globalPotentialEnstrophy - globalPotentialEnstrophyReservoir
+
+      ! Compute Kinetic and Potential Energy terms to be combined into total energy
+      call sw_compute_global_sum(dminfo, nVertLevels, nEdgesSolve, volumeWeightedKineticEnergy, globalKineticEnergy)
+      call sw_compute_global_sum(dminfo, nVertLevels, nCellsSolve, volumeWeightedPotentialEnergy, globalPotentialEnergy)
+      call sw_compute_global_sum(dminfo, nVertLevels, nCellsSolve, volumeWeightedPotentialEnergyTopography, global_temp)
+
+      globalKineticEnergy = globalKineticEnergy/sumCellVolume
+      globalPotentialEnergy = (globalPotentialEnergy + global_temp)/sumCellVolume
+
+      ! Compute Potential energy reservoir to be subtracted from potential energy term
+      volumeWeightedPotentialEnergyReservoir(1:nCellsSolve) = areaCell(1:nCellsSolve)*averageThickness*averageThickness*gravity*0.5
+      call sw_compute_global_sum(dminfo, nVertLevels, nCellsSolve, volumeWeightedPotentialEnergyReservoir, globalPotentialEnergyReservoir)
+      volumeWeightedPotentialEnergyReservoir(1:nCellsSolve) = areaCell(1:nCellsSolve)*averageThickness*h_s(1:nCellsSolve)*gravity
+      call sw_compute_global_sum(dminfo, nVertLevels, nCellsSolve, volumeWeightedPotentialEnergyReservoir, global_temp)
+
+      globalPotentialEnergyReservoir = (globalPotentialEnergyReservoir + global_temp)/sumCellVolume
+
+      globalPotentialEnergy = globalPotentialEnergy - globalPotentialEnergyReservoir
+      globalEnergy = globalKineticEnergy + globalPotentialEnergy
+
+      ! Compute Coriolis energy tendency term
+      call sw_compute_global_sum(dminfo, nVertLevels, nEdgesSolve, keTend_CoriolisForce, globalCoriolisEnergyTendency)
+      globalCoriolisEnergyTendency = globalCoriolisEnergyTendency/sumCellVolume
+
+      ! Step 6
+      ! 6. Write out your global stat to the file
+      if (dminfo % my_proc_id == IO_NODE) then
+         fileID = sw_get_free_unit()
+
+         if (timeIndex/config_stats_interval == 1) then
+             open(fileID, file='GlobalIntegrals.txt',STATUS='unknown')
+         else
+             open(fileID, file='GlobalIntegrals.txt',POSITION='append')
+         endif 
+         write(fileID,'(1i0, 100es24.16)') timeIndex, timeIndex*dt, globalFluidThickness, globalPotentialVorticity, globalPotentialEnstrophy, &amp;
+                        globalEnergy, globalCoriolisEnergyTendency, globalKineticEnergyTendency+globalPotentialEnergyTendency, &amp;
+                        globalKineticEnergy, globalPotentialEnergy
+         close(fileID)
+      end if
+
+      deallocate(areaEdge)
+   end subroutine sw_compute_global_diagnostics
+
+   integer function sw_get_free_unit()
+      implicit none
+
+      integer :: index
+      logical :: isOpened
+
+      sw_get_free_unit = 0
+      do index = 1,99
+         if((index /= 5) .and. (index /= 6)) then
+            inquire(unit = index, opened = isOpened)
+            if( .not. isOpened) then
+               sw_get_free_unit = index
+               return
+            end if
+         end if
+      end do
+   end function sw_get_free_unit
+
+   subroutine sw_compute_global_sum(dminfo, nVertLevels, nElements, field, globalSum)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: globalSum
+
+      real (kind=RKIND) :: localSum
+
+      localSum = sum(field)
+      call mpas_dmpar_sum_real(dminfo, localSum, globalSum)
+
+   end subroutine sw_compute_global_sum
+
+   subroutine sw_compute_global_min(dminfo, nVertLevels, nElements, field, globalMin)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: globalMin
+
+      real (kind=RKIND) :: localMin
+
+      localMin = minval(field)
+      call mpas_dmpar_min_real(dminfo, localMin, globalMin)
+
+   end subroutine sw_compute_global_min
+
+   subroutine sw_compute_global_max(dminfo, nVertLevels, nElements, field, globalMax)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: globalMax
+
+      real (kind=RKIND) :: localMax
+
+      localMax = maxval(field)
+      call mpas_dmpar_max_real(dminfo, localMax, globalMax)
+
+   end subroutine sw_compute_global_max
+
+   subroutine compute_global_vert_sum_horiz_min(dminfo, nVertLevels, nElements, field, globalMin)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: globalMin
+
+      real (kind=RKIND) :: localMin
+
+      localMin = minval(sum(field,1))
+      call mpas_dmpar_min_real(dminfo, localMin, globalMin)
+
+   end subroutine compute_global_vert_sum_horiz_min
+
+   subroutine sw_compute_global_vert_sum_horiz_max(dminfo, nVertLevels, nElements, field, globalMax)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nVertLevels, nElements
+      real (kind=RKIND), dimension(nVertLevels, nElements), intent(in) :: field
+      real (kind=RKIND), intent(out) :: globalMax
+
+      real (kind=RKIND) :: localMax
+
+      localMax = maxval(sum(field,1))
+      call mpas_dmpar_max_real(dminfo, localMax, globalMax)
+
+   end subroutine sw_compute_global_vert_sum_horiz_max
+
+end module sw_global_diagnostics

Copied: branches/source_condensing/src/core_sw/mpas_sw_mpas_core.F (from rev 1114, trunk/mpas/src/core_sw/mpas_sw_mpas_core.F)
===================================================================
--- branches/source_condensing/src/core_sw/mpas_sw_mpas_core.F                                (rev 0)
+++ branches/source_condensing/src/core_sw/mpas_sw_mpas_core.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,382 @@
+module mpas_core
+
+   use mpas_framework
+   use mpas_timekeeping
+
+   type (io_output_object) :: restart_obj
+   integer :: restart_frame
+   integer :: current_outfile_frames
+
+   type (MPAS_Clock_type) :: clock
+
+   integer, parameter :: outputAlarmID = 1
+   integer, parameter :: restartAlarmID = 2
+   !integer, parameter :: statsAlarmID = 3
+
+   contains
+
+   subroutine mpas_core_init(domain, startTimeStamp)
+   
+      use mpas_configure
+      use mpas_grid_types
+      use sw_test_cases
+   
+      implicit none
+   
+      type (domain_type), intent(inout) :: domain
+      character(len=*), intent(out) :: startTimeStamp
+   
+      real (kind=RKIND) :: dt
+      type (block_type), pointer :: block
+
+
+      if (.not. config_do_restart) call setup_sw_test_case(domain)
+
+      !
+      ! Initialize core
+      !
+      dt = config_dt
+
+      call simulation_clock_init(domain, dt, startTimeStamp)
+
+      block =&gt; domain % blocklist
+      do while (associated(block))
+         call mpas_init_block(block, block % mesh, dt)
+         block % state % time_levs(1) % state % xtime % scalar = startTimeStamp
+         block =&gt; block % next
+      end do
+
+      restart_frame = 1
+      current_outfile_frames = 0
+
+   end subroutine mpas_core_init
+
+
+   subroutine simulation_clock_init(domain, dt, startTimeStamp)
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+      real (kind=RKIND), intent(in) :: dt
+      character(len=*), intent(out) :: startTimeStamp
+
+      type (MPAS_Time_Type) :: startTime, stopTime, alarmStartTime
+      type (MPAS_TimeInterval_type) :: runDuration, timeStep, alarmTimeStep
+      integer :: ierr
+
+      call mpas_set_time(curr_time=startTime, dateTimeString=config_start_time, ierr=ierr)
+      call mpas_set_timeInterval(timeStep, dt=dt, ierr=ierr)
+
+      if (trim(config_run_duration) /= &quot;none&quot;) then
+         call mpas_set_timeInterval(runDuration, timeString=config_run_duration, ierr=ierr)
+         call mpas_create_clock(clock, startTime=startTime, timeStep=timeStep, runDuration=runDuration, ierr=ierr)
+
+         if (trim(config_stop_time) /= &quot;none&quot;) then
+            call mpas_set_time(curr_time=stopTime, dateTimeString=config_stop_time, ierr=ierr)
+            if(startTime + runduration /= stopTime) then
+               write(0,*) 'Warning: config_run_duration and config_stop_time are inconsitent: using config_run_duration.'
+            end if
+         end if
+      else if (trim(config_stop_time) /= &quot;none&quot;) then
+         call mpas_set_time(curr_time=stopTime, dateTimeString=config_stop_time, ierr=ierr)
+         call mpas_create_clock(clock, startTime=startTime, timeStep=timeStep, stopTime=stopTime, ierr=ierr)
+      else
+          write(0,*) 'Error: Neither config_run_duration nor config_stop_time were specified.'
+          call mpas_dmpar_abort(domain % dminfo)
+      end if
+
+      ! set output alarm
+      call mpas_set_timeInterval(alarmTimeStep, timeString=config_output_interval, ierr=ierr)
+      alarmStartTime = startTime + alarmTimeStep
+      call mpas_add_clock_alarm(clock, outputAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
+
+      ! set restart alarm, if necessary
+      if (trim(config_restart_interval) /= &quot;none&quot;) then
+         call mpas_set_timeInterval(alarmTimeStep, timeString=config_restart_interval, ierr=ierr)
+         alarmStartTime = startTime + alarmTimeStep
+         call mpas_add_clock_alarm(clock, restartAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
+      end if
+
+      !TODO: use this code if we desire to convert config_stats_interval to alarms 
+      !(must also change config_stats_interval type to character) 
+      ! set stats alarm, if necessary
+      !if (trim(config_stats_interval) /= &quot;none&quot;) then      
+      !   call mpas_set_timeInterval(alarmTimeStep, timeString=config_stats_interval, ierr=ierr)
+      !   alarmStartTime = startTime + alarmTimeStep
+      !   call mpas_add_clock_alarm(clock, statsAlarmID, alarmStartTime, alarmTimeStep, ierr=ierr)
+      !end if
+
+      call mpas_get_time(curr_time=startTime, dateTimeString=startTimeStamp, ierr=ierr)
+
+   end subroutine simulation_clock_init
+
+
+   subroutine mpas_init_block(block, mesh, dt)
+   
+      use mpas_grid_types
+      use sw_time_integration
+      use mpas_rbf_interpolation
+      use mpas_vector_reconstruction
+   
+      implicit none
+   
+      type (block_type), intent(inout) :: block
+      type (mesh_type), intent(inout) :: mesh
+      real (kind=RKIND), intent(in) :: dt
+   
+
+      call sw_compute_solve_diagnostics(dt, block % state % time_levs(1) % state, mesh)
+      call compute_mesh_scaling(mesh) 
+
+      call mpas_rbf_interp_initialize(mesh)
+      call mpas_init_reconstruct(mesh)
+      call mpas_reconstruct(mesh, block % state % time_levs(1) % state % u % array,                  &amp;
+                       block % state % time_levs(1) % state % uReconstructX % array,            &amp;
+                       block % state % time_levs(1) % state % uReconstructY % array,            &amp;
+                       block % state % time_levs(1) % state % uReconstructZ % array,            &amp;
+                       block % state % time_levs(1) % state % uReconstructZonal % array,        &amp;
+                       block % state % time_levs(1) % state % uReconstructMeridional % array    &amp;
+                      )
+
+   
+   end subroutine mpas_init_block
+   
+   
+   subroutine mpas_core_run(domain, output_obj, output_frame)
+   
+      use mpas_grid_types
+      use mpas_io_output
+      use mpas_timer
+   
+      implicit none
+   
+      type (domain_type), intent(inout) :: domain
+      type (io_output_object), intent(inout) :: output_obj
+      integer, intent(inout) :: output_frame
+
+      integer :: itimestep
+      real (kind=RKIND) :: dt
+      type (block_type), pointer :: block_ptr
+
+      type (MPAS_Time_Type) :: currTime
+      character(len=32) :: timeStamp
+      integer :: ierr
+   
+      ! Eventually, dt should be domain specific
+      dt = config_dt
+
+      currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+      call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)         
+      write(0,*) 'Initial timestep ', timeStamp
+
+      call write_output_frame(output_obj, output_frame, domain)
+
+      ! During integration, time level 1 stores the model state at the beginning of the
+      !   time step, and time level 2 stores the state advanced dt in time by timestep(...)
+      itimestep = 0
+      do while (.not. mpas_is_clock_stop_time(clock))
+
+         itimestep = itimestep + 1
+         call mpas_advance_clock(clock)
+
+         currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+         call mpas_get_time(curr_time=currTime, dateTimeString=timeStamp, ierr=ierr)         
+         write(0,*) 'Doing timestep ', timeStamp
+
+         call mpas_timer_start(&quot;time integration&quot;)
+         call mpas_timestep(domain, itimestep, dt, timeStamp)
+         call mpas_timer_stop(&quot;time integration&quot;)
+
+         ! Move time level 2 fields back into time level 1 for next time step
+         call mpas_shift_time_levels_state(domain % blocklist % state)
+
+         !TODO: mpas_get_clock_ringing_alarms is probably faster than multiple mpas_is_alarm_ringing...
+
+         if (mpas_is_alarm_ringing(clock, outputAlarmID, ierr=ierr)) then
+            call mpas_reset_clock_alarm(clock, outputAlarmID, ierr=ierr)
+            if(output_frame == 1) call mpas_output_state_init(output_obj, domain, &quot;OUTPUT&quot;, trim(timeStamp)) ! output_frame will always be &gt; 1 here unless it is reset after the output file is finalized
+            call write_output_frame(output_obj, output_frame, domain)
+         end if
+
+         if (mpas_is_alarm_ringing(clock, restartAlarmID, ierr=ierr)) then
+            call mpas_reset_clock_alarm(clock, restartAlarmID, ierr=ierr)
+            if (restart_frame == 1) call mpas_output_state_init(restart_obj, domain, &quot;RESTART&quot;)
+            call mpas_output_state_for_domain(restart_obj, domain, restart_frame)
+            restart_frame = restart_frame + 1
+         end if
+
+      end do
+
+   end subroutine mpas_core_run
+   
+   
+   subroutine write_output_frame(output_obj, output_frame, domain)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Compute diagnostic fields for a domain and write model state to output file
+   !
+   ! Input/Output: domain - contains model state; diagnostic field are computed
+   !                        before returning
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   
+      use mpas_grid_types
+      use mpas_io_output
+   
+      implicit none
+
+      type (io_output_object), intent(inout) :: output_obj
+      integer, intent(inout) :: output_frame
+      type (domain_type), intent(inout) :: domain
+   
+      integer :: i, j, k
+      integer :: eoe
+      type (block_type), pointer :: block_ptr
+   
+      block_ptr =&gt; domain % blocklist
+      do while (associated(block_ptr))
+         call compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
+         block_ptr =&gt; block_ptr % next
+      end do
+   
+      call mpas_output_state_for_domain(output_obj, domain, output_frame)
+      output_frame = output_frame + 1
+
+      ! if the maximum number of frames per outfile has been reached, finalize outfile and reset frame   
+      if (config_frames_per_outfile &gt; 0) then
+         current_outfile_frames = current_outfile_frames + 1            
+         if(current_outfile_frames &gt;= config_frames_per_outfile) then
+            current_outfile_frames = 0
+            call mpas_output_state_finalize(output_obj, domain % dminfo)
+            output_frame = 1
+         end if
+      end if
+
+   end subroutine write_output_frame
+   
+   
+   subroutine compute_output_diagnostics(state, grid)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Compute diagnostic fields for a domain
+   !
+   ! 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 (mesh_type), intent(in) :: grid
+   
+      integer :: i, eoe
+      integer :: iEdge, k
+   
+   end subroutine compute_output_diagnostics
+   
+   
+   subroutine mpas_timestep(domain, itimestep, dt, timeStamp)
+   
+      use mpas_grid_types
+      use sw_time_integration
+      use mpas_timer
+      use sw_global_diagnostics
+   
+      implicit none
+   
+      type (domain_type), intent(inout) :: domain 
+      integer, intent(in) :: itimestep
+      real (kind=RKIND), intent(in) :: dt
+      character(len=*), intent(in) :: timeStamp
+      
+      type (block_type), pointer :: block_ptr
+      integer :: ierr
+   
+      call sw_timestep(domain, dt, timeStamp)
+   
+      if(config_stats_interval .gt. 0) then
+          if(mod(itimestep, config_stats_interval) == 0) then
+              block_ptr =&gt; domain % blocklist
+              if(associated(block_ptr % next)) then
+                  write(0,*) 'Error: computeGlobalDiagnostics assumes ',&amp;
+                             'that there is only one block per processor.'
+              end if
+   
+              call mpas_timer_start(&quot;global_diagnostics&quot;)
+              call sw_compute_global_diagnostics(domain % dminfo, &amp;
+                       block_ptr % state % time_levs(2) % state, block_ptr % mesh, &amp;
+                       itimestep, dt)
+              call mpas_timer_stop(&quot;global_diagnostics&quot;)
+          end if
+      end if
+
+      !TODO: replace the above code block with this if we desire to convert config_stats_interval to use alarms
+      !if (mpas_is_alarm_ringing(clock, statsAlarmID, ierr=ierr)) then
+      !   call mpas_reset_clock_alarm(clock, statsAlarmID, ierr=ierr)
+
+      !   block_ptr =&gt; domain % blocklist
+      !   if(associated(block_ptr % next)) then
+      !      write(0,*) 'Error: computeGlobalDiagnostics assumes ',&amp;
+      !                 'that there is only one block per processor.'
+      !   end if
+
+      !   call mpas_timer_start(&quot;global_diagnostics&quot;)
+      !   call sw_compute_global_diagnostics(domain % dminfo, &amp;
+      !            block_ptr % state % time_levs(2) % state, block_ptr % mesh, &amp;
+      !            timeStamp, dt)
+      !   call mpas_timer_stop(&quot;global_diagnostics&quot;)
+      !end if
+   
+   end subroutine mpas_timestep
+   
+   
+   subroutine mpas_core_finalize(domain)
+   
+      use mpas_grid_types
+   
+      implicit none
+
+      integer :: ierr
+
+      type (domain_type), intent(inout) :: domain 
+
+      if (restart_frame &gt; 1) call mpas_output_state_finalize(restart_obj, domain % dminfo)
+
+      call mpas_destroy_clock(clock, ierr)
+
+   end subroutine mpas_core_finalize
+
+
+   subroutine compute_mesh_scaling(mesh)
+
+      use mpas_grid_types
+
+      implicit none
+
+      type (mesh_type), intent(inout) :: mesh
+
+      integer :: iEdge, cell1, cell2
+      real (kind=RKIND), dimension(:), pointer :: meshDensity, meshScalingDel2, meshScalingDel4
+
+      meshDensity =&gt; mesh % meshDensity % array
+      meshScalingDel2 =&gt; mesh % meshScalingDel2 % array
+      meshScalingDel4 =&gt; mesh % meshScalingDel4 % array
+
+      !
+      ! Compute the scaling factors to be used in the del2 and del4 dissipation
+      !
+      meshScalingDel2(:) = 1.0
+      meshScalingDel4(:) = 1.0
+      if (config_h_ScaleWithMesh) then
+         do iEdge=1,mesh%nEdges
+            cell1 = mesh % cellsOnEdge % array(1,iEdge)
+            cell2 = mesh % cellsOnEdge % array(2,iEdge)
+            meshScalingDel2(iEdge) = 1.0 / ( (meshDensity(cell1) + meshDensity(cell2) )/2.0)**(5.0/12.0)
+            meshScalingDel4(iEdge) = 1.0 / ( (meshDensity(cell1) + meshDensity(cell2) )/2.0)**(5.0/6.0)
+         end do
+      end if
+
+   end subroutine compute_mesh_scaling
+
+end module mpas_core

Copied: branches/source_condensing/src/core_sw/mpas_sw_test_cases.F (from rev 1114, trunk/mpas/src/core_sw/mpas_sw_test_cases.F)
===================================================================
--- branches/source_condensing/src/core_sw/mpas_sw_test_cases.F                                (rev 0)
+++ branches/source_condensing/src/core_sw/mpas_sw_test_cases.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,527 @@
+module sw_test_cases
+
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+
+
+   contains
+
+
+   subroutine setup_sw_test_case(domain)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Configure grid metadata and model state for the shallow water test case 
+   !   specified in the namelist
+   !
+   ! Output: block - a subset (not necessarily proper) of the model domain to be
+   !                 initialized
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+
+      integer :: i
+      type (block_type), pointer :: block_ptr
+
+      if (config_test_case == 0) then
+         write(0,*) 'Using initial conditions supplied in input file'
+
+      else if (config_test_case == 1) then
+         write(0,*) 'Setting up shallow water test case 1'
+         write(0,*) ' -- Advection of Cosine Bell over the Pole'
+
+         block_ptr =&gt; domain % blocklist
+         do while (associated(block_ptr))
+            call sw_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
+            do i=2,nTimeLevs
+               call mpas_copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
+            end do
+
+            block_ptr =&gt; block_ptr % next
+         end do
+
+      else if (config_test_case == 2) then
+         write(0,*) 'Setting up shallow water test case 2'
+         write(0,*) ' -- Setup shallow water test case 2: Global Steady State Nonlinear Zonal Geostrophic Flow'
+
+         block_ptr =&gt; domain % blocklist
+         do while (associated(block_ptr))
+            call sw_test_case_2(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
+            do i=2,nTimeLevs
+               call mpas_copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
+            end do
+
+            block_ptr =&gt; block_ptr % next
+         end do
+
+      else if (config_test_case == 5) then
+         write(0,*) 'Setting up shallow water test case 5'
+         write(0,*) ' -- Setup shallow water test case 5: Zonal Flow over an Isolated Mountain'
+
+         block_ptr =&gt; domain % blocklist
+         do while (associated(block_ptr))
+            call sw_test_case_5(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
+            do i=2,nTimeLevs
+               call mpas_copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
+            end do
+
+            block_ptr =&gt; block_ptr % next
+         end do
+
+      else if (config_test_case == 6) then
+         write(0,*) 'Setting up shallow water test case 6'
+         write(0,*) ' -- Rossby-Haurwitz Wave'
+
+         block_ptr =&gt; domain % blocklist
+         do while (associated(block_ptr))
+            call sw_test_case_6(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
+            do i=2,nTimeLevs
+               call mpas_copy_state(block_ptr % state % time_levs(i) % state, block_ptr % state % time_levs(1) % state)
+            end do
+
+            block_ptr =&gt; block_ptr % next
+         end do
+
+      else
+         write(0,*) 'Only test case 1, 2, 5, and 6 are currently supported.'
+         stop
+      end if
+
+   end subroutine setup_sw_test_case
+
+
+   subroutine sw_test_case_1(grid, state)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Setup shallow water test case 1: Advection of Cosine Bell over the Pole
+   !
+   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
+   !            Approximations to the Shallow Water Equations in Spherical 
+   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (mesh_type), intent(inout) :: grid
+      type (state_type), intent(inout) :: state
+
+      real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
+      real (kind=RKIND), parameter :: h0 = 1000.0
+      real (kind=RKIND), parameter :: theta_c = 0.0
+      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
+      real (kind=RKIND), parameter :: alpha = pii/4.0
+
+      integer :: iCell, iEdge, iVtx
+      real (kind=RKIND) :: r, u, v
+      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
+
+      !
+      ! Scale all distances and areas from a unit sphere to one with radius a
+      !
+      grid % xCell % array = grid % xCell % array * a
+      grid % yCell % array = grid % yCell % array * a
+      grid % zCell % array = grid % zCell % array * a
+      grid % xVertex % array = grid % xVertex % array * a
+      grid % yVertex % array = grid % yVertex % array * a
+      grid % zVertex % array = grid % zVertex % array * a
+      grid % xEdge % array = grid % xEdge % array * a
+      grid % yEdge % array = grid % yEdge % array * a
+      grid % zEdge % array = grid % zEdge % array * a
+      grid % dvEdge % array = grid % dvEdge % array * a
+      grid % dcEdge % array = grid % dcEdge % array * a
+      grid % areaCell % array = grid % areaCell % array * a**2.0
+      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
+      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
+
+      !
+      ! Initialize wind field
+      !
+      allocate(psiVertex(grid % nVertices))
+      do iVtx=1,grid % nVertices
+         psiVertex(iVtx) = -a * u0 * ( &amp;
+                                       sin(grid%latVertex%array(iVtx)) * cos(alpha) - &amp;
+                                       cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &amp;
+                                     )
+      end do
+      do iEdge=1,grid % nEdges
+         state % u % array(1,iEdge) = -1.0 * ( &amp;
+                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
+                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
+                                             ) / grid%dvEdge%array(iEdge)
+      end do
+      deallocate(psiVertex)
+
+      !
+      ! Initialize cosine bell at (theta_c, lambda_c)
+      !
+      do iCell=1,grid % nCells
+         r = sphere_distance(theta_c, lambda_c, grid % latCell % array(iCell), grid % lonCell % array(iCell), a) 
+         if (r &lt; a/3.0) then
+            state % h % array(1,iCell) = (h0 / 2.0) * (1.0 + cos(pii*r*3.0/a))
+         else
+            state % h % array(1,iCell) = 0.0
+         end if
+      end do
+
+   end subroutine sw_test_case_1
+
+
+   subroutine sw_test_case_2(grid, state)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Setup shallow water test case 2: Global Steady State Nonlinear Zonal 
+   !                                  Geostrophic Flow
+   !
+   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
+   !            Approximations to the Shallow Water Equations in Spherical 
+   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (mesh_type), intent(inout) :: grid
+      type (state_type), intent(inout) :: state
+
+      real (kind=RKIND), parameter :: u0 = 2.0 * pii * a / (12.0 * 86400.0)
+      real (kind=RKIND), parameter :: gh0 = 29400.0
+      real (kind=RKIND), parameter :: alpha = 0.0
+
+      integer :: iCell, iEdge, iVtx
+      real (kind=RKIND) :: u, v
+      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
+
+
+      !
+      ! Scale all distances and areas from a unit sphere to one with radius a
+      !
+      grid % xCell % array = grid % xCell % array * a
+      grid % yCell % array = grid % yCell % array * a
+      grid % zCell % array = grid % zCell % array * a
+      grid % xVertex % array = grid % xVertex % array * a
+      grid % yVertex % array = grid % yVertex % array * a
+      grid % zVertex % array = grid % zVertex % array * a
+      grid % xEdge % array = grid % xEdge % array * a
+      grid % yEdge % array = grid % yEdge % array * a
+      grid % zEdge % array = grid % zEdge % array * a
+      grid % dvEdge % array = grid % dvEdge % array * a
+      grid % dcEdge % array = grid % dcEdge % array * a
+      grid % areaCell % array = grid % areaCell % array * a**2.0
+      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
+      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
+      
+
+      !
+      ! Initialize wind field
+      !
+      allocate(psiVertex(grid % nVertices))
+      do iVtx=1,grid % nVertices
+         psiVertex(iVtx) = -a * u0 * ( &amp;
+                                       sin(grid%latVertex%array(iVtx)) * cos(alpha) - &amp;
+                                       cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &amp;
+                                     )
+      end do
+      do iEdge=1,grid % nEdges
+         state % u % array(1,iEdge) = -1.0 * ( &amp;
+                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
+                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
+                                             ) / grid%dvEdge%array(iEdge)
+      end do
+      deallocate(psiVertex)
+
+      !
+      ! Generate rotated Coriolis field
+      !
+      do iEdge=1,grid % nEdges
+         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
+                                       ( -cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &amp;
+                                         sin(grid%latEdge%array(iEdge)) * cos(alpha) &amp;
+                                       )
+      end do
+      do iVtx=1,grid % nVertices
+         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
+                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &amp;
+                                          sin(grid%latVertex%array(iVtx)) * cos(alpha) &amp;
+                                         )
+      end do
+
+      !
+      ! Initialize height field (actually, fluid thickness field)
+      !
+      do iCell=1,grid % nCells
+         state % h % array(1,iCell) = (gh0 - (a * omega * u0 + 0.5 * u0**2.0) * &amp;
+                                             (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &amp;
+                                              sin(grid%latCell%array(iCell)) * cos(alpha) &amp;
+                                             )**2.0 &amp;
+                                      ) / &amp;
+                                      gravity
+      end do
+
+   end subroutine sw_test_case_2
+
+
+   subroutine sw_test_case_5(grid, state)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Setup shallow water test case 5: Zonal Flow over an Isolated Mountain
+   !
+   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
+   !            Approximations to the Shallow Water Equations in Spherical 
+   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (mesh_type), intent(inout) :: grid
+      type (state_type), intent(inout) :: state
+
+      real (kind=RKIND), parameter :: u0 = 20.
+      real (kind=RKIND), parameter :: gh0 = 5960.0*gravity
+      real (kind=RKIND), parameter :: hs0 = 2000.
+      real (kind=RKIND), parameter :: theta_c = pii/6.0
+      real (kind=RKIND), parameter :: lambda_c = 3.0*pii/2.0
+      real (kind=RKIND), parameter :: rr = pii/9.0
+      real (kind=RKIND), parameter :: alpha = 0.0
+
+      integer :: iCell, iEdge, iVtx
+      real (kind=RKIND) :: r, u, v
+      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
+
+
+      !
+      ! Scale all distances and areas from a unit sphere to one with radius a
+      !
+      grid % xCell % array = grid % xCell % array * a
+      grid % yCell % array = grid % yCell % array * a
+      grid % zCell % array = grid % zCell % array * a
+      grid % xVertex % array = grid % xVertex % array * a
+      grid % yVertex % array = grid % yVertex % array * a
+      grid % zVertex % array = grid % zVertex % array * a
+      grid % xEdge % array = grid % xEdge % array * a
+      grid % yEdge % array = grid % yEdge % array * a
+      grid % zEdge % array = grid % zEdge % array * a
+      grid % dvEdge % array = grid % dvEdge % array * a
+      grid % dcEdge % array = grid % dcEdge % array * a
+      grid % areaCell % array = grid % areaCell % array * a**2.0
+      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
+      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
+
+      !
+      ! Initialize wind field
+      !
+      allocate(psiVertex(grid % nVertices))
+      do iVtx=1,grid % nVertices
+         psiVertex(iVtx) = -a * u0 * ( &amp;
+                                       sin(grid%latVertex%array(iVtx)) * cos(alpha) - &amp;
+                                       cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &amp;
+                                     )
+      end do
+      do iEdge=1,grid % nEdges
+         state % u % array(1,iEdge) = -1.0 * ( &amp;
+                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
+                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
+                                             ) / grid%dvEdge%array(iEdge)
+      end do
+      deallocate(psiVertex)
+
+      !
+      ! Generate rotated Coriolis field
+      !
+      do iEdge=1,grid % nEdges
+         grid % fEdge % array(iEdge) = 2.0 * omega * &amp;
+                                        (-cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &amp;
+                                         sin(grid%latEdge%array(iEdge)) * cos(alpha) &amp;
+                                        )
+      end do
+      do iVtx=1,grid % nVertices
+         grid % fVertex % array(iVtx) = 2.0 * omega * &amp;
+                                         (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &amp;
+                                          sin(grid%latVertex%array(iVtx)) * cos(alpha) &amp;
+                                         )
+      end do
+
+      !
+      ! Initialize mountain
+      !
+      do iCell=1,grid % nCells
+         if (grid % lonCell % array(iCell) &lt; 0.0) grid % lonCell % array(iCell) = grid % lonCell % array(iCell) + 2.0 * pii
+         r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + (grid % latCell % array(iCell) - theta_c)**2.0))
+         grid % h_s % array(iCell) = hs0 * (1.0 - r/rr)
+      end do
+
+      !
+      ! Initialize tracer fields
+      !
+      do iCell=1,grid % nCells
+         r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + (grid % latCell % array(iCell) - theta_c)**2.0))
+         state % tracers % array(1,1,iCell) = 1.0 - r/rr
+      end do
+      if (grid%nTracers &gt; 1) then
+         do iCell=1,grid % nCells
+            r = sqrt(min(rr**2.0, (grid % lonCell % array(iCell) - lambda_c)**2.0 + &amp;
+                         (grid % latCell % array(iCell) - theta_c - pii/6.0)**2.0 &amp;
+                        ) &amp;
+                    )
+            state % tracers % array(2,1,iCell) = 1.0 - r/rr
+         end do
+      end if
+
+      !
+      ! Initialize height field (actually, fluid thickness field)
+      !
+      do iCell=1,grid % nCells
+         state % h % array(1,iCell) = (gh0 - (a * omega * u0 + 0.5 * u0**2.0) * &amp;
+                                         (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &amp;
+                                          sin(grid%latCell%array(iCell)) * cos(alpha) &amp;
+                                         )**2.0 &amp;
+                                      ) / &amp;
+                                      gravity
+         state % h % array(1,iCell) = state % h % array(1,iCell) - grid % h_s % array(iCell)
+      end do
+
+   end subroutine sw_test_case_5
+
+
+   subroutine sw_test_case_6(grid, state)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Setup shallow water test case 6: Rossby-Haurwitz Wave
+   !
+   ! Reference: Williamson, D.L., et al., &quot;A Standard Test Set for Numerical 
+   !            Approximations to the Shallow Water Equations in Spherical 
+   !            Geometry&quot; J. of Comp. Phys., 102, pp. 211--224
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      type (mesh_type), intent(inout) :: grid
+      type (state_type), intent(inout) :: state
+
+      real (kind=RKIND), parameter :: h0 = 8000.0
+      real (kind=RKIND), parameter :: w = 7.848e-6
+      real (kind=RKIND), parameter :: K = 7.848e-6
+      real (kind=RKIND), parameter :: R = 4.0
+
+      integer :: iCell, iEdge, iVtx
+      real (kind=RKIND) :: u, v
+      real (kind=RKIND), allocatable, dimension(:) :: psiVertex
+
+
+      !
+      ! Scale all distances and areas from a unit sphere to one with radius a
+      !
+      grid % xCell % array = grid % xCell % array * a
+      grid % yCell % array = grid % yCell % array * a
+      grid % zCell % array = grid % zCell % array * a
+      grid % xVertex % array = grid % xVertex % array * a
+      grid % yVertex % array = grid % yVertex % array * a
+      grid % zVertex % array = grid % zVertex % array * a
+      grid % xEdge % array = grid % xEdge % array * a
+      grid % yEdge % array = grid % yEdge % array * a
+      grid % zEdge % array = grid % zEdge % array * a
+      grid % dvEdge % array = grid % dvEdge % array * a
+      grid % dcEdge % array = grid % dcEdge % array * a
+      grid % areaCell % array = grid % areaCell % array * a**2.0
+      grid % areaTriangle % array = grid % areaTriangle % array * a**2.0
+      grid % kiteAreasOnVertex % array = grid % kiteAreasOnVertex % array * a**2.0
+
+      !
+      ! Initialize wind field
+      !
+      allocate(psiVertex(grid % nVertices))
+      do iVtx=1,grid % nVertices
+         psiVertex(iVtx) = -a * a * w * sin(grid%latVertex%array(iVtx)) + &amp;
+                            a *a * K * (cos(grid%latVertex%array(iVtx))**R) * &amp;
+                            sin(grid%latVertex%array(iVtx)) * cos(R * grid%lonVertex%array(iVtx))
+      end do
+      do iEdge=1,grid % nEdges
+         state % u % array(1,iEdge) = -1.0 * ( &amp;
+                                               psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &amp;
+                                               psiVertex(grid%verticesOnEdge%array(1,iEdge)) &amp;
+                                             ) / grid%dvEdge%array(iEdge)
+      end do
+      deallocate(psiVertex)
+
+      !
+      ! Initialize height field (actually, fluid thickness field)
+      !
+      do iCell=1,grid % nCells
+         state % h % array(1,iCell) = (gravity * h0 + a*a*aa(grid%latCell%array(iCell)) + &amp;
+                                                      a*a*bb(grid%latCell%array(iCell)) * cos(R*grid%lonCell%array(iCell)) + &amp;
+                                                      a*a*cc(grid%latCell%array(iCell)) * cos(2.0*R*grid%lonCell%array(iCell)) &amp;
+                                      ) / gravity
+      end do
+
+   end subroutine sw_test_case_6
+
+
+   real function sphere_distance(lat1, lon1, lat2, lon2, radius)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Compute the great-circle distance between (lat1, lon1) and (lat2, lon2) on a
+   !   sphere with given radius.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      real (kind=RKIND), intent(in) :: lat1, lon1, lat2, lon2, radius
+
+      real (kind=RKIND) :: arg1
+
+      arg1 = sqrt( sin(0.5*(lat2-lat1))**2 +  &amp;
+                   cos(lat1)*cos(lat2)*sin(0.5*(lon2-lon1))**2 )
+      sphere_distance = 2.*radius*asin(arg1)
+
+   end function sphere_distance
+
+
+   real function aa(theta)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! A, used in height field computation for Rossby-Haurwitz wave
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      real (kind=RKIND), parameter :: w = 7.848e-6
+      real (kind=RKIND), parameter :: K = 7.848e-6
+      real (kind=RKIND), parameter :: R = 4.0
+
+      real (kind=RKIND), intent(in) :: theta
+
+      aa = 0.5 * w * (2.0 * omega + w) * cos(theta)**2.0 + &amp;
+          0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 + 2.0*R**2.0 - R - 2.0 - 2.0*R**2.0 * cos(theta)**(-2.0))
+
+   end function aa
+
+   
+   real function bb(theta)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! B, used in height field computation for Rossby-Haurwitz wave
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      real (kind=RKIND), parameter :: w = 7.848e-6
+      real (kind=RKIND), parameter :: K = 7.848e-6
+      real (kind=RKIND), parameter :: R = 4.0
+
+      real (kind=RKIND), intent(in) :: theta
+
+      bb = (2.0*(omega + w)*K / ((R+1.0)*(R+2.0))) * cos(theta)**R * ((R**2.0 + 2.0*R + 2.0) - ((R+1.0)*cos(theta))**2.0)
+
+   end function bb
+
+
+   real function cc(theta)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! C, used in height field computation for Rossby-Haurwitz wave
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      implicit none
+
+      real (kind=RKIND), parameter :: w = 7.848e-6
+      real (kind=RKIND), parameter :: K = 7.848e-6
+      real (kind=RKIND), parameter :: R = 4.0
+
+      real (kind=RKIND), intent(in) :: theta
+
+      cc = 0.25 * K**2.0 * cos(theta)**(2.0*R) * ((R+1.0)*cos(theta)**2.0 - R - 2.0)
+
+   end function cc
+
+end module sw_test_cases

Copied: branches/source_condensing/src/core_sw/mpas_sw_time_integration.F (from rev 1114, trunk/mpas/src/core_sw/mpas_sw_time_integration.F)
===================================================================
--- branches/source_condensing/src/core_sw/mpas_sw_time_integration.F                                (rev 0)
+++ branches/source_condensing/src/core_sw/mpas_sw_time_integration.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,1287 @@
+module sw_time_integration
+
+   use mpas_vector_reconstruction
+   use mpas_grid_types
+   use mpas_configure
+   use mpas_constants
+   use mpas_dmpar
+
+
+   contains
+
+
+   subroutine sw_timestep(domain, dt, timeStamp)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Advance model state forward in time by the specified time step
+   !
+   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
+   !                 plus grid meta-data
+   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
+   !                  model state advanced forward in time by dt seconds
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+      real (kind=RKIND), intent(in) :: dt
+      character(len=*), intent(in) :: timeStamp
+
+      type (block_type), pointer :: block
+
+      if (trim(config_time_integration) == 'RK4') then
+         call sw_rk4(domain, dt)
+      else
+         write(0,*) 'Unknown time integration option '//trim(config_time_integration)
+         write(0,*) 'Currently, only ''RK4'' is supported.'
+         stop
+      end if
+
+      block =&gt; domain % blocklist
+      do while (associated(block))
+         block % state % time_levs(2) % state % xtime % scalar = timeStamp 
+         block =&gt; block % next
+      end do
+
+   end subroutine sw_timestep
+
+
+   subroutine sw_rk4(domain, dt)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Advance model state forward in time by the specified time step using 
+   !   4th order Runge-Kutta
+   !
+   ! Input: domain - current model state in time level 1 (e.g., time_levs(1)state%h(:,:)) 
+   !                 plus grid meta-data
+   ! Output: domain - upon exit, time level 2 (e.g., time_levs(2)%state%h(:,:)) contains 
+   !                  model state advanced forward in time by dt seconds
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      implicit none
+
+      type (domain_type), intent(inout) :: domain
+      real (kind=RKIND), intent(in) :: dt
+
+      integer :: iCell, k
+      type (block_type), pointer :: block
+      type (state_type) :: provis
+
+      integer :: rk_step
+
+      real (kind=RKIND), dimension(4) :: rk_weights, rk_substep_weights
+
+      block =&gt; domain % blocklist
+      call mpas_allocate_state(provis, &amp;
+                          block % mesh % nCells, block % mesh % nEdges, block % mesh % maxEdges, block % mesh % maxEdges2, &amp;
+                          block % mesh % nVertices, block % mesh % vertexDegree, block % mesh % nVertLevels, &amp;
+                          block % mesh % nTracers)
+
+      !
+      ! Initialize time_levs(2) with state at current time
+      ! Initialize first RK state
+      ! Couple tracers time_levs(2) with h in time-levels
+      ! Initialize RK weights
+      !
+      block =&gt; domain % blocklist
+      do while (associated(block))
+
+         block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+         block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:)
+         do iCell=1,block % mesh % nCells  ! couple tracers to h
+           do k=1,block % mesh % nVertLevels
+             block % state % time_levs(2) % state % tracers % array(:,k,iCell) = block % state % time_levs(1) % state % tracers % array(:,k,iCell) &amp;
+                                                                       * block % state % time_levs(1) % state % h % array(k,iCell)
+            end do
+         end do
+
+         call mpas_copy_state(provis, block % state % time_levs(1) % state)
+
+         block =&gt; block % next
+      end do
+
+      rk_weights(1) = dt/6.
+      rk_weights(2) = dt/3.
+      rk_weights(3) = dt/3.
+      rk_weights(4) = dt/6.
+
+      rk_substep_weights(1) = dt/2.
+      rk_substep_weights(2) = dt/2.
+      rk_substep_weights(3) = dt
+      rk_substep_weights(4) = 0.
+
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+      ! BEGIN RK loop 
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+      do rk_step = 1, 4
+
+! ---  update halos for diagnostic variables
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, provis % pv_edge % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
+                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+           if (config_h_mom_eddy_visc4 &gt; 0.0) then
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &amp;
+                                               block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                               block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+              call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &amp;
+                                               block % mesh % nVertLevels, block % mesh % nVertices, &amp;
+                                               block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
+           end if
+
+           block =&gt; block % next
+        end do
+
+! ---  compute tendencies
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           call sw_compute_tend(block % tend, provis, block % mesh)
+           call sw_compute_scalar_tend(block % tend, provis, block % mesh)
+           call sw_enforce_boundary_edge(block % tend, block % mesh)
+           block =&gt; block % next
+        end do
+
+! ---  update halos for prognostic variables
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % tend % u % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nEdges, &amp;
+                                            block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+           call mpas_dmpar_exch_halo_field2d_real(domain % dminfo, block % tend % h % array(:,:), &amp;
+                                            block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           call mpas_dmpar_exch_halo_field3d_real(domain % dminfo, block % tend % tracers % array(:,:,:), &amp;
+                                            block % mesh % nTracers, block % mesh % nVertLevels, block % mesh % nCells, &amp;
+                                            block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+           block =&gt; block % next
+        end do
+
+! ---  compute next substep state
+
+        if (rk_step &lt; 4) then
+           block =&gt; domain % blocklist
+           do while (associated(block))
+              provis % u % array(:,:)       = block % state % time_levs(1) % state % u % array(:,:)  &amp;
+                                            + rk_substep_weights(rk_step) * block % tend % u % array(:,:)
+              provis % h % array(:,:)       = block % state % time_levs(1) % state % h % array(:,:)  &amp;
+                                            + rk_substep_weights(rk_step) * block % tend % h % array(:,:)
+              do iCell=1,block % mesh % nCells
+                 do k=1,block % mesh % nVertLevels
+                    provis % tracers % array(:,k,iCell) = ( &amp;
+                                                           block % state % time_levs(1) % state % h % array(k,iCell) * &amp;
+                                                           block % state % time_levs(1) % state % tracers % array(:,k,iCell)  &amp;
+                                      + rk_substep_weights(rk_step) * block % tend % tracers % array(:,k,iCell) &amp;
+                                                          ) / provis % h % array(k,iCell)
+                 end do
+              end do
+              if (config_test_case == 1) then    ! For case 1, wind field should be fixed
+                 provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+              end if
+              call sw_compute_solve_diagnostics(dt, provis, block % mesh)
+              block =&gt; block % next
+           end do
+        end if
+
+!--- accumulate update (for RK4)
+
+        block =&gt; domain % blocklist
+        do while (associated(block))
+           block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % u % array(:,:) &amp;
+                                   + rk_weights(rk_step) * block % tend % u % array(:,:) 
+           block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(2) % state % h % array(:,:) &amp;
+                                   + rk_weights(rk_step) * block % tend % h % array(:,:) 
+           do iCell=1,block % mesh % nCells
+              do k=1,block % mesh % nVertLevels
+                 block % state % time_levs(2) % state % tracers % array(:,k,iCell) =  &amp;
+                                                                       block % state % time_levs(2) % state % tracers % array(:,k,iCell) &amp;
+                                               + rk_weights(rk_step) * block % tend % tracers % array(:,k,iCell)
+              end do
+           end do
+           block =&gt; block % next
+        end do
+
+      end do
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+      ! END RK loop 
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+
+      !
+      !  A little clean up at the end: decouple new scalar fields and compute diagnostics for new state
+      !
+      block =&gt; domain % blocklist
+      do while (associated(block))
+         do iCell=1,block % mesh % nCells
+            do k=1,block % mesh % nVertLevels
+               block % state % time_levs(2) % state % tracers % array(:,k,iCell) = &amp;
+                                                                     block % state % time_levs(2) % state % tracers % array(:,k,iCell)  &amp;
+                                                                   / block % state % time_levs(2) % state % h % array(k,iCell)
+            end do
+         end do
+
+         if (config_test_case == 1) then    ! For case 1, wind field should be fixed
+            block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:)
+         end if
+
+         call sw_compute_solve_diagnostics(dt, block % state % time_levs(2) % state, block % mesh)
+
+         call mpas_reconstruct(block % mesh, block % state % time_levs(2) % state % u % array,          &amp;
+                          block % state % time_levs(2) % state % uReconstructX % array,            &amp;
+                          block % state % time_levs(2) % state % uReconstructY % array,            &amp;
+                          block % state % time_levs(2) % state % uReconstructZ % array,            &amp;
+                          block % state % time_levs(2) % state % uReconstructZonal % array,        &amp;
+                          block % state % time_levs(2) % state % uReconstructMeridional % array    &amp;
+                         )
+
+         block =&gt; block % next
+      end do
+
+      call mpas_deallocate_state(provis)
+
+   end subroutine sw_rk4
+
+
+   subroutine sw_compute_tend(tend, s, 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 (mesh_type), intent(in) :: grid
+
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j
+      real (kind=RKIND) :: flux, vorticity_abs, workpv, q, upstream_bias
+
+      integer :: nCells, nEdges, nVertices, nVertLevels
+      real (kind=RKIND), dimension(:), pointer :: h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &amp;
+                                                  meshScalingDel2, meshScalingDel4
+      real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, tend_h, tend_u, &amp;
+                                                    circulation, vorticity, ke, pv_edge, divergence, h_vertex
+      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
+      real (kind=RKIND) :: r, u_diffusion
+
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_divergence
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_u
+      real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation, delsq_vorticity
+
+      real (kind=RKIND), dimension(:,:), pointer :: u_src
+      real (kind=RKIND), parameter :: rho_ref = 1000.0
+      real (kind=RKIND) :: ke_edge
+
+
+      h           =&gt; s % h % array
+      u           =&gt; s % u % array
+      v           =&gt; s % v % array
+      h_edge      =&gt; s % h_edge % array
+      circulation =&gt; s % circulation % array
+      vorticity   =&gt; s % vorticity % array
+      divergence  =&gt; s % divergence % array
+      ke          =&gt; s % ke % array
+      pv_edge     =&gt; s % pv_edge % array
+      vh          =&gt; s % vh % array
+
+      weightsOnEdge     =&gt; grid % weightsOnEdge % array
+      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      cellsOnVertex     =&gt; grid % cellsOnVertex % array
+      verticesOnEdge    =&gt; grid % verticesOnEdge % array
+      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
+      edgesOnCell       =&gt; grid % edgesOnCell % array
+      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
+      edgesOnEdge       =&gt; grid % edgesOnEdge % array
+      edgesOnVertex     =&gt; grid % edgesOnVertex % array
+      dcEdge            =&gt; grid % dcEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      areaCell          =&gt; grid % areaCell % array
+      areaTriangle      =&gt; grid % areaTriangle % array
+      h_s               =&gt; grid % h_s % array
+      fVertex           =&gt; grid % fVertex % array
+      fEdge             =&gt; grid % fEdge % array
+
+      tend_h      =&gt; tend % h % array
+      tend_u      =&gt; tend % u % array
+                  
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+
+      u_src =&gt; grid % u_src % array
+
+      meshScalingDel2 =&gt; grid % meshScalingDel2 % array
+      meshScalingDel4 =&gt; grid % meshScalingDel4 % array
+
+
+      !
+      ! Compute height tendency for each cell
+      !
+      tend_h(:,:) = 0.0
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         do k=1,nVertLevels
+            flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge)
+            tend_h(k,cell1) = tend_h(k,cell1) - flux
+            tend_h(k,cell2) = tend_h(k,cell2) + flux
+         end do
+      end do 
+      do iCell=1,grid % nCellsSolve
+         do k=1,nVertLevels
+            tend_h(k,iCell) = tend_h(k,iCell) / areaCell(iCell)
+         end do
+      end do
+
+#ifdef LANL_FORMULATION
+      !
+      ! Compute u (normal) velocity tendency for each edge (cell face)
+      !
+      tend_u(:,:) = 0.0
+      do iEdge=1,grid % nEdgesSolve
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         vertex1 = verticesOnEdge(1,iEdge)
+         vertex2 = verticesOnEdge(2,iEdge)
+         
+         do k=1,nVertLevels
+            q = 0.0
+            do j = 1,nEdgesOnEdge(iEdge)
+               eoe = edgesOnEdge(j,iEdge)
+               workpv = 0.5 * (pv_edge(k,iEdge) + pv_edge(k,eoe))
+               q = q + weightsOnEdge(j,iEdge) * u(k,eoe) * workpv * h_edge(k,eoe) 
+            end do
+
+            tend_u(k,iEdge) =       &amp;
+                              q     &amp;
+                              - (   ke(k,cell2) - ke(k,cell1) + &amp;
+                                    gravity * (h(k,cell2) + h_s(cell2) - h(k,cell1) - h_s(cell1)) &amp;
+                                  ) / dcEdge(iEdge)
+         end do
+      end do
+
+
+#endif
+
+#ifdef NCAR_FORMULATION
+      !
+      ! Compute u (normal) velocity tendency for each edge (cell face)
+      !
+      tend_u(:,:) = 0.0
+      do iEdge=1,grid % nEdgesSolve
+         vertex1 = verticesOnEdge(1,iEdge)
+         vertex2 = verticesOnEdge(2,iEdge)
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+
+         do k=1,nVertLevels
+            vorticity_abs = fEdge(iEdge) + (circulation(k,vertex1) + circulation(k,vertex2)) / &amp;
+                                           (areaTriangle(vertex1) + areaTriangle(vertex2))
+
+            workpv = 2.0 * vorticity_abs / (h(k,cell1) + h(k,cell2))
+
+            tend_u(k,iEdge) = workpv * vh(k,iEdge) - &amp;
+                              (ke(k,cell2) - ke(k,cell1) + &amp;
+                                 gravity * (h(k,cell2) + h_s(cell2) - h(k,cell1) - h_s(cell1)) &amp;
+                              ) / &amp;
+                              dcEdge(iEdge)
+         end do
+      end do
+#endif
+
+     ! Compute diffusion, computed as </font>
<font color="black">abla divergence - k \times </font>
<font color="blue">abla vorticity
+     !                    only valid for visc == constant
+     if (config_h_mom_eddy_visc2 &gt; 0.0) then
+        do iEdge=1,grid % nEdgesSolve
+           cell1 = cellsOnEdge(1,iEdge)
+           cell2 = cellsOnEdge(2,iEdge)
+           vertex1 = verticesOnEdge(1,iEdge)
+           vertex2 = verticesOnEdge(2,iEdge)
+
+           do k=1,nVertLevels
+              u_diffusion =   ( divergence(k,cell2)  -  divergence(k,cell1) ) / dcEdge(iEdge) &amp;
+                   -(vorticity(k,vertex2)  - vorticity(k,vertex1) ) / dvEdge(iEdge)
+              u_diffusion = meshScalingDel2(iEdge) * config_h_mom_eddy_visc2 * u_diffusion
+              tend_u(k,iEdge) = tend_u(k,iEdge) + u_diffusion
+           end do
+        end do
+     end if
+
+     !
+     ! velocity tendency: del4 dissipation, -</font>
<font color="black">u_4 </font>
<font color="blue">abla^4 u
+     !   computed as </font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="blue">abla vorticity
+     !   applied recursively.
+     !   strictly only valid for h_mom_eddy_visc4 == constant
+     !
+     if (config_h_mom_eddy_visc4 &gt; 0.0) then
+        allocate(delsq_divergence(nVertLevels, nCells+1))
+        allocate(delsq_u(nVertLevels, nEdges+1))
+        allocate(delsq_circulation(nVertLevels, nVertices+1))
+        allocate(delsq_vorticity(nVertLevels, nVertices+1))
+
+        delsq_u(:,:) = 0.0
+
+        ! Compute </font>
<font color="black">abla^2 u = </font>
<font color="black">abla divergence + k \times </font>
<font color="blue">abla vorticity
+        do iEdge=1,grid % nEdges
+           cell1 = cellsOnEdge(1,iEdge)
+           cell2 = cellsOnEdge(2,iEdge)
+           vertex1 = verticesOnEdge(1,iEdge)
+           vertex2 = verticesOnEdge(2,iEdge)
+
+           do k=1,nVertLevels
+
+              delsq_u(k,iEdge) = ( divergence(k,cell2)  - divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
+                   -( vorticity(k,vertex2) - vorticity(k,vertex1)) / dvEdge(iEdge)
+
+           end do
+        end do
+
+        ! vorticity using </font>
<font color="blue">abla^2 u
+        delsq_circulation(:,:) = 0.0
+        do iEdge=1,nEdges
+           vertex1 = verticesOnEdge(1,iEdge)
+           vertex2 = verticesOnEdge(2,iEdge)
+           do k=1,nVertLevels
+              delsq_circulation(k,vertex1) = delsq_circulation(k,vertex1) &amp;
+                   - dcEdge(iEdge) * delsq_u(k,iEdge)
+              delsq_circulation(k,vertex2) = delsq_circulation(k,vertex2) &amp;
+                   + dcEdge(iEdge) * delsq_u(k,iEdge)
+           end do
+        end do
+        do iVertex=1,nVertices
+           r = 1.0 / areaTriangle(iVertex)
+           do k=1,nVertLevels
+              delsq_vorticity(k,iVertex) = delsq_circulation(k,iVertex) * r
+           end do
+        end do
+
+        ! Divergence using </font>
<font color="blue">abla^2 u
+        delsq_divergence(:,:) = 0.0
+        do iEdge=1,nEdges
+           cell1 = cellsOnEdge(1,iEdge)
+           cell2 = cellsOnEdge(2,iEdge)
+           do k=1,nVertLevels
+              delsq_divergence(k,cell1) = delsq_divergence(k,cell1) &amp;
+                   + delsq_u(k,iEdge)*dvEdge(iEdge)
+              delsq_divergence(k,cell2) = delsq_divergence(k,cell2) &amp;
+                   - delsq_u(k,iEdge)*dvEdge(iEdge)
+           end do
+        end do
+        do iCell = 1,nCells
+           r = 1.0 / areaCell(iCell)
+           do k = 1,nVertLevels
+              delsq_divergence(k,iCell) = delsq_divergence(k,iCell) * r
+           end do
+        end do
+
+        ! Compute - \kappa </font>
<font color="blue">abla^4 u 
+        ! as  </font>
<font color="black">abla div(</font>
<font color="black">abla^2 u) + k \times </font>
<font color="black">abla ( k \cross curl(</font>
<font color="blue">abla^2 u) )
+        do iEdge=1,grid % nEdgesSolve
+           cell1 = cellsOnEdge(1,iEdge)
+           cell2 = cellsOnEdge(2,iEdge)
+           vertex1 = verticesOnEdge(1,iEdge)
+           vertex2 = verticesOnEdge(2,iEdge)
+
+           do k=1,nVertLevels
+
+              u_diffusion = (  delsq_divergence(k,cell2) &amp;
+                   - delsq_divergence(k,cell1) ) / dcEdge(iEdge)  &amp;
+                   -(  delsq_vorticity(k,vertex2) &amp;
+                   - delsq_vorticity(k,vertex1) ) / dvEdge(iEdge)
+
+              u_diffusion = meshScalingDel4(iEdge) * config_h_mom_eddy_visc4 * u_diffusion
+              tend_u(k,iEdge) = tend_u(k,iEdge) - u_diffusion
+
+           end do
+        end do
+
+        deallocate(delsq_divergence)
+        deallocate(delsq_u)
+        deallocate(delsq_circulation)
+        deallocate(delsq_vorticity)
+
+     end if
+
+     ! Compute u (velocity) tendency from wind stress (u_src)
+     if(config_wind_stress) then
+         do iEdge=1,grid % nEdges
+            tend_u(1,iEdge) =  tend_u(1,iEdge) &amp;
+                  + u_src(1,iEdge)/rho_ref/h_edge(1,iEdge)
+         end do
+     endif
+
+     if (config_bottom_drag) then
+         do iEdge=1,grid % nEdges
+             ! bottom drag is the same as POP:
+             ! -c |u| u  where c is unitless and 1.0e-3.
+             ! see POP Reference guide, section 3.4.4.
+             ke_edge = 0.5 * ( ke(1,cellsOnEdge(1,iEdge)) &amp;
+                   + ke(1,cellsOnEdge(2,iEdge)))
+
+             tend_u(1,iEdge) = tend_u(1,iEdge)  &amp;
+                  - 1.0e-3*u(1,iEdge) &amp;
+                  *sqrt(2.0*ke_edge)/h_edge(1,iEdge)
+         end do
+     endif

+   end subroutine sw_compute_tend
+
+
+   subroutine sw_compute_scalar_tend(tend, s, grid)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   !
+   ! Input: s - current model state
+   !        grid - grid metadata
+   !
+   ! Output: tend - computed scalar tendencies
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+      implicit none
+
+      type (tend_type), intent(inout) :: tend
+      type (state_type), intent(in) :: s
+      type (mesh_type), intent(in) :: grid
+
+      integer :: iCell, iEdge, k, iTracer, cell1, cell2, i
+      real (kind=RKIND) :: flux, tracer_edge, r
+      real (kind=RKIND) :: invAreaCell1, invAreaCell2, tracer_turb_flux
+      integer, dimension(:,:), pointer :: boundaryEdge
+      real (kind=RKIND), dimension(:,:), allocatable :: boundaryMask
+      real (kind=RKIND), dimension(:,:,:), allocatable:: delsq_tracer
+      
+      real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2
+      real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
+      real (kind=RKIND), dimension(:,:,:), pointer :: tracers, tracer_tend
+      integer, dimension(:,:), pointer :: cellsOnEdge, boundaryCell
+      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
+      real (kind=RKIND) :: coef_3rd_order
+      real (kind=RKIND), dimension(:,:), pointer :: u, h_edge
+
+      u           =&gt; s % u % array
+      h_edge      =&gt; s % h_edge % array
+      dcEdge      =&gt; grid % dcEdge % array
+      deriv_two   =&gt; grid % deriv_two % array
+      dvEdge      =&gt; grid % dvEdge % array
+      tracers     =&gt; s % tracers % array
+      cellsOnEdge =&gt; grid % cellsOnEdge % array
+      boundaryCell=&gt; grid % boundaryCell % array
+      boundaryEdge=&gt; grid % boundaryEdge % array
+      areaCell    =&gt; grid % areaCell % array
+      tracer_tend =&gt; tend % tracers % array
+
+      coef_3rd_order = 0.
+      if (config_tracer_adv_order == 3) coef_3rd_order = 1.0
+      if (config_tracer_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
+
+
+      tracer_tend(:,:,:) = 0.0
+
+      if (config_tracer_adv_order == 2) then
+
+      do iEdge=1,grid % nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            if (cell1 &lt;= grid%nCells .and. cell2 &lt;= grid%nCells) then
+               do k=1,grid % nVertLevels
+                  do iTracer=1,grid % nTracers
+                     tracer_edge = 0.5 * (tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))
+                     flux = u(k,iEdge) * dvEdge(iEdge) * h_edge(k,iEdge) * tracer_edge
+                     tracer_tend(iTracer,k,cell1) = tracer_tend(iTracer,k,cell1) - flux/areaCell(cell1)
+                     tracer_tend(iTracer,k,cell2) = tracer_tend(iTracer,k,cell2) + flux/areaCell(cell2)
+                  end do 
+               end do 
+            end if
+      end do 
+
+      else if (config_tracer_adv_order == 3) then
+
+         do iEdge=1,grid%nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+
+            !-- if a cell not on the most outside ring of the halo
+            if (cell1 &lt;= grid%nCells .and. cell2 &lt;= grid%nCells) then
+
+               do k=1,grid % nVertLevels
+
+                  d2fdx2_cell1 = 0.0
+                  d2fdx2_cell2 = 0.0
+
+                  do iTracer=1,grid % nTracers

+                     !-- if not a boundary cell
+                     if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
+
+                        d2fdx2_cell1 = deriv_two(1,1,iEdge) * tracers(iTracer,k,cell1)
+                        d2fdx2_cell2 = deriv_two(1,2,iEdge) * tracers(iTracer,k,cell2)
+
+                        !-- all edges of cell 1
+                        do i=1, grid % nEdgesOnCell % array (cell1)
+                                d2fdx2_cell1 = d2fdx2_cell1 + &amp;
+                                deriv_two(i+1,1,iEdge) * tracers(iTracer,k,grid % CellsOnCell % array (i,cell1))
+                        end do
+
+                        !-- all edges of cell 2
+                        do i=1, grid % nEdgesOnCell % array (cell2)
+                                d2fdx2_cell2 = d2fdx2_cell2 + &amp;
+                                deriv_two(i+1,2,iEdge) * tracers(iTracer,k,grid % CellsOnCell % array (i,cell2))
+                        end do
+
+                     endif
+
+                     !-- if u &gt; 0:
+                     if (u(k,iEdge) &gt; 0) then
+                        flux = dvEdge(iEdge) * u(k,iEdge) * h_edge(k,iEdge) * (          &amp;
+                             0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))      &amp;
+                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
+                             -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
+                     !-- else u &lt;= 0:
+                     else
+                        flux = dvEdge(iEdge) *  u(k,iEdge) * h_edge(k,iEdge) * (          &amp;
+                             0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))      &amp;
+                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
+                             +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
+                     end if
+
+                     !-- update tendency
+                     tracer_tend(iTracer,k,cell1) = tracer_tend(iTracer,k,cell1) - flux/areaCell(cell1)
+                     tracer_tend(iTracer,k,cell2) = tracer_tend(iTracer,k,cell2) + flux/areaCell(cell2)
+                  enddo
+               end do
+            end if
+         end do
+
+      else  if (config_tracer_adv_order == 4) then
+
+         do iEdge=1,grid%nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+
+            !-- if an edge is not on the outer-most ring of the halo
+            if (cell1 &lt;= grid%nCells .and. cell2 &lt;= grid%nCells) then
+
+               do k=1,grid % nVertLevels
+
+                  d2fdx2_cell1 = 0.0
+                  d2fdx2_cell2 = 0.0
+
+                  do iTracer=1,grid % nTracers
+
+                     !-- if not a boundary cell
+                     if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
+
+                        d2fdx2_cell1 = deriv_two(1,1,iEdge) * tracers(iTracer,k,cell1)
+                        d2fdx2_cell2 = deriv_two(1,2,iEdge) * tracers(iTracer,k,cell2)
+
+                        !-- all edges of cell 1
+                        do i=1, grid % nEdgesOnCell % array (cell1)
+                                d2fdx2_cell1 = d2fdx2_cell1 + &amp;
+                                deriv_two(i+1,1,iEdge) * tracers(iTracer,k,grid % CellsOnCell % array (i,cell1))
+                        end do
+
+                        !-- all edges of cell 2
+                        do i=1, grid % nEdgesOnCell % array (cell2)
+                                d2fdx2_cell2 = d2fdx2_cell2 + &amp;
+                                deriv_two(i+1,2,iEdge) * tracers(iTracer,k,grid % CellsOnCell % array (i,cell2))
+                        end do
+
+                     endif
+
+                     flux = dvEdge(iEdge) *  u(k,iEdge) * h_edge(k,iEdge) * (          &amp;
+                          0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2))      &amp;
+                             -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. )
+
+                     !-- update tendency
+                     tracer_tend(iTracer,k,cell1) = tracer_tend(iTracer,k,cell1) - flux/areaCell(cell1)
+                     tracer_tend(iTracer,k,cell2) = tracer_tend(iTracer,k,cell2) + flux/areaCell(cell2)
+                  enddo
+               end do
+            end if
+         end do
+
+      endif   ! if (config_tracer_adv_order == 2 )
+
+      !
+      ! tracer tendency: del2 horizontal tracer diffusion, div(h \kappa_2 </font>
<font color="blue">abla \phi)
+      !
+      if ( config_h_tracer_eddy_diff2 &gt; 0.0 ) then
+
+         !
+         ! compute a boundary mask to enforce insulating boundary conditions in the horizontal
+         !
+         allocate(boundaryMask(grid % nVertLevels, grid % nEdges+1))
+         boundaryMask = 1.0
+         where(boundaryEdge.eq.1) boundaryMask=0.0
+
+         do iEdge=1,grid % nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            invAreaCell1 = 1.0/areaCell(cell1)
+            invAreaCell2 = 1.0/areaCell(cell2)
+
+            do k=1,grid % nVertLevels
+              do iTracer=1, grid % nTracers
+                 ! \kappa_2 </font>
<font color="blue">abla \phi on edge
+                 tracer_turb_flux = config_h_tracer_eddy_diff2 &amp;
+                    *( tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) / dcEdge(iEdge)
+
+                 ! div(h \kappa_2 </font>
<font color="blue">abla \phi) at cell center
+                 flux = dvEdge(iEdge) * h_edge(k,iEdge) * tracer_turb_flux * boundaryMask(k, iEdge)
+                 tracer_tend(iTracer,k,cell1) = tracer_tend(iTracer,k,cell1) + flux * invAreaCell1
+                 tracer_tend(iTracer,k,cell2) = tracer_tend(iTracer,k,cell2) - flux * invAreaCell2
+              end do
+            end do
+
+         end do
+
+        deallocate(boundaryMask)
+
+      end if
+
+      !
+      ! tracer tendency: del4 horizontal tracer diffusion, &amp;
+      !    div(h \kappa_4 </font>
<font color="black">abla [div(h </font>
<font color="blue">abla \phi)])
+      !
+      if ( config_h_tracer_eddy_diff4 &gt; 0.0 ) then
+
+         !
+         ! compute a boundary mask to enforce insulating boundary conditions in the horizontal
+         !
+         allocate(boundaryMask(grid % nVertLevels, grid % nEdges+1))
+         boundaryMask = 1.0
+         where(boundaryEdge.eq.1) boundaryMask=0.0
+
+         allocate(delsq_tracer(grid % nTracers, grid % nVertLevels, grid % nCells+1))
+
+         delsq_tracer(:,:,:) = 0.
+
+         ! first del2: div(h </font>
<font color="blue">abla \phi) at cell center
+         do iEdge=1,grid % nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+
+            do k=1,grid % nVertLevels
+              do iTracer=1, grid % nTracers
+                 delsq_tracer(iTracer,k,cell1) = delsq_tracer(iTracer,k,cell1) &amp;
+                    + dvEdge(iEdge) * h_edge(k,iEdge) * (tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) / dcEdge(iEdge) * boundaryMask(k,iEdge)
+                 delsq_tracer(iTracer,k,cell2) = delsq_tracer(iTracer,k,cell2) &amp;
+                    - dvEdge(iEdge) * h_edge(k,iEdge) * (tracers(iTracer,k,cell2) - tracers(iTracer,k,cell1)) / dcEdge(iEdge) * boundaryMask(k,iEdge)
+              end do
+            end do
+
+         end do
+
+         do iCell = 1, grid % nCells
+            r = 1.0 / grid % areaCell % array(iCell)
+            do k=1,grid % nVertLevels
+            do iTracer=1,grid % nTracers
+               delsq_tracer(iTracer,k,iCell) = delsq_tracer(iTracer,k,iCell) * r
+            end do
+            end do
+         end do
+
+         ! second del2: div(h </font>
<font color="gray">abla [delsq_tracer]) at cell center
+         do iEdge=1,grid % nEdges
+            cell1 = grid % cellsOnEdge % array(1,iEdge)
+            cell2 = grid % cellsOnEdge % array(2,iEdge)
+            invAreaCell1 = 1.0 / grid % areaCell % array(cell1)
+            invAreaCell2 = 1.0 / grid % areaCell % array(cell2)
+
+            do k=1,grid % nVertLevels
+            do iTracer=1,grid % nTracers
+               tracer_turb_flux = config_h_tracer_eddy_diff4 * (delsq_tracer(iTracer,k,cell2) - delsq_tracer(iTracer,k,cell1)) / dcEdge(iEdge)
+               flux = dvEdge(iEdge) * tracer_turb_flux
+               tracer_tend(iTracer,k,cell1) = tracer_tend(iTracer,k,cell1) - flux * invAreaCell1 * boundaryMask(k,iEdge)
+               tracer_tend(iTracer,k,cell2) = tracer_tend(iTracer,k,cell2) + flux * invAreaCell2 * boundaryMask(k,iEdge)
+            end do
+            enddo
+
+         end do
+
+         deallocate(delsq_tracer)
+         deallocate(boundaryMask)
+
+      end if
+
+   end subroutine sw_compute_scalar_tend
+
+
+   subroutine sw_compute_solve_diagnostics(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
+
+
+      integer :: iEdge, iCell, iVertex, k, cell1, cell2, vertex1, vertex2, eoe, i, j, cov
+      real (kind=RKIND) :: flux, vorticity_abs, workpv
+
+      integer :: nCells, nEdges, nVertices, nVertLevels
+      real (kind=RKIND), dimension(:), pointer :: h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
+      real (kind=RKIND), dimension(:,:), pointer :: vh, weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, tend_h, tend_u, &amp;
+                                                    circulation, vorticity, ke, pv_edge, pv_vertex, pv_cell, gradPVn, gradPVt, divergence, &amp;
+                                                    h_vertex, vorticity_cell
+      integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex, boundaryEdge, boundaryCell
+      integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge
+      real (kind=RKIND) :: r, h1, h2
+      real (kind=RKIND) :: d2fdx2_cell1, d2fdx2_cell2
+      real (kind=RKIND), dimension(:,:,:), pointer :: deriv_two
+      real (kind=RKIND) :: coef_3rd_order
+
+      h           =&gt; s % h % array
+      u           =&gt; s % u % array
+      v           =&gt; s % v % array
+      vh          =&gt; s % vh % array
+      h_edge      =&gt; s % h_edge % array
+      h_vertex    =&gt; s % h_vertex % array
+      tend_h      =&gt; s % h % array
+      tend_u      =&gt; s % u % array
+      circulation =&gt; s % circulation % array
+      vorticity   =&gt; s % vorticity % array
+      divergence  =&gt; s % divergence % array
+      ke          =&gt; s % ke % array
+      pv_edge     =&gt; s % pv_edge % array
+      pv_vertex   =&gt; s % pv_vertex % array
+      pv_cell     =&gt; s % pv_cell % array
+      vorticity_cell =&gt; s % vorticity_cell % array
+      gradPVn     =&gt; s % gradPVn % array
+      gradPVt     =&gt; s % gradPVt % array
+
+      weightsOnEdge     =&gt; grid % weightsOnEdge % array
+      kiteAreasOnVertex =&gt; grid % kiteAreasOnVertex % array
+      cellsOnEdge       =&gt; grid % cellsOnEdge % array
+      cellsOnVertex     =&gt; grid % cellsOnVertex % array
+      verticesOnEdge    =&gt; grid % verticesOnEdge % array
+      nEdgesOnCell      =&gt; grid % nEdgesOnCell % array
+      edgesOnCell       =&gt; grid % edgesOnCell % array
+      nEdgesOnEdge      =&gt; grid % nEdgesOnEdge % array
+      edgesOnEdge       =&gt; grid % edgesOnEdge % array
+      edgesOnVertex     =&gt; grid % edgesOnVertex % array
+      dcEdge            =&gt; grid % dcEdge % array
+      dvEdge            =&gt; grid % dvEdge % array
+      areaCell          =&gt; grid % areaCell % array
+      areaTriangle      =&gt; grid % areaTriangle % array
+      h_s               =&gt; grid % h_s % array
+      fVertex           =&gt; grid % fVertex % array
+      fEdge             =&gt; grid % fEdge % array
+      deriv_two         =&gt; grid % deriv_two % array
+                  
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+
+      boundaryEdge =&gt; grid % boundaryEdge % array
+      boundaryCell =&gt; grid % boundaryCell % array
+
+      !
+      ! Find those cells that have an edge on the boundary
+      !
+      boundaryCell(:,:) = 0
+      do iEdge=1,nEdges
+       do k=1,nVertLevels
+         if(boundaryEdge(k,iEdge).eq.1) then
+           cell1 = cellsOnEdge(1,iEdge)
+           cell2 = cellsOnEdge(2,iEdge)
+           boundaryCell(k,cell1) = 1
+           boundaryCell(k,cell2) = 1
+         endif
+       enddo
+      enddo
+
+      !
+      ! Compute height on cell edges at velocity locations
+      !   Namelist options control the order of accuracy of the reconstructed h_edge value
+      !
+
+      coef_3rd_order = 0.
+      if (config_thickness_adv_order == 3) coef_3rd_order = 1.0
+      if (config_thickness_adv_order == 3 .and. config_monotonic) coef_3rd_order = 0.25
+
+      if (config_thickness_adv_order == 2) then
+
+         do iEdge=1,grid % nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+            if (cell1 &lt;= grid%nCells .and. cell2 &lt;= grid%nCells) then
+               do k=1,grid % nVertLevels
+                  h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2))
+               end do 
+            end if
+         end do 
+
+      else if (config_thickness_adv_order == 3) then
+
+         do iEdge=1,grid%nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+
+            !-- if a cell not on the most outside ring of the halo
+            if (cell1 &lt;= grid%nCells .and. cell2 &lt;= grid%nCells) then
+
+               do k=1,grid % nVertLevels
+
+                  d2fdx2_cell1 = 0.0
+                  d2fdx2_cell2 = 0.0
+
+                  !-- if not a boundary cell
+                  if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
+
+                     d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1)
+                     d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2)
+
+                     !-- all edges of cell 1
+                     do i=1, grid % nEdgesOnCell % array (cell1)
+                             d2fdx2_cell1 = d2fdx2_cell1 + &amp;
+                             deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (i,cell1))
+                     end do
+
+                     !-- all edges of cell 2
+                     do i=1, grid % nEdgesOnCell % array (cell2)
+                             d2fdx2_cell2 = d2fdx2_cell2 + &amp;
+                             deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
+                     end do
+
+                  endif
+
+                  !-- if u &gt; 0:
+                  if (u(k,iEdge) &gt; 0) then
+                     h_edge(k,iEdge) =     &amp;
+                          0.5*(h(k,cell1) + h(k,cell2))      &amp;
+                          -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
+                          -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
+                  !-- else u &lt;= 0:
+                  else
+                     h_edge(k,iEdge) =     &amp;
+                          0.5*(h(k,cell1) + h(k,cell2))      &amp;
+                          -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.          &amp;
+                          +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
+                  end if
+
+               end do   ! do k
+            end if      ! if (cell1 &lt;=
+         end do         ! do iEdge
+
+      else  if (config_thickness_adv_order == 4) then
+
+         do iEdge=1,grid%nEdges
+            cell1 = cellsOnEdge(1,iEdge)
+            cell2 = cellsOnEdge(2,iEdge)
+
+            !-- if a cell not on the most outside ring of the halo
+            if (cell1 &lt;= grid%nCells .and. cell2 &lt;= grid%nCells) then
+
+               do k=1,grid % nVertLevels
+
+                  d2fdx2_cell1 = 0.0
+                  d2fdx2_cell2 = 0.0
+
+                  !-- if not a boundary cell
+                  if(boundaryCell(k,cell1).eq.0.and.boundaryCell(k,cell2).eq.0) then
+
+                     d2fdx2_cell1 = deriv_two(1,1,iEdge) * h(k,cell1)
+                     d2fdx2_cell2 = deriv_two(1,2,iEdge) * h(k,cell2)
+
+                     !-- all edges of cell 1
+                     do i=1, grid % nEdgesOnCell % array (cell1)
+                             d2fdx2_cell1 = d2fdx2_cell1 + &amp;
+                             deriv_two(i+1,1,iEdge) * h(k,grid % CellsOnCell % array (i,cell1))
+                     end do
+
+                     !-- all edges of cell 2
+                     do i=1, grid % nEdgesOnCell % array (cell2)
+                             d2fdx2_cell2 = d2fdx2_cell2 + &amp;
+                             deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
+                     end do
+
+                  endif
+
+                  h_edge(k,iEdge) =   &amp;
+                       0.5*(h(k,cell1) + h(k,cell2))      &amp;
+                          -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.
+
+               end do   ! do k
+            end if      ! if (cell1 &lt;=
+         end do         ! do iEdge
+
+      endif   ! if(config_thickness_adv_order == 2)
+
+      !
+      ! set the velocity in the nEdges+1 slot to zero, this is a dummy address
+      !    used to when reading for edges that do not exist
+      !
+      u(:,nEdges+1) = 0.0
+
+      !
+      ! Compute circulation and relative vorticity at each vertex
+      !
+      circulation(:,:) = 0.0
+      do iEdge=1,nEdges
+         do k=1,nVertLevels
+            circulation(k,verticesOnEdge(1,iEdge)) = circulation(k,verticesOnEdge(1,iEdge)) - dcEdge(iEdge) * u(k,iEdge)
+            circulation(k,verticesOnEdge(2,iEdge)) = circulation(k,verticesOnEdge(2,iEdge)) + dcEdge(iEdge) * u(k,iEdge)
+         end do
+      end do
+      do iVertex=1,nVertices
+         do k=1,nVertLevels
+            vorticity(k,iVertex) = circulation(k,iVertex) / areaTriangle(iVertex)
+         end do
+      end do
+
+
+      !
+      ! Compute the divergence at each cell center
+      !
+      divergence(:,:) = 0.0
+      do iEdge=1,nEdges
+         cell1 = cellsOnEdge(1,iEdge)
+         cell2 = cellsOnEdge(2,iEdge)
+         if (cell1 &lt;= nCells) then
+            do k=1,nVertLevels
+              divergence(k,cell1) = divergence(k,cell1) + u(k,iEdge)*dvEdge(iEdge)
+            enddo
+         endif
+         if(cell2 &lt;= nCells) then
+            do k=1,nVertLevels
+              divergence(k,cell2) = divergence(k,cell2) - u(k,iEdge)*dvEdge(iEdge)
+            enddo
+         end if
+      end do
+      do iCell = 1,nCells
+        r = 1.0 / areaCell(iCell)
+        do k = 1,nVertLevels
+           divergence(k,iCell) = divergence(k,iCell) * r
+        enddo
+      enddo
+
+      !
+      ! Compute kinetic energy in each cell
+      !
+      ke(:,:) = 0.0
+      do iCell=1,nCells
+         do i=1,nEdgesOnCell(iCell)
+            iEdge = edgesOnCell(i,iCell)
+            do k=1,nVertLevels
+               ke(k,iCell) = ke(k,iCell) + 0.25 * dcEdge(iEdge) * dvEdge(iEdge) * u(k,iEdge)**2.0
+            end do
+         end do
+         do k=1,nVertLevels
+            ke(k,iCell) = ke(k,iCell) / areaCell(iCell)
+         end do
+      end do
+
+      !
+      ! Compute v (tangential) velocities
+      !
+      v(:,:) = 0.0
+      do iEdge = 1,nEdges
+         do i=1,nEdgesOnEdge(iEdge)
+            eoe = edgesOnEdge(i,iEdge)
+            do k = 1,nVertLevels
+               v(k,iEdge) = v(k,iEdge) + weightsOnEdge(i,iEdge) * u(k, eoe)
+            end do
+         end do
+      end do
+
+#ifdef NCAR_FORMULATION
+      !
+      ! Compute mass fluxes tangential to each edge (i.e., through the faces of dual grid cells)
+      !
+      vh(:,:) = 0.0
+      do iEdge=1,grid % nEdgesSolve
+         do j=1,nEdgesOnEdge(iEdge)
+            eoe = edgesOnEdge(j,iEdge)
+            do k=1,nVertLevels
+               vh(k,iEdge) = vh(k,iEdge) + weightsOnEdge(j,iEdge) * u(k,eoe) * h_edge(k,eoe)
+            end do
+         end do
+      end do
+#endif
+
+
+      !
+      ! 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 )
+      !
+      do iVertex = 1,nVertices
+         do k=1,nVertLevels
+            h_vertex(k,iVertex) = 0.0
+            do i=1,grid % vertexDegree
+               h_vertex(k,iVertex) = h_vertex(k,iVertex) + h(k,cellsOnVertex(i,iVertex)) * kiteAreasOnVertex(i,iVertex)
+            end do
+            h_vertex(k,iVertex) = h_vertex(k,iVertex) / areaTriangle(iVertex)
+
+            pv_vertex(k,iVertex) = (fVertex(iVertex) + vorticity(k,iVertex)) / h_vertex(k,iVertex)
+         end do
+      end do
+
+
+      !
+      ! Compute gradient of PV in the tangent direction
+      !   ( this computes gradPVt at all edges bounding real cells and distance-1 ghost cells )
+      !
+      do iEdge = 1,nEdges
+         do k = 1,nVertLevels
+           gradPVt(k,iEdge) = (pv_vertex(k,verticesOnEdge(2,iEdge)) - pv_vertex(k,verticesOnEdge(1,iEdge))) / &amp;
+                              dvEdge(iEdge)
+         enddo
+      enddo
+
+      !
+      ! Compute pv at the edges
+      !   ( this computes pv_edge at all edges bounding real cells )
+      !
+      pv_edge(:,:) = 0.0
+      do iVertex = 1,nVertices
+        do i=1,grid % vertexDegree
+           iEdge = edgesOnVertex(i,iVertex)
+           do k=1,nVertLevels
+              pv_edge(k,iEdge) =  pv_edge(k,iEdge)  + 0.5 * pv_vertex(k,iVertex)
+           end do
+        end do
+      end do
+
+
+      !
+      ! Modify PV edge with upstream bias. 
+      !
+      do iEdge = 1,nEdges
+         do k = 1,nVertLevels
+           pv_edge(k,iEdge) = pv_edge(k,iEdge) - config_apvm_upwinding * v(k,iEdge) * dt * gradPVt(k,iEdge)
+         enddo
+      enddo
+
+
+      !
+      ! Compute pv at cell centers
+      !    ( this computes pv_cell for all real cells and distance-1 ghost cells )
+      !
+      pv_cell(:,:) = 0.0
+      vorticity_cell(:,:) = 0.0
+      do iVertex = 1, nVertices
+       do i=1,grid % vertexDegree
+         iCell = cellsOnVertex(i,iVertex)
+         if (iCell &lt;= nCells) then
+           do k = 1,nVertLevels
+             pv_cell(k,iCell) = pv_cell(k,iCell) + kiteAreasOnVertex(i, iVertex) * pv_vertex(k, iVertex) / areaCell(iCell)
+             vorticity_cell(k,iCell) = vorticity_cell(k,iCell) + kiteAreasOnVertex(i, iVertex) * vorticity(k, iVertex) / areaCell(iCell)
+           enddo
+         endif
+       enddo
+      enddo
+
+
+      !
+      ! Compute gradient of PV in normal direction
+      !   ( this computes gradPVn for all edges bounding real cells )
+      !
+      gradPVn(:,:) = 0.0
+      do iEdge = 1,nEdges
+        if( cellsOnEdge(1,iEdge) &lt;= nCells .and. cellsOnEdge(2,iEdge) &lt;= nCells) then
+          do k = 1,nVertLevels
+            gradPVn(k,iEdge) = (pv_cell(k,cellsOnEdge(2,iEdge)) - pv_cell(k,cellsOnEdge(1,iEdge))) / &amp;
+                                 dcEdge(iEdge)
+          enddo
+        endif
+      enddo
+
+      ! Modify PV edge with upstream bias.
+      !
+      do iEdge = 1,nEdges
+         do k = 1,nVertLevels
+           pv_edge(k,iEdge) = pv_edge(k,iEdge) - config_apvm_upwinding * u(k,iEdge) * dt * gradPVn(k,iEdge)
+         enddo
+      enddo
+
+      !
+      ! set pv_edge = fEdge / h_edge at boundary points
+      !
+   !  if (maxval(boundaryEdge).ge.0) then
+   !  do iEdge = 1,nEdges
+   !     cell1 = cellsOnEdge(1,iEdge)
+   !     cell2 = cellsOnEdge(2,iEdge)
+   !     do k = 1,nVertLevels
+   !       if(boundaryEdge(k,iEdge).eq.1) then
+   !         v(k,iEdge) = 0.0
+   !         if(cell1.gt.0) then
+   !            h1 = h(k,cell1)
+   !            pv_edge(k,iEdge) = fEdge(iEdge) / h1
+   !            h_edge(k,iEdge) = h1
+   !         else
+   !            h2 = h(k,cell2)
+   !            pv_edge(k,iEdge) = fEdge(iEdge) / h2
+   !            h_edge(k,iEdge) = h2
+   !         endif
+   !       endif
+   !     enddo
+   !  enddo
+   !  endif
+
+
+   end subroutine sw_compute_solve_diagnostics
+
+
+   subroutine sw_enforce_boundary_edge(tend, grid)
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   ! Enforce any boundary conditions on the normal velocity at each edge
+   !
+   ! Input: grid - grid metadata
+   !
+   ! Output: tend_u set to zero at boundaryEdge == 1 locations
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+      implicit none
+
+      type (tend_type), intent(inout) :: tend
+      type (mesh_type), intent(in) :: grid
+
+      integer, dimension(:,:), pointer :: boundaryEdge
+      real (kind=RKIND), dimension(:,:), pointer :: tend_u
+      integer :: nCells, nEdges, nVertices, nVertLevels
+      integer :: iEdge, k
+
+      nCells      = grid % nCells
+      nEdges      = grid % nEdges
+      nVertices   = grid % nVertices
+      nVertLevels = grid % nVertLevels
+
+      boundaryEdge         =&gt; grid % boundaryEdge % array
+      tend_u               =&gt; tend % u % array
+
+      if(maxval(boundaryEdge).le.0) return
+
+      do iEdge = 1,nEdges
+        do k = 1,nVertLevels
+
+          if(boundaryEdge(k,iEdge).eq.1) then
+             tend_u(k,iEdge) = 0.0
+          endif
+
+        enddo
+       enddo
+
+   end subroutine sw_enforce_boundary_edge
+
+
+end module sw_time_integration

Deleted: branches/source_condensing/src/driver/Makefile
===================================================================
--- trunk/mpas/src/driver/Makefile        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/driver/Makefile        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,18 +0,0 @@
-.SUFFIXES: .F .o
-
-OBJS = module_mpas_subdriver.o \
-       mpas.o
-
-all: $(OBJS)
-
-module_mpas_subdriver.o: 
-
-mpas.o: module_mpas_subdriver.o
-
-clean:
-        $(RM) *.o *.mod *.f90
-
-.F.o:
-        $(RM) $@ $*.mod
-        $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $&lt; &gt; $*.f90
-        $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework -I../core_$(CORE) -I../external/esmf_time_f90

Copied: branches/source_condensing/src/driver/Makefile (from rev 1114, trunk/mpas/src/driver/Makefile)
===================================================================
--- branches/source_condensing/src/driver/Makefile                                (rev 0)
+++ branches/source_condensing/src/driver/Makefile        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,18 @@
+.SUFFIXES: .F .o
+
+OBJS = mpas_subdriver.o \
+       mpas.o
+
+all: $(OBJS)
+
+mpas_subdriver.o: 
+
+mpas.o: mpas_subdriver.o
+
+clean:
+        $(RM) *.o *.mod *.f90
+
+.F.o:
+        $(RM) $@ $*.mod
+        $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $&lt; &gt; $*.f90
+        $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework -I../core_$(CORE) -I../external/esmf_time_f90

Deleted: branches/source_condensing/src/driver/module_mpas_subdriver.F
===================================================================
--- trunk/mpas/src/driver/module_mpas_subdriver.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/driver/module_mpas_subdriver.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,93 +0,0 @@
-module mpas_subdriver
-
-   use mpas_framework
-   use mpas_core
-
-   type (dm_info), pointer :: dminfo
-   type (domain_type), pointer :: domain
-   type (io_output_object) :: output_obj
-   integer :: output_frame
-
-
-   contains
-
-
-   subroutine mpas_init()

-      implicit none
-
-      real (kind=RKIND) :: dt
-      character(len=32) :: timeStamp
-
-      call timer_start(&quot;total time&quot;)
-      call timer_start(&quot;initialize&quot;)
-
-
-      !
-      ! Initialize infrastructure
-      !
-      call mpas_framework_init(dminfo, domain)
-
-
-      call input_state_for_domain(domain)
-
-
-      !
-      ! Initialize core
-      !
-      call mpas_core_init(domain, timeStamp)
-
-      call timer_stop(&quot;initialize&quot;)
-
-
-      !
-      ! Set up output streams to be written to by the MPAS core
-      !
-      output_frame = 1
-
-      if(config_frames_per_outfile &gt; 0) then
-         call output_state_init(output_obj, domain, &quot;OUTPUT&quot;, trim(timeStamp))
-      else
-         call output_state_init(output_obj, domain, &quot;OUTPUT&quot;)         
-      end if
-
-
-   end subroutine mpas_init
-
-
-   subroutine mpas_run()
-
-      implicit none
-
-      call mpas_core_run(domain, output_obj, output_frame)
-
-   end subroutine mpas_run
-
-
-   subroutine mpas_finalize()
-   
-      implicit none
-
-      !
-      ! Finalize output streams
-      !
-      call output_state_finalize(output_obj, domain % dminfo)
-
-
-      !
-      ! Finalize core
-      !
-      call mpas_core_finalize(domain)
-
-      call timer_stop(&quot;total time&quot;)
-      call timer_write()
-
-
-      !
-      ! Finalize infrastructure
-      !
-      call mpas_framework_finalize(dminfo, domain)
-
-   end subroutine mpas_finalize
-
-end module mpas_subdriver

Copied: branches/source_condensing/src/driver/mpas_subdriver.F (from rev 1114, trunk/mpas/src/driver/mpas_subdriver.F)
===================================================================
--- branches/source_condensing/src/driver/mpas_subdriver.F                                (rev 0)
+++ branches/source_condensing/src/driver/mpas_subdriver.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,93 @@
+module mpas_subdriver
+
+   use mpas_framework
+   use mpas_core
+
+   type (dm_info), pointer :: dminfo
+   type (domain_type), pointer :: domain
+   type (io_output_object) :: output_obj
+   integer :: output_frame
+
+
+   contains
+
+
+   subroutine mpas_init()

+      implicit none
+
+      real (kind=RKIND) :: dt
+      character(len=32) :: timeStamp
+
+      call mpas_timer_start(&quot;total time&quot;)
+      call mpas_timer_start(&quot;initialize&quot;)
+
+
+      !
+      ! Initialize infrastructure
+      !
+      call mpas_framework_init(dminfo, domain)
+
+
+      call mpas_input_state_for_domain(domain)
+
+
+      !
+      ! Initialize core
+      !
+      call mpas_core_init(domain, timeStamp)
+
+      call mpas_timer_stop(&quot;initialize&quot;)
+
+
+      !
+      ! Set up output streams to be written to by the MPAS core
+      !
+      output_frame = 1
+
+      if(config_frames_per_outfile &gt; 0) then
+         call mpas_output_state_init(output_obj, domain, &quot;OUTPUT&quot;, trim(timeStamp))
+      else
+         call mpas_output_state_init(output_obj, domain, &quot;OUTPUT&quot;)         
+      end if
+
+
+   end subroutine mpas_init
+
+
+   subroutine mpas_run()
+
+      implicit none
+
+      call mpas_core_run(domain, output_obj, output_frame)
+
+   end subroutine mpas_run
+
+
+   subroutine mpas_finalize()
+   
+      implicit none
+
+      !
+      ! Finalize output streams
+      !
+      call mpas_output_state_finalize(output_obj, domain % dminfo)
+
+
+      !
+      ! Finalize core
+      !
+      call mpas_core_finalize(domain)
+
+      call mpas_timer_stop(&quot;total time&quot;)
+      call mpas_timer_write()
+
+
+      !
+      ! Finalize infrastructure
+      !
+      call mpas_framework_finalize(dminfo, domain)
+
+   end subroutine mpas_finalize
+
+end module mpas_subdriver

Deleted: branches/source_condensing/src/framework/Makefile
===================================================================
--- trunk/mpas/src/framework/Makefile        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/Makefile        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,50 +0,0 @@
-.SUFFIXES: .F .o
-
-ifdef ZOLTAN_HOME
-   ZOLTANOBJ = module_zoltan_interface.o
-endif
-
-OBJS = module_mpas_framework.o \
-       module_timer.o \
-       module_mpas_timekeeping.o \
-       module_configure.o \
-       module_constants.o \
-       module_grid_types.o \
-       module_hash.o \
-       module_sort.o \
-       module_block_decomp.o \
-       module_dmpar.o \
-       module_io_input.o \
-       module_io_output.o \
-       $(ZOLTANOBJ) \
-       streams.o
-
-all: framework
-
-framework: $(OBJS)
-        ar -ru libframework.a $(OBJS)
-
-module_mpas_framework.o: module_dmpar.o module_io_input.o module_io_output.o module_grid_types.o module_configure.o module_timer.o
-
-module_configure.o: module_dmpar.o
-
-module_grid_types.o: module_dmpar.o
-
-module_dmpar.o: module_sort.o streams.o
-
-module_block_decomp.o: module_grid_types.o module_hash.o module_configure.o
-
-module_io_input.o: module_grid_types.o module_dmpar.o module_block_decomp.o module_sort.o module_configure.o module_mpas_timekeeping.o $(ZOLTANOBJ)
-
-module_io_output.o: module_grid_types.o module_dmpar.o module_sort.o module_configure.o
-
-clean:
-        $(RM) *.o *.mod *.f90 libframework.a
-
-.F.o:
-        $(RM) $@ $*.mod
-        $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $&lt; &gt; $*.f90
-        $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../external/esmf_time_f90
-
-.c.o:
-        $(CC) $(CFLAGS) $(CPPFLAGS) $(CPPINCLUDES) -c $&lt;

Copied: branches/source_condensing/src/framework/Makefile (from rev 1114, trunk/mpas/src/framework/Makefile)
===================================================================
--- branches/source_condensing/src/framework/Makefile                                (rev 0)
+++ branches/source_condensing/src/framework/Makefile        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,50 @@
+.SUFFIXES: .F .o
+
+ifdef ZOLTAN_HOME
+   ZOLTANOBJ = mpas_zoltan_interface.o
+endif
+
+OBJS = mpas_framework.o \
+       mpas_timer.o \
+       mpas_timekeeping.o \
+       mpas_configure.o \
+       mpas_constants.o \
+       mpas_grid_types.o \
+       mpas_hash.o \
+       mpas_sort.o \
+       mpas_block_decomp.o \
+       mpas_dmpar.o \
+       mpas_io_input.o \
+       mpas_io_output.o \
+       $(ZOLTANOBJ) \
+       streams.o
+
+all: framework
+
+framework: $(OBJS)
+        ar -ru libframework.a $(OBJS)
+
+mpas_framework.o: mpas_dmpar.o mpas_io_input.o mpas_io_output.o mpas_grid_types.o mpas_configure.o mpas_timer.o
+
+mpas_configure.o: mpas_dmpar.o
+
+mpas_grid_types.o: mpas_dmpar.o
+
+mpas_dmpar.o: mpas_sort.o streams.o
+
+mpas_block_decomp.o: mpas_grid_types.o mpas_hash.o mpas_configure.o
+
+mpas_io_input.o: mpas_grid_types.o mpas_dmpar.o mpas_block_decomp.o mpas_sort.o mpas_configure.o mpas_timekeeping.o $(ZOLTANOBJ)
+
+mpas_io_output.o: mpas_grid_types.o mpas_dmpar.o mpas_sort.o mpas_configure.o
+
+clean:
+        $(RM) *.o *.mod *.f90 libframework.a
+
+.F.o:
+        $(RM) $@ $*.mod
+        $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $&lt; &gt; $*.f90
+        $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../external/esmf_time_f90
+
+.c.o:
+        $(CC) $(CFLAGS) $(CPPFLAGS) $(CPPINCLUDES) -c $&lt;

Deleted: branches/source_condensing/src/framework/module_block_decomp.F
===================================================================
--- trunk/mpas/src/framework/module_block_decomp.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/module_block_decomp.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,306 +0,0 @@
-module block_decomp
-
-   use dmpar
-   use hash
-
-   type graph
-      integer :: nVerticesTotal
-      integer :: nVertices, maxDegree
-      integer :: ghostStart
-      integer, dimension(:), pointer :: vertexID
-      integer, dimension(:), pointer :: nAdjacent
-      integer, dimension(:,:), pointer :: adjacencyList
-   end type graph
-
-
-   contains
-
-
-   subroutine block_decomp_cells_for_proc(dminfo, partial_global_graph_info, local_cell_list)
-
-      use configure
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      type (graph), intent(in) :: partial_global_graph_info
-      integer, dimension(:), pointer :: local_cell_list
-
-      integer, dimension(:), pointer :: global_cell_list
-      integer, dimension(:), pointer :: global_start
-
-      integer :: i, j, owner, iunit, istatus
-      integer, dimension(:), pointer :: local_nvertices
-      character (len=256) :: filename
-
-      if (dminfo % nprocs &gt; 1) then
-
-         allocate(local_nvertices(dminfo % nprocs))
-         allocate(global_start(dminfo % nprocs))
-         allocate(global_cell_list(partial_global_graph_info % nVerticesTotal))
-
-         if (dminfo % my_proc_id == IO_NODE) then
-
-            iunit = 50 + dminfo % my_proc_id
-            if (dminfo % nprocs &lt; 10) then
-               write(filename,'(a,i1)') trim(config_decomp_file_prefix), dminfo % nprocs
-            else if (dminfo % nprocs &lt; 100) then
-               write(filename,'(a,i2)') trim(config_decomp_file_prefix), dminfo % nprocs
-            else if (dminfo % nprocs &lt; 1000) then
-               write(filename,'(a,i3)') trim(config_decomp_file_prefix), dminfo % nprocs
-            else if (dminfo % nprocs &lt; 10000) then
-               write(filename,'(a,i4)') trim(config_decomp_file_prefix), dminfo % nprocs
-            else if (dminfo % nprocs &lt; 100000) then
-               write(filename,'(a,i5)') trim(config_decomp_file_prefix), dminfo % nprocs
-            end if
-          
-            open(unit=iunit, file=trim(filename), form='formatted', status='old', iostat=istatus)
-      
-            if (istatus /= 0) then
-               write(0,*) 'Could not open block decomposition file for ',dminfo % nprocs,' tasks.'
-               write(0,*) 'Filename: ',trim(filename)
-               call dmpar_abort(dminfo)
-            end if
-      
-            local_nvertices(:) = 0
-            do i=1,partial_global_graph_info % nVerticesTotal
-               read(unit=iunit, fmt=*) owner
-               local_nvertices(owner+1) = local_nvertices(owner+1) + 1
-            end do
-      
-!            allocate(global_cell_list(partial_global_graph_info % nVerticesTotal))
-
-            global_start(1) = 1
-            do i=2,dminfo % nprocs
-               global_start(i) = global_start(i-1) + local_nvertices(i-1)
-            end do
-      
-            rewind(unit=iunit)
-      
-            do i=1,partial_global_graph_info % nVerticesTotal
-               read(unit=iunit, fmt=*) owner
-               global_cell_list(global_start(owner+1)) = i
-               global_start(owner+1) = global_start(owner+1) + 1
-            end do
-
-            global_start(1) = 0
-            do i=2,dminfo % nprocs
-               global_start(i) = global_start(i-1) + local_nvertices(i-1)
-            end do
-
-            close(unit=iunit)
-
-            call dmpar_bcast_ints(dminfo, dminfo % nprocs, local_nvertices)
-            allocate(local_cell_list(local_nvertices(dminfo % my_proc_id + 1)))
-
-            call dmpar_scatter_ints(dminfo, dminfo % nprocs, local_nvertices(dminfo % my_proc_id + 1), &amp;
-                                    global_start, local_nvertices, global_cell_list, local_cell_list)
-
-         else
-
-            call dmpar_bcast_ints(dminfo, dminfo % nprocs, local_nvertices)
-            allocate(local_cell_list(local_nvertices(dminfo % my_proc_id + 1)))
-
-            call dmpar_scatter_ints(dminfo, dminfo % nprocs, local_nvertices(dminfo % my_proc_id + 1), &amp;
-                                    global_start, local_nvertices, global_cell_list, local_cell_list)
-
-         end if
-
-         deallocate(local_nvertices)
-         deallocate(global_start)
-         deallocate(global_cell_list)
-      else
-         allocate(local_cell_list(partial_global_graph_info % nVerticesTotal))
-         do i=1,size(local_cell_list)
-            local_cell_list(i) = i
-         end do
-      endif
-
-   end subroutine block_decomp_cells_for_proc
-
-
-   subroutine block_decomp_partitioned_edge_list(nCells, cellIDList, maxCells, nEdges, cellsOnEdge, edgeIDList, ghostEdgeStart)
-
-      implicit none
-
-      integer, intent(in) :: nCells, maxCells, nEdges
-      integer, dimension(nCells), intent(in) :: cellIDList
-      integer, dimension(maxCells, nEdges), intent(in) :: cellsOnEdge
-      integer, dimension(nEdges), intent(inout) :: edgeIDList
-      integer, intent(inout) :: ghostEdgeStart
-
-      integer :: i, j, lastEdge
-      integer, dimension(nEdges) :: edgeIDListLocal
-      type (hashtable) :: h
-
-      call hash_init(h)
-
-      do i=1,nCells
-         ! OPTIMIZATION: Actually, if we can assume that all cellIDs are unique, the if-test is unnecessary
-         if (.not. hash_search(h, cellIDList(i))) call hash_insert(h, cellIDList(i))
-      end do
-
-      lastEdge = 0
-      ghostEdgeStart = nEdges+1
-
-      edgeIDListLocal(:) = edgeIDList(:)
-
-      do i=1,nEdges
-         do j=1,maxCells
-            if (cellsOnEdge(j,i) /= 0) exit
-         end do
-         if (j &gt; maxCells) &amp;
-            write(0,*) 'Error in block_decomp_partitioned_edge_list: ',&amp;
-               'edge/vertex is not adjacent to any valid cells'
-         if (hash_search(h, cellsOnEdge(j,i))) then
-            lastEdge = lastEdge + 1
-            edgeIDList(lastEdge) = edgeIDListLocal(i)
-         else
-            ghostEdgeStart = ghostEdgeStart - 1
-            edgeIDList(ghostEdgeStart) = edgeIDListLocal(i)
-         end if
-         if (ghostEdgeStart &lt;= lastEdge) then
-           write(0,*) 'block_decomp_partitioned_edge_list: ',&amp;
-              'Somehow we have more edges than we thought we should.'
-         end if
-      end do
-
-      if (ghostEdgeStart /= lastEdge + 1) then
-         write(0,*) 'block_decomp_partitioned_edge_list:',&amp;
-            ' Somehow we didn''t have enough edges to fill edgeIDList.'
-      end if
-
-      call hash_destroy(h)
-
-   end subroutine block_decomp_partitioned_edge_list
-
-
-   subroutine block_decomp_all_edges_in_block(maxEdges, nCells, nEdgesOnCell, edgesOnCell, nEdges, edgeList)
-
-      implicit none
-
-      integer, intent(in) :: maxEdges, nCells
-      integer, dimension(nCells), intent(in) :: nEdgesOnCell
-      integer, dimension(maxEdges, nCells), intent(in) :: edgesOnCell
-      integer, intent(out) :: nEdges
-      integer, dimension(:), pointer :: edgeList
-
-      integer :: i, j, k
-      type (hashtable) :: h
-
-      call hash_init(h)
-
-      do i=1,nCells
-         do j=1,nEdgesOnCell(i)
-            if (.not. hash_search(h, edgesOnCell(j,i))) call hash_insert(h, edgesOnCell(j,i)) 
-         end do
-      end do
-
-      nEdges = hash_size(h)
-      allocate(edgeList(nEdges))
-
-      call hash_destroy(h)
-
-      call hash_init(h)
-
-      k = 0
-      do i=1,nCells
-         do j=1,nEdgesOnCell(i)
-            if (.not. hash_search(h, edgesOnCell(j,i))) then
-               k = k + 1
-               if (k &gt; nEdges) then
-                 write(0,*) 'block_decomp_all_edges_in_block: ',&amp;
-                    'Trying to add more edges than expected.'
-                 return
-               end if
-               edgeList(k) = edgesOnCell(j,i)
-               call hash_insert(h, edgesOnCell(j,i)) 
-            end if
-         end do
-      end do
-
-      call hash_destroy(h)
-
-      if (k &lt; nEdges) then
-         write(0,*) 'block_decomp_all_edges_in_block: ',&amp;
-            'Listed fewer edges than expected.'
-      end if
-
-   end subroutine block_decomp_all_edges_in_block
-
-
-   subroutine block_decomp_add_halo(dminfo, local_graph_info, local_graph_with_halo)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      type (graph), intent(in) :: local_graph_info
-      type (graph), intent(out) :: local_graph_with_halo
-
-      integer :: i, j, k
-      type (hashtable) :: h
-
-
-      call hash_init(h)
-
-      do i=1,local_graph_info % nVertices
-         call hash_insert(h, local_graph_info % vertexID(i))
-      end do
-
-      do i=1,local_graph_info % nVertices
-         do j=1,local_graph_info % nAdjacent(i)
-            if (local_graph_info % adjacencyList(j,i) /= 0) then
-               if (.not. hash_search(h, local_graph_info % adjacencyList(j,i))) then
-                  call hash_insert(h, local_graph_info % adjacencyList(j,i))
-               end if
-            end if
-         end do
-      end do 
-
-
-      local_graph_with_halo % nVertices = local_graph_info % nVertices
-      local_graph_with_halo % maxDegree = local_graph_info % maxDegree
-      local_graph_with_halo % nVerticesTotal = hash_size(h)
-      local_graph_with_halo % ghostStart = local_graph_with_halo % nVertices + 1
-      allocate(local_graph_with_halo % vertexID(local_graph_with_halo % nVerticesTotal))
-      allocate(local_graph_with_halo % nAdjacent(local_graph_with_halo % nVerticesTotal))
-      allocate(local_graph_with_halo % adjacencyList(local_graph_with_halo % maxDegree, local_graph_with_halo % nVerticesTotal))
-
-      call hash_destroy(h)
-
-      call hash_init(h)
-
-      do i=1,local_graph_info % nVertices
-         if (hash_search(h, local_graph_info % vertexID(i))) &amp;
-           write(0,*) 'block_decomp_add_halo: ', &amp;
-             'There appear to be duplicates in vertexID list.'
-         call hash_insert(h, local_graph_info % vertexID(i)) 
-         local_graph_with_halo % vertexID(i) = local_graph_info % vertexID(i) 
-         local_graph_with_halo % nAdjacent(i) = local_graph_info % nAdjacent(i) 
-         local_graph_with_halo % adjacencyList(:,i) = local_graph_info % adjacencyList(:,i) 
-      end do
-
-      k = local_graph_with_halo % ghostStart
-      if (hash_size(h) /= k-1) &amp;
-         write(0,*) 'block_decomp_add_halo: ',&amp;
-           'Somehow we don''t have the right number of non-ghost cells.'
-      do i=1,local_graph_info % nVertices
-         do j=1,local_graph_info % nAdjacent(i)
-            if (local_graph_info % adjacencyList(j,i) /= 0) then
-               if (.not. hash_search(h, local_graph_info % adjacencyList(j,i))) then
-                  call hash_insert(h, local_graph_info % adjacencyList(j,i))
-                  local_graph_with_halo % vertexID(k) = local_graph_info % adjacencyList(j,i)
-                  k = k + 1
-               end if
-            end if
-         end do
-      end do 
-      if (local_graph_with_halo % nVerticesTotal /= k-1) &amp;
-         write(0,*) 'block_decomp_add_halo: ',&amp; 
-           'Somehow we don''t have the right number of total cells.'
-
-      call hash_destroy(h)
-
-   end subroutine block_decomp_add_halo
-
-end module block_decomp

Deleted: branches/source_condensing/src/framework/module_configure.F
===================================================================
--- trunk/mpas/src/framework/module_configure.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/module_configure.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,36 +0,0 @@
-module configure
-
-   use dmpar
-
-#include &quot;config_defs.inc&quot;
-
-   contains
-
-
-   subroutine read_namelist(dminfo)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-
-      integer :: funit
-
-#include &quot;config_namelist_defs.inc&quot;
-
-      funit = 21
-
-      ! Set default values for namelist options
-#include &quot;config_set_defaults.inc&quot;
-
-      if (dminfo % my_proc_id == IO_NODE) then
-         open(funit,file='namelist.input',status='old',form='formatted')
-
-#include &quot;config_namelist_reads.inc&quot;
-         close(funit)
-      end if
-
-#include &quot;config_bcast_namelist.inc&quot;
-
-   end subroutine read_namelist
-
-end module configure

Deleted: branches/source_condensing/src/framework/module_constants.F
===================================================================
--- trunk/mpas/src/framework/module_constants.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/module_constants.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,20 +0,0 @@
-module constants
-
-   real (kind=RKIND), parameter :: pii     = 3.141592653589793   
-   real (kind=RKIND), parameter :: a       = 6371229.0
-   real (kind=RKIND), parameter :: omega   = 7.29212e-5
-   real (kind=RKIND), parameter :: gravity = 9.80616
-   real (kind=RKIND), parameter :: rgas = 287.
-   real (kind=RKIND), parameter :: cp = 1003.
-   real (kind=RKIND), parameter :: cv = 716.  ! cp - rgas
-   real (kind=RKIND), parameter :: cvpm = -.71385842 ! -cv/cp
-   real (kind=RKIND), parameter :: prandtl = 1.0
-
-
-   contains
-
-   subroutine dummy()
-
-   end subroutine dummy
-
-end module constants

Deleted: branches/source_condensing/src/framework/module_dmpar.F
===================================================================
--- trunk/mpas/src/framework/module_dmpar.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/module_dmpar.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,1928 +0,0 @@
-module dmpar
-
-   use sort
-
-#ifdef _MPI
-include 'mpif.h'
-   integer, parameter :: MPI_INTEGERKIND = MPI_INTEGER
-
-#if (RKIND == 8)
-   integer, parameter :: MPI_REALKIND = MPI_DOUBLE_PRECISION
-#else
-   integer, parameter :: MPI_REALKIND = MPI_REAL
-#endif
-#endif
-
-   integer, parameter :: IO_NODE = 0
-   integer, parameter :: BUFSIZE = 6000
-
-
-   type dm_info
-      integer :: nprocs, my_proc_id, comm, info
-   end type dm_info
-
-
-   type exchange_list
-      integer :: procID
-      integer :: nlist
-      integer, dimension(:), pointer :: list
-      type (exchange_list), pointer :: next
-      real (kind=RKIND), dimension(:), pointer :: rbuffer
-      integer, dimension(:), pointer           :: ibuffer
-      integer :: reqID
-   end type exchange_list
-
-
-   interface dmpar_alltoall_field
-      module procedure dmpar_alltoall_field1dInteger
-      module procedure dmpar_alltoall_field2dInteger
-      module procedure dmpar_alltoall_field1dReal
-      module procedure dmpar_alltoall_field2dReal
-      module procedure dmpar_alltoall_field3dReal
-   end interface
-
-
-   contains
-
-
-   subroutine dmpar_init(dminfo)
-
-      implicit none
-
-      type (dm_info), intent(inout) :: dminfo
-
-#ifdef _MPI
-      integer :: mpi_rank, mpi_size
-      integer :: mpi_ierr
-
-      ! Find out our rank and the total number of processors
-      call MPI_Init(mpi_ierr)
-      call MPI_Comm_rank(MPI_COMM_WORLD, mpi_rank, mpi_ierr)
-      call MPI_Comm_size(MPI_COMM_WORLD, mpi_size, mpi_ierr)
-
-      dminfo % comm = MPI_COMM_WORLD
-
-      dminfo % nprocs = mpi_size
-      dminfo % my_proc_id = mpi_rank
-
-      write(0,'(a,i5,a,i5,a)') 'task ', mpi_rank, ' of ', mpi_size, &amp;
-        ' is running'
-
-      call open_streams(dminfo % my_proc_id)
-
-      dminfo % info = MPI_INFO_NULL
-#else
-      dminfo % comm = 0
-      dminfo % my_proc_id = IO_NODE
-      dminfo % nprocs = 1
-#endif
-
-   end subroutine dmpar_init
-
-
-   subroutine dmpar_finalize(dminfo)
-
-      implicit none
-
-      type (dm_info), intent(inout) :: dminfo
-
-#ifdef _MPI
-      integer :: mpi_ierr
-
-      call MPI_Finalize(mpi_ierr)
-#endif
-
-   end subroutine dmpar_finalize
-
-
-   subroutine dmpar_abort(dminfo)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-
-#ifdef _MPI
-      integer :: mpi_ierr, mpi_errcode
-
-      call MPI_Abort(dminfo % comm, mpi_errcode, mpi_ierr)
-#endif
-
-      stop
-
-   end subroutine dmpar_abort
-
-
-   subroutine dmpar_global_abort(mesg)
-
-      implicit none
-
-      character (len=*), intent(in) :: mesg
-
-#ifdef _MPI
-      integer :: mpi_ierr, mpi_errcode
-
-      write(0,*) trim(mesg)
-      call MPI_Abort(MPI_COMM_WORLD, mpi_errcode, mpi_ierr)
-#endif
-
-      write(0,*) trim(mesg)
-      stop
-
-   end subroutine dmpar_global_abort
-
-
-   subroutine dmpar_bcast_int(dminfo, i)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(inout) :: i
-
-#ifdef _MPI
-      integer :: mpi_ierr
-
-      call MPI_Bcast(i, 1, MPI_INTEGERKIND, IO_NODE, dminfo % comm, mpi_ierr)
-#endif
-
-   end subroutine dmpar_bcast_int
-
-
-   subroutine dmpar_bcast_ints(dminfo, n, iarray)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: n
-      integer, dimension(n), intent(inout) :: iarray
-
-#ifdef _MPI
-      integer :: mpi_ierr
-
-      call MPI_Bcast(iarray, n, MPI_INTEGERKIND, IO_NODE, dminfo % comm, mpi_ierr)
-#endif
-
-   end subroutine dmpar_bcast_ints
-
-
-   subroutine dmpar_bcast_real(dminfo, r)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      real (kind=RKIND), intent(inout) :: r
-
-#ifdef _MPI
-      integer :: mpi_ierr
-
-      call MPI_Bcast(r, 1, MPI_REALKIND, IO_NODE, dminfo % comm, mpi_ierr)
-#endif
-
-   end subroutine dmpar_bcast_real
-
-
-   subroutine dmpar_bcast_reals(dminfo, n, rarray)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: n
-      real (kind=RKIND), dimension(n), intent(inout) :: rarray
-
-#ifdef _MPI
-      integer :: mpi_ierr
-
-      call MPI_Bcast(rarray, n, MPI_REALKIND, IO_NODE, dminfo % comm, mpi_ierr)
-#endif
-
-   end subroutine dmpar_bcast_reals
-
-
-   subroutine dmpar_bcast_logical(dminfo, l)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      logical, intent(inout) :: l
-
-#ifdef _MPI
-      integer :: mpi_ierr
-      integer :: itemp
-
-      if (dminfo % my_proc_id == IO_NODE) then
-         if (l) then
-            itemp = 1
-         else
-            itemp = 0
-         end if
-      end if
-
-      call MPI_Bcast(itemp, 1, MPI_INTEGERKIND, IO_NODE, dminfo % comm, mpi_ierr)
-
-      if (itemp == 1) then
-         l = .true.
-      else
-         l = .false.
-      end if
-#endif
-
-   end subroutine dmpar_bcast_logical
-
-
-   subroutine dmpar_bcast_char(dminfo, c)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      character (len=*), intent(inout) :: c
-
-#ifdef _MPI
-      integer :: mpi_ierr
-
-      call MPI_Bcast(c, len(c), MPI_CHARACTER, IO_NODE, dminfo % comm, mpi_ierr)
-#endif
-
-   end subroutine dmpar_bcast_char
-
-
-   subroutine dmpar_sum_int(dminfo, i, isum)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: i
-      integer, intent(out) :: isum
-
-      integer :: mpi_ierr
-
-#ifdef _MPI
-      call MPI_Allreduce(i, isum, 1, MPI_INTEGERKIND, MPI_SUM, dminfo % comm, mpi_ierr)
-#else
-      isum = i
-#endif
-
-   end subroutine dmpar_sum_int
-
-
-   subroutine dmpar_sum_real(dminfo, r, rsum)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      real(kind=RKIND), intent(in) :: r
-      real(kind=RKIND), intent(out) :: rsum
-
-      integer :: mpi_ierr
-
-#ifdef _MPI
-      call MPI_Allreduce(r, rsum, 1, MPI_REALKIND, MPI_SUM, dminfo % comm, mpi_ierr)
-#else
-      rsum = r
-#endif
-
-   end subroutine dmpar_sum_real
-
-
-   subroutine dmpar_min_int(dminfo, i, imin)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: i
-      integer, intent(out) :: imin
-
-      integer :: mpi_ierr
-
-#ifdef _MPI
-      call MPI_Allreduce(i, imin, 1, MPI_INTEGERKIND, MPI_MIN, dminfo % comm, mpi_ierr)
-#else
-      imin = i
-#endif
-
-   end subroutine dmpar_min_int
-
-
-   subroutine dmpar_min_real(dminfo, r, rmin)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      real(kind=RKIND), intent(in) :: r
-      real(kind=RKIND), intent(out) :: rmin
-
-      integer :: mpi_ierr
-
-#ifdef _MPI
-      call MPI_Allreduce(r, rmin, 1, MPI_REALKIND, MPI_MIN, dminfo % comm, mpi_ierr)
-#else
-      rmin = r
-#endif
-
-   end subroutine dmpar_min_real
-
-
-   subroutine dmpar_max_int(dminfo, i, imax)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: i
-      integer, intent(out) :: imax
-      
-      integer :: mpi_ierr 
-      
-#ifdef _MPI
-      call MPI_Allreduce(i, imax, 1, MPI_INTEGERKIND, MPI_MAX, dminfo % comm, mpi_ierr)
-#else
-      imax = i
-#endif
-
-   end subroutine dmpar_max_int
-
-
-   subroutine dmpar_max_real(dminfo, r, rmax)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      real(kind=RKIND), intent(in) :: r
-      real(kind=RKIND), intent(out) :: rmax
-
-      integer :: mpi_ierr
-
-#ifdef _MPI
-      call MPI_Allreduce(r, rmax, 1, MPI_REALKIND, MPI_MAX, dminfo % comm, mpi_ierr)
-#else
-      rmax = r
-#endif
-
-   end subroutine dmpar_max_real
-
-
-   subroutine dmpar_sum_int_array(dminfo, nElements, inArray, outArray)
-
-      implicit none
-   
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nElements
-      integer, dimension(nElements), intent(in) :: inArray
-      integer, dimension(nElements), intent(out) :: outArray
-      
-      integer :: mpi_ierr
-
-#ifdef _MPI
-      call MPI_Allreduce(inArray, outArray, nElements, MPI_INTEGERKIND, MPI_SUM, dminfo % comm, mpi_ierr)
-#else
-      outArray = inArray
-#endif
-
-   end subroutine dmpar_sum_int_array
-
-
-   subroutine dmpar_min_int_array(dminfo, nElements, inArray, outArray)
-   
-      implicit none
-      
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nElements
-      integer, dimension(nElements), intent(in) :: inArray
-      integer, dimension(nElements), intent(out) :: outArray
-
-      integer :: mpi_ierr
-
-#ifdef _MPI
-      call MPI_Allreduce(inArray, outArray, nElements, MPI_INTEGERKIND, MPI_MIN, dminfo % comm, mpi_ierr)
-#else
-      outArray = inArray
-#endif
-
-   end subroutine dmpar_min_int_array
-
-
-   subroutine dmpar_max_int_array(dminfo, nElements, inArray, outArray)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nElements
-      integer, dimension(nElements), intent(in) :: inArray
-      integer, dimension(nElements), intent(out) :: outArray
-
-      integer :: mpi_ierr
-
-#ifdef _MPI
-      call MPI_Allreduce(inArray, outArray, nElements, MPI_INTEGERKIND, MPI_MAX, dminfo % comm, mpi_ierr)
-#else
-      outArray = inArray
-#endif
-
-   end subroutine dmpar_max_int_array
-
-
-   subroutine dmpar_sum_real_array(dminfo, nElements, inArray, outArray)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nElements
-      real(kind=RKIND), dimension(nElements), intent(in) :: inArray
-      real(kind=RKIND), dimension(nElements), intent(out) :: outArray
-
-      integer :: mpi_ierr
-
-#ifdef _MPI
-      call MPI_Allreduce(inArray, outArray, nElements, MPI_REALKIND, MPI_SUM, dminfo % comm, mpi_ierr)
-#else
-      outArray = inArray
-#endif
-
-   end subroutine dmpar_sum_real_array
-
-
-   subroutine dmpar_min_real_array(dminfo, nElements, inArray, outArray)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nElements
-      real(kind=RKIND), dimension(nElements), intent(in) :: inArray
-      real(kind=RKIND), dimension(nElements), intent(out) :: outArray
-
-      integer :: mpi_ierr
-
-#ifdef _MPI
-      call MPI_Allreduce(inArray, outArray, nElements, MPI_REALKIND, MPI_MIN, dminfo % comm, mpi_ierr)
-#else
-      outArray = inArray
-#endif
-
-   end subroutine dmpar_min_real_array
-
-
-   subroutine dmpar_max_real_array(dminfo, nElements, inArray, outArray)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nElements
-      real(kind=RKIND), dimension(nElements), intent(in) :: inArray
-      real(kind=RKIND), dimension(nElements), intent(out) :: outArray
-
-      integer :: mpi_ierr
-
-#ifdef _MPI
-      call MPI_Allreduce(inArray, outArray, nElements, MPI_REALKIND, MPI_MAX, dminfo % comm, mpi_ierr)
-#else
-      outArray = inArray
-#endif
-
-   end subroutine dmpar_max_real_array
-
-
-   subroutine dmpar_scatter_ints(dminfo, nprocs, noutlist, displs, counts, inlist, outlist)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nprocs, noutlist
-      integer, dimension(nprocs), intent(in) :: displs, counts
-      integer, dimension(:), pointer :: inlist
-      integer, dimension(noutlist), intent(inout) :: outlist
-
-#ifdef _MPI
-      integer :: mpi_ierr
-      
-      call MPI_Scatterv(inlist, counts, displs, MPI_INTEGERKIND, outlist, noutlist, MPI_INTEGERKIND, IO_NODE, dminfo % comm, mpi_ierr)
-#endif
-
-   end subroutine dmpar_scatter_ints
-
-
-   subroutine dmpar_get_index_range(dminfo, &amp;
-                                    global_start, global_end, &amp;
-                                    local_start, local_end)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: global_start, global_end
-      integer, intent(out) :: local_start, local_end
-
-      local_start = nint(real(dminfo % my_proc_id) * real(global_end - global_start + 1) / real(dminfo % nprocs)) + 1
-      local_end   = nint(real(dminfo % my_proc_id + 1) * real(global_end - global_start + 1) / real(dminfo % nprocs)) 
-
-   end subroutine dmpar_get_index_range
-
-  
-   subroutine dmpar_compute_index_range(dminfo, &amp;
-                                        local_start, local_end, &amp;
-                                        global_start, global_end)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: local_start, local_end
-      integer, intent(inout) :: global_start, global_end
-
-      integer :: n
-      integer :: mpi_ierr
-
-      n = local_end - local_start + 1
-
-      if (dminfo % my_proc_id == 0) then
-         global_start = 1
-         global_end = global_start + n - 1
-         
-#ifdef _MPI
-      else if (dminfo % my_proc_id == dminfo % nprocs - 1) then
-         call MPI_Recv(global_start, 1, MPI_INTEGERKIND, dminfo % my_proc_id - 1, 0, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
-         global_end = global_start + n - 1
-
-      else
-         call MPI_Recv(global_start, 1, MPI_INTEGERKIND, dminfo % my_proc_id - 1, 0, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
-         global_end = global_start + n
-         call MPI_Send(global_end, 1, MPI_INTEGERKIND, dminfo % my_proc_id + 1, 0, dminfo % comm, mpi_ierr)
-         global_end = global_end - 1
-#endif
-
-      end if
-      
-   
-   end subroutine dmpar_compute_index_range
-
-
-   subroutine dmpar_get_owner_list(dminfo, &amp;
-                                   nOwnedList, nNeededList, &amp;
-                                   ownedList, neededList, &amp;
-                                   sendList, recvList)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: nOwnedList, nNeededList
-      integer, dimension(nOwnedList), intent(in) :: ownedList
-      integer, dimension(nNeededList), intent(in) :: neededList
-      type (exchange_list), pointer :: sendList
-      type (exchange_list), pointer :: recvList
-
-      integer :: i, j, k, kk
-      integer :: totalSize, nMesgRecv, nMesgSend, recvNeighbor, sendNeighbor, currentProc
-      integer :: numToSend, numToRecv
-      integer, dimension(nOwnedList) :: recipientList
-      integer, dimension(2,nOwnedList) :: ownedListSorted
-      integer, allocatable, dimension(:) :: ownerListIn, ownerListOut
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: mpi_ierr, mpi_rreq, mpi_sreq
-
-#ifdef _MPI
-      allocate(sendList)
-      allocate(recvList)
-      nullify(sendList % next)
-      nullify(recvList % next)
-      sendListPtr =&gt; sendList
-      recvListPtr =&gt; recvList
-
-      do i=1,nOwnedList
-         ownedListSorted(1,i) = ownedList(i)
-         ownedListSorted(2,i) = i
-      end do
-      call quicksort(nOwnedList, ownedListSorted)
-
-      call MPI_Allreduce(nNeededList, totalSize, 1, MPI_INTEGERKIND, MPI_MAX, dminfo % comm, mpi_ierr)
-
-      allocate(ownerListIn(totalSize))
-      allocate(ownerListOut(totalSize))
-
-      nMesgRecv = nNeededList
-      ownerListIn(1:nNeededList) = neededList(1:nNeededList)
-
-      recvNeighbor = mod(dminfo % my_proc_id + dminfo % nprocs - 1, dminfo % nprocs)
-      sendNeighbor = mod(dminfo % my_proc_id + 1, dminfo % nprocs)
-
-      do i=1, dminfo % nprocs
-
-         recipientList(:) = -1
-         numToSend = 0
-
-         currentProc = mod(dminfo % my_proc_id + dminfo % nprocs - i + 1, dminfo % nprocs)
-         do j=1,nMesgRecv
-            if (ownerListIn(j) &gt; 0) then
-               k = binary_search(ownedListSorted, 2, 1, nOwnedList, ownerListIn(j))
-               if (k &lt;= nOwnedList) then
-                  ownerListOut(j) = -1 * dminfo % my_proc_id
-                  numToSend = numToSend + 1
-                  recipientList(ownedListSorted(2,k)) = numToSend
-               else
-                  ownerListOut(j) = ownerListIn(j)
-               end if
-            else
-               ownerListOut(j) = ownerListIn(j)
-            end if
-         end do
-
-         if (numToSend &gt; 0) then
-            allocate(sendListPtr % next)
-            sendListPtr =&gt; sendListPtr % next
-            sendListPtr % procID = currentProc
-            sendListPtr % nlist = numToSend
-            allocate(sendListPtr % list(numToSend))
-            nullify(sendListPtr % next)
-            kk = 1
-            do j=1,nOwnedList
-               if (recipientList(j) /= -1) then
-                  sendListPtr % list(recipientList(j)) = j
-                  kk = kk + 1
-               end if
-            end do
-         end if
-
-         nMesgSend = nMesgRecv
-         call MPI_Irecv(nMesgRecv, 1, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
-         call MPI_Isend(nMesgSend, 1, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
-         call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
-         call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
-         call MPI_Irecv(ownerListIn, nMesgRecv, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
-         call MPI_Isend(ownerListOut, nMesgSend, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
-         call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
-         call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
-      end do
-
-      do i=0, dminfo % nprocs - 1
-
-         numToRecv = 0
-         do j=1,nNeededList
-            if (ownerListIn(j) == -i) numToRecv = numToRecv + 1
-         end do
-         if (numToRecv &gt; 0) then
-            allocate(recvListPtr % next)
-            recvListPtr =&gt; recvListPtr % next
-            recvListPtr % procID = i
-            recvListPtr % nlist = numToRecv
-            allocate(recvListPtr % list(numToRecv))
-            nullify(recvListPtr % next)
-            kk = 1
-            do j=1,nNeededList
-               if (ownerListIn(j) == -i) then
-                  recvListPtr % list(kk) = j
-                  kk = kk + 1
-               end if
-            end do
-         end if
-
-      end do
-
-      deallocate(ownerListIn)
-      deallocate(ownerListOut)
-
-      sendListPtr =&gt; sendList
-      sendList =&gt; sendList % next
-      deallocate(sendListPtr)
-
-      recvListPtr =&gt; recvList
-      recvList =&gt; recvList % next
-      deallocate(recvListPtr)
-
-#else
-      allocate(recvList)
-      recvList % procID = dminfo % my_proc_id
-      recvList % nlist = nNeededList
-      allocate(recvList % list(nNeededList))
-      nullify(recvList % next)
-      do j=1,nNeededList
-         recvList % list(j) = j
-      end do
-
-      allocate(sendList)
-      sendList % procID = dminfo % my_proc_id
-      sendList % nlist = nOwnedList
-      allocate(sendList % list(nOwnedList))
-      nullify(sendList % next)
-      do j=1,nOwnedList
-         sendList % list(j) = j
-      end do
-#endif
-
-   end subroutine dmpar_get_owner_list
-
-
-   subroutine dmpar_alltoall_field1dInteger(dminfo, arrayIn, arrayOut, nOwnedList, nNeededList, sendList, recvList)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, dimension(*), intent(in) :: arrayIn
-      integer, dimension(*), intent(inout) :: arrayOut
-      integer, intent(in) :: nOwnedList, nNeededList
-      type (exchange_list), pointer :: sendList, recvList
-
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-      integer :: i
-
-#ifdef _MPI
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID == dminfo % my_proc_id) exit
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID == dminfo % my_proc_id) exit
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      if (associated(recvListPtr) .and. associated(sendListPtr)) then
-         do i=1,recvListPtr % nlist
-            arrayOut(recvListPtr % list(i)) = arrayIn(sendListPtr % list(i))
-         end do
-      end if
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            allocate(recvListPtr % ibuffer(recvListPtr % nlist))
-            call MPI_Irecv(recvListPtr % ibuffer, recvListPtr % nlist, MPI_INTEGERKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            allocate(sendListPtr % ibuffer(sendListPtr % nlist))
-            call packSendBuf1dInteger(nOwnedList, arrayIn, sendListPtr, 1, sendListPtr % nlist, &amp;
-                                   sendListPtr % ibuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % ibuffer, sendListPtr % nlist, MPI_INTEGERKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            call unpackRecvBuf1dInteger(nNeededList, arrayOut, recvListPtr, 1, recvListPtr % nlist, &amp;
-                                     recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % ibuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % ibuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-#else
-      if (nOwnedList /= nNeededList) then
-         write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, ', &amp;
-           'arrayIn and arrayOut dims must match.'
-         call dmpar_abort(dminfo)
-      else
-         arrayOut(1:nNeededList) = arrayIn(1:nOwnedList)
-      end if
-#endif
-
-   end subroutine dmpar_alltoall_field1dInteger
-
-
-   subroutine dmpar_alltoall_field2dInteger(dminfo, arrayIn, arrayOut, dim1, nOwnedList, nNeededList, sendList, recvList)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: dim1, nOwnedList, nNeededList
-      integer, dimension(dim1,*), intent(in) :: arrayIn
-      integer, dimension(dim1,*), intent(inout) :: arrayOut
-      type (exchange_list), pointer :: sendList, recvList
-
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-      integer :: i, d2
-
-#ifdef _MPI
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID == dminfo % my_proc_id) exit
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID == dminfo % my_proc_id) exit
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      if (associated(recvListPtr) .and. associated(sendListPtr)) then
-         do i=1,recvListPtr % nlist
-            arrayOut(:,recvListPtr % list(i)) = arrayIn(:,sendListPtr % list(i))
-         end do
-      end if
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            d2 = dim1 * recvListPtr % nlist
-            allocate(recvListPtr % ibuffer(d2))
-            call MPI_Irecv(recvListPtr % ibuffer, d2, MPI_INTEGERKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            d2 = dim1 * sendListPtr % nlist
-            allocate(sendListPtr % ibuffer(d2))
-            call packSendBuf2dInteger(1, dim1, nOwnedList, arrayIn, sendListPtr, 1, d2, &amp;
-                                   sendListPtr % ibuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % ibuffer, d2, MPI_INTEGERKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            d2 = dim1 * recvListPtr % nlist
-            call unpackRecvBuf2dInteger(1, dim1, nNeededList, arrayOut, recvListPtr, 1, d2, &amp;
-                                     recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % ibuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % ibuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-#else
-      if (nOwnedList /= nNeededList) then
-         write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, ', &amp;
-           'arrayIn and arrayOut dims must match.'
-         call dmpar_abort(dminfo)
-      else
-         arrayOut(:,1:nNeededList) = arrayIn(:,1:nOwnedList)
-      end if
-#endif
-
-   end subroutine dmpar_alltoall_field2dInteger
-
-
-   subroutine dmpar_alltoall_field1dReal(dminfo, arrayIn, arrayOut, nOwnedList, nNeededList, sendList, recvList)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      real (kind=RKIND), dimension(*), intent(in) :: arrayIn
-      real (kind=RKIND), dimension(*), intent(inout) :: arrayOut
-      integer, intent(in) :: nOwnedList, nNeededList
-      type (exchange_list), pointer :: sendList, recvList
-
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-      integer :: i
-
-#ifdef _MPI
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID == dminfo % my_proc_id) exit
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID == dminfo % my_proc_id) exit
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      if (associated(recvListPtr) .and. associated(sendListPtr)) then
-         do i=1,recvListPtr % nlist
-            arrayOut(recvListPtr % list(i)) = arrayIn(sendListPtr % list(i))
-         end do
-      end if
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            allocate(recvListPtr % rbuffer(recvListPtr % nlist))
-            call MPI_Irecv(recvListPtr % rbuffer, recvListPtr % nlist, MPI_REALKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            allocate(sendListPtr % rbuffer(sendListPtr % nlist))
-            call packSendBuf1dReal(nOwnedList, arrayIn, sendListPtr, 1, sendListPtr % nlist, &amp;
-                                   sendListPtr % rbuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % rbuffer, sendListPtr % nlist, MPI_REALKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            call unpackRecvBuf1dReal(nNeededList, arrayOut, recvListPtr, 1, recvListPtr % nlist, &amp;
-                                     recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % rbuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % rbuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-#else
-      if (nOwnedList /= nNeededList) then
-         write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, ', &amp;
-           'arrayIn and arrayOut dims must match.'
-         call dmpar_abort(dminfo)
-      else
-         arrayOut(1:nNeededList) = arrayIn(1:nOwnedList)
-      end if
-#endif
-
-   end subroutine dmpar_alltoall_field1dReal
-
-
-   subroutine dmpar_alltoall_field2dReal(dminfo, arrayIn, arrayOut, dim1, nOwnedList, nNeededList, sendList, recvList)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: dim1, nOwnedList, nNeededList
-      real (kind=RKIND), dimension(dim1,*), intent(in) :: arrayIn
-      real (kind=RKIND), dimension(dim1,*), intent(inout) :: arrayOut
-      type (exchange_list), pointer :: sendList, recvList
-
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-      integer :: i, d2
-
-#ifdef _MPI
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID == dminfo % my_proc_id) exit
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID == dminfo % my_proc_id) exit
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      if (associated(recvListPtr) .and. associated(sendListPtr)) then
-         do i=1,recvListPtr % nlist
-            arrayOut(:,recvListPtr % list(i)) = arrayIn(:,sendListPtr % list(i))
-         end do
-      end if
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            d2 = dim1 * recvListPtr % nlist
-            allocate(recvListPtr % rbuffer(d2))
-            call MPI_Irecv(recvListPtr % rbuffer, d2, MPI_REALKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            d2 = dim1 * sendListPtr % nlist
-            allocate(sendListPtr % rbuffer(d2))
-            call packSendBuf2dReal(1, dim1, nOwnedList, arrayIn, sendListPtr, 1, d2, &amp;
-                                   sendListPtr % rbuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % rbuffer, d2, MPI_REALKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            d2 = dim1 * recvListPtr % nlist
-            call unpackRecvBuf2dReal(1, dim1, nNeededList, arrayOut, recvListPtr, 1, d2, &amp;
-                                     recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % rbuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % rbuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-#else
-      if (nOwnedList /= nNeededList) then
-         write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, ', &amp;
-           'arrayIn and arrayOut dims must match.'
-         call dmpar_abort(dminfo)
-      else
-         arrayOut(:,1:nNeededList) = arrayIn(:,1:nOwnedList)
-      end if
-#endif
-
-   end subroutine dmpar_alltoall_field2dReal
-
-  
-   subroutine dmpar_alltoall_field3dReal(dminfo, arrayIn, arrayOut, dim1, dim2, nOwnedList, nNeededList, sendList, recvList)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: dim1, dim2, nOwnedList, nNeededList
-      real (kind=RKIND), dimension(dim1,dim2,*), intent(in) :: arrayIn
-      real (kind=RKIND), dimension(dim1,dim2,*), intent(inout) :: arrayOut
-      type (exchange_list), pointer :: sendList, recvList
-
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-      integer :: i, d3
-
-#ifdef _MPI
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID == dminfo % my_proc_id) exit
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID == dminfo % my_proc_id) exit
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      if (associated(recvListPtr) .and. associated(sendListPtr)) then
-         do i=1,recvListPtr % nlist
-            arrayOut(:,:,recvListPtr % list(i)) = arrayIn(:,:,sendListPtr % list(i))
-         end do
-      end if
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            d3 = dim1 * dim2 * recvListPtr % nlist
-            allocate(recvListPtr % rbuffer(d3))
-            call MPI_Irecv(recvListPtr % rbuffer, d3, MPI_REALKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            d3 = dim1 * dim2 * sendListPtr % nlist
-            allocate(sendListPtr % rbuffer(d3))
-            call packSendBuf3dReal(1, dim1, 1, dim2, nOwnedList, arrayIn, sendListPtr, 1, d3, &amp;
-                                   sendListPtr % rbuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % rbuffer, d3, MPI_REALKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            d3 = dim1 * dim2 * recvListPtr % nlist
-            call unpackRecvBuf3dReal(1, dim1, 1, dim2, nNeededList, arrayOut, recvListPtr, 1, d3, &amp;
-                                     recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % rbuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % rbuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-#else
-      if (nOwnedList /= nNeededList) then
-         write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, ', &amp;
-           'arrayIn and arrayOut dims must match.'
-         call dmpar_abort(dminfo)
-      else
-         arrayOut(:,:,1:nNeededList) = arrayIn(:,:,1:nOwnedList)
-      end if
-#endif
-
-   end subroutine dmpar_alltoall_field3dReal
-
-  
-   subroutine packSendBuf1dInteger(nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)
-
-      implicit none
-
-      integer, intent(in) :: nField, nBuffer, startPackIdx
-      integer, dimension(*), intent(in) :: field
-      type (exchange_list), intent(in) :: sendList
-      integer, dimension(nBuffer), intent(out) :: buffer
-      integer, intent(inout) :: nPacked, lastPackedIdx
-
-      integer :: i
-
-      nPacked = 0
-      do i=startPackIdx, sendList % nlist
-         nPacked = nPacked + 1
-         if (nPacked &gt; nBuffer) then
-            nPacked = nPacked - 1
-            lastPackedIdx = i - 1
-            return
-         end if
-         buffer(nPacked) = field(sendList % list(i))
-      end do
-      lastPackedIdx = sendList % nlist
-
-   end subroutine packSendBuf1dInteger
-
-
-   subroutine packSendBuf2dInteger(ds, de, nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)
-
-      implicit none
-
-      integer, intent(in) :: ds, de, nField, nBuffer, startPackIdx
-      integer, dimension(ds:de,*), intent(in) :: field
-      type (exchange_list), intent(in) :: sendList
-      integer, dimension(nBuffer), intent(out) :: buffer
-      integer, intent(inout) :: nPacked, lastPackedIdx
-
-      integer :: i, n
-
-      n = de-ds+1
-
-      if (n &gt; nBuffer) then
-         write(0,*) 'packSendBuf2dInteger: Not enough space in buffer', &amp;
-          ' to fit a single slice.'
-         return
-      end if
-
-      nPacked = 0
-      do i=startPackIdx, sendList % nlist
-         nPacked = nPacked + n
-         if (nPacked &gt; nBuffer) then
-            nPacked = nPacked - n
-            lastPackedIdx = i - 1
-            return
-         end if
-         buffer(nPacked-n+1:nPacked) = field(ds:de,sendList % list(i))
-      end do
-      lastPackedIdx = sendList % nlist
-
-   end subroutine packSendBuf2dInteger
-
-
-   subroutine packSendBuf3dInteger(d1s, d1e, d2s, d2e, nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)
-
-      implicit none
-
-      integer, intent(in) :: d1s, d1e, d2s, d2e, nField, nBuffer, startPackIdx
-      integer, dimension(d1s:d1e,d2s:d2e,*), intent(in) :: field
-      type (exchange_list), intent(in) :: sendList
-      integer, dimension(nBuffer), intent(out) :: buffer
-      integer, intent(inout) :: nPacked, lastPackedIdx
-
-      integer :: i, j, k, n
-
-      n = (d1e-d1s+1) * (d2e-d2s+1)
-
-      if (n &gt; nBuffer) then
-         write(0,*) 'packSendBuf3dInteger: Not enough space in buffer', &amp;
-          ' to fit a single slice.'
-         return
-      end if
-
-      nPacked = 0
-      do i=startPackIdx, sendList % nlist
-         nPacked = nPacked + n
-         if (nPacked &gt; nBuffer) then
-            nPacked = nPacked - n
-            lastPackedIdx = i - 1
-            return
-         end if
-         k = nPacked-n+1
-         do j=d2s,d2e
-            buffer(k:k+d1e-d1s) = field(d1s:d1e,j,sendList % list(i))
-            k = k + d1e-d1s+1
-         end do
-      end do
-      lastPackedIdx = sendList % nlist
-
-   end subroutine packSendBuf3dInteger
-
-
-   subroutine packSendBuf1dReal(nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)
-
-      implicit none
-
-      integer, intent(in) :: nField, nBuffer, startPackIdx
-      real (kind=RKIND), dimension(*), intent(in) :: field
-      type (exchange_list), intent(in) :: sendList
-      real (kind=RKIND), dimension(nBuffer), intent(out) :: buffer
-      integer, intent(inout) :: nPacked, lastPackedIdx
-
-      integer :: i
-
-      nPacked = 0
-      do i=startPackIdx, sendList % nlist
-         nPacked = nPacked + 1
-         if (nPacked &gt; nBuffer) then
-            nPacked = nPacked - 1
-            lastPackedIdx = i - 1
-            return
-         end if
-         buffer(nPacked) = field(sendList % list(i))
-      end do
-      lastPackedIdx = sendList % nlist
-
-   end subroutine packSendBuf1dReal
-
-
-   subroutine packSendBuf2dReal(ds, de, nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)
-
-      implicit none
-
-      integer, intent(in) :: ds, de, nField, nBuffer, startPackIdx
-      real (kind=RKIND), dimension(ds:de,*), intent(in) :: field
-      type (exchange_list), intent(in) :: sendList
-      real (kind=RKIND), dimension(nBuffer), intent(out) :: buffer
-      integer, intent(inout) :: nPacked, lastPackedIdx
-
-      integer :: i, n
-
-      n = de-ds+1
-
-      if (n &gt; nBuffer) then
-         write(0,*) 'packSendBuf2dReal: Not enough space in buffer', &amp;
-          ' to fit a single slice.'
-         return
-      end if
-
-      nPacked = 0
-      do i=startPackIdx, sendList % nlist
-         nPacked = nPacked + n
-         if (nPacked &gt; nBuffer) then
-            nPacked = nPacked - n
-            lastPackedIdx = i - 1
-            return
-         end if
-         buffer(nPacked-n+1:nPacked) = field(ds:de,sendList % list(i))
-      end do
-      lastPackedIdx = sendList % nlist
-
-   end subroutine packSendBuf2dReal
-
-
-   subroutine packSendBuf3dReal(d1s, d1e, d2s, d2e, nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)
-
-      implicit none
-
-      integer, intent(in) :: d1s, d1e, d2s, d2e, nField, nBuffer, startPackIdx
-      real (kind=RKIND), dimension(d1s:d1e,d2s:d2e,*), intent(in) :: field
-      type (exchange_list), intent(in) :: sendList
-      real (kind=RKIND), dimension(nBuffer), intent(out) :: buffer
-      integer, intent(inout) :: nPacked, lastPackedIdx
-
-      integer :: i, j, k, n
-
-      n = (d1e-d1s+1) * (d2e-d2s+1)
-
-      if (n &gt; nBuffer) then
-         write(0,*) 'packSendBuf3dReal: Not enough space in buffer', &amp;
-          ' to fit a single slice.'
-         return
-      end if
-
-      nPacked = 0
-      do i=startPackIdx, sendList % nlist
-         nPacked = nPacked + n
-         if (nPacked &gt; nBuffer) then
-            nPacked = nPacked - n
-            lastPackedIdx = i - 1
-            return
-         end if
-         k = nPacked-n+1
-         do j=d2s,d2e
-            buffer(k:k+d1e-d1s) = field(d1s:d1e,j,sendList % list(i))
-            k = k + d1e-d1s+1
-         end do
-      end do
-      lastPackedIdx = sendList % nlist
-
-   end subroutine packSendBuf3dReal
-
-
-   subroutine unpackRecvBuf1dInteger(nField, field, recvList, startUnpackIdx, nBuffer, buffer, nUnpacked, lastUnpackedIdx)
-
-      implicit none
-
-      integer, intent(in) :: nField, nBuffer, startUnpackIdx
-      integer, dimension(*), intent(inout) :: field
-      type (exchange_list), intent(in) :: recvList
-      integer, dimension(nBuffer), intent(in) :: buffer
-      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
-
-      integer :: i
-
-      nUnpacked = 0
-      do i=startUnpackIdx, recvList % nlist
-         nUnpacked = nUnpacked + 1
-         if (nUnpacked &gt; nBuffer) then
-            nUnpacked = nUnpacked - 1
-            lastUnpackedIdx = i - 1
-            return
-         end if
-         field(recvList % list(i)) = buffer(nUnpacked)
-      end do
-      lastUnpackedIdx = recvList % nlist
-
-   end subroutine unpackRecvBuf1dInteger
-
-
-   subroutine unpackRecvBuf2dInteger(ds, de, nField, field, recvList, startUnpackIdx, nBuffer, buffer, nUnpacked, lastUnpackedIdx)
-
-      implicit none
-
-      integer, intent(in) :: ds, de, nField, nBuffer, startUnpackIdx
-      integer, dimension(ds:de,*), intent(inout) :: field
-      type (exchange_list), intent(in) :: recvList
-      integer, dimension(nBuffer), intent(in) :: buffer
-      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
-
-      integer :: i, n
-
-      n = de-ds+1
-
-      nUnpacked = 0
-      do i=startUnpackIdx, recvList % nlist
-         nUnpacked = nUnpacked + n
-         if (nUnpacked &gt; nBuffer) then
-            nUnpacked = nUnpacked - n
-            lastUnpackedIdx = i - 1
-            return
-         end if
-         field(ds:de,recvList % list(i)) = buffer(nUnpacked-n+1:nUnpacked)
-      end do
-      lastUnpackedIdx = recvList % nlist
-
-   end subroutine unpackRecvBuf2dInteger
-
-
-   subroutine unpackRecvBuf3dInteger(d1s, d1e, d2s, d2e, nField, field, recvList, startUnpackIdx, nBuffer, buffer, &amp;
-                                  nUnpacked, lastUnpackedIdx)
-
-      implicit none
-
-      integer, intent(in) :: d1s, d1e, d2s, d2e, nField, nBuffer, startUnpackIdx
-      integer, dimension(d1s:d1e,d2s:d2e,*), intent(inout) :: field
-      type (exchange_list), intent(in) :: recvList
-      integer, dimension(nBuffer), intent(in) :: buffer
-      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
-
-      integer :: i, j, k, n
-
-      n = (d1e-d1s+1) * (d2e-d2s+1)
-
-      nUnpacked = 0
-      do i=startUnpackIdx, recvList % nlist
-         nUnpacked = nUnpacked + n
-         if (nUnpacked &gt; nBuffer) then
-            nUnpacked = nUnpacked - n
-            lastUnpackedIdx = i - 1
-            return
-         end if
-         k = nUnpacked-n+1
-         do j=d2s,d2e
-            field(d1s:d1e,j,recvList % list(i)) = buffer(k:k+d1e-d1s)
-            k = k + d1e-d1s+1
-         end do
-      end do
-      lastUnpackedIdx = recvList % nlist
-
-   end subroutine unpackRecvBuf3dInteger
-
-
-   subroutine dmpar_exch_halo_field1dInteger(dminfo, array, dim1, sendList, recvList)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: dim1
-      integer, dimension(*), intent(inout) :: array
-      type (exchange_list), pointer :: sendList, recvList
-
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-
-#ifdef _MPI
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            allocate(recvListPtr % ibuffer(recvListPtr % nlist))
-            call MPI_Irecv(recvListPtr % ibuffer, recvListPtr % nlist, MPI_INTEGERKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-      
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            allocate(sendListPtr % ibuffer(sendListPtr % nlist))
-            call packSendBuf1dInteger(dim1, array, sendListPtr, 1, sendListPtr % nlist, sendListPtr % ibuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % ibuffer, sendListPtr % nlist, MPI_INTEGERKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            call unpackRecvBuf1dInteger(dim1, array, recvListPtr, 1, recvListPtr % nlist, recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % ibuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-      
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % ibuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-#endif
-
-   end subroutine dmpar_exch_halo_field1dInteger
-
-
-   subroutine dmpar_exch_halo_field2dInteger(dminfo, array, dim1, dim2, sendList, recvList)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: dim1, dim2
-      integer, dimension(dim1,*), intent(inout) :: array
-      type (exchange_list), pointer :: sendList, recvList
-
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-      integer :: d2
-
-#ifdef _MPI
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            d2 = dim1 * recvListPtr % nlist
-            allocate(recvListPtr % ibuffer(d2))
-            call MPI_Irecv(recvListPtr % ibuffer, d2, MPI_INTEGERKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-      
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            d2 = dim1 * sendListPtr % nlist
-            allocate(sendListPtr % ibuffer(d2))
-            call packSendBuf2dInteger(1, dim1, dim2, array, sendListPtr, 1, d2, sendListPtr % ibuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % ibuffer, d2, MPI_INTEGERKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            d2 = dim1 * recvListPtr % nlist
-            call unpackRecvBuf2dInteger(1, dim1, dim2, array, recvListPtr, 1, d2, recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % ibuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-      
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % ibuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-#endif
-
-   end subroutine dmpar_exch_halo_field2dInteger
-
-
-   subroutine dmpar_exch_halo_field3dInteger(dminfo, array, dim1, dim2, dim3, sendList, recvList)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: dim1, dim2, dim3
-      integer, dimension(dim1,dim2,*), intent(inout) :: array
-      type (exchange_list), pointer :: sendList, recvList
-
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-      integer :: d3
-
-#ifdef _MPI
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            d3 = dim1 * dim2 * recvListPtr % nlist
-            allocate(recvListPtr % ibuffer(d3))
-            call MPI_Irecv(recvListPtr % ibuffer, d3, MPI_INTEGERKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            d3 = dim1 * dim2 * sendListPtr % nlist
-            allocate(sendListPtr % ibuffer(d3))
-            call packSendBuf3dInteger(1, dim1, 1, dim2, dim3, array, sendListPtr, 1, d3, &amp;
-                                   sendListPtr % ibuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % ibuffer, d3, MPI_INTEGERKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            d3 = dim1 * dim2 * recvListPtr % nlist
-            call unpackRecvBuf3dInteger(1, dim1, 1, dim2, dim3, array, recvListPtr, 1, d3, &amp;
-                                     recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % ibuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % ibuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-#endif
-
-   end subroutine dmpar_exch_halo_field3dInteger
-
-  
-   subroutine unpackRecvBuf1dReal(nField, field, recvList, startUnpackIdx, nBuffer, buffer, nUnpacked, lastUnpackedIdx)
-
-      implicit none
-
-      integer, intent(in) :: nField, nBuffer, startUnpackIdx
-      real (kind=RKIND), dimension(*), intent(inout) :: field
-      type (exchange_list), intent(in) :: recvList
-      real (kind=RKIND), dimension(nBuffer), intent(in) :: buffer
-      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
-
-      integer :: i
-
-      nUnpacked = 0
-      do i=startUnpackIdx, recvList % nlist
-         nUnpacked = nUnpacked + 1
-         if (nUnpacked &gt; nBuffer) then
-            nUnpacked = nUnpacked - 1
-            lastUnpackedIdx = i - 1
-            return
-         end if
-         field(recvList % list(i)) = buffer(nUnpacked)
-      end do
-      lastUnpackedIdx = recvList % nlist
-
-   end subroutine unpackRecvBuf1dReal
-
-
-   subroutine unpackRecvBuf2dReal(ds, de, nField, field, recvList, startUnpackIdx, nBuffer, buffer, nUnpacked, lastUnpackedIdx)
-
-      implicit none
-
-      integer, intent(in) :: ds, de, nField, nBuffer, startUnpackIdx
-      real (kind=RKIND), dimension(ds:de,*), intent(inout) :: field
-      type (exchange_list), intent(in) :: recvList
-      real (kind=RKIND), dimension(nBuffer), intent(in) :: buffer
-      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
-
-      integer :: i, n
-
-      n = de-ds+1
-
-      nUnpacked = 0
-      do i=startUnpackIdx, recvList % nlist
-         nUnpacked = nUnpacked + n
-         if (nUnpacked &gt; nBuffer) then
-            nUnpacked = nUnpacked - n
-            lastUnpackedIdx = i - 1
-            return
-         end if
-         field(ds:de,recvList % list(i)) = buffer(nUnpacked-n+1:nUnpacked)
-      end do
-      lastUnpackedIdx = recvList % nlist
-
-   end subroutine unpackRecvBuf2dReal
-
-
-   subroutine unpackRecvBuf3dReal(d1s, d1e, d2s, d2e, nField, field, recvList, startUnpackIdx, nBuffer, buffer, &amp;
-                                  nUnpacked, lastUnpackedIdx)
-
-      implicit none
-
-      integer, intent(in) :: d1s, d1e, d2s, d2e, nField, nBuffer, startUnpackIdx
-      real (kind=RKIND), dimension(d1s:d1e,d2s:d2e,*), intent(inout) :: field
-      type (exchange_list), intent(in) :: recvList
-      real (kind=RKIND), dimension(nBuffer), intent(in) :: buffer
-      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
-
-      integer :: i, j, k, n
-
-      n = (d1e-d1s+1) * (d2e-d2s+1)
-
-      nUnpacked = 0
-      do i=startUnpackIdx, recvList % nlist
-         nUnpacked = nUnpacked + n
-         if (nUnpacked &gt; nBuffer) then
-            nUnpacked = nUnpacked - n
-            lastUnpackedIdx = i - 1
-            return
-         end if
-         k = nUnpacked-n+1
-         do j=d2s,d2e
-            field(d1s:d1e,j,recvList % list(i)) = buffer(k:k+d1e-d1s)
-            k = k + d1e-d1s+1
-         end do
-      end do
-      lastUnpackedIdx = recvList % nlist
-
-   end subroutine unpackRecvBuf3dReal
-
-
-   subroutine dmpar_exch_halo_field1dReal(dminfo, array, dim1, sendList, recvList)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: dim1
-      real (kind=RKIND), dimension(*), intent(inout) :: array
-      type (exchange_list), pointer :: sendList, recvList
-
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-
-#ifdef _MPI
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            allocate(recvListPtr % rbuffer(recvListPtr % nlist))
-            call MPI_Irecv(recvListPtr % rbuffer, recvListPtr % nlist, MPI_REALKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-      
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            allocate(sendListPtr % rbuffer(sendListPtr % nlist))
-            call packSendBuf1dReal(dim1, array, sendListPtr, 1, sendListPtr % nlist, sendListPtr % rbuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % rbuffer, sendListPtr % nlist, MPI_REALKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            call unpackRecvBuf1dReal(dim1, array, recvListPtr, 1, recvListPtr % nlist, recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % rbuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-      
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % rbuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-#endif
-
-   end subroutine dmpar_exch_halo_field1dReal
-
-
-   subroutine dmpar_exch_halo_field2dReal(dminfo, array, dim1, dim2, sendList, recvList)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: dim1, dim2
-      real (kind=RKIND), dimension(dim1,*), intent(inout) :: array
-      type (exchange_list), pointer :: sendList, recvList
-
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-      integer :: d2
-
-#ifdef _MPI
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            d2 = dim1 * recvListPtr % nlist
-            allocate(recvListPtr % rbuffer(d2))
-            call MPI_Irecv(recvListPtr % rbuffer, d2, MPI_REALKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-      
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            d2 = dim1 * sendListPtr % nlist
-            allocate(sendListPtr % rbuffer(d2))
-            call packSendBuf2dReal(1, dim1, dim2, array, sendListPtr, 1, d2, sendListPtr % rbuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % rbuffer, d2, MPI_REALKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            d2 = dim1 * recvListPtr % nlist
-            call unpackRecvBuf2dReal(1, dim1, dim2, array, recvListPtr, 1, d2, recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % rbuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-      
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % rbuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-#endif
-
-   end subroutine dmpar_exch_halo_field2dReal
-
-
-   subroutine dmpar_exch_halo_field3dReal(dminfo, array, dim1, dim2, dim3, sendList, recvList)
-
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      integer, intent(in) :: dim1, dim2, dim3
-      real (kind=RKIND), dimension(dim1,dim2,*), intent(inout) :: array
-      type (exchange_list), pointer :: sendList, recvList
-
-      type (exchange_list), pointer :: sendListPtr, recvListPtr
-      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
-      integer :: mpi_ierr
-      integer :: d3
-
-#ifdef _MPI
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            d3 = dim1 * dim2 * recvListPtr % nlist
-            allocate(recvListPtr % rbuffer(d3))
-            call MPI_Irecv(recvListPtr % rbuffer, d3, MPI_REALKIND, &amp;
-                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            d3 = dim1 * dim2 * sendListPtr % nlist
-            allocate(sendListPtr % rbuffer(d3))
-            call packSendBuf3dReal(1, dim1, 1, dim2, dim3, array, sendListPtr, 1, d3, &amp;
-                                   sendListPtr % rbuffer, nPacked, lastPackedIdx)
-            call MPI_Isend(sendListPtr % rbuffer, d3, MPI_REALKIND, &amp;
-                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-      recvListPtr =&gt; recvList
-      do while (associated(recvListPtr))
-         if (recvListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            d3 = dim1 * dim2 * recvListPtr % nlist
-            call unpackRecvBuf3dReal(1, dim1, 1, dim2, dim3, array, recvListPtr, 1, d3, &amp;
-                                     recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
-            deallocate(recvListPtr % rbuffer)
-         end if
-         recvListPtr =&gt; recvListPtr % next
-      end do
-
-      sendListPtr =&gt; sendList
-      do while (associated(sendListPtr))
-         if (sendListPtr % procID /= dminfo % my_proc_id) then
-            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
-            deallocate(sendListPtr % rbuffer)
-         end if
-         sendListPtr =&gt; sendListPtr % next
-      end do
-
-#endif
-
-   end subroutine dmpar_exch_halo_field3dReal
-
-
-end module dmpar

Deleted: branches/source_condensing/src/framework/module_grid_types.F
===================================================================
--- trunk/mpas/src/framework/module_grid_types.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/module_grid_types.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,219 +0,0 @@
-module grid_types
-
-   use dmpar
-
-   integer, parameter :: nTimeLevs = 2
-
-
-   ! Derived type describing info for doing I/O specific to a field
-   type io_info
-      character (len=1024) :: fieldName
-      integer, dimension(4) :: start
-      integer, dimension(4) :: count
-      logical :: input
-      logical :: sfc
-      logical :: restart
-      logical :: output
-   end type io_info
-
-
-   ! Derived type for storing fields
-   type field3DReal
-      type (block_type), pointer :: block
-      real (kind=RKIND), dimension(:,:,:), pointer :: array
-      type (io_info), pointer :: ioinfo
-   end type field3DReal
-
-
-   ! Derived type for storing fields
-   type field2DReal
-      type (block_type), pointer :: block
-      real (kind=RKIND), dimension(:,:), pointer :: array
-      type (io_info), pointer :: ioinfo
-   end type field2DReal
-
-
-   ! Derived type for storing fields
-   type field1DReal
-      type (block_type), pointer :: block
-      real (kind=RKIND), dimension(:), pointer :: array
-      type (io_info), pointer :: ioinfo
-   end type field1DReal
-
-
-   ! Derived type for storing fields
-   type field0DReal
-      type (block_type), pointer :: block
-      real (kind=RKIND) :: scalar
-      type (io_info), pointer :: ioinfo
-   end type field0DReal
-
-
-   ! Derived type for storing fields
-   type field2DInteger
-      type (block_type), pointer :: block
-      integer, dimension(:,:), pointer :: array
-      type (io_info), pointer :: ioinfo
-   end type field2DInteger
-
-
-   ! Derived type for storing fields
-   type field1DInteger
-      type (block_type), pointer :: block
-      integer, dimension(:), pointer :: array
-      type (io_info), pointer :: ioinfo
-   end type field1DInteger
-
-
-   ! Derived type for storing fields
-   type field1DChar
-      type (block_type), pointer :: block
-      character (len=64), dimension(:), pointer :: array
-      type (io_info), pointer :: ioinfo
-   end type field1DChar
-
-
-   ! Derived type for storing fields
-   type field0DChar
-      type (block_type), pointer :: block
-      character (len=64) :: scalar
-      type (io_info), pointer :: ioinfo
-   end type field0DChar
-
-
-   ! Derived type for storing grid meta-data
-   type mesh_type
-
-#include &quot;field_dimensions.inc&quot;
-
-      logical :: on_a_sphere
-      real (kind=RKIND) :: sphere_radius
-
-#include &quot;time_invariant_fields.inc&quot;
-
-   end type mesh_type
-
-
-#include &quot;variable_groups.inc&quot;
-
-
-   ! Type for storing (possibly architecture specific) information concerning to parallelism
-   type parallel_info
-      type (exchange_list), pointer :: cellsToSend            ! List of types describing which cells to send to other blocks
-      type (exchange_list), pointer :: cellsToRecv            ! List of types describing which cells to receive from other blocks
-      type (exchange_list), pointer :: edgesToSend            ! List of types describing which edges to send to other blocks
-      type (exchange_list), pointer :: edgesToRecv            ! List of types describing which edges to receive from other blocks
-      type (exchange_list), pointer :: verticesToSend         ! List of types describing which vertices to send to other blocks
-      type (exchange_list), pointer :: verticesToRecv         ! List of types describing which vertices to receive from other blocks
-   end type parallel_info
-
-
-   ! Derived type for storing part of a domain; used as a basic unit of work for a process
-   type block_type
-
-#include &quot;block_group_members.inc&quot;
-
-      type (domain_type), pointer :: domain
-
-      type (parallel_info), pointer :: parinfo
-
-      type (block_type), pointer :: prev, next
-   end type block_type
-
-
-   ! Derived type for storing list of blocks from a domain to be handled by a process
-   type domain_type
-      type (block_type), pointer :: blocklist
-   
-      ! Also store parallelization info here
-      type (dm_info), pointer :: dminfo
-   end type domain_type
-
-
-   contains
-
-
-   subroutine allocate_domain(dom, dminfo)
-
-      implicit none
-
-      type (domain_type), pointer :: dom
-      type (dm_info), pointer :: dminfo
-
-      allocate(dom)
-      nullify(dom % blocklist)
-      dom % dminfo =&gt; dminfo
-
-   end subroutine allocate_domain
-
-
-   subroutine allocate_block(b, dom, &amp;
-#include &quot;dim_dummy_args.inc&quot;
-                            )
-
-      implicit none
-
-      type (block_type), pointer :: b
-      type (domain_type), pointer :: dom
-#include &quot;dim_dummy_decls.inc&quot;
-
-      integer :: i
-
-      nullify(b % prev)
-      nullify(b % next)
-
-      allocate(b % parinfo)
-
-      b % domain =&gt; dom
-
-#include &quot;block_allocs.inc&quot;
-
-   end subroutine allocate_block
-
-
-#include &quot;group_alloc_routines.inc&quot;
-
-
-   subroutine deallocate_domain(dom)
-
-      implicit none
-
-      type (domain_type), pointer :: dom
-
-      type (block_type), pointer :: block_ptr
-
-      block_ptr =&gt; dom % blocklist
-      do while (associated(block_ptr))
-         call deallocate_block(block_ptr)
-         block_ptr =&gt; block_ptr % next
-      end do
-
-      deallocate(dom) 
-
-   end subroutine deallocate_domain
-
-
-   subroutine deallocate_block(b)

-      implicit none
-
-      type (block_type), intent(inout) :: b
-
-      integer :: i
-
-      deallocate(b % parinfo)
-
-#include &quot;block_deallocs.inc&quot;
-
-   end subroutine deallocate_block
-
-
-#include &quot;group_dealloc_routines.inc&quot;
-
-
-#include &quot;group_copy_routines.inc&quot;
-
-
-#include &quot;group_shift_level_routines.inc&quot;
-
-end module grid_types

Deleted: branches/source_condensing/src/framework/module_hash.F
===================================================================
--- trunk/mpas/src/framework/module_hash.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/module_hash.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,175 +0,0 @@
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-! MODULE HASH
-!
-! Purpose: This module provides a dictionary/hashtable with insert, search, and
-!   remove routines. 
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-module hash
-
-   ! Parameters
-   integer, parameter :: TABLESIZE=27183     ! Number of spaces in the table (the
-                                             !   number of linked lists)

-   type hashnode
-      integer :: key
-      type (hashnode), pointer :: next
-   end type hashnode

-   type hashnode_ptr
-      type (hashnode), pointer :: p        ! Pointer to a list of entries
-   end type hashnode_ptr

-   type hashtable
-      integer :: size
-      type (hashnode_ptr), dimension(TABLESIZE) :: table ! The hashtable array
-   end type hashtable
-

-   contains


-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Name: hash_init
-   !
-   ! Purpose: To initialize a hashtable
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   subroutine hash_init(h)
-   
-     implicit none

-     ! Arguments
-     type (hashtable), intent(inout) :: h

-     ! Local variables
-     integer :: i
-
-     h%size = 0

-     do i=1,TABLESIZE
-        nullify(h%table(i)%p)
-     end do

-   end subroutine hash_init


-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Name: hash_insert
-   !
-   ! Purpose: Given a hashtable h and a key to be inserted into the hashtable,
-   !   this routine adds key to the table. 
-   !
-   ! NOTE: If the key already exists in the table, a second copy of the
-   !   key is added to the table
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   subroutine hash_insert(h, key)
-   
-     implicit none

-     ! Arguments
-     integer, intent(in) :: key
-     type (hashtable), intent(inout) :: h

-     ! Local variables
-     integer :: hashval, i
-     type (hashnode), pointer :: hn 

-     hashval = mod(key, TABLESIZE) + 1  
-    
-     allocate(hn) 
-     hn%key = key
-     hn%next =&gt; h%table(hashval)%p
-     h%table(hashval)%p =&gt; hn 
-
-     h%size = h%size + 1

-   end subroutine hash_insert


-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Name: hash_search
-   !
-   ! Purpose: This function returns TRUE if the specified key was found in the
-   !   hashtable h, and FALSE otherwise.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   logical function hash_search(h, key)
-   
-      implicit none
-  
-      ! Arguments
-      integer, intent(in) :: key
-      type (hashtable), intent(inout) :: h
-  
-      ! Local variables
-      integer :: hashval, i
-      type (hashnode), pointer :: cursor 
-  
-      hash_search = .false.
-  
-      hashval = mod(key, TABLESIZE) + 1  
-     
-      cursor =&gt; h%table(hashval)%p
-      do while(associated(cursor))
-         if (cursor%key == key) then
-            hash_search = .true.
-            return 
-         else
-            cursor =&gt; cursor%next 
-         end if
-      end do
-    
-      return

-   end function hash_search
-
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Name: hash_size
-   !
-   ! Purpose: Returns the number of items in the hash table h.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   integer function hash_size(h)
-
-      implicit none
-
-      ! Arguments
-      type (hashtable) :: h
-
-      hash_size = h%size
-
-      return
-
-   end function hash_size


-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   ! Name: hash_destroy
-   !
-   ! Purpose: Frees all memory associated with hashtable h. This routine may be
-   !   used to remove all entries from a hashtable.
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-   subroutine hash_destroy(h)
-   
-      implicit none
-  
-      ! Arguments
-      type (hashtable), intent(inout) :: h
-  
-      ! Local variables
-      integer :: i
-      type (hashnode), pointer :: cursor, cursor_prev
-     
-      do i=1,TABLESIZE
-         cursor =&gt; h%table(i)%p
-         do while(associated(cursor))
-            cursor_prev =&gt; cursor
-            cursor =&gt; cursor%next
-            deallocate(cursor_prev)
-         end do 
-         nullify(h%table(i)%p)
-      end do 
-
-      h%size = 0

-   end subroutine hash_destroy

-end module hash

Deleted: branches/source_condensing/src/framework/module_io_input.F
===================================================================
--- trunk/mpas/src/framework/module_io_input.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/module_io_input.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,1614 +0,0 @@
-module io_input
-
-   use grid_types
-   use dmpar
-   use block_decomp
-   use sort
-   use configure
-   use mpas_timekeeping
-
-
-#ifdef HAVE_ZOLTAN
-   use zoltan_interface
-#endif
-
-   integer, parameter :: STREAM_INPUT=1, STREAM_SFC=2, STREAM_RESTART=3
-
-   type io_input_object
-      character (len=1024) :: filename
-      integer :: rd_ncid
-      integer :: stream
-
-      integer :: time
-
-#include &quot;io_input_obj_decls.inc&quot;
-   end type io_input_object
-
-
-   interface io_input_field
-      module procedure io_input_field0dReal
-      module procedure io_input_field1dReal
-      module procedure io_input_field2dReal
-      module procedure io_input_field3dReal
-      module procedure io_input_field1dInteger
-      module procedure io_input_field2dInteger
-      module procedure io_input_field0dChar
-      module procedure io_input_field1dChar
-   end interface io_input_field
-
-   interface io_input_field_time
-      module procedure io_input_field0dReal_time
-      module procedure io_input_field1dReal_time
-      module procedure io_input_field2dReal_time
-      module procedure io_input_field3dReal_time
-      module procedure io_input_field1dInteger_time
-      module procedure io_input_field0dChar_time
-      module procedure io_input_field1dChar_time
-   end interface io_input_field_time
-
-   type (exchange_list), pointer :: sendCellList, recvCellList
-   type (exchange_list), pointer :: sendEdgeList, recvEdgeList
-   type (exchange_list), pointer :: sendVertexList, recvVertexList
-   type (exchange_list), pointer :: sendVertLevelList, recvVertLevelList

-   integer :: readCellStart, readCellEnd, nReadCells
-   integer :: readEdgeStart, readEdgeEnd, nReadEdges
-   integer :: readVertexStart, readVertexEnd, nReadVertices
-   integer :: readVertLevelStart, readVertLevelEnd, nReadVertLevels
-   
-
-   contains
-
-
-   subroutine input_state_for_domain(domain)
-   
-      implicit none
-   
-      type (domain_type), pointer :: domain
-   
-      integer :: i, j, k
-      type (io_input_object) :: input_obj
-#include &quot;dim_decls.inc&quot;
-
-      character (len=16) :: c_on_a_sphere
-      real (kind=RKIND) :: r_sphere_radius
-   
-      type (field1dInteger) :: indexToCellIDField
-      type (field1dInteger) :: indexToEdgeIDField
-      type (field1dInteger) :: indexToVertexIDField
-      type (field1dInteger) :: nEdgesOnCellField
-      type (field2dInteger) :: cellsOnCellField
-      type (field2dInteger) :: edgesOnCellField
-      type (field2dInteger) :: verticesOnCellField
-      type (field2dInteger) :: cellsOnEdgeField
-      type (field2dInteger) :: cellsOnVertexField
-
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI 
-      type (field1dReal) :: xCellField,   yCellField,   zCellField
-      type (field1dReal) :: xEdgeField,   yEdgeField,   zEdgeField
-      type (field1dReal) :: xVertexField, yVertexField, zVertexField
-#endif
-#endif
-
-      type (field1DChar) :: xtime
-   
-      integer, dimension(:), pointer :: indexToCellID_0Halo
-      integer, dimension(:), pointer :: nEdgesOnCell_0Halo
-      integer, dimension(:,:), pointer :: cellsOnCell_0Halo
-   
-      integer, dimension(:,:), pointer :: edgesOnCell_2Halo
-      integer, dimension(:,:), pointer :: verticesOnCell_2Halo
-      integer, dimension(:,:), pointer :: cellsOnEdge_2Halo
-      integer, dimension(:,:), pointer :: cellsOnVertex_2Halo
-
-      integer, dimension(:,:), pointer :: cellIDSorted
-      integer, dimension(:,:), pointer :: edgeIDSorted
-      integer, dimension(:,:), pointer :: vertexIDSorted
-
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI 
-      real (kind=RKIND), dimension(:), pointer :: xCell,   yCell,   zCell
-      real (kind=RKIND), dimension(:), pointer :: xEdge,   yEdge,   zEdge
-      real (kind=RKIND), dimension(:), pointer :: xVertex, yVertex, zVertex
-#endif
-#endif
-   
-      integer, dimension(:), pointer :: local_cell_list, local_edge_list, local_vertex_list
-      integer, dimension(:), pointer :: local_vertlevel_list, needed_vertlevel_list
-      integer :: nlocal_edges, nlocal_vertices
-      type (exchange_list), pointer :: send1Halo, recv1Halo
-      type (exchange_list), pointer :: send2Halo, recv2Halo
-      type (graph) :: partial_global_graph_info
-      type (graph) :: block_graph_0Halo, block_graph_1Halo, block_graph_2Halo
-      integer :: ghostEdgeStart, ghostVertexStart
-
-      type (MPAS_Time_type) :: startTime
-      type (MPAS_Time_type) :: sliceTime
-      type (MPAS_TimeInterval_type) :: timeDiff
-      type (MPAS_TimeInterval_type) :: minTimeDiff
-      character(len=32) :: timeStamp
-
-      if (config_do_restart) then
-         input_obj % filename = trim(config_restart_name)
-         input_obj % stream = STREAM_RESTART
-      else
-         input_obj % filename = trim(config_input_name)
-         input_obj % stream = STREAM_INPUT
-      end if
-      call io_input_init(input_obj, domain % dminfo)
-   
-
-      !
-      ! Read global number of cells/edges/vertices
-      !
-#include &quot;read_dims.inc&quot;
-   
-      !
-      ! Determine the range of cells/edges/vertices that a processor will initially read
-      !   from the input file
-      !
-      call dmpar_get_index_range(domain % dminfo, 1, nCells, readCellStart, readCellEnd)   
-      nReadCells    = readCellEnd - readCellStart + 1
-   
-      call dmpar_get_index_range(domain % dminfo, 1, nEdges, readEdgeStart, readEdgeEnd)   
-      nReadEdges    = readEdgeEnd - readEdgeStart + 1
-   
-      call dmpar_get_index_range(domain % dminfo, 1, nVertices, readVertexStart, readVertexEnd)   
-      nReadVertices = readVertexEnd - readVertexStart + 1
-
-      readVertLevelStart = 1
-      readVertLevelEnd = nVertLevels
-      nReadVertLevels = nVertLevels
-   
-   
-      !
-      ! Allocate and read fields that we will need in order to ultimately work out
-      !   which cells/edges/vertices are owned by each block, and which are ghost
-      !
-
-      ! Global cell indices
-      allocate(indexToCellIDField % ioinfo)
-      indexToCellIDField % ioinfo % fieldName = 'indexToCellID'
-      indexToCellIDField % ioinfo % start(1) = readCellStart
-      indexToCellIDField % ioinfo % count(1) = nReadCells
-      allocate(indexToCellIDField % array(nReadCells))
-      call io_input_field(input_obj, indexToCellIDField)
-   
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI 
-      ! Cell x-coordinates (in 3d Cartesian space)
-      allocate(xCellField % ioinfo)
-      xCellField % ioinfo % fieldName = 'xCell'
-      xCellField % ioinfo % start(1) = readCellStart
-      xCellField % ioinfo % count(1) = nReadCells
-      allocate(xCellField % array(nReadCells))
-      call io_input_field(input_obj, xCellField)
-
-      ! Cell y-coordinates (in 3d Cartesian space)
-      allocate(yCellField % ioinfo)
-      yCellField % ioinfo % fieldName = 'yCell'
-      yCellField % ioinfo % start(1) = readCellStart
-      yCellField % ioinfo % count(1) = nReadCells
-      allocate(yCellField % array(nReadCells))
-      call io_input_field(input_obj, yCellField)
-
-      ! Cell z-coordinates (in 3d Cartesian space)
-      allocate(zCellField % ioinfo)
-      zCellField % ioinfo % fieldName = 'zCell'
-      zCellField % ioinfo % start(1) = readCellStart
-      zCellField % ioinfo % count(1) = nReadCells
-      allocate(zCellField % array(nReadCells))
-      call io_input_field(input_obj, zCellField)
-#endif
-#endif
-
-
-      ! Global edge indices
-      allocate(indexToEdgeIDField % ioinfo)
-      indexToEdgeIDField % ioinfo % fieldName = 'indexToEdgeID'
-      indexToEdgeIDField % ioinfo % start(1) = readEdgeStart
-      indexToEdgeIDField % ioinfo % count(1) = nReadEdges
-      allocate(indexToEdgeIDField % array(nReadEdges))
-      call io_input_field(input_obj, indexToEdgeIDField)
-   
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI 
-      ! Edge x-coordinates (in 3d Cartesian space)
-      allocate(xEdgeField % ioinfo)
-      xEdgeField % ioinfo % fieldName = 'xEdge'
-      xEdgeField % ioinfo % start(1) = readEdgeStart
-      xEdgeField % ioinfo % count(1) = nReadEdges
-      allocate(xEdgeField % array(nReadEdges))
-      call io_input_field(input_obj, xEdgeField)
-
-      ! Edge y-coordinates (in 3d Cartesian space)
-      allocate(yEdgeField % ioinfo)
-      yEdgeField % ioinfo % fieldName = 'yEdge'
-      yEdgeField % ioinfo % start(1) = readEdgeStart
-      yEdgeField % ioinfo % count(1) = nReadEdges
-      allocate(yEdgeField % array(nReadEdges))
-      call io_input_field(input_obj, yEdgeField)
-
-      ! Edge z-coordinates (in 3d Cartesian space)
-      allocate(zEdgeField % ioinfo)
-      zEdgeField % ioinfo % fieldName = 'zEdge'
-      zEdgeField % ioinfo % start(1) = readEdgeStart
-      zEdgeField % ioinfo % count(1) = nReadEdges
-      allocate(zEdgeField % array(nReadEdges))
-      call io_input_field(input_obj, zEdgeField)
-#endif
-#endif
-
-      ! Global vertex indices
-      allocate(indexToVertexIDField % ioinfo)
-      indexToVertexIDField % ioinfo % fieldName = 'indexToVertexID'
-      indexToVertexIDField % ioinfo % start(1) = readVertexStart
-      indexToVertexIDField % ioinfo % count(1) = nReadVertices
-      allocate(indexToVertexIDField % array(nReadVertices))
-      call io_input_field(input_obj, indexToVertexIDField)
-   
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI
-      ! Vertex x-coordinates (in 3d Cartesian space)
-      allocate(xVertexField % ioinfo)
-      xVertexField % ioinfo % fieldName = 'xVertex'
-      xVertexField % ioinfo % start(1) = readVertexStart
-      xVertexField % ioinfo % count(1) = nReadVertices
-      allocate(xVertexField % array(nReadVertices))
-      call io_input_field(input_obj, xVertexField)
-
-      ! Vertex y-coordinates (in 3d Cartesian space)
-      allocate(yVertexField % ioinfo)
-      yVertexField % ioinfo % fieldName = 'yVertex'
-      yVertexField % ioinfo % start(1) = readVertexStart
-      yVertexField % ioinfo % count(1) = nReadVertices
-      allocate(yVertexField % array(nReadVertices))
-      call io_input_field(input_obj, yVertexField)
-
-      ! Vertex z-coordinates (in 3d Cartesian space)
-      allocate(zVertexField % ioinfo)
-      zVertexField % ioinfo % fieldName = 'zVertex'
-      zVertexField % ioinfo % start(1) = readVertexStart
-      zVertexField % ioinfo % count(1) = nReadVertices
-      allocate(zVertexField % array(nReadVertices))
-      call io_input_field(input_obj, zVertexField)
-#endif
-#endif
-
-      ! Number of cell/edges/vertices adjacent to each cell
-      allocate(nEdgesOnCellField % ioinfo)
-      nEdgesOnCellField % ioinfo % fieldName = 'nEdgesOnCell'
-      nEdgesOnCellField % ioinfo % start(1) = readCellStart
-      nEdgesOnCellField % ioinfo % count(1) = nReadCells
-      allocate(nEdgesOnCellField % array(nReadCells))
-      call io_input_field(input_obj, nEdgesOnCellField)
-   
-      ! Global indices of cells adjacent to each cell
-      allocate(cellsOnCellField % ioinfo)
-      cellsOnCellField % ioinfo % fieldName = 'cellsOnCell'
-      cellsOnCellField % ioinfo % start(1) = 1
-      cellsOnCellField % ioinfo % start(2) = readCellStart
-      cellsOnCellField % ioinfo % count(1) = maxEdges
-      cellsOnCellField % ioinfo % count(2) = nReadCells
-      allocate(cellsOnCellField % array(maxEdges,nReadCells))
-      call io_input_field(input_obj, cellsOnCellField)
-   
-      ! Global indices of edges adjacent to each cell
-      allocate(edgesOnCellField % ioinfo)
-      edgesOnCellField % ioinfo % fieldName = 'edgesOnCell'
-      edgesOnCellField % ioinfo % start(1) = 1
-      edgesOnCellField % ioinfo % start(2) = readCellStart
-      edgesOnCellField % ioinfo % count(1) = maxEdges
-      edgesOnCellField % ioinfo % count(2) = nReadCells
-      allocate(edgesOnCellField % array(maxEdges,nReadCells))
-      call io_input_field(input_obj, edgesOnCellField)
-   
-      ! Global indices of vertices adjacent to each cell
-      allocate(verticesOnCellField % ioinfo)
-      verticesOnCellField % ioinfo % fieldName = 'verticesOnCell'
-      verticesOnCellField % ioinfo % start(1) = 1
-      verticesOnCellField % ioinfo % start(2) = readCellStart
-      verticesOnCellField % ioinfo % count(1) = maxEdges
-      verticesOnCellField % ioinfo % count(2) = nReadCells
-      allocate(verticesOnCellField % array(maxEdges,nReadCells))
-      call io_input_field(input_obj, verticesOnCellField)
-   
-      ! Global indices of cells adjacent to each edge
-      !    used for determining which edges are owned by a block, where 
-      !    iEdge is owned iff cellsOnEdge(1,iEdge) is an owned cell
-      allocate(cellsOnEdgeField % ioinfo)
-      cellsOnEdgeField % ioinfo % fieldName = 'cellsOnEdge'
-      cellsOnEdgeField % ioinfo % start(1) = 1
-      cellsOnEdgeField % ioinfo % start(2) = readEdgeStart
-      cellsOnEdgeField % ioinfo % count(1) = 2
-      cellsOnEdgeField % ioinfo % count(2) = nReadEdges
-      allocate(cellsOnEdgeField % array(2,nReadEdges))
-      call io_input_field(input_obj, cellsOnEdgeField)
-   
-      ! Global indices of cells adjacent to each vertex
-      !    used for determining which vertices are owned by a block, where 
-      !    iVtx is owned iff cellsOnVertex(1,iVtx) is an owned cell
-      allocate(cellsOnVertexField % ioinfo)
-      cellsOnVertexField % ioinfo % fieldName = 'cellsOnVertex'
-      cellsOnVertexField % ioinfo % start(1) = 1
-      cellsOnVertexField % ioinfo % start(2) = readVertexStart
-      cellsOnVertexField % ioinfo % count(1) = vertexDegree
-      cellsOnVertexField % ioinfo % count(2) = nReadVertices
-      allocate(cellsOnVertexField % array(vertexDegree,nReadVertices))
-      call io_input_field(input_obj, cellsOnVertexField)
-   
-   
-      !
-      ! Set up a graph derived data type describing the connectivity for the cells 
-      !   that were read by this process
-      ! A partial description is passed to the block decomp module by each process,
-      !   and the block decomp module returns with a list of global cell indices
-      !   that belong to the block on this process
-      !
-      partial_global_graph_info % nVertices = nReadCells
-      partial_global_graph_info % nVerticesTotal = nCells
-      partial_global_graph_info % maxDegree = maxEdges
-      partial_global_graph_info % ghostStart = nVertices+1
-      allocate(partial_global_graph_info % vertexID(nReadCells))
-      allocate(partial_global_graph_info % nAdjacent(nReadCells))
-      allocate(partial_global_graph_info % adjacencyList(maxEdges, nReadCells))
-   
-      partial_global_graph_info % vertexID(:) = indexToCellIDField % array(:)
-      partial_global_graph_info % nAdjacent(:) = nEdgesOnCellField % array(:)
-      partial_global_graph_info % adjacencyList(:,:) = cellsOnCellField % array(:,:)
-      
-   
-      ! TODO: Ensure (by renaming or exchanging) that initial cell range on each proc is contiguous
-      !       This situation may occur when reading a restart file with cells/edges/vertices written
-      !       in a scrambled order
-   
-
-      ! Determine which cells are owned by this process
-      call block_decomp_cells_for_proc(domain % dminfo, partial_global_graph_info, local_cell_list)
-
-      deallocate(partial_global_graph_info % vertexID)
-      deallocate(partial_global_graph_info % nAdjacent)
-      deallocate(partial_global_graph_info % adjacencyList)
-   
-   
-      allocate(indexToCellID_0Halo(size(local_cell_list)))
-      allocate(nEdgesOnCell_0Halo(size(local_cell_list)))
-      allocate(cellsOnCell_0Halo(maxEdges, size(local_cell_list)))
-   
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI 
-      allocate(xCell(size(local_cell_list)))
-      allocate(yCell(size(local_cell_list)))
-      allocate(zCell(size(local_cell_list)))
-#endif
-#endif
-   
-      !
-      ! Now that each process has a list of cells that it owns, exchange cell connectivity 
-      !   information between the processes that read info for a cell and those that own that cell
-      !
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                size(indexToCellIDField % array), size(local_cell_list), &amp;
-                                indexToCellIDField % array, local_cell_list, &amp;
-                                sendCellList, recvCellList)
-   
-      call dmpar_alltoall_field(domain % dminfo, indexToCellIDField % array, indexToCellID_0Halo, &amp;
-                                size(indexToCellIDField % array), size(local_cell_list), &amp;
-                                sendCellList, recvCellList)
-   
-      call dmpar_alltoall_field(domain % dminfo, nEdgesOnCellField % array, nEdgesOnCell_0Halo, &amp;
-                                size(indexToCellIDField % array), size(local_cell_list), &amp;
-                                sendCellList, recvCellList)
-   
-      call dmpar_alltoall_field(domain % dminfo, cellsOnCellField % array, cellsOnCell_0Halo, &amp;
-                                size(cellsOnCellField % array, 1), size(indexToCellIDField % array), size(local_cell_list), &amp;
-                                sendCellList, recvCellList)
-   
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI 
-      call dmpar_alltoall_field(domain % dminfo, xCellField % array, xCell, &amp;
-                                size(xCellField % array), size(local_cell_list), &amp;
-                                sendCellList, recvCellList)
-   
-      call dmpar_alltoall_field(domain % dminfo, yCellField % array, yCell, &amp;
-                                size(yCellField % array), size(local_cell_list), &amp;
-                                sendCellList, recvCellList)
-   
-      call dmpar_alltoall_field(domain % dminfo, zCellField % array, zCell, &amp;
-                                size(zCellField % array), size(local_cell_list), &amp;
-                                sendCellList, recvCellList)
-#endif
-#endif
-
-
-      deallocate(sendCellList % list)
-      deallocate(sendCellList)
-      deallocate(recvCellList % list)
-      deallocate(recvCellList)
-
-
-
-      !
-      ! Build a graph of cell connectivity based on cells owned by this process
-      !
-      block_graph_0Halo % nVerticesTotal = size(local_cell_list)
-      block_graph_0Halo % nVertices = size(local_cell_list)
-      block_graph_0Halo % maxDegree = maxEdges
-      block_graph_0Halo % ghostStart = size(local_cell_list) + 1
-      allocate(block_graph_0Halo % vertexID(size(local_cell_list)))
-      allocate(block_graph_0Halo % nAdjacent(size(local_cell_list)))
-      allocate(block_graph_0Halo % adjacencyList(maxEdges, size(local_cell_list)))
-   
-      block_graph_0Halo % vertexID(:) = indexToCellID_0Halo(:)
-      block_graph_0Halo % nAdjacent(:) = nEdgesOnCell_0Halo(:)
-      block_graph_0Halo % adjacencyList(:,:) = cellsOnCell_0Halo(:,:)
-   
-      ! Get back a graph describing the owned cells plus the cells in the 1-halo
-      call block_decomp_add_halo(domain % dminfo, block_graph_0Halo, block_graph_1Halo)
-   
-   
-      !
-      ! Work out exchange lists for 1-halo and exchange cell information for 1-halo
-      !
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                block_graph_0Halo % nVertices, block_graph_1Halo % nVerticesTotal, &amp;
-                                block_graph_0Halo % vertexID,  block_graph_1Halo % vertexID, &amp;
-                                send1Halo, recv1Halo)
-   
-      call dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % vertexID, block_graph_1Halo % vertexID, &amp;
-                                block_graph_0Halo % nVertices, block_graph_1Halo % nVerticesTotal, &amp;
-                                send1Halo, recv1Halo)
-   
-      call dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % nAdjacent, block_graph_1Halo % nAdjacent, &amp;
-                                block_graph_0Halo % nVertices, block_graph_1Halo % nVerticesTotal, &amp;
-                                send1Halo, recv1Halo)
-   
-      call dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % adjacencyList, block_graph_1Halo % adjacencyList, &amp;
-                                block_graph_0Halo % maxDegree, block_graph_0Halo % nVertices, block_graph_1Halo % nVerticesTotal, &amp;
-                                send1Halo, recv1Halo)
-   
-   
-      !
-      ! Work out exchange lists for 2-halo and exchange cell information for 2-halo
-      !
-      block_graph_1Halo % nVertices = block_graph_1Halo % nVerticesTotal
-      block_graph_1Halo % ghostStart = block_graph_1Halo % nVerticesTotal + 1
-     
-      ! Get back a graph describing the owned and 1-halo cells plus the cells in the 2-halo
-      call block_decomp_add_halo(domain % dminfo, block_graph_1Halo, block_graph_2Halo)
-   
-      block_graph_2Halo % nVertices = block_graph_0Halo % nVertices
-      block_graph_2Halo % ghostStart = block_graph_2Halo % nVertices + 1
-
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI 
-      !! For now, only use Zoltan with MPI
-      !! Zoltan initialization
-      call zoltanStart()
-
-      !! Zoltan hook for cells
-      call zoltanOrderLocHSFC_Cells(block_graph_2Halo%nVertices,block_graph_2Halo%VertexID,3,xCell,yCell,zCell)
-#endif
-#endif
-
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                block_graph_0Halo % nVertices, block_graph_2Halo % nVerticesTotal, &amp;
-                                block_graph_0Halo % vertexID,  block_graph_2Halo % vertexID, &amp;
-                                send2Halo, recv2Halo)
-   
-      call dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % vertexID, block_graph_2Halo % vertexID, &amp;
-                                block_graph_0Halo % nVertices, block_graph_2Halo % nVerticesTotal, &amp;
-                                send2Halo, recv2Halo)
-   
-      call dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % nAdjacent, block_graph_2Halo % nAdjacent, &amp;
-                                block_graph_0Halo % nVertices, block_graph_2Halo % nVerticesTotal, &amp;
-                                send2Halo, recv2Halo)
-   
-      call dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % adjacencyList, block_graph_2Halo % adjacencyList, &amp;
-                                block_graph_0Halo % maxDegree, block_graph_0Halo % nVertices, block_graph_2Halo % nVerticesTotal, &amp;
-                                send2Halo, recv2Halo)
-
-
-   
-      !
-      ! Knowing which cells are in block and the 2-halo, we can exchange lists of which edges are
-      !   on each cell and which vertices are on each cell from the processes that read these
-      !   fields for each cell to the processes that own the cells
-      !
-      allocate(edgesOnCell_2Halo(maxEdges, block_graph_2Halo % nVerticesTotal))
-      allocate(verticesOnCell_2Halo(maxEdges, block_graph_2Halo % nVerticesTotal))
-   
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                size(indexToCellIDField % array), block_graph_2Halo % nVerticesTotal, &amp;
-                                indexToCellIDField % array, block_graph_2Halo % vertexID, &amp;
-                                sendCellList, recvCellList)
-   
-      call dmpar_alltoall_field(domain % dminfo, edgesOnCellField % array, edgesOnCell_2Halo, &amp;
-                                maxEdges, nReadCells, block_graph_2Halo % nVerticesTotal, &amp;
-                                sendCellList, recvCellList)
-   
-      call dmpar_alltoall_field(domain % dminfo, verticesOnCellField % array, verticesOnCell_2Halo, &amp;
-                                maxEdges, nReadCells, block_graph_2Halo % nVerticesTotal, &amp;
-                                sendCellList, recvCellList)
-
-   
-      ! 
-      ! Get a list of which edges and vertices are adjacent to cells (including halo cells) in block
-      ! 
-      call block_decomp_all_edges_in_block(maxEdges, block_graph_2Halo % nVerticesTotal, block_graph_2Halo % nAdjacent, &amp;
-                                           edgesOnCell_2Halo, nlocal_edges, local_edge_list)
-      call block_decomp_all_edges_in_block(maxEdges, block_graph_2Halo % nVerticesTotal, block_graph_2Halo % nAdjacent, &amp;
-                                           verticesOnCell_2Halo, nlocal_vertices, local_vertex_list)
-   
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                size(indexToEdgeIDField % array), nlocal_edges, &amp;
-                                indexToEdgeIDField % array, local_edge_list, &amp;
-                                sendEdgeList, recvEdgeList)
-   
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                size(indexToVertexIDField % array), nlocal_vertices, &amp;
-                                indexToVertexIDField % array, local_vertex_list, &amp;
-                                sendVertexList, recvVertexList)
-   
-   
-   
-      ! 
-      ! Work out which edges and vertices are owned by this process, and which are ghost
-      ! 
-      allocate(cellsOnEdge_2Halo(2,nlocal_edges))
-      allocate(cellsOnVertex_2Halo(vertexDegree,nlocal_vertices))
-   
-      call dmpar_alltoall_field(domain % dminfo, cellsOnEdgeField % array, cellsOnEdge_2Halo, &amp;
-                                2, size(cellsOnEdgeField % array, 2), nlocal_edges, &amp;
-                                sendEdgeList, recvEdgeList)
-   
-      call dmpar_alltoall_field(domain % dminfo, cellsOnVertexField % array, cellsOnVertex_2Halo, &amp;
-                                vertexDegree, size(cellsOnVertexField % array, 2), nlocal_vertices, &amp;
-                                sendVertexList, recvVertexList)
-   
-   
-      call block_decomp_partitioned_edge_list(block_graph_2Halo % nVertices, &amp;
-                                              block_graph_2Halo % vertexID(1:block_graph_2Halo % nVertices), &amp;
-                                              2, nlocal_edges, cellsOnEdge_2Halo, local_edge_list, ghostEdgeStart)
-      call block_decomp_partitioned_edge_list(block_graph_2Halo % nVertices, &amp;
-                                              block_graph_2Halo % vertexID(1:block_graph_2Halo % nVertices), &amp;
-                                              vertexDegree, nlocal_vertices, cellsOnVertex_2Halo, local_vertex_list, ghostVertexStart)
-
-
-      ! At this point, local_edge_list(1;ghostEdgeStart-1) contains all of the owned edges for this block
-      !   and local_edge_list(ghostEdgeStart:nlocal_edges) contains all of the ghost edges
-
-      ! At this point, local_vertex_list(1;ghostVertexStart-1) contains all of the owned vertices for this block
-      !   and local_vertex_list(ghostVertexStart:nlocal_vertices) contains all of the ghost vertices
-
-      ! Also, at this point, block_graph_2Halo % vertexID(1:block_graph_2Halo%nVertices) contains all of the owned
-      !   cells for this block, and block_graph_2Halo % vertexID(block_graph_2Halo%nVertices+1:block_graph_2Halo%nVerticesTotal)
-      !   contains all of the ghost cells
-
-
-      deallocate(sendEdgeList % list)
-      deallocate(sendEdgeList)
-      deallocate(recvEdgeList % list)
-      deallocate(recvEdgeList)
-   
-      deallocate(sendVertexList % list)
-      deallocate(sendVertexList)
-      deallocate(recvVertexList % list)
-      deallocate(recvVertexList)
-   
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI 
-      allocate(xEdge(nlocal_edges))
-      allocate(yEdge(nlocal_edges))
-      allocate(zEdge(nlocal_edges))
-      allocate(xVertex(nlocal_vertices))
-      allocate(yVertex(nlocal_vertices))
-      allocate(zVertex(nlocal_vertices))
-#endif
-#endif
-    
-      !
-      ! Knowing which edges/vertices are owned by this block and which are actually read
-      !   from the input or restart file, we can build exchange lists to perform 
-      !   all-to-all field exchanges from process that reads a field to the processes that
-      !   need them
-      !
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                size(indexToEdgeIDField % array), nlocal_edges, &amp;
-                                indexToEdgeIDField % array, local_edge_list, &amp;
-                                sendEdgeList, recvEdgeList)
-   
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                size(indexToVertexIDField % array), nlocal_vertices, &amp;
-                                indexToVertexIDField % array, local_vertex_list, &amp;
-                                sendVertexList, recvVertexList)
-
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI 
-      call dmpar_alltoall_field(domain % dminfo, xEdgeField % array, xEdge, &amp;
-                                size(xEdgeField % array), nlocal_edges, &amp;
-                                sendEdgeList, recvEdgeList)
-      call dmpar_alltoall_field(domain % dminfo, yEdgeField % array, yEdge, &amp;
-                                size(yEdgeField % array), nlocal_edges, &amp;
-                                sendEdgeList, recvEdgeList)
-      call dmpar_alltoall_field(domain % dminfo, zEdgeField % array, zEdge, &amp;
-                                size(zEdgeField % array), nlocal_edges, &amp;
-                                sendEdgeList, recvEdgeList)
-
-      call dmpar_alltoall_field(domain % dminfo, xVertexField % array, xVertex, &amp;
-                                size(xVertexField % array), nlocal_vertices, &amp;
-                                sendVertexList, recvVertexList)
-      call dmpar_alltoall_field(domain % dminfo, yVertexField % array, yVertex, &amp;
-                                size(yVertexField % array), nlocal_vertices, &amp;
-                                sendVertexList, recvVertexList)
-      call dmpar_alltoall_field(domain % dminfo, zVertexField % array, zVertex, &amp;
-                                size(zVertexField % array), nlocal_vertices, &amp;
-                                sendVertexList, recvVertexList)
-      !!!!!!!!!!!!!!!!!!
-      !! Reorder edges
-      !!!!!!!!!!!!!!!!!!
-      call zoltanOrderLocHSFC_Edges(ghostEdgeStart-1,local_edge_list,3,xEdge,yEdge,zEdge)
-      !!!!!!!!!!!!!!!!!!
-
-      !!!!!!!!!!!!!!!!!!
-      !! Reorder vertices
-      !!!!!!!!!!!!!!!!!!
-      call zoltanOrderLocHSFC_Verts(ghostVertexStart-1,local_vertex_list,3,xVertex,yVertex,zVertex)
-      !!!!!!!!!!!!!!!!!!
-
-      deallocate(sendEdgeList % list)
-      deallocate(sendEdgeList)
-      deallocate(recvEdgeList % list)
-      deallocate(recvEdgeList)
-   
-      deallocate(sendVertexList % list)
-      deallocate(sendVertexList)
-      deallocate(recvVertexList % list)
-      deallocate(recvVertexList)
-    
-      !
-      ! Knowing which edges/vertices are owned by this block and which are actually read
-      !   from the input or restart file, we can build exchange lists to perform 
-      !   all-to-all field exchanges from process that reads a field to the processes that
-      !   need them
-      !
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                size(indexToEdgeIDField % array), nlocal_edges, &amp;
-                                indexToEdgeIDField % array, local_edge_list, &amp;
-                                sendEdgeList, recvEdgeList)
-   
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                size(indexToVertexIDField % array), nlocal_vertices, &amp;
-                                indexToVertexIDField % array, local_vertex_list, &amp;
-                                sendVertexList, recvVertexList)
-
-#endif
-#endif
-
-      ! 
-      ! Build ownership and exchange lists for vertical levels
-      ! Essentially, process 0 owns all vertical levels when reading and writing,
-      ! and it distributes them or gathers them to/from all other processes
-      ! 
-      if (domain % dminfo % my_proc_id == 0) then
-         allocate(local_vertlevel_list(nVertLevels))
-         do i=1,nVertLevels
-            local_vertlevel_list(i) = i
-         end do
-      else
-         allocate(local_vertlevel_list(0))
-      end if
-      allocate(needed_vertlevel_list(nVertLevels))
-      do i=1,nVertLevels
-         needed_vertlevel_list(i) = i
-      end do
-
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                size(local_vertlevel_list), size(needed_vertlevel_list), &amp;
-                                local_vertlevel_list, needed_vertlevel_list, &amp;
-                                sendVertLevelList, recvVertLevelList)
-
-      deallocate(local_vertlevel_list)
-      deallocate(needed_vertlevel_list)
-
-
-      !
-      ! Read and distribute all fields given ownership lists and exchange lists (maybe already in block?)
-      !
-      allocate(domain % blocklist)
-
-      nCells = block_graph_2Halo % nVerticesTotal
-      nEdges = nlocal_edges
-      nVertices = nlocal_vertices
-
-      call allocate_block(domain % blocklist, domain, &amp;
-#include &quot;dim_dummy_args.inc&quot;
-                         )
-
-      !
-      ! Read attributes
-      !
-      call io_input_get_att_text(input_obj, 'on_a_sphere', c_on_a_sphere)
-      call io_input_get_att_real(input_obj, 'sphere_radius', r_sphere_radius)
-      if (index(c_on_a_sphere, 'YES') /= 0) then
-         domain % blocklist % mesh % on_a_sphere = .true.
-      else
-         domain % blocklist % mesh % on_a_sphere = .false.
-      end if
-      domain % blocklist % mesh % sphere_radius = r_sphere_radius
-
-      if (.not. config_do_restart) then
-         input_obj % time = 1
-      else
-         input_obj % time = 1
-
-         !
-         ! If doing a restart, we need to decide which time slice to read from the 
-         !   restart file
-         !
-         if (input_obj % rdLocalTime &lt;= 0) then
-            write(0,*) 'Error: Couldn''t find any times in restart file.'
-            call dmpar_abort(domain % dminfo)
-         end if
-         if (domain % dminfo % my_proc_id == IO_NODE) then
-            allocate(xtime % ioinfo)
-            xtime % ioinfo % start(1) = 1
-            xtime % ioinfo % count(1) = input_obj % rdLocalTime
-            allocate(xtime % array(input_obj % rdLocalTime))
-
-            xtime % ioinfo % fieldName = 'xtime'
-            call io_input_field(input_obj, xtime)
-
-            call MPAS_setTimeInterval(interval=minTimeDiff, DD=10000)
-            call MPAS_setTime(curr_time=startTime, dateTimeString=config_start_time)
-
-            do i=1,input_obj % rdLocalTime
-               call MPAS_setTime(curr_time=sliceTime, dateTimeString=xtime % array(i))
-               timeDiff = abs(sliceTime - startTime)
-               if (timeDiff &lt; minTimeDiff) then
-                  minTimeDiff = timeDiff
-                  input_obj % time = i
-               end if
-            end do
-
-            timeStamp = xtime % array(input_obj % time)
-
-            deallocate(xtime % ioinfo)
-            deallocate(xtime % array)
-         end if
-
-         call dmpar_bcast_int(domain % dminfo, input_obj % time)
-         call dmpar_bcast_char(domain % dminfo, timeStamp)
-
-         write(0,*) 'Restarting model from time ', timeStamp
-
-      end if
-
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-      ! Do the actual work of reading all fields in from the input or restart file
-      ! For each field:
-      !   1) Each process reads a contiguous range of cell/edge/vertex indices, which
-      !      may not correspond with the cells/edges/vertices that are owned by the
-      !      process
-      !   2) All processes then send the global indices that were read to the 
-      !      processes that own those indices based on 
-      !      {send,recv}{Cell,Edge,Vertex,VertLevel}List
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-      call read_and_distribute_fields(domain % dminfo, input_obj, domain % blocklist, &amp;
-                                      readCellStart, nReadCells, readEdgeStart, nReadEdges, readVertexStart, nReadVertices, &amp;
-                                      readVertLevelStart, nReadVertLevels, &amp;
-                                      sendCellList, recvCellList, sendEdgeList, recvEdgeList, sendVertexList, recvVertexList, &amp;
-                                      sendVertLevelList, recvVertLevelList) 
-
-
-      call io_input_finalize(input_obj, domain % dminfo)
-
-   
-      !
-      ! Rename vertices in cellsOnCell, edgesOnCell, etc. to local indices
-      !
-      allocate(cellIDSorted(2,domain % blocklist % mesh % nCells))
-      allocate(edgeIDSorted(2,domain % blocklist % mesh % nEdges))
-      allocate(vertexIDSorted(2,domain % blocklist % mesh % nVertices))
-
-      do i=1,domain % blocklist % mesh % nCells
-         cellIDSorted(1,i) = domain % blocklist % mesh % indexToCellID % array(i)
-         cellIDSorted(2,i) = i
-      end do
-      call quicksort(block_graph_2Halo % nVerticesTotal, cellIDSorted)
-
-      do i=1,domain % blocklist % mesh % nEdges
-         edgeIDSorted(1,i) = domain % blocklist % mesh % indexToEdgeID % array(i)
-         edgeIDSorted(2,i) = i
-      end do
-      call quicksort(nlocal_edges, edgeIDSorted)
-
-      do i=1,domain % blocklist % mesh % nVertices
-         vertexIDSorted(1,i) = domain % blocklist % mesh % indexToVertexID % array(i)
-         vertexIDSorted(2,i) = i
-      end do
-      call quicksort(nlocal_vertices, vertexIDSorted)
-
-
-      do i=1,domain % blocklist % mesh % nCells
-         do j=1,domain % blocklist % mesh % nEdgesOnCell % array(i)
-
-            k = binary_search(cellIDSorted, 2, 1, domain % blocklist % mesh % nCells, &amp;
-                              domain % blocklist % mesh % cellsOnCell % array(j,i))
-            if (k &lt;= domain % blocklist % mesh % nCells) then
-               domain % blocklist % mesh % cellsOnCell % array(j,i) = cellIDSorted(2,k)
-            else
-               domain % blocklist % mesh % cellsOnCell % array(j,i) = domain % blocklist % mesh % nCells + 1
-!               domain % blocklist % mesh % cellsOnCell % array(j,i) = 0
-            end if
-
-            k = binary_search(edgeIDSorted, 2, 1, domain % blocklist % mesh % nEdges, &amp;
-                              domain % blocklist % mesh % edgesOnCell % array(j,i))
-            if (k &lt;= domain % blocklist % mesh % nEdges) then
-               domain % blocklist % mesh % edgesOnCell % array(j,i) = edgeIDSorted(2,k)
-            else
-               domain % blocklist % mesh % edgesOnCell % array(j,i) = domain % blocklist % mesh % nEdges + 1
-!               domain % blocklist % mesh % edgesOnCell % array(j,i) = 0
-            end if
-
-            k = binary_search(vertexIDSorted, 2, 1, domain % blocklist % mesh % nVertices, &amp;
-                              domain % blocklist % mesh % verticesOnCell % array(j,i))
-            if (k &lt;= domain % blocklist % mesh % nVertices) then
-               domain % blocklist % mesh % verticesOnCell % array(j,i) = vertexIDSorted(2,k)
-            else
-               domain % blocklist % mesh % verticesOnCell % array(j,i) = domain % blocklist % mesh % nVertices + 1
-!               domain % blocklist % mesh % verticesOnCell % array(j,i) = 0
-            end if
-
-         end do
-      end do
-
-      do i=1,domain % blocklist % mesh % nEdges
-         do j=1,2
-
-            k = binary_search(cellIDSorted, 2, 1, domain % blocklist % mesh % nCells, &amp;
-                              domain % blocklist % mesh % cellsOnEdge % array(j,i))
-            if (k &lt;= domain % blocklist % mesh % nCells) then
-               domain % blocklist % mesh % cellsOnEdge % array(j,i) = cellIDSorted(2,k)
-            else
-               domain % blocklist % mesh % cellsOnEdge % array(j,i) = domain % blocklist % mesh % nCells + 1
-!               domain % blocklist % mesh % cellsOnEdge % array(j,i) = 0
-            end if
-
-            k = binary_search(vertexIDSorted, 2, 1, domain % blocklist % mesh % nVertices, &amp;
-                              domain % blocklist % mesh % verticesOnEdge % array(j,i))
-            if (k &lt;= domain % blocklist % mesh % nVertices) then
-               domain % blocklist % mesh % verticesOnEdge % array(j,i) = vertexIDSorted(2,k)
-            else
-               domain % blocklist % mesh % verticesOnEdge % array(j,i) = domain % blocklist % mesh % nVertices + 1
-!               domain % blocklist % mesh % verticesOnEdge % array(j,i) = 0
-            end if
-
-         end do
-
-         do j=1,domain % blocklist % mesh % nEdgesOnEdge % array(i)
-
-            k = binary_search(edgeIDSorted, 2, 1, domain % blocklist % mesh % nEdges, &amp;
-                              domain % blocklist % mesh % edgesOnEdge % array(j,i))
-            if (k &lt;= domain % blocklist % mesh % nEdges) then
-               domain % blocklist % mesh % edgesOnEdge % array(j,i) = edgeIDSorted(2,k)
-            else
-               domain % blocklist % mesh % edgesOnEdge % array(j,i) = domain % blocklist % mesh % nEdges + 1
-!               domain % blocklist % mesh % edgesOnEdge % array(j,i) = 0
-            end if
-
-         end do
-      end do
-
-      do i=1,domain % blocklist % mesh % nVertices
-         do j=1,vertexDegree
-
-            k = binary_search(cellIDSorted, 2, 1, domain % blocklist % mesh % nCells, &amp;
-                              domain % blocklist % mesh % cellsOnVertex % array(j,i))
-            if (k &lt;= domain % blocklist % mesh % nCells) then
-               domain % blocklist % mesh % cellsOnVertex % array(j,i) = cellIDSorted(2,k)
-            else
-               domain % blocklist % mesh % cellsOnVertex % array(j,i) = domain % blocklist % mesh % nCells + 1
-!               domain % blocklist % mesh % cellsOnVertex % array(j,i) = 0
-            end if
-
-            k = binary_search(edgeIDSorted, 2, 1, domain % blocklist % mesh % nEdges, &amp;
-                              domain % blocklist % mesh % edgesOnVertex % array(j,i))
-            if (k &lt;= domain % blocklist % mesh % nEdges) then
-               domain % blocklist % mesh % edgesOnVertex % array(j,i) = edgeIDSorted(2,k)
-            else
-               domain % blocklist % mesh % edgesOnVertex % array(j,i) = domain % blocklist % mesh % nEdges + 1
-!               domain % blocklist % mesh % edgesOnVertex % array(j,i) = 0
-            end if
-
-         end do
-      end do
-
-      deallocate(cellIDSorted)
-      deallocate(edgeIDSorted)
-      deallocate(vertexIDSorted)
-
-
-      !
-      ! Work out halo exchange lists for cells, edges, and vertices
-      !
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                block_graph_2Halo % nVertices, block_graph_2Halo % nVerticesTotal, &amp;
-                                block_graph_2Halo % vertexID(1:block_graph_2Halo % nVertices), block_graph_2Halo % vertexID, &amp;
-                                domain % blocklist % parinfo % cellsToSend, domain % blocklist % parinfo % cellsToRecv)
-
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                ghostEdgeStart-1, nlocal_edges, &amp;
-                                local_edge_list(1:ghostEdgeStart-1), local_edge_list, &amp;
-                                domain % blocklist % parinfo % edgesToSend, domain % blocklist % parinfo % edgesToRecv)
-
-      call dmpar_get_owner_list(domain % dminfo, &amp;
-                                ghostVertexStart-1, nlocal_vertices, &amp;
-                                local_vertex_list(1:ghostVertexStart-1), local_vertex_list, &amp;
-                                domain % blocklist % parinfo % verticesToSend, domain % blocklist % parinfo % verticesToRecv)
-
-      domain % blocklist % mesh % nCellsSolve = block_graph_2Halo % nVertices
-      domain % blocklist % mesh % nEdgesSolve = ghostEdgeStart-1
-      domain % blocklist % mesh % nVerticesSolve = ghostVertexStart-1
-      domain % blocklist % mesh % nVertLevelsSolve = domain % blocklist % mesh % nVertLevels   ! No vertical decomp yet...
-
-   
-      !
-      ! Deallocate fields, graphs, and other memory
-      !
-      deallocate(indexToCellIDField % ioinfo)
-      deallocate(indexToCellIDField % array)
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI 
-      deallocate(xCellField % ioinfo)
-      deallocate(xCellField % array)
-      deallocate(yCellField % ioinfo)
-      deallocate(yCellField % array)
-      deallocate(zCellField % ioinfo)
-      deallocate(zCellField % array)
-#endif
-#endif
-      deallocate(indexToEdgeIDField % ioinfo)
-      deallocate(indexToEdgeIDField % array)
-      deallocate(indexToVertexIDField % ioinfo)
-      deallocate(indexToVertexIDField % array)
-      deallocate(cellsOnCellField % ioinfo)
-      deallocate(cellsOnCellField % array)
-      deallocate(edgesOnCellField % ioinfo)
-      deallocate(edgesOnCellField % array)
-      deallocate(verticesOnCellField % ioinfo)
-      deallocate(verticesOnCellField % array)
-      deallocate(cellsOnEdgeField % ioinfo)
-      deallocate(cellsOnEdgeField % array)
-      deallocate(cellsOnVertexField % ioinfo)
-      deallocate(cellsOnVertexField % array)
-      deallocate(cellsOnCell_0Halo)
-      deallocate(nEdgesOnCell_0Halo)
-      deallocate(indexToCellID_0Halo)
-      deallocate(cellsOnEdge_2Halo)
-      deallocate(cellsOnVertex_2Halo)
-      deallocate(edgesOnCell_2Halo)
-      deallocate(verticesOnCell_2Halo)
-      deallocate(block_graph_0Halo % vertexID)
-      deallocate(block_graph_0Halo % nAdjacent)
-      deallocate(block_graph_0Halo % adjacencyList)
-#ifdef HAVE_ZOLTAN
-#ifdef _MPI
-      deallocate(xCell)
-      deallocate(yCell)
-      deallocate(zCell)
-#endif
-#endif
-   end subroutine input_state_for_domain
-
-
-   subroutine read_and_distribute_fields(dminfo, input_obj, block, &amp;
-                                     readCellsStart, readCellsCount, &amp;
-                                     readEdgesStart, readEdgesCount, &amp;
-                                     readVerticesStart, readVerticesCount, &amp;
-                                     readVertLevelsStart, readVertLevelsCount, &amp;
-                                     sendCellsList, recvCellsList, &amp;
-                                     sendEdgesList, recvEdgesList, &amp;
-                                     sendVerticesList, recvVerticesList, &amp;
-                                     sendVertLevelsList, recvVertLevelsList)
-      
-      implicit none
-
-      type (dm_info), intent(in) :: dminfo
-      type (io_input_object), intent(in) :: input_obj
-      type (block_type), intent(inout) :: block
-      integer, intent(in) :: readCellsStart, readCellsCount, readEdgesStart, readEdgesCount, readVerticesStart, readVerticesCount
-      integer, intent(in) :: readVertLevelsStart, readVertLevelsCount
-      type (exchange_list), pointer :: sendCellsList, recvCellsList
-      type (exchange_list), pointer :: sendEdgesList, recvEdgesList
-      type (exchange_list), pointer :: sendVerticesList, recvVerticesList
-      type (exchange_list), pointer :: sendVertLevelsList, recvVertLevelsList
-
-      type (field1dInteger) :: int1d
-      type (field2dInteger) :: int2d
-      type (field0dReal) :: real0d
-      type (field1dReal) :: real1d
-      type (field2dReal) :: real2d
-      type (field3dReal) :: real3d
-      type (field0dChar) :: char0d
-      type (field1dChar) :: char1d
-
-      integer :: i1, i2, i3, i4
-
-      integer, dimension(:), pointer :: super_int1d
-      integer, dimension(:,:), pointer :: super_int2d
-      real (kind=RKIND) :: super_real0d
-      real (kind=RKIND), dimension(:), pointer :: super_real1d
-      real (kind=RKIND), dimension(:,:), pointer :: super_real2d
-      real (kind=RKIND), dimension(:,:,:), pointer :: super_real3d
-      character (len=64) :: super_char0d
-      character (len=64), dimension(:), pointer :: super_char1d
-
-      integer :: i, k
-
-#include &quot;nondecomp_dims.inc&quot;
-
-      allocate(int1d % ioinfo)
-      allocate(int2d % ioinfo)
-      allocate(real0d % ioinfo)
-      allocate(real1d % ioinfo)
-      allocate(real2d % ioinfo)
-      allocate(real3d % ioinfo)
-      allocate(char0d % ioinfo)
-      allocate(char1d % ioinfo)
-
-
-#include &quot;io_input_fields.inc&quot;
-
-#include &quot;nondecomp_dims_dealloc.inc&quot;
-
-   end subroutine read_and_distribute_fields
-
-
-
-   subroutine io_input_init(input_obj, dminfo)

-      implicit none
-
-      type (io_input_object), intent(inout) :: input_obj
-      type (dm_info), intent(in) :: dminfo

-      include 'netcdf.inc'

-      integer :: nferr


-#ifdef OFFSET64BIT
-      nferr = nf_open(trim(input_obj % filename), ior(NF_SHARE,NF_64BIT_OFFSET), input_obj % rd_ncid)
-#else
-      nferr = nf_open(trim(input_obj % filename), NF_SHARE, input_obj % rd_ncid)
-#endif
-
-      if (nferr /= NF_NOERR) then
-         write(0,*) ' '
-         if (input_obj % stream == STREAM_RESTART) then
-            write(0,*) 'Error opening restart file ''', trim(input_obj % filename), ''''
-         else if (input_obj % stream == STREAM_INPUT) then
-            write(0,*) 'Error opening input file ''', trim(input_obj % filename), ''''
-         else if (input_obj % stream == STREAM_SFC) then
-            write(0,*) 'Error opening sfc file ''', trim(input_obj % filename), ''''
-         end if
-         write(0,*) ' '
-         call dmpar_abort(dminfo)
-      end if

-#include &quot;netcdf_read_ids.inc&quot;
-
-   end subroutine io_input_init
-
-  
-   subroutine io_input_get_dimension(input_obj, dimname, dimsize)
-
-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj
-      character (len=*), intent(in) :: dimname
-      integer, intent(out) :: dimsize
-
-#include &quot;get_dimension_by_name.inc&quot;
-
-   end subroutine io_input_get_dimension
-
-   
-   subroutine io_input_get_att_real(input_obj, attname, attvalue)
-      
-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj
-      character (len=*), intent(in) :: attname
-      real (kind=RKIND), intent(out) :: attvalue
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-
-      if (RKIND == 8) then
-         nferr = nf_get_att_double(input_obj % rd_ncid, NF_GLOBAL, attname, attvalue)
-      else
-         nferr = nf_get_att_real(input_obj % rd_ncid, NF_GLOBAL, attname, attvalue)
-      end if
-      if (nferr /= NF_NOERR) then
-         write(0,*) 'Warning: Attribute '//trim(attname)//&amp;
-           ' not found in '//trim(input_obj % filename)
-         if (index(attname, 'sphere_radius') /= 0) then
-            write(0,*) '   Setting '//trim(attname)//' to 1.0'
-            attvalue = 1.0
-         end if
-      end if
-
-   end subroutine io_input_get_att_real
-
-   
-   subroutine io_input_get_att_text(input_obj, attname, attvalue)
-      
-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj
-      character (len=*), intent(in) :: attname
-      character (len=*), intent(out) :: attvalue
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-
-      nferr = nf_get_att_text(input_obj % rd_ncid, NF_GLOBAL, attname, attvalue)
-      if (nferr /= NF_NOERR) then
-         write(0,*) 'Warning: Attribute '//trim(attname)//&amp;
-            ' not found in '//trim(input_obj % filename)
-         if (index(attname, 'on_a_sphere') /= 0) then
-            write(0,*) '   Setting '//trim(attname)//' to ''YES'''
-            attvalue = 'YES'
-         end if
-      end if
-
-   end subroutine io_input_get_att_text
-
-
-   subroutine io_input_field0dReal(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field0dReal), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(1) :: start1, count1

-      start1(1) = 1
-      count1(1) = 1
-
-#include &quot;input_field0dreal.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start1, count1, field % scalar)
-#else
-      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start1, count1, field % scalar)
-#endif

-   end subroutine io_input_field0dReal
-
-
-   subroutine io_input_field1dReal(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field1dReal), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(1) :: start1, count1

-      start1(1) = field % ioinfo % start(1)
-      count1(1) = field % ioinfo % count(1)
-
-      !
-      ! Special case: we may want to read the xtime variable across the
-      !   time dimension as a 1d array.
-      !
-      if (trim(field % ioinfo % fieldName) == 'xtime') then
-         varID = input_obj % rdVarIDxtime
-      end if

-#include &quot;input_field1dreal.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start1, count1, field % array)
-#else
-      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start1, count1, field % array)
-#endif

-   end subroutine io_input_field1dReal
-
-
-   subroutine io_input_field2dReal(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field2dReal), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start2, count2

-      start2(1) = field % ioinfo % start(1)
-      start2(2) = field % ioinfo % start(2)
-      count2(1) = field % ioinfo % count(1)
-      count2(2) = field % ioinfo % count(2)

-#include &quot;input_field2dreal.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start2, count2, field % array)
-#else
-      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start2, count2, field % array)
-#endif
-
-   end subroutine io_input_field2dReal
-
-
-   subroutine io_input_field3dReal(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field3dReal), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(3) :: start3, count3

-      start3(1) = field % ioinfo % start(1)
-      start3(2) = field % ioinfo % start(2)
-      start3(3) = field % ioinfo % start(3)
-      count3(1) = field % ioinfo % count(1)
-      count3(2) = field % ioinfo % count(2)
-      count3(3) = field % ioinfo % count(3)

-#include &quot;input_field3dreal.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start3, count3, field % array)
-#else
-      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start3, count3, field % array)
-#endif
-
-   end subroutine io_input_field3dReal
-
-
-   subroutine io_input_field0dReal_time(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field0dReal), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(1) :: start1, count1

-      start1(1) = input_obj % time
-      count1(1) = 1

-#include &quot;input_field0dreal_time.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start1, count1, field % scalar)
-#else
-      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start1, count1, field % scalar)
-#endif
-
-   end subroutine io_input_field0dReal_time
-
-
-   subroutine io_input_field1dReal_time(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field1dReal), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start2, count2

-      start2(1) = field % ioinfo % start(1)
-      start2(2) = input_obj % time
-      count2(1) = field % ioinfo % count(1)
-      count2(2) = 1

-#include &quot;input_field1dreal_time.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start2, count2, field % array)
-#else
-      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start2, count2, field % array)
-#endif
-
-   end subroutine io_input_field1dReal_time
-
-
-   subroutine io_input_field2dReal_time(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field2dReal), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(3) :: start3, count3

-      start3(1) = field % ioinfo % start(1)
-      start3(2) = field % ioinfo % start(2)
-      start3(3) = input_obj % time
-      count3(1) = field % ioinfo % count(1)
-      count3(2) = field % ioinfo % count(2)
-      count3(3) = 1

-#include &quot;input_field2dreal_time.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start3, count3, field % array)
-#else
-      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start3, count3, field % array)
-#endif
-
-   end subroutine io_input_field2dReal_time
-
-
-   subroutine io_input_field3dReal_time(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field3dReal), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(4) :: start4, count4

-      start4(1) = field % ioinfo % start(1)
-      start4(2) = field % ioinfo % start(2)
-      start4(3) = field % ioinfo % start(3)
-      start4(4) = input_obj % time
-      count4(1) = field % ioinfo % count(1)
-      count4(2) = field % ioinfo % count(2)
-      count4(3) = field % ioinfo % count(3)
-      count4(4) = 1

-#include &quot;input_field3dreal_time.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start4, count4, field % array)
-#else
-      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start4, count4, field % array)
-#endif
-
-   end subroutine io_input_field3dReal_time
-
-
-   subroutine io_input_field1dInteger(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field1dInteger), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(1) :: start1, count1

-      start1(1) = field % ioinfo % start(1)
-      count1(1) = field % ioinfo % count(1)
-      
-#include &quot;input_field1dinteger.inc&quot;
-
-      nferr = nf_get_vara_int(input_obj % rd_ncid, varID, start1, count1, field % array)

-   end subroutine io_input_field1dInteger
-
-
-   subroutine io_input_field2dInteger(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field2dInteger), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start2, count2

-      start2(1) = field % ioinfo % start(1)
-      start2(2) = field % ioinfo % start(2)
-      count2(1) = field % ioinfo % count(1)
-      count2(2) = field % ioinfo % count(2)
-
-#include &quot;input_field2dinteger.inc&quot;
-
-      nferr = nf_get_vara_int(input_obj % rd_ncid, varID, start2, count2, field % array)
-
-   end subroutine io_input_field2dInteger
-
-
-   subroutine io_input_field1dInteger_time(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field1dInteger), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start2, count2

-      start2(1) = field % ioinfo % start(1)
-      start2(2) = input_obj % time
-      count2(1) = field % ioinfo % count(1)
-      count2(2) = 1

-#include &quot;input_field1dinteger_time.inc&quot;
-
-      nferr = nf_get_vara_int(input_obj % rd_ncid, varID, start2, count2, field % array)
-
-   end subroutine io_input_field1dInteger_time
-
-
-   subroutine io_input_field0dChar_time(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field0dChar), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start1, count1

-      start1(1) = 1
-      count1(1) = 64
-      start1(2) = input_obj % time
-      count1(2) = 1

-#include &quot;input_field0dchar_time.inc&quot;
-
-      nferr = nf_get_vara_text(input_obj % rd_ncid, varID, start1, count1, field % scalar)
-
-   end subroutine io_input_field0dChar_time
-
-
-   subroutine io_input_field1dChar_time(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field1dChar), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(3) :: start2, count2

-      start2(1) = 1
-      start2(2) = field % ioinfo % start(1)
-      start2(3) = input_obj % time
-      count2(1) = 64
-      count2(2) = field % ioinfo % count(1)
-      count2(3) = 1

-#include &quot;input_field1dchar_time.inc&quot;
-
-      nferr = nf_get_vara_text(input_obj % rd_ncid, varID, start2, count2, field % array)
-
-   end subroutine io_input_field1dChar_time
-
-
-   subroutine io_input_field0dChar(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field0dChar), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start1, count1

-      start1(1) = 1
-      count1(1) = 64
-      start1(2) = 1
-      count1(2) = 1
-
-#include &quot;input_field0dchar.inc&quot;
-
-      nferr = nf_get_vara_text(input_obj % rd_ncid, varID, start1, count1, field % scalar)

-   end subroutine io_input_field0dChar
-
-
-   subroutine io_input_field1dChar(input_obj, field)

-      implicit none
-
-      type (io_input_object), intent(in) :: input_obj      
-      type (field1dChar), intent(inout) :: field

-      include 'netcdf.inc'

-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start1, count1

-      start1(1) = 1
-      count1(1) = 64
-      start1(2) = field % ioinfo % start(1)
-      count1(2) = field % ioinfo % count(1)
-
-      !
-      ! Special case: we may want to read the xtime variable across the
-      !   time dimension as a 1d array.
-      !
-      if (trim(field % ioinfo % fieldName) == 'xtime') then
-         varID = input_obj % rdVarIDxtime
-      end if

-#include &quot;input_field1dchar.inc&quot;
-
-      nferr = nf_get_vara_text(input_obj % rd_ncid, varID, start1, count1, field % array)

-   end subroutine io_input_field1dChar
-
-
-   subroutine io_input_finalize(input_obj, dminfo)

-      implicit none

-      type (io_input_object), intent(inout) :: input_obj
-      type (dm_info), intent(in) :: dminfo
-
-      include 'netcdf.inc'

-      integer :: nferr

-      nferr = nf_close(input_obj % rd_ncid)

-   end subroutine io_input_finalize

-end module io_input

Deleted: branches/source_condensing/src/framework/module_io_output.F
===================================================================
--- trunk/mpas/src/framework/module_io_output.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/module_io_output.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,866 +0,0 @@
-module io_output
-
-   use grid_types
-   use dmpar
-   use sort
-   use configure
-
-   integer, parameter :: OUTPUT = 1
-   integer, parameter :: RESTART = 2
-   integer, parameter :: SFC = 3

-   type io_output_object
-      integer :: wr_ncid
-      character (len=1024) :: filename
-
-      integer :: time
-
-      integer :: stream
-
-      integer :: wrDimIDStrLen
-#include &quot;io_output_obj_decls.inc&quot;
-
-      logical :: validExchangeLists
-      type (exchange_list), pointer :: sendCellsList, recvCellsList
-      type (exchange_list), pointer :: sendEdgesList, recvEdgesList
-      type (exchange_list), pointer :: sendVerticesList, recvVerticesList
-      type (exchange_list), pointer :: sendVertLevelsList, recvVertLevelsList
-   end type io_output_object
-
-
-   interface io_output_field
-      module procedure io_output_field0dReal
-      module procedure io_output_field1dReal
-      module procedure io_output_field2dReal
-      module procedure io_output_field3dReal
-      module procedure io_output_field1dInteger
-      module procedure io_output_field2dInteger
-      module procedure io_output_field0dChar
-      module procedure io_output_field1dChar
-   end interface io_output_field
-
-   interface io_output_field_time
-      module procedure io_output_field0dReal_time
-      module procedure io_output_field1dReal_time
-      module procedure io_output_field2dReal_time
-      module procedure io_output_field3dReal_time
-      module procedure io_output_field1dInteger_time
-      module procedure io_output_field0dChar_time
-      module procedure io_output_field1dChar_time
-   end interface io_output_field_time

-
-   contains
-

-   subroutine output_state_init(output_obj, domain, stream, outputSuffix)
-
-      implicit none
-
-      type (io_output_object), intent(inout) :: output_obj
-      type (domain_type), intent(in) :: domain
-      character (len=*) :: stream
-      character (len=*), optional :: outputSuffix
-
-      character (len=128) :: tempfilename
-
-      type (block_type), pointer :: block_ptr
-#include &quot;output_dim_actual_decls.inc&quot;
-
-      block_ptr =&gt; domain % blocklist
-      nullify(output_obj % sendCellsList)
-      nullify(output_obj % recvCellsList)
-      nullify(output_obj % sendEdgesList)
-      nullify(output_obj % recvEdgesList)
-      nullify(output_obj % sendVerticesList)
-      nullify(output_obj % recvVerticesList)
-      nullify(output_obj % sendVertLevelsList)
-      nullify(output_obj % recvVertLevelsList)
-      output_obj % validExchangeLists = .false.
-
-#include &quot;output_dim_inits.inc&quot;
-
-      call dmpar_sum_int(domain % dminfo, block_ptr % mesh % nCellsSolve, nCellsGlobal) 
-      call dmpar_sum_int(domain % dminfo, block_ptr % mesh % nEdgesSolve, nEdgesGlobal) 
-      call dmpar_sum_int(domain % dminfo, block_ptr % mesh % nVerticesSolve, nVerticesGlobal) 
-      nVertLevelsGlobal = block_ptr % mesh % nVertLevels
-
-      if (trim(stream) == 'OUTPUT') then
-         if(present(outputSuffix)) then
-            call insert_string_suffix(config_output_name, outputSuffix, tempfilename)
-         else
-            tempfilename = config_output_name
-         end if
-         output_obj % filename = trim(tempfilename)
-         output_obj % stream = OUTPUT
-      else if (trim(stream) == 'RESTART') then
-         output_obj % filename = trim(config_restart_name)
-         output_obj % stream = RESTART
-      else if (trim(stream) == 'SFC') then
-         ! Keep filename as whatever was set by the user
-         output_obj % stream = SFC
-      end if
-
-      ! For now, we assume that a domain consists only of one block,
-      !   although in future, work needs to be done to write model state
-      !   from many distributed blocks
-      call io_output_init(output_obj, domain % dminfo, &amp;
-                          block_ptr % mesh, &amp;
-#include &quot;output_dim_actual_args.inc&quot;
-                         )
-
-   end subroutine output_state_init
-
-
-   subroutine insert_string_suffix(stream, suffix, filename)
-
-      implicit none
-
-      character (len=*), intent(in) :: stream
-      character (len=*), intent(in) :: suffix
-      character (len=*), intent(out) :: filename
-      integer :: length, i
-
-      filename = trim(stream) // '.' // trim(suffix)
-
-      length = len_trim(stream)
-      do i=length-1,1,-1
-         if(stream(i:i) == '.') then
-            filename = trim(stream(:i)) // trim(suffix) // trim(stream(i:))
-            exit
-         end if
-      end do
-
-   end subroutine  insert_string_suffix
-
-
-   subroutine output_state_for_domain(output_obj, domain, itime)
-   
-      implicit none
-   
-      type (io_output_object), intent(inout) :: output_obj
-      type (domain_type), intent(inout) :: domain
-      integer, intent(in) :: itime
-
-      integer :: i, j
-      integer :: nCellsGlobal
-      integer :: nEdgesGlobal
-      integer :: nVerticesGlobal
-      integer :: nVertLevelsGlobal
-      integer, dimension(:), pointer :: neededCellList
-      integer, dimension(:), pointer :: neededEdgeList
-      integer, dimension(:), pointer :: neededVertexList
-      integer, dimension(:), pointer :: neededVertLevelList
-      integer, dimension(:,:), pointer :: cellsOnCell, edgesOnCell, verticesOnCell, &amp;
-                                          cellsOnEdge, verticesOnEdge, edgesOnEdge, cellsOnVertex, edgesOnVertex
-      integer, dimension(:,:), pointer :: cellsOnCell_save, edgesOnCell_save, verticesOnCell_save, &amp;
-                                          cellsOnEdge_save, verticesOnEdge_save, edgesOnEdge_save, &amp;
-                                          cellsOnVertex_save, edgesOnVertex_save
-      type (field1dInteger) :: int1d
-      type (field2dInteger) :: int2d
-      type (field0dReal) :: real0d
-      type (field1dReal) :: real1d
-      type (field2dReal) :: real2d
-      type (field3dReal) :: real3d
-      type (field0dChar) :: char0d
-      type (field1dChar) :: char1d
-
-      integer :: i1, i2, i3, i4
-
-      integer, dimension(:), pointer :: super_int1d
-      integer, dimension(:,:), pointer :: super_int2d
-      real (kind=RKIND) :: super_real0d
-      real (kind=RKIND), dimension(:), pointer :: super_real1d
-      real (kind=RKIND), dimension(:,:), pointer :: super_real2d
-      real (kind=RKIND), dimension(:,:,:), pointer :: super_real3d
-      character (len=64) :: super_char0d
-      character (len=64), dimension(:), pointer :: super_char1d
-
-#include &quot;nondecomp_outputs.inc&quot;
-
-      output_obj % time = itime
-
-      allocate(int1d % ioinfo)
-      allocate(int2d % ioinfo)
-      allocate(real0d % ioinfo)
-      allocate(real1d % ioinfo)
-      allocate(real2d % ioinfo)
-      allocate(real3d % ioinfo)
-      allocate(char0d % ioinfo)
-      allocate(char1d % ioinfo)
-
-      call dmpar_sum_int(domain % dminfo, domain % blocklist % mesh % nCellsSolve, nCellsGlobal)
-      call dmpar_sum_int(domain % dminfo, domain % blocklist % mesh % nEdgesSolve, nEdgesGlobal)
-      call dmpar_sum_int(domain % dminfo, domain % blocklist % mesh % nVerticesSolve, nVerticesGlobal)
-      nVertLevelsGlobal = domain % blocklist % mesh % nVertLevels
-
-      allocate(cellsOnCell(domain % blocklist % mesh % maxEdges, domain % blocklist % mesh % nCellsSolve))
-      allocate(edgesOnCell(domain % blocklist % mesh % maxEdges, domain % blocklist % mesh % nCellsSolve))
-      allocate(verticesOnCell(domain % blocklist % mesh % maxEdges, domain % blocklist % mesh % nCellsSolve))
-      allocate(cellsOnEdge(2, domain % blocklist % mesh % nEdgesSolve))
-      allocate(verticesOnEdge(2, domain % blocklist % mesh % nEdgesSolve))
-      allocate(edgesOnEdge(2 * domain % blocklist % mesh % maxEdges, domain % blocklist % mesh % nEdgesSolve))
-      allocate(cellsOnVertex(domain % blocklist % mesh % vertexDegree, domain % blocklist % mesh % nVerticesSolve))
-      allocate(edgesOnVertex(domain % blocklist % mesh % vertexDegree, domain % blocklist % mesh % nVerticesSolve))
-
-
-      !
-      ! Convert connectivity information from local to global indices
-      !
-      do i=1,domain % blocklist % mesh % nCellsSolve
-         do j=1,domain % blocklist % mesh % nEdgesOnCell % array(i)
-            cellsOnCell(j,i) = domain % blocklist % mesh % indexToCellID % array( &amp;
-                                                                           domain % blocklist % mesh % cellsOnCell % array(j,i))
-            edgesOnCell(j,i) = domain % blocklist % mesh % indexToEdgeID % array( &amp;
-                                                                           domain % blocklist % mesh % edgesOnCell % array(j,i))
-            verticesOnCell(j,i) = domain % blocklist % mesh % indexToVertexID % array( &amp;
-                                                                           domain % blocklist % mesh % verticesOnCell % array(j,i))
-         end do
-         do j=domain % blocklist % mesh % nEdgesOnCell % array(i)+1,domain % blocklist % mesh % maxEdges
-            cellsOnCell(j,i) = domain % blocklist % mesh % indexToCellID % array( &amp;
-                                                                           domain % blocklist % mesh % nEdgesOnCell % array(i))
-            edgesOnCell(j,i) = domain % blocklist % mesh % indexToEdgeID % array( &amp;
-                                                                           domain % blocklist % mesh % nEdgesOnCell % array(i))
-            verticesOnCell(j,i) = domain % blocklist % mesh % indexToVertexID % array( &amp;
-                                                                           domain % blocklist % mesh % nEdgesOnCell % array(i))
-         end do
-      end do
-      do i=1,domain % blocklist % mesh % nEdgesSolve
-         cellsOnEdge(1,i) = domain % blocklist % mesh % indexToCellID % array(domain % blocklist % mesh % cellsOnEdge % array(1,i))
-         cellsOnEdge(2,i) = domain % blocklist % mesh % indexToCellID % array(domain % blocklist % mesh % cellsOnEdge % array(2,i))
-         verticesOnEdge(1,i) = domain % blocklist % mesh % indexToVertexID % array( &amp;
-                                                                           domain % blocklist % mesh % verticesOnEdge % array(1,i))
-         verticesOnEdge(2,i) = domain % blocklist % mesh % indexToVertexID % array( &amp;
-                                                                           domain % blocklist % mesh % verticesOnEdge % array(2,i))
-         do j=1,domain % blocklist % mesh % nEdgesOnEdge % array(i)
-            edgesOnEdge(j,i) = domain % blocklist % mesh % indexToEdgeID % array( &amp;
-                                                                           domain % blocklist % mesh % edgesOnEdge % array(j,i))
-         end do
-         do j=domain % blocklist % mesh % nEdgesOnEdge % array(i)+1,2*domain % blocklist % mesh % maxEdges
-            if(domain % blocklist % mesh % nEdgesOnEdge % array(i) .eq. 0) then
-               edgesOnEdge(j,i) = domain % blocklist % mesh % nEdgesSolve + 1
-            else
-               edgesOnEdge(j,i) = domain % blocklist % mesh % indexToEdgeID % array( &amp;
-                                                                           domain % blocklist % mesh % nEdgesOnEdge % array(i))
-            endif
-         end do
-      end do
-      do i=1,domain % blocklist % mesh % nVerticesSolve
-         do j=1,domain % blocklist % mesh % vertexDegree
-            cellsOnVertex(j,i) = domain % blocklist % mesh % indexToCellID % array( &amp;
-                                                                           domain % blocklist % mesh % cellsOnVertex % array(j,i))
-            edgesOnVertex(j,i) = domain % blocklist % mesh % indexToEdgeID % array( &amp;
-                                                                           domain % blocklist % mesh % edgesOnVertex % array(j,i))
-         end do
-      end do
-
-      if (domain % dminfo % my_proc_id == 0) then
-         allocate(neededCellList(nCellsGlobal))
-         allocate(neededEdgeList(nEdgesGlobal))
-         allocate(neededVertexList(nVerticesGlobal))
-         allocate(neededVertLevelList(nVertLevelsGlobal))
-         do i=1,nCellsGlobal
-            neededCellList(i) = i
-         end do
-         do i=1,nEdgesGlobal
-            neededEdgeList(i) = i
-         end do
-         do i=1,nVerticesGlobal
-            neededVertexList(i) = i
-         end do
-         do i=1,nVertLevelsGlobal
-            neededVertLevelList(i) = i
-         end do
-      else
-         allocate(neededCellList(0))
-         allocate(neededEdgeList(0))
-         allocate(neededVertexList(0))
-         allocate(neededVertLevelList(0))
-      end if
-
-      if (.not. output_obj % validExchangeLists) then
-         call dmpar_get_owner_list(domain % dminfo, &amp;
-                                   domain % blocklist % mesh % nCellsSolve, size(neededCellList), &amp;
-                                   domain % blocklist % mesh % indexToCellID % array, neededCellList, &amp;
-                                   output_obj % sendCellsList, output_obj % recvCellsList)
-
-         call dmpar_get_owner_list(domain % dminfo, &amp;
-                                   domain % blocklist % mesh % nEdgesSolve, size(neededEdgeList), &amp;
-                                   domain % blocklist % mesh % indexToEdgeID % array, neededEdgeList, &amp;
-                                   output_obj % sendEdgesList, output_obj % recvEdgesList)
-
-         call dmpar_get_owner_list(domain % dminfo, &amp;
-                                   domain % blocklist % mesh % nVerticesSolve, size(neededVertexList), &amp;
-                                   domain % blocklist % mesh % indexToVertexID % array, neededVertexList, &amp;
-                                   output_obj % sendVerticesList, output_obj % recvVerticesList)
-
-         call dmpar_get_owner_list(domain % dminfo, &amp;
-                                   size(neededVertLevelList), size(neededVertLevelList), &amp;
-                                   neededVertLevelList, neededVertLevelList, &amp;
-                                   output_obj % sendVertLevelsList, output_obj % recvVertLevelsList)
-
-         output_obj % validExchangeLists = .true.
-      end if
-
-      deallocate(neededCellList)
-      deallocate(neededEdgeList)
-      deallocate(neededVertexList)
-
-      cellsOnCell_save =&gt; domain % blocklist % mesh % cellsOnCell % array
-      edgesOnCell_save =&gt; domain % blocklist % mesh % edgesOnCell % array
-      verticesOnCell_save =&gt; domain % blocklist % mesh % verticesOnCell % array
-      cellsOnEdge_save =&gt; domain % blocklist % mesh % cellsOnEdge % array
-      verticesOnEdge_save =&gt; domain % blocklist % mesh % verticesOnEdge % array
-      edgesOnEdge_save =&gt; domain % blocklist % mesh % edgesOnEdge % array
-      cellsOnVertex_save =&gt; domain % blocklist % mesh % cellsOnVertex % array
-      edgesOnVertex_save =&gt; domain % blocklist % mesh % edgesOnVertex % array
-
-      domain % blocklist % mesh % cellsOnCell % array =&gt; cellsOnCell
-      domain % blocklist % mesh % edgesOnCell % array =&gt; edgesOnCell
-      domain % blocklist % mesh % verticesOnCell % array =&gt; verticesOnCell
-      domain % blocklist % mesh % cellsOnEdge % array =&gt; cellsOnEdge
-      domain % blocklist % mesh % verticesOnEdge % array =&gt; verticesOnEdge
-      domain % blocklist % mesh % edgesOnEdge % array =&gt; edgesOnEdge
-      domain % blocklist % mesh % cellsOnVertex % array =&gt; cellsOnVertex
-      domain % blocklist % mesh % edgesOnVertex % array =&gt; edgesOnVertex
-
-#include &quot;io_output_fields.inc&quot;
-
-      domain % blocklist % mesh % cellsOnCell % array =&gt; cellsOnCell_save
-      domain % blocklist % mesh % edgesOnCell % array =&gt; edgesOnCell_save
-      domain % blocklist % mesh % verticesOnCell % array =&gt; verticesOnCell_save
-      domain % blocklist % mesh % cellsOnEdge % array =&gt; cellsOnEdge_save
-      domain % blocklist % mesh % verticesOnEdge % array =&gt; verticesOnEdge_save
-      domain % blocklist % mesh % edgesOnEdge % array =&gt; edgesOnEdge_save
-      domain % blocklist % mesh % cellsOnVertex % array =&gt; cellsOnVertex_save
-      domain % blocklist % mesh % edgesOnVertex % array =&gt; edgesOnVertex_save
-
-      deallocate(cellsOnCell)
-      deallocate(edgesOnCell)
-      deallocate(verticesOnCell)
-      deallocate(cellsOnEdge)
-      deallocate(verticesOnEdge)
-      deallocate(edgesOnEdge)
-      deallocate(cellsOnVertex)
-      deallocate(edgesOnVertex)
-
-#include &quot;nondecomp_outputs_dealloc.inc&quot;
-
-   end subroutine output_state_for_domain
-
-
-   subroutine output_state_finalize(output_obj, dminfo)
-
-      implicit none
-
-      type (io_output_object), intent(inout) :: output_obj
-      type (dm_info), intent(in) :: dminfo
-
-      call io_output_finalize(output_obj, dminfo)
-
-   end subroutine output_state_finalize
-
-
-   subroutine io_output_init( output_obj, &amp;
-                              dminfo, &amp;
-                              mesh, &amp;
-#include &quot;dim_dummy_args.inc&quot;
-                            )

-      implicit none

-      include 'netcdf.inc'

-      type (io_output_object), intent(inout) :: output_obj
-      type (dm_info), intent(in) :: dminfo
-      type (mesh_type), intent(in) :: mesh
-#include &quot;dim_dummy_decls.inc&quot;

-      integer :: nferr
-      integer, dimension(10) :: dimlist

-      if (dminfo % my_proc_id == 0) then
-#ifdef OFFSET64BIT
-      nferr = nf_create(trim(output_obj % filename), ior(NF_CLOBBER,NF_64BIT_OFFSET), output_obj % wr_ncid)
-#else
-      nferr = nf_create(trim(output_obj % filename), NF_CLOBBER, output_obj % wr_ncid)
-#endif

-      nferr = nf_def_dim(output_obj % wr_ncid, 'StrLen', 64, output_obj % wrDimIDStrLen)
-#include &quot;netcdf_def_dims_vars.inc&quot;
-
-      if (mesh % on_a_sphere) then
-         nferr = nf_put_att_text(output_obj % wr_ncid, NF_GLOBAL, 'on_a_sphere', 16, 'YES             ')
-      else
-         nferr = nf_put_att_text(output_obj % wr_ncid, NF_GLOBAL, 'on_a_sphere', 16, 'NO              ')
-      end if
-      if (RKIND == 8) then
-         nferr = nf_put_att_double(output_obj % wr_ncid, NF_GLOBAL, 'sphere_radius', NF_DOUBLE, 1, mesh % sphere_radius)
-      else
-         nferr = nf_put_att_real(output_obj % wr_ncid, NF_GLOBAL, 'sphere_radius', NF_FLOAT, 1, mesh % sphere_radius)
-      end if

-      nferr = nf_enddef(output_obj % wr_ncid)
-      end if

-   end subroutine io_output_init
-
-
-   subroutine io_output_field0dReal(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field0dReal), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(1) :: start1, count1
-
-      start1(1) = 1
-      count1(1) = 1
-
-#include &quot;output_field0dreal.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start1, count1, field % scalar)
-#else
-      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start1, count1, field % scalar)
-#endif

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field0dReal
-
-
-   subroutine io_output_field1dReal(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field1dReal), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(1) :: start1, count1
-
-      start1(1) = field % ioinfo % start(1)
-      count1(1) = field % ioinfo % count(1)
-
-#include &quot;output_field1dreal.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_put_vara_double(output_obj % wr_ncid, VarID, start1, count1, field % array)
-#else
-      nferr = nf_put_vara_real(output_obj % wr_ncid, VarID, start1, count1, field % array)
-#endif

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field1dReal


-   subroutine io_output_field2dReal(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field2dReal), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start2, count2
-
-      start2(1) = field % ioinfo % start(1)
-      start2(2) = field % ioinfo % start(2)
-      count2(1) = field % ioinfo % count(1)
-      count2(2) = field % ioinfo % count(2)
-
-#include &quot;output_field2dreal.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start2, count2, field % array)
-#else
-      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start2, count2, field % array)
-#endif

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field2dReal


-   subroutine io_output_field3dReal(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field3dReal), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(3) :: start3, count3
-
-      start3(1) = field % ioinfo % start(1)
-      start3(2) = field % ioinfo % start(2)
-      start3(3) = field % ioinfo % start(3)
-      count3(1) = field % ioinfo % count(1)
-      count3(2) = field % ioinfo % count(2)
-      count3(3) = field % ioinfo % count(3)
-
-#include &quot;output_field3dreal.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start3, count3, field % array)
-#else
-      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start3, count3, field % array)
-#endif

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field3dReal
-
-
-   subroutine io_output_field0dReal_time(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field0dReal), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(1) :: start1, count1
-
-      start1(1) = output_obj % time
-      count1(1) = 1
-
-#include &quot;output_field0dreal_time.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start1, count1, field % scalar)
-#else
-      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start1, count1, field % scalar)
-#endif

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field0dReal_time
-
-
-   subroutine io_output_field1dReal_time(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field1dReal), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start2, count2
-
-      start2(1) = field % ioinfo % start(1)
-      start2(2) = output_obj % time
-      count2(1) = field % ioinfo % count(1)
-      count2(2) = 1
-
-#include &quot;output_field1dreal_time.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start2, count2, field % array)
-#else
-      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start2, count2, field % array)
-#endif

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field1dReal_time
-
-
-   subroutine io_output_field2dReal_time(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field2dReal), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(3) :: start3, count3
-
-      start3(1) = field % ioinfo % start(1)
-      start3(2) = field % ioinfo % start(2)
-      start3(3) = output_obj % time
-      count3(1) = field % ioinfo % count(1)
-      count3(2) = field % ioinfo % count(2)
-      count3(3) = 1
-
-#include &quot;output_field2dreal_time.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start3, count3, field % array)
-#else
-      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start3, count3, field % array)
-#endif

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field2dReal_time
-
-
-   subroutine io_output_field3dReal_time(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field3dReal), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(4) :: start4, count4
-
-      start4(1) = field % ioinfo % start(1)
-      start4(2) = field % ioinfo % start(2)
-      start4(3) = field % ioinfo % start(3)
-      start4(4) = output_obj % time
-      count4(1) = field % ioinfo % count(1)
-      count4(2) = field % ioinfo % count(2)
-      count4(3) = field % ioinfo % count(3)
-      count4(4) = 1
-
-#include &quot;output_field3dreal_time.inc&quot;
-
-#if (RKIND == 8)
-      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start4, count4, field % array)
-#else
-      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start4, count4, field % array)
-#endif

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field3dReal_time
-
-
-   subroutine io_output_field1dInteger(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field1dInteger), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(1) :: start1, count1
-
-      start1(1) = field % ioinfo % start(1)
-      count1(1) = field % ioinfo % count(1)
-
-#include &quot;output_field1dinteger.inc&quot;
-
-      nferr = nf_put_vara_int(output_obj % wr_ncid, varID, start1, count1, field % array)

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field1dInteger
-
-
-   subroutine io_output_field2dInteger(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field2dInteger), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start2, count2
-
-      start2(1) = field % ioinfo % start(1)
-      start2(2) = field % ioinfo % start(2)
-      count2(1) = field % ioinfo % count(1)
-      count2(2) = field % ioinfo % count(2)
-
-#include &quot;output_field2dinteger.inc&quot;
-
-      nferr = nf_put_vara_int(output_obj % wr_ncid, varID, start2, count2, field % array)

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field2dInteger
-
-
-   subroutine io_output_field1dInteger_time(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field1dInteger), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start2, count2
-
-      start2(1) = field % ioinfo % start(1)
-      start2(2) = output_obj % time
-      count2(1) = field % ioinfo % count(1)
-      count2(2) = 1
-
-#include &quot;output_field1dinteger_time.inc&quot;
-
-      nferr = nf_put_vara_int(output_obj % wr_ncid, varID, start2, count2, field % array)

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field1dInteger_time
-
-
-   subroutine io_output_field0dChar_time(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field0dChar), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start1, count1
-
-      start1(1) = 1
-      count1(1) = 64
-      start1(2) = output_obj % time
-      count1(2) = 1
-
-#include &quot;output_field0dchar_time.inc&quot;
-
-      nferr = nf_put_vara_text(output_obj % wr_ncid, varID, start1, count1, field % scalar)

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field0dChar_time
-
-
-   subroutine io_output_field1dChar_time(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field1dChar), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(3) :: start2, count2
-
-      start2(1) = 1
-      start2(2) = field % ioinfo % start(1)
-      start2(3) = output_obj % time
-      count2(1) = 64
-      count2(2) = field % ioinfo % count(1)
-      count2(3) = 1
-
-#include &quot;output_field1dchar_time.inc&quot;
-
-      nferr = nf_put_vara_text(output_obj % wr_ncid, varID, start2, count2, field % array)

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field1dChar_time
-
-
-   subroutine io_output_field0dChar(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field0dChar), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start1, count1
-
-      start1(1) = 1
-      count1(1) = 64
-      start1(2) = 1
-      count1(2) = 1
-
-#include &quot;output_field0dchar.inc&quot;
-
-      nferr = nf_put_vara_text(output_obj % wr_ncid, varID, start1, count1, field % scalar)

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field0dChar
-
-
-   subroutine io_output_field1dChar(output_obj, field)
-
-      implicit none
-
-      type (io_output_object), intent(in) :: output_obj
-      type (field1dChar), intent(inout) :: field
-
-      include 'netcdf.inc'
-
-      integer :: nferr
-      integer :: varID
-      integer, dimension(2) :: start1, count1
-
-      start1(1) = 1
-      count1(1) = 64
-      start1(2) = field % ioinfo % start(1)
-      count1(2) = field % ioinfo % count(1)
-
-#include &quot;output_field1dchar.inc&quot;
-
-      nferr = nf_put_vara_text(output_obj % wr_ncid, VarID, start1, count1, field % array)

-      nferr = nf_sync(output_obj % wr_ncid)
-
-   end subroutine io_output_field1dChar
-
-
-   subroutine io_output_finalize(output_obj, dminfo)

-      implicit none

-      include 'netcdf.inc'
-
-      type (io_output_object), intent(inout) :: output_obj
-      type (dm_info), intent(in) :: dminfo

-      integer :: nferr

-      if (dminfo % my_proc_id == 0) then
-      nferr = nf_close(output_obj % wr_ncid)
-      end if

-   end subroutine io_output_finalize

-end module io_output


Deleted: branches/source_condensing/src/framework/module_mpas_framework.F
===================================================================
--- trunk/mpas/src/framework/module_mpas_framework.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/module_mpas_framework.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,49 +0,0 @@
-module mpas_framework
-
-   use dmpar
-   use grid_types
-   use io_input
-   use io_output
-   use configure
-   use timer
-   use mpas_timekeeping
-
-
-   contains
-
-   
-   subroutine mpas_framework_init(dminfo, domain)
-
-      implicit none
-
-      type (dm_info), pointer :: dminfo
-      type (domain_type), pointer :: domain
-
-      allocate(dminfo)
-      call dmpar_init(dminfo)
-
-      call read_namelist(dminfo)
-
-      call allocate_domain(domain, dminfo)
-      
-      call mpas_timekeeping_init(config_calendar_type)
-
-   end subroutine mpas_framework_init
-
-   
-   subroutine mpas_framework_finalize(dminfo, domain)
-  
-      implicit none
-
-      type (dm_info), pointer :: dminfo
-      type (domain_type), pointer :: domain
-
-      call deallocate_domain(domain)
-
-      call dmpar_finalize(dminfo)
-
-      call mpas_timekeeping_finalize()
-
-   end subroutine mpas_framework_finalize
-
-end module mpas_framework

Deleted: branches/source_condensing/src/framework/module_mpas_timekeeping.F
===================================================================
--- trunk/mpas/src/framework/module_mpas_timekeeping.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/module_mpas_timekeeping.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,1625 +0,0 @@
-module mpas_timekeeping
-
-   use ESMF_BaseMod
-   use ESMF_Stubs
-   use ESMF_CalendarMod
-   use ESMF_ClockMod
-   use ESMF_TimeMod
-   use ESMF_TimeIntervalMod
-
-   private :: MPAS_CalibrateAlarms
-   private :: MPAS_inRingingEnvelope
-
-   integer, parameter :: MPAS_MAX_ALARMS = 20
-   integer, parameter :: MPAS_NOW = 0, &amp;
-                         MPAS_START_TIME = 1, &amp;
-                         MPAS_STOP_TIME = 2
-   integer, parameter :: MPAS_FORWARD = 1, &amp;
-                         MPAS_BACKWARD = -1
-   integer, parameter :: MPAS_GREGORIAN = 0, &amp;
-                         MPAS_GREGORIAN_NOLEAP = 1, &amp;
-                         MPAS_360DAY = 2
-
-   integer :: TheCalendar 
-
-   integer, dimension(12), parameter :: daysInMonth     = (/31,28,31,30,31,30,31,31,30,31,30,31/)
-   integer, dimension(12), parameter :: daysInMonthLeap = (/31,29,31,30,31,30,31,31,30,31,30,31/)
-
-
-   type MPAS_Time_type
-      type (ESMF_Time) :: t
-   end type
-
-   type MPAS_TimeInterval_type
-      type (ESMF_TimeInterval) :: ti
-   end type
-
-   type MPAS_Alarm_type
-      integer :: alarmID
-      logical :: isRecurring
-      logical :: isSet
-      type (MPAS_Time_type) :: ringTime
-      type (MPAS_Time_type) :: prevRingTime
-      type (MPAS_TimeInterval_type) :: ringTimeInterval
-      type (MPAS_Alarm_type), pointer :: next
-   end type
-   
-   type MPAS_Clock_type
-      integer :: direction
-      integer :: nAlarms
-      type (ESMF_Clock) :: c
-      type (MPAS_Alarm_type), pointer :: alarmListHead
-   end type
-
-   interface operator (+)
-      module procedure add_t_ti
-      module procedure add_ti_ti
-   end interface
-
-   interface operator (-)
-      module procedure sub_t_t
-      module procedure sub_t_ti
-      module procedure sub_ti_ti
-      module procedure neg_ti
-   end interface
-
-   interface operator (*)
-      module procedure mul_ti_n
-   end interface
-
-   interface operator (/)
-      module procedure div_ti_n
-   end interface
-
-   interface operator (.EQ.)
-      module procedure eq_t_t
-      module procedure eq_ti_ti
-   end interface
-
-   interface operator (.NE.)
-      module procedure ne_t_t
-      module procedure ne_ti_ti
-   end interface
-
-   interface operator (.LT.)
-      module procedure lt_t_t
-      module procedure lt_ti_ti
-   end interface
-
-   interface operator (.GT.)
-      module procedure gt_t_t
-      module procedure gt_ti_ti
-   end interface
-
-   interface operator (.LE.)
-      module procedure le_t_t
-      module procedure le_ti_ti
-   end interface
-
-   interface operator (.GE.)
-      module procedure ge_t_t
-      module procedure ge_ti_ti
-   end interface
-
-   interface abs
-      module procedure abs_ti
-   end interface
-
-
-   contains
-
-
-   subroutine mpas_timekeeping_init(calendar)
-
-      implicit none
-
-      integer, intent(in) :: calendar 
-
-      TheCalendar = calendar
-
-      if (TheCalendar == MPAS_GREGORIAN) then
-         call ESMF_Initialize(defaultCalendar=ESMF_CAL_GREGORIAN)
-      else if (TheCalendar == MPAS_GREGORIAN_NOLEAP) then
-         call ESMF_Initialize(defaultCalendar=ESMF_CAL_NOLEAP)
-      else if (TheCalendar == MPAS_360DAY) then
-         call ESMF_Initialize(defaultCalendar=ESMF_CAL_360DAY)
-      else
-         write(0,*) 'ERROR: mpas_timekeeping_init: Invalid calendar type'
-      end if
-
-   end subroutine mpas_timekeeping_init
-
-
-   subroutine mpas_timekeeping_finalize()
-
-      implicit none
-
-      call ESMF_Finalize()
-
-   end subroutine mpas_timekeeping_finalize
-
-
-   subroutine MPAS_createClock(clock, startTime, timeStep, stopTime, runDuration, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(out) :: clock
-      type (MPAS_Time_type), intent(in) :: startTime
-      type (MPAS_TimeInterval_type), intent(in) :: timeStep
-      type (MPAS_Time_type), intent(in), optional :: stopTime
-      type (MPAS_TimeInterval_type), intent(in), optional :: runDuration
-      integer, intent(out), optional :: ierr
-
-      type (MPAS_Time_type) :: stop_time
-
-      if (present(runDuration)) then
-         stop_time = startTime + runDuration
-         if (present(stopTime)) then
-            if (stopTime /= stop_time) then
-               if (present(ierr)) ierr = 1   ! stopTime and runDuration are inconsistent
-               write(0,*) 'ERROR: MPAS_createClock: stopTime and runDuration are inconsistent'
-               return
-            end if
-         end if
-      else if (present(stopTime)) then 
-         stop_time = stopTime
-      else
-         if (present(ierr)) ierr = 1   ! neither stopTime nor runDuration are specified
-         write(0,*) 'ERROR: MPAS_createClock: neither stopTime nor runDuration are specified'
-         return
-      end if
-
-      clock % c = ESMF_ClockCreate(TimeStep=timeStep%ti, StartTime=startTime%t, StopTime=stop_time%t, rc=ierr)
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-      clock % direction = MPAS_FORWARD
-      clock % nAlarms = 0
-      nullify(clock % alarmListHead)
-
-   end subroutine MPAS_createClock
-
-
-   subroutine MPAS_destroyClock(clock, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(inout) :: clock
-      integer, intent(out), optional :: ierr
-
-      type (MPAS_Alarm_type), pointer :: alarmPtr
-
-      alarmPtr =&gt; clock % alarmListHead
-      do while (associated(alarmPtr))
-         clock % alarmListHead =&gt; alarmPtr % next
-         deallocate(alarmPtr)
-         alarmPtr =&gt; clock % alarmListHead
-      end do
-
-      call ESMF_ClockDestroy(clock % c, rc=ierr)
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-   end subroutine MPAS_destroyClock
-
-
-   logical function MPAS_isClockStartTime(clock, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(in) :: clock
-      integer, intent(out), optional :: ierr
-
-      type (ESMF_Time) :: currTime, startTime, stopTime
-
-      call ESMF_ClockGet(clock % c, CurrTime=currTime, rc=ierr)
-      call ESMF_ClockGet(clock % c, StartTime=startTime, rc=ierr)
-      call ESMF_ClockGet(clock % c, StopTime=stopTime, rc=ierr)
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-      if (startTime &lt;= stopTime) then
-         MPAS_isClockStartTime = (currTime &lt;= startTime)
-      else
-         MPAS_isClockStartTime = (currTime &gt;= startTime)
-      end if
-
-   end function MPAS_isClockStartTime
-
-
-   logical function MPAS_isClockStopTime(clock, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(in) :: clock
-      integer, intent(out), optional :: ierr
-
-      type (ESMF_Time) :: currTime, startTime, stopTime
-
-      call ESMF_ClockGet(clock % c, CurrTime=currTime, rc=ierr)
-      call ESMF_ClockGet(clock % c, StartTime=startTime, rc=ierr)
-      call ESMF_ClockGet(clock % c, StopTime=stopTime, rc=ierr)
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-      if (startTime &lt;= stopTime) then
-         MPAS_isClockStopTime = (currTime &gt;= stopTime)
-      else
-         MPAS_isClockStopTime = (currTime &lt;= stopTime)
-      end if
-
-   end function MPAS_isClockStopTime
-
-
-   subroutine MPAS_setClockDirection(clock, direction, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(inout) :: clock
-      integer, intent(in) :: direction
-      integer, intent(out), optional :: ierr
-
-      type (MPAS_TimeInterval_type) :: timeStep
-
-      if (direction == MPAS_FORWARD .and. clock % direction == MPAS_FORWARD) return
-      if (direction == MPAS_BACKWARD .and. clock % direction == MPAS_BACKWARD) return
-
-      clock % direction = direction
-      call ESMF_ClockGet(clock % c, TimeStep=timeStep%ti, rc=ierr)
-      timeStep = neg_ti(timeStep)
-      call ESMF_ClockSet(clock % c, TimeStep=timeStep%ti, rc=ierr)
-
-      ! specify a valid previousRingTime for each alarm
-      call MPAS_CalibrateAlarms(clock, ierr);
-
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-   end subroutine MPAS_setClockDirection
-
-
-
-   integer function MPAS_getClockDirection(clock, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(in) :: clock
-      integer, intent(out), optional :: ierr
-
-      if (present(ierr)) ierr = 0
-
-      MPAS_getClockDirection = clock % direction
-
-   end function MPAS_getClockDirection
-
-
-   subroutine MPAS_setClockTimeStep(clock, timeStep, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(inout) :: clock
-      type (MPAS_TimeInterval_type), intent(in) :: timeStep
-      integer, intent(out), optional :: ierr
-
-      call ESMF_ClockSet(clock % c, TimeStep=timeStep%ti, rc=ierr)
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-   end subroutine MPAS_setClockTimeStep
-
-
-   type (MPAS_TimeInterval_type) function MPAS_getClockTimeStep(clock, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(in) :: clock
-      integer, intent(out), optional :: ierr
-
-      type (MPAS_TimeInterval_type) :: timeStep
-
-      call ESMF_ClockGet(clock % c, TimeStep=timeStep%ti, rc=ierr)
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-      MPAS_getClockTimeStep = timeStep
-
-   end function MPAS_getClockTimeStep
-
-
-   subroutine MPAS_advanceClock(clock, timeStep, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(inout) :: clock
-      type (MPAS_TimeInterval_type), intent(in), optional :: timeStep
-      integer, intent(out), optional :: ierr
-
-      type (ESMF_TimeInterval) :: time_step
-
-      if (present(timeStep)) then
-         call ESMF_ClockGet(clock % c, TimeStep=time_step, rc=ierr)
-         call ESMF_ClockSet(clock % c, TimeStep=timeStep % ti, rc=ierr)
-         call ESMF_ClockAdvance(clock % c, rc=ierr)
-         call ESMF_ClockSet(clock % c, TimeStep=time_step, rc=ierr)
-      else
-         call ESMF_ClockAdvance(clock % c, rc=ierr)
-      end if
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-   end subroutine MPAS_advanceClock
-
-
-   subroutine MPAS_setClockTime(clock, clock_time, whichTime, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(inout) :: clock
-      type (MPAS_Time_type), intent(in) :: clock_time
-      integer, intent(in) :: whichTime
-      integer, intent(out), optional :: ierr
-
-      if (whichTime == MPAS_NOW) then
-         call ESMF_ClockSet(clock % c, CurrTime=clock_time%t, rc=ierr)
-         call MPAS_CalibrateAlarms(clock, ierr);
-      else if (whichTime == MPAS_START_TIME) then
-         call ESMF_ClockSet(clock % c, StartTime=clock_time%t, rc=ierr)
-      else if (whichTime == MPAS_STOP_TIME) then
-         call ESMF_ClockSet(clock % c, StopTime=clock_time%t, rc=ierr)
-      else if (present(ierr)) then
-         ierr = 1
-      end if
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-   end subroutine MPAS_setClockTime
-
-
-   type (MPAS_Time_type) function MPAS_getClockTime(clock, whichTime, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(in) :: clock
-      integer, intent(in) :: whichTime
-      integer, intent(out), optional :: ierr
-
-      type (MPAS_Time_type) :: clock_time
-
-      if (whichTime == MPAS_NOW) then
-         call ESMF_ClockGet(clock % c, CurrTime=clock_time%t, rc=ierr)
-      else if (whichTime == MPAS_START_TIME) then
-         call ESMF_ClockGet(clock % c, StartTime=clock_time%t, rc=ierr)
-      else if (whichTime == MPAS_STOP_TIME) then
-         call ESMF_ClockGet(clock % c, StopTime=clock_time%t, rc=ierr)
-      else if (present(ierr)) then
-         ierr = 1
-      end if
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-      MPAS_getClockTime = clock_time
-
-   end function MPAS_getClockTime
-
-
-   subroutine MPAS_addClockAlarm(clock, alarmID, alarmTime, alarmTimeInterval, ierr)
-! TODO: possibly add a stop time for recurring alarms
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(inout) :: clock
-      integer, intent(in) :: alarmID
-      type (MPAS_Time_type), intent(in) :: alarmTime
-      type (MPAS_TimeInterval_type), intent(in), optional :: alarmTimeInterval
-      integer, intent(out), optional :: ierr
-
-      type (MPAS_Alarm_type), pointer :: alarmPtr
-
-      ! Add a new entry to the linked list of alarms for this clock
-      if (.not. associated(clock % alarmListHead)) then
-         allocate(clock % alarmListHead)
-         nullify(clock % alarmListHead % next)
-         alarmPtr =&gt; clock % alarmListHead
-      else
-         alarmPtr =&gt; clock % alarmListHead
-         do while (associated(alarmPtr % next))
-            if (alarmPtr % alarmID == alarmID) then
-               write(0,*) 'OOPS -- we have a duplicate alarmID', alarmID
-               if (present(ierr)) ierr = 1
-               return
-            end if
-            alarmPtr =&gt; alarmPtr % next
-         end do
-            if (alarmPtr % alarmID == alarmID) then
-               write(0,*) 'OOPS -- we have a duplicate alarmID', alarmID
-               if (present(ierr)) ierr = 1
-               return
-            end if
-         allocate(alarmPtr % next)
-         alarmPtr =&gt; alarmPtr % next
-         nullify(alarmPtr % next)
-      end if
-
-      alarmPtr % alarmID = alarmID
-
-      clock % nAlarms = clock % nAlarms + 1
-
-      alarmPtr % isSet = .true.
-      alarmPtr % ringTime = alarmTime
-      
-
-      if (present(alarmTimeInterval)) then
-         alarmPtr % isRecurring = .true.
-         alarmPtr % ringTimeInterval = alarmTimeInterval
-         if(clock % direction == MPAS_FORWARD) then
-            alarmPtr % prevRingTime = alarmTime - alarmTimeInterval
-         else
-            alarmPtr % prevRingTime = alarmTime + alarmTimeInterval         
-         end if
-      else
-         alarmPtr % isRecurring = .false.
-         alarmPtr % prevRingTime = alarmTime
-      end if
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-   end subroutine MPAS_addClockAlarm
-
-
-   subroutine MPAS_removeClockAlarm(clock, alarmID, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(inout) :: clock
-      integer, intent(in) :: alarmID
-      integer, intent(out), optional :: ierr
-
-      type (MPAS_Alarm_type), pointer :: alarmPtr
-      type (MPAS_Alarm_type), pointer :: alarmParentPtr
-
-      if (present(ierr)) ierr = 0
-
-      alarmPtr =&gt; clock % alarmListHead
-      alarmParentPtr = alarmPtr
-      do while (associated(alarmPtr))
-         if (alarmPtr % alarmID == alarmID) then
-            alarmParentPtr % next =&gt; alarmPtr % next
-            deallocate(alarmPtr)
-            exit
-         end if
-         alarmParentPtr = alarmPtr
-         alarmPtr =&gt; alarmPtr % next
-      end do
-
-   end subroutine MPAS_removeClockAlarm
-
-
-
-   subroutine MPAS_printAlarm(clock, alarmID, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(in) :: clock
-      integer, intent(in) :: alarmID
-      integer, intent(out) :: ierr
-
-      type (MPAS_Alarm_type), pointer :: alarmPtr
-
-      type (MPAS_TimeInterval_type) :: alarmTimeInterval
-      type (MPAS_Time_type) :: alarmTime
-      character (len=32) :: printString
-
-      ierr = 0
-
-      alarmPtr =&gt; clock % alarmListHead
-      do while (associated(alarmPtr))
-         if (alarmPtr % alarmID == alarmID) then
-            write(0,*) 'ALARM ', alarmID
-
-            write(0,*) 'isRecurring', alarmPtr % isRecurring
-            
-            write(0,*) 'isSet', alarmPtr % isSet
-
-            call MPAS_getTime(alarmPtr % ringTime, dateTimeString=printString, ierr=ierr)
-            write(0,*) 'ringTime', printString
-
-            call MPAS_getTime(alarmPtr % prevRingTime, dateTimeString=printString, ierr=ierr)
-            write(0,*) 'prevRingTime', printString
-
-            call MPAS_getTimeInterval(alarmPtr % ringTimeInterval, timeString=printString, ierr=ierr)
-            write(0,*) 'ringTimeInterval', printString
-            
-            exit
-         end if
-         alarmPtr =&gt; alarmPtr % next
-      end do
-
-   end subroutine MPAS_printAlarm
-
-
-
-   logical function MPAS_isAlarmRinging(clock, alarmID, interval, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(in) :: clock
-      integer, intent(in) :: alarmID
-      type (MPAS_TimeInterval_type), intent(in), optional :: interval
-      integer, intent(out), optional :: ierr
-
-      type (MPAS_Alarm_type), pointer :: alarmPtr
-
-      if (present(ierr)) ierr = 0
-
-      MPAS_isAlarmRinging = .false.
-      
-      alarmPtr =&gt; clock % alarmListHead
-      do while (associated(alarmPtr))
-         if (alarmPtr % alarmID == alarmID) then
-            if (alarmPtr % isSet) then
-               if (MPAS_inRingingEnvelope(clock, alarmPtr, interval, ierr)) then
-                  MPAS_isAlarmRinging = .true.
-               end if
-            end if
-            exit
-         end if
-         alarmPtr =&gt; alarmPtr % next
-      end do
-
-   end function MPAS_isAlarmRinging
-
-
-
-   subroutine MPAS_getClockRingingAlarms(clock, nAlarms, alarmList, interval, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(in) :: clock
-      integer, intent(out) :: nAlarms
-      integer, dimension(MPAS_MAX_ALARMS), intent(out) :: alarmList
-      type (MPAS_TimeInterval_type), intent(in), optional :: interval
-      integer, intent(out), optional :: ierr
-
-      type (MPAS_Alarm_type), pointer :: alarmPtr
-
-      if (present(ierr)) ierr = 0
-
-      nAlarms = 0
-
-      alarmPtr =&gt; clock % alarmListHead
-      do while (associated(alarmPtr))
-         if (alarmPtr % isSet) then
-            if (MPAS_inRingingEnvelope(clock, alarmPtr, interval, ierr)) then
-               nAlarms = nAlarms + 1
-               alarmList(nAlarms) = alarmPtr % alarmID
-            end if
-         end if
-         alarmPtr =&gt; alarmPtr % next
-      end do
-
-   end subroutine MPAS_getClockRingingAlarms
-
-
-   logical function MPAS_inRingingEnvelope(clock, alarmPtr, interval, ierr)
-
-      implicit none
-      
-      type (MPAS_Clock_type), intent(in) :: clock
-      type (MPAS_Alarm_type), pointer, intent(in) :: alarmPtr
-      type (MPAS_TimeInterval_type), intent(in), optional :: interval
-      integer, intent(out), optional :: ierr
-      
-      type (MPAS_Time_type) :: alarmNow
-      type (MPAS_Time_type) :: alarmThreshold
-
-      alarmNow = MPAS_getClockTime(clock, MPAS_NOW, ierr)
-      alarmThreshold = alarmPtr % ringTime 
-      
-      MPAS_inRingingEnvelope = .false.      
-               
-      if(clock % direction == MPAS_FORWARD) then
-
-         if (present(interval)) then
-            alarmNow = alarmNow + interval; 
-         end if
-
-         if (alarmPtr % isRecurring) then
-            alarmThreshold = alarmPtr % prevRingTime + alarmPtr % ringTimeInterval
-         end if
-
-         if (alarmThreshold &lt;= alarmNow) then
-            MPAS_inRingingEnvelope = .true.
-         end if
-      else
-
-         if (present(interval)) then
-            alarmNow = alarmNow - interval; 
-         end if
-
-         if (alarmPtr % isRecurring) then
-            alarmThreshold = alarmPtr % prevRingTime - alarmPtr % ringTimeInterval
-         end if
-            
-         if (alarmThreshold &gt;= alarmNow) then
-            MPAS_inRingingEnvelope = .true.
-         end if
-      end if
-
-   end function MPAS_inRingingEnvelope
-
-
-
-   subroutine MPAS_resetClockAlarm(clock, alarmID, interval, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(inout) :: clock
-      integer, intent(in) :: alarmID
-      type (MPAS_TimeInterval_type), intent(in), optional :: interval
-      integer, intent(out), optional :: ierr
-
-      type (MPAS_Time_type) :: alarmNow
-      type (MPAS_Alarm_type), pointer :: alarmPtr
-
-      if (present(ierr)) ierr = 0
-
-      alarmPtr =&gt; clock % alarmListHead
-      do while (associated(alarmPtr))
-      
-         if (alarmPtr % alarmID == alarmID) then
-
-            if (MPAS_inRingingEnvelope(clock, alarmPtr, interval, ierr)) then
-
-               if (.not. alarmPtr % isRecurring) then
-                  alarmPtr % isSet = .false. 
-               else
-                  alarmNow = MPAS_getClockTime(clock, MPAS_NOW, ierr)
-
-                  if(clock % direction == MPAS_FORWARD) then
-                     if (present(interval)) then
-                        alarmNow = alarmNow + interval
-                     end if
-
-                     do while(alarmPtr % prevRingTime &lt;= alarmNow)
-                        alarmPtr % prevRingTime = alarmPtr % prevRingTime + alarmPtr % ringTimeInterval
-                     end do
-                     alarmPtr % prevRingTime =  alarmPtr % prevRingTime - alarmPtr % ringTimeInterval
-                  else
-                     if (present(interval)) then
-                        alarmNow = alarmNow - interval
-                     end if
-
-                     do while(alarmPtr % prevRingTime &gt;= alarmNow)
-                        alarmPtr % prevRingTime = alarmPtr % prevRingTime - alarmPtr % ringTimeInterval
-                     end do
-                     alarmPtr % prevRingTime = alarmPtr % prevRingTime + alarmPtr % ringTimeInterval
-                  end if
-               end if
-            end if
-            exit
-         end if
-         alarmPtr =&gt; alarmPtr % next
-      end do
-
-   end subroutine MPAS_resetClockAlarm
-
-
-
-   ! specify a valid previousRingTime for each alarm
-   subroutine MPAS_CalibrateAlarms(clock, ierr)
-
-      implicit none
-
-      type (MPAS_Clock_type), intent(in) :: clock
-      integer, intent(out), optional :: ierr
-
-      type (MPAS_Time_type) :: now
-      type (MPAS_Time_type) :: previousRingTime
-      type (MPAS_Time_type) :: negativeNeighborRingTime
-      type (MPAS_Time_type) :: positiveNeighborRingTime
-      type (MPAS_TimeInterval_type) :: ringTimeInterval 
-      type (MPAS_Alarm_type), pointer :: alarmPtr
-
-      now = MPAS_getClockTime(clock, MPAS_NOW, ierr)
-      
-      alarmPtr =&gt; clock % alarmListHead
-      do while (associated(alarmPtr))
-         
-         if (.not. alarmPtr % isRecurring) then
-            alarmPtr % isSet = .true.            
-         else
-         
-            previousRingTime = alarmPtr % prevRingTime
-
-            if (previousRingTime &lt;= now) then
-            
-               do while(previousRingTime &lt;= now)
-                  previousRingTime = previousRingTime + alarmPtr % ringTimeInterval
-               end do
-               positiveNeighborRingTime = previousRingTime
-            
-               do while(previousRingTime &gt;= now)
-                  previousRingTime = previousRingTime - alarmPtr % ringTimeInterval
-               end do
-               negativeNeighborRingTime = previousRingTime
-            
-            else
-
-               do while(previousRingTime &gt;= now)
-                  previousRingTime = previousRingTime - alarmPtr % ringTimeInterval
-               end do
-               negativeNeighborRingTime = previousRingTime
-
-               do while(previousRingTime &lt;= now)
-                  previousRingTime = previousRingTime + alarmPtr % ringTimeInterval
-               end do
-               positiveNeighborRingTime = previousRingTime
-         
-            end if
-
-            if (clock % direction == MPAS_FORWARD) then
-               alarmPtr % prevRingTime = negativeNeighborRingTime
-            else
-               alarmPtr % prevRingTime = positiveNeighborRingTime
-            end if
-
-         end if
-   
-         alarmPtr =&gt; alarmPtr % next
-         
-      end do
-   
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-   
-   end subroutine MPAS_CalibrateAlarms
-
-
-   subroutine MPAS_setTime(curr_time, YYYY, MM, DD, DoY, H, M, S, S_n, S_d, dateTimeString, ierr)
-
-      implicit none
-
-      type (MPAS_Time_type), intent(out) :: curr_time
-      integer, intent(in), optional :: YYYY
-      integer, intent(in), optional :: MM
-      integer, intent(in), optional :: DD
-      integer, intent(in), optional :: DoY
-      integer, intent(in), optional :: H
-      integer, intent(in), optional :: M
-      integer, intent(in), optional :: S
-      integer, intent(in), optional :: S_n
-      integer, intent(in), optional :: S_d
-      character (len=*), intent(in), optional :: dateTimeString
-      integer, intent(out), optional :: ierr
-
-      integer, parameter :: integerMaxDigits = 8
-      integer :: year, month, day, hour, min, sec
-      integer :: numerator, denominator, denominatorPower
-
-      character (len=50) :: dateTimeString_
-      character (len=50) :: dateSubString
-      character (len=50) :: timeSubString
-      character (len=50) :: secDecSubString
-      character(len=50), pointer, dimension(:) :: subStrings
-
-      if (present(dateTimeString)) then
-
-         dateTimeString_ = dateTimeString
-         numerator = 0
-         denominator = 1
-
-         call SplitString(dateTimeString_, &quot;.&quot;, subStrings)
-         if (size(subStrings) == 2) then ! contains second decimals
-            dateTimeString_ = subStrings(1)
-            secDecSubString = subStrings(2)(:integerMaxDigits)
-            deallocate(subStrings)
-            denominatorPower = len_trim(secDecSubString)
-            if(denominatorPower &gt; 0) then
-               read(secDecSubString,*) numerator 
-               if(numerator &gt; 0) then
-                  denominator = 10**denominatorPower
-               end if
-            end if
-         else if (size(subStrings) /= 1) then
-            deallocate(subStrings)
-            if (present(ierr)) ierr = 1
-            write(0,*) 'ERROR: Invalid DateTime string', dateTimeString
-            return
-         end if
-
-         call SplitString(dateTimeString_, &quot;_&quot;, subStrings)
-
-         if(size(subStrings) == 2) then   ! contains a date and time
-            dateSubString = subStrings(1)
-            timeSubString = subStrings(2)
-            deallocate(subStrings)
-            
-            call SplitString(timeSubString, &quot;:&quot;, subStrings)
-            
-            if (size(subStrings) == 3) then
-               read(subStrings(1),*) hour 
-               read(subStrings(2),*) min 
-               read(subStrings(3),*) sec 
-               deallocate(subStrings)
-            else
-               deallocate(subStrings)
-               if (present(ierr)) ierr = 1
-               write(0,*) 'ERROR: Invalid DateTime string (invalid time substring)', dateTimeString
-               return
-            end if
-
-         else if(size(subStrings) == 1) then   ! contains only a date- assume all time values are 0 
-            dateSubString = subStrings(1)
-            deallocate(subStrings)
-           
-            hour = 0
-            min = 0
-            sec = 0
-         
-         else
-            deallocate(subStrings)
-            if (present(ierr)) ierr = 1
-            write(0,*) 'ERROR: Invalid DateTime string', dateTimeString
-            return
-         end if
-
-         call SplitString(dateSubString, &quot;-&quot;, subStrings)
-            
-         if (size(subStrings) == 3) then
-            read(subStrings(1),*) year 
-            read(subStrings(2),*) month
-            read(subStrings(3),*) day
-            deallocate(subStrings)
-         else
-            deallocate(subStrings)
-            if (present(ierr)) ierr = 1
-            write(0,*) 'ERROR: Invalid DateTime string (invalid date substring)', dateTimeString
-            return
-         end if
-
-         call ESMF_TimeSet(curr_time % t, YY=year, MM=month, DD=day, H=hour, M=min, S=sec, Sn=numerator, Sd=denominator, rc=ierr)
-
-      else
-      
-         if (present(DoY)) then
-            call getMonthDay(YYYY, DoY, month, day)
-         
-            ! consistency check
-            if (present(MM)) then
-               if (MM /= month) then
-                  if (present(ierr)) ierr = 1
-                  write(0,*) 'ERROR: MPAS_setTime : DoY and MM are inconsistent - using DoY'
-               end if
-            end if
-            if (present(DD)) then
-               if (DD /= day) then
-                  if (present(ierr)) ierr = 1
-                  write(0,*) 'ERROR: MPAS_setTime : DoY and DD are inconsistent - using DoY'
-               end if
-            end if
-         else
-            if (present(MM)) then
-               month = MM
-            else
-               if (present(ierr)) ierr = 1
-               write(0,*) 'ERROR: MPAS_setTime : Neither DoY nor MM are specified'
-               return
-            end if
-
-            if (present(DD)) then
-               day = DD
-            else
-               if (present(ierr)) ierr = 1
-               write(0,*) 'ERROR: MPAS_setTime : Neither DoY nor DD are specified'
-               return
-            end if
-         end if
-
-         if (.not. isValidDate(YYYY,month,day)) then
-            write(0,*) 'ERROR: MPAS_setTime : Invalid date'
-            return
-         end if
-
-         call ESMF_TimeSet(curr_time % t, YY=YYYY, MM=month, DD=day, H=H, M=M, S=S, Sn=S_n, Sd=S_d, rc=ierr)
-      
-      end if
-      
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-   end subroutine MPAS_setTime
-
-
-   subroutine MPAS_getTime(curr_time, YYYY, MM, DD, DoY, H, M, S, S_n, S_d, dateTimeString, ierr)
-
-      implicit none
-
-      type (MPAS_Time_type), intent(in) :: curr_time
-      integer, intent(out), optional :: YYYY
-      integer, intent(out), optional :: MM
-      integer, intent(out), optional :: DD
-      integer, intent(out), optional :: DoY
-      integer, intent(out), optional :: H
-      integer, intent(out), optional :: M
-      integer, intent(out), optional :: S
-      integer, intent(out), optional :: S_n
-      integer, intent(out), optional :: S_d
-      character (len=32), intent(out), optional :: dateTimeString
-      integer, intent(out), optional :: ierr
-
-      call ESMF_TimeGet(curr_time % t, YY=YYYY, MM=MM, DD=DD, H=H, M=M, S=S, Sn=S_n, Sd=S_d, rc=ierr)
-      call ESMF_TimeGet(curr_time % t, dayOfYear=DoY, rc=ierr)
-      call ESMF_TimeGet(curr_time % t, timeString=dateTimeString, rc=ierr)
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-   end subroutine MPAS_getTime
-
-
-   subroutine MPAS_setTimeInterval(interval, DD, H, M, S, S_n, S_d, timeString, dt, ierr)
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(out) :: interval
-      integer, intent(in), optional :: DD
-      integer, intent(in), optional :: H
-      integer, intent(in), optional :: M
-      integer, intent(in), optional :: S
-      integer, intent(in), optional :: S_n
-      integer, intent(in), optional :: S_d
-      character (len=*), intent(in), optional :: timeString
-      real (kind=RKIND), intent(in), optional :: dt
-      integer, intent(out), optional :: ierr
-
-      integer, parameter :: integerMaxDigits = 8
-      integer :: days, hours, minutes, seconds
-      integer :: numerator, denominator, denominatorPower
-      type (MPAS_TimeInterval_type) :: zeroInterval
-
-      integer :: day, hour, min, sec
-      character (len=50) :: timeString_
-      character (len=50) :: daySubString
-      character (len=50) :: timeSubString
-      character (len=50) :: secDecSubString
-      character(len=50), pointer, dimension(:) :: subStrings
-
-!      if (present(DD)) then
-!         days = DD
-!      else
-!         days = 0
-!      end if
-
-!      if (present(H)) then
-!         hours = H
-!      else
-!         hours = 0
-!      end if
-
-!      if (present(M)) then
-!         minutes = M
-!      else
-!         minutes = 0
-!      end if
-
-!      if (present(S)) then
-!         seconds = S
-!      else
-!         seconds = 0
-!      end if
-
-
-      !
-      ! Reduce minute count to something less than one hour
-      !
-!      do while (minutes &gt; 1440)
-!         days = days + 1
-!         minutes = minutes - 1440
-!      end do
-!      do while (minutes &gt; 60)
-!         hours = hours + 1
-!         minutes = minutes - 60
-!      end do
-!      do while (minutes &lt; -1440)
-!         days = days - 1
-!         minutes = minutes + 1440
-!      end do
-!      do while (minutes &lt; -60)
-!         hours = hours - 1
-!         minutes = minutes + 60
-!      end do
-
-      !
-      ! Reduce hour count to something less than one day
-      !
-!      do while (hours &gt; 24)
-!         days = days + 1
-!         hours = hours - 24
-!      end do
-!      do while (hours &lt; -24)
-!         days = days - 1
-!         hours = hours + 24
-!      end do
-
-      !
-      ! Any leftover minutes and hours are given to the second count
-      !
-!      seconds = seconds + hours*3600 + minutes*60
-
-!      call ESMF_TimeIntervalSet(interval % ti, D=days, S=seconds, Sn=S_n, Sd=S_d, rc=ierr)
-
-
-      if (present(timeString) .or. present(dt)) then
-
-
-         if(present(dt)) then
-            write (timeString_,*) &quot;00:00:&quot;, dt         
-         else
-            timeString_ = timeString
-         end if
-
-         numerator = 0
-         denominator = 1
-
-         call SplitString(timeString_, &quot;.&quot;, subStrings)
-         
-         if (size(subStrings) == 2) then ! contains second decimals
-            timeString_ = subStrings(1)
-            secDecSubString = subStrings(2)(:integerMaxDigits)
-            deallocate(subStrings)
-
-            denominatorPower = len_trim(secDecSubString)
-            if(denominatorPower &gt; 0) then
-               read(secDecSubString,*) numerator 
-               if(numerator &gt; 0) then
-                  denominator = 10**denominatorPower
-               end if
-            end if
-         else if (size(subStrings) /= 1) then
-            deallocate(subStrings)
-            if (present(ierr)) ierr = 1
-            write(0,*) 'ERROR: Invalid TimeInterval string', timeString
-            return
-         end if
-
-         call SplitString(timeString_, &quot;_&quot;, subStrings)
-
-         if(size(subStrings) == 2) then   ! contains a day and time
-            daySubString = subStrings(1)
-            timeSubString = subStrings(2)
-            deallocate(subStrings)
-            read(daySubString,*) day 
-         else if(size(subStrings) == 1) then   ! contains only a time- assume day is 0 
-            timeSubString = subStrings(1)
-            deallocate(subStrings)
-            day = 0
-         else
-            deallocate(subStrings)
-            if (present(ierr)) ierr = 1
-            write(0,*) 'ERROR: Invalid TimeInterval string', timeString
-            return
-         end if
-
-         call SplitString(timeSubString, &quot;:&quot;, subStrings)
-            
-         if (size(subStrings) == 3) then
-            read(subStrings(1),*) hour 
-            read(subStrings(2),*) min 
-            read(subStrings(3),*) sec 
-            deallocate(subStrings)
-         else
-            deallocate(subStrings)
-            if (present(ierr)) ierr = 1
-            write(0,*) 'ERROR: Invalid TimeInterval string (invalid time substring)', timeString
-            return
-         end if
-
-         call ESMF_TimeIntervalSet(interval % ti, D=day, H=hour, M=min, S=sec, Sn=numerator, Sd=denominator, rc=ierr)
-
-      else
-
-         call ESMF_TimeIntervalSet(interval % ti, D=DD, H=H, M=M, S=S, Sn=S_n, Sd=S_d, rc=ierr)
-      
-      end if
-
-      ! verify that time interval is positive
-      call ESMF_TimeIntervalSet(zeroInterval % ti, D=0, H=0, M=0, S=0, rc=ierr)
-
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-      if (interval &lt;= zeroInterval) then
-         if (present(ierr)) ierr = 1   
-         write(0,*) 'ERROR: TimeInterval must be greater than 0', timeString !'ERROR: TimeInterval cannot be negative'
-      end if
-      
-
-      
-   end subroutine MPAS_setTimeInterval
-
-
-   subroutine MPAS_getTimeInterval(interval, DD, H, M, S, S_n, S_d, timeString, dt, ierr)
-! TODO: add double-precision seconds
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(in) :: interval
-      integer, intent(out), optional :: DD
-      integer, intent(out), optional :: H
-      integer, intent(out), optional :: M
-      integer, intent(out), optional :: S
-      integer, intent(out), optional :: S_n
-      integer, intent(out), optional :: S_d
-      character (len=32), intent(out), optional :: timeString
-      real (kind=RKIND), intent(out), optional :: dt
-      integer, intent(out), optional :: ierr
-
-      integer :: days, seconds, sn, sd
-
-      call ESMF_TimeIntervalGet(interval % ti, D=days, S=seconds, Sn=sn, Sd=sd, rc=ierr)
-
-      if (present(dt)) then
-         dt = (days * 24 * 60 * 60) + seconds + (sn / sd)
-      end if
-
-      if (present(DD)) then
-         DD = days
-         days = 0
-      end if
-
-      if (present(H)) then
-         H = (seconds - mod(seconds,3600)) / 3600
-         seconds = seconds - H*3600
-         H = H + days * 24
-         days = 0
-      end if
-
-      if (present(M)) then
-         M = (seconds - mod(seconds,60)) / 60
-         seconds = seconds - M*60
-         M = M + days * 1440
-         days = 0
-      end if
-
-      if (present(S)) then
-         S = seconds
-      end if
-
-      if (present(S_n)) then
-         S_n = sn
-      end if
-
-      if (present(S_d)) then
-         S_d = sd
-      end if
-
-      if (present(timeString)) then
-         call ESMF_TimeIntervalGet(interval % ti, timeString=timeString, rc=ierr)
-      end if
-
-      if (present(ierr)) then
-         if (ierr == ESMF_SUCCESS) ierr = 0
-      end if
-
-   end subroutine MPAS_getTimeInterval
-
-
-   type (MPAS_Time_type) function add_t_ti(t, ti)
-
-      implicit none
-
-      type (MPAS_Time_type), intent(in) :: t
-      type (MPAS_TimeInterval_type), intent(in) :: ti
-
-      add_t_ti % t = t % t + ti % ti
-
-   end function add_t_ti
-
-
-   type (MPAS_TimeInterval_type) function add_ti_ti(ti1, ti2)
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
-
-      add_ti_ti % ti = ti1 % ti + ti2 % ti
-
-   end function add_ti_ti
-
-
-   type (MPAS_TimeInterval_type) function sub_t_t(t1, t2)
-
-      implicit none
-
-      type (MPAS_Time_type), intent(in) :: t1, t2
-
-      sub_t_t % ti = t1 % t - t2 % t
-
-   end function sub_t_t
-
-
-   type (MPAS_Time_type) function sub_t_ti(t, ti)
-
-      implicit none
-
-      type (MPAS_Time_type), intent(in) :: t
-      type (MPAS_TimeInterval_type), intent(in) :: ti
-
-      sub_t_ti % t = t % t - ti % ti
-
-   end function sub_t_ti
-
-
-   type (MPAS_TimeInterval_type) function sub_ti_ti(ti1, ti2)
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
-
-      sub_ti_ti % ti = ti1 % ti - ti2 % ti
-
-   end function sub_ti_ti
-
-
-   type (MPAS_TimeInterval_type) function mul_ti_n(ti, n)
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(in) :: ti
-      integer, intent(in) :: n
-
-      mul_ti_n % ti = ti % ti * n
-
-   end function mul_ti_n
-
-
-   type (MPAS_TimeInterval_type) function div_ti_n(ti, n)
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(in) :: ti
-      integer, intent(in) :: n
-
-      div_ti_n % ti = ti % ti / n
-
-   end function div_ti_n
-
-
-   logical function eq_t_t(t1, t2)
-
-      implicit none
-
-      type (MPAS_Time_type), intent(in) :: t1, t2
-
-      eq_t_t = (t1 % t == t2 % t)
-
-   end function eq_t_t
-
-
-   logical function ne_t_t(t1, t2)
-
-      implicit none
-
-      type (MPAS_Time_type), intent(in) :: t1, t2
-
-      ne_t_t = (t1 % t /= t2 % t)
-
-   end function ne_t_t
-
-
-   logical function lt_t_t(t1, t2)
-
-      implicit none
-
-      type (MPAS_Time_type), intent(in) :: t1, t2
-
-      lt_t_t = (t1 % t &lt; t2 % t)
-
-   end function lt_t_t
-
-
-   logical function gt_t_t(t1, t2)
-
-      implicit none
-
-      type (MPAS_Time_type), intent(in) :: t1, t2
-
-      gt_t_t = (t1 % t &gt; t2 % t)
-
-   end function gt_t_t
-
-
-   logical function le_t_t(t1, t2)
-
-      implicit none
-
-      type (MPAS_Time_type), intent(in) :: t1, t2
-
-      le_t_t = (t1 % t &lt;= t2 % t)
-
-   end function le_t_t
-
-
-   logical function ge_t_t(t1, t2)
-
-      implicit none
-
-      type (MPAS_Time_type), intent(in) :: t1, t2
-
-      ge_t_t = (t1 % t &gt;= t2 % t)
-
-   end function ge_t_t
-
-
-   logical function eq_ti_ti(ti1, ti2)
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
-
-      eq_ti_ti = (ti1 % ti == ti2 % ti)
-
-   end function eq_ti_ti
-
-
-   logical function ne_ti_ti(ti1, ti2)
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
-
-      ne_ti_ti = (ti1 % ti /= ti2 % ti)
-
-   end function ne_ti_ti
-
-
-   logical function lt_ti_ti(ti1, ti2)
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
-
-      lt_ti_ti = (ti1 % ti &lt; ti2 % ti)
-
-   end function lt_ti_ti
-
-
-   logical function gt_ti_ti(ti1, ti2)
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
-
-      gt_ti_ti = (ti1 % ti &gt; ti2 % ti)
-
-   end function gt_ti_ti
-
-
-   logical function le_ti_ti(ti1, ti2)
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
-
-      le_ti_ti = (ti1 % ti &lt;= ti2 % ti)
-
-   end function le_ti_ti
-
-
-   logical function ge_ti_ti(ti1, ti2)
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
-
-      ge_ti_ti = (ti1 % ti &gt;= ti2 % ti)
-
-   end function ge_ti_ti
-
-
-   type (MPAS_TimeInterval_type) function neg_ti(ti)
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(in) :: ti
-
-      integer :: rc
-      integer :: D, S, Sn, Sd
-
-      call ESMF_TimeIntervalGet(ti % ti, D=D, S=S, Sn=Sn, Sd=Sd, rc=rc)
-      D    = -D 
-      S    = -S 
-      Sn   = -Sn
-      call ESMF_TimeIntervalSet(neg_ti % ti, D=D, S=S, Sn=Sn, Sd=Sd, rc=rc)
-
-   end function neg_ti
-
-
-   type (MPAS_TimeInterval_type) function abs_ti(ti)
-
-      implicit none
-
-      type (MPAS_TimeInterval_type), intent(in) :: ti
-
-      type (MPAS_TimeInterval_type) :: zeroInterval
-      integer :: rc
-      integer :: D, S, Sn, Sd
-
-      call ESMF_TimeIntervalSet(zeroInterval % ti, D=0, H=0, M=0, S=0, rc=rc)
-
-      if(ti &lt; zeroInterval) then
-         call ESMF_TimeIntervalGet(ti % ti, D=D, S=S, Sn=Sn, Sd=Sd, rc=rc)
-         D    = -D 
-         S    = -S 
-         Sn   = -Sn
-         call ESMF_TimeIntervalSet(abs_ti % ti, D=D, S=S, Sn=Sn, Sd=Sd, rc=rc)
-      else
-         abs_ti = ti
-      end if
-
-   end function abs_ti
-
-
-! TODO: Implement this function
-!   type (MPAS_TimeInterval_type) function mod(ti1, ti2)
-!
-!      implicit none
-!
-!      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
-!
-!      mod % ti = mod(ti1 % ti, ti2 % ti)
-!
-!   end function mod
-
-
-   subroutine SplitString(string, delimiter, subStrings)   
-      
-      implicit none
-      
-      character(len=*), intent(in) :: string
-      character, intent(in) :: delimiter
-      character(len=*), pointer, dimension(:) :: subStrings
-      
-      integer :: i, start, index
-
-      index = 1
-      do i = 1, len(string)
-         if(string(i:i) == delimiter) then
-            index = index + 1
-         end if
-      end do
-
-      allocate(subStrings(1:index))
-
-      start = 1
-      index = 1
-      do i = 1, len(string)
-         if(string(i:i) == delimiter) then
-               subStrings(index) = string(start:i-1) 
-               index = index + 1
-               start = i + 1
-         end if
-      end do
-      subStrings(index) = string(start:len(string)) 
-      
-   end subroutine SplitString
-
-
-    subroutine getMonthDay(YYYY, DoY, month, day)
-       
-       implicit none
-
-       integer, intent(in) :: YYYY, DoY
-       integer, intent(out) :: month, day
-
-       integer, dimension(12) :: dpm
-       
-       if (isLeapYear(YYYY)) then
-          dpm(:) = daysInMonthLeap
-       else
-          dpm(:) = daysInMonth
-       end if
-
-       month = 1
-       day = DoY
-       do while (day &gt; dpm(month))
-          day = day -  dpm(month)
-          month = month + 1       
-       end do
-
-    end subroutine getMonthDay
-
-
-   logical function isValidDate(YYYY, MM, DD)
-   
-      integer, intent(in) :: YYYY, MM, DD
-      integer :: daysInMM
-      
-      isValidDate = .true.
-
-      ! TODO: ???? Gregorian calendar has no year zero, but perhaps 0 = 1 BC ??? 
-      !if (YYYY == 0) then
-      !   isValidDate = .false.
-      !   return
-      !end if
-
-      if (MM &lt; 1 .or. MM &gt; 12) then
-         isValidDate = .false.
-         return
-      end if
-
-      if (DD &lt; 1) then
-         isValidDate = .false.
-         return
-      end if
-
-      if(TheCalendar == MPAS_360DAY) then
-         daysInMM = 30
-      else
-         if (TheCalendar == MPAS_GREGORIAN .and. isLeapYear(YYYY)) then
-            daysInMM = daysInMonthLeap(MM)
-         else
-            daysInMM = daysInMonth(MM)        
-         end if
-      end if
-     
-      if (DD &gt; daysInMM) then
-         isValidDate = .false.
-         return
-      end if
-
-   end function
-
-    
-    logical function isLeapYear(year)
-
-       implicit none
-
-       integer, intent(in) :: year
-
-       isLeapYear = .false.
-       
-       if (mod(year,4) == 0) then
-          if (mod(year,100) == 0) then
-             if (mod(year,400) == 0) then
-                isLeapYear = .true.
-             end if
-          else
-             isLeapYear = .true.
-          end if
-       end if
-
-    end function isLeapYear
-
-
-
-
-
-end module mpas_timekeeping
-
-
-
-subroutine wrf_error_fatal(msg)
-
-   implicit none
-
-   character (len=*) :: msg
-
-   write(0,*) 'MPAS_TIMEKEEPING: '//trim(msg)
-
-   stop
-
-end subroutine wrf_error_fatal

Deleted: branches/source_condensing/src/framework/module_sort.F
===================================================================
--- trunk/mpas/src/framework/module_sort.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/module_sort.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,230 +0,0 @@
-module sort
-
-   interface quicksort
-      module procedure quicksort_int
-      module procedure quicksort_real
-   end interface
-
-
-   contains
-
-
-   recursive subroutine mergesort(array, d1, n1, n2)
-   
-      implicit none
-   
-      ! Arguments
-      integer, intent(in) :: n1, n2, d1
-      integer, dimension(1:d1,n1:n2), intent(inout) :: array
-   
-      ! Local variables
-      integer :: i, j, k
-      integer :: rtemp
-      integer, dimension(1:d1,1:n2-n1+1) :: temp
-   
-      if (n1 &gt;= n2) return
-   
-      if (n2 - n1 == 1) then
-        if (array(1,n1) &gt; array(1,n2)) then
-           do i=1,d1
-              rtemp = array(i,n1)
-              array(i,n1) = array(i,n2)
-              array(i,n2) = rtemp
-           end do
-        end if
-        return
-      end if
-   
-      call mergesort(array(1:d1,n1:n1+(n2-n1+1)/2), d1, n1, n1+(n2-n1+1)/2)
-      call mergesort(array(1:d1,n1+((n2-n1+1)/2)+1:n2), d1, n1+((n2-n1+1)/2)+1, n2)
-   
-      i = n1
-      j = n1 + ((n2-n1+1)/2) + 1
-      k = 1
-      do while (i &lt;= n1+(n2-n1+1)/2 .and. j &lt;= n2)
-        if (array(1,i) &lt; array(1,j)) then
-          temp(1:d1,k) = array(1:d1,i)
-          k = k + 1
-          i = i + 1
-        else
-          temp(1:d1,k) = array(1:d1,j)
-          k = k + 1
-          j = j + 1
-        end if
-      end do
-   
-      if (i &lt;= n1+(n2-n1+1)/2) then
-        do while (i &lt;= n1+(n2-n1+1)/2)
-          temp(1:d1,k) = array(1:d1,i)
-          i = i + 1
-          k = k + 1
-        end do
-      else
-        do while (j &lt;= n2)
-          temp(1:d1,k) = array(1:d1,j)
-          j = j + 1
-          k = k + 1
-        end do
-      end if
-   
-      array(1:d1,n1:n2) = temp(1:d1,1:k-1)
-   
-   end subroutine mergesort
-
-
-   subroutine quicksort_int(nArray, array)
-
-      implicit none
-
-      integer, intent(in) :: nArray
-      integer, dimension(2,nArray), intent(inout) :: array
-
-      integer :: i, j, top, l, r, pivot, s
-      integer :: pivot_value
-      integer, dimension(2) :: temp
-      integer, dimension(1000) :: lstack, rstack
-
-      if (nArray &lt; 1) return
-
-      top = 1
-      lstack(top) = 1
-      rstack(top) = nArray
-
-      do while (top &gt; 0)
-
-         l = lstack(top)
-         r = rstack(top)
-         top = top - 1
-
-         pivot = (l+r)/2
-
-         pivot_value = array(1,pivot)
-         temp(:) = array(:,pivot)
-         array(:,pivot) = array(:,r)
-         array(:,r) = temp(:)
-
-         s = l
-         do i=l,r-1
-            if (array(1,i) &lt;= pivot_value) then
-               temp(:) = array(:,s)
-               array(:,s) = array(:,i)
-               array(:,i) = temp(:)
-               s = s + 1
-            end if
-         end do
-
-         temp(:) = array(:,s)
-         array(:,s) = array(:,r)
-         array(:,r) = temp(:)
-
-         if (s-1 &gt; l) then
-            top = top + 1
-if (top &gt; 1000) write(0,*) 'Error: Quicksort exhausted its stack.'
-            lstack(top) = l
-            rstack(top) = s-1
-         end if
-
-         if (r &gt; s+1) then
-            top = top + 1
-if (top &gt; 1000) write(0,*) 'Error: Quicksort exhausted its stack.'
-            lstack(top) = s+1
-            rstack(top) = r
-         end if
-      end do
-
-   end subroutine quicksort_int
-
-
-   subroutine quicksort_real(nArray, array)
-
-      implicit none
-
-      integer, intent(in) :: nArray
-      real (kind=RKIND), dimension(2,nArray), intent(inout) :: array
-
-      integer :: i, j, top, l, r, pivot, s
-      real (kind=RKIND) :: pivot_value
-      real (kind=RKIND), dimension(2) :: temp
-      integer, dimension(1000) :: lstack, rstack
-
-      if (nArray &lt; 1) return
-
-      top = 1
-      lstack(top) = 1
-      rstack(top) = nArray
-
-      do while (top &gt; 0)
-
-         l = lstack(top)
-         r = rstack(top)
-         top = top - 1
-
-         pivot = (l+r)/2
-
-         pivot_value = array(1,pivot)
-         temp(:) = array(:,pivot)
-         array(:,pivot) = array(:,r)
-         array(:,r) = temp(:)
-
-         s = l
-         do i=l,r-1
-            if (array(1,i) &lt;= pivot_value) then
-               temp(:) = array(:,s)
-               array(:,s) = array(:,i)
-               array(:,i) = temp(:)
-               s = s + 1
-            end if
-         end do
-
-         temp(:) = array(:,s)
-         array(:,s) = array(:,r)
-         array(:,r) = temp(:)
-
-         if (s-1 &gt; l) then
-            top = top + 1
-if (top &gt; 1000) write(0,*) 'Error: Quicksort exhausted its stack.'
-            lstack(top) = l
-            rstack(top) = s-1
-         end if
-
-         if (r &gt; s+1) then
-            top = top + 1
-if (top &gt; 1000) write(0,*) 'Error: Quicksort exhausted its stack.'
-            lstack(top) = s+1
-            rstack(top) = r
-         end if
-      end do
-
-   end subroutine quicksort_real
-
-
-   integer function binary_search(array, d1, n1, n2, key)
-
-      implicit none
-
-      integer, intent(in) :: d1, n1, n2, key
-      integer, dimension(d1,n1:n2), intent(in) :: array
-
-      integer :: l, u, k
-
-      binary_search = n2+1
-
-      l = n1
-      u = n2
-      k = (l+u)/2
-      do while (u &gt;= l)
-         if (array(1,k) == key) then
-            binary_search = k
-            exit   
-         else if (array(1,k) &lt; key) then
-            l = k + 1
-            k = (l+u)/2
-         else   
-            u = k - 1
-            k = (l+u)/2
-         end if 
-      end do 
-
-   end function binary_search
-
-end module sort

Deleted: branches/source_condensing/src/framework/module_timer.F
===================================================================
--- trunk/mpas/src/framework/module_timer.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/module_timer.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,293 +0,0 @@
-      module timer
-
-        implicit none
-        save
-!       private
-
-#ifdef _PAPI
-        include 'f90papi.h'
-#endif
-
-#ifdef _MPI
-        include 'mpif.h'
-#endif
-
-        type timer_node
-          character (len=72) :: timer_name
-          logical :: running, printable
-          integer :: levels, calls
-          real (kind=RKIND) :: start_time, end_time, total_time
-          real (kind=RKIND) :: max_time, min_time, avg_time
-          type (timer_node), pointer :: next
-        end type timer_node
-
-        type (timer_node), pointer :: all_timers
-        integer :: levels
-
-        public :: timer_start, &amp;
-                  timer_stop, &amp;
-                  timer_write
-
-        contains
-
-        subroutine timer_start(timer_name, clear_timer, timer_ptr)!{{{
-          character (len=*), intent (in) :: timer_name !&lt; Input: name of timer, stored as name of timer
-          logical, optional, intent(in) :: clear_timer !&lt; Input: flag to clear timer
-          type (timer_node), optional, pointer, intent(out) :: timer_ptr !&lt; Output: pointer to store timer in module
-
-          logical :: timer_added, timer_found, string_equal, check_flag
-          type (timer_node), pointer :: current, temp
-
-          integer :: clock, hz, usecs
-
-          timer_added = .false.
-          timer_found = .false.
-
-          if(.not.associated(all_timers)) then
-            timer_added = .true.
-            allocate(all_timers)
-            allocate(all_timers%next)
-            levels = 0
-
-            all_timers%timer_name = ''
-            current =&gt; all_timers%next
-            nullify(current%next)
-          else
-            current =&gt; all_timers%next
-            timer_search: do while ((.not.timer_found) .and. associated(current))
-              string_equal = (trim(current%timer_name) == trim(timer_name))
-              if(string_equal) then
-                timer_found = .true.
-              else
-                current =&gt; current%next
-              endif
-            end do timer_search
-          endif
-
-          if(present(timer_ptr)) then
-            timer_found = .true.
-            if(.not.associated(timer_ptr)) then
-              current =&gt; all_timers
-              find_end_ptr: do while((.not.timer_added) .and. (associated(current%next)))
-                current =&gt; current%next
-              end do find_end_ptr
-
-              allocate(timer_ptr)
-
-              current%next =&gt; timer_ptr
-              current =&gt; timer_ptr
-              nullify(timer_ptr%next)
-              current%levels = levels
-              current%timer_name = timer_name
-              current%running = .false.
-              current%total_time = 0.0
-              current%max_time = 0.0
-              current%min_time = 100000000.0
-              current%avg_time = 0.0
-              current%calls = 0
-            endif
-          endif
-
-          if(.not.timer_found) then
-            current =&gt; all_timers
-            find_end: do while((.not.timer_added) .and. (associated(current%next)))
-              current =&gt; current%next
-            end do find_end
-
-            allocate(current%next)
-            current =&gt; current%next
-
-            nullify(current%next)
-            timer_added = .true.
-          endif
-
-          if(timer_added .and. (.not.timer_found)) then
-            current%levels = levels
-            current%timer_name = timer_name
-            current%running = .false.
-            current%total_time = 0.0
-            current%max_time = 0.0
-            current%min_time = 100000000.0
-            current%avg_time = 0.0
-            current%calls = 0
-          endif
-
-          if((timer_added .or. timer_found) .and. (.not.current%running)) then
-            current%running = .true.
-            levels = levels + 1
-
-#ifdef _PAPI
-            call PAPIF_get_real_usec(usecs, check_flag)
-            current%start_time = usecs/1.0e6
-#elif _MPI
-            current%start_time = MPI_Wtime()
-#else
-            call system_clock (count=clock)
-            call system_clock (count_rate=hz)
-            current%start_time = real(clock,kind=RKIND)/real(hz,kind=RKIND)
-#endif
-          endif
-
-          if(present(clear_timer)) then
-            if(clear_timer) then
-              current%start_time = 0.0
-              current%end_time = 0.0
-              current%total_time = 0.0
-              current%max_time = 0.0
-              current%min_time = 0.0
-              current%avg_time = 0.0
-              current%calls = 0
-              current%running = .false.
-            endif
-          endif
-
-          if(present(timer_ptr)) then
-              timer_ptr =&gt; current
-          endif
-          
-        end subroutine timer_start!}}}
-       
-        subroutine timer_stop(timer_name, timer_ptr)!{{{
-          character (len=*), intent(in) :: timer_name !&lt; Input: name of timer to stop
-          type (timer_node), pointer, intent(in), optional :: timer_ptr !&lt; Input: pointer to timer, for stopping
-
-          type (timer_node), pointer :: current
-          
-          real (kind=RKIND) :: time_temp
-          logical :: timer_found, string_equal, check_flag
-          integer :: clock, hz, usecs

-          timer_found = .false.

-          if(present(timer_ptr)) then
-            timer_found = .true.
-            current =&gt; timer_ptr
-          endif

-          if(.not.associated(all_timers)) then
-            print *,' timer_stop :: timer_stop called with no timers initialized'
-          else if(.not. timer_found) then
-            current =&gt; all_timers
-            timer_find: do while(.not.timer_found .and. associated(current))
-              string_equal = (trim(current%timer_name) == trim(timer_name))
-
-              if(string_equal) then
-                timer_found = .true.
-              else
-                current =&gt; current%next
-              endif
-            end do timer_find
-          endif
-
-          if(.not.timer_found) then
-            print *,' timer_stop :: timer_stop called with timer_name =', timer_name,' when timer has not been started.'
-            stop
-          endif
-
-          if(current%running) then
-            current%running = .false.
-            levels = levels - 1
-
-#ifdef _PAPI
-            call PAPIF_get_real_usec(usecs, check_flag)
-            current%end_time = usecs/1.0e6
-#elif _MPI
-            current%end_time = MPI_Wtime()
-#else
-            call system_clock(count=clock)
-            call system_clock(count_rate=hz)
-            current%end_time = real(clock,kind=RKIND)/real(hz,kind=RKIND)
-#endif
-            
-            time_temp = current%end_time - current%start_time
-            current%total_time = current%total_time + time_temp
-
-            if(time_temp &gt; current%max_time) then
-              current%max_time = time_temp
-            endif
-
-            if(time_temp &lt; current%min_time) then
-              current%min_time = time_temp
-            endif
-
-            current%avg_time = current%avg_time + time_temp
-            current%calls = current%calls + 1
-          endif
-
-        end subroutine timer_stop!}}}
-
-        recursive subroutine timer_write(timer_ptr, total_ptr)!{{{
-          type (timer_node), pointer, intent(inout), optional :: timer_ptr
-          type (timer_node), pointer, intent(in), optional :: total_ptr
-          character (len=10) :: tname
-
-          logical :: total_found, string_equals
-          type (timer_node), pointer :: current, total
-          real (kind=RKIND) :: percent
-          integer :: i
-
-          total_found = .false.
-
-          if(present(timer_ptr) .and. (.not.present(total_ptr))) then
-            print *,'timer_write :: timer_ptr valid, but total_ptr is not assigned.'
-            stop
-          else if(present(timer_ptr)) then
-            tname = ''
-            do i=0,timer_ptr%levels+2
-              tname = tname//' '
-!             write(*,'(a,$)') ' '
-            end do
-!           tname = tname//timer_ptr%timer_name
-
-            if(timer_ptr%total_time == 0.0d0) then
-              timer_ptr%min_time = 0.0d0
-              timer_ptr%max_time = 0.0d0
-              timer_ptr%avg_time = 0.0d0
-              percent = 0.0d0
-            else
-              timer_ptr%avg_time = timer_ptr%avg_time/timer_ptr%calls
-              percent = timer_ptr%total_time/total_ptr%total_time
-            endif
-
-            write(*,'(i2, 1x, a35, f15.5, i10, 3f15.5, f8.2)') timer_ptr%levels, tname(1:timer_ptr%levels)//timer_ptr%timer_name, timer_ptr%total_time, timer_ptr%calls, timer_ptr%min_time, timer_ptr%max_time, timer_ptr%avg_time, percent
-            return
-          endif
-
-          total =&gt; all_timers
-
-          find_total: do while((.not.total_found) .and. associated(total))
-            string_equals = (trim(total%timer_name) == trim(&quot;total time&quot;))
-            if(string_equals) then
-              total_found = .true.
-            else
-              total =&gt; total%next
-            endif
-          end do find_total
-
-          if(.not.total_found) then
-            print *,' timer_write :: no timer named &quot;total time&quot; found.'
-            stop
-          end if
-
-          write(*,'(3x, a10, 24x, a15, a10, a13, a15, a15, a15)') 'timer_name', 'total', 'calls', 'min', 'max', 'avg', 'percent'
-          write(*,'(i2, 1x, a35, f15.5, i10, 3f15.5)') total%levels, total%timer_name, total%total_time, total%calls, total%min_time, total%max_time, total%avg_time
-
-          current =&gt; all_timers
-
-          print_timers: do while(associated(current))
-            string_equals = (trim(current%timer_name) == trim(&quot;total time&quot;))
-            string_equals = string_equals .or. (trim(current%timer_name) == trim(&quot; &quot;))
-
-            if(.not.string_equals) then
-              call timer_write(current, total)
-              current =&gt; current%next
-            else
-              current =&gt; current%next
-            endif
-          end do print_timers
-
-        end subroutine timer_write!}}}
-
-      end module timer
-
-! vim: foldmethod=marker et ts=2

Deleted: branches/source_condensing/src/framework/module_zoltan_interface.F
===================================================================
--- trunk/mpas/src/framework/module_zoltan_interface.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/framework/module_zoltan_interface.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,581 +0,0 @@
-module zoltan_interface
-   use zoltan
-
-   implicit none
-
-   include 'mpif.h'
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! Data for reordering cells
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   integer :: numCells
-   integer, dimension(:), pointer :: cellIDs
-   integer :: geomDim
-   real (kind=RKIND), dimension(:), pointer :: cellCoordX, cellCoordY, cellCoordZ
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! Data for reordering edges
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   integer :: numEdges
-   integer, dimension(:), pointer :: edgeIDs
-   real (kind=RKIND), dimension(:), pointer :: edgeCoordX, edgeCoordY, edgeCoordZ  
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! Data for reordering vertices
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   integer :: numVerts
-   integer, dimension(:), pointer :: vertIDs
-   real (kind=RKIND), dimension(:), pointer :: vertCoordX, vertCoordY, vertCoordZ  
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-   contains
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! Perhaps not necessary, but implemented in case it helps
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   subroutine zoltanStart()  
-
-      integer(Zoltan_INT) :: error
-      real(Zoltan_FLOAT) :: version
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! Body of subroutine
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      error = Zoltan_Initialize(version)
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      
-   end subroutine
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   subroutine zoltanOrderLocHSFC_Cells(in_numcells,in_cellIDs,in_geomDim,in_cellX, &amp;
-                                       in_cellY, in_cellZ)
-      implicit none
-
-      integer :: in_numcells
-      integer, dimension(:), pointer :: in_cellIDs
-      integer :: in_geomDim
-      real (kind=RKIND), dimension(:), pointer :: in_cellX, in_cellY, in_cellZ
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! local variables
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      type(Zoltan_Struct), pointer :: zz_obj
-      integer(ZOLTAN_INT) :: ierr
-
-      integer :: numGidEntries, i
-      integer(ZOLTAN_INT), allocatable :: global_ids(:), permIndices(:),permGIDs(:)
-      real(kind=RKIND), allocatable :: permXs(:),permYs(:),permZs(:)
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! Body of subroutine
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      numCells = in_numcells
-      cellIDs =&gt; in_cellIDs
-      geomDim = in_geomDim
-      cellCoordX =&gt; in_cellX
-      cellCoordY =&gt; in_cellY
-      cellCoordZ =&gt; in_cellZ
-
-      nullify(zz_obj)
-      zz_obj =&gt; Zoltan_Create(MPI_COMM_SELF)
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! General Zoltan Parameters
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ierr = Zoltan_Set_Param(zz_obj, &quot;ORDER_METHOD&quot;, &quot;LOCAL_HSFC&quot;)
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! register query functions
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_OBJ_FN_TYPE,zqfNumCells)
-      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_OBJ_LIST_FN_TYPE,zqfGetCells)
-      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_GEOM_FN_TYPE,zqfGeomDim)
-      ierr =  Zoltan_Set_Fn(zz_obj, ZOLTAN_GEOM_FN_TYPE, zqfGetCellGeom)
-
-      numGidEntries=1
-
-      allocate(global_ids(numCells))
-      allocate(permIndices(numCells))
-      allocate(permGIDs(numCells))
-      allocate(permXs(numCells))
-      allocate(permYs(numCells))
-      allocate(permZs(numCells))
-
-      !! MMW: There might be a way to use cellIDs directly
-      do i=1,numCells
-        global_ids(i) = cellIDs(i)
-      end do
-
-      ierr = Zoltan_Order(zz_obj, numGidEntries, numCells, global_ids, permIndices);
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! This is necessary for now until we fix a small bug in Zoltan_Order
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-      do i=1,numCells
-        permGIDs(i) = global_ids(permIndices(i)+1)
-        permXs(i) = cellCoordX(permIndices(i)+1)
-        permYs(i) = cellCoordY(permIndices(i)+1)
-        permZs(i) = cellCoordZ(permIndices(i)+1)
-      end do
-
-      !!do i=1,numCells
-      !!   write(*,*) global_ids(i), permGIDs(i)
-      !!end do
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! Actually change the ordering of the cells
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-      do i=1,numCells
-        cellIDs(i) = permGIDs(i)
-        cellCoordX(i) = permXs(i)
-        cellCoordY(i) = permYs(i)
-        cellCoordZ(i) = permZs(i)
-      end do
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      deallocate(global_ids)
-      deallocate(permIndices)
-      deallocate(permGIDs)
-      deallocate(permXs)
-      deallocate(permYs)
-      deallocate(permZs)
-
-      call Zoltan_Destroy(zz_obj)
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   end subroutine zoltanOrderLocHSFC_Cells
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! zoltan query function:
-   !!    Returns number of cells
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   integer function zqfNumCells(data, ierr)
-
-      ! Local declarations
-      integer(ZOLTAN_INT), intent(in) :: data(*)
-      integer(ZOLTAN_INT), intent(out) :: ierr
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      zqfNumCells = numCells
-      ierr = ZOLTAN_OK
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   end function zqfNumCells
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! zoltan query function: 
-   !!    Returns lists of Cell IDs
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   subroutine zqfGetCells (data, num_gid_entries, num_lid_entries, global_ids, &amp;
-                           local_ids, wgt_dim, obj_wgts, ierr)
-     integer(ZOLTAN_INT), intent(in) :: data(*)
-     integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
-     integer(ZOLTAN_INT), intent(out) :: global_ids(*), local_ids(*)
-     integer(ZOLTAN_INT), intent(in) :: wgt_dim 
-     real(ZOLTAN_FLOAT), intent(out) :: obj_wgts(*)
-     integer(ZOLTAN_INT), intent(out) :: ierr
-
-     ! local declarations
-     integer :: i
-
-     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-     do i= 1, numCells
-       global_ids(i) = cellIDs(i)
-       local_ids(i) = i
-     end do
-
-     ierr = ZOLTAN_OK
-     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   end subroutine zqfGetCells
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! Zoltan Query Function:
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   integer function zqfGeomDim(data, ierr)
-      !use zoltan
-      implicit none
-      integer(ZOLTAN_INT), intent(in) :: data(*)
-      integer(ZOLTAN_INT) :: ierr
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      zqfGeomDim = geomDim
-      ierr = ZOLTAN_OK
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   end function zqfGeomDim
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! Zoltan Query Function:
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   subroutine zqfGetCellGeom(data, num_gid_entries, num_lid_entries, global_id, &amp;
-                             local_id, geom_vec, ierr)
-      !use zoltan
-      implicit none
-
-      integer(ZOLTAN_INT), intent(in) :: data(*)
-      integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
-      integer(ZOLTAN_INT), intent(in) :: global_id, local_id
-      real(ZOLTAN_DOUBLE), intent(out) :: geom_vec(*)
-      integer(ZOLTAN_INT), intent(out) :: ierr
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! Assuming geom_dim is 3
-      geom_vec(1) = cellCoordX(local_id)
-      geom_vec(2) = cellCoordY(local_id)
-      geom_vec(3) = cellCoordZ(local_id)
-
-      ierr = ZOLTAN_OK
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   end subroutine zqfGetCellGeom
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! The ordering functions should perhaps be refactored so that there
-   !! are not separate functions for cells, edges, and vertices
-   !! Not sure if this is worth it with the additional conditionals that would 
-   !! be required. 
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   subroutine zoltanOrderLocHSFC_Edges(in_numedges,in_edgeIDs,in_geomDim,in_edgeX, &amp;
-                                       in_edgeY, in_edgeZ)
-      implicit none
-
-      integer :: in_numedges
-      integer, dimension(:), pointer :: in_edgeIDs
-      integer :: in_geomDim
-      real (kind=RKIND), dimension(:), pointer :: in_edgeX, in_edgeY, in_edgeZ
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! local variables
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      type(Zoltan_Struct), pointer :: zz_obj
-      integer(ZOLTAN_INT) :: ierr
-
-      integer :: numGidEntries, i
-      integer(ZOLTAN_INT), allocatable :: global_ids(:), permIndices(:),permGIDs(:)
-      real(kind=RKIND), allocatable :: permXs(:),permYs(:),permZs(:)
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! Body of subroutine
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      numEdges = in_numedges
-      edgeIDs =&gt; in_edgeIDs
-      geomDim = in_geomDim
-      edgeCoordX =&gt; in_edgeX
-      edgeCoordY =&gt; in_edgeY
-      edgeCoordZ =&gt; in_edgeZ
-
-      nullify(zz_obj)
-      zz_obj =&gt; Zoltan_Create(MPI_COMM_SELF)
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! General Zoltan Parameters
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ierr = Zoltan_Set_Param(zz_obj, &quot;ORDER_METHOD&quot;, &quot;LOCAL_HSFC&quot;)
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! register query functions
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_OBJ_FN_TYPE,zqfNumEdges)
-      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_OBJ_LIST_FN_TYPE,zqfGetEdges)
-      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_GEOM_FN_TYPE,zqfGeomDim)
-      ierr =  Zoltan_Set_Fn(zz_obj, ZOLTAN_GEOM_FN_TYPE, zqfGetEdgeGeom)
-
-      numGidEntries=1
-
-      allocate(global_ids(numEdges))
-      allocate(permIndices(numEdges))
-      allocate(permGIDs(numEdges))
-      allocate(permXs(numEdges))
-      allocate(permYs(numEdges))
-      allocate(permZs(numEdges))
-
-      !! MMW: There might be a way to use edgeIDs directly
-      do i=1,numEdges
-        global_ids(i) = edgeIDs(i)
-      end do
-
-      ierr = Zoltan_Order(zz_obj, numGidEntries, numEdges, global_ids, permIndices);
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! This is necessary for now until we fix a small bug in Zoltan_Order
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-      do i=1,numEdges
-        permGIDs(i) = global_ids(permIndices(i)+1)
-        permXs(i) = edgeCoordX(permIndices(i)+1)
-        permYs(i) = edgeCoordY(permIndices(i)+1)
-        permZs(i) = edgeCoordZ(permIndices(i)+1)
-      end do
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! Actually change the ordering of the edges
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-      do i=1,numEdges
-        edgeIDs(i) = permGIDs(i)
-        edgeCoordX(i) = permXs(i)
-        edgeCoordY(i) = permYs(i)
-        edgeCoordZ(i) = permZs(i)
-      end do
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      deallocate(global_ids)
-      deallocate(permIndices)
-      deallocate(permGIDs)
-      deallocate(permXs)
-      deallocate(permYs)
-      deallocate(permZs)
-
-      call Zoltan_Destroy(zz_obj)
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   end subroutine zoltanOrderLocHSFC_Edges
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! zoltan query function:
-   !!    Returns number of edges
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   integer function zqfNumEdges(data, ierr)
-      ! Local declarations
-      integer(ZOLTAN_INT), intent(in) :: data(*)
-      integer(ZOLTAN_INT), intent(out) :: ierr
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      zqfNumEdges = numEdges
-      ierr = ZOLTAN_OK
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   end function zqfNumEdges
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! zoltan query function: 
-   !!    Returns lists of Edge IDs
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   subroutine zqfGetEdges (data, num_gid_entries, num_lid_entries, global_ids, &amp;
-                           local_ids, wgt_dim, obj_wgts, ierr)
-     integer(ZOLTAN_INT), intent(in) :: data(*)
-     integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
-     integer(ZOLTAN_INT), intent(out) :: global_ids(*), local_ids(*)
-     integer(ZOLTAN_INT), intent(in) :: wgt_dim 
-     real(ZOLTAN_FLOAT), intent(out) :: obj_wgts(*)
-     integer(ZOLTAN_INT), intent(out) :: ierr
-
-     ! local declarations
-     integer :: i
-
-     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-     do i= 1, numEdges
-       global_ids(i) = edgeIDs(i)
-       local_ids(i) = i
-     end do
-
-     ierr = ZOLTAN_OK
-     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   end subroutine zqfGetEdges
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! Zoltan Query Function:
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   subroutine zqfGetEdgeGeom(data, num_gid_entries, num_lid_entries, global_id, &amp;
-                             local_id, geom_vec, ierr)
-      !use zoltan
-      implicit none
-
-      integer(ZOLTAN_INT), intent(in) :: data(*)
-      integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
-      integer(ZOLTAN_INT), intent(in) :: global_id, local_id
-      real(ZOLTAN_DOUBLE), intent(out) :: geom_vec(*)
-      integer(ZOLTAN_INT), intent(out) :: ierr
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! Assuming geom_dim is 3
-      geom_vec(1) = edgeCoordX(local_id)
-      geom_vec(2) = edgeCoordY(local_id)
-      geom_vec(3) = edgeCoordZ(local_id)
-
-      ierr = ZOLTAN_OK
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   end subroutine zqfGetEdgeGeom
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   subroutine zoltanOrderLocHSFC_Verts(in_numverts,in_vertIDs,in_geomDim,in_vertX, &amp;
-                                       in_vertY, in_vertZ)
-      implicit none
-
-      integer :: in_numverts
-      integer, dimension(:), pointer :: in_vertIDs
-      integer :: in_geomDim
-      real (kind=RKIND), dimension(:), pointer :: in_vertX, in_vertY, in_vertZ
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! local variables
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      type(Zoltan_Struct), pointer :: zz_obj
-      integer(ZOLTAN_INT) :: ierr
-
-      integer :: numGidEntries, i
-      integer(ZOLTAN_INT), allocatable :: global_ids(:), permIndices(:),permGIDs(:)
-      real(kind=RKIND), allocatable :: permXs(:),permYs(:),permZs(:)
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! Body of subroutine
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      numVerts = in_numverts
-      vertIDs =&gt; in_vertIDs
-      geomDim = in_geomDim
-      vertCoordX =&gt; in_vertX
-      vertCoordY =&gt; in_vertY
-      vertCoordZ =&gt; in_vertZ
-
-      nullify(zz_obj)
-      zz_obj =&gt; Zoltan_Create(MPI_COMM_SELF)
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! General Zoltan Parameters
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ierr = Zoltan_Set_Param(zz_obj, &quot;ORDER_METHOD&quot;, &quot;LOCAL_HSFC&quot;)
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! register query functions
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_OBJ_FN_TYPE,zqfNumVerts)
-      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_OBJ_LIST_FN_TYPE,zqfGetVerts)
-      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_GEOM_FN_TYPE,zqfGeomDim)
-      ierr =  Zoltan_Set_Fn(zz_obj, ZOLTAN_GEOM_FN_TYPE, zqfGetVertGeom)
-
-      numGidEntries=1
-
-      allocate(global_ids(numVerts))
-      allocate(permIndices(numVerts))
-      allocate(permGIDs(numVerts))
-      allocate(permXs(numVerts))
-      allocate(permYs(numVerts))
-      allocate(permZs(numVerts))
-
-      !! MMW: There might be a way to use vertIDs directly
-      do i=1,numVerts
-        global_ids(i) = vertIDs(i)
-      end do
-
-      ierr = Zoltan_Order(zz_obj, numGidEntries, numVerts, global_ids, permIndices);
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! This is necessary for now until we fix a small bug in Zoltan_Order
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-      do i=1,numVerts
-        permGIDs(i) = global_ids(permIndices(i)+1)
-        permXs(i) = vertCoordX(permIndices(i)+1)
-        permYs(i) = vertCoordY(permIndices(i)+1)
-        permZs(i) = vertCoordZ(permIndices(i)+1)
-      end do
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! Actually change the ordering of the verts
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-      do i=1,numVerts
-        vertIDs(i) = permGIDs(i)
-        vertCoordX(i) = permXs(i)
-        vertCoordY(i) = permYs(i)
-        vertCoordZ(i) = permZs(i)
-      end do
-      !!!!!!!!!!!!!!!!!!!!!!!!!!
-
-      deallocate(global_ids)
-      deallocate(permIndices)
-      deallocate(permGIDs)
-      deallocate(permXs)
-      deallocate(permYs)
-      deallocate(permZs)
-
-      call Zoltan_Destroy(zz_obj)
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   end subroutine zoltanOrderLocHSFC_Verts
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! zoltan query function:
-   !!    Returns number of verts
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   integer function zqfNumVerts(data, ierr)
-
-      ! Local declarations
-      integer(ZOLTAN_INT), intent(in) :: data(*)
-      integer(ZOLTAN_INT), intent(out) :: ierr
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      zqfNumVerts = numVerts
-      ierr = ZOLTAN_OK
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   end function zqfNumVerts
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! zoltan query function: 
-   !!    Returns lists of Vert IDs
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   subroutine zqfGetVerts (data, num_gid_entries, num_lid_entries, global_ids, &amp;
-                           local_ids, wgt_dim, obj_wgts, ierr)
-
-     integer(ZOLTAN_INT), intent(in) :: data(*)
-     integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
-     integer(ZOLTAN_INT), intent(out) :: global_ids(*), local_ids(*)
-     integer(ZOLTAN_INT), intent(in) :: wgt_dim 
-     real(ZOLTAN_FLOAT), intent(out) :: obj_wgts(*)
-     integer(ZOLTAN_INT), intent(out) :: ierr
-
-     ! local declarations
-     integer :: i
-
-     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-     do i= 1, numVerts
-       global_ids(i) = vertIDs(i)
-       local_ids(i) = i
-     end do
-
-     ierr = ZOLTAN_OK
-     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   end subroutine zqfGetVerts
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   !! Zoltan Query Function:
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   subroutine zqfGetVertGeom(data, num_gid_entries, num_lid_entries, global_id, &amp;
-                             local_id, geom_vec, ierr)
-      !use zoltan
-      implicit none
-
-      integer(ZOLTAN_INT), intent(in) :: data(*)
-      integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
-      integer(ZOLTAN_INT), intent(in) :: global_id, local_id
-      real(ZOLTAN_DOUBLE), intent(out) :: geom_vec(*)
-      integer(ZOLTAN_INT), intent(out) :: ierr
-
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-      !! Assuming geom_dim is 3
-      geom_vec(1) = vertCoordX(local_id)
-      geom_vec(2) = vertCoordY(local_id)
-      geom_vec(3) = vertCoordZ(local_id)
-
-      ierr = ZOLTAN_OK
-      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-   end subroutine zqfGetVertGeom
-   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-
-
-
-end module zoltan_interface

Copied: branches/source_condensing/src/framework/mpas_block_decomp.F (from rev 1114, trunk/mpas/src/framework/mpas_block_decomp.F)
===================================================================
--- branches/source_condensing/src/framework/mpas_block_decomp.F                                (rev 0)
+++ branches/source_condensing/src/framework/mpas_block_decomp.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,306 @@
+module mpas_block_decomp
+
+   use mpas_dmpar
+   use mpas_hash
+
+   type graph
+      integer :: nVerticesTotal
+      integer :: nVertices, maxDegree
+      integer :: ghostStart
+      integer, dimension(:), pointer :: vertexID
+      integer, dimension(:), pointer :: nAdjacent
+      integer, dimension(:,:), pointer :: adjacencyList
+   end type graph
+
+
+   contains
+
+
+   subroutine mpas_block_decomp_cells_for_proc(dminfo, partial_global_graph_info, local_cell_list)
+
+      use mpas_configure
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      type (graph), intent(in) :: partial_global_graph_info
+      integer, dimension(:), pointer :: local_cell_list
+
+      integer, dimension(:), pointer :: global_cell_list
+      integer, dimension(:), pointer :: global_start
+
+      integer :: i, j, owner, iunit, istatus
+      integer, dimension(:), pointer :: local_nvertices
+      character (len=256) :: filename
+
+      if (dminfo % nprocs &gt; 1) then
+
+         allocate(local_nvertices(dminfo % nprocs))
+         allocate(global_start(dminfo % nprocs))
+         allocate(global_cell_list(partial_global_graph_info % nVerticesTotal))
+
+         if (dminfo % my_proc_id == IO_NODE) then
+
+            iunit = 50 + dminfo % my_proc_id
+            if (dminfo % nprocs &lt; 10) then
+               write(filename,'(a,i1)') trim(config_decomp_file_prefix), dminfo % nprocs
+            else if (dminfo % nprocs &lt; 100) then
+               write(filename,'(a,i2)') trim(config_decomp_file_prefix), dminfo % nprocs
+            else if (dminfo % nprocs &lt; 1000) then
+               write(filename,'(a,i3)') trim(config_decomp_file_prefix), dminfo % nprocs
+            else if (dminfo % nprocs &lt; 10000) then
+               write(filename,'(a,i4)') trim(config_decomp_file_prefix), dminfo % nprocs
+            else if (dminfo % nprocs &lt; 100000) then
+               write(filename,'(a,i5)') trim(config_decomp_file_prefix), dminfo % nprocs
+            end if
+          
+            open(unit=iunit, file=trim(filename), form='formatted', status='old', iostat=istatus)
+      
+            if (istatus /= 0) then
+               write(0,*) 'Could not open block decomposition file for ',dminfo % nprocs,' tasks.'
+               write(0,*) 'Filename: ',trim(filename)
+               call mpas_dmpar_abort(dminfo)
+            end if
+      
+            local_nvertices(:) = 0
+            do i=1,partial_global_graph_info % nVerticesTotal
+               read(unit=iunit, fmt=*) owner
+               local_nvertices(owner+1) = local_nvertices(owner+1) + 1
+            end do
+      
+!            allocate(global_cell_list(partial_global_graph_info % nVerticesTotal))
+
+            global_start(1) = 1
+            do i=2,dminfo % nprocs
+               global_start(i) = global_start(i-1) + local_nvertices(i-1)
+            end do
+      
+            rewind(unit=iunit)
+      
+            do i=1,partial_global_graph_info % nVerticesTotal
+               read(unit=iunit, fmt=*) owner
+               global_cell_list(global_start(owner+1)) = i
+               global_start(owner+1) = global_start(owner+1) + 1
+            end do
+
+            global_start(1) = 0
+            do i=2,dminfo % nprocs
+               global_start(i) = global_start(i-1) + local_nvertices(i-1)
+            end do
+
+            close(unit=iunit)
+
+            call mpas_dmpar_bcast_ints(dminfo, dminfo % nprocs, local_nvertices)
+            allocate(local_cell_list(local_nvertices(dminfo % my_proc_id + 1)))
+
+            call mpas_dmpar_scatter_ints(dminfo, dminfo % nprocs, local_nvertices(dminfo % my_proc_id + 1), &amp;
+                                    global_start, local_nvertices, global_cell_list, local_cell_list)
+
+         else
+
+            call mpas_dmpar_bcast_ints(dminfo, dminfo % nprocs, local_nvertices)
+            allocate(local_cell_list(local_nvertices(dminfo % my_proc_id + 1)))
+
+            call mpas_dmpar_scatter_ints(dminfo, dminfo % nprocs, local_nvertices(dminfo % my_proc_id + 1), &amp;
+                                    global_start, local_nvertices, global_cell_list, local_cell_list)
+
+         end if
+
+         deallocate(local_nvertices)
+         deallocate(global_start)
+         deallocate(global_cell_list)
+      else
+         allocate(local_cell_list(partial_global_graph_info % nVerticesTotal))
+         do i=1,size(local_cell_list)
+            local_cell_list(i) = i
+         end do
+      endif
+
+   end subroutine mpas_block_decomp_cells_for_proc
+
+
+   subroutine mpas_block_decomp_partitioned_edge_list(nCells, cellIDList, maxCells, nEdges, cellsOnEdge, edgeIDList, ghostEdgeStart)
+
+      implicit none
+
+      integer, intent(in) :: nCells, maxCells, nEdges
+      integer, dimension(nCells), intent(in) :: cellIDList
+      integer, dimension(maxCells, nEdges), intent(in) :: cellsOnEdge
+      integer, dimension(nEdges), intent(inout) :: edgeIDList
+      integer, intent(inout) :: ghostEdgeStart
+
+      integer :: i, j, lastEdge
+      integer, dimension(nEdges) :: edgeIDListLocal
+      type (hashtable) :: h
+
+      call mpas_hash_init(h)
+
+      do i=1,nCells
+         ! OPTIMIZATION: Actually, if we can assume that all cellIDs are unique, the if-test is unnecessary
+         if (.not. mpas_hash_search(h, cellIDList(i))) call mpas_hash_insert(h, cellIDList(i))
+      end do
+
+      lastEdge = 0
+      ghostEdgeStart = nEdges+1
+
+      edgeIDListLocal(:) = edgeIDList(:)
+
+      do i=1,nEdges
+         do j=1,maxCells
+            if (cellsOnEdge(j,i) /= 0) exit
+         end do
+         if (j &gt; maxCells) &amp;
+            write(0,*) 'Error in block_decomp_partitioned_edge_list: ',&amp;
+               'edge/vertex is not adjacent to any valid cells'
+         if (mpas_hash_search(h, cellsOnEdge(j,i))) then
+            lastEdge = lastEdge + 1
+            edgeIDList(lastEdge) = edgeIDListLocal(i)
+         else
+            ghostEdgeStart = ghostEdgeStart - 1
+            edgeIDList(ghostEdgeStart) = edgeIDListLocal(i)
+         end if
+         if (ghostEdgeStart &lt;= lastEdge) then
+           write(0,*) 'block_decomp_partitioned_edge_list: ',&amp;
+              'Somehow we have more edges than we thought we should.'
+         end if
+      end do
+
+      if (ghostEdgeStart /= lastEdge + 1) then
+         write(0,*) 'block_decomp_partitioned_edge_list:',&amp;
+            ' Somehow we didn''t have enough edges to fill edgeIDList.'
+      end if
+
+      call mpas_hash_destroy(h)
+
+   end subroutine mpas_block_decomp_partitioned_edge_list
+
+
+   subroutine mpas_block_decomp_all_edges_in_block(maxEdges, nCells, nEdgesOnCell, edgesOnCell, nEdges, edgeList)
+
+      implicit none
+
+      integer, intent(in) :: maxEdges, nCells
+      integer, dimension(nCells), intent(in) :: nEdgesOnCell
+      integer, dimension(maxEdges, nCells), intent(in) :: edgesOnCell
+      integer, intent(out) :: nEdges
+      integer, dimension(:), pointer :: edgeList
+
+      integer :: i, j, k
+      type (hashtable) :: h
+
+      call mpas_hash_init(h)
+
+      do i=1,nCells
+         do j=1,nEdgesOnCell(i)
+            if (.not. mpas_hash_search(h, edgesOnCell(j,i))) call mpas_hash_insert(h, edgesOnCell(j,i)) 
+         end do
+      end do
+
+      nEdges = mpas_hash_size(h)
+      allocate(edgeList(nEdges))
+
+      call mpas_hash_destroy(h)
+
+      call mpas_hash_init(h)
+
+      k = 0
+      do i=1,nCells
+         do j=1,nEdgesOnCell(i)
+            if (.not. mpas_hash_search(h, edgesOnCell(j,i))) then
+               k = k + 1
+               if (k &gt; nEdges) then
+                 write(0,*) 'block_decomp_all_edges_in_block: ',&amp;
+                    'Trying to add more edges than expected.'
+                 return
+               end if
+               edgeList(k) = edgesOnCell(j,i)
+               call mpas_hash_insert(h, edgesOnCell(j,i)) 
+            end if
+         end do
+      end do
+
+      call mpas_hash_destroy(h)
+
+      if (k &lt; nEdges) then
+         write(0,*) 'block_decomp_all_edges_in_block: ',&amp;
+            'Listed fewer edges than expected.'
+      end if
+
+   end subroutine mpas_block_decomp_all_edges_in_block
+
+
+   subroutine mpas_block_decomp_add_halo(dminfo, local_graph_info, local_graph_with_halo)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      type (graph), intent(in) :: local_graph_info
+      type (graph), intent(out) :: local_graph_with_halo
+
+      integer :: i, j, k
+      type (hashtable) :: h
+
+
+      call mpas_hash_init(h)
+
+      do i=1,local_graph_info % nVertices
+         call mpas_hash_insert(h, local_graph_info % vertexID(i))
+      end do
+
+      do i=1,local_graph_info % nVertices
+         do j=1,local_graph_info % nAdjacent(i)
+            if (local_graph_info % adjacencyList(j,i) /= 0) then
+               if (.not. mpas_hash_search(h, local_graph_info % adjacencyList(j,i))) then
+                  call mpas_hash_insert(h, local_graph_info % adjacencyList(j,i))
+               end if
+            end if
+         end do
+      end do 
+
+
+      local_graph_with_halo % nVertices = local_graph_info % nVertices
+      local_graph_with_halo % maxDegree = local_graph_info % maxDegree
+      local_graph_with_halo % nVerticesTotal = mpas_hash_size(h)
+      local_graph_with_halo % ghostStart = local_graph_with_halo % nVertices + 1
+      allocate(local_graph_with_halo % vertexID(local_graph_with_halo % nVerticesTotal))
+      allocate(local_graph_with_halo % nAdjacent(local_graph_with_halo % nVerticesTotal))
+      allocate(local_graph_with_halo % adjacencyList(local_graph_with_halo % maxDegree, local_graph_with_halo % nVerticesTotal))
+
+      call mpas_hash_destroy(h)
+
+      call mpas_hash_init(h)
+
+      do i=1,local_graph_info % nVertices
+         if (mpas_hash_search(h, local_graph_info % vertexID(i))) &amp;
+           write(0,*) 'block_decomp_add_halo: ', &amp;
+             'There appear to be duplicates in vertexID list.'
+         call mpas_hash_insert(h, local_graph_info % vertexID(i)) 
+         local_graph_with_halo % vertexID(i) = local_graph_info % vertexID(i) 
+         local_graph_with_halo % nAdjacent(i) = local_graph_info % nAdjacent(i) 
+         local_graph_with_halo % adjacencyList(:,i) = local_graph_info % adjacencyList(:,i) 
+      end do
+
+      k = local_graph_with_halo % ghostStart
+      if (mpas_hash_size(h) /= k-1) &amp;
+         write(0,*) 'block_decomp_add_halo: ',&amp;
+           'Somehow we don''t have the right number of non-ghost cells.'
+      do i=1,local_graph_info % nVertices
+         do j=1,local_graph_info % nAdjacent(i)
+            if (local_graph_info % adjacencyList(j,i) /= 0) then
+               if (.not. mpas_hash_search(h, local_graph_info % adjacencyList(j,i))) then
+                  call mpas_hash_insert(h, local_graph_info % adjacencyList(j,i))
+                  local_graph_with_halo % vertexID(k) = local_graph_info % adjacencyList(j,i)
+                  k = k + 1
+               end if
+            end if
+         end do
+      end do 
+      if (local_graph_with_halo % nVerticesTotal /= k-1) &amp;
+         write(0,*) 'block_decomp_add_halo: ',&amp; 
+           'Somehow we don''t have the right number of total cells.'
+
+      call mpas_hash_destroy(h)
+
+   end subroutine mpas_block_decomp_add_halo
+
+end module mpas_block_decomp

Copied: branches/source_condensing/src/framework/mpas_configure.F (from rev 1114, trunk/mpas/src/framework/mpas_configure.F)
===================================================================
--- branches/source_condensing/src/framework/mpas_configure.F                                (rev 0)
+++ branches/source_condensing/src/framework/mpas_configure.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,36 @@
+module mpas_configure
+
+   use mpas_dmpar
+
+#include &quot;config_defs.inc&quot;
+
+   contains
+
+
+   subroutine mpas_read_namelist(dminfo)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+
+      integer :: funit
+
+#include &quot;config_namelist_defs.inc&quot;
+
+      funit = 21
+
+      ! Set default values for namelist options
+#include &quot;config_set_defaults.inc&quot;
+
+      if (dminfo % my_proc_id == IO_NODE) then
+         open(funit,file='namelist.input',status='old',form='formatted')
+
+#include &quot;config_namelist_reads.inc&quot;
+         close(funit)
+      end if
+
+#include &quot;config_bcast_namelist.inc&quot;
+
+   end subroutine mpas_read_namelist
+
+end module mpas_configure

Copied: branches/source_condensing/src/framework/mpas_constants.F (from rev 1114, trunk/mpas/src/framework/mpas_constants.F)
===================================================================
--- branches/source_condensing/src/framework/mpas_constants.F                                (rev 0)
+++ branches/source_condensing/src/framework/mpas_constants.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,20 @@
+module mpas_constants
+
+   real (kind=RKIND), parameter :: pii     = 3.141592653589793   
+   real (kind=RKIND), parameter :: a       = 6371229.0
+   real (kind=RKIND), parameter :: omega   = 7.29212e-5
+   real (kind=RKIND), parameter :: gravity = 9.80616
+   real (kind=RKIND), parameter :: rgas = 287.
+   real (kind=RKIND), parameter :: cp = 1003.
+   real (kind=RKIND), parameter :: cv = 716.  ! cp - rgas
+   real (kind=RKIND), parameter :: cvpm = -.71385842 ! -cv/cp
+   real (kind=RKIND), parameter :: prandtl = 1.0
+
+
+   contains
+
+   subroutine dummy()
+
+   end subroutine dummy
+
+end module mpas_constants

Copied: branches/source_condensing/src/framework/mpas_dmpar.F (from rev 1114, trunk/mpas/src/framework/mpas_dmpar.F)
===================================================================
--- branches/source_condensing/src/framework/mpas_dmpar.F                                (rev 0)
+++ branches/source_condensing/src/framework/mpas_dmpar.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,1928 @@
+module mpas_dmpar
+
+   use mpas_sort
+
+#ifdef _MPI
+include 'mpif.h'
+   integer, parameter :: MPI_INTEGERKIND = MPI_INTEGER
+
+#if (RKIND == 8)
+   integer, parameter :: MPI_REALKIND = MPI_DOUBLE_PRECISION
+#else
+   integer, parameter :: MPI_REALKIND = MPI_REAL
+#endif
+#endif
+
+   integer, parameter :: IO_NODE = 0
+   integer, parameter :: BUFSIZE = 6000
+
+
+   type dm_info
+      integer :: nprocs, my_proc_id, comm, info
+   end type dm_info
+
+
+   type exchange_list
+      integer :: procID
+      integer :: nlist
+      integer, dimension(:), pointer :: list
+      type (exchange_list), pointer :: next
+      real (kind=RKIND), dimension(:), pointer :: rbuffer
+      integer, dimension(:), pointer           :: ibuffer
+      integer :: reqID
+   end type exchange_list
+
+
+   interface mpas_dmpar_alltoall_field
+      module procedure mpas_dmpar_alltoall_field1d_integer
+      module procedure mpas_dmpar_alltoall_field2d_integer
+      module procedure mpas_dmpar_alltoall_field1d_real
+      module procedure mpas_dmpar_alltoall_field2d_real
+      module procedure mpas_dmpar_alltoall_field3d_real
+   end interface
+
+
+   contains
+
+
+   subroutine mpas_dmpar_init(dminfo)
+
+      implicit none
+
+      type (dm_info), intent(inout) :: dminfo
+
+#ifdef _MPI
+      integer :: mpi_rank, mpi_size
+      integer :: mpi_ierr
+
+      ! Find out our rank and the total number of processors
+      call MPI_Init(mpi_ierr)
+      call MPI_Comm_rank(MPI_COMM_WORLD, mpi_rank, mpi_ierr)
+      call MPI_Comm_size(MPI_COMM_WORLD, mpi_size, mpi_ierr)
+
+      dminfo % comm = MPI_COMM_WORLD
+
+      dminfo % nprocs = mpi_size
+      dminfo % my_proc_id = mpi_rank
+
+      write(0,'(a,i5,a,i5,a)') 'task ', mpi_rank, ' of ', mpi_size, &amp;
+        ' is running'
+
+      call open_streams(dminfo % my_proc_id)
+
+      dminfo % info = MPI_INFO_NULL
+#else
+      dminfo % comm = 0
+      dminfo % my_proc_id = IO_NODE
+      dminfo % nprocs = 1
+#endif
+
+   end subroutine mpas_dmpar_init
+
+
+   subroutine mpas_dmpar_finalize(dminfo)
+
+      implicit none
+
+      type (dm_info), intent(inout) :: dminfo
+
+#ifdef _MPI
+      integer :: mpi_ierr
+
+      call MPI_Finalize(mpi_ierr)
+#endif
+
+   end subroutine mpas_dmpar_finalize
+
+
+   subroutine mpas_dmpar_abort(dminfo)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+
+#ifdef _MPI
+      integer :: mpi_ierr, mpi_errcode
+
+      call MPI_Abort(dminfo % comm, mpi_errcode, mpi_ierr)
+#endif
+
+      stop
+
+   end subroutine mpas_dmpar_abort
+
+
+   subroutine mpas_dmpar_global_abort(mesg)
+
+      implicit none
+
+      character (len=*), intent(in) :: mesg
+
+#ifdef _MPI
+      integer :: mpi_ierr, mpi_errcode
+
+      write(0,*) trim(mesg)
+      call MPI_Abort(MPI_COMM_WORLD, mpi_errcode, mpi_ierr)
+#endif
+
+      write(0,*) trim(mesg)
+      stop
+
+   end subroutine mpas_dmpar_global_abort
+
+
+   subroutine mpas_dmpar_bcast_int(dminfo, i)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(inout) :: i
+
+#ifdef _MPI
+      integer :: mpi_ierr
+
+      call MPI_Bcast(i, 1, MPI_INTEGERKIND, IO_NODE, dminfo % comm, mpi_ierr)
+#endif
+
+   end subroutine mpas_dmpar_bcast_int
+
+
+   subroutine mpas_dmpar_bcast_ints(dminfo, n, iarray)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: n
+      integer, dimension(n), intent(inout) :: iarray
+
+#ifdef _MPI
+      integer :: mpi_ierr
+
+      call MPI_Bcast(iarray, n, MPI_INTEGERKIND, IO_NODE, dminfo % comm, mpi_ierr)
+#endif
+
+   end subroutine mpas_dmpar_bcast_ints
+
+
+   subroutine mpas_dmpar_bcast_real(dminfo, r)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      real (kind=RKIND), intent(inout) :: r
+
+#ifdef _MPI
+      integer :: mpi_ierr
+
+      call MPI_Bcast(r, 1, MPI_REALKIND, IO_NODE, dminfo % comm, mpi_ierr)
+#endif
+
+   end subroutine mpas_dmpar_bcast_real
+
+
+   subroutine mpas_dmpar_bcast_reals(dminfo, n, rarray)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: n
+      real (kind=RKIND), dimension(n), intent(inout) :: rarray
+
+#ifdef _MPI
+      integer :: mpi_ierr
+
+      call MPI_Bcast(rarray, n, MPI_REALKIND, IO_NODE, dminfo % comm, mpi_ierr)
+#endif
+
+   end subroutine mpas_dmpar_bcast_reals
+
+
+   subroutine mpas_dmpar_bcast_logical(dminfo, l)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      logical, intent(inout) :: l
+
+#ifdef _MPI
+      integer :: mpi_ierr
+      integer :: itemp
+
+      if (dminfo % my_proc_id == IO_NODE) then
+         if (l) then
+            itemp = 1
+         else
+            itemp = 0
+         end if
+      end if
+
+      call MPI_Bcast(itemp, 1, MPI_INTEGERKIND, IO_NODE, dminfo % comm, mpi_ierr)
+
+      if (itemp == 1) then
+         l = .true.
+      else
+         l = .false.
+      end if
+#endif
+
+   end subroutine mpas_dmpar_bcast_logical
+
+
+   subroutine mpas_dmpar_bcast_char(dminfo, c)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      character (len=*), intent(inout) :: c
+
+#ifdef _MPI
+      integer :: mpi_ierr
+
+      call MPI_Bcast(c, len(c), MPI_CHARACTER, IO_NODE, dminfo % comm, mpi_ierr)
+#endif
+
+   end subroutine mpas_dmpar_bcast_char
+
+
+   subroutine mpas_dmpar_sum_int(dminfo, i, isum)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: i
+      integer, intent(out) :: isum
+
+      integer :: mpi_ierr
+
+#ifdef _MPI
+      call MPI_Allreduce(i, isum, 1, MPI_INTEGERKIND, MPI_SUM, dminfo % comm, mpi_ierr)
+#else
+      isum = i
+#endif
+
+   end subroutine mpas_dmpar_sum_int
+
+
+   subroutine mpas_dmpar_sum_real(dminfo, r, rsum)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      real(kind=RKIND), intent(in) :: r
+      real(kind=RKIND), intent(out) :: rsum
+
+      integer :: mpi_ierr
+
+#ifdef _MPI
+      call MPI_Allreduce(r, rsum, 1, MPI_REALKIND, MPI_SUM, dminfo % comm, mpi_ierr)
+#else
+      rsum = r
+#endif
+
+   end subroutine mpas_dmpar_sum_real
+
+
+   subroutine mpas_dmpar_min_int(dminfo, i, imin)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: i
+      integer, intent(out) :: imin
+
+      integer :: mpi_ierr
+
+#ifdef _MPI
+      call MPI_Allreduce(i, imin, 1, MPI_INTEGERKIND, MPI_MIN, dminfo % comm, mpi_ierr)
+#else
+      imin = i
+#endif
+
+   end subroutine mpas_dmpar_min_int
+
+
+   subroutine mpas_dmpar_min_real(dminfo, r, rmin)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      real(kind=RKIND), intent(in) :: r
+      real(kind=RKIND), intent(out) :: rmin
+
+      integer :: mpi_ierr
+
+#ifdef _MPI
+      call MPI_Allreduce(r, rmin, 1, MPI_REALKIND, MPI_MIN, dminfo % comm, mpi_ierr)
+#else
+      rmin = r
+#endif
+
+   end subroutine mpas_dmpar_min_real
+
+
+   subroutine mpas_dmpar_max_int(dminfo, i, imax)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: i
+      integer, intent(out) :: imax
+      
+      integer :: mpi_ierr 
+      
+#ifdef _MPI
+      call MPI_Allreduce(i, imax, 1, MPI_INTEGERKIND, MPI_MAX, dminfo % comm, mpi_ierr)
+#else
+      imax = i
+#endif
+
+   end subroutine mpas_dmpar_max_int
+
+
+   subroutine mpas_dmpar_max_real(dminfo, r, rmax)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      real(kind=RKIND), intent(in) :: r
+      real(kind=RKIND), intent(out) :: rmax
+
+      integer :: mpi_ierr
+
+#ifdef _MPI
+      call MPI_Allreduce(r, rmax, 1, MPI_REALKIND, MPI_MAX, dminfo % comm, mpi_ierr)
+#else
+      rmax = r
+#endif
+
+   end subroutine mpas_dmpar_max_real
+
+
+   subroutine mpas_dmpar_sum_int_array(dminfo, nElements, inArray, outArray)
+
+      implicit none
+   
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nElements
+      integer, dimension(nElements), intent(in) :: inArray
+      integer, dimension(nElements), intent(out) :: outArray
+      
+      integer :: mpi_ierr
+
+#ifdef _MPI
+      call MPI_Allreduce(inArray, outArray, nElements, MPI_INTEGERKIND, MPI_SUM, dminfo % comm, mpi_ierr)
+#else
+      outArray = inArray
+#endif
+
+   end subroutine mpas_dmpar_sum_int_array
+
+
+   subroutine mpas_dmpar_min_int_array(dminfo, nElements, inArray, outArray)
+   
+      implicit none
+      
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nElements
+      integer, dimension(nElements), intent(in) :: inArray
+      integer, dimension(nElements), intent(out) :: outArray
+
+      integer :: mpi_ierr
+
+#ifdef _MPI
+      call MPI_Allreduce(inArray, outArray, nElements, MPI_INTEGERKIND, MPI_MIN, dminfo % comm, mpi_ierr)
+#else
+      outArray = inArray
+#endif
+
+   end subroutine mpas_dmpar_min_int_array
+
+
+   subroutine mpas_dmpar_max_int_array(dminfo, nElements, inArray, outArray)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nElements
+      integer, dimension(nElements), intent(in) :: inArray
+      integer, dimension(nElements), intent(out) :: outArray
+
+      integer :: mpi_ierr
+
+#ifdef _MPI
+      call MPI_Allreduce(inArray, outArray, nElements, MPI_INTEGERKIND, MPI_MAX, dminfo % comm, mpi_ierr)
+#else
+      outArray = inArray
+#endif
+
+   end subroutine mpas_dmpar_max_int_array
+
+
+   subroutine mpas_dmpar_sum_real_array(dminfo, nElements, inArray, outArray)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nElements
+      real(kind=RKIND), dimension(nElements), intent(in) :: inArray
+      real(kind=RKIND), dimension(nElements), intent(out) :: outArray
+
+      integer :: mpi_ierr
+
+#ifdef _MPI
+      call MPI_Allreduce(inArray, outArray, nElements, MPI_REALKIND, MPI_SUM, dminfo % comm, mpi_ierr)
+#else
+      outArray = inArray
+#endif
+
+   end subroutine mpas_dmpar_sum_real_array
+
+
+   subroutine mpas_dmpar_min_real_array(dminfo, nElements, inArray, outArray)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nElements
+      real(kind=RKIND), dimension(nElements), intent(in) :: inArray
+      real(kind=RKIND), dimension(nElements), intent(out) :: outArray
+
+      integer :: mpi_ierr
+
+#ifdef _MPI
+      call MPI_Allreduce(inArray, outArray, nElements, MPI_REALKIND, MPI_MIN, dminfo % comm, mpi_ierr)
+#else
+      outArray = inArray
+#endif
+
+   end subroutine mpas_dmpar_min_real_array
+
+
+   subroutine mpas_dmpar_max_real_array(dminfo, nElements, inArray, outArray)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nElements
+      real(kind=RKIND), dimension(nElements), intent(in) :: inArray
+      real(kind=RKIND), dimension(nElements), intent(out) :: outArray
+
+      integer :: mpi_ierr
+
+#ifdef _MPI
+      call MPI_Allreduce(inArray, outArray, nElements, MPI_REALKIND, MPI_MAX, dminfo % comm, mpi_ierr)
+#else
+      outArray = inArray
+#endif
+
+   end subroutine mpas_dmpar_max_real_array
+
+
+   subroutine mpas_dmpar_scatter_ints(dminfo, nprocs, noutlist, displs, counts, inlist, outlist)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nprocs, noutlist
+      integer, dimension(nprocs), intent(in) :: displs, counts
+      integer, dimension(:), pointer :: inlist
+      integer, dimension(noutlist), intent(inout) :: outlist
+
+#ifdef _MPI
+      integer :: mpi_ierr
+      
+      call MPI_Scatterv(inlist, counts, displs, MPI_INTEGERKIND, outlist, noutlist, MPI_INTEGERKIND, IO_NODE, dminfo % comm, mpi_ierr)
+#endif
+
+   end subroutine mpas_dmpar_scatter_ints
+
+
+   subroutine mpas_dmpar_get_index_range(dminfo, &amp;
+                                    global_start, global_end, &amp;
+                                    local_start, local_end)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: global_start, global_end
+      integer, intent(out) :: local_start, local_end
+
+      local_start = nint(real(dminfo % my_proc_id) * real(global_end - global_start + 1) / real(dminfo % nprocs)) + 1
+      local_end   = nint(real(dminfo % my_proc_id + 1) * real(global_end - global_start + 1) / real(dminfo % nprocs)) 
+
+   end subroutine mpas_dmpar_get_index_range
+
+  
+   subroutine mpas_dmpar_compute_index_range(dminfo, &amp;
+                                        local_start, local_end, &amp;
+                                        global_start, global_end)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: local_start, local_end
+      integer, intent(inout) :: global_start, global_end
+
+      integer :: n
+      integer :: mpi_ierr
+
+      n = local_end - local_start + 1
+
+      if (dminfo % my_proc_id == 0) then
+         global_start = 1
+         global_end = global_start + n - 1
+         
+#ifdef _MPI
+      else if (dminfo % my_proc_id == dminfo % nprocs - 1) then
+         call MPI_Recv(global_start, 1, MPI_INTEGERKIND, dminfo % my_proc_id - 1, 0, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
+         global_end = global_start + n - 1
+
+      else
+         call MPI_Recv(global_start, 1, MPI_INTEGERKIND, dminfo % my_proc_id - 1, 0, dminfo % comm, MPI_STATUS_IGNORE, mpi_ierr)
+         global_end = global_start + n
+         call MPI_Send(global_end, 1, MPI_INTEGERKIND, dminfo % my_proc_id + 1, 0, dminfo % comm, mpi_ierr)
+         global_end = global_end - 1
+#endif
+
+      end if
+      
+   
+   end subroutine mpas_dmpar_compute_index_range
+
+
+   subroutine mpas_dmpar_get_owner_list(dminfo, &amp;
+                                   nOwnedList, nNeededList, &amp;
+                                   ownedList, neededList, &amp;
+                                   sendList, recvList)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: nOwnedList, nNeededList
+      integer, dimension(nOwnedList), intent(in) :: ownedList
+      integer, dimension(nNeededList), intent(in) :: neededList
+      type (exchange_list), pointer :: sendList
+      type (exchange_list), pointer :: recvList
+
+      integer :: i, j, k, kk
+      integer :: totalSize, nMesgRecv, nMesgSend, recvNeighbor, sendNeighbor, currentProc
+      integer :: numToSend, numToRecv
+      integer, dimension(nOwnedList) :: recipientList
+      integer, dimension(2,nOwnedList) :: ownedListSorted
+      integer, allocatable, dimension(:) :: ownerListIn, ownerListOut
+      type (exchange_list), pointer :: sendListPtr, recvListPtr
+      integer :: mpi_ierr, mpi_rreq, mpi_sreq
+
+#ifdef _MPI
+      allocate(sendList)
+      allocate(recvList)
+      nullify(sendList % next)
+      nullify(recvList % next)
+      sendListPtr =&gt; sendList
+      recvListPtr =&gt; recvList
+
+      do i=1,nOwnedList
+         ownedListSorted(1,i) = ownedList(i)
+         ownedListSorted(2,i) = i
+      end do
+      call quicksort(nOwnedList, ownedListSorted)
+
+      call MPI_Allreduce(nNeededList, totalSize, 1, MPI_INTEGERKIND, MPI_MAX, dminfo % comm, mpi_ierr)
+
+      allocate(ownerListIn(totalSize))
+      allocate(ownerListOut(totalSize))
+
+      nMesgRecv = nNeededList
+      ownerListIn(1:nNeededList) = neededList(1:nNeededList)
+
+      recvNeighbor = mod(dminfo % my_proc_id + dminfo % nprocs - 1, dminfo % nprocs)
+      sendNeighbor = mod(dminfo % my_proc_id + 1, dminfo % nprocs)
+
+      do i=1, dminfo % nprocs
+
+         recipientList(:) = -1
+         numToSend = 0
+
+         currentProc = mod(dminfo % my_proc_id + dminfo % nprocs - i + 1, dminfo % nprocs)
+         do j=1,nMesgRecv
+            if (ownerListIn(j) &gt; 0) then
+               k = mpas_binary_search(ownedListSorted, 2, 1, nOwnedList, ownerListIn(j))
+               if (k &lt;= nOwnedList) then
+                  ownerListOut(j) = -1 * dminfo % my_proc_id
+                  numToSend = numToSend + 1
+                  recipientList(ownedListSorted(2,k)) = numToSend
+               else
+                  ownerListOut(j) = ownerListIn(j)
+               end if
+            else
+               ownerListOut(j) = ownerListIn(j)
+            end if
+         end do
+
+         if (numToSend &gt; 0) then
+            allocate(sendListPtr % next)
+            sendListPtr =&gt; sendListPtr % next
+            sendListPtr % procID = currentProc
+            sendListPtr % nlist = numToSend
+            allocate(sendListPtr % list(numToSend))
+            nullify(sendListPtr % next)
+            kk = 1
+            do j=1,nOwnedList
+               if (recipientList(j) /= -1) then
+                  sendListPtr % list(recipientList(j)) = j
+                  kk = kk + 1
+               end if
+            end do
+         end if
+
+         nMesgSend = nMesgRecv
+         call MPI_Irecv(nMesgRecv, 1, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
+         call MPI_Isend(nMesgSend, 1, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
+         call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
+         call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
+         call MPI_Irecv(ownerListIn, nMesgRecv, MPI_INTEGERKIND, recvNeighbor, i, dminfo % comm, mpi_rreq, mpi_ierr)
+         call MPI_Isend(ownerListOut, nMesgSend, MPI_INTEGERKIND, sendNeighbor, i, dminfo % comm, mpi_sreq, mpi_ierr)
+         call MPI_Wait(mpi_rreq, MPI_STATUS_IGNORE, mpi_ierr)
+         call MPI_Wait(mpi_sreq, MPI_STATUS_IGNORE, mpi_ierr)
+      end do
+
+      do i=0, dminfo % nprocs - 1
+
+         numToRecv = 0
+         do j=1,nNeededList
+            if (ownerListIn(j) == -i) numToRecv = numToRecv + 1
+         end do
+         if (numToRecv &gt; 0) then
+            allocate(recvListPtr % next)
+            recvListPtr =&gt; recvListPtr % next
+            recvListPtr % procID = i
+            recvListPtr % nlist = numToRecv
+            allocate(recvListPtr % list(numToRecv))
+            nullify(recvListPtr % next)
+            kk = 1
+            do j=1,nNeededList
+               if (ownerListIn(j) == -i) then
+                  recvListPtr % list(kk) = j
+                  kk = kk + 1
+               end if
+            end do
+         end if
+
+      end do
+
+      deallocate(ownerListIn)
+      deallocate(ownerListOut)
+
+      sendListPtr =&gt; sendList
+      sendList =&gt; sendList % next
+      deallocate(sendListPtr)
+
+      recvListPtr =&gt; recvList
+      recvList =&gt; recvList % next
+      deallocate(recvListPtr)
+
+#else
+      allocate(recvList)
+      recvList % procID = dminfo % my_proc_id
+      recvList % nlist = nNeededList
+      allocate(recvList % list(nNeededList))
+      nullify(recvList % next)
+      do j=1,nNeededList
+         recvList % list(j) = j
+      end do
+
+      allocate(sendList)
+      sendList % procID = dminfo % my_proc_id
+      sendList % nlist = nOwnedList
+      allocate(sendList % list(nOwnedList))
+      nullify(sendList % next)
+      do j=1,nOwnedList
+         sendList % list(j) = j
+      end do
+#endif
+
+   end subroutine mpas_dmpar_get_owner_list
+
+
+   subroutine mpas_dmpar_alltoall_field1d_integer(dminfo, arrayIn, arrayOut, nOwnedList, nNeededList, sendList, recvList)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, dimension(*), intent(in) :: arrayIn
+      integer, dimension(*), intent(inout) :: arrayOut
+      integer, intent(in) :: nOwnedList, nNeededList
+      type (exchange_list), pointer :: sendList, recvList
+
+      type (exchange_list), pointer :: sendListPtr, recvListPtr
+      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+      integer :: mpi_ierr
+      integer :: i
+
+#ifdef _MPI
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID == dminfo % my_proc_id) exit
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID == dminfo % my_proc_id) exit
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      if (associated(recvListPtr) .and. associated(sendListPtr)) then
+         do i=1,recvListPtr % nlist
+            arrayOut(recvListPtr % list(i)) = arrayIn(sendListPtr % list(i))
+         end do
+      end if
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            allocate(recvListPtr % ibuffer(recvListPtr % nlist))
+            call MPI_Irecv(recvListPtr % ibuffer, recvListPtr % nlist, MPI_INTEGERKIND, &amp;
+                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            allocate(sendListPtr % ibuffer(sendListPtr % nlist))
+            call mpas_pack_send_buf1d_integer(nOwnedList, arrayIn, sendListPtr, 1, sendListPtr % nlist, &amp;
+                                   sendListPtr % ibuffer, nPacked, lastPackedIdx)
+            call MPI_Isend(sendListPtr % ibuffer, sendListPtr % nlist, MPI_INTEGERKIND, &amp;
+                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            call mpas_unpack_recv_buf1d_integer(nNeededList, arrayOut, recvListPtr, 1, recvListPtr % nlist, &amp;
+                                     recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
+            deallocate(recvListPtr % ibuffer)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            deallocate(sendListPtr % ibuffer)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+#else
+      if (nOwnedList /= nNeededList) then
+         write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, ', &amp;
+           'arrayIn and arrayOut dims must match.'
+         call mpas_dmpar_abort(dminfo)
+      else
+         arrayOut(1:nNeededList) = arrayIn(1:nOwnedList)
+      end if
+#endif
+
+   end subroutine mpas_dmpar_alltoall_field1d_integer
+
+
+   subroutine mpas_dmpar_alltoall_field2d_integer(dminfo, arrayIn, arrayOut, dim1, nOwnedList, nNeededList, sendList, recvList)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: dim1, nOwnedList, nNeededList
+      integer, dimension(dim1,*), intent(in) :: arrayIn
+      integer, dimension(dim1,*), intent(inout) :: arrayOut
+      type (exchange_list), pointer :: sendList, recvList
+
+      type (exchange_list), pointer :: sendListPtr, recvListPtr
+      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+      integer :: mpi_ierr
+      integer :: i, d2
+
+#ifdef _MPI
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID == dminfo % my_proc_id) exit
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID == dminfo % my_proc_id) exit
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      if (associated(recvListPtr) .and. associated(sendListPtr)) then
+         do i=1,recvListPtr % nlist
+            arrayOut(:,recvListPtr % list(i)) = arrayIn(:,sendListPtr % list(i))
+         end do
+      end if
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            d2 = dim1 * recvListPtr % nlist
+            allocate(recvListPtr % ibuffer(d2))
+            call MPI_Irecv(recvListPtr % ibuffer, d2, MPI_INTEGERKIND, &amp;
+                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            d2 = dim1 * sendListPtr % nlist
+            allocate(sendListPtr % ibuffer(d2))
+            call mpas_pack_send_buf2d_integer(1, dim1, nOwnedList, arrayIn, sendListPtr, 1, d2, &amp;
+                                   sendListPtr % ibuffer, nPacked, lastPackedIdx)
+            call MPI_Isend(sendListPtr % ibuffer, d2, MPI_INTEGERKIND, &amp;
+                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            d2 = dim1 * recvListPtr % nlist
+            call mpas_unpack_recv_buf2d_integer(1, dim1, nNeededList, arrayOut, recvListPtr, 1, d2, &amp;
+                                     recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
+            deallocate(recvListPtr % ibuffer)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            deallocate(sendListPtr % ibuffer)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+#else
+      if (nOwnedList /= nNeededList) then
+         write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, ', &amp;
+           'arrayIn and arrayOut dims must match.'
+         call mpas_dmpar_abort(dminfo)
+      else
+         arrayOut(:,1:nNeededList) = arrayIn(:,1:nOwnedList)
+      end if
+#endif
+
+   end subroutine mpas_dmpar_alltoall_field2d_integer
+
+
+   subroutine mpas_dmpar_alltoall_field1d_real(dminfo, arrayIn, arrayOut, nOwnedList, nNeededList, sendList, recvList)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      real (kind=RKIND), dimension(*), intent(in) :: arrayIn
+      real (kind=RKIND), dimension(*), intent(inout) :: arrayOut
+      integer, intent(in) :: nOwnedList, nNeededList
+      type (exchange_list), pointer :: sendList, recvList
+
+      type (exchange_list), pointer :: sendListPtr, recvListPtr
+      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+      integer :: mpi_ierr
+      integer :: i
+
+#ifdef _MPI
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID == dminfo % my_proc_id) exit
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID == dminfo % my_proc_id) exit
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      if (associated(recvListPtr) .and. associated(sendListPtr)) then
+         do i=1,recvListPtr % nlist
+            arrayOut(recvListPtr % list(i)) = arrayIn(sendListPtr % list(i))
+         end do
+      end if
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            allocate(recvListPtr % rbuffer(recvListPtr % nlist))
+            call MPI_Irecv(recvListPtr % rbuffer, recvListPtr % nlist, MPI_REALKIND, &amp;
+                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            allocate(sendListPtr % rbuffer(sendListPtr % nlist))
+            call mpas_pack_send_buf1d_real(nOwnedList, arrayIn, sendListPtr, 1, sendListPtr % nlist, &amp;
+                                   sendListPtr % rbuffer, nPacked, lastPackedIdx)
+            call MPI_Isend(sendListPtr % rbuffer, sendListPtr % nlist, MPI_REALKIND, &amp;
+                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            call mpas_unpack_recv_buf1d_real(nNeededList, arrayOut, recvListPtr, 1, recvListPtr % nlist, &amp;
+                                     recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
+            deallocate(recvListPtr % rbuffer)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            deallocate(sendListPtr % rbuffer)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+#else
+      if (nOwnedList /= nNeededList) then
+         write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, ', &amp;
+           'arrayIn and arrayOut dims must match.'
+         call mpas_dmpar_abort(dminfo)
+      else
+         arrayOut(1:nNeededList) = arrayIn(1:nOwnedList)
+      end if
+#endif
+
+   end subroutine mpas_dmpar_alltoall_field1d_real
+
+
+   subroutine mpas_dmpar_alltoall_field2d_real(dminfo, arrayIn, arrayOut, dim1, nOwnedList, nNeededList, sendList, recvList)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: dim1, nOwnedList, nNeededList
+      real (kind=RKIND), dimension(dim1,*), intent(in) :: arrayIn
+      real (kind=RKIND), dimension(dim1,*), intent(inout) :: arrayOut
+      type (exchange_list), pointer :: sendList, recvList
+
+      type (exchange_list), pointer :: sendListPtr, recvListPtr
+      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+      integer :: mpi_ierr
+      integer :: i, d2
+
+#ifdef _MPI
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID == dminfo % my_proc_id) exit
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID == dminfo % my_proc_id) exit
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      if (associated(recvListPtr) .and. associated(sendListPtr)) then
+         do i=1,recvListPtr % nlist
+            arrayOut(:,recvListPtr % list(i)) = arrayIn(:,sendListPtr % list(i))
+         end do
+      end if
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            d2 = dim1 * recvListPtr % nlist
+            allocate(recvListPtr % rbuffer(d2))
+            call MPI_Irecv(recvListPtr % rbuffer, d2, MPI_REALKIND, &amp;
+                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            d2 = dim1 * sendListPtr % nlist
+            allocate(sendListPtr % rbuffer(d2))
+            call mpas_pack_send_buf2d_real(1, dim1, nOwnedList, arrayIn, sendListPtr, 1, d2, &amp;
+                                   sendListPtr % rbuffer, nPacked, lastPackedIdx)
+            call MPI_Isend(sendListPtr % rbuffer, d2, MPI_REALKIND, &amp;
+                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            d2 = dim1 * recvListPtr % nlist
+            call mpas_unpack_recv_buf2d_real(1, dim1, nNeededList, arrayOut, recvListPtr, 1, d2, &amp;
+                                     recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
+            deallocate(recvListPtr % rbuffer)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            deallocate(sendListPtr % rbuffer)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+#else
+      if (nOwnedList /= nNeededList) then
+         write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, ', &amp;
+           'arrayIn and arrayOut dims must match.'
+         call mpas_dmpar_abort(dminfo)
+      else
+         arrayOut(:,1:nNeededList) = arrayIn(:,1:nOwnedList)
+      end if
+#endif
+
+   end subroutine mpas_dmpar_alltoall_field2d_real
+
+  
+   subroutine mpas_dmpar_alltoall_field3d_real(dminfo, arrayIn, arrayOut, dim1, dim2, nOwnedList, nNeededList, sendList, recvList)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: dim1, dim2, nOwnedList, nNeededList
+      real (kind=RKIND), dimension(dim1,dim2,*), intent(in) :: arrayIn
+      real (kind=RKIND), dimension(dim1,dim2,*), intent(inout) :: arrayOut
+      type (exchange_list), pointer :: sendList, recvList
+
+      type (exchange_list), pointer :: sendListPtr, recvListPtr
+      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+      integer :: mpi_ierr
+      integer :: i, d3
+
+#ifdef _MPI
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID == dminfo % my_proc_id) exit
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID == dminfo % my_proc_id) exit
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      if (associated(recvListPtr) .and. associated(sendListPtr)) then
+         do i=1,recvListPtr % nlist
+            arrayOut(:,:,recvListPtr % list(i)) = arrayIn(:,:,sendListPtr % list(i))
+         end do
+      end if
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            d3 = dim1 * dim2 * recvListPtr % nlist
+            allocate(recvListPtr % rbuffer(d3))
+            call MPI_Irecv(recvListPtr % rbuffer, d3, MPI_REALKIND, &amp;
+                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            d3 = dim1 * dim2 * sendListPtr % nlist
+            allocate(sendListPtr % rbuffer(d3))
+            call mpas_pack_send_buf3d_real(1, dim1, 1, dim2, nOwnedList, arrayIn, sendListPtr, 1, d3, &amp;
+                                   sendListPtr % rbuffer, nPacked, lastPackedIdx)
+            call MPI_Isend(sendListPtr % rbuffer, d3, MPI_REALKIND, &amp;
+                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            d3 = dim1 * dim2 * recvListPtr % nlist
+            call mpas_unpack_recv_buf3d_real(1, dim1, 1, dim2, nNeededList, arrayOut, recvListPtr, 1, d3, &amp;
+                                     recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
+            deallocate(recvListPtr % rbuffer)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            deallocate(sendListPtr % rbuffer)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+#else
+      if (nOwnedList /= nNeededList) then
+         write(0,*) 'Error in dmpar_alltoall_field: For non-dmpar, ', &amp;
+           'arrayIn and arrayOut dims must match.'
+         call mpas_dmpar_abort(dminfo)
+      else
+         arrayOut(:,:,1:nNeededList) = arrayIn(:,:,1:nOwnedList)
+      end if
+#endif
+
+   end subroutine mpas_dmpar_alltoall_field3d_real
+
+  
+   subroutine mpas_pack_send_buf1d_integer(nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)
+
+      implicit none
+
+      integer, intent(in) :: nField, nBuffer, startPackIdx
+      integer, dimension(*), intent(in) :: field
+      type (exchange_list), intent(in) :: sendList
+      integer, dimension(nBuffer), intent(out) :: buffer
+      integer, intent(inout) :: nPacked, lastPackedIdx
+
+      integer :: i
+
+      nPacked = 0
+      do i=startPackIdx, sendList % nlist
+         nPacked = nPacked + 1
+         if (nPacked &gt; nBuffer) then
+            nPacked = nPacked - 1
+            lastPackedIdx = i - 1
+            return
+         end if
+         buffer(nPacked) = field(sendList % list(i))
+      end do
+      lastPackedIdx = sendList % nlist
+
+   end subroutine mpas_pack_send_buf1d_integer
+
+
+   subroutine mpas_pack_send_buf2d_integer(ds, de, nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)
+
+      implicit none
+
+      integer, intent(in) :: ds, de, nField, nBuffer, startPackIdx
+      integer, dimension(ds:de,*), intent(in) :: field
+      type (exchange_list), intent(in) :: sendList
+      integer, dimension(nBuffer), intent(out) :: buffer
+      integer, intent(inout) :: nPacked, lastPackedIdx
+
+      integer :: i, n
+
+      n = de-ds+1
+
+      if (n &gt; nBuffer) then
+         write(0,*) 'packSendBuf2dInteger: Not enough space in buffer', &amp;
+          ' to fit a single slice.'
+         return
+      end if
+
+      nPacked = 0
+      do i=startPackIdx, sendList % nlist
+         nPacked = nPacked + n
+         if (nPacked &gt; nBuffer) then
+            nPacked = nPacked - n
+            lastPackedIdx = i - 1
+            return
+         end if
+         buffer(nPacked-n+1:nPacked) = field(ds:de,sendList % list(i))
+      end do
+      lastPackedIdx = sendList % nlist
+
+   end subroutine mpas_pack_send_buf2d_integer
+
+
+   subroutine mpas_pack_send_buf3d_integer(d1s, d1e, d2s, d2e, nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)
+
+      implicit none
+
+      integer, intent(in) :: d1s, d1e, d2s, d2e, nField, nBuffer, startPackIdx
+      integer, dimension(d1s:d1e,d2s:d2e,*), intent(in) :: field
+      type (exchange_list), intent(in) :: sendList
+      integer, dimension(nBuffer), intent(out) :: buffer
+      integer, intent(inout) :: nPacked, lastPackedIdx
+
+      integer :: i, j, k, n
+
+      n = (d1e-d1s+1) * (d2e-d2s+1)
+
+      if (n &gt; nBuffer) then
+         write(0,*) 'packSendBuf3dInteger: Not enough space in buffer', &amp;
+          ' to fit a single slice.'
+         return
+      end if
+
+      nPacked = 0
+      do i=startPackIdx, sendList % nlist
+         nPacked = nPacked + n
+         if (nPacked &gt; nBuffer) then
+            nPacked = nPacked - n
+            lastPackedIdx = i - 1
+            return
+         end if
+         k = nPacked-n+1
+         do j=d2s,d2e
+            buffer(k:k+d1e-d1s) = field(d1s:d1e,j,sendList % list(i))
+            k = k + d1e-d1s+1
+         end do
+      end do
+      lastPackedIdx = sendList % nlist
+
+   end subroutine mpas_pack_send_buf3d_integer
+
+
+   subroutine mpas_pack_send_buf1d_real(nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)
+
+      implicit none
+
+      integer, intent(in) :: nField, nBuffer, startPackIdx
+      real (kind=RKIND), dimension(*), intent(in) :: field
+      type (exchange_list), intent(in) :: sendList
+      real (kind=RKIND), dimension(nBuffer), intent(out) :: buffer
+      integer, intent(inout) :: nPacked, lastPackedIdx
+
+      integer :: i
+
+      nPacked = 0
+      do i=startPackIdx, sendList % nlist
+         nPacked = nPacked + 1
+         if (nPacked &gt; nBuffer) then
+            nPacked = nPacked - 1
+            lastPackedIdx = i - 1
+            return
+         end if
+         buffer(nPacked) = field(sendList % list(i))
+      end do
+      lastPackedIdx = sendList % nlist
+
+   end subroutine mpas_pack_send_buf1d_real
+
+
+   subroutine mpas_pack_send_buf2d_real(ds, de, nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)
+
+      implicit none
+
+      integer, intent(in) :: ds, de, nField, nBuffer, startPackIdx
+      real (kind=RKIND), dimension(ds:de,*), intent(in) :: field
+      type (exchange_list), intent(in) :: sendList
+      real (kind=RKIND), dimension(nBuffer), intent(out) :: buffer
+      integer, intent(inout) :: nPacked, lastPackedIdx
+
+      integer :: i, n
+
+      n = de-ds+1
+
+      if (n &gt; nBuffer) then
+         write(0,*) 'packSendBuf2dReal: Not enough space in buffer', &amp;
+          ' to fit a single slice.'
+         return
+      end if
+
+      nPacked = 0
+      do i=startPackIdx, sendList % nlist
+         nPacked = nPacked + n
+         if (nPacked &gt; nBuffer) then
+            nPacked = nPacked - n
+            lastPackedIdx = i - 1
+            return
+         end if
+         buffer(nPacked-n+1:nPacked) = field(ds:de,sendList % list(i))
+      end do
+      lastPackedIdx = sendList % nlist
+
+   end subroutine mpas_pack_send_buf2d_real
+
+
+   subroutine mpas_pack_send_buf3d_real(d1s, d1e, d2s, d2e, nField, field, sendList, startPackIdx, nBuffer, buffer, nPacked, lastPackedIdx)
+
+      implicit none
+
+      integer, intent(in) :: d1s, d1e, d2s, d2e, nField, nBuffer, startPackIdx
+      real (kind=RKIND), dimension(d1s:d1e,d2s:d2e,*), intent(in) :: field
+      type (exchange_list), intent(in) :: sendList
+      real (kind=RKIND), dimension(nBuffer), intent(out) :: buffer
+      integer, intent(inout) :: nPacked, lastPackedIdx
+
+      integer :: i, j, k, n
+
+      n = (d1e-d1s+1) * (d2e-d2s+1)
+
+      if (n &gt; nBuffer) then
+         write(0,*) 'packSendBuf3dReal: Not enough space in buffer', &amp;
+          ' to fit a single slice.'
+         return
+      end if
+
+      nPacked = 0
+      do i=startPackIdx, sendList % nlist
+         nPacked = nPacked + n
+         if (nPacked &gt; nBuffer) then
+            nPacked = nPacked - n
+            lastPackedIdx = i - 1
+            return
+         end if
+         k = nPacked-n+1
+         do j=d2s,d2e
+            buffer(k:k+d1e-d1s) = field(d1s:d1e,j,sendList % list(i))
+            k = k + d1e-d1s+1
+         end do
+      end do
+      lastPackedIdx = sendList % nlist
+
+   end subroutine mpas_pack_send_buf3d_real
+
+
+   subroutine mpas_unpack_recv_buf1d_integer(nField, field, recvList, startUnpackIdx, nBuffer, buffer, nUnpacked, lastUnpackedIdx)
+
+      implicit none
+
+      integer, intent(in) :: nField, nBuffer, startUnpackIdx
+      integer, dimension(*), intent(inout) :: field
+      type (exchange_list), intent(in) :: recvList
+      integer, dimension(nBuffer), intent(in) :: buffer
+      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
+
+      integer :: i
+
+      nUnpacked = 0
+      do i=startUnpackIdx, recvList % nlist
+         nUnpacked = nUnpacked + 1
+         if (nUnpacked &gt; nBuffer) then
+            nUnpacked = nUnpacked - 1
+            lastUnpackedIdx = i - 1
+            return
+         end if
+         field(recvList % list(i)) = buffer(nUnpacked)
+      end do
+      lastUnpackedIdx = recvList % nlist
+
+   end subroutine mpas_unpack_recv_buf1d_integer
+
+
+   subroutine mpas_unpack_recv_buf2d_integer(ds, de, nField, field, recvList, startUnpackIdx, nBuffer, buffer, nUnpacked, lastUnpackedIdx)
+
+      implicit none
+
+      integer, intent(in) :: ds, de, nField, nBuffer, startUnpackIdx
+      integer, dimension(ds:de,*), intent(inout) :: field
+      type (exchange_list), intent(in) :: recvList
+      integer, dimension(nBuffer), intent(in) :: buffer
+      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
+
+      integer :: i, n
+
+      n = de-ds+1
+
+      nUnpacked = 0
+      do i=startUnpackIdx, recvList % nlist
+         nUnpacked = nUnpacked + n
+         if (nUnpacked &gt; nBuffer) then
+            nUnpacked = nUnpacked - n
+            lastUnpackedIdx = i - 1
+            return
+         end if
+         field(ds:de,recvList % list(i)) = buffer(nUnpacked-n+1:nUnpacked)
+      end do
+      lastUnpackedIdx = recvList % nlist
+
+   end subroutine mpas_unpack_recv_buf2d_integer
+
+
+   subroutine mpas_unpack_recv_buf3d_integer(d1s, d1e, d2s, d2e, nField, field, recvList, startUnpackIdx, nBuffer, buffer, &amp;
+                                  nUnpacked, lastUnpackedIdx)
+
+      implicit none
+
+      integer, intent(in) :: d1s, d1e, d2s, d2e, nField, nBuffer, startUnpackIdx
+      integer, dimension(d1s:d1e,d2s:d2e,*), intent(inout) :: field
+      type (exchange_list), intent(in) :: recvList
+      integer, dimension(nBuffer), intent(in) :: buffer
+      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
+
+      integer :: i, j, k, n
+
+      n = (d1e-d1s+1) * (d2e-d2s+1)
+
+      nUnpacked = 0
+      do i=startUnpackIdx, recvList % nlist
+         nUnpacked = nUnpacked + n
+         if (nUnpacked &gt; nBuffer) then
+            nUnpacked = nUnpacked - n
+            lastUnpackedIdx = i - 1
+            return
+         end if
+         k = nUnpacked-n+1
+         do j=d2s,d2e
+            field(d1s:d1e,j,recvList % list(i)) = buffer(k:k+d1e-d1s)
+            k = k + d1e-d1s+1
+         end do
+      end do
+      lastUnpackedIdx = recvList % nlist
+
+   end subroutine mpas_unpack_recv_buf3d_integer
+
+
+   subroutine mpas_dmpar_exch_halo_field1d_integer(dminfo, array, dim1, sendList, recvList)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: dim1
+      integer, dimension(*), intent(inout) :: array
+      type (exchange_list), pointer :: sendList, recvList
+
+      type (exchange_list), pointer :: sendListPtr, recvListPtr
+      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+      integer :: mpi_ierr
+
+#ifdef _MPI
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            allocate(recvListPtr % ibuffer(recvListPtr % nlist))
+            call MPI_Irecv(recvListPtr % ibuffer, recvListPtr % nlist, MPI_INTEGERKIND, &amp;
+                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+      
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            allocate(sendListPtr % ibuffer(sendListPtr % nlist))
+            call mpas_pack_send_buf1d_integer(dim1, array, sendListPtr, 1, sendListPtr % nlist, sendListPtr % ibuffer, nPacked, lastPackedIdx)
+            call MPI_Isend(sendListPtr % ibuffer, sendListPtr % nlist, MPI_INTEGERKIND, &amp;
+                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            call mpas_unpack_recv_buf1d_integer(dim1, array, recvListPtr, 1, recvListPtr % nlist, recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
+            deallocate(recvListPtr % ibuffer)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+      
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            deallocate(sendListPtr % ibuffer)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+#endif
+
+   end subroutine mpas_dmpar_exch_halo_field1d_integer
+
+
+   subroutine mpas_dmpar_exch_halo_field2d_integer(dminfo, array, dim1, dim2, sendList, recvList)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: dim1, dim2
+      integer, dimension(dim1,*), intent(inout) :: array
+      type (exchange_list), pointer :: sendList, recvList
+
+      type (exchange_list), pointer :: sendListPtr, recvListPtr
+      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+      integer :: mpi_ierr
+      integer :: d2
+
+#ifdef _MPI
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            d2 = dim1 * recvListPtr % nlist
+            allocate(recvListPtr % ibuffer(d2))
+            call MPI_Irecv(recvListPtr % ibuffer, d2, MPI_INTEGERKIND, &amp;
+                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+      
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            d2 = dim1 * sendListPtr % nlist
+            allocate(sendListPtr % ibuffer(d2))
+            call mpas_pack_send_buf2d_integer(1, dim1, dim2, array, sendListPtr, 1, d2, sendListPtr % ibuffer, nPacked, lastPackedIdx)
+            call MPI_Isend(sendListPtr % ibuffer, d2, MPI_INTEGERKIND, &amp;
+                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            d2 = dim1 * recvListPtr % nlist
+            call mpas_unpack_recv_buf2d_integer(1, dim1, dim2, array, recvListPtr, 1, d2, recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
+            deallocate(recvListPtr % ibuffer)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+      
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            deallocate(sendListPtr % ibuffer)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+#endif
+
+   end subroutine mpas_dmpar_exch_halo_field2d_integer
+
+
+   subroutine mpas_dmpar_exch_halo_field3d_integer(dminfo, array, dim1, dim2, dim3, sendList, recvList)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: dim1, dim2, dim3
+      integer, dimension(dim1,dim2,*), intent(inout) :: array
+      type (exchange_list), pointer :: sendList, recvList
+
+      type (exchange_list), pointer :: sendListPtr, recvListPtr
+      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+      integer :: mpi_ierr
+      integer :: d3
+
+#ifdef _MPI
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            d3 = dim1 * dim2 * recvListPtr % nlist
+            allocate(recvListPtr % ibuffer(d3))
+            call MPI_Irecv(recvListPtr % ibuffer, d3, MPI_INTEGERKIND, &amp;
+                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            d3 = dim1 * dim2 * sendListPtr % nlist
+            allocate(sendListPtr % ibuffer(d3))
+            call mpas_pack_send_buf3d_integer(1, dim1, 1, dim2, dim3, array, sendListPtr, 1, d3, &amp;
+                                   sendListPtr % ibuffer, nPacked, lastPackedIdx)
+            call MPI_Isend(sendListPtr % ibuffer, d3, MPI_INTEGERKIND, &amp;
+                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            d3 = dim1 * dim2 * recvListPtr % nlist
+            call mpas_unpack_recv_buf3d_integer(1, dim1, 1, dim2, dim3, array, recvListPtr, 1, d3, &amp;
+                                     recvListPtr % ibuffer, nUnpacked, lastUnpackedIdx)
+            deallocate(recvListPtr % ibuffer)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            deallocate(sendListPtr % ibuffer)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+#endif
+
+   end subroutine mpas_dmpar_exch_halo_field3d_integer
+
+  
+   subroutine mpas_unpack_recv_buf1d_real(nField, field, recvList, startUnpackIdx, nBuffer, buffer, nUnpacked, lastUnpackedIdx)
+
+      implicit none
+
+      integer, intent(in) :: nField, nBuffer, startUnpackIdx
+      real (kind=RKIND), dimension(*), intent(inout) :: field
+      type (exchange_list), intent(in) :: recvList
+      real (kind=RKIND), dimension(nBuffer), intent(in) :: buffer
+      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
+
+      integer :: i
+
+      nUnpacked = 0
+      do i=startUnpackIdx, recvList % nlist
+         nUnpacked = nUnpacked + 1
+         if (nUnpacked &gt; nBuffer) then
+            nUnpacked = nUnpacked - 1
+            lastUnpackedIdx = i - 1
+            return
+         end if
+         field(recvList % list(i)) = buffer(nUnpacked)
+      end do
+      lastUnpackedIdx = recvList % nlist
+
+   end subroutine mpas_unpack_recv_buf1d_real
+
+
+   subroutine mpas_unpack_recv_buf2d_real(ds, de, nField, field, recvList, startUnpackIdx, nBuffer, buffer, nUnpacked, lastUnpackedIdx)
+
+      implicit none
+
+      integer, intent(in) :: ds, de, nField, nBuffer, startUnpackIdx
+      real (kind=RKIND), dimension(ds:de,*), intent(inout) :: field
+      type (exchange_list), intent(in) :: recvList
+      real (kind=RKIND), dimension(nBuffer), intent(in) :: buffer
+      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
+
+      integer :: i, n
+
+      n = de-ds+1
+
+      nUnpacked = 0
+      do i=startUnpackIdx, recvList % nlist
+         nUnpacked = nUnpacked + n
+         if (nUnpacked &gt; nBuffer) then
+            nUnpacked = nUnpacked - n
+            lastUnpackedIdx = i - 1
+            return
+         end if
+         field(ds:de,recvList % list(i)) = buffer(nUnpacked-n+1:nUnpacked)
+      end do
+      lastUnpackedIdx = recvList % nlist
+
+   end subroutine mpas_unpack_recv_buf2d_real
+
+
+   subroutine mpas_unpack_recv_buf3d_real(d1s, d1e, d2s, d2e, nField, field, recvList, startUnpackIdx, nBuffer, buffer, &amp;
+                                  nUnpacked, lastUnpackedIdx)
+
+      implicit none
+
+      integer, intent(in) :: d1s, d1e, d2s, d2e, nField, nBuffer, startUnpackIdx
+      real (kind=RKIND), dimension(d1s:d1e,d2s:d2e,*), intent(inout) :: field
+      type (exchange_list), intent(in) :: recvList
+      real (kind=RKIND), dimension(nBuffer), intent(in) :: buffer
+      integer, intent(inout) :: nUnpacked, lastUnpackedIdx
+
+      integer :: i, j, k, n
+
+      n = (d1e-d1s+1) * (d2e-d2s+1)
+
+      nUnpacked = 0
+      do i=startUnpackIdx, recvList % nlist
+         nUnpacked = nUnpacked + n
+         if (nUnpacked &gt; nBuffer) then
+            nUnpacked = nUnpacked - n
+            lastUnpackedIdx = i - 1
+            return
+         end if
+         k = nUnpacked-n+1
+         do j=d2s,d2e
+            field(d1s:d1e,j,recvList % list(i)) = buffer(k:k+d1e-d1s)
+            k = k + d1e-d1s+1
+         end do
+      end do
+      lastUnpackedIdx = recvList % nlist
+
+   end subroutine mpas_unpack_recv_buf3d_real
+
+
+   subroutine mpas_dmpar_exch_halo_field1d_real(dminfo, array, dim1, sendList, recvList)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: dim1
+      real (kind=RKIND), dimension(*), intent(inout) :: array
+      type (exchange_list), pointer :: sendList, recvList
+
+      type (exchange_list), pointer :: sendListPtr, recvListPtr
+      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+      integer :: mpi_ierr
+
+#ifdef _MPI
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            allocate(recvListPtr % rbuffer(recvListPtr % nlist))
+            call MPI_Irecv(recvListPtr % rbuffer, recvListPtr % nlist, MPI_REALKIND, &amp;
+                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+      
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            allocate(sendListPtr % rbuffer(sendListPtr % nlist))
+            call mpas_pack_send_buf1d_real(dim1, array, sendListPtr, 1, sendListPtr % nlist, sendListPtr % rbuffer, nPacked, lastPackedIdx)
+            call MPI_Isend(sendListPtr % rbuffer, sendListPtr % nlist, MPI_REALKIND, &amp;
+                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            call mpas_unpack_recv_buf1d_real(dim1, array, recvListPtr, 1, recvListPtr % nlist, recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
+            deallocate(recvListPtr % rbuffer)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+      
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            deallocate(sendListPtr % rbuffer)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+#endif
+
+   end subroutine mpas_dmpar_exch_halo_field1d_real
+
+
+   subroutine mpas_dmpar_exch_halo_field2d_real(dminfo, array, dim1, dim2, sendList, recvList)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: dim1, dim2
+      real (kind=RKIND), dimension(dim1,*), intent(inout) :: array
+      type (exchange_list), pointer :: sendList, recvList
+
+      type (exchange_list), pointer :: sendListPtr, recvListPtr
+      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+      integer :: mpi_ierr
+      integer :: d2
+
+#ifdef _MPI
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            d2 = dim1 * recvListPtr % nlist
+            allocate(recvListPtr % rbuffer(d2))
+            call MPI_Irecv(recvListPtr % rbuffer, d2, MPI_REALKIND, &amp;
+                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+      
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            d2 = dim1 * sendListPtr % nlist
+            allocate(sendListPtr % rbuffer(d2))
+            call mpas_pack_send_buf2d_real(1, dim1, dim2, array, sendListPtr, 1, d2, sendListPtr % rbuffer, nPacked, lastPackedIdx)
+            call MPI_Isend(sendListPtr % rbuffer, d2, MPI_REALKIND, &amp;
+                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            d2 = dim1 * recvListPtr % nlist
+            call mpas_unpack_recv_buf2d_real(1, dim1, dim2, array, recvListPtr, 1, d2, recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
+            deallocate(recvListPtr % rbuffer)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+      
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            deallocate(sendListPtr % rbuffer)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+#endif
+
+   end subroutine mpas_dmpar_exch_halo_field2d_real
+
+
+   subroutine mpas_dmpar_exch_halo_field3d_real(dminfo, array, dim1, dim2, dim3, sendList, recvList)
+
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      integer, intent(in) :: dim1, dim2, dim3
+      real (kind=RKIND), dimension(dim1,dim2,*), intent(inout) :: array
+      type (exchange_list), pointer :: sendList, recvList
+
+      type (exchange_list), pointer :: sendListPtr, recvListPtr
+      integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
+      integer :: mpi_ierr
+      integer :: d3
+
+#ifdef _MPI
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            d3 = dim1 * dim2 * recvListPtr % nlist
+            allocate(recvListPtr % rbuffer(d3))
+            call MPI_Irecv(recvListPtr % rbuffer, d3, MPI_REALKIND, &amp;
+                           recvListPtr % procID, recvListPtr % procID, dminfo % comm, recvListPtr % reqID, mpi_ierr)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            d3 = dim1 * dim2 * sendListPtr % nlist
+            allocate(sendListPtr % rbuffer(d3))
+            call mpas_pack_send_buf3d_real(1, dim1, 1, dim2, dim3, array, sendListPtr, 1, d3, &amp;
+                                   sendListPtr % rbuffer, nPacked, lastPackedIdx)
+            call MPI_Isend(sendListPtr % rbuffer, d3, MPI_REALKIND, &amp;
+                           sendListPtr % procID, dminfo % my_proc_id, dminfo % comm, sendListPtr % reqID, mpi_ierr)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+      recvListPtr =&gt; recvList
+      do while (associated(recvListPtr))
+         if (recvListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(recvListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            d3 = dim1 * dim2 * recvListPtr % nlist
+            call mpas_unpack_recv_buf3d_real(1, dim1, 1, dim2, dim3, array, recvListPtr, 1, d3, &amp;
+                                     recvListPtr % rbuffer, nUnpacked, lastUnpackedIdx)
+            deallocate(recvListPtr % rbuffer)
+         end if
+         recvListPtr =&gt; recvListPtr % next
+      end do
+
+      sendListPtr =&gt; sendList
+      do while (associated(sendListPtr))
+         if (sendListPtr % procID /= dminfo % my_proc_id) then
+            call MPI_Wait(sendListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr)
+            deallocate(sendListPtr % rbuffer)
+         end if
+         sendListPtr =&gt; sendListPtr % next
+      end do
+
+#endif
+
+   end subroutine mpas_dmpar_exch_halo_field3d_real
+
+
+end module mpas_dmpar

Copied: branches/source_condensing/src/framework/mpas_framework.F (from rev 1114, trunk/mpas/src/framework/mpas_framework.F)
===================================================================
--- branches/source_condensing/src/framework/mpas_framework.F                                (rev 0)
+++ branches/source_condensing/src/framework/mpas_framework.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,49 @@
+module mpas_framework
+
+   use mpas_dmpar
+   use mpas_grid_types
+   use mpas_io_input
+   use mpas_io_output
+   use mpas_configure
+   use mpas_timer
+   use mpas_timekeeping
+
+
+   contains
+
+   
+   subroutine mpas_framework_init(dminfo, domain)
+
+      implicit none
+
+      type (dm_info), pointer :: dminfo
+      type (domain_type), pointer :: domain
+
+      allocate(dminfo)
+      call mpas_dmpar_init(dminfo)
+
+      call mpas_read_namelist(dminfo)
+
+      call mpas_allocate_domain(domain, dminfo)
+      
+      call mpas_timekeeping_init(config_calendar_type)
+
+   end subroutine mpas_framework_init
+
+   
+   subroutine mpas_framework_finalize(dminfo, domain)
+  
+      implicit none
+
+      type (dm_info), pointer :: dminfo
+      type (domain_type), pointer :: domain
+
+      call mpas_deallocate_domain(domain)
+
+      call mpas_dmpar_finalize(dminfo)
+
+      call mpas_timekeeping_finalize()
+
+   end subroutine mpas_framework_finalize
+
+end module mpas_framework

Copied: branches/source_condensing/src/framework/mpas_grid_types.F (from rev 1114, trunk/mpas/src/framework/mpas_grid_types.F)
===================================================================
--- branches/source_condensing/src/framework/mpas_grid_types.F                                (rev 0)
+++ branches/source_condensing/src/framework/mpas_grid_types.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,219 @@
+module mpas_grid_types
+
+   use mpas_dmpar
+
+   integer, parameter :: nTimeLevs = 2
+
+
+   ! Derived type describing info for doing I/O specific to a field
+   type io_info
+      character (len=1024) :: fieldName
+      integer, dimension(4) :: start
+      integer, dimension(4) :: count
+      logical :: input
+      logical :: sfc
+      logical :: restart
+      logical :: output
+   end type io_info
+
+
+   ! Derived type for storing fields
+   type field3DReal
+      type (block_type), pointer :: block
+      real (kind=RKIND), dimension(:,:,:), pointer :: array
+      type (io_info), pointer :: ioinfo
+   end type field3DReal
+
+
+   ! Derived type for storing fields
+   type field2DReal
+      type (block_type), pointer :: block
+      real (kind=RKIND), dimension(:,:), pointer :: array
+      type (io_info), pointer :: ioinfo
+   end type field2DReal
+
+
+   ! Derived type for storing fields
+   type field1DReal
+      type (block_type), pointer :: block
+      real (kind=RKIND), dimension(:), pointer :: array
+      type (io_info), pointer :: ioinfo
+   end type field1DReal
+
+
+   ! Derived type for storing fields
+   type field0DReal
+      type (block_type), pointer :: block
+      real (kind=RKIND) :: scalar
+      type (io_info), pointer :: ioinfo
+   end type field0DReal
+
+
+   ! Derived type for storing fields
+   type field2DInteger
+      type (block_type), pointer :: block
+      integer, dimension(:,:), pointer :: array
+      type (io_info), pointer :: ioinfo
+   end type field2DInteger
+
+
+   ! Derived type for storing fields
+   type field1DInteger
+      type (block_type), pointer :: block
+      integer, dimension(:), pointer :: array
+      type (io_info), pointer :: ioinfo
+   end type field1DInteger
+
+
+   ! Derived type for storing fields
+   type field1DChar
+      type (block_type), pointer :: block
+      character (len=64), dimension(:), pointer :: array
+      type (io_info), pointer :: ioinfo
+   end type field1DChar
+
+
+   ! Derived type for storing fields
+   type field0DChar
+      type (block_type), pointer :: block
+      character (len=64) :: scalar
+      type (io_info), pointer :: ioinfo
+   end type field0DChar
+
+
+   ! Derived type for storing grid meta-data
+   type mesh_type
+
+#include &quot;field_dimensions.inc&quot;
+
+      logical :: on_a_sphere
+      real (kind=RKIND) :: sphere_radius
+
+#include &quot;time_invariant_fields.inc&quot;
+
+   end type mesh_type
+
+
+#include &quot;variable_groups.inc&quot;
+
+
+   ! Type for storing (possibly architecture specific) information concerning to parallelism
+   type parallel_info
+      type (exchange_list), pointer :: cellsToSend            ! List of types describing which cells to send to other blocks
+      type (exchange_list), pointer :: cellsToRecv            ! List of types describing which cells to receive from other blocks
+      type (exchange_list), pointer :: edgesToSend            ! List of types describing which edges to send to other blocks
+      type (exchange_list), pointer :: edgesToRecv            ! List of types describing which edges to receive from other blocks
+      type (exchange_list), pointer :: verticesToSend         ! List of types describing which vertices to send to other blocks
+      type (exchange_list), pointer :: verticesToRecv         ! List of types describing which vertices to receive from other blocks
+   end type parallel_info
+
+
+   ! Derived type for storing part of a domain; used as a basic unit of work for a process
+   type block_type
+
+#include &quot;block_group_members.inc&quot;
+
+      type (domain_type), pointer :: domain
+
+      type (parallel_info), pointer :: parinfo
+
+      type (block_type), pointer :: prev, next
+   end type block_type
+
+
+   ! Derived type for storing list of blocks from a domain to be handled by a process
+   type domain_type
+      type (block_type), pointer :: blocklist
+   
+      ! Also store parallelization info here
+      type (dm_info), pointer :: dminfo
+   end type domain_type
+
+
+   contains
+
+
+   subroutine mpas_allocate_domain(dom, dminfo)
+
+      implicit none
+
+      type (domain_type), pointer :: dom
+      type (dm_info), pointer :: dminfo
+
+      allocate(dom)
+      nullify(dom % blocklist)
+      dom % dminfo =&gt; dminfo
+
+   end subroutine mpas_allocate_domain
+
+
+   subroutine mpas_allocate_block(b, dom, &amp;
+#include &quot;dim_dummy_args.inc&quot;
+                            )
+
+      implicit none
+
+      type (block_type), pointer :: b
+      type (domain_type), pointer :: dom
+#include &quot;dim_dummy_decls.inc&quot;
+
+      integer :: i
+
+      nullify(b % prev)
+      nullify(b % next)
+
+      allocate(b % parinfo)
+
+      b % domain =&gt; dom
+
+#include &quot;block_allocs.inc&quot;
+
+   end subroutine mpas_allocate_block
+
+
+#include &quot;group_alloc_routines.inc&quot;
+
+
+   subroutine mpas_deallocate_domain(dom)
+
+      implicit none
+
+      type (domain_type), pointer :: dom
+
+      type (block_type), pointer :: block_ptr
+
+      block_ptr =&gt; dom % blocklist
+      do while (associated(block_ptr))
+         call mpas_deallocate_block(block_ptr)
+         block_ptr =&gt; block_ptr % next
+      end do
+
+      deallocate(dom) 
+
+   end subroutine mpas_deallocate_domain
+
+
+   subroutine mpas_deallocate_block(b)

+      implicit none
+
+      type (block_type), intent(inout) :: b
+
+      integer :: i
+
+      deallocate(b % parinfo)
+
+#include &quot;block_deallocs.inc&quot;
+
+   end subroutine mpas_deallocate_block
+
+
+#include &quot;group_dealloc_routines.inc&quot;
+
+
+#include &quot;group_copy_routines.inc&quot;
+
+
+#include &quot;group_shift_level_routines.inc&quot;
+
+end module mpas_grid_types

Copied: branches/source_condensing/src/framework/mpas_hash.F (from rev 1114, trunk/mpas/src/framework/mpas_hash.F)
===================================================================
--- branches/source_condensing/src/framework/mpas_hash.F                                (rev 0)
+++ branches/source_condensing/src/framework/mpas_hash.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,175 @@
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! MODULE HASH
+!
+! Purpose: This module provides a dictionary/hashtable with insert, search, and
+!   remove routines. 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+module mpas_hash
+
+   ! Parameters
+   integer, parameter :: TABLESIZE=27183     ! Number of spaces in the table (the
+                                             !   number of linked lists)

+   type hashnode
+      integer :: key
+      type (hashnode), pointer :: next
+   end type hashnode

+   type hashnode_ptr
+      type (hashnode), pointer :: p        ! Pointer to a list of entries
+   end type hashnode_ptr

+   type hashtable
+      integer :: size
+      type (hashnode_ptr), dimension(TABLESIZE) :: table ! The hashtable array
+   end type hashtable
+

+   contains


+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Name: hash_init
+   !
+   ! Purpose: To initialize a hashtable
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   subroutine mpas_hash_init(h)
+   
+     implicit none

+     ! Arguments
+     type (hashtable), intent(inout) :: h

+     ! Local variables
+     integer :: i
+
+     h%size = 0

+     do i=1,TABLESIZE
+        nullify(h%table(i)%p)
+     end do

+   end subroutine mpas_hash_init


+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Name: hash_insert
+   !
+   ! Purpose: Given a hashtable h and a key to be inserted into the hashtable,
+   !   this routine adds key to the table. 
+   !
+   ! NOTE: If the key already exists in the table, a second copy of the
+   !   key is added to the table
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   subroutine mpas_hash_insert(h, key)
+   
+     implicit none

+     ! Arguments
+     integer, intent(in) :: key
+     type (hashtable), intent(inout) :: h

+     ! Local variables
+     integer :: hashval, i
+     type (hashnode), pointer :: hn 

+     hashval = mod(key, TABLESIZE) + 1  
+    
+     allocate(hn) 
+     hn%key = key
+     hn%next =&gt; h%table(hashval)%p
+     h%table(hashval)%p =&gt; hn 
+
+     h%size = h%size + 1

+   end subroutine mpas_hash_insert


+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Name: hash_search
+   !
+   ! Purpose: This function returns TRUE if the specified key was found in the
+   !   hashtable h, and FALSE otherwise.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   logical function mpas_hash_search(h, key)
+   
+      implicit none
+  
+      ! Arguments
+      integer, intent(in) :: key
+      type (hashtable), intent(inout) :: h
+  
+      ! Local variables
+      integer :: hashval, i
+      type (hashnode), pointer :: cursor 
+  
+      mpas_hash_search = .false.
+  
+      hashval = mod(key, TABLESIZE) + 1  
+     
+      cursor =&gt; h%table(hashval)%p
+      do while(associated(cursor))
+         if (cursor%key == key) then
+            mpas_hash_search = .true.
+            return 
+         else
+            cursor =&gt; cursor%next 
+         end if
+      end do
+    
+      return

+   end function mpas_hash_search
+
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Name: hash_size
+   !
+   ! Purpose: Returns the number of items in the hash table h.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   integer function mpas_hash_size(h)
+
+      implicit none
+
+      ! Arguments
+      type (hashtable) :: h
+
+      mpas_hash_size = h%size
+
+      return
+
+   end function mpas_hash_size


+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   ! Name: hash_destroy
+   !
+   ! Purpose: Frees all memory associated with hashtable h. This routine may be
+   !   used to remove all entries from a hashtable.
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+   subroutine mpas_hash_destroy(h)
+   
+      implicit none
+  
+      ! Arguments
+      type (hashtable), intent(inout) :: h
+  
+      ! Local variables
+      integer :: i
+      type (hashnode), pointer :: cursor, cursor_prev
+     
+      do i=1,TABLESIZE
+         cursor =&gt; h%table(i)%p
+         do while(associated(cursor))
+            cursor_prev =&gt; cursor
+            cursor =&gt; cursor%next
+            deallocate(cursor_prev)
+         end do 
+         nullify(h%table(i)%p)
+      end do 
+
+      h%size = 0

+   end subroutine mpas_hash_destroy

+end module mpas_hash

Copied: branches/source_condensing/src/framework/mpas_io_input.F (from rev 1114, trunk/mpas/src/framework/mpas_io_input.F)
===================================================================
--- branches/source_condensing/src/framework/mpas_io_input.F                                (rev 0)
+++ branches/source_condensing/src/framework/mpas_io_input.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,1614 @@
+module mpas_io_input
+
+   use mpas_grid_types
+   use mpas_dmpar
+   use mpas_block_decomp
+   use mpas_sort
+   use mpas_configure
+   use mpas_timekeeping
+
+
+#ifdef HAVE_ZOLTAN
+   use mpas_zoltan_interface
+#endif
+
+   integer, parameter :: STREAM_INPUT=1, STREAM_SFC=2, STREAM_RESTART=3
+
+   type io_input_object
+      character (len=1024) :: filename
+      integer :: rd_ncid
+      integer :: stream
+
+      integer :: time
+
+#include &quot;io_input_obj_decls.inc&quot;
+   end type io_input_object
+
+
+   interface mpas_io_input_field
+      module procedure mpas_io_input_field0d_real
+      module procedure mpas_io_input_field1d_real
+      module procedure mpas_io_input_field2d_real
+      module procedure mpas_io_input_field3d_real
+      module procedure mpas_io_input_field1d_integer
+      module procedure mpas_io_input_field2d_integer
+      module procedure mpas_io_input_field0d_char
+      module procedure mpas_io_input_field1d_char
+   end interface mpas_io_input_field
+
+   interface mpas_io_input_field_time
+      module procedure mpas_io_input_field0d_real_time
+      module procedure mpas_io_input_field1d_real_time
+      module procedure mpas_io_input_field2d_real_time
+      module procedure mpas_io_input_field3d_real_time
+      module procedure mpas_io_input_field1d_integer_time
+      module procedure mpas_io_input_field0d_char_time
+      module procedure mpas_io_input_field1d_char_time
+   end interface mpas_io_input_field_time
+
+   type (exchange_list), pointer :: sendCellList, recvCellList
+   type (exchange_list), pointer :: sendEdgeList, recvEdgeList
+   type (exchange_list), pointer :: sendVertexList, recvVertexList
+   type (exchange_list), pointer :: sendVertLevelList, recvVertLevelList

+   integer :: readCellStart, readCellEnd, nReadCells
+   integer :: readEdgeStart, readEdgeEnd, nReadEdges
+   integer :: readVertexStart, readVertexEnd, nReadVertices
+   integer :: readVertLevelStart, readVertLevelEnd, nReadVertLevels
+   
+
+   contains
+
+
+   subroutine mpas_input_state_for_domain(domain)
+   
+      implicit none
+   
+      type (domain_type), pointer :: domain
+   
+      integer :: i, j, k
+      type (io_input_object) :: input_obj
+#include &quot;dim_decls.inc&quot;
+
+      character (len=16) :: c_on_a_sphere
+      real (kind=RKIND) :: r_sphere_radius
+   
+      type (field1dInteger) :: indexToCellIDField
+      type (field1dInteger) :: indexToEdgeIDField
+      type (field1dInteger) :: indexToVertexIDField
+      type (field1dInteger) :: nEdgesOnCellField
+      type (field2dInteger) :: cellsOnCellField
+      type (field2dInteger) :: edgesOnCellField
+      type (field2dInteger) :: verticesOnCellField
+      type (field2dInteger) :: cellsOnEdgeField
+      type (field2dInteger) :: cellsOnVertexField
+
+#ifdef HAVE_ZOLTAN
+#ifdef _MPI 
+      type (field1dReal) :: xCellField,   yCellField,   zCellField
+      type (field1dReal) :: xEdgeField,   yEdgeField,   zEdgeField
+      type (field1dReal) :: xVertexField, yVertexField, zVertexField
+#endif
+#endif
+
+      type (field1DChar) :: xtime
+   
+      integer, dimension(:), pointer :: indexToCellID_0Halo
+      integer, dimension(:), pointer :: nEdgesOnCell_0Halo
+      integer, dimension(:,:), pointer :: cellsOnCell_0Halo
+   
+      integer, dimension(:,:), pointer :: edgesOnCell_2Halo
+      integer, dimension(:,:), pointer :: verticesOnCell_2Halo
+      integer, dimension(:,:), pointer :: cellsOnEdge_2Halo
+      integer, dimension(:,:), pointer :: cellsOnVertex_2Halo
+
+      integer, dimension(:,:), pointer :: cellIDSorted
+      integer, dimension(:,:), pointer :: edgeIDSorted
+      integer, dimension(:,:), pointer :: vertexIDSorted
+
+#ifdef HAVE_ZOLTAN
+#ifdef _MPI 
+      real (kind=RKIND), dimension(:), pointer :: xCell,   yCell,   zCell
+      real (kind=RKIND), dimension(:), pointer :: xEdge,   yEdge,   zEdge
+      real (kind=RKIND), dimension(:), pointer :: xVertex, yVertex, zVertex
+#endif
+#endif
+   
+      integer, dimension(:), pointer :: local_cell_list, local_edge_list, local_vertex_list
+      integer, dimension(:), pointer :: local_vertlevel_list, needed_vertlevel_list
+      integer :: nlocal_edges, nlocal_vertices
+      type (exchange_list), pointer :: send1Halo, recv1Halo
+      type (exchange_list), pointer :: send2Halo, recv2Halo
+      type (graph) :: partial_global_graph_info
+      type (graph) :: block_graph_0Halo, block_graph_1Halo, block_graph_2Halo
+      integer :: ghostEdgeStart, ghostVertexStart
+
+      type (MPAS_Time_type) :: startTime
+      type (MPAS_Time_type) :: sliceTime
+      type (MPAS_TimeInterval_type) :: timeDiff
+      type (MPAS_TimeInterval_type) :: minTimeDiff
+      character(len=32) :: timeStamp
+
+      if (config_do_restart) then
+         input_obj % filename = trim(config_restart_name)
+         input_obj % stream = STREAM_RESTART
+      else
+         input_obj % filename = trim(config_input_name)
+         input_obj % stream = STREAM_INPUT
+      end if
+      call mpas_io_input_init(input_obj, domain % dminfo)
+   
+
+      !
+      ! Read global number of cells/edges/vertices
+      !
+#include &quot;read_dims.inc&quot;
+   
+      !
+      ! Determine the range of cells/edges/vertices that a processor will initially read
+      !   from the input file
+      !
+      call mpas_dmpar_get_index_range(domain % dminfo, 1, nCells, readCellStart, readCellEnd)   
+      nReadCells    = readCellEnd - readCellStart + 1
+   
+      call mpas_dmpar_get_index_range(domain % dminfo, 1, nEdges, readEdgeStart, readEdgeEnd)   
+      nReadEdges    = readEdgeEnd - readEdgeStart + 1
+   
+      call mpas_dmpar_get_index_range(domain % dminfo, 1, nVertices, readVertexStart, readVertexEnd)   
+      nReadVertices = readVertexEnd - readVertexStart + 1
+
+      readVertLevelStart = 1
+      readVertLevelEnd = nVertLevels
+      nReadVertLevels = nVertLevels
+   
+   
+      !
+      ! Allocate and read fields that we will need in order to ultimately work out
+      !   which cells/edges/vertices are owned by each block, and which are ghost
+      !
+
+      ! Global cell indices
+      allocate(indexToCellIDField % ioinfo)
+      indexToCellIDField % ioinfo % fieldName = 'indexToCellID'
+      indexToCellIDField % ioinfo % start(1) = readCellStart
+      indexToCellIDField % ioinfo % count(1) = nReadCells
+      allocate(indexToCellIDField % array(nReadCells))
+      call mpas_io_input_field(input_obj, indexToCellIDField)
+   
+#ifdef HAVE_ZOLTAN
+#ifdef _MPI 
+      ! Cell x-coordinates (in 3d Cartesian space)
+      allocate(xCellField % ioinfo)
+      xCellField % ioinfo % fieldName = 'xCell'
+      xCellField % ioinfo % start(1) = readCellStart
+      xCellField % ioinfo % count(1) = nReadCells
+      allocate(xCellField % array(nReadCells))
+      call mpas_io_input_field(input_obj, xCellField)
+
+      ! Cell y-coordinates (in 3d Cartesian space)
+      allocate(yCellField % ioinfo)
+      yCellField % ioinfo % fieldName = 'yCell'
+      yCellField % ioinfo % start(1) = readCellStart
+      yCellField % ioinfo % count(1) = nReadCells
+      allocate(yCellField % array(nReadCells))
+      call mpas_io_input_field(input_obj, yCellField)
+
+      ! Cell z-coordinates (in 3d Cartesian space)
+      allocate(zCellField % ioinfo)
+      zCellField % ioinfo % fieldName = 'zCell'
+      zCellField % ioinfo % start(1) = readCellStart
+      zCellField % ioinfo % count(1) = nReadCells
+      allocate(zCellField % array(nReadCells))
+      call mpas_io_input_field(input_obj, zCellField)
+#endif
+#endif
+
+
+      ! Global edge indices
+      allocate(indexToEdgeIDField % ioinfo)
+      indexToEdgeIDField % ioinfo % fieldName = 'indexToEdgeID'
+      indexToEdgeIDField % ioinfo % start(1) = readEdgeStart
+      indexToEdgeIDField % ioinfo % count(1) = nReadEdges
+      allocate(indexToEdgeIDField % array(nReadEdges))
+      call mpas_io_input_field(input_obj, indexToEdgeIDField)
+   
+#ifdef HAVE_ZOLTAN
+#ifdef _MPI 
+      ! Edge x-coordinates (in 3d Cartesian space)
+      allocate(xEdgeField % ioinfo)
+      xEdgeField % ioinfo % fieldName = 'xEdge'
+      xEdgeField % ioinfo % start(1) = readEdgeStart
+      xEdgeField % ioinfo % count(1) = nReadEdges
+      allocate(xEdgeField % array(nReadEdges))
+      call mpas_io_input_field(input_obj, xEdgeField)
+
+      ! Edge y-coordinates (in 3d Cartesian space)
+      allocate(yEdgeField % ioinfo)
+      yEdgeField % ioinfo % fieldName = 'yEdge'
+      yEdgeField % ioinfo % start(1) = readEdgeStart
+      yEdgeField % ioinfo % count(1) = nReadEdges
+      allocate(yEdgeField % array(nReadEdges))
+      call mpas_io_input_field(input_obj, yEdgeField)
+
+      ! Edge z-coordinates (in 3d Cartesian space)
+      allocate(zEdgeField % ioinfo)
+      zEdgeField % ioinfo % fieldName = 'zEdge'
+      zEdgeField % ioinfo % start(1) = readEdgeStart
+      zEdgeField % ioinfo % count(1) = nReadEdges
+      allocate(zEdgeField % array(nReadEdges))
+      call mpas_io_input_field(input_obj, zEdgeField)
+#endif
+#endif
+
+      ! Global vertex indices
+      allocate(indexToVertexIDField % ioinfo)
+      indexToVertexIDField % ioinfo % fieldName = 'indexToVertexID'
+      indexToVertexIDField % ioinfo % start(1) = readVertexStart
+      indexToVertexIDField % ioinfo % count(1) = nReadVertices
+      allocate(indexToVertexIDField % array(nReadVertices))
+      call mpas_io_input_field(input_obj, indexToVertexIDField)
+   
+#ifdef HAVE_ZOLTAN
+#ifdef _MPI
+      ! Vertex x-coordinates (in 3d Cartesian space)
+      allocate(xVertexField % ioinfo)
+      xVertexField % ioinfo % fieldName = 'xVertex'
+      xVertexField % ioinfo % start(1) = readVertexStart
+      xVertexField % ioinfo % count(1) = nReadVertices
+      allocate(xVertexField % array(nReadVertices))
+      call mpas_io_input_field(input_obj, xVertexField)
+
+      ! Vertex y-coordinates (in 3d Cartesian space)
+      allocate(yVertexField % ioinfo)
+      yVertexField % ioinfo % fieldName = 'yVertex'
+      yVertexField % ioinfo % start(1) = readVertexStart
+      yVertexField % ioinfo % count(1) = nReadVertices
+      allocate(yVertexField % array(nReadVertices))
+      call mpas_io_input_field(input_obj, yVertexField)
+
+      ! Vertex z-coordinates (in 3d Cartesian space)
+      allocate(zVertexField % ioinfo)
+      zVertexField % ioinfo % fieldName = 'zVertex'
+      zVertexField % ioinfo % start(1) = readVertexStart
+      zVertexField % ioinfo % count(1) = nReadVertices
+      allocate(zVertexField % array(nReadVertices))
+      call mpas_io_input_field(input_obj, zVertexField)
+#endif
+#endif
+
+      ! Number of cell/edges/vertices adjacent to each cell
+      allocate(nEdgesOnCellField % ioinfo)
+      nEdgesOnCellField % ioinfo % fieldName = 'nEdgesOnCell'
+      nEdgesOnCellField % ioinfo % start(1) = readCellStart
+      nEdgesOnCellField % ioinfo % count(1) = nReadCells
+      allocate(nEdgesOnCellField % array(nReadCells))
+      call mpas_io_input_field(input_obj, nEdgesOnCellField)
+   
+      ! Global indices of cells adjacent to each cell
+      allocate(cellsOnCellField % ioinfo)
+      cellsOnCellField % ioinfo % fieldName = 'cellsOnCell'
+      cellsOnCellField % ioinfo % start(1) = 1
+      cellsOnCellField % ioinfo % start(2) = readCellStart
+      cellsOnCellField % ioinfo % count(1) = maxEdges
+      cellsOnCellField % ioinfo % count(2) = nReadCells
+      allocate(cellsOnCellField % array(maxEdges,nReadCells))
+      call mpas_io_input_field(input_obj, cellsOnCellField)
+   
+      ! Global indices of edges adjacent to each cell
+      allocate(edgesOnCellField % ioinfo)
+      edgesOnCellField % ioinfo % fieldName = 'edgesOnCell'
+      edgesOnCellField % ioinfo % start(1) = 1
+      edgesOnCellField % ioinfo % start(2) = readCellStart
+      edgesOnCellField % ioinfo % count(1) = maxEdges
+      edgesOnCellField % ioinfo % count(2) = nReadCells
+      allocate(edgesOnCellField % array(maxEdges,nReadCells))
+      call mpas_io_input_field(input_obj, edgesOnCellField)
+   
+      ! Global indices of vertices adjacent to each cell
+      allocate(verticesOnCellField % ioinfo)
+      verticesOnCellField % ioinfo % fieldName = 'verticesOnCell'
+      verticesOnCellField % ioinfo % start(1) = 1
+      verticesOnCellField % ioinfo % start(2) = readCellStart
+      verticesOnCellField % ioinfo % count(1) = maxEdges
+      verticesOnCellField % ioinfo % count(2) = nReadCells
+      allocate(verticesOnCellField % array(maxEdges,nReadCells))
+      call mpas_io_input_field(input_obj, verticesOnCellField)
+   
+      ! Global indices of cells adjacent to each edge
+      !    used for determining which edges are owned by a block, where 
+      !    iEdge is owned iff cellsOnEdge(1,iEdge) is an owned cell
+      allocate(cellsOnEdgeField % ioinfo)
+      cellsOnEdgeField % ioinfo % fieldName = 'cellsOnEdge'
+      cellsOnEdgeField % ioinfo % start(1) = 1
+      cellsOnEdgeField % ioinfo % start(2) = readEdgeStart
+      cellsOnEdgeField % ioinfo % count(1) = 2
+      cellsOnEdgeField % ioinfo % count(2) = nReadEdges
+      allocate(cellsOnEdgeField % array(2,nReadEdges))
+      call mpas_io_input_field(input_obj, cellsOnEdgeField)
+   
+      ! Global indices of cells adjacent to each vertex
+      !    used for determining which vertices are owned by a block, where 
+      !    iVtx is owned iff cellsOnVertex(1,iVtx) is an owned cell
+      allocate(cellsOnVertexField % ioinfo)
+      cellsOnVertexField % ioinfo % fieldName = 'cellsOnVertex'
+      cellsOnVertexField % ioinfo % start(1) = 1
+      cellsOnVertexField % ioinfo % start(2) = readVertexStart
+      cellsOnVertexField % ioinfo % count(1) = vertexDegree
+      cellsOnVertexField % ioinfo % count(2) = nReadVertices
+      allocate(cellsOnVertexField % array(vertexDegree,nReadVertices))
+      call mpas_io_input_field(input_obj, cellsOnVertexField)
+   
+   
+      !
+      ! Set up a graph derived data type describing the connectivity for the cells 
+      !   that were read by this process
+      ! A partial description is passed to the block decomp module by each process,
+      !   and the block decomp module returns with a list of global cell indices
+      !   that belong to the block on this process
+      !
+      partial_global_graph_info % nVertices = nReadCells
+      partial_global_graph_info % nVerticesTotal = nCells
+      partial_global_graph_info % maxDegree = maxEdges
+      partial_global_graph_info % ghostStart = nVertices+1
+      allocate(partial_global_graph_info % vertexID(nReadCells))
+      allocate(partial_global_graph_info % nAdjacent(nReadCells))
+      allocate(partial_global_graph_info % adjacencyList(maxEdges, nReadCells))
+   
+      partial_global_graph_info % vertexID(:) = indexToCellIDField % array(:)
+      partial_global_graph_info % nAdjacent(:) = nEdgesOnCellField % array(:)
+      partial_global_graph_info % adjacencyList(:,:) = cellsOnCellField % array(:,:)
+      
+   
+      ! TODO: Ensure (by renaming or exchanging) that initial cell range on each proc is contiguous
+      !       This situation may occur when reading a restart file with cells/edges/vertices written
+      !       in a scrambled order
+   
+
+      ! Determine which cells are owned by this process
+      call mpas_block_decomp_cells_for_proc(domain % dminfo, partial_global_graph_info, local_cell_list)
+
+      deallocate(partial_global_graph_info % vertexID)
+      deallocate(partial_global_graph_info % nAdjacent)
+      deallocate(partial_global_graph_info % adjacencyList)
+   
+   
+      allocate(indexToCellID_0Halo(size(local_cell_list)))
+      allocate(nEdgesOnCell_0Halo(size(local_cell_list)))
+      allocate(cellsOnCell_0Halo(maxEdges, size(local_cell_list)))
+   
+#ifdef HAVE_ZOLTAN
+#ifdef _MPI 
+      allocate(xCell(size(local_cell_list)))
+      allocate(yCell(size(local_cell_list)))
+      allocate(zCell(size(local_cell_list)))
+#endif
+#endif
+   
+      !
+      ! Now that each process has a list of cells that it owns, exchange cell connectivity 
+      !   information between the processes that read info for a cell and those that own that cell
+      !
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                size(indexToCellIDField % array), size(local_cell_list), &amp;
+                                indexToCellIDField % array, local_cell_list, &amp;
+                                sendCellList, recvCellList)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, indexToCellIDField % array, indexToCellID_0Halo, &amp;
+                                size(indexToCellIDField % array), size(local_cell_list), &amp;
+                                sendCellList, recvCellList)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, nEdgesOnCellField % array, nEdgesOnCell_0Halo, &amp;
+                                size(indexToCellIDField % array), size(local_cell_list), &amp;
+                                sendCellList, recvCellList)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, cellsOnCellField % array, cellsOnCell_0Halo, &amp;
+                                size(cellsOnCellField % array, 1), size(indexToCellIDField % array), size(local_cell_list), &amp;
+                                sendCellList, recvCellList)
+   
+#ifdef HAVE_ZOLTAN
+#ifdef _MPI 
+      call mpas_dmpar_alltoall_field(domain % dminfo, xCellField % array, xCell, &amp;
+                                size(xCellField % array), size(local_cell_list), &amp;
+                                sendCellList, recvCellList)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, yCellField % array, yCell, &amp;
+                                size(yCellField % array), size(local_cell_list), &amp;
+                                sendCellList, recvCellList)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, zCellField % array, zCell, &amp;
+                                size(zCellField % array), size(local_cell_list), &amp;
+                                sendCellList, recvCellList)
+#endif
+#endif
+
+
+      deallocate(sendCellList % list)
+      deallocate(sendCellList)
+      deallocate(recvCellList % list)
+      deallocate(recvCellList)
+
+
+
+      !
+      ! Build a graph of cell connectivity based on cells owned by this process
+      !
+      block_graph_0Halo % nVerticesTotal = size(local_cell_list)
+      block_graph_0Halo % nVertices = size(local_cell_list)
+      block_graph_0Halo % maxDegree = maxEdges
+      block_graph_0Halo % ghostStart = size(local_cell_list) + 1
+      allocate(block_graph_0Halo % vertexID(size(local_cell_list)))
+      allocate(block_graph_0Halo % nAdjacent(size(local_cell_list)))
+      allocate(block_graph_0Halo % adjacencyList(maxEdges, size(local_cell_list)))
+   
+      block_graph_0Halo % vertexID(:) = indexToCellID_0Halo(:)
+      block_graph_0Halo % nAdjacent(:) = nEdgesOnCell_0Halo(:)
+      block_graph_0Halo % adjacencyList(:,:) = cellsOnCell_0Halo(:,:)
+   
+      ! Get back a graph describing the owned cells plus the cells in the 1-halo
+      call mpas_block_decomp_add_halo(domain % dminfo, block_graph_0Halo, block_graph_1Halo)
+   
+   
+      !
+      ! Work out exchange lists for 1-halo and exchange cell information for 1-halo
+      !
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                block_graph_0Halo % nVertices, block_graph_1Halo % nVerticesTotal, &amp;
+                                block_graph_0Halo % vertexID,  block_graph_1Halo % vertexID, &amp;
+                                send1Halo, recv1Halo)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % vertexID, block_graph_1Halo % vertexID, &amp;
+                                block_graph_0Halo % nVertices, block_graph_1Halo % nVerticesTotal, &amp;
+                                send1Halo, recv1Halo)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % nAdjacent, block_graph_1Halo % nAdjacent, &amp;
+                                block_graph_0Halo % nVertices, block_graph_1Halo % nVerticesTotal, &amp;
+                                send1Halo, recv1Halo)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % adjacencyList, block_graph_1Halo % adjacencyList, &amp;
+                                block_graph_0Halo % maxDegree, block_graph_0Halo % nVertices, block_graph_1Halo % nVerticesTotal, &amp;
+                                send1Halo, recv1Halo)
+   
+   
+      !
+      ! Work out exchange lists for 2-halo and exchange cell information for 2-halo
+      !
+      block_graph_1Halo % nVertices = block_graph_1Halo % nVerticesTotal
+      block_graph_1Halo % ghostStart = block_graph_1Halo % nVerticesTotal + 1
+     
+      ! Get back a graph describing the owned and 1-halo cells plus the cells in the 2-halo
+      call mpas_block_decomp_add_halo(domain % dminfo, block_graph_1Halo, block_graph_2Halo)
+   
+      block_graph_2Halo % nVertices = block_graph_0Halo % nVertices
+      block_graph_2Halo % ghostStart = block_graph_2Halo % nVertices + 1
+
+#ifdef HAVE_ZOLTAN
+#ifdef _MPI 
+      !! For now, only use Zoltan with MPI
+      !! Zoltan initialization
+      call mpas_zoltan_start()
+
+      !! Zoltan hook for cells
+      call mpas_zoltan_order_loc_hsfc_cells(block_graph_2Halo%nVertices,block_graph_2Halo%VertexID,3,xCell,yCell,zCell)
+#endif
+#endif
+
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                block_graph_0Halo % nVertices, block_graph_2Halo % nVerticesTotal, &amp;
+                                block_graph_0Halo % vertexID,  block_graph_2Halo % vertexID, &amp;
+                                send2Halo, recv2Halo)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % vertexID, block_graph_2Halo % vertexID, &amp;
+                                block_graph_0Halo % nVertices, block_graph_2Halo % nVerticesTotal, &amp;
+                                send2Halo, recv2Halo)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % nAdjacent, block_graph_2Halo % nAdjacent, &amp;
+                                block_graph_0Halo % nVertices, block_graph_2Halo % nVerticesTotal, &amp;
+                                send2Halo, recv2Halo)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, block_graph_0Halo % adjacencyList, block_graph_2Halo % adjacencyList, &amp;
+                                block_graph_0Halo % maxDegree, block_graph_0Halo % nVertices, block_graph_2Halo % nVerticesTotal, &amp;
+                                send2Halo, recv2Halo)
+
+
+   
+      !
+      ! Knowing which cells are in block and the 2-halo, we can exchange lists of which edges are
+      !   on each cell and which vertices are on each cell from the processes that read these
+      !   fields for each cell to the processes that own the cells
+      !
+      allocate(edgesOnCell_2Halo(maxEdges, block_graph_2Halo % nVerticesTotal))
+      allocate(verticesOnCell_2Halo(maxEdges, block_graph_2Halo % nVerticesTotal))
+   
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                size(indexToCellIDField % array), block_graph_2Halo % nVerticesTotal, &amp;
+                                indexToCellIDField % array, block_graph_2Halo % vertexID, &amp;
+                                sendCellList, recvCellList)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, edgesOnCellField % array, edgesOnCell_2Halo, &amp;
+                                maxEdges, nReadCells, block_graph_2Halo % nVerticesTotal, &amp;
+                                sendCellList, recvCellList)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, verticesOnCellField % array, verticesOnCell_2Halo, &amp;
+                                maxEdges, nReadCells, block_graph_2Halo % nVerticesTotal, &amp;
+                                sendCellList, recvCellList)
+
+   
+      ! 
+      ! Get a list of which edges and vertices are adjacent to cells (including halo cells) in block
+      ! 
+      call mpas_block_decomp_all_edges_in_block(maxEdges, block_graph_2Halo % nVerticesTotal, block_graph_2Halo % nAdjacent, &amp;
+                                           edgesOnCell_2Halo, nlocal_edges, local_edge_list)
+      call mpas_block_decomp_all_edges_in_block(maxEdges, block_graph_2Halo % nVerticesTotal, block_graph_2Halo % nAdjacent, &amp;
+                                           verticesOnCell_2Halo, nlocal_vertices, local_vertex_list)
+   
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                size(indexToEdgeIDField % array), nlocal_edges, &amp;
+                                indexToEdgeIDField % array, local_edge_list, &amp;
+                                sendEdgeList, recvEdgeList)
+   
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                size(indexToVertexIDField % array), nlocal_vertices, &amp;
+                                indexToVertexIDField % array, local_vertex_list, &amp;
+                                sendVertexList, recvVertexList)
+   
+   
+   
+      ! 
+      ! Work out which edges and vertices are owned by this process, and which are ghost
+      ! 
+      allocate(cellsOnEdge_2Halo(2,nlocal_edges))
+      allocate(cellsOnVertex_2Halo(vertexDegree,nlocal_vertices))
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, cellsOnEdgeField % array, cellsOnEdge_2Halo, &amp;
+                                2, size(cellsOnEdgeField % array, 2), nlocal_edges, &amp;
+                                sendEdgeList, recvEdgeList)
+   
+      call mpas_dmpar_alltoall_field(domain % dminfo, cellsOnVertexField % array, cellsOnVertex_2Halo, &amp;
+                                vertexDegree, size(cellsOnVertexField % array, 2), nlocal_vertices, &amp;
+                                sendVertexList, recvVertexList)
+   
+   
+      call mpas_block_decomp_partitioned_edge_list(block_graph_2Halo % nVertices, &amp;
+                                              block_graph_2Halo % vertexID(1:block_graph_2Halo % nVertices), &amp;
+                                              2, nlocal_edges, cellsOnEdge_2Halo, local_edge_list, ghostEdgeStart)
+      call mpas_block_decomp_partitioned_edge_list(block_graph_2Halo % nVertices, &amp;
+                                              block_graph_2Halo % vertexID(1:block_graph_2Halo % nVertices), &amp;
+                                              vertexDegree, nlocal_vertices, cellsOnVertex_2Halo, local_vertex_list, ghostVertexStart)
+
+
+      ! At this point, local_edge_list(1;ghostEdgeStart-1) contains all of the owned edges for this block
+      !   and local_edge_list(ghostEdgeStart:nlocal_edges) contains all of the ghost edges
+
+      ! At this point, local_vertex_list(1;ghostVertexStart-1) contains all of the owned vertices for this block
+      !   and local_vertex_list(ghostVertexStart:nlocal_vertices) contains all of the ghost vertices
+
+      ! Also, at this point, block_graph_2Halo % vertexID(1:block_graph_2Halo%nVertices) contains all of the owned
+      !   cells for this block, and block_graph_2Halo % vertexID(block_graph_2Halo%nVertices+1:block_graph_2Halo%nVerticesTotal)
+      !   contains all of the ghost cells
+
+
+      deallocate(sendEdgeList % list)
+      deallocate(sendEdgeList)
+      deallocate(recvEdgeList % list)
+      deallocate(recvEdgeList)
+   
+      deallocate(sendVertexList % list)
+      deallocate(sendVertexList)
+      deallocate(recvVertexList % list)
+      deallocate(recvVertexList)
+   
+#ifdef HAVE_ZOLTAN
+#ifdef _MPI 
+      allocate(xEdge(nlocal_edges))
+      allocate(yEdge(nlocal_edges))
+      allocate(zEdge(nlocal_edges))
+      allocate(xVertex(nlocal_vertices))
+      allocate(yVertex(nlocal_vertices))
+      allocate(zVertex(nlocal_vertices))
+#endif
+#endif
+    
+      !
+      ! Knowing which edges/vertices are owned by this block and which are actually read
+      !   from the input or restart file, we can build exchange lists to perform 
+      !   all-to-all field exchanges from process that reads a field to the processes that
+      !   need them
+      !
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                size(indexToEdgeIDField % array), nlocal_edges, &amp;
+                                indexToEdgeIDField % array, local_edge_list, &amp;
+                                sendEdgeList, recvEdgeList)
+   
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                size(indexToVertexIDField % array), nlocal_vertices, &amp;
+                                indexToVertexIDField % array, local_vertex_list, &amp;
+                                sendVertexList, recvVertexList)
+
+#ifdef HAVE_ZOLTAN
+#ifdef _MPI 
+      call mpas_dmpar_alltoall_field(domain % dminfo, xEdgeField % array, xEdge, &amp;
+                                size(xEdgeField % array), nlocal_edges, &amp;
+                                sendEdgeList, recvEdgeList)
+      call mpas_dmpar_alltoall_field(domain % dminfo, yEdgeField % array, yEdge, &amp;
+                                size(yEdgeField % array), nlocal_edges, &amp;
+                                sendEdgeList, recvEdgeList)
+      call mpas_dmpar_alltoall_field(domain % dminfo, zEdgeField % array, zEdge, &amp;
+                                size(zEdgeField % array), nlocal_edges, &amp;
+                                sendEdgeList, recvEdgeList)
+
+      call mpas_dmpar_alltoall_field(domain % dminfo, xVertexField % array, xVertex, &amp;
+                                size(xVertexField % array), nlocal_vertices, &amp;
+                                sendVertexList, recvVertexList)
+      call mpas_dmpar_alltoall_field(domain % dminfo, yVertexField % array, yVertex, &amp;
+                                size(yVertexField % array), nlocal_vertices, &amp;
+                                sendVertexList, recvVertexList)
+      call mpas_dmpar_alltoall_field(domain % dminfo, zVertexField % array, zVertex, &amp;
+                                size(zVertexField % array), nlocal_vertices, &amp;
+                                sendVertexList, recvVertexList)
+      !!!!!!!!!!!!!!!!!!
+      !! Reorder edges
+      !!!!!!!!!!!!!!!!!!
+      call mpas_zoltan_order_loc_hsfc_edges(ghostEdgeStart-1,local_edge_list,3,xEdge,yEdge,zEdge)
+      !!!!!!!!!!!!!!!!!!
+
+      !!!!!!!!!!!!!!!!!!
+      !! Reorder vertices
+      !!!!!!!!!!!!!!!!!!
+      call mpas_zoltan_order_loc_hsfc_verts(ghostVertexStart-1,local_vertex_list,3,xVertex,yVertex,zVertex)
+      !!!!!!!!!!!!!!!!!!
+
+      deallocate(sendEdgeList % list)
+      deallocate(sendEdgeList)
+      deallocate(recvEdgeList % list)
+      deallocate(recvEdgeList)
+   
+      deallocate(sendVertexList % list)
+      deallocate(sendVertexList)
+      deallocate(recvVertexList % list)
+      deallocate(recvVertexList)
+    
+      !
+      ! Knowing which edges/vertices are owned by this block and which are actually read
+      !   from the input or restart file, we can build exchange lists to perform 
+      !   all-to-all field exchanges from process that reads a field to the processes that
+      !   need them
+      !
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                size(indexToEdgeIDField % array), nlocal_edges, &amp;
+                                indexToEdgeIDField % array, local_edge_list, &amp;
+                                sendEdgeList, recvEdgeList)
+   
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                size(indexToVertexIDField % array), nlocal_vertices, &amp;
+                                indexToVertexIDField % array, local_vertex_list, &amp;
+                                sendVertexList, recvVertexList)
+
+#endif
+#endif
+
+      ! 
+      ! Build ownership and exchange lists for vertical levels
+      ! Essentially, process 0 owns all vertical levels when reading and writing,
+      ! and it distributes them or gathers them to/from all other processes
+      ! 
+      if (domain % dminfo % my_proc_id == 0) then
+         allocate(local_vertlevel_list(nVertLevels))
+         do i=1,nVertLevels
+            local_vertlevel_list(i) = i
+         end do
+      else
+         allocate(local_vertlevel_list(0))
+      end if
+      allocate(needed_vertlevel_list(nVertLevels))
+      do i=1,nVertLevels
+         needed_vertlevel_list(i) = i
+      end do
+
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                size(local_vertlevel_list), size(needed_vertlevel_list), &amp;
+                                local_vertlevel_list, needed_vertlevel_list, &amp;
+                                sendVertLevelList, recvVertLevelList)
+
+      deallocate(local_vertlevel_list)
+      deallocate(needed_vertlevel_list)
+
+
+      !
+      ! Read and distribute all fields given ownership lists and exchange lists (maybe already in block?)
+      !
+      allocate(domain % blocklist)
+
+      nCells = block_graph_2Halo % nVerticesTotal
+      nEdges = nlocal_edges
+      nVertices = nlocal_vertices
+
+      call mpas_allocate_block(domain % blocklist, domain, &amp;
+#include &quot;dim_dummy_args.inc&quot;
+                         )
+
+      !
+      ! Read attributes
+      !
+      call mpas_io_input_get_att_text(input_obj, 'on_a_sphere', c_on_a_sphere)
+      call mpas_io_input_get_att_real(input_obj, 'sphere_radius', r_sphere_radius)
+      if (index(c_on_a_sphere, 'YES') /= 0) then
+         domain % blocklist % mesh % on_a_sphere = .true.
+      else
+         domain % blocklist % mesh % on_a_sphere = .false.
+      end if
+      domain % blocklist % mesh % sphere_radius = r_sphere_radius
+
+      if (.not. config_do_restart) then
+         input_obj % time = 1
+      else
+         input_obj % time = 1
+
+         !
+         ! If doing a restart, we need to decide which time slice to read from the 
+         !   restart file
+         !
+         if (input_obj % rdLocalTime &lt;= 0) then
+            write(0,*) 'Error: Couldn''t find any times in restart file.'
+            call mpas_dmpar_abort(domain % dminfo)
+         end if
+         if (domain % dminfo % my_proc_id == IO_NODE) then
+            allocate(xtime % ioinfo)
+            xtime % ioinfo % start(1) = 1
+            xtime % ioinfo % count(1) = input_obj % rdLocalTime
+            allocate(xtime % array(input_obj % rdLocalTime))
+
+            xtime % ioinfo % fieldName = 'xtime'
+            call mpas_io_input_field(input_obj, xtime)
+
+            call mpas_set_timeInterval(interval=minTimeDiff, DD=10000)
+            call mpas_set_time(curr_time=startTime, dateTimeString=config_start_time)
+
+            do i=1,input_obj % rdLocalTime
+               call mpas_set_time(curr_time=sliceTime, dateTimeString=xtime % array(i))
+               timeDiff = abs(sliceTime - startTime)
+               if (timeDiff &lt; minTimeDiff) then
+                  minTimeDiff = timeDiff
+                  input_obj % time = i
+               end if
+            end do
+
+            timeStamp = xtime % array(input_obj % time)
+
+            deallocate(xtime % ioinfo)
+            deallocate(xtime % array)
+         end if
+
+         call mpas_dmpar_bcast_int(domain % dminfo, input_obj % time)
+         call mpas_dmpar_bcast_char(domain % dminfo, timeStamp)
+
+         write(0,*) 'Restarting model from time ', timeStamp
+
+      end if
+
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+      ! Do the actual work of reading all fields in from the input or restart file
+      ! For each field:
+      !   1) Each process reads a contiguous range of cell/edge/vertex indices, which
+      !      may not correspond with the cells/edges/vertices that are owned by the
+      !      process
+      !   2) All processes then send the global indices that were read to the 
+      !      processes that own those indices based on 
+      !      {send,recv}{Cell,Edge,Vertex,VertLevel}List
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+      call mpas_read_and_distribute_fields(domain % dminfo, input_obj, domain % blocklist, &amp;
+                                      readCellStart, nReadCells, readEdgeStart, nReadEdges, readVertexStart, nReadVertices, &amp;
+                                      readVertLevelStart, nReadVertLevels, &amp;
+                                      sendCellList, recvCellList, sendEdgeList, recvEdgeList, sendVertexList, recvVertexList, &amp;
+                                      sendVertLevelList, recvVertLevelList) 
+
+
+      call mpas_io_input_finalize(input_obj, domain % dminfo)
+
+   
+      !
+      ! Rename vertices in cellsOnCell, edgesOnCell, etc. to local indices
+      !
+      allocate(cellIDSorted(2,domain % blocklist % mesh % nCells))
+      allocate(edgeIDSorted(2,domain % blocklist % mesh % nEdges))
+      allocate(vertexIDSorted(2,domain % blocklist % mesh % nVertices))
+
+      do i=1,domain % blocklist % mesh % nCells
+         cellIDSorted(1,i) = domain % blocklist % mesh % indexToCellID % array(i)
+         cellIDSorted(2,i) = i
+      end do
+      call quicksort(block_graph_2Halo % nVerticesTotal, cellIDSorted)
+
+      do i=1,domain % blocklist % mesh % nEdges
+         edgeIDSorted(1,i) = domain % blocklist % mesh % indexToEdgeID % array(i)
+         edgeIDSorted(2,i) = i
+      end do
+      call quicksort(nlocal_edges, edgeIDSorted)
+
+      do i=1,domain % blocklist % mesh % nVertices
+         vertexIDSorted(1,i) = domain % blocklist % mesh % indexToVertexID % array(i)
+         vertexIDSorted(2,i) = i
+      end do
+      call quicksort(nlocal_vertices, vertexIDSorted)
+
+
+      do i=1,domain % blocklist % mesh % nCells
+         do j=1,domain % blocklist % mesh % nEdgesOnCell % array(i)
+
+            k = mpas_binary_search(cellIDSorted, 2, 1, domain % blocklist % mesh % nCells, &amp;
+                              domain % blocklist % mesh % cellsOnCell % array(j,i))
+            if (k &lt;= domain % blocklist % mesh % nCells) then
+               domain % blocklist % mesh % cellsOnCell % array(j,i) = cellIDSorted(2,k)
+            else
+               domain % blocklist % mesh % cellsOnCell % array(j,i) = domain % blocklist % mesh % nCells + 1
+!               domain % blocklist % mesh % cellsOnCell % array(j,i) = 0
+            end if
+
+            k = mpas_binary_search(edgeIDSorted, 2, 1, domain % blocklist % mesh % nEdges, &amp;
+                              domain % blocklist % mesh % edgesOnCell % array(j,i))
+            if (k &lt;= domain % blocklist % mesh % nEdges) then
+               domain % blocklist % mesh % edgesOnCell % array(j,i) = edgeIDSorted(2,k)
+            else
+               domain % blocklist % mesh % edgesOnCell % array(j,i) = domain % blocklist % mesh % nEdges + 1
+!               domain % blocklist % mesh % edgesOnCell % array(j,i) = 0
+            end if
+
+            k = mpas_binary_search(vertexIDSorted, 2, 1, domain % blocklist % mesh % nVertices, &amp;
+                              domain % blocklist % mesh % verticesOnCell % array(j,i))
+            if (k &lt;= domain % blocklist % mesh % nVertices) then
+               domain % blocklist % mesh % verticesOnCell % array(j,i) = vertexIDSorted(2,k)
+            else
+               domain % blocklist % mesh % verticesOnCell % array(j,i) = domain % blocklist % mesh % nVertices + 1
+!               domain % blocklist % mesh % verticesOnCell % array(j,i) = 0
+            end if
+
+         end do
+      end do
+
+      do i=1,domain % blocklist % mesh % nEdges
+         do j=1,2
+
+            k = mpas_binary_search(cellIDSorted, 2, 1, domain % blocklist % mesh % nCells, &amp;
+                              domain % blocklist % mesh % cellsOnEdge % array(j,i))
+            if (k &lt;= domain % blocklist % mesh % nCells) then
+               domain % blocklist % mesh % cellsOnEdge % array(j,i) = cellIDSorted(2,k)
+            else
+               domain % blocklist % mesh % cellsOnEdge % array(j,i) = domain % blocklist % mesh % nCells + 1
+!               domain % blocklist % mesh % cellsOnEdge % array(j,i) = 0
+            end if
+
+            k = mpas_binary_search(vertexIDSorted, 2, 1, domain % blocklist % mesh % nVertices, &amp;
+                              domain % blocklist % mesh % verticesOnEdge % array(j,i))
+            if (k &lt;= domain % blocklist % mesh % nVertices) then
+               domain % blocklist % mesh % verticesOnEdge % array(j,i) = vertexIDSorted(2,k)
+            else
+               domain % blocklist % mesh % verticesOnEdge % array(j,i) = domain % blocklist % mesh % nVertices + 1
+!               domain % blocklist % mesh % verticesOnEdge % array(j,i) = 0
+            end if
+
+         end do
+
+         do j=1,domain % blocklist % mesh % nEdgesOnEdge % array(i)
+
+            k = mpas_binary_search(edgeIDSorted, 2, 1, domain % blocklist % mesh % nEdges, &amp;
+                              domain % blocklist % mesh % edgesOnEdge % array(j,i))
+            if (k &lt;= domain % blocklist % mesh % nEdges) then
+               domain % blocklist % mesh % edgesOnEdge % array(j,i) = edgeIDSorted(2,k)
+            else
+               domain % blocklist % mesh % edgesOnEdge % array(j,i) = domain % blocklist % mesh % nEdges + 1
+!               domain % blocklist % mesh % edgesOnEdge % array(j,i) = 0
+            end if
+
+         end do
+      end do
+
+      do i=1,domain % blocklist % mesh % nVertices
+         do j=1,vertexDegree
+
+            k = mpas_binary_search(cellIDSorted, 2, 1, domain % blocklist % mesh % nCells, &amp;
+                              domain % blocklist % mesh % cellsOnVertex % array(j,i))
+            if (k &lt;= domain % blocklist % mesh % nCells) then
+               domain % blocklist % mesh % cellsOnVertex % array(j,i) = cellIDSorted(2,k)
+            else
+               domain % blocklist % mesh % cellsOnVertex % array(j,i) = domain % blocklist % mesh % nCells + 1
+!               domain % blocklist % mesh % cellsOnVertex % array(j,i) = 0
+            end if
+
+            k = mpas_binary_search(edgeIDSorted, 2, 1, domain % blocklist % mesh % nEdges, &amp;
+                              domain % blocklist % mesh % edgesOnVertex % array(j,i))
+            if (k &lt;= domain % blocklist % mesh % nEdges) then
+               domain % blocklist % mesh % edgesOnVertex % array(j,i) = edgeIDSorted(2,k)
+            else
+               domain % blocklist % mesh % edgesOnVertex % array(j,i) = domain % blocklist % mesh % nEdges + 1
+!               domain % blocklist % mesh % edgesOnVertex % array(j,i) = 0
+            end if
+
+         end do
+      end do
+
+      deallocate(cellIDSorted)
+      deallocate(edgeIDSorted)
+      deallocate(vertexIDSorted)
+
+
+      !
+      ! Work out halo exchange lists for cells, edges, and vertices
+      !
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                block_graph_2Halo % nVertices, block_graph_2Halo % nVerticesTotal, &amp;
+                                block_graph_2Halo % vertexID(1:block_graph_2Halo % nVertices), block_graph_2Halo % vertexID, &amp;
+                                domain % blocklist % parinfo % cellsToSend, domain % blocklist % parinfo % cellsToRecv)
+
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                ghostEdgeStart-1, nlocal_edges, &amp;
+                                local_edge_list(1:ghostEdgeStart-1), local_edge_list, &amp;
+                                domain % blocklist % parinfo % edgesToSend, domain % blocklist % parinfo % edgesToRecv)
+
+      call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                ghostVertexStart-1, nlocal_vertices, &amp;
+                                local_vertex_list(1:ghostVertexStart-1), local_vertex_list, &amp;
+                                domain % blocklist % parinfo % verticesToSend, domain % blocklist % parinfo % verticesToRecv)
+
+      domain % blocklist % mesh % nCellsSolve = block_graph_2Halo % nVertices
+      domain % blocklist % mesh % nEdgesSolve = ghostEdgeStart-1
+      domain % blocklist % mesh % nVerticesSolve = ghostVertexStart-1
+      domain % blocklist % mesh % nVertLevelsSolve = domain % blocklist % mesh % nVertLevels   ! No vertical decomp yet...
+
+   
+      !
+      ! Deallocate fields, graphs, and other memory
+      !
+      deallocate(indexToCellIDField % ioinfo)
+      deallocate(indexToCellIDField % array)
+#ifdef HAVE_ZOLTAN
+#ifdef _MPI 
+      deallocate(xCellField % ioinfo)
+      deallocate(xCellField % array)
+      deallocate(yCellField % ioinfo)
+      deallocate(yCellField % array)
+      deallocate(zCellField % ioinfo)
+      deallocate(zCellField % array)
+#endif
+#endif
+      deallocate(indexToEdgeIDField % ioinfo)
+      deallocate(indexToEdgeIDField % array)
+      deallocate(indexToVertexIDField % ioinfo)
+      deallocate(indexToVertexIDField % array)
+      deallocate(cellsOnCellField % ioinfo)
+      deallocate(cellsOnCellField % array)
+      deallocate(edgesOnCellField % ioinfo)
+      deallocate(edgesOnCellField % array)
+      deallocate(verticesOnCellField % ioinfo)
+      deallocate(verticesOnCellField % array)
+      deallocate(cellsOnEdgeField % ioinfo)
+      deallocate(cellsOnEdgeField % array)
+      deallocate(cellsOnVertexField % ioinfo)
+      deallocate(cellsOnVertexField % array)
+      deallocate(cellsOnCell_0Halo)
+      deallocate(nEdgesOnCell_0Halo)
+      deallocate(indexToCellID_0Halo)
+      deallocate(cellsOnEdge_2Halo)
+      deallocate(cellsOnVertex_2Halo)
+      deallocate(edgesOnCell_2Halo)
+      deallocate(verticesOnCell_2Halo)
+      deallocate(block_graph_0Halo % vertexID)
+      deallocate(block_graph_0Halo % nAdjacent)
+      deallocate(block_graph_0Halo % adjacencyList)
+#ifdef HAVE_ZOLTAN
+#ifdef _MPI
+      deallocate(xCell)
+      deallocate(yCell)
+      deallocate(zCell)
+#endif
+#endif
+   end subroutine mpas_input_state_for_domain
+
+
+   subroutine mpas_read_and_distribute_fields(dminfo, input_obj, block, &amp;
+                                     readCellsStart, readCellsCount, &amp;
+                                     readEdgesStart, readEdgesCount, &amp;
+                                     readVerticesStart, readVerticesCount, &amp;
+                                     readVertLevelsStart, readVertLevelsCount, &amp;
+                                     sendCellsList, recvCellsList, &amp;
+                                     sendEdgesList, recvEdgesList, &amp;
+                                     sendVerticesList, recvVerticesList, &amp;
+                                     sendVertLevelsList, recvVertLevelsList)
+      
+      implicit none
+
+      type (dm_info), intent(in) :: dminfo
+      type (io_input_object), intent(in) :: input_obj
+      type (block_type), intent(inout) :: block
+      integer, intent(in) :: readCellsStart, readCellsCount, readEdgesStart, readEdgesCount, readVerticesStart, readVerticesCount
+      integer, intent(in) :: readVertLevelsStart, readVertLevelsCount
+      type (exchange_list), pointer :: sendCellsList, recvCellsList
+      type (exchange_list), pointer :: sendEdgesList, recvEdgesList
+      type (exchange_list), pointer :: sendVerticesList, recvVerticesList
+      type (exchange_list), pointer :: sendVertLevelsList, recvVertLevelsList
+
+      type (field1dInteger) :: int1d
+      type (field2dInteger) :: int2d
+      type (field0dReal) :: real0d
+      type (field1dReal) :: real1d
+      type (field2dReal) :: real2d
+      type (field3dReal) :: real3d
+      type (field0dChar) :: char0d
+      type (field1dChar) :: char1d
+
+      integer :: i1, i2, i3, i4
+
+      integer, dimension(:), pointer :: super_int1d
+      integer, dimension(:,:), pointer :: super_int2d
+      real (kind=RKIND) :: super_real0d
+      real (kind=RKIND), dimension(:), pointer :: super_real1d
+      real (kind=RKIND), dimension(:,:), pointer :: super_real2d
+      real (kind=RKIND), dimension(:,:,:), pointer :: super_real3d
+      character (len=64) :: super_char0d
+      character (len=64), dimension(:), pointer :: super_char1d
+
+      integer :: i, k
+
+#include &quot;nondecomp_dims.inc&quot;
+
+      allocate(int1d % ioinfo)
+      allocate(int2d % ioinfo)
+      allocate(real0d % ioinfo)
+      allocate(real1d % ioinfo)
+      allocate(real2d % ioinfo)
+      allocate(real3d % ioinfo)
+      allocate(char0d % ioinfo)
+      allocate(char1d % ioinfo)
+
+
+#include &quot;io_input_fields.inc&quot;
+
+#include &quot;nondecomp_dims_dealloc.inc&quot;
+
+   end subroutine mpas_read_and_distribute_fields
+
+
+
+   subroutine mpas_io_input_init(input_obj, dminfo)

+      implicit none
+
+      type (io_input_object), intent(inout) :: input_obj
+      type (dm_info), intent(in) :: dminfo

+      include 'netcdf.inc'

+      integer :: nferr


+#ifdef OFFSET64BIT
+      nferr = nf_open(trim(input_obj % filename), ior(NF_SHARE,NF_64BIT_OFFSET), input_obj % rd_ncid)
+#else
+      nferr = nf_open(trim(input_obj % filename), NF_SHARE, input_obj % rd_ncid)
+#endif
+
+      if (nferr /= NF_NOERR) then
+         write(0,*) ' '
+         if (input_obj % stream == STREAM_RESTART) then
+            write(0,*) 'Error opening restart file ''', trim(input_obj % filename), ''''
+         else if (input_obj % stream == STREAM_INPUT) then
+            write(0,*) 'Error opening input file ''', trim(input_obj % filename), ''''
+         else if (input_obj % stream == STREAM_SFC) then
+            write(0,*) 'Error opening sfc file ''', trim(input_obj % filename), ''''
+         end if
+         write(0,*) ' '
+         call mpas_dmpar_abort(dminfo)
+      end if

+#include &quot;netcdf_read_ids.inc&quot;
+
+   end subroutine mpas_io_input_init
+
+  
+   subroutine mpas_io_input_get_dimension(input_obj, dimname, dimsize)
+
+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj
+      character (len=*), intent(in) :: dimname
+      integer, intent(out) :: dimsize
+
+#include &quot;get_dimension_by_name.inc&quot;
+
+   end subroutine mpas_io_input_get_dimension
+
+   
+   subroutine mpas_io_input_get_att_real(input_obj, attname, attvalue)
+      
+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj
+      character (len=*), intent(in) :: attname
+      real (kind=RKIND), intent(out) :: attvalue
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+
+      if (RKIND == 8) then
+         nferr = nf_get_att_double(input_obj % rd_ncid, NF_GLOBAL, attname, attvalue)
+      else
+         nferr = nf_get_att_real(input_obj % rd_ncid, NF_GLOBAL, attname, attvalue)
+      end if
+      if (nferr /= NF_NOERR) then
+         write(0,*) 'Warning: Attribute '//trim(attname)//&amp;
+           ' not found in '//trim(input_obj % filename)
+         if (index(attname, 'sphere_radius') /= 0) then
+            write(0,*) '   Setting '//trim(attname)//' to 1.0'
+            attvalue = 1.0
+         end if
+      end if
+
+   end subroutine mpas_io_input_get_att_real
+
+   
+   subroutine mpas_io_input_get_att_text(input_obj, attname, attvalue)
+      
+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj
+      character (len=*), intent(in) :: attname
+      character (len=*), intent(out) :: attvalue
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+
+      nferr = nf_get_att_text(input_obj % rd_ncid, NF_GLOBAL, attname, attvalue)
+      if (nferr /= NF_NOERR) then
+         write(0,*) 'Warning: Attribute '//trim(attname)//&amp;
+            ' not found in '//trim(input_obj % filename)
+         if (index(attname, 'on_a_sphere') /= 0) then
+            write(0,*) '   Setting '//trim(attname)//' to ''YES'''
+            attvalue = 'YES'
+         end if
+      end if
+
+   end subroutine mpas_io_input_get_att_text
+
+
+   subroutine mpas_io_input_field0d_real(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field0dReal), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(1) :: start1, count1

+      start1(1) = 1
+      count1(1) = 1
+
+#include &quot;input_field0dreal.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start1, count1, field % scalar)
+#else
+      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start1, count1, field % scalar)
+#endif

+   end subroutine mpas_io_input_field0d_real
+
+
+   subroutine mpas_io_input_field1d_real(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field1dReal), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(1) :: start1, count1

+      start1(1) = field % ioinfo % start(1)
+      count1(1) = field % ioinfo % count(1)
+
+      !
+      ! Special case: we may want to read the xtime variable across the
+      !   time dimension as a 1d array.
+      !
+      if (trim(field % ioinfo % fieldName) == 'xtime') then
+         varID = input_obj % rdVarIDxtime
+      end if

+#include &quot;input_field1dreal.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start1, count1, field % array)
+#else
+      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start1, count1, field % array)
+#endif

+   end subroutine mpas_io_input_field1d_real
+
+
+   subroutine mpas_io_input_field2d_real(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field2dReal), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start2, count2

+      start2(1) = field % ioinfo % start(1)
+      start2(2) = field % ioinfo % start(2)
+      count2(1) = field % ioinfo % count(1)
+      count2(2) = field % ioinfo % count(2)

+#include &quot;input_field2dreal.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start2, count2, field % array)
+#else
+      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start2, count2, field % array)
+#endif
+
+   end subroutine mpas_io_input_field2d_real
+
+
+   subroutine mpas_io_input_field3d_real(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field3dReal), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(3) :: start3, count3

+      start3(1) = field % ioinfo % start(1)
+      start3(2) = field % ioinfo % start(2)
+      start3(3) = field % ioinfo % start(3)
+      count3(1) = field % ioinfo % count(1)
+      count3(2) = field % ioinfo % count(2)
+      count3(3) = field % ioinfo % count(3)

+#include &quot;input_field3dreal.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start3, count3, field % array)
+#else
+      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start3, count3, field % array)
+#endif
+
+   end subroutine mpas_io_input_field3d_real
+
+
+   subroutine mpas_io_input_field0d_real_time(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field0dReal), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(1) :: start1, count1

+      start1(1) = input_obj % time
+      count1(1) = 1

+#include &quot;input_field0dreal_time.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start1, count1, field % scalar)
+#else
+      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start1, count1, field % scalar)
+#endif
+
+   end subroutine mpas_io_input_field0d_real_time
+
+
+   subroutine mpas_io_input_field1d_real_time(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field1dReal), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start2, count2

+      start2(1) = field % ioinfo % start(1)
+      start2(2) = input_obj % time
+      count2(1) = field % ioinfo % count(1)
+      count2(2) = 1

+#include &quot;input_field1dreal_time.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start2, count2, field % array)
+#else
+      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start2, count2, field % array)
+#endif
+
+   end subroutine mpas_io_input_field1d_real_time
+
+
+   subroutine mpas_io_input_field2d_real_time(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field2dReal), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(3) :: start3, count3

+      start3(1) = field % ioinfo % start(1)
+      start3(2) = field % ioinfo % start(2)
+      start3(3) = input_obj % time
+      count3(1) = field % ioinfo % count(1)
+      count3(2) = field % ioinfo % count(2)
+      count3(3) = 1

+#include &quot;input_field2dreal_time.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start3, count3, field % array)
+#else
+      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start3, count3, field % array)
+#endif
+
+   end subroutine mpas_io_input_field2d_real_time
+
+
+   subroutine mpas_io_input_field3d_real_time(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field3dReal), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(4) :: start4, count4

+      start4(1) = field % ioinfo % start(1)
+      start4(2) = field % ioinfo % start(2)
+      start4(3) = field % ioinfo % start(3)
+      start4(4) = input_obj % time
+      count4(1) = field % ioinfo % count(1)
+      count4(2) = field % ioinfo % count(2)
+      count4(3) = field % ioinfo % count(3)
+      count4(4) = 1

+#include &quot;input_field3dreal_time.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_get_vara_double(input_obj % rd_ncid, varID, start4, count4, field % array)
+#else
+      nferr = nf_get_vara_real(input_obj % rd_ncid, varID, start4, count4, field % array)
+#endif
+
+   end subroutine mpas_io_input_field3d_real_time
+
+
+   subroutine mpas_io_input_field1d_integer(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field1dInteger), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(1) :: start1, count1

+      start1(1) = field % ioinfo % start(1)
+      count1(1) = field % ioinfo % count(1)
+      
+#include &quot;input_field1dinteger.inc&quot;
+
+      nferr = nf_get_vara_int(input_obj % rd_ncid, varID, start1, count1, field % array)

+   end subroutine mpas_io_input_field1d_integer
+
+
+   subroutine mpas_io_input_field2d_integer(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field2dInteger), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start2, count2

+      start2(1) = field % ioinfo % start(1)
+      start2(2) = field % ioinfo % start(2)
+      count2(1) = field % ioinfo % count(1)
+      count2(2) = field % ioinfo % count(2)
+
+#include &quot;input_field2dinteger.inc&quot;
+
+      nferr = nf_get_vara_int(input_obj % rd_ncid, varID, start2, count2, field % array)
+
+   end subroutine mpas_io_input_field2d_integer
+
+
+   subroutine mpas_io_input_field1d_integer_time(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field1dInteger), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start2, count2

+      start2(1) = field % ioinfo % start(1)
+      start2(2) = input_obj % time
+      count2(1) = field % ioinfo % count(1)
+      count2(2) = 1

+#include &quot;input_field1dinteger_time.inc&quot;
+
+      nferr = nf_get_vara_int(input_obj % rd_ncid, varID, start2, count2, field % array)
+
+   end subroutine mpas_io_input_field1d_integer_time
+
+
+   subroutine mpas_io_input_field0d_char_time(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field0dChar), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start1, count1

+      start1(1) = 1
+      count1(1) = 64
+      start1(2) = input_obj % time
+      count1(2) = 1

+#include &quot;input_field0dchar_time.inc&quot;
+
+      nferr = nf_get_vara_text(input_obj % rd_ncid, varID, start1, count1, field % scalar)
+
+   end subroutine mpas_io_input_field0d_char_time
+
+
+   subroutine mpas_io_input_field1d_char_time(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field1dChar), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(3) :: start2, count2

+      start2(1) = 1
+      start2(2) = field % ioinfo % start(1)
+      start2(3) = input_obj % time
+      count2(1) = 64
+      count2(2) = field % ioinfo % count(1)
+      count2(3) = 1

+#include &quot;input_field1dchar_time.inc&quot;
+
+      nferr = nf_get_vara_text(input_obj % rd_ncid, varID, start2, count2, field % array)
+
+   end subroutine mpas_io_input_field1d_char_time
+
+
+   subroutine mpas_io_input_field0d_char(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field0dChar), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start1, count1

+      start1(1) = 1
+      count1(1) = 64
+      start1(2) = 1
+      count1(2) = 1
+
+#include &quot;input_field0dchar.inc&quot;
+
+      nferr = nf_get_vara_text(input_obj % rd_ncid, varID, start1, count1, field % scalar)

+   end subroutine mpas_io_input_field0d_char
+
+
+   subroutine mpas_io_input_field1d_char(input_obj, field)

+      implicit none
+
+      type (io_input_object), intent(in) :: input_obj      
+      type (field1dChar), intent(inout) :: field

+      include 'netcdf.inc'

+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start1, count1

+      start1(1) = 1
+      count1(1) = 64
+      start1(2) = field % ioinfo % start(1)
+      count1(2) = field % ioinfo % count(1)
+
+      !
+      ! Special case: we may want to read the xtime variable across the
+      !   time dimension as a 1d array.
+      !
+      if (trim(field % ioinfo % fieldName) == 'xtime') then
+         varID = input_obj % rdVarIDxtime
+      end if

+#include &quot;input_field1dchar.inc&quot;
+
+      nferr = nf_get_vara_text(input_obj % rd_ncid, varID, start1, count1, field % array)

+   end subroutine mpas_io_input_field1d_char
+
+
+   subroutine mpas_io_input_finalize(input_obj, dminfo)

+      implicit none

+      type (io_input_object), intent(inout) :: input_obj
+      type (dm_info), intent(in) :: dminfo
+
+      include 'netcdf.inc'

+      integer :: nferr

+      nferr = nf_close(input_obj % rd_ncid)

+   end subroutine mpas_io_input_finalize

+end module mpas_io_input

Copied: branches/source_condensing/src/framework/mpas_io_output.F (from rev 1114, trunk/mpas/src/framework/mpas_io_output.F)
===================================================================
--- branches/source_condensing/src/framework/mpas_io_output.F                                (rev 0)
+++ branches/source_condensing/src/framework/mpas_io_output.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,865 @@
+module mpas_io_output
+
+   use mpas_grid_types
+   use mpas_dmpar
+   use mpas_sort
+   use mpas_configure
+
+   integer, parameter :: OUTPUT = 1
+   integer, parameter :: RESTART = 2
+   integer, parameter :: SFC = 3

+   type io_output_object
+      integer :: wr_ncid
+      character (len=1024) :: filename
+
+      integer :: time
+
+      integer :: stream
+
+      integer :: wrDimIDStrLen
+#include &quot;io_output_obj_decls.inc&quot;
+
+      logical :: validExchangeLists
+      type (exchange_list), pointer :: sendCellsList, recvCellsList
+      type (exchange_list), pointer :: sendEdgesList, recvEdgesList
+      type (exchange_list), pointer :: sendVerticesList, recvVerticesList
+      type (exchange_list), pointer :: sendVertLevelsList, recvVertLevelsList
+   end type io_output_object
+
+
+   interface mpas_io_output_field
+      module procedure mpas_io_output_field0d_real
+      module procedure mpas_io_output_field1d_real
+      module procedure mpas_io_output_field2d_real
+      module procedure mpas_io_output_field3d_real
+      module procedure mpas_io_output_field1d_integer
+      module procedure mpas_io_output_field2d_integer
+      module procedure mpas_io_output_field0d_char
+      module procedure mpas_io_output_field1d_char
+   end interface mpas_io_output_field
+
+   interface mpas_io_output_field_time
+      module procedure mpas_io_output_field0d_real_time
+      module procedure mpas_io_output_field1d_real_time
+      module procedure mpas_io_output_field2d_real_time
+      module procedure mpas_io_output_field3d_real_time
+      module procedure mpas_io_output_field1d_integer_time
+      module procedure mpas_io_output_field0d_char_time
+      module procedure mpas_io_output_field1d_char_time
+   end interface mpas_io_output_field_time

+
+   contains
+

+   subroutine mpas_output_state_init(output_obj, domain, stream, outputSuffix)
+
+      implicit none
+
+      type (io_output_object), intent(inout) :: output_obj
+      type (domain_type), intent(in) :: domain
+      character (len=*) :: stream
+      character (len=*), optional :: outputSuffix
+
+      character (len=128) :: tempfilename
+
+      type (block_type), pointer :: block_ptr
+#include &quot;output_dim_actual_decls.inc&quot;
+
+      block_ptr =&gt; domain % blocklist
+      nullify(output_obj % sendCellsList)
+      nullify(output_obj % recvCellsList)
+      nullify(output_obj % sendEdgesList)
+      nullify(output_obj % recvEdgesList)
+      nullify(output_obj % sendVerticesList)
+      nullify(output_obj % recvVerticesList)
+      nullify(output_obj % sendVertLevelsList)
+      nullify(output_obj % recvVertLevelsList)
+      output_obj % validExchangeLists = .false.
+
+#include &quot;output_dim_inits.inc&quot;
+
+      call mpas_dmpar_sum_int(domain % dminfo, block_ptr % mesh % nCellsSolve, nCellsGlobal) 
+      call mpas_dmpar_sum_int(domain % dminfo, block_ptr % mesh % nEdgesSolve, nEdgesGlobal) 
+      call mpas_dmpar_sum_int(domain % dminfo, block_ptr % mesh % nVerticesSolve, nVerticesGlobal) 
+      nVertLevelsGlobal = block_ptr % mesh % nVertLevels
+
+      if (trim(stream) == 'OUTPUT') then
+         if(present(outputSuffix)) then
+            call mpas_insert_string_suffix(config_output_name, outputSuffix, tempfilename)
+         else
+            tempfilename = config_output_name
+         end if
+         output_obj % filename = trim(tempfilename)
+         output_obj % stream = OUTPUT
+      else if (trim(stream) == 'RESTART') then
+         output_obj % filename = trim(config_restart_name)
+         output_obj % stream = RESTART
+      else if (trim(stream) == 'SFC') then
+         ! Keep filename as whatever was set by the user
+         output_obj % stream = SFC
+      end if
+
+      ! For now, we assume that a domain consists only of one block,
+      !   although in future, work needs to be done to write model state
+      !   from many distributed blocks
+      call mpas_io_output_init(output_obj, domain % dminfo, &amp;
+                          block_ptr % mesh, &amp;
+#include &quot;output_dim_actual_args.inc&quot;
+                         )
+
+   end subroutine mpas_output_state_init
+
+
+   subroutine mpas_insert_string_suffix(stream, suffix, filename)
+
+      implicit none
+
+      character (len=*), intent(in) :: stream
+      character (len=*), intent(in) :: suffix
+      character (len=*), intent(out) :: filename
+      integer :: length, i
+
+      filename = trim(stream) // '.' // trim(suffix)
+
+      length = len_trim(stream)
+      do i=length-1,1,-1
+         if(stream(i:i) == '.') then
+            filename = trim(stream(:i)) // trim(suffix) // trim(stream(i:))
+            exit
+         end if
+      end do
+
+   end subroutine mpas_insert_string_suffix
+
+
+   subroutine mpas_output_state_for_domain(output_obj, domain, itime)
+   
+      implicit none
+   
+      type (io_output_object), intent(inout) :: output_obj
+      type (domain_type), intent(inout) :: domain
+      integer, intent(in) :: itime
+
+      integer :: i, j
+      integer :: nCellsGlobal
+      integer :: nEdgesGlobal
+      integer :: nVerticesGlobal
+      integer :: nVertLevelsGlobal
+      integer, dimension(:), pointer :: neededCellList
+      integer, dimension(:), pointer :: neededEdgeList
+      integer, dimension(:), pointer :: neededVertexList
+      integer, dimension(:), pointer :: neededVertLevelList
+      integer, dimension(:,:), pointer :: cellsOnCell, edgesOnCell, verticesOnCell, &amp;
+                                          cellsOnEdge, verticesOnEdge, edgesOnEdge, cellsOnVertex, edgesOnVertex
+      integer, dimension(:,:), pointer :: cellsOnCell_save, edgesOnCell_save, verticesOnCell_save, &amp;
+                                          cellsOnEdge_save, verticesOnEdge_save, edgesOnEdge_save, &amp;
+                                          cellsOnVertex_save, edgesOnVertex_save
+      type (field1dInteger) :: int1d
+      type (field2dInteger) :: int2d
+      type (field0dReal) :: real0d
+      type (field1dReal) :: real1d
+      type (field2dReal) :: real2d
+      type (field3dReal) :: real3d
+      type (field0dChar) :: char0d
+      type (field1dChar) :: char1d
+
+      integer :: i1, i2, i3, i4
+
+      integer, dimension(:), pointer :: super_int1d
+      integer, dimension(:,:), pointer :: super_int2d
+      real (kind=RKIND) :: super_real0d
+      real (kind=RKIND), dimension(:), pointer :: super_real1d
+      real (kind=RKIND), dimension(:,:), pointer :: super_real2d
+      real (kind=RKIND), dimension(:,:,:), pointer :: super_real3d
+      character (len=64) :: super_char0d
+      character (len=64), dimension(:), pointer :: super_char1d
+
+#include &quot;nondecomp_outputs.inc&quot;
+
+      output_obj % time = itime
+
+      allocate(int1d % ioinfo)
+      allocate(int2d % ioinfo)
+      allocate(real0d % ioinfo)
+      allocate(real1d % ioinfo)
+      allocate(real2d % ioinfo)
+      allocate(real3d % ioinfo)
+      allocate(char0d % ioinfo)
+      allocate(char1d % ioinfo)
+
+      call mpas_dmpar_sum_int(domain % dminfo, domain % blocklist % mesh % nCellsSolve, nCellsGlobal)
+      call mpas_dmpar_sum_int(domain % dminfo, domain % blocklist % mesh % nEdgesSolve, nEdgesGlobal)
+      call mpas_dmpar_sum_int(domain % dminfo, domain % blocklist % mesh % nVerticesSolve, nVerticesGlobal)
+      nVertLevelsGlobal = domain % blocklist % mesh % nVertLevels
+
+      allocate(cellsOnCell(domain % blocklist % mesh % maxEdges, domain % blocklist % mesh % nCellsSolve))
+      allocate(edgesOnCell(domain % blocklist % mesh % maxEdges, domain % blocklist % mesh % nCellsSolve))
+      allocate(verticesOnCell(domain % blocklist % mesh % maxEdges, domain % blocklist % mesh % nCellsSolve))
+      allocate(cellsOnEdge(2, domain % blocklist % mesh % nEdgesSolve))
+      allocate(verticesOnEdge(2, domain % blocklist % mesh % nEdgesSolve))
+      allocate(edgesOnEdge(2 * domain % blocklist % mesh % maxEdges, domain % blocklist % mesh % nEdgesSolve))
+      allocate(cellsOnVertex(domain % blocklist % mesh % vertexDegree, domain % blocklist % mesh % nVerticesSolve))
+      allocate(edgesOnVertex(domain % blocklist % mesh % vertexDegree, domain % blocklist % mesh % nVerticesSolve))
+
+
+      !
+      ! Convert connectivity information from local to global indices
+      !
+      do i=1,domain % blocklist % mesh % nCellsSolve
+         do j=1,domain % blocklist % mesh % nEdgesOnCell % array(i)
+            cellsOnCell(j,i) = domain % blocklist % mesh % indexToCellID % array( &amp;
+                                                                           domain % blocklist % mesh % cellsOnCell % array(j,i))
+            edgesOnCell(j,i) = domain % blocklist % mesh % indexToEdgeID % array( &amp;
+                                                                           domain % blocklist % mesh % edgesOnCell % array(j,i))
+            verticesOnCell(j,i) = domain % blocklist % mesh % indexToVertexID % array( &amp;
+                                                                           domain % blocklist % mesh % verticesOnCell % array(j,i))
+         end do
+         do j=domain % blocklist % mesh % nEdgesOnCell % array(i)+1,domain % blocklist % mesh % maxEdges
+            cellsOnCell(j,i) = domain % blocklist % mesh % indexToCellID % array( &amp;
+                                                                           domain % blocklist % mesh % nEdgesOnCell % array(i))
+            edgesOnCell(j,i) = domain % blocklist % mesh % indexToEdgeID % array( &amp;
+                                                                           domain % blocklist % mesh % nEdgesOnCell % array(i))
+            verticesOnCell(j,i) = domain % blocklist % mesh % indexToVertexID % array( &amp;
+                                                                           domain % blocklist % mesh % nEdgesOnCell % array(i))
+         end do
+      end do
+      do i=1,domain % blocklist % mesh % nEdgesSolve
+         cellsOnEdge(1,i) = domain % blocklist % mesh % indexToCellID % array(domain % blocklist % mesh % cellsOnEdge % array(1,i))
+         cellsOnEdge(2,i) = domain % blocklist % mesh % indexToCellID % array(domain % blocklist % mesh % cellsOnEdge % array(2,i))
+         verticesOnEdge(1,i) = domain % blocklist % mesh % indexToVertexID % array( &amp;
+                                                                           domain % blocklist % mesh % verticesOnEdge % array(1,i))
+         verticesOnEdge(2,i) = domain % blocklist % mesh % indexToVertexID % array( &amp;
+                                                                           domain % blocklist % mesh % verticesOnEdge % array(2,i))
+         do j=1,domain % blocklist % mesh % nEdgesOnEdge % array(i)
+            edgesOnEdge(j,i) = domain % blocklist % mesh % indexToEdgeID % array( &amp;
+                                                                           domain % blocklist % mesh % edgesOnEdge % array(j,i))
+         end do
+         do j=domain % blocklist % mesh % nEdgesOnEdge % array(i)+1,2*domain % blocklist % mesh % maxEdges
+            if(domain % blocklist % mesh % nEdgesOnEdge % array(i) .eq. 0) then
+               edgesOnEdge(j,i) = domain % blocklist % mesh % nEdgesSolve + 1
+            else
+               edgesOnEdge(j,i) = domain % blocklist % mesh % indexToEdgeID % array( &amp;
+                                                                           domain % blocklist % mesh % nEdgesOnEdge % array(i))
+            endif
+         end do
+      end do
+      do i=1,domain % blocklist % mesh % nVerticesSolve
+         do j=1,domain % blocklist % mesh % vertexDegree
+            cellsOnVertex(j,i) = domain % blocklist % mesh % indexToCellID % array( &amp;
+                                                                           domain % blocklist % mesh % cellsOnVertex % array(j,i))
+            edgesOnVertex(j,i) = domain % blocklist % mesh % indexToEdgeID % array( &amp;
+                                                                           domain % blocklist % mesh % edgesOnVertex % array(j,i))
+         end do
+      end do
+
+      if (domain % dminfo % my_proc_id == 0) then
+         allocate(neededCellList(nCellsGlobal))
+         allocate(neededEdgeList(nEdgesGlobal))
+         allocate(neededVertexList(nVerticesGlobal))
+         allocate(neededVertLevelList(nVertLevelsGlobal))
+         do i=1,nCellsGlobal
+            neededCellList(i) = i
+         end do
+         do i=1,nEdgesGlobal
+            neededEdgeList(i) = i
+         end do
+         do i=1,nVerticesGlobal
+            neededVertexList(i) = i
+         end do
+         do i=1,nVertLevelsGlobal
+            neededVertLevelList(i) = i
+         end do
+      else
+         allocate(neededCellList(0))
+         allocate(neededEdgeList(0))
+         allocate(neededVertexList(0))
+         allocate(neededVertLevelList(0))
+      end if
+
+      if (.not. output_obj % validExchangeLists) then
+         call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                   domain % blocklist % mesh % nCellsSolve, size(neededCellList), &amp;
+                                   domain % blocklist % mesh % indexToCellID % array, neededCellList, &amp;
+                                   output_obj % sendCellsList, output_obj % recvCellsList)
+
+         call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                   domain % blocklist % mesh % nEdgesSolve, size(neededEdgeList), &amp;
+                                   domain % blocklist % mesh % indexToEdgeID % array, neededEdgeList, &amp;
+                                   output_obj % sendEdgesList, output_obj % recvEdgesList)
+
+         call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                   domain % blocklist % mesh % nVerticesSolve, size(neededVertexList), &amp;
+                                   domain % blocklist % mesh % indexToVertexID % array, neededVertexList, &amp;
+                                   output_obj % sendVerticesList, output_obj % recvVerticesList)
+
+         call mpas_dmpar_get_owner_list(domain % dminfo, &amp;
+                                   size(neededVertLevelList), size(neededVertLevelList), &amp;
+                                   neededVertLevelList, neededVertLevelList, &amp;
+                                   output_obj % sendVertLevelsList, output_obj % recvVertLevelsList)
+
+         output_obj % validExchangeLists = .true.
+      end if
+
+      deallocate(neededCellList)
+      deallocate(neededEdgeList)
+      deallocate(neededVertexList)
+
+      cellsOnCell_save =&gt; domain % blocklist % mesh % cellsOnCell % array
+      edgesOnCell_save =&gt; domain % blocklist % mesh % edgesOnCell % array
+      verticesOnCell_save =&gt; domain % blocklist % mesh % verticesOnCell % array
+      cellsOnEdge_save =&gt; domain % blocklist % mesh % cellsOnEdge % array
+      verticesOnEdge_save =&gt; domain % blocklist % mesh % verticesOnEdge % array
+      edgesOnEdge_save =&gt; domain % blocklist % mesh % edgesOnEdge % array
+      cellsOnVertex_save =&gt; domain % blocklist % mesh % cellsOnVertex % array
+      edgesOnVertex_save =&gt; domain % blocklist % mesh % edgesOnVertex % array
+
+      domain % blocklist % mesh % cellsOnCell % array =&gt; cellsOnCell
+      domain % blocklist % mesh % edgesOnCell % array =&gt; edgesOnCell
+      domain % blocklist % mesh % verticesOnCell % array =&gt; verticesOnCell
+      domain % blocklist % mesh % cellsOnEdge % array =&gt; cellsOnEdge
+      domain % blocklist % mesh % verticesOnEdge % array =&gt; verticesOnEdge
+      domain % blocklist % mesh % edgesOnEdge % array =&gt; edgesOnEdge
+      domain % blocklist % mesh % cellsOnVertex % array =&gt; cellsOnVertex
+      domain % blocklist % mesh % edgesOnVertex % array =&gt; edgesOnVertex
+
+#include &quot;io_output_fields.inc&quot;
+
+      domain % blocklist % mesh % cellsOnCell % array =&gt; cellsOnCell_save
+      domain % blocklist % mesh % edgesOnCell % array =&gt; edgesOnCell_save
+      domain % blocklist % mesh % verticesOnCell % array =&gt; verticesOnCell_save
+      domain % blocklist % mesh % cellsOnEdge % array =&gt; cellsOnEdge_save
+      domain % blocklist % mesh % verticesOnEdge % array =&gt; verticesOnEdge_save
+      domain % blocklist % mesh % edgesOnEdge % array =&gt; edgesOnEdge_save
+      domain % blocklist % mesh % cellsOnVertex % array =&gt; cellsOnVertex_save
+      domain % blocklist % mesh % edgesOnVertex % array =&gt; edgesOnVertex_save
+
+      deallocate(cellsOnCell)
+      deallocate(edgesOnCell)
+      deallocate(verticesOnCell)
+      deallocate(cellsOnEdge)
+      deallocate(verticesOnEdge)
+      deallocate(edgesOnEdge)
+      deallocate(cellsOnVertex)
+      deallocate(edgesOnVertex)
+
+#include &quot;nondecomp_outputs_dealloc.inc&quot;
+
+   end subroutine mpas_output_state_for_domain
+
+
+   subroutine mpas_output_state_finalize(output_obj, dminfo)
+
+      implicit none
+
+      type (io_output_object), intent(inout) :: output_obj
+      type (dm_info), intent(in) :: dminfo
+
+      call mpas_io_output_finalize(output_obj, dminfo)
+
+   end subroutine mpas_output_state_finalize
+
+
+   subroutine mpas_io_output_init( output_obj, &amp;
+                              dminfo, &amp;
+                              mesh, &amp;
+#include &quot;dim_dummy_args.inc&quot;
+                            )

+      implicit none

+      include 'netcdf.inc'

+      type (io_output_object), intent(inout) :: output_obj
+      type (dm_info), intent(in) :: dminfo
+      type (mesh_type), intent(in) :: mesh
+#include &quot;dim_dummy_decls.inc&quot;

+      integer :: nferr
+      integer, dimension(10) :: dimlist

+      if (dminfo % my_proc_id == 0) then
+#ifdef OFFSET64BIT
+      nferr = nf_create(trim(output_obj % filename), ior(NF_CLOBBER,NF_64BIT_OFFSET), output_obj % wr_ncid)
+#else
+      nferr = nf_create(trim(output_obj % filename), NF_CLOBBER, output_obj % wr_ncid)
+#endif

+      nferr = nf_def_dim(output_obj % wr_ncid, 'StrLen', 64, output_obj % wrDimIDStrLen)
+#include &quot;netcdf_def_dims_vars.inc&quot;
+
+      if (mesh % on_a_sphere) then
+         nferr = nf_put_att_text(output_obj % wr_ncid, NF_GLOBAL, 'on_a_sphere', 16, 'YES             ')
+      else
+         nferr = nf_put_att_text(output_obj % wr_ncid, NF_GLOBAL, 'on_a_sphere', 16, 'NO              ')
+      end if
+      if (RKIND == 8) then
+         nferr = nf_put_att_double(output_obj % wr_ncid, NF_GLOBAL, 'sphere_radius', NF_DOUBLE, 1, mesh % sphere_radius)
+      else
+         nferr = nf_put_att_real(output_obj % wr_ncid, NF_GLOBAL, 'sphere_radius', NF_FLOAT, 1, mesh % sphere_radius)
+      end if

+      nferr = nf_enddef(output_obj % wr_ncid)
+      end if

+   end subroutine mpas_io_output_init
+
+
+   subroutine mpas_io_output_field0d_real(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field0dReal), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(1) :: start1, count1
+
+      start1(1) = 1
+      count1(1) = 1
+
+#include &quot;output_field0dreal.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start1, count1, field % scalar)
+#else
+      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start1, count1, field % scalar)
+#endif

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field0d_real
+
+
+   subroutine mpas_io_output_field1d_real(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field1dReal), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(1) :: start1, count1
+
+      start1(1) = field % ioinfo % start(1)
+      count1(1) = field % ioinfo % count(1)
+
+#include &quot;output_field1dreal.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_put_vara_double(output_obj % wr_ncid, VarID, start1, count1, field % array)
+#else
+      nferr = nf_put_vara_real(output_obj % wr_ncid, VarID, start1, count1, field % array)
+#endif

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field1d_real


+   subroutine mpas_io_output_field2d_real(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field2dReal), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start2, count2
+
+      start2(1) = field % ioinfo % start(1)
+      start2(2) = field % ioinfo % start(2)
+      count2(1) = field % ioinfo % count(1)
+      count2(2) = field % ioinfo % count(2)
+
+#include &quot;output_field2dreal.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start2, count2, field % array)
+#else
+      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start2, count2, field % array)
+#endif

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field2d_real


+   subroutine mpas_io_output_field3d_real(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field3dReal), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(3) :: start3, count3
+
+      start3(1) = field % ioinfo % start(1)
+      start3(2) = field % ioinfo % start(2)
+      start3(3) = field % ioinfo % start(3)
+      count3(1) = field % ioinfo % count(1)
+      count3(2) = field % ioinfo % count(2)
+      count3(3) = field % ioinfo % count(3)
+
+#include &quot;output_field3dreal.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start3, count3, field % array)
+#else
+      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start3, count3, field % array)
+#endif

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field3d_real
+
+
+   subroutine mpas_io_output_field0d_real_time(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field0dReal), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(1) :: start1, count1
+
+      start1(1) = output_obj % time
+      count1(1) = 1
+
+#include &quot;output_field0dreal_time.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start1, count1, field % scalar)
+#else
+      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start1, count1, field % scalar)
+#endif

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field0d_real_time
+
+
+   subroutine mpas_io_output_field1d_real_time(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field1dReal), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start2, count2
+
+      start2(1) = field % ioinfo % start(1)
+      start2(2) = output_obj % time
+      count2(1) = field % ioinfo % count(1)
+      count2(2) = 1
+
+#include &quot;output_field1dreal_time.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start2, count2, field % array)
+#else
+      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start2, count2, field % array)
+#endif

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field1d_real_time
+
+
+   subroutine mpas_io_output_field2d_real_time(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field2dReal), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(3) :: start3, count3
+
+      start3(1) = field % ioinfo % start(1)
+      start3(2) = field % ioinfo % start(2)
+      start3(3) = output_obj % time
+      count3(1) = field % ioinfo % count(1)
+      count3(2) = field % ioinfo % count(2)
+      count3(3) = 1
+
+#include &quot;output_field2dreal_time.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start3, count3, field % array)
+#else
+      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start3, count3, field % array)
+#endif

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field2d_real_time
+
+
+   subroutine mpas_io_output_field3d_real_time(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field3dReal), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(4) :: start4, count4
+
+      start4(1) = field % ioinfo % start(1)
+      start4(2) = field % ioinfo % start(2)
+      start4(3) = field % ioinfo % start(3)
+      start4(4) = output_obj % time
+      count4(1) = field % ioinfo % count(1)
+      count4(2) = field % ioinfo % count(2)
+      count4(3) = field % ioinfo % count(3)
+      count4(4) = 1
+
+#include &quot;output_field3dreal_time.inc&quot;
+
+#if (RKIND == 8)
+      nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start4, count4, field % array)
+#else
+      nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start4, count4, field % array)
+#endif

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field3d_real_time
+
+
+   subroutine mpas_io_output_field1d_integer(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field1dInteger), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(1) :: start1, count1
+
+      start1(1) = field % ioinfo % start(1)
+      count1(1) = field % ioinfo % count(1)
+
+#include &quot;output_field1dinteger.inc&quot;
+
+      nferr = nf_put_vara_int(output_obj % wr_ncid, varID, start1, count1, field % array)

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field1d_integer
+
+
+   subroutine mpas_io_output_field2d_integer(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field2dInteger), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start2, count2
+
+      start2(1) = field % ioinfo % start(1)
+      start2(2) = field % ioinfo % start(2)
+      count2(1) = field % ioinfo % count(1)
+      count2(2) = field % ioinfo % count(2)
+
+#include &quot;output_field2dinteger.inc&quot;
+
+      nferr = nf_put_vara_int(output_obj % wr_ncid, varID, start2, count2, field % array)

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field2d_integer
+
+
+   subroutine mpas_io_output_field1d_integer_time(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field1dInteger), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start2, count2
+
+      start2(1) = field % ioinfo % start(1)
+      start2(2) = output_obj % time
+      count2(1) = field % ioinfo % count(1)
+      count2(2) = 1
+
+#include &quot;output_field1dinteger_time.inc&quot;
+
+      nferr = nf_put_vara_int(output_obj % wr_ncid, varID, start2, count2, field % array)

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field1d_integer_time
+
+
+   subroutine mpas_io_output_field0d_char_time(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field0dChar), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start1, count1
+
+      start1(1) = 1
+      count1(1) = 64
+      start1(2) = output_obj % time
+      count1(2) = 1
+
+#include &quot;output_field0dchar_time.inc&quot;
+
+      nferr = nf_put_vara_text(output_obj % wr_ncid, varID, start1, count1, field % scalar)

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field0d_char_time
+
+
+   subroutine mpas_io_output_field1d_char_time(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field1dChar), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(3) :: start2, count2
+
+      start2(1) = 1
+      start2(2) = field % ioinfo % start(1)
+      start2(3) = output_obj % time
+      count2(1) = 64
+      count2(2) = field % ioinfo % count(1)
+      count2(3) = 1
+
+#include &quot;output_field1dchar_time.inc&quot;
+
+      nferr = nf_put_vara_text(output_obj % wr_ncid, varID, start2, count2, field % array)

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field1d_char_time
+
+
+   subroutine mpas_io_output_field0d_char(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field0dChar), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start1, count1
+
+      start1(1) = 1
+      count1(1) = 64
+      start1(2) = 1
+      count1(2) = 1
+
+#include &quot;output_field0dchar.inc&quot;
+
+      nferr = nf_put_vara_text(output_obj % wr_ncid, varID, start1, count1, field % scalar)

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field0d_char
+
+
+   subroutine mpas_io_output_field1d_char(output_obj, field)
+
+      implicit none
+
+      type (io_output_object), intent(in) :: output_obj
+      type (field1dChar), intent(inout) :: field
+
+      include 'netcdf.inc'
+
+      integer :: nferr
+      integer :: varID
+      integer, dimension(2) :: start1, count1
+
+      start1(1) = 1
+      count1(1) = 64
+      start1(2) = field % ioinfo % start(1)
+      count1(2) = field % ioinfo % count(1)
+
+#include &quot;output_field1dchar.inc&quot;
+
+      nferr = nf_put_vara_text(output_obj % wr_ncid, VarID, start1, count1, field % array)

+      nferr = nf_sync(output_obj % wr_ncid)
+
+   end subroutine mpas_io_output_field1d_char
+
+
+   subroutine mpas_io_output_finalize(output_obj, dminfo)

+      implicit none

+      include 'netcdf.inc'
+
+      type (io_output_object), intent(inout) :: output_obj
+      type (dm_info), intent(in) :: dminfo

+      integer :: nferr

+      if (dminfo % my_proc_id == 0) then
+      nferr = nf_close(output_obj % wr_ncid)
+      end if

+   end subroutine mpas_io_output_finalize

+end module mpas_io_output

Copied: branches/source_condensing/src/framework/mpas_sort.F (from rev 1114, trunk/mpas/src/framework/mpas_sort.F)
===================================================================
--- branches/source_condensing/src/framework/mpas_sort.F                                (rev 0)
+++ branches/source_condensing/src/framework/mpas_sort.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,230 @@
+module mpas_sort
+
+   interface quicksort
+      module procedure mpas_quicksort_int
+      module procedure mpas_quicksort_real
+   end interface
+
+
+   contains
+
+
+   recursive subroutine mpas_mergesort(array, d1, n1, n2)
+   
+      implicit none
+   
+      ! Arguments
+      integer, intent(in) :: n1, n2, d1
+      integer, dimension(1:d1,n1:n2), intent(inout) :: array
+   
+      ! Local variables
+      integer :: i, j, k
+      integer :: rtemp
+      integer, dimension(1:d1,1:n2-n1+1) :: temp
+   
+      if (n1 &gt;= n2) return
+   
+      if (n2 - n1 == 1) then
+        if (array(1,n1) &gt; array(1,n2)) then
+           do i=1,d1
+              rtemp = array(i,n1)
+              array(i,n1) = array(i,n2)
+              array(i,n2) = rtemp
+           end do
+        end if
+        return
+      end if
+   
+      call mpas_mergesort(array(1:d1,n1:n1+(n2-n1+1)/2), d1, n1, n1+(n2-n1+1)/2)
+      call mpas_mergesort(array(1:d1,n1+((n2-n1+1)/2)+1:n2), d1, n1+((n2-n1+1)/2)+1, n2)
+   
+      i = n1
+      j = n1 + ((n2-n1+1)/2) + 1
+      k = 1
+      do while (i &lt;= n1+(n2-n1+1)/2 .and. j &lt;= n2)
+        if (array(1,i) &lt; array(1,j)) then
+          temp(1:d1,k) = array(1:d1,i)
+          k = k + 1
+          i = i + 1
+        else
+          temp(1:d1,k) = array(1:d1,j)
+          k = k + 1
+          j = j + 1
+        end if
+      end do
+   
+      if (i &lt;= n1+(n2-n1+1)/2) then
+        do while (i &lt;= n1+(n2-n1+1)/2)
+          temp(1:d1,k) = array(1:d1,i)
+          i = i + 1
+          k = k + 1
+        end do
+      else
+        do while (j &lt;= n2)
+          temp(1:d1,k) = array(1:d1,j)
+          j = j + 1
+          k = k + 1
+        end do
+      end if
+   
+      array(1:d1,n1:n2) = temp(1:d1,1:k-1)
+   
+   end subroutine mpas_mergesort
+
+
+   subroutine mpas_quicksort_int(nArray, array)
+
+      implicit none
+
+      integer, intent(in) :: nArray
+      integer, dimension(2,nArray), intent(inout) :: array
+
+      integer :: i, j, top, l, r, pivot, s
+      integer :: pivot_value
+      integer, dimension(2) :: temp
+      integer, dimension(1000) :: lstack, rstack
+
+      if (nArray &lt; 1) return
+
+      top = 1
+      lstack(top) = 1
+      rstack(top) = nArray
+
+      do while (top &gt; 0)
+
+         l = lstack(top)
+         r = rstack(top)
+         top = top - 1
+
+         pivot = (l+r)/2
+
+         pivot_value = array(1,pivot)
+         temp(:) = array(:,pivot)
+         array(:,pivot) = array(:,r)
+         array(:,r) = temp(:)
+
+         s = l
+         do i=l,r-1
+            if (array(1,i) &lt;= pivot_value) then
+               temp(:) = array(:,s)
+               array(:,s) = array(:,i)
+               array(:,i) = temp(:)
+               s = s + 1
+            end if
+         end do
+
+         temp(:) = array(:,s)
+         array(:,s) = array(:,r)
+         array(:,r) = temp(:)
+
+         if (s-1 &gt; l) then
+            top = top + 1
+if (top &gt; 1000) write(0,*) 'Error: Quicksort exhausted its stack.'
+            lstack(top) = l
+            rstack(top) = s-1
+         end if
+
+         if (r &gt; s+1) then
+            top = top + 1
+if (top &gt; 1000) write(0,*) 'Error: Quicksort exhausted its stack.'
+            lstack(top) = s+1
+            rstack(top) = r
+         end if
+      end do
+
+   end subroutine mpas_quicksort_int
+
+
+   subroutine mpas_quicksort_real(nArray, array)
+
+      implicit none
+
+      integer, intent(in) :: nArray
+      real (kind=RKIND), dimension(2,nArray), intent(inout) :: array
+
+      integer :: i, j, top, l, r, pivot, s
+      real (kind=RKIND) :: pivot_value
+      real (kind=RKIND), dimension(2) :: temp
+      integer, dimension(1000) :: lstack, rstack
+
+      if (nArray &lt; 1) return
+
+      top = 1
+      lstack(top) = 1
+      rstack(top) = nArray
+
+      do while (top &gt; 0)
+
+         l = lstack(top)
+         r = rstack(top)
+         top = top - 1
+
+         pivot = (l+r)/2
+
+         pivot_value = array(1,pivot)
+         temp(:) = array(:,pivot)
+         array(:,pivot) = array(:,r)
+         array(:,r) = temp(:)
+
+         s = l
+         do i=l,r-1
+            if (array(1,i) &lt;= pivot_value) then
+               temp(:) = array(:,s)
+               array(:,s) = array(:,i)
+               array(:,i) = temp(:)
+               s = s + 1
+            end if
+         end do
+
+         temp(:) = array(:,s)
+         array(:,s) = array(:,r)
+         array(:,r) = temp(:)
+
+         if (s-1 &gt; l) then
+            top = top + 1
+if (top &gt; 1000) write(0,*) 'Error: Quicksort exhausted its stack.'
+            lstack(top) = l
+            rstack(top) = s-1
+         end if
+
+         if (r &gt; s+1) then
+            top = top + 1
+if (top &gt; 1000) write(0,*) 'Error: Quicksort exhausted its stack.'
+            lstack(top) = s+1
+            rstack(top) = r
+         end if
+      end do
+
+   end subroutine mpas_quicksort_real
+
+
+   integer function mpas_binary_search(array, d1, n1, n2, key)
+
+      implicit none
+
+      integer, intent(in) :: d1, n1, n2, key
+      integer, dimension(d1,n1:n2), intent(in) :: array
+
+      integer :: l, u, k
+
+      mpas_binary_search = n2+1
+
+      l = n1
+      u = n2
+      k = (l+u)/2
+      do while (u &gt;= l)
+         if (array(1,k) == key) then
+            mpas_binary_search = k
+            exit   
+         else if (array(1,k) &lt; key) then
+            l = k + 1
+            k = (l+u)/2
+         else   
+            u = k - 1
+            k = (l+u)/2
+         end if 
+      end do 
+
+   end function mpas_binary_search
+
+end module mpas_sort

Copied: branches/source_condensing/src/framework/mpas_timekeeping.F (from rev 1114, trunk/mpas/src/framework/mpas_timekeeping.F)
===================================================================
--- branches/source_condensing/src/framework/mpas_timekeeping.F                                (rev 0)
+++ branches/source_condensing/src/framework/mpas_timekeeping.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,1625 @@
+module mpas_timekeeping
+
+   use ESMF_BaseMod
+   use ESMF_Stubs
+   use ESMF_CalendarMod
+   use ESMF_ClockMod
+   use ESMF_TimeMod
+   use ESMF_TimeIntervalMod
+
+   private :: mpas_calibrate_alarms
+   private :: mpas_in_ringing_envelope
+
+   integer, parameter :: MPAS_MAX_ALARMS = 20
+   integer, parameter :: MPAS_NOW = 0, &amp;
+                         MPAS_START_TIME = 1, &amp;
+                         MPAS_STOP_TIME = 2
+   integer, parameter :: MPAS_FORWARD = 1, &amp;
+                         MPAS_BACKWARD = -1
+   integer, parameter :: MPAS_GREGORIAN = 0, &amp;
+                         MPAS_GREGORIAN_NOLEAP = 1, &amp;
+                         MPAS_360DAY = 2
+
+   integer :: TheCalendar 
+
+   integer, dimension(12), parameter :: daysInMonth     = (/31,28,31,30,31,30,31,31,30,31,30,31/)
+   integer, dimension(12), parameter :: daysInMonthLeap = (/31,29,31,30,31,30,31,31,30,31,30,31/)
+
+
+   type MPAS_Time_type
+      type (ESMF_Time) :: t
+   end type
+
+   type MPAS_TimeInterval_type
+      type (ESMF_TimeInterval) :: ti
+   end type
+
+   type MPAS_Alarm_type
+      integer :: alarmID
+      logical :: isRecurring
+      logical :: isSet
+      type (MPAS_Time_type) :: ringTime
+      type (MPAS_Time_type) :: prevRingTime
+      type (MPAS_TimeInterval_type) :: ringTimeInterval
+      type (MPAS_Alarm_type), pointer :: next
+   end type
+   
+   type MPAS_Clock_type
+      integer :: direction
+      integer :: nAlarms
+      type (ESMF_Clock) :: c
+      type (MPAS_Alarm_type), pointer :: alarmListHead
+   end type
+
+   interface operator (+)
+      module procedure add_t_ti
+      module procedure add_ti_ti
+   end interface
+
+   interface operator (-)
+      module procedure sub_t_t
+      module procedure sub_t_ti
+      module procedure sub_ti_ti
+      module procedure neg_ti
+   end interface
+
+   interface operator (*)
+      module procedure mul_ti_n
+   end interface
+
+   interface operator (/)
+      module procedure div_ti_n
+   end interface
+
+   interface operator (.EQ.)
+      module procedure eq_t_t
+      module procedure eq_ti_ti
+   end interface
+
+   interface operator (.NE.)
+      module procedure ne_t_t
+      module procedure ne_ti_ti
+   end interface
+
+   interface operator (.LT.)
+      module procedure lt_t_t
+      module procedure lt_ti_ti
+   end interface
+
+   interface operator (.GT.)
+      module procedure gt_t_t
+      module procedure gt_ti_ti
+   end interface
+
+   interface operator (.LE.)
+      module procedure le_t_t
+      module procedure le_ti_ti
+   end interface
+
+   interface operator (.GE.)
+      module procedure ge_t_t
+      module procedure ge_ti_ti
+   end interface
+
+   interface abs
+      module procedure abs_ti
+   end interface
+
+
+   contains
+
+
+   subroutine mpas_timekeeping_init(calendar)
+
+      implicit none
+
+      integer, intent(in) :: calendar 
+
+      TheCalendar = calendar
+
+      if (TheCalendar == MPAS_GREGORIAN) then
+         call ESMF_Initialize(defaultCalendar=ESMF_CAL_GREGORIAN)
+      else if (TheCalendar == MPAS_GREGORIAN_NOLEAP) then
+         call ESMF_Initialize(defaultCalendar=ESMF_CAL_NOLEAP)
+      else if (TheCalendar == MPAS_360DAY) then
+         call ESMF_Initialize(defaultCalendar=ESMF_CAL_360DAY)
+      else
+         write(0,*) 'ERROR: mpas_timekeeping_init: Invalid calendar type'
+      end if
+
+   end subroutine mpas_timekeeping_init
+
+
+   subroutine mpas_timekeeping_finalize()
+
+      implicit none
+
+      call ESMF_Finalize()
+
+   end subroutine mpas_timekeeping_finalize
+
+
+   subroutine mpas_create_clock(clock, startTime, timeStep, stopTime, runDuration, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(out) :: clock
+      type (MPAS_Time_type), intent(in) :: startTime
+      type (MPAS_TimeInterval_type), intent(in) :: timeStep
+      type (MPAS_Time_type), intent(in), optional :: stopTime
+      type (MPAS_TimeInterval_type), intent(in), optional :: runDuration
+      integer, intent(out), optional :: ierr
+
+      type (MPAS_Time_type) :: stop_time
+
+      if (present(runDuration)) then
+         stop_time = startTime + runDuration
+         if (present(stopTime)) then
+            if (stopTime /= stop_time) then
+               if (present(ierr)) ierr = 1   ! stopTime and runDuration are inconsistent
+               write(0,*) 'ERROR: MPAS_createClock: stopTime and runDuration are inconsistent'
+               return
+            end if
+         end if
+      else if (present(stopTime)) then 
+         stop_time = stopTime
+      else
+         if (present(ierr)) ierr = 1   ! neither stopTime nor runDuration are specified
+         write(0,*) 'ERROR: MPAS_createClock: neither stopTime nor runDuration are specified'
+         return
+      end if
+
+      clock % c = ESMF_ClockCreate(TimeStep=timeStep%ti, StartTime=startTime%t, StopTime=stop_time%t, rc=ierr)
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+      clock % direction = MPAS_FORWARD
+      clock % nAlarms = 0
+      nullify(clock % alarmListHead)
+
+   end subroutine mpas_create_clock
+
+
+   subroutine mpas_destroy_clock(clock, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(inout) :: clock
+      integer, intent(out), optional :: ierr
+
+      type (MPAS_Alarm_type), pointer :: alarmPtr
+
+      alarmPtr =&gt; clock % alarmListHead
+      do while (associated(alarmPtr))
+         clock % alarmListHead =&gt; alarmPtr % next
+         deallocate(alarmPtr)
+         alarmPtr =&gt; clock % alarmListHead
+      end do
+
+      call ESMF_ClockDestroy(clock % c, rc=ierr)
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+   end subroutine mpas_destroy_clock
+
+
+   logical function mpas_is_clock_start_time(clock, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(in) :: clock
+      integer, intent(out), optional :: ierr
+
+      type (ESMF_Time) :: currTime, startTime, stopTime
+
+      call ESMF_ClockGet(clock % c, CurrTime=currTime, rc=ierr)
+      call ESMF_ClockGet(clock % c, StartTime=startTime, rc=ierr)
+      call ESMF_ClockGet(clock % c, StopTime=stopTime, rc=ierr)
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+      if (startTime &lt;= stopTime) then
+         mpas_is_clock_start_time = (currTime &lt;= startTime)
+      else
+         mpas_is_clock_start_time = (currTime &gt;= startTime)
+      end if
+
+   end function mpas_is_clock_start_time
+
+
+   logical function mpas_is_clock_stop_time(clock, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(in) :: clock
+      integer, intent(out), optional :: ierr
+
+      type (ESMF_Time) :: currTime, startTime, stopTime
+
+      call ESMF_ClockGet(clock % c, CurrTime=currTime, rc=ierr)
+      call ESMF_ClockGet(clock % c, StartTime=startTime, rc=ierr)
+      call ESMF_ClockGet(clock % c, StopTime=stopTime, rc=ierr)
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+      if (startTime &lt;= stopTime) then
+         mpas_is_clock_stop_time = (currTime &gt;= stopTime)
+      else
+         mpas_is_clock_stop_time = (currTime &lt;= stopTime)
+      end if
+
+   end function mpas_is_clock_stop_time
+
+
+   subroutine mpas_set_clock_direction(clock, direction, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(inout) :: clock
+      integer, intent(in) :: direction
+      integer, intent(out), optional :: ierr
+
+      type (MPAS_TimeInterval_type) :: timeStep
+
+      if (direction == MPAS_FORWARD .and. clock % direction == MPAS_FORWARD) return
+      if (direction == MPAS_BACKWARD .and. clock % direction == MPAS_BACKWARD) return
+
+      clock % direction = direction
+      call ESMF_ClockGet(clock % c, TimeStep=timeStep%ti, rc=ierr)
+      timeStep = neg_ti(timeStep)
+      call ESMF_ClockSet(clock % c, TimeStep=timeStep%ti, rc=ierr)
+
+      ! specify a valid previousRingTime for each alarm
+      call mpas_calibrate_alarms(clock, ierr);
+
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+   end subroutine mpas_set_clock_direction
+
+
+
+   integer function mpas_get_clock_direction(clock, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(in) :: clock
+      integer, intent(out), optional :: ierr
+
+      if (present(ierr)) ierr = 0
+
+      mpas_get_clock_direction = clock % direction
+
+   end function mpas_get_clock_direction
+
+
+   subroutine mpas_set_clock_timestep(clock, timeStep, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(inout) :: clock
+      type (MPAS_TimeInterval_type), intent(in) :: timeStep
+      integer, intent(out), optional :: ierr
+
+      call ESMF_ClockSet(clock % c, TimeStep=timeStep%ti, rc=ierr)
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+   end subroutine mpas_set_clock_timestep
+
+
+   type (MPAS_TimeInterval_type) function mpas_get_clock_timestep(clock, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(in) :: clock
+      integer, intent(out), optional :: ierr
+
+      type (MPAS_TimeInterval_type) :: timeStep
+
+      call ESMF_ClockGet(clock % c, TimeStep=timeStep%ti, rc=ierr)
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+      mpas_get_clock_timestep = timeStep
+
+   end function mpas_get_clock_timestep
+
+
+   subroutine mpas_advance_clock(clock, timeStep, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(inout) :: clock
+      type (MPAS_TimeInterval_type), intent(in), optional :: timeStep
+      integer, intent(out), optional :: ierr
+
+      type (ESMF_TimeInterval) :: time_step
+
+      if (present(timeStep)) then
+         call ESMF_ClockGet(clock % c, TimeStep=time_step, rc=ierr)
+         call ESMF_ClockSet(clock % c, TimeStep=timeStep % ti, rc=ierr)
+         call ESMF_ClockAdvance(clock % c, rc=ierr)
+         call ESMF_ClockSet(clock % c, TimeStep=time_step, rc=ierr)
+      else
+         call ESMF_ClockAdvance(clock % c, rc=ierr)
+      end if
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+   end subroutine mpas_advance_clock
+
+
+   subroutine mpas_set_clock_time(clock, clock_time, whichTime, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(inout) :: clock
+      type (MPAS_Time_type), intent(in) :: clock_time
+      integer, intent(in) :: whichTime
+      integer, intent(out), optional :: ierr
+
+      if (whichTime == MPAS_NOW) then
+         call ESMF_ClockSet(clock % c, CurrTime=clock_time%t, rc=ierr)
+         call mpas_calibrate_alarms(clock, ierr);
+      else if (whichTime == MPAS_START_TIME) then
+         call ESMF_ClockSet(clock % c, StartTime=clock_time%t, rc=ierr)
+      else if (whichTime == MPAS_STOP_TIME) then
+         call ESMF_ClockSet(clock % c, StopTime=clock_time%t, rc=ierr)
+      else if (present(ierr)) then
+         ierr = 1
+      end if
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+   end subroutine mpas_set_clock_time
+
+
+   type (MPAS_Time_type) function mpas_get_clock_time(clock, whichTime, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(in) :: clock
+      integer, intent(in) :: whichTime
+      integer, intent(out), optional :: ierr
+
+      type (MPAS_Time_type) :: clock_time
+
+      if (whichTime == MPAS_NOW) then
+         call ESMF_ClockGet(clock % c, CurrTime=clock_time%t, rc=ierr)
+      else if (whichTime == MPAS_START_TIME) then
+         call ESMF_ClockGet(clock % c, StartTime=clock_time%t, rc=ierr)
+      else if (whichTime == MPAS_STOP_TIME) then
+         call ESMF_ClockGet(clock % c, StopTime=clock_time%t, rc=ierr)
+      else if (present(ierr)) then
+         ierr = 1
+      end if
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+      mpas_get_clock_time = clock_time
+
+   end function mpas_get_clock_time
+
+
+   subroutine mpas_add_clock_alarm(clock, alarmID, alarmTime, alarmTimeInterval, ierr)
+! TODO: possibly add a stop time for recurring alarms
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(inout) :: clock
+      integer, intent(in) :: alarmID
+      type (MPAS_Time_type), intent(in) :: alarmTime
+      type (MPAS_TimeInterval_type), intent(in), optional :: alarmTimeInterval
+      integer, intent(out), optional :: ierr
+
+      type (MPAS_Alarm_type), pointer :: alarmPtr
+
+      ! Add a new entry to the linked list of alarms for this clock
+      if (.not. associated(clock % alarmListHead)) then
+         allocate(clock % alarmListHead)
+         nullify(clock % alarmListHead % next)
+         alarmPtr =&gt; clock % alarmListHead
+      else
+         alarmPtr =&gt; clock % alarmListHead
+         do while (associated(alarmPtr % next))
+            if (alarmPtr % alarmID == alarmID) then
+               write(0,*) 'OOPS -- we have a duplicate alarmID', alarmID
+               if (present(ierr)) ierr = 1
+               return
+            end if
+            alarmPtr =&gt; alarmPtr % next
+         end do
+            if (alarmPtr % alarmID == alarmID) then
+               write(0,*) 'OOPS -- we have a duplicate alarmID', alarmID
+               if (present(ierr)) ierr = 1
+               return
+            end if
+         allocate(alarmPtr % next)
+         alarmPtr =&gt; alarmPtr % next
+         nullify(alarmPtr % next)
+      end if
+
+      alarmPtr % alarmID = alarmID
+
+      clock % nAlarms = clock % nAlarms + 1
+
+      alarmPtr % isSet = .true.
+      alarmPtr % ringTime = alarmTime
+      
+
+      if (present(alarmTimeInterval)) then
+         alarmPtr % isRecurring = .true.
+         alarmPtr % ringTimeInterval = alarmTimeInterval
+         if(clock % direction == MPAS_FORWARD) then
+            alarmPtr % prevRingTime = alarmTime - alarmTimeInterval
+         else
+            alarmPtr % prevRingTime = alarmTime + alarmTimeInterval         
+         end if
+      else
+         alarmPtr % isRecurring = .false.
+         alarmPtr % prevRingTime = alarmTime
+      end if
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+   end subroutine mpas_add_clock_alarm
+
+
+   subroutine mpas_remove_clock_alarm(clock, alarmID, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(inout) :: clock
+      integer, intent(in) :: alarmID
+      integer, intent(out), optional :: ierr
+
+      type (MPAS_Alarm_type), pointer :: alarmPtr
+      type (MPAS_Alarm_type), pointer :: alarmParentPtr
+
+      if (present(ierr)) ierr = 0
+
+      alarmPtr =&gt; clock % alarmListHead
+      alarmParentPtr = alarmPtr
+      do while (associated(alarmPtr))
+         if (alarmPtr % alarmID == alarmID) then
+            alarmParentPtr % next =&gt; alarmPtr % next
+            deallocate(alarmPtr)
+            exit
+         end if
+         alarmParentPtr = alarmPtr
+         alarmPtr =&gt; alarmPtr % next
+      end do
+
+   end subroutine mpas_remove_clock_alarm
+
+
+
+   subroutine mpas_print_alarm(clock, alarmID, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(in) :: clock
+      integer, intent(in) :: alarmID
+      integer, intent(out) :: ierr
+
+      type (MPAS_Alarm_type), pointer :: alarmPtr
+
+      type (MPAS_TimeInterval_type) :: alarmTimeInterval
+      type (MPAS_Time_type) :: alarmTime
+      character (len=32) :: printString
+
+      ierr = 0
+
+      alarmPtr =&gt; clock % alarmListHead
+      do while (associated(alarmPtr))
+         if (alarmPtr % alarmID == alarmID) then
+            write(0,*) 'ALARM ', alarmID
+
+            write(0,*) 'isRecurring', alarmPtr % isRecurring
+            
+            write(0,*) 'isSet', alarmPtr % isSet
+
+            call mpas_get_time(alarmPtr % ringTime, dateTimeString=printString, ierr=ierr)
+            write(0,*) 'ringTime', printString
+
+            call mpas_get_time(alarmPtr % prevRingTime, dateTimeString=printString, ierr=ierr)
+            write(0,*) 'prevRingTime', printString
+
+            call mpas_get_timeInterval(alarmPtr % ringTimeInterval, timeString=printString, ierr=ierr)
+            write(0,*) 'ringTimeInterval', printString
+            
+            exit
+         end if
+         alarmPtr =&gt; alarmPtr % next
+      end do
+
+   end subroutine mpas_print_alarm
+
+
+
+   logical function mpas_is_alarm_ringing(clock, alarmID, interval, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(in) :: clock
+      integer, intent(in) :: alarmID
+      type (MPAS_TimeInterval_type), intent(in), optional :: interval
+      integer, intent(out), optional :: ierr
+
+      type (MPAS_Alarm_type), pointer :: alarmPtr
+
+      if (present(ierr)) ierr = 0
+
+      mpas_is_alarm_ringing = .false.
+      
+      alarmPtr =&gt; clock % alarmListHead
+      do while (associated(alarmPtr))
+         if (alarmPtr % alarmID == alarmID) then
+            if (alarmPtr % isSet) then
+               if (mpas_in_ringing_envelope(clock, alarmPtr, interval, ierr)) then
+                  mpas_is_alarm_ringing = .true.
+               end if
+            end if
+            exit
+         end if
+         alarmPtr =&gt; alarmPtr % next
+      end do
+
+   end function mpas_is_alarm_ringing
+
+
+
+   subroutine mpas_get_clock_ringing_alarms(clock, nAlarms, alarmList, interval, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(in) :: clock
+      integer, intent(out) :: nAlarms
+      integer, dimension(MPAS_MAX_ALARMS), intent(out) :: alarmList
+      type (MPAS_TimeInterval_type), intent(in), optional :: interval
+      integer, intent(out), optional :: ierr
+
+      type (MPAS_Alarm_type), pointer :: alarmPtr
+
+      if (present(ierr)) ierr = 0
+
+      nAlarms = 0
+
+      alarmPtr =&gt; clock % alarmListHead
+      do while (associated(alarmPtr))
+         if (alarmPtr % isSet) then
+            if (mpas_in_ringing_envelope(clock, alarmPtr, interval, ierr)) then
+               nAlarms = nAlarms + 1
+               alarmList(nAlarms) = alarmPtr % alarmID
+            end if
+         end if
+         alarmPtr =&gt; alarmPtr % next
+      end do
+
+   end subroutine mpas_get_clock_ringing_alarms
+
+
+   logical function mpas_in_ringing_envelope(clock, alarmPtr, interval, ierr)
+
+      implicit none
+      
+      type (MPAS_Clock_type), intent(in) :: clock
+      type (MPAS_Alarm_type), pointer, intent(in) :: alarmPtr
+      type (MPAS_TimeInterval_type), intent(in), optional :: interval
+      integer, intent(out), optional :: ierr
+      
+      type (MPAS_Time_type) :: alarmNow
+      type (MPAS_Time_type) :: alarmThreshold
+
+      alarmNow = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+      alarmThreshold = alarmPtr % ringTime 
+      
+      mpas_in_ringing_envelope = .false.      
+               
+      if(clock % direction == MPAS_FORWARD) then
+
+         if (present(interval)) then
+            alarmNow = alarmNow + interval; 
+         end if
+
+         if (alarmPtr % isRecurring) then
+            alarmThreshold = alarmPtr % prevRingTime + alarmPtr % ringTimeInterval
+         end if
+
+         if (alarmThreshold &lt;= alarmNow) then
+            mpas_in_ringing_envelope = .true.
+         end if
+      else
+
+         if (present(interval)) then
+            alarmNow = alarmNow - interval; 
+         end if
+
+         if (alarmPtr % isRecurring) then
+            alarmThreshold = alarmPtr % prevRingTime - alarmPtr % ringTimeInterval
+         end if
+            
+         if (alarmThreshold &gt;= alarmNow) then
+            mpas_in_ringing_envelope = .true.
+         end if
+      end if
+
+   end function mpas_in_ringing_envelope
+
+
+
+   subroutine mpas_reset_clock_alarm(clock, alarmID, interval, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(inout) :: clock
+      integer, intent(in) :: alarmID
+      type (MPAS_TimeInterval_type), intent(in), optional :: interval
+      integer, intent(out), optional :: ierr
+
+      type (MPAS_Time_type) :: alarmNow
+      type (MPAS_Alarm_type), pointer :: alarmPtr
+
+      if (present(ierr)) ierr = 0
+
+      alarmPtr =&gt; clock % alarmListHead
+      do while (associated(alarmPtr))
+      
+         if (alarmPtr % alarmID == alarmID) then
+
+            if (mpas_in_ringing_envelope(clock, alarmPtr, interval, ierr)) then
+
+               if (.not. alarmPtr % isRecurring) then
+                  alarmPtr % isSet = .false. 
+               else
+                  alarmNow = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+
+                  if(clock % direction == MPAS_FORWARD) then
+                     if (present(interval)) then
+                        alarmNow = alarmNow + interval
+                     end if
+
+                     do while(alarmPtr % prevRingTime &lt;= alarmNow)
+                        alarmPtr % prevRingTime = alarmPtr % prevRingTime + alarmPtr % ringTimeInterval
+                     end do
+                     alarmPtr % prevRingTime =  alarmPtr % prevRingTime - alarmPtr % ringTimeInterval
+                  else
+                     if (present(interval)) then
+                        alarmNow = alarmNow - interval
+                     end if
+
+                     do while(alarmPtr % prevRingTime &gt;= alarmNow)
+                        alarmPtr % prevRingTime = alarmPtr % prevRingTime - alarmPtr % ringTimeInterval
+                     end do
+                     alarmPtr % prevRingTime = alarmPtr % prevRingTime + alarmPtr % ringTimeInterval
+                  end if
+               end if
+            end if
+            exit
+         end if
+         alarmPtr =&gt; alarmPtr % next
+      end do
+
+   end subroutine mpas_reset_clock_alarm
+
+
+
+   ! specify a valid previousRingTime for each alarm
+   subroutine mpas_calibrate_alarms(clock, ierr)
+
+      implicit none
+
+      type (MPAS_Clock_type), intent(in) :: clock
+      integer, intent(out), optional :: ierr
+
+      type (MPAS_Time_type) :: now
+      type (MPAS_Time_type) :: previousRingTime
+      type (MPAS_Time_type) :: negativeNeighborRingTime
+      type (MPAS_Time_type) :: positiveNeighborRingTime
+      type (MPAS_TimeInterval_type) :: ringTimeInterval 
+      type (MPAS_Alarm_type), pointer :: alarmPtr
+
+      now = mpas_get_clock_time(clock, MPAS_NOW, ierr)
+      
+      alarmPtr =&gt; clock % alarmListHead
+      do while (associated(alarmPtr))
+         
+         if (.not. alarmPtr % isRecurring) then
+            alarmPtr % isSet = .true.            
+         else
+         
+            previousRingTime = alarmPtr % prevRingTime
+
+            if (previousRingTime &lt;= now) then
+            
+               do while(previousRingTime &lt;= now)
+                  previousRingTime = previousRingTime + alarmPtr % ringTimeInterval
+               end do
+               positiveNeighborRingTime = previousRingTime
+            
+               do while(previousRingTime &gt;= now)
+                  previousRingTime = previousRingTime - alarmPtr % ringTimeInterval
+               end do
+               negativeNeighborRingTime = previousRingTime
+            
+            else
+
+               do while(previousRingTime &gt;= now)
+                  previousRingTime = previousRingTime - alarmPtr % ringTimeInterval
+               end do
+               negativeNeighborRingTime = previousRingTime
+
+               do while(previousRingTime &lt;= now)
+                  previousRingTime = previousRingTime + alarmPtr % ringTimeInterval
+               end do
+               positiveNeighborRingTime = previousRingTime
+         
+            end if
+
+            if (clock % direction == MPAS_FORWARD) then
+               alarmPtr % prevRingTime = negativeNeighborRingTime
+            else
+               alarmPtr % prevRingTime = positiveNeighborRingTime
+            end if
+
+         end if
+   
+         alarmPtr =&gt; alarmPtr % next
+         
+      end do
+   
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+   
+   end subroutine mpas_calibrate_alarms
+
+
+   subroutine mpas_set_time(curr_time, YYYY, MM, DD, DoY, H, M, S, S_n, S_d, dateTimeString, ierr)
+
+      implicit none
+
+      type (MPAS_Time_type), intent(out) :: curr_time
+      integer, intent(in), optional :: YYYY
+      integer, intent(in), optional :: MM
+      integer, intent(in), optional :: DD
+      integer, intent(in), optional :: DoY
+      integer, intent(in), optional :: H
+      integer, intent(in), optional :: M
+      integer, intent(in), optional :: S
+      integer, intent(in), optional :: S_n
+      integer, intent(in), optional :: S_d
+      character (len=*), intent(in), optional :: dateTimeString
+      integer, intent(out), optional :: ierr
+
+      integer, parameter :: integerMaxDigits = 8
+      integer :: year, month, day, hour, min, sec
+      integer :: numerator, denominator, denominatorPower
+
+      character (len=50) :: dateTimeString_
+      character (len=50) :: dateSubString
+      character (len=50) :: timeSubString
+      character (len=50) :: secDecSubString
+      character(len=50), pointer, dimension(:) :: subStrings
+
+      if (present(dateTimeString)) then
+
+         dateTimeString_ = dateTimeString
+         numerator = 0
+         denominator = 1
+
+         call mpas_split_string(dateTimeString_, &quot;.&quot;, subStrings)
+         if (size(subStrings) == 2) then ! contains second decimals
+            dateTimeString_ = subStrings(1)
+            secDecSubString = subStrings(2)(:integerMaxDigits)
+            deallocate(subStrings)
+            denominatorPower = len_trim(secDecSubString)
+            if(denominatorPower &gt; 0) then
+               read(secDecSubString,*) numerator 
+               if(numerator &gt; 0) then
+                  denominator = 10**denominatorPower
+               end if
+            end if
+         else if (size(subStrings) /= 1) then
+            deallocate(subStrings)
+            if (present(ierr)) ierr = 1
+            write(0,*) 'ERROR: Invalid DateTime string', dateTimeString
+            return
+         end if
+
+         call mpas_split_string(dateTimeString_, &quot;_&quot;, subStrings)
+
+         if(size(subStrings) == 2) then   ! contains a date and time
+            dateSubString = subStrings(1)
+            timeSubString = subStrings(2)
+            deallocate(subStrings)
+            
+            call mpas_split_string(timeSubString, &quot;:&quot;, subStrings)
+            
+            if (size(subStrings) == 3) then
+               read(subStrings(1),*) hour 
+               read(subStrings(2),*) min 
+               read(subStrings(3),*) sec 
+               deallocate(subStrings)
+            else
+               deallocate(subStrings)
+               if (present(ierr)) ierr = 1
+               write(0,*) 'ERROR: Invalid DateTime string (invalid time substring)', dateTimeString
+               return
+            end if
+
+         else if(size(subStrings) == 1) then   ! contains only a date- assume all time values are 0 
+            dateSubString = subStrings(1)
+            deallocate(subStrings)
+           
+            hour = 0
+            min = 0
+            sec = 0
+         
+         else
+            deallocate(subStrings)
+            if (present(ierr)) ierr = 1
+            write(0,*) 'ERROR: Invalid DateTime string', dateTimeString
+            return
+         end if
+
+         call mpas_split_string(dateSubString, &quot;-&quot;, subStrings)
+            
+         if (size(subStrings) == 3) then
+            read(subStrings(1),*) year 
+            read(subStrings(2),*) month
+            read(subStrings(3),*) day
+            deallocate(subStrings)
+         else
+            deallocate(subStrings)
+            if (present(ierr)) ierr = 1
+            write(0,*) 'ERROR: Invalid DateTime string (invalid date substring)', dateTimeString
+            return
+         end if
+
+         call ESMF_TimeSet(curr_time % t, YY=year, MM=month, DD=day, H=hour, M=min, S=sec, Sn=numerator, Sd=denominator, rc=ierr)
+
+      else
+      
+         if (present(DoY)) then
+            call mpas_get_month_day(YYYY, DoY, month, day)
+         
+            ! consistency check
+            if (present(MM)) then
+               if (MM /= month) then
+                  if (present(ierr)) ierr = 1
+                  write(0,*) 'ERROR: MPAS_setTime : DoY and MM are inconsistent - using DoY'
+               end if
+            end if
+            if (present(DD)) then
+               if (DD /= day) then
+                  if (present(ierr)) ierr = 1
+                  write(0,*) 'ERROR: MPAS_setTime : DoY and DD are inconsistent - using DoY'
+               end if
+            end if
+         else
+            if (present(MM)) then
+               month = MM
+            else
+               if (present(ierr)) ierr = 1
+               write(0,*) 'ERROR: MPAS_setTime : Neither DoY nor MM are specified'
+               return
+            end if
+
+            if (present(DD)) then
+               day = DD
+            else
+               if (present(ierr)) ierr = 1
+               write(0,*) 'ERROR: MPAS_setTime : Neither DoY nor DD are specified'
+               return
+            end if
+         end if
+
+         if (.not. isValidDate(YYYY,month,day)) then
+            write(0,*) 'ERROR: MPAS_setTime : Invalid date'
+            return
+         end if
+
+         call ESMF_TimeSet(curr_time % t, YY=YYYY, MM=month, DD=day, H=H, M=M, S=S, Sn=S_n, Sd=S_d, rc=ierr)
+      
+      end if
+      
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+   end subroutine mpas_set_time
+
+
+   subroutine mpas_get_time(curr_time, YYYY, MM, DD, DoY, H, M, S, S_n, S_d, dateTimeString, ierr)
+
+      implicit none
+
+      type (MPAS_Time_type), intent(in) :: curr_time
+      integer, intent(out), optional :: YYYY
+      integer, intent(out), optional :: MM
+      integer, intent(out), optional :: DD
+      integer, intent(out), optional :: DoY
+      integer, intent(out), optional :: H
+      integer, intent(out), optional :: M
+      integer, intent(out), optional :: S
+      integer, intent(out), optional :: S_n
+      integer, intent(out), optional :: S_d
+      character (len=32), intent(out), optional :: dateTimeString
+      integer, intent(out), optional :: ierr
+
+      call ESMF_TimeGet(curr_time % t, YY=YYYY, MM=MM, DD=DD, H=H, M=M, S=S, Sn=S_n, Sd=S_d, rc=ierr)
+      call ESMF_TimeGet(curr_time % t, dayOfYear=DoY, rc=ierr)
+      call ESMF_TimeGet(curr_time % t, timeString=dateTimeString, rc=ierr)
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+   end subroutine mpas_get_time
+
+
+   subroutine mpas_set_timeInterval(interval, DD, H, M, S, S_n, S_d, timeString, dt, ierr)
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(out) :: interval
+      integer, intent(in), optional :: DD
+      integer, intent(in), optional :: H
+      integer, intent(in), optional :: M
+      integer, intent(in), optional :: S
+      integer, intent(in), optional :: S_n
+      integer, intent(in), optional :: S_d
+      character (len=*), intent(in), optional :: timeString
+      real (kind=RKIND), intent(in), optional :: dt
+      integer, intent(out), optional :: ierr
+
+      integer, parameter :: integerMaxDigits = 8
+      integer :: days, hours, minutes, seconds
+      integer :: numerator, denominator, denominatorPower
+      type (MPAS_TimeInterval_type) :: zeroInterval
+
+      integer :: day, hour, min, sec
+      character (len=50) :: timeString_
+      character (len=50) :: daySubString
+      character (len=50) :: timeSubString
+      character (len=50) :: secDecSubString
+      character(len=50), pointer, dimension(:) :: subStrings
+
+!      if (present(DD)) then
+!         days = DD
+!      else
+!         days = 0
+!      end if
+
+!      if (present(H)) then
+!         hours = H
+!      else
+!         hours = 0
+!      end if
+
+!      if (present(M)) then
+!         minutes = M
+!      else
+!         minutes = 0
+!      end if
+
+!      if (present(S)) then
+!         seconds = S
+!      else
+!         seconds = 0
+!      end if
+
+
+      !
+      ! Reduce minute count to something less than one hour
+      !
+!      do while (minutes &gt; 1440)
+!         days = days + 1
+!         minutes = minutes - 1440
+!      end do
+!      do while (minutes &gt; 60)
+!         hours = hours + 1
+!         minutes = minutes - 60
+!      end do
+!      do while (minutes &lt; -1440)
+!         days = days - 1
+!         minutes = minutes + 1440
+!      end do
+!      do while (minutes &lt; -60)
+!         hours = hours - 1
+!         minutes = minutes + 60
+!      end do
+
+      !
+      ! Reduce hour count to something less than one day
+      !
+!      do while (hours &gt; 24)
+!         days = days + 1
+!         hours = hours - 24
+!      end do
+!      do while (hours &lt; -24)
+!         days = days - 1
+!         hours = hours + 24
+!      end do
+
+      !
+      ! Any leftover minutes and hours are given to the second count
+      !
+!      seconds = seconds + hours*3600 + minutes*60
+
+!      call ESMF_TimeIntervalSet(interval % ti, D=days, S=seconds, Sn=S_n, Sd=S_d, rc=ierr)
+
+
+      if (present(timeString) .or. present(dt)) then
+
+
+         if(present(dt)) then
+            write (timeString_,*) &quot;00:00:&quot;, dt         
+         else
+            timeString_ = timeString
+         end if
+
+         numerator = 0
+         denominator = 1
+
+         call mpas_split_string(timeString_, &quot;.&quot;, subStrings)
+         
+         if (size(subStrings) == 2) then ! contains second decimals
+            timeString_ = subStrings(1)
+            secDecSubString = subStrings(2)(:integerMaxDigits)
+            deallocate(subStrings)
+
+            denominatorPower = len_trim(secDecSubString)
+            if(denominatorPower &gt; 0) then
+               read(secDecSubString,*) numerator 
+               if(numerator &gt; 0) then
+                  denominator = 10**denominatorPower
+               end if
+            end if
+         else if (size(subStrings) /= 1) then
+            deallocate(subStrings)
+            if (present(ierr)) ierr = 1
+            write(0,*) 'ERROR: Invalid TimeInterval string', timeString
+            return
+         end if
+
+         call mpas_split_string(timeString_, &quot;_&quot;, subStrings)
+
+         if(size(subStrings) == 2) then   ! contains a day and time
+            daySubString = subStrings(1)
+            timeSubString = subStrings(2)
+            deallocate(subStrings)
+            read(daySubString,*) day 
+         else if(size(subStrings) == 1) then   ! contains only a time- assume day is 0 
+            timeSubString = subStrings(1)
+            deallocate(subStrings)
+            day = 0
+         else
+            deallocate(subStrings)
+            if (present(ierr)) ierr = 1
+            write(0,*) 'ERROR: Invalid TimeInterval string', timeString
+            return
+         end if
+
+         call mpas_split_string(timeSubString, &quot;:&quot;, subStrings)
+            
+         if (size(subStrings) == 3) then
+            read(subStrings(1),*) hour 
+            read(subStrings(2),*) min 
+            read(subStrings(3),*) sec 
+            deallocate(subStrings)
+         else
+            deallocate(subStrings)
+            if (present(ierr)) ierr = 1
+            write(0,*) 'ERROR: Invalid TimeInterval string (invalid time substring)', timeString
+            return
+         end if
+
+         call ESMF_TimeIntervalSet(interval % ti, D=day, H=hour, M=min, S=sec, Sn=numerator, Sd=denominator, rc=ierr)
+
+      else
+
+         call ESMF_TimeIntervalSet(interval % ti, D=DD, H=H, M=M, S=S, Sn=S_n, Sd=S_d, rc=ierr)
+      
+      end if
+
+      ! verify that time interval is positive
+      call ESMF_TimeIntervalSet(zeroInterval % ti, D=0, H=0, M=0, S=0, rc=ierr)
+
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+      if (interval &lt;= zeroInterval) then
+         if (present(ierr)) ierr = 1   
+         write(0,*) 'ERROR: TimeInterval must be greater than 0', timeString !'ERROR: TimeInterval cannot be negative'
+      end if
+      
+
+      
+   end subroutine mpas_set_timeInterval
+
+
+   subroutine mpas_get_timeInterval(interval, DD, H, M, S, S_n, S_d, timeString, dt, ierr)
+! TODO: add double-precision seconds
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(in) :: interval
+      integer, intent(out), optional :: DD
+      integer, intent(out), optional :: H
+      integer, intent(out), optional :: M
+      integer, intent(out), optional :: S
+      integer, intent(out), optional :: S_n
+      integer, intent(out), optional :: S_d
+      character (len=32), intent(out), optional :: timeString
+      real (kind=RKIND), intent(out), optional :: dt
+      integer, intent(out), optional :: ierr
+
+      integer :: days, seconds, sn, sd
+
+      call ESMF_TimeIntervalGet(interval % ti, D=days, S=seconds, Sn=sn, Sd=sd, rc=ierr)
+
+      if (present(dt)) then
+         dt = (days * 24 * 60 * 60) + seconds + (sn / sd)
+      end if
+
+      if (present(DD)) then
+         DD = days
+         days = 0
+      end if
+
+      if (present(H)) then
+         H = (seconds - mod(seconds,3600)) / 3600
+         seconds = seconds - H*3600
+         H = H + days * 24
+         days = 0
+      end if
+
+      if (present(M)) then
+         M = (seconds - mod(seconds,60)) / 60
+         seconds = seconds - M*60
+         M = M + days * 1440
+         days = 0
+      end if
+
+      if (present(S)) then
+         S = seconds
+      end if
+
+      if (present(S_n)) then
+         S_n = sn
+      end if
+
+      if (present(S_d)) then
+         S_d = sd
+      end if
+
+      if (present(timeString)) then
+         call ESMF_TimeIntervalGet(interval % ti, timeString=timeString, rc=ierr)
+      end if
+
+      if (present(ierr)) then
+         if (ierr == ESMF_SUCCESS) ierr = 0
+      end if
+
+   end subroutine mpas_get_timeInterval
+
+
+   type (MPAS_Time_type) function add_t_ti(t, ti)
+
+      implicit none
+
+      type (MPAS_Time_type), intent(in) :: t
+      type (MPAS_TimeInterval_type), intent(in) :: ti
+
+      add_t_ti % t = t % t + ti % ti
+
+   end function add_t_ti
+
+
+   type (MPAS_TimeInterval_type) function add_ti_ti(ti1, ti2)
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
+
+      add_ti_ti % ti = ti1 % ti + ti2 % ti
+
+   end function add_ti_ti
+
+
+   type (MPAS_TimeInterval_type) function sub_t_t(t1, t2)
+
+      implicit none
+
+      type (MPAS_Time_type), intent(in) :: t1, t2
+
+      sub_t_t % ti = t1 % t - t2 % t
+
+   end function sub_t_t
+
+
+   type (MPAS_Time_type) function sub_t_ti(t, ti)
+
+      implicit none
+
+      type (MPAS_Time_type), intent(in) :: t
+      type (MPAS_TimeInterval_type), intent(in) :: ti
+
+      sub_t_ti % t = t % t - ti % ti
+
+   end function sub_t_ti
+
+
+   type (MPAS_TimeInterval_type) function sub_ti_ti(ti1, ti2)
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
+
+      sub_ti_ti % ti = ti1 % ti - ti2 % ti
+
+   end function sub_ti_ti
+
+
+   type (MPAS_TimeInterval_type) function mul_ti_n(ti, n)
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(in) :: ti
+      integer, intent(in) :: n
+
+      mul_ti_n % ti = ti % ti * n
+
+   end function mul_ti_n
+
+
+   type (MPAS_TimeInterval_type) function div_ti_n(ti, n)
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(in) :: ti
+      integer, intent(in) :: n
+
+      div_ti_n % ti = ti % ti / n
+
+   end function div_ti_n
+
+
+   logical function eq_t_t(t1, t2)
+
+      implicit none
+
+      type (MPAS_Time_type), intent(in) :: t1, t2
+
+      eq_t_t = (t1 % t == t2 % t)
+
+   end function eq_t_t
+
+
+   logical function ne_t_t(t1, t2)
+
+      implicit none
+
+      type (MPAS_Time_type), intent(in) :: t1, t2
+
+      ne_t_t = (t1 % t /= t2 % t)
+
+   end function ne_t_t
+
+
+   logical function lt_t_t(t1, t2)
+
+      implicit none
+
+      type (MPAS_Time_type), intent(in) :: t1, t2
+
+      lt_t_t = (t1 % t &lt; t2 % t)
+
+   end function lt_t_t
+
+
+   logical function gt_t_t(t1, t2)
+
+      implicit none
+
+      type (MPAS_Time_type), intent(in) :: t1, t2
+
+      gt_t_t = (t1 % t &gt; t2 % t)
+
+   end function gt_t_t
+
+
+   logical function le_t_t(t1, t2)
+
+      implicit none
+
+      type (MPAS_Time_type), intent(in) :: t1, t2
+
+      le_t_t = (t1 % t &lt;= t2 % t)
+
+   end function le_t_t
+
+
+   logical function ge_t_t(t1, t2)
+
+      implicit none
+
+      type (MPAS_Time_type), intent(in) :: t1, t2
+
+      ge_t_t = (t1 % t &gt;= t2 % t)
+
+   end function ge_t_t
+
+
+   logical function eq_ti_ti(ti1, ti2)
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
+
+      eq_ti_ti = (ti1 % ti == ti2 % ti)
+
+   end function eq_ti_ti
+
+
+   logical function ne_ti_ti(ti1, ti2)
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
+
+      ne_ti_ti = (ti1 % ti /= ti2 % ti)
+
+   end function ne_ti_ti
+
+
+   logical function lt_ti_ti(ti1, ti2)
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
+
+      lt_ti_ti = (ti1 % ti &lt; ti2 % ti)
+
+   end function lt_ti_ti
+
+
+   logical function gt_ti_ti(ti1, ti2)
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
+
+      gt_ti_ti = (ti1 % ti &gt; ti2 % ti)
+
+   end function gt_ti_ti
+
+
+   logical function le_ti_ti(ti1, ti2)
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
+
+      le_ti_ti = (ti1 % ti &lt;= ti2 % ti)
+
+   end function le_ti_ti
+
+
+   logical function ge_ti_ti(ti1, ti2)
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
+
+      ge_ti_ti = (ti1 % ti &gt;= ti2 % ti)
+
+   end function ge_ti_ti
+
+
+   type (MPAS_TimeInterval_type) function neg_ti(ti)
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(in) :: ti
+
+      integer :: rc
+      integer :: D, S, Sn, Sd
+
+      call ESMF_TimeIntervalGet(ti % ti, D=D, S=S, Sn=Sn, Sd=Sd, rc=rc)
+      D    = -D 
+      S    = -S 
+      Sn   = -Sn
+      call ESMF_TimeIntervalSet(neg_ti % ti, D=D, S=S, Sn=Sn, Sd=Sd, rc=rc)
+
+   end function neg_ti
+
+
+   type (MPAS_TimeInterval_type) function abs_ti(ti)
+
+      implicit none
+
+      type (MPAS_TimeInterval_type), intent(in) :: ti
+
+      type (MPAS_TimeInterval_type) :: zeroInterval
+      integer :: rc
+      integer :: D, S, Sn, Sd
+
+      call ESMF_TimeIntervalSet(zeroInterval % ti, D=0, H=0, M=0, S=0, rc=rc)
+
+      if(ti &lt; zeroInterval) then
+         call ESMF_TimeIntervalGet(ti % ti, D=D, S=S, Sn=Sn, Sd=Sd, rc=rc)
+         D    = -D 
+         S    = -S 
+         Sn   = -Sn
+         call ESMF_TimeIntervalSet(abs_ti % ti, D=D, S=S, Sn=Sn, Sd=Sd, rc=rc)
+      else
+         abs_ti = ti
+      end if
+
+   end function abs_ti
+
+
+! TODO: Implement this function
+!   type (MPAS_TimeInterval_type) function mod(ti1, ti2)
+!
+!      implicit none
+!
+!      type (MPAS_TimeInterval_type), intent(in) :: ti1, ti2
+!
+!      mod % ti = mod(ti1 % ti, ti2 % ti)
+!
+!   end function mod
+
+
+   subroutine mpas_split_string(string, delimiter, subStrings)   
+      
+      implicit none
+      
+      character(len=*), intent(in) :: string
+      character, intent(in) :: delimiter
+      character(len=*), pointer, dimension(:) :: subStrings
+      
+      integer :: i, start, index
+
+      index = 1
+      do i = 1, len(string)
+         if(string(i:i) == delimiter) then
+            index = index + 1
+         end if
+      end do
+
+      allocate(subStrings(1:index))
+
+      start = 1
+      index = 1
+      do i = 1, len(string)
+         if(string(i:i) == delimiter) then
+               subStrings(index) = string(start:i-1) 
+               index = index + 1
+               start = i + 1
+         end if
+      end do
+      subStrings(index) = string(start:len(string)) 
+      
+   end subroutine mpas_split_string
+
+
+    subroutine mpas_get_month_day(YYYY, DoY, month, day)
+       
+       implicit none
+
+       integer, intent(in) :: YYYY, DoY
+       integer, intent(out) :: month, day
+
+       integer, dimension(12) :: dpm
+       
+       if (isLeapYear(YYYY)) then
+          dpm(:) = daysInMonthLeap
+       else
+          dpm(:) = daysInMonth
+       end if
+
+       month = 1
+       day = DoY
+       do while (day &gt; dpm(month))
+          day = day -  dpm(month)
+          month = month + 1       
+       end do
+
+    end subroutine mpas_get_month_day
+
+
+   logical function isValidDate(YYYY, MM, DD)
+   
+      integer, intent(in) :: YYYY, MM, DD
+      integer :: daysInMM
+      
+      isValidDate = .true.
+
+      ! TODO: ???? Gregorian calendar has no year zero, but perhaps 0 = 1 BC ??? 
+      !if (YYYY == 0) then
+      !   isValidDate = .false.
+      !   return
+      !end if
+
+      if (MM &lt; 1 .or. MM &gt; 12) then
+         isValidDate = .false.
+         return
+      end if
+
+      if (DD &lt; 1) then
+         isValidDate = .false.
+         return
+      end if
+
+      if(TheCalendar == MPAS_360DAY) then
+         daysInMM = 30
+      else
+         if (TheCalendar == MPAS_GREGORIAN .and. isLeapYear(YYYY)) then
+            daysInMM = daysInMonthLeap(MM)
+         else
+            daysInMM = daysInMonth(MM)        
+         end if
+      end if
+     
+      if (DD &gt; daysInMM) then
+         isValidDate = .false.
+         return
+      end if
+
+   end function
+
+    
+    logical function isLeapYear(year)
+
+       implicit none
+
+       integer, intent(in) :: year
+
+       isLeapYear = .false.
+       
+       if (mod(year,4) == 0) then
+          if (mod(year,100) == 0) then
+             if (mod(year,400) == 0) then
+                isLeapYear = .true.
+             end if
+          else
+             isLeapYear = .true.
+          end if
+       end if
+
+    end function isLeapYear
+
+
+
+
+
+end module mpas_timekeeping
+
+
+
+subroutine wrf_error_fatal(msg)
+
+   implicit none
+
+   character (len=*) :: msg
+
+   write(0,*) 'MPAS_TIMEKEEPING: '//trim(msg)
+
+   stop
+
+end subroutine wrf_error_fatal

Copied: branches/source_condensing/src/framework/mpas_timer.F (from rev 1114, trunk/mpas/src/framework/mpas_timer.F)
===================================================================
--- branches/source_condensing/src/framework/mpas_timer.F                                (rev 0)
+++ branches/source_condensing/src/framework/mpas_timer.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,293 @@
+      module mpas_timer
+
+        implicit none
+        save
+!       private
+
+#ifdef _PAPI
+        include 'f90papi.h'
+#endif
+
+#ifdef _MPI
+        include 'mpif.h'
+#endif
+
+        type timer_node
+          character (len=72) :: timer_name
+          logical :: running, printable
+          integer :: levels, calls
+          real (kind=RKIND) :: start_time, end_time, total_time
+          real (kind=RKIND) :: max_time, min_time, avg_time
+          type (timer_node), pointer :: next
+        end type timer_node
+
+        type (timer_node), pointer :: all_timers
+        integer :: levels
+
+        public :: mpas_timer_start, &amp;
+                  mpas_timer_stop, &amp;
+                  mpas_timer_write
+
+        contains
+
+        subroutine mpas_timer_start(timer_name, clear_timer, timer_ptr)!{{{
+          character (len=*), intent (in) :: timer_name !&lt; Input: name of timer, stored as name of timer
+          logical, optional, intent(in) :: clear_timer !&lt; Input: flag to clear timer
+          type (timer_node), optional, pointer, intent(out) :: timer_ptr !&lt; Output: pointer to store timer in module
+
+          logical :: timer_added, timer_found, string_equal, check_flag
+          type (timer_node), pointer :: current, temp
+
+          integer :: clock, hz, usecs
+
+          timer_added = .false.
+          timer_found = .false.
+
+          if(.not.associated(all_timers)) then
+            timer_added = .true.
+            allocate(all_timers)
+            allocate(all_timers%next)
+            levels = 0
+
+            all_timers%timer_name = ''
+            current =&gt; all_timers%next
+            nullify(current%next)
+          else
+            current =&gt; all_timers%next
+            timer_search: do while ((.not.timer_found) .and. associated(current))
+              string_equal = (trim(current%timer_name) == trim(timer_name))
+              if(string_equal) then
+                timer_found = .true.
+              else
+                current =&gt; current%next
+              endif
+            end do timer_search
+          endif
+
+          if(present(timer_ptr)) then
+            timer_found = .true.
+            if(.not.associated(timer_ptr)) then
+              current =&gt; all_timers
+              find_end_ptr: do while((.not.timer_added) .and. (associated(current%next)))
+                current =&gt; current%next
+              end do find_end_ptr
+
+              allocate(timer_ptr)
+
+              current%next =&gt; timer_ptr
+              current =&gt; timer_ptr
+              nullify(timer_ptr%next)
+              current%levels = levels
+              current%timer_name = timer_name
+              current%running = .false.
+              current%total_time = 0.0
+              current%max_time = 0.0
+              current%min_time = 100000000.0
+              current%avg_time = 0.0
+              current%calls = 0
+            endif
+          endif
+
+          if(.not.timer_found) then
+            current =&gt; all_timers
+            find_end: do while((.not.timer_added) .and. (associated(current%next)))
+              current =&gt; current%next
+            end do find_end
+
+            allocate(current%next)
+            current =&gt; current%next
+
+            nullify(current%next)
+            timer_added = .true.
+          endif
+
+          if(timer_added .and. (.not.timer_found)) then
+            current%levels = levels
+            current%timer_name = timer_name
+            current%running = .false.
+            current%total_time = 0.0
+            current%max_time = 0.0
+            current%min_time = 100000000.0
+            current%avg_time = 0.0
+            current%calls = 0
+          endif
+
+          if((timer_added .or. timer_found) .and. (.not.current%running)) then
+            current%running = .true.
+            levels = levels + 1
+
+#ifdef _PAPI
+            call PAPIF_get_real_usec(usecs, check_flag)
+            current%start_time = usecs/1.0e6
+#elif _MPI
+            current%start_time = MPI_Wtime()
+#else
+            call system_clock (count=clock)
+            call system_clock (count_rate=hz)
+            current%start_time = real(clock,kind=RKIND)/real(hz,kind=RKIND)
+#endif
+          endif
+
+          if(present(clear_timer)) then
+            if(clear_timer) then
+              current%start_time = 0.0
+              current%end_time = 0.0
+              current%total_time = 0.0
+              current%max_time = 0.0
+              current%min_time = 0.0
+              current%avg_time = 0.0
+              current%calls = 0
+              current%running = .false.
+            endif
+          endif
+
+          if(present(timer_ptr)) then
+              timer_ptr =&gt; current
+          endif
+          
+        end subroutine mpas_timer_start!}}}
+       
+        subroutine mpas_timer_stop(timer_name, timer_ptr)!{{{
+          character (len=*), intent(in) :: timer_name !&lt; Input: name of timer to stop
+          type (timer_node), pointer, intent(in), optional :: timer_ptr !&lt; Input: pointer to timer, for stopping
+
+          type (timer_node), pointer :: current
+          
+          real (kind=RKIND) :: time_temp
+          logical :: timer_found, string_equal, check_flag
+          integer :: clock, hz, usecs

+          timer_found = .false.

+          if(present(timer_ptr)) then
+            timer_found = .true.
+            current =&gt; timer_ptr
+          endif

+          if(.not.associated(all_timers)) then
+            print *,' timer_stop :: timer_stop called with no timers initialized'
+          else if(.not. timer_found) then
+            current =&gt; all_timers
+            timer_find: do while(.not.timer_found .and. associated(current))
+              string_equal = (trim(current%timer_name) == trim(timer_name))
+
+              if(string_equal) then
+                timer_found = .true.
+              else
+                current =&gt; current%next
+              endif
+            end do timer_find
+          endif
+
+          if(.not.timer_found) then
+            print *,' timer_stop :: timer_stop called with timer_name =', timer_name,' when timer has not been started.'
+            stop
+          endif
+
+          if(current%running) then
+            current%running = .false.
+            levels = levels - 1
+
+#ifdef _PAPI
+            call PAPIF_get_real_usec(usecs, check_flag)
+            current%end_time = usecs/1.0e6
+#elif _MPI
+            current%end_time = MPI_Wtime()
+#else
+            call system_clock(count=clock)
+            call system_clock(count_rate=hz)
+            current%end_time = real(clock,kind=RKIND)/real(hz,kind=RKIND)
+#endif
+            
+            time_temp = current%end_time - current%start_time
+            current%total_time = current%total_time + time_temp
+
+            if(time_temp &gt; current%max_time) then
+              current%max_time = time_temp
+            endif
+
+            if(time_temp &lt; current%min_time) then
+              current%min_time = time_temp
+            endif
+
+            current%avg_time = current%avg_time + time_temp
+            current%calls = current%calls + 1
+          endif
+
+        end subroutine mpas_timer_stop!}}}
+
+        recursive subroutine mpas_timer_write(timer_ptr, total_ptr)!{{{
+          type (timer_node), pointer, intent(inout), optional :: timer_ptr
+          type (timer_node), pointer, intent(in), optional :: total_ptr
+          character (len=10) :: tname
+
+          logical :: total_found, string_equals
+          type (timer_node), pointer :: current, total
+          real (kind=RKIND) :: percent
+          integer :: i
+
+          total_found = .false.
+
+          if(present(timer_ptr) .and. (.not.present(total_ptr))) then
+            print *,'timer_write :: timer_ptr valid, but total_ptr is not assigned.'
+            stop
+          else if(present(timer_ptr)) then
+            tname = ''
+            do i=0,timer_ptr%levels+2
+              tname = tname//' '
+!             write(*,'(a,$)') ' '
+            end do
+!           tname = tname//timer_ptr%timer_name
+
+            if(timer_ptr%total_time == 0.0d0) then
+              timer_ptr%min_time = 0.0d0
+              timer_ptr%max_time = 0.0d0
+              timer_ptr%avg_time = 0.0d0
+              percent = 0.0d0
+            else
+              timer_ptr%avg_time = timer_ptr%avg_time/timer_ptr%calls
+              percent = timer_ptr%total_time/total_ptr%total_time
+            endif
+
+            write(*,'(i2, 1x, a35, f15.5, i10, 3f15.5, f8.2)') timer_ptr%levels, tname(1:timer_ptr%levels)//timer_ptr%timer_name, timer_ptr%total_time, timer_ptr%calls, timer_ptr%min_time, timer_ptr%max_time, timer_ptr%avg_time, percent
+            return
+          endif
+
+          total =&gt; all_timers
+
+          find_total: do while((.not.total_found) .and. associated(total))
+            string_equals = (trim(total%timer_name) == trim(&quot;total time&quot;))
+            if(string_equals) then
+              total_found = .true.
+            else
+              total =&gt; total%next
+            endif
+          end do find_total
+
+          if(.not.total_found) then
+            print *,' timer_write :: no timer named &quot;total time&quot; found.'
+            stop
+          end if
+
+          write(*,'(3x, a10, 24x, a15, a10, a13, a15, a15, a15)') 'timer_name', 'total', 'calls', 'min', 'max', 'avg', 'percent'
+          write(*,'(i2, 1x, a35, f15.5, i10, 3f15.5)') total%levels, total%timer_name, total%total_time, total%calls, total%min_time, total%max_time, total%avg_time
+
+          current =&gt; all_timers
+
+          print_timers: do while(associated(current))
+            string_equals = (trim(current%timer_name) == trim(&quot;total time&quot;))
+            string_equals = string_equals .or. (trim(current%timer_name) == trim(&quot; &quot;))
+
+            if(.not.string_equals) then
+              call mpas_timer_write(current, total)
+              current =&gt; current%next
+            else
+              current =&gt; current%next
+            endif
+          end do print_timers
+
+        end subroutine mpas_timer_write!}}}
+
+      end module mpas_timer
+
+! vim: foldmethod=marker et ts=2

Copied: branches/source_condensing/src/framework/mpas_zoltan_interface.F (from rev 1114, trunk/mpas/src/framework/mpas_zoltan_interface.F)
===================================================================
--- branches/source_condensing/src/framework/mpas_zoltan_interface.F                                (rev 0)
+++ branches/source_condensing/src/framework/mpas_zoltan_interface.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,581 @@
+module mpas_zoltan_interface
+   use zoltan
+
+   implicit none
+
+   include 'mpif.h'
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! Data for reordering cells
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   integer :: numCells
+   integer, dimension(:), pointer :: cellIDs
+   integer :: geomDim
+   real (kind=RKIND), dimension(:), pointer :: cellCoordX, cellCoordY, cellCoordZ
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! Data for reordering edges
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   integer :: numEdges
+   integer, dimension(:), pointer :: edgeIDs
+   real (kind=RKIND), dimension(:), pointer :: edgeCoordX, edgeCoordY, edgeCoordZ  
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! Data for reordering vertices
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   integer :: numVerts
+   integer, dimension(:), pointer :: vertIDs
+   real (kind=RKIND), dimension(:), pointer :: vertCoordX, vertCoordY, vertCoordZ  
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+   contains
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! Perhaps not necessary, but implemented in case it helps
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   subroutine mpas_zoltan_start()  
+
+      integer(Zoltan_INT) :: error
+      real(Zoltan_FLOAT) :: version
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! Body of subroutine
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      error = Zoltan_Initialize(version)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      
+   end subroutine
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   subroutine mpas_zoltan_order_loc_hsfc_cells(in_numcells,in_cellIDs,in_geomDim,in_cellX, &amp;
+                                       in_cellY, in_cellZ)
+      implicit none
+
+      integer :: in_numcells
+      integer, dimension(:), pointer :: in_cellIDs
+      integer :: in_geomDim
+      real (kind=RKIND), dimension(:), pointer :: in_cellX, in_cellY, in_cellZ
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! local variables
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      type(Zoltan_Struct), pointer :: zz_obj
+      integer(ZOLTAN_INT) :: ierr
+
+      integer :: numGidEntries, i
+      integer(ZOLTAN_INT), allocatable :: global_ids(:), permIndices(:),permGIDs(:)
+      real(kind=RKIND), allocatable :: permXs(:),permYs(:),permZs(:)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! Body of subroutine
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      numCells = in_numcells
+      cellIDs =&gt; in_cellIDs
+      geomDim = in_geomDim
+      cellCoordX =&gt; in_cellX
+      cellCoordY =&gt; in_cellY
+      cellCoordZ =&gt; in_cellZ
+
+      nullify(zz_obj)
+      zz_obj =&gt; Zoltan_Create(MPI_COMM_SELF)
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! General Zoltan Parameters
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ierr = Zoltan_Set_Param(zz_obj, &quot;ORDER_METHOD&quot;, &quot;LOCAL_HSFC&quot;)
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! register query functions
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_OBJ_FN_TYPE,zqfNumCells)
+      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_OBJ_LIST_FN_TYPE,zqfGetCells)
+      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_GEOM_FN_TYPE,zqfGeomDim)
+      ierr =  Zoltan_Set_Fn(zz_obj, ZOLTAN_GEOM_FN_TYPE, zqfGetCellGeom)
+
+      numGidEntries=1
+
+      allocate(global_ids(numCells))
+      allocate(permIndices(numCells))
+      allocate(permGIDs(numCells))
+      allocate(permXs(numCells))
+      allocate(permYs(numCells))
+      allocate(permZs(numCells))
+
+      !! MMW: There might be a way to use cellIDs directly
+      do i=1,numCells
+        global_ids(i) = cellIDs(i)
+      end do
+
+      ierr = Zoltan_Order(zz_obj, numGidEntries, numCells, global_ids, permIndices);
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! This is necessary for now until we fix a small bug in Zoltan_Order
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+      do i=1,numCells
+        permGIDs(i) = global_ids(permIndices(i)+1)
+        permXs(i) = cellCoordX(permIndices(i)+1)
+        permYs(i) = cellCoordY(permIndices(i)+1)
+        permZs(i) = cellCoordZ(permIndices(i)+1)
+      end do
+
+      !!do i=1,numCells
+      !!   write(*,*) global_ids(i), permGIDs(i)
+      !!end do
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! Actually change the ordering of the cells
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+      do i=1,numCells
+        cellIDs(i) = permGIDs(i)
+        cellCoordX(i) = permXs(i)
+        cellCoordY(i) = permYs(i)
+        cellCoordZ(i) = permZs(i)
+      end do
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      deallocate(global_ids)
+      deallocate(permIndices)
+      deallocate(permGIDs)
+      deallocate(permXs)
+      deallocate(permYs)
+      deallocate(permZs)
+
+      call Zoltan_Destroy(zz_obj)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   end subroutine mpas_zoltan_order_loc_hsfc_cells
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! zoltan query function:
+   !!    Returns number of cells
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   integer function zqfNumCells(data, ierr)
+
+      ! Local declarations
+      integer(ZOLTAN_INT), intent(in) :: data(*)
+      integer(ZOLTAN_INT), intent(out) :: ierr
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      zqfNumCells = numCells
+      ierr = ZOLTAN_OK
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   end function zqfNumCells
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! zoltan query function: 
+   !!    Returns lists of Cell IDs
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   subroutine mpas_zqf_get_cells (data, num_gid_entries, num_lid_entries, global_ids, &amp;
+                           local_ids, wgt_dim, obj_wgts, ierr)
+     integer(ZOLTAN_INT), intent(in) :: data(*)
+     integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
+     integer(ZOLTAN_INT), intent(out) :: global_ids(*), local_ids(*)
+     integer(ZOLTAN_INT), intent(in) :: wgt_dim 
+     real(ZOLTAN_FLOAT), intent(out) :: obj_wgts(*)
+     integer(ZOLTAN_INT), intent(out) :: ierr
+
+     ! local declarations
+     integer :: i
+
+     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+     do i= 1, numCells
+       global_ids(i) = cellIDs(i)
+       local_ids(i) = i
+     end do
+
+     ierr = ZOLTAN_OK
+     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   end subroutine mpas_zqf_get_cells
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! Zoltan Query Function:
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   integer function zqfGeomDim(data, ierr)
+      !use zoltan
+      implicit none
+      integer(ZOLTAN_INT), intent(in) :: data(*)
+      integer(ZOLTAN_INT) :: ierr
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      zqfGeomDim = geomDim
+      ierr = ZOLTAN_OK
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   end function zqfGeomDim
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! Zoltan Query Function:
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   subroutine mpas_zqf_get_cell_geom(data, num_gid_entries, num_lid_entries, global_id, &amp;
+                             local_id, geom_vec, ierr)
+      !use zoltan
+      implicit none
+
+      integer(ZOLTAN_INT), intent(in) :: data(*)
+      integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
+      integer(ZOLTAN_INT), intent(in) :: global_id, local_id
+      real(ZOLTAN_DOUBLE), intent(out) :: geom_vec(*)
+      integer(ZOLTAN_INT), intent(out) :: ierr
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! Assuming geom_dim is 3
+      geom_vec(1) = cellCoordX(local_id)
+      geom_vec(2) = cellCoordY(local_id)
+      geom_vec(3) = cellCoordZ(local_id)
+
+      ierr = ZOLTAN_OK
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   end subroutine mpas_zqf_get_cell_geom
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! The ordering functions should perhaps be refactored so that there
+   !! are not separate functions for cells, edges, and vertices
+   !! Not sure if this is worth it with the additional conditionals that would 
+   !! be required. 
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   subroutine mpas_zoltan_order_loc_hsfc_edges(in_numedges,in_edgeIDs,in_geomDim,in_edgeX, &amp;
+                                       in_edgeY, in_edgeZ)
+      implicit none
+
+      integer :: in_numedges
+      integer, dimension(:), pointer :: in_edgeIDs
+      integer :: in_geomDim
+      real (kind=RKIND), dimension(:), pointer :: in_edgeX, in_edgeY, in_edgeZ
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! local variables
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      type(Zoltan_Struct), pointer :: zz_obj
+      integer(ZOLTAN_INT) :: ierr
+
+      integer :: numGidEntries, i
+      integer(ZOLTAN_INT), allocatable :: global_ids(:), permIndices(:),permGIDs(:)
+      real(kind=RKIND), allocatable :: permXs(:),permYs(:),permZs(:)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! Body of subroutine
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      numEdges = in_numedges
+      edgeIDs =&gt; in_edgeIDs
+      geomDim = in_geomDim
+      edgeCoordX =&gt; in_edgeX
+      edgeCoordY =&gt; in_edgeY
+      edgeCoordZ =&gt; in_edgeZ
+
+      nullify(zz_obj)
+      zz_obj =&gt; Zoltan_Create(MPI_COMM_SELF)
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! General Zoltan Parameters
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ierr = Zoltan_Set_Param(zz_obj, &quot;ORDER_METHOD&quot;, &quot;LOCAL_HSFC&quot;)
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! register query functions
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_OBJ_FN_TYPE,zqfNumEdges)
+      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_OBJ_LIST_FN_TYPE,zqfGetEdges)
+      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_GEOM_FN_TYPE,zqfGeomDim)
+      ierr =  Zoltan_Set_Fn(zz_obj, ZOLTAN_GEOM_FN_TYPE, zqfGetEdgeGeom)
+
+      numGidEntries=1
+
+      allocate(global_ids(numEdges))
+      allocate(permIndices(numEdges))
+      allocate(permGIDs(numEdges))
+      allocate(permXs(numEdges))
+      allocate(permYs(numEdges))
+      allocate(permZs(numEdges))
+
+      !! MMW: There might be a way to use edgeIDs directly
+      do i=1,numEdges
+        global_ids(i) = edgeIDs(i)
+      end do
+
+      ierr = Zoltan_Order(zz_obj, numGidEntries, numEdges, global_ids, permIndices);
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! This is necessary for now until we fix a small bug in Zoltan_Order
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+      do i=1,numEdges
+        permGIDs(i) = global_ids(permIndices(i)+1)
+        permXs(i) = edgeCoordX(permIndices(i)+1)
+        permYs(i) = edgeCoordY(permIndices(i)+1)
+        permZs(i) = edgeCoordZ(permIndices(i)+1)
+      end do
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! Actually change the ordering of the edges
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+      do i=1,numEdges
+        edgeIDs(i) = permGIDs(i)
+        edgeCoordX(i) = permXs(i)
+        edgeCoordY(i) = permYs(i)
+        edgeCoordZ(i) = permZs(i)
+      end do
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      deallocate(global_ids)
+      deallocate(permIndices)
+      deallocate(permGIDs)
+      deallocate(permXs)
+      deallocate(permYs)
+      deallocate(permZs)
+
+      call Zoltan_Destroy(zz_obj)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   end subroutine mpas_zoltan_order_loc_hsfc_edges
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! zoltan query function:
+   !!    Returns number of edges
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   integer function zqfNumEdges(data, ierr)
+      ! Local declarations
+      integer(ZOLTAN_INT), intent(in) :: data(*)
+      integer(ZOLTAN_INT), intent(out) :: ierr
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      zqfNumEdges = numEdges
+      ierr = ZOLTAN_OK
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   end function zqfNumEdges
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! zoltan query function: 
+   !!    Returns lists of Edge IDs
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   subroutine mpas_zqf_get_edges (data, num_gid_entries, num_lid_entries, global_ids, &amp;
+                           local_ids, wgt_dim, obj_wgts, ierr)
+     integer(ZOLTAN_INT), intent(in) :: data(*)
+     integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
+     integer(ZOLTAN_INT), intent(out) :: global_ids(*), local_ids(*)
+     integer(ZOLTAN_INT), intent(in) :: wgt_dim 
+     real(ZOLTAN_FLOAT), intent(out) :: obj_wgts(*)
+     integer(ZOLTAN_INT), intent(out) :: ierr
+
+     ! local declarations
+     integer :: i
+
+     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+     do i= 1, numEdges
+       global_ids(i) = edgeIDs(i)
+       local_ids(i) = i
+     end do
+
+     ierr = ZOLTAN_OK
+     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   end subroutine mpas_zqf_get_edges
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! Zoltan Query Function:
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   subroutine mpas_zqf_get_edge_geom(data, num_gid_entries, num_lid_entries, global_id, &amp;
+                             local_id, geom_vec, ierr)
+      !use zoltan
+      implicit none
+
+      integer(ZOLTAN_INT), intent(in) :: data(*)
+      integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
+      integer(ZOLTAN_INT), intent(in) :: global_id, local_id
+      real(ZOLTAN_DOUBLE), intent(out) :: geom_vec(*)
+      integer(ZOLTAN_INT), intent(out) :: ierr
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! Assuming geom_dim is 3
+      geom_vec(1) = edgeCoordX(local_id)
+      geom_vec(2) = edgeCoordY(local_id)
+      geom_vec(3) = edgeCoordZ(local_id)
+
+      ierr = ZOLTAN_OK
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   end subroutine mpas_zqf_get_edge_geom
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   subroutine mpas_zoltan_order_loc_hsfc_verts(in_numverts,in_vertIDs,in_geomDim,in_vertX, &amp;
+                                       in_vertY, in_vertZ)
+      implicit none
+
+      integer :: in_numverts
+      integer, dimension(:), pointer :: in_vertIDs
+      integer :: in_geomDim
+      real (kind=RKIND), dimension(:), pointer :: in_vertX, in_vertY, in_vertZ
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! local variables
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      type(Zoltan_Struct), pointer :: zz_obj
+      integer(ZOLTAN_INT) :: ierr
+
+      integer :: numGidEntries, i
+      integer(ZOLTAN_INT), allocatable :: global_ids(:), permIndices(:),permGIDs(:)
+      real(kind=RKIND), allocatable :: permXs(:),permYs(:),permZs(:)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! Body of subroutine
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      numVerts = in_numverts
+      vertIDs =&gt; in_vertIDs
+      geomDim = in_geomDim
+      vertCoordX =&gt; in_vertX
+      vertCoordY =&gt; in_vertY
+      vertCoordZ =&gt; in_vertZ
+
+      nullify(zz_obj)
+      zz_obj =&gt; Zoltan_Create(MPI_COMM_SELF)
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! General Zoltan Parameters
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ierr = Zoltan_Set_Param(zz_obj, &quot;ORDER_METHOD&quot;, &quot;LOCAL_HSFC&quot;)
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! register query functions
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_OBJ_FN_TYPE,zqfNumVerts)
+      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_OBJ_LIST_FN_TYPE,zqfGetVerts)
+      ierr = Zoltan_Set_Fn(zz_obj, ZOLTAN_NUM_GEOM_FN_TYPE,zqfGeomDim)
+      ierr =  Zoltan_Set_Fn(zz_obj, ZOLTAN_GEOM_FN_TYPE, zqfGetVertGeom)
+
+      numGidEntries=1
+
+      allocate(global_ids(numVerts))
+      allocate(permIndices(numVerts))
+      allocate(permGIDs(numVerts))
+      allocate(permXs(numVerts))
+      allocate(permYs(numVerts))
+      allocate(permZs(numVerts))
+
+      !! MMW: There might be a way to use vertIDs directly
+      do i=1,numVerts
+        global_ids(i) = vertIDs(i)
+      end do
+
+      ierr = Zoltan_Order(zz_obj, numGidEntries, numVerts, global_ids, permIndices);
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! This is necessary for now until we fix a small bug in Zoltan_Order
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+      do i=1,numVerts
+        permGIDs(i) = global_ids(permIndices(i)+1)
+        permXs(i) = vertCoordX(permIndices(i)+1)
+        permYs(i) = vertCoordY(permIndices(i)+1)
+        permZs(i) = vertCoordZ(permIndices(i)+1)
+      end do
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! Actually change the ordering of the verts
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+      do i=1,numVerts
+        vertIDs(i) = permGIDs(i)
+        vertCoordX(i) = permXs(i)
+        vertCoordY(i) = permYs(i)
+        vertCoordZ(i) = permZs(i)
+      end do
+      !!!!!!!!!!!!!!!!!!!!!!!!!!
+
+      deallocate(global_ids)
+      deallocate(permIndices)
+      deallocate(permGIDs)
+      deallocate(permXs)
+      deallocate(permYs)
+      deallocate(permZs)
+
+      call Zoltan_Destroy(zz_obj)
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   end subroutine mpas_zoltan_order_loc_hsfc_verts
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! zoltan query function:
+   !!    Returns number of verts
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   integer function zqfNumVerts(data, ierr)
+
+      ! Local declarations
+      integer(ZOLTAN_INT), intent(in) :: data(*)
+      integer(ZOLTAN_INT), intent(out) :: ierr
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      zqfNumVerts = numVerts
+      ierr = ZOLTAN_OK
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   end function zqfNumVerts
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! zoltan query function: 
+   !!    Returns lists of Vert IDs
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   subroutine mpas_zqf_get_verts (data, num_gid_entries, num_lid_entries, global_ids, &amp;
+                           local_ids, wgt_dim, obj_wgts, ierr)
+
+     integer(ZOLTAN_INT), intent(in) :: data(*)
+     integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
+     integer(ZOLTAN_INT), intent(out) :: global_ids(*), local_ids(*)
+     integer(ZOLTAN_INT), intent(in) :: wgt_dim 
+     real(ZOLTAN_FLOAT), intent(out) :: obj_wgts(*)
+     integer(ZOLTAN_INT), intent(out) :: ierr
+
+     ! local declarations
+     integer :: i
+
+     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+     do i= 1, numVerts
+       global_ids(i) = vertIDs(i)
+       local_ids(i) = i
+     end do
+
+     ierr = ZOLTAN_OK
+     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   end subroutine mpas_zqf_get_verts
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   !! Zoltan Query Function:
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   subroutine mpas_zqf_get_vert_geom(data, num_gid_entries, num_lid_entries, global_id, &amp;
+                             local_id, geom_vec, ierr)
+      !use zoltan
+      implicit none
+
+      integer(ZOLTAN_INT), intent(in) :: data(*)
+      integer(ZOLTAN_INT), intent(in) :: num_gid_entries, num_lid_entries
+      integer(ZOLTAN_INT), intent(in) :: global_id, local_id
+      real(ZOLTAN_DOUBLE), intent(out) :: geom_vec(*)
+      integer(ZOLTAN_INT), intent(out) :: ierr
+
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      !! Assuming geom_dim is 3
+      geom_vec(1) = vertCoordX(local_id)
+      geom_vec(2) = vertCoordY(local_id)
+      geom_vec(3) = vertCoordZ(local_id)
+
+      ierr = ZOLTAN_OK
+      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+   end subroutine mpas_zqf_get_vert_geom
+   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+
+
+end module mpas_zoltan_interface

Deleted: branches/source_condensing/src/operators/Makefile
===================================================================
--- trunk/mpas/src/operators/Makefile        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/operators/Makefile        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,20 +0,0 @@
-.SUFFIXES: .F .o
-
-OBJS = module_RBF_interpolation.o module_vector_reconstruction.o module_spline_interpolation.o
-
-all: operators
-
-operators: $(OBJS)
-        ar -ru libops.a $(OBJS)
-
-module_vector_reconstruction.o: module_RBF_interpolation.o
-module_RBF_interpolation.o:
-module_spline_interpolation:
-
-clean:
-        $(RM) *.o *.mod *.f90 libops.a
-
-.F.o:
-        $(RM) $@ $*.mod
-        $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $&lt; &gt; $*.f90
-        $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework

Copied: branches/source_condensing/src/operators/Makefile (from rev 1114, trunk/mpas/src/operators/Makefile)
===================================================================
--- branches/source_condensing/src/operators/Makefile                                (rev 0)
+++ branches/source_condensing/src/operators/Makefile        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,20 @@
+.SUFFIXES: .F .o
+
+OBJS = mpas_rbf_interpolation.o mpas_vector_reconstruction.o mpas_spline_interpolation.o
+
+all: operators
+
+operators: $(OBJS)
+        ar -ru libops.a $(OBJS)
+
+mpas_vector_reconstruction.o: mpas_rbf_interpolation.o
+mpas_rbf_interpolation.o:
+mpas_spline_interpolation:
+
+clean:
+        $(RM) *.o *.mod *.f90 libops.a
+
+.F.o:
+        $(RM) $@ $*.mod
+        $(CPP) $(CPPFLAGS) $(CPPINCLUDES) $&lt; &gt; $*.f90
+        $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework

Deleted: branches/source_condensing/src/operators/module_RBF_interpolation.F
===================================================================
--- trunk/mpas/src/operators/module_RBF_interpolation.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/operators/module_RBF_interpolation.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,1824 +0,0 @@
-module RBF_interpolation
-   use dmpar
-   use grid_types
-
-   implicit none
-   private
-   save
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-! Purpose: perform interpolation of scalar and vector functions in 2D
-!   and 3D using Radial Basis Functions (RBFs).
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-   ! Initialize the geometry that will be useful from interpolation
-  public :: rbfInterp_initialize
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Routines for perofrming interpolation in 2D (including Jacobian and Hessian)
-  !  at locations that vary using a function that is fixed.  This is useful
-  !  for finding the location on the the RBF reconstruction of a function
-  !  (e.g., a height field) that minimizes the distance to a point in 3D space
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  public :: rbfInterp_loc_2D_sca_const_compCoeffs, &amp;
-    rbfInterp_loc_2D_sca_lin_compCoeffs, &amp;
-    rbfInterp_loc_2D_sca_const_evalWithDerivs, &amp;
-    rbfInterp_loc_2D_sca_lin_evalWithDerivs
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Routines for computing scalar interpolaiton coefficients in 3D (coplanar points
-  !  in 3D) with support for either constant or constant and linear basis
-  !  functions in addition to RBFs.  In constrast to the two subroutines
-  !  above, these coefficients are valid for computing the value of the
-  !  interpolant at a fixe point in space using function values that may
-  !  vary (e.g., in time) at each of the interpolation &quot;source&quot; points.
-  !  The last 3 routines can be used to compute coefficients for imposing both Neumann
-  !  and Dirichlet boundary conditions.
-  ! Pseudocode for function reconstruction at the destinationPoint is as follows
-  !  Dirichlet:  functionAtDestination = sum(functionAtSources*dirichletCoefficients)
-  !  Neumann:    functionAtDestination = sum(functionOrDerivAtSources*neumannCoefficients)
-  !    where functionOrDerivAtSource = functionAtSources where .not.(isInterface)
-  !                                  = functionNormalDerivAtSources where isInterface
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  public :: rbfInterp_func_3D_sca_const_dir_compCoeffs, &amp;
-    rbfInterp_func_3DPlane_sca_lin_dir_compCoeffs, &amp;
-    rbfInterp_func_3D_sca_lin_dir_compCoeffs, &amp;
-    rbfInterp_func_3D_sca_const_dirNeu_compCoeffs, &amp;
-    rbfInterp_func_3DPlane_sca_lin_dirNeu_compCoeffs, &amp;
-    rbfInterp_func_3D_sca_lin_dirNeu_compCoeffs
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Routines for computing vector interpolaiton coefficients in 3D (coplanar points
-  !  in 3D) with support for only constant basis functions in addition to RBFs. 
-  !  (Linear basis functions can cause problems: a linear vortex flow u = y xHat - x yHat
-  !  cannot be reconstructed from vectors that are only normal to the cell edges in 2D.
-  !  Therefore, we don't support them). As with the scalar 3D subroutines
-  !  above, these coefficients are valid for computing the value of the
-  !  interpolant at a fixe point in space using function values that may
-  !  vary (e.g., in time) at each of the interpolation &quot;source&quot; points.
-  !  The user supplies to these routines a set of sourcePoints and unitVectors
-  !  as well as a destinationPoint and, for the last 2 routines, flags for
-  !  which points are tangent to the interface and which of the supplied unitVectors
-  !  is the normal at the corresponding point.
-  !
-  ! The first two routines compute coefficients that can be used to interpolate
-  !  a vector function to the destination point given &quot;function dot unitVector&quot; values
-  !  at each source point.  These routines are useful, for example, for reconstructing
-  !  the full vector velocity at cell centers from the normal components of the velocity
-  !  at cell faces (or cell edges in 2D), or for computing the full velocity at an
-  !  immersed boundary image point based on the normal velocity at several faces and
-  !  the full velocity at boundary points (e.g., a no-slip boundary condition).
-  !
-  ! The last two routines compute coefficients that can be used to interpolate
-  !  a vector function to the destination point given &quot;function dot unitVector&quot; values
-  !  at non-tangent source point and &quot;dFunction/dn dot unitVector&quot; values at
-  !  tangent source point.  These routines are useful, for example, for computing the 
-  !  full velocity at an immersed boundary image point based on the normal velocity at
-  !  several faces, the normal velocity at boundary points (e.g., u dot n = 0 for a
-  !  no-penetration boundary condition on a fixed boundary), and the normal derivative
-  !  of the tangential components of velocity at the boundary points (e.g., a free-slip
-  !  boundary condition).
-  ! Pseudocode for function reconstruction at the destinationPoint is as follows
-  !  dirichlet:  functionAtDestination_i = sum_j(functionDotUnitVectorAtSources_j*coefficients_j,i)
-  !    for i = x,y,z
-  !  tangentNeumann:    functionAtDestination_i &amp;
-  !    = sum_(j where .not isTangent) (functionDotUnitVectorAtSources_j*coefficients_j,i) &amp;
-  !    + sum_(j where isTangent) ((dFunction/dn dot UnitVector)_j*coefficients_j,i)
-  !    for i = x,y,z
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  public :: rbfInterp_func_3D_vec_const_dir_compCoeffs, &amp;
-    rbfInterp_func_3DPlane_vec_const_dir_compCoeffs!, &amp;
-    !rbfInterp_func_3D_vec_const_tanNeu_compCoeffs, &amp;
-    !rbfInterp_func_3DPlane_vec_const_tanNeu_compCoeffs
-
-  contains
-
-  subroutine rbfInterp_initialize(grid)
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: compute geometric fields that will be potentially useful for calling
-  !          the interpolation routines
-  !
-  ! Input: the grid
-  !
-  ! Output: 
-  !  edgeNormalVectors - the unit vector at the center of each edge tangent to the sphere
-  !  cellTangentPlane - 2 orthogonal unit vectors in the tangent plane of each cell
-  !                     The first unit vector is chosen to point toward the center of the first
-  !                     edge on the cell.
-  !  localVerticalUnitVectors - the unit normal vector of the tangent plane at the center 
-  !                             of each cell
-  !       
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-    implicit none
-
-    type (mesh_type), intent(inout) :: grid 
-
-    integer :: nCells, nEdges
-    integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
-    integer :: iEdge, iCell, cell1, cell2
-    real(kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell, xEdge, yEdge, zEdge
-    real(kind=RKIND), dimension(:,:), pointer :: localVerticalUnitVectors, edgeNormalVectors
-    real(kind=RKIND), dimension(:,:,:), pointer :: cellTangentPlane
-    real(kind=RKIND), dimension(3) :: xHatPlane, yHatPlane, rHat
-    real(kind=RKIND) :: normalDotRHat
-    logical :: on_a_sphere
-
-    xCell       =&gt; grid % xCell % array
-    yCell       =&gt; grid % yCell % array
-    zCell       =&gt; grid % zCell % array
-    xEdge       =&gt; grid % xEdge % array
-    yEdge       =&gt; grid % yEdge % array
-    zEdge       =&gt; grid % zEdge % array
-    cellsOnEdge =&gt; grid % cellsOnEdge % array
-    edgesOnCell =&gt; grid % edgesOnCell % array
-    nCells      = grid % nCells
-    nEdges      = grid % nEdges
-    on_a_sphere = grid % on_a_sphere
-
-    localVerticalUnitVectors =&gt; grid % localVerticalUnitVectors % array
-    edgeNormalVectors =&gt; grid % edgeNormalVectors % array
-    cellTangentPlane =&gt; grid % cellTangentPlane % array
-
-    ! init arrays
-    edgeNormalVectors = 0
-    localVerticalUnitVectors = 0
-
-    ! loop over all cells to be solved on this block
-    do iCell=1,nCells
-      if(on_a_sphere) then
-        localVerticalUnitVectors(1,iCell) = xCell(iCell)
-        localVerticalUnitVectors(2,iCell) = yCell(iCell)
-        localVerticalUnitVectors(3,iCell) = zCell(iCell)
-        call unit_vec_in_R3(localVerticalUnitVectors(:,iCell))
-      else ! on a plane
-        localVerticalUnitVectors(:,iCell) = (/ 0., 0., 1. /)
-      end if
-    end do
-
-    do iEdge = 1,nEdges
-      iCell = cellsOnEdge(1,iEdge) ! the normal vector points from the first cell toward the edge
-      if(iCell == nCells+1) then ! this is a boundary edge
-        ! the first cell bordering this edge is not real, use the second cell
-        !  The normal should always point outward at boundaries, away from the valid cell center
-        iCell = cellsOnEdge(2,iEdge)
-      end if
-      ! the normal points from the cell location to the edge location
-      edgeNormalVectors(1,iEdge) = xEdge(iEdge) - xCell(iCell)
-      edgeNormalVectors(2,iEdge) = yEdge(iEdge) - yCell(iCell)
-      edgeNormalVectors(3,iEdge) = zEdge(iEdge) - zCell(iCell)
-      call unit_vec_in_R3(edgeNormalVectors(:,iEdge))
-    end do
-
-    do iCell=1,nCells
-      iEdge = edgesOnCell(1,iCell)
-      ! xHat and yHat are a local basis in the plane of the horizontal cell
-      ! we arbitrarily choose xHat to point toward the first edge
-      rHat = localVerticalUnitVectors(:,iCell)
-      normalDotRHat = sum(edgeNormalVectors(:,iEdge)*rHat)
-      xHatPlane = edgeNormalVectors(:,iEdge) - normalDotRHat*rHat
-      call unit_vec_in_R3(xHatPlane)
-
-      call cross_product_in_R3(rHat, xHatPlane, yHatPlane)
-      call unit_vec_in_R3(yHatPlane) ! just to be sure...
-      cellTangentPlane(:,1,iCell) = xHatPlane
-      cellTangentPlane(:,2,iCell) = yHatPlane
-    end do
-
-  end subroutine rbfInterp_initialize
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Compute interpolation coefficients in 2D that can be used to
-  !  reconstruct a given scalar function at varying locations. This is useful
-  !  for finding the location on the the RBF reconstruction of a function
-  !  (e.g., a height field) that minimizes the distance to a point in 3D space.
-  !  The reconstruction is performed with basis functions that are RBFs and constant 
-  ! Input:
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  coeffCount - the size of coefficients, must be at least pointCount + 1
-  !  points - the location of the &quot;source&quot; points in the 2D space where the values of
-  !    the function are known
-  !  fieldValues - the values of the function of interest at the points
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  ! Output:
-  !  coefficients - the coefficients needed to perform interpolation of the funciton
-  !    at destination points yet to be specified
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_loc_2D_sca_const_compCoeffs(pointCount, coeffCount, &amp;
-    points, fieldValues, alpha, coefficients)

-    integer, intent(in) :: pointCount, coeffCount
-    real(kind=RKIND), dimension(pointCount,2), intent(in) :: points
-    real(kind=RKIND), dimension(pointCount), intent(in) :: fieldValues
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(coeffCount), intent(out) :: coefficients
-
-    integer :: i, j, matrixSize
-    real(kind=RKIND), dimension(pointCount+1,pointCount+1) :: matrix
-    real(kind=RKIND), dimension(pointCount+1) :: rhs
-    integer, dimension(pointCount+1) :: pivotIndices
-    real(kind=RKIND) :: rSquared
-
-    matrixSize = pointCount+1
-    coefficients = 0.0
-    matrix = 0.0
-    rhs = 0.0
-
-    rhs(1:pointCount) = fieldValues
-
-    do j=1,pointCount
-      do i=j,pointCount
-        rSquared = sum((points(j,:) - points(i,:))**2)/alpha**2
-        matrix(i,j) = evaluateRBF(rSquared)
-        matrix(j,i) = matrix(i,j)
-      end do
-    end do
-    do j=1,pointCount
-      matrix(pointCount+1,j) = 1.0
-      matrix(j,pointCount+1) = 1.0
-    end do
-
-    call LEGS(matrix(1:matrixSize,1:matrixSize), matrixSize, rhs(1:matrixSize), &amp;
-      coefficients(1:matrixSize), pivotIndices(1:matrixSize))
-
-  end subroutine rbfInterp_loc_2D_sca_const_compCoeffs
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Compute interpolation coefficients in 2D that can be used to
-  !  reconstruct a given scalar function at varying locations. This is useful
-  !  for finding the location on the the RBF reconstruction of a function
-  !  (e.g., a height field) that minimizes the distance to a point in 3D space.
-  !  The reconstruction is performed with basis functions that are RBFs plus constant
-  !  and linear 
-  ! Input:
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  coeffCount - the size of coefficients, must be at least pointCount + 3
-  !  points - the location of the &quot;source&quot; points in the 2D space where the values of
-  !    the function are known
-  !  fieldValues - the values of the function of interest at the points
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  ! Output:
-  !  coefficients - the coefficients needed to perform interpolation of the funciton
-  !    at destination points yet to be specified
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_loc_2D_sca_lin_compCoeffs(pointCount, coeffCount, &amp;
-    points, fieldValues, alpha, coefficients)

-    integer, intent(in) :: pointCount, coeffCount
-    real(kind=RKIND), dimension(pointCount,2), intent(in) :: points
-    real(kind=RKIND), dimension(pointCount), intent(in) :: fieldValues
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(coeffCount), intent(out) :: coefficients
-
-    integer :: i, j, matrixSize
-    real(kind=RKIND), dimension(pointCount+3,pointCount+3) :: matrix
-    real(kind=RKIND), dimension(pointCount+3) :: rhs
-    integer, dimension(pointCount+3) :: pivotIndices
-    real(kind=RKIND) :: rSquared
-
-    coefficients = 0.0
-    matrix = 0.0
-    rhs = 0.0
-
-    rhs(1:pointCount) = fieldValues
-
-    do j=1,pointCount
-      do i=j,pointCount
-        rSquared = sum((points(j,:) - points(i,:))**2)/alpha**2
-        matrix(i,j) = evaluateRBF(rSquared)
-        matrix(j,i) = matrix(i,j)
-      end do
-    end do
-    matrixSize = pointCount+3
-    do j=1,pointCount
-      matrix(pointCount+1,j) = 1.0
-      matrix(pointCount+2,j) = points(j,1)
-      matrix(pointCount+3,j) = points(j,2)
-      matrix(j,pointCount+1:pointCount+3) = matrix(pointCount+1:pointCount+3, j)
-    end do
-    call LEGS(matrix(1:matrixSize,1:matrixSize), matrixSize, rhs(1:matrixSize), &amp;
-      coefficients(1:matrixSize), pivotIndices(1:matrixSize))
-
-  end subroutine rbfInterp_loc_2D_sca_lin_compCoeffs
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Evalute a scalar function in 2D using coefficients computed in
-  !  rbfInterp_loc_2D_sca_const_compCoeffs.  This 
-  !  function can be called repeatedly with different destination points
-  !  to quickly evaluate the interpolating function using the same
-  !  coefficients.  This is useful for finding the location on the the 
-  !  RBF reconstruction of a function (e.g., a height field) that minimizes
-  !  the distance to a point in 3D space. The reconstruction is performed
-  !  with basis functions that are RBFs and constant 
-  ! Input:
-  !  fieldCount - the number fields to be evaluated.  This is useful for reconstructing,
-  !    for example, the x-, y- and z-components of a vector field at the same
-  !    point in 2D
-  !  coeffCount - the size of coefficients, must be at least pointCount + 1
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  coefficients - the coefficients needed to perform interpolation of the funciton
-  !    at the evaluationPoint
-  !  evaluationPoint - the point in 2D where the function is to be reconstructed
-  !  points - the location of the &quot;source&quot; points in the 2D space where the values of
-  !    the function are known
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  ! Output:
-  !  derivs - the value of the function, the 2 components of its Jacobian and
-  !    the 3 unique components of its Hessian at the evaluationPoint
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_loc_2D_sca_const_evalWithDerivs(fieldCount, coeffCount, &amp;
-    pointCount, coefficients, evaluationPoint, points, alpha, derivs)
-    integer, intent(in) :: fieldCount, coeffCount, pointCount
-    real(kind=RKIND), dimension(coeffCount, fieldCount), intent(in) :: coefficients
-    real(kind=RKIND), dimension(2), intent(in) :: evaluationPoint
-    real(kind=RKIND), dimension(pointCount,2), intent(in) :: points
-    real(kind=RKIND), intent(in) :: alpha
-
-    real(kind=RKIND), dimension(6,fieldCount), intent(out) :: derivs
-
-    integer :: pointIndex
-    real(kind=RKIND) :: x, y, rSquared, rbfValue, rbfDerivOverR, rbfSecondDeriv
-
-    derivs = 0.0
-    do pointIndex = 1, pointCount
-      x = (evaluationPoint(1) - points(pointIndex,1))
-      y = (evaluationPoint(2) - points(pointIndex,2))
-      rSquared = x**2 + y**2
-      call evaluateRBFAndDerivs(rSquared/alpha**2,  rbfValue, rbfDerivOverR, rbfSecondDeriv)
-      rbfDerivOverR = rbfDerivOverR/alpha**2
-      rbfSecondDeriv = rbfSecondDeriv/alpha**2
-      if(rSquared/alpha**2 &lt; 1e-7) then
-        ! terms 2,3 and 5 are zero by radial symmetry of the RBF
-        derivs(1,:) = derivs(1,:) + coefficients(pointIndex,:)*rbfValue
-        derivs(4,:) = derivs(4,:) + coefficients(pointIndex,:)*rbfSecondDeriv
-        derivs(6,:) = derivs(6,:) + coefficients(pointIndex,:)*rbfSecondDeriv
-      else
-        call evaluateRBFAndDerivs(rSquared,  rbfValue, rbfDerivOverR, rbfSecondDeriv)
-        derivs(1,:) = derivs(1,:) + coefficients(pointIndex,:)*rbfValue
-        derivs(2,:) = derivs(2,:) + coefficients(pointIndex,:)*rbfDerivOverR*x
-        derivs(3,:) = derivs(3,:) + coefficients(pointIndex,:)*rbfDerivOverR*y
-        derivs(4,:) = derivs(4,:) + coefficients(pointIndex,:) &amp;
-          * (rbfSecondDeriv*x**2 + rbfDerivOverR*y**2)/rSquared
-        derivs(5,:) = derivs(5,:) + coefficients(pointIndex,:) &amp;
-          * (rbfSecondDeriv - rbfDerivOverR)*x*y/rSquared
-        derivs(6,:) = derivs(6,:) + coefficients(pointIndex,:) &amp;
-          * (rbfSecondDeriv*y**2 + rbfDerivOverR*x**2)/rSquared
-      end if
-    end do
-    derivs(1,:) = derivs(1,:) + coefficients(pointCount+1,:)
-  end subroutine rbfInterp_loc_2D_sca_const_evalWithDerivs
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Evalute a scalar function in 2D using coefficients computed in
-  !  rbfInterp_loc_2D_sca_const_compCoeffs.  This 
-  !  function can be called repeatedly with different destination points
-  !  to quickly evaluate the interpolating function using the same
-  !  coefficients.  This is useful for finding the location on the the 
-  !  RBF reconstruction of a function (e.g., a height field) that minimizes
-  !  the distance to a point in 3D space. The reconstruction is performed
-  !  with basis functions that are RBFs, constant and linear
-  ! Input:
-  !  fieldCount - the number fields to be evaluated.  This is useful for reconstructing,
-  !    for example, the x-, y- and z-components of a vector field at the same
-  !    point in 2D
-  !  coeffCount - the size of coefficients, must be at least pointCount + 1
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  coefficients - the coefficients needed to perform interpolation of the funciton
-  !    at the evaluationPoint
-  !  evaluationPoint - the point in 2D where the function is to be reconstructed
-  !  points - the location of the &quot;source&quot; points in the 2D space where the values of
-  !    the function are known
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  ! Output:
-  !  derivs - the value of the function, the 2 components of its Jacobian and
-  !    the 3 unique components of its Hessian at the evaluationPoint
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_loc_2D_sca_lin_evalWithDerivs(fieldCount, coeffCount, &amp;
-    pointCount, coefficients, evaluationPoint, points, alpha, derivs)
-    integer, intent(in) :: fieldCount, coeffCount, pointCount
-    real(kind=RKIND), dimension(coeffCount, fieldCount), intent(in) :: coefficients
-    real(kind=RKIND), dimension(2), intent(in) :: evaluationPoint
-    real(kind=RKIND), dimension(pointCount,2), intent(in) :: points
-    real(kind=RKIND), intent(in) :: alpha
-
-    real(kind=RKIND), dimension(6,fieldCount), intent(out) :: derivs
-
-    integer :: pointIndex
-    real(kind=RKIND) :: x, y, rSquared, rbfValue, rbfDerivOverR, rbfSecondDeriv
-
-    derivs = 0.0
-    do pointIndex = 1, pointCount
-      x = (evaluationPoint(1) - points(pointIndex,1))
-      y = (evaluationPoint(2) - points(pointIndex,2))
-      rSquared = x**2 + y**2
-      call evaluateRBFAndDerivs(rSquared/alpha**2,  rbfValue, rbfDerivOverR, rbfSecondDeriv)
-      rbfDerivOverR = rbfDerivOverR/alpha**2
-      rbfSecondDeriv = rbfSecondDeriv/alpha**2
-      if(rSquared/alpha**2 &lt; 1e-7) then
-        ! terms 2,3 and 5 are zero by radial symmetry of the RBF
-        derivs(1,:) = derivs(1,:) + coefficients(pointIndex,:)*rbfValue
-        derivs(4,:) = derivs(4,:) + coefficients(pointIndex,:)*rbfSecondDeriv
-        derivs(6,:) = derivs(6,:) + coefficients(pointIndex,:)*rbfSecondDeriv
-      else
-        call evaluateRBFAndDerivs(rSquared,  rbfValue, rbfDerivOverR, rbfSecondDeriv)
-        derivs(1,:) = derivs(1,:) + coefficients(pointIndex,:)*rbfValue
-        derivs(2,:) = derivs(2,:) + coefficients(pointIndex,:)*rbfDerivOverR*x
-        derivs(3,:) = derivs(3,:) + coefficients(pointIndex,:)*rbfDerivOverR*y
-        derivs(4,:) = derivs(4,:) + coefficients(pointIndex,:) &amp;
-          * (rbfSecondDeriv*x**2 + rbfDerivOverR*y**2)/rSquared
-        derivs(5,:) = derivs(5,:) + coefficients(pointIndex,:) &amp;
-          * (rbfSecondDeriv - rbfDerivOverR)*x*y/rSquared
-        derivs(6,:) = derivs(6,:) + coefficients(pointIndex,:) &amp;
-          * (rbfSecondDeriv*y**2 + rbfDerivOverR*x**2)/rSquared
-      end if
-    end do
-    derivs(1,:) = derivs(1,:) + coefficients(pointCount+1,:) &amp;
-      + coefficients(pointCount+2,:)*evaluationPoint(1) &amp;
-      + coefficients(pointCount+3,:)*evaluationPoint(2)
-    derivs(2,:) = derivs(2,:) + coefficients(pointCount+2,:)
-    derivs(3,:) = derivs(3,:) + coefficients(pointCount+3,:)
-
-  end subroutine rbfInterp_loc_2D_sca_lin_evalWithDerivs
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Compute interpolation coefficients in 3D that can be used to
-  !  interpolate a number of scalar functions at a given locations. This is useful
-  !  if the interpolation location does not change with time, or if several
-  !  fields are to be interpolated at a given time step.  (If both the fields
-  !  and the interpolation locations vary with time, there is no clear advantage in
-  !  using either this method or the method for 2D interpoaltion above; for simplicity
-  !  and because we foresee more uses for the method of this subroutine, we have not
-  !  implemented a 3D version of the fixed field, variable interpolation location method
-  !  as we have in 2D.) Coefficients are produced for handling Dirichlet boundary
-  !  conditions (or no boundaries).  The interpolation is performed with basis functions
-  !  that are RBFs plus a constant.
-  ! Input:
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
-  !    the function are known
-  !  destinationPoint - the point where the interpolation will be performed
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  ! Output:
-  !  coefficients - the coefficients used to interpolate a function with Dirichlet
-  !    boundary conditions to the specified destinationPoint
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_func_3D_sca_const_dir_compCoeffs( &amp;
-    pointCount, sourcePoints, destinationPoint, alpha, coefficients)
-
-    integer, intent(in) :: pointCount
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
-    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(pointCount), intent(out) :: coefficients
-
-    integer :: i, j
-    integer :: matrixSize
-
-    real(kind=RKIND), dimension(:,:), pointer :: dirichletMatrix
-    real(kind=RKIND), dimension(:), pointer :: rhs, coeffs
-    integer, dimension(:), pointer :: pivotIndices
-
-    matrixSize = pointCount+1 !! 1 extra space for constant 
-
-    allocate(dirichletMatrix(matrixSize,matrixSize))  
-    allocate(rhs(matrixSize))  
-    allocate(coeffs(matrixSize))  
-    allocate(pivotIndices(matrixSize))  
-
-    dirichletMatrix = 0.0
-    rhs = 0.0
-    coeffs = 0.0
-
-    call setUpScalarRBFDirichletMatrixAndRHS(pointCount, sourcePoints, destinationPoint, &amp;
-      alpha, dirichletMatrix(1:pointCount,1:pointCount), rhs(1:pointCount))
-
-    do i = 1, pointCount
-      dirichletMatrix(i,pointCount+1) = 1.0
-      dirichletMatrix(pointCount+1,i) = dirichletMatrix(i,pointCount+1)
-    end do
-
-    rhs(pointCount+1) = 1.0
-
-    ! solve each linear system
-    call LEGS(dirichletMatrix, matrixSize, rhs, coeffs, pivotIndices)
-    coefficients = coeffs(1:pointCount)
-
-    deallocate(dirichletMatrix)  
-    deallocate(rhs)  
-    deallocate(coeffs)  
-    deallocate(pivotIndices) 
-
-  end subroutine rbfInterp_func_3D_sca_const_dir_compCoeffs
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Compute interpolation coefficients in a plane in 3D that can be used to
-  !  interpolate a number of scalar functions at a given locations. This is useful
-  !  if the interpolation location does not change with time, or if several
-  !  fields are to be interpolated at a given time step.  (If both the fields
-  !  and the interpolation locations vary with time, there is no clear advantage in
-  !  using either this method or the method for 2D interpoaltion above; for simplicity
-  !  and because we foresee more uses for the method of this subroutine, we have not
-  !  implemented a 3D version of the fixed field, variable interpolation location method
-  !  as we have in 2D.) Coefficients are produced for handling both Dirichlet (or no)
-  !  boundary conditions.  The interpolation is performed with basis functions that are
-  !  RBFs plus constant and linear.  All points are projected into the plane given by the
-  !  planeBasisVectors.
-  ! Input:
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
-  !    the function are known.  The points will be projected into the plane given by 
-  !    planeBasisVectors
-  !  destinationPoint - the point in 3D where the interpolation will be performed.  The
-  !    destinationPoint will be projected into the plane given by planeBasisVectors.
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  !  planeBasisVectors - the basis fectors for the plane where interpolation is performed.
-  !    All points are projected into this plane. 
-  ! Output:
-  !  coefficients - the coefficients used to interpolate a function with Dirichlet
-  !    boundary conditions to the specified destinationPoint
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_func_3DPlane_sca_lin_dir_compCoeffs( &amp;
-    pointCount, sourcePoints, destinationPoint, &amp;
-    alpha, planeBasisVectors, coefficients)
-
-    integer, intent(in) :: pointCount
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
-    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(2,3) :: planeBasisVectors
-    real(kind=RKIND), dimension(pointCount), intent(out) :: coefficients
-
-    integer :: i, j
-    integer :: matrixSize
-
-    real(kind=RKIND), dimension(:,:), pointer :: dirichletMatrix
-    real(kind=RKIND), dimension(:), pointer :: rhs, coeffs
-    integer, dimension(:), pointer :: pivotIndices
-
-    matrixSize = pointCount+3 !! 3 extra space for constant and 2 planar dimensions
-
-    allocate(dirichletMatrix(matrixSize,matrixSize))  
-    allocate(rhs(matrixSize))  
-    allocate(coeffs(matrixSize))  
-    allocate(pivotIndices(matrixSize))  
-
-    dirichletMatrix = 0.0
-    rhs = 0.0
-    coeffs = 0.0
-
-    call setUpScalarRBFDirichletMatrixAndRHS(pointCount, sourcePoints, destinationPoint, &amp;
-      alpha, dirichletMatrix(1:pointCount,1:pointCount), rhs(1:pointCount))
-
-    do i = 1, pointCount
-      dirichletMatrix(i,pointCount+1) = 1.0
-      dirichletMatrix(i,pointCount+2) = sum(sourcePoints(i,1:3)*planeBasisVectors(1,:))
-      dirichletMatrix(i,pointCount+3) = sum(sourcePoints(i,1:3)*planeBasisVectors(2,:))
-      dirichletMatrix(pointCount+1:pointCount+3,i) &amp;
-        = dirichletMatrix(i,pointCount+1:pointCount+3)
-    end do
-
-    rhs(pointCount+1) = 1.0
-    rhs(pointCount+2) = sum(destinationPoint(1:3)*planeBasisVectors(1,:))
-    rhs(pointCount+3) = sum(destinationPoint(1:3)*planeBasisVectors(2,:))
-
-    ! solve each linear system
-    call LEGS(dirichletMatrix, matrixSize, rhs, coeffs, pivotIndices)
-    coefficients = coeffs(1:pointCount)
-
-    deallocate(dirichletMatrix)  
-    deallocate(rhs)  
-    deallocate(coeffs)  
-    deallocate(pivotIndices) 
-
-  end subroutine rbfInterp_func_3DPlane_sca_lin_dir_compCoeffs
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Compute interpolation coefficients in 3D that can be used to
-  !  interpolate a number of scalar functions at a given locations. This is useful
-  !  if the interpolation location does not change with time, or if several
-  !  fields are to be interpolated at a given time step.  (If both the fields
-  !  and the interpolation locations vary with time, there is no clear advantage in
-  !  using either this method or the method for 2D interpoaltion above; for simplicity
-  !  and because we foresee more uses for the method of this subroutine, we have not
-  !  implemented a 3D version of the fixed field, variable interpolation location method
-  !  as we have in 2D.) Coefficients are produced for handling both Dirichlet (or no)
-  !  boundary conditions.  The interpolation is performed with basis functions that are
-  !  RBFs plus constant and linear.
-  ! Input:
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
-  !    the function are known
-  !  destinationPoint - the point where the interpolation will be performed
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  ! Output:
-  !  coefficients - the coefficients used to interpolate a function with Dirichlet
-  !    boundary conditions to the specified destinationPoint
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_func_3D_sca_lin_dir_compCoeffs(pointCount, &amp;
-    sourcePoints, destinationPoint, alpha, coefficients)
-
-    integer, intent(in) :: pointCount
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
-    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(pointCount), intent(out) :: coefficients
-
-    integer :: i, j
-    integer :: matrixSize
-
-    real(kind=RKIND), dimension(:,:), pointer :: dirichletMatrix
-    real(kind=RKIND), dimension(:), pointer :: rhs, coeffs
-    integer, dimension(:), pointer :: pivotIndices
-
-    matrixSize = pointCount+4 !! 4 extra space for constant and linear in 3D
-
-    allocate(dirichletMatrix(matrixSize,matrixSize))  
-    allocate(rhs(matrixSize))  
-    allocate(coeffs(matrixSize))  
-    allocate(pivotIndices(matrixSize))  
-
-    dirichletMatrix = 0.0
-    rhs = 0.0
-    coeffs = 0.0
-
-    call setUpScalarRBFDirichletMatrixAndRHS(pointCount, sourcePoints, destinationPoint, &amp;
-      alpha, dirichletMatrix(1:pointCount,1:pointCount), rhs(1:pointCount))
-
-    do i = 1, pointCount
-      dirichletMatrix(i,pointCount+1) = 1.0
-      dirichletMatrix(i,pointCount+2:pointCount+4) = sourcePoints(i,1:3)
-      dirichletMatrix(pointCount+1:pointCount+4,i) &amp;
-        = dirichletMatrix(i,pointCount+1:pointCount+4)
-    end do
-
-    rhs(pointCount+1) = 1.0
-    rhs(pointCount+2:pointCount+4) = destinationPoint(1:3)
-
-    ! solve each linear system
-    call LEGS(dirichletMatrix, matrixSize, rhs, coeffs, pivotIndices)
-    coefficients = coeffs(1:pointCount)
-
-    deallocate(dirichletMatrix)  
-    deallocate(rhs)  
-    deallocate(coeffs)  
-    deallocate(pivotIndices) 
-
-  end subroutine rbfInterp_func_3D_sca_lin_dir_compCoeffs
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Compute interpolation coefficients in 3D that can be used to
-  !  interpolate a number of scalar functions at a given locations. This is useful
-  !  if the interpolation location does not change with time, or if several
-  !  fields are to be interpolated at a given time step.  (If both the fields
-  !  and the interpolation locations vary with time, there is no clear advantage in
-  !  using either this method or the method for 2D interpoaltion above; for simplicity
-  !  and because we foresee more uses for the method of this subroutine, we have not
-  !  implemented a 3D version of the fixed field, variable interpolation location method
-  !  as we have in 2D.) Coefficients are produced for handling both Dirichlet and Neumann
-  !  boundary conditions.  The interpolation is performed with basis functions that are
-  !  RBFs plus a constant.
-  ! Input:
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
-  !    the function are known
-  !  isInterface - a logical array indicating which of the source points (if any) are at
-  !    at the domain interface.  These points and their normals will be used to compute the
-  !    neumannCoefficients below
-  !  interfaceNormals - a 3D normal vector for each sourcePoint.  These vectors are only used
-  !    at points where isInterface == .true., and can take arbitrary values elsewehere.  The
-  !    normal vector is used to compute coefficients for the normal derivative of the
-  !    interpolating function in order to impose the Neumann Boundary condition
-  !  destinationPoint - the point where the interpolation will be performed
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  ! Output:
-  !  dirichletCoefficients - the coefficients used to interpolate a function with Dirichlet
-  !    boundary conditions to the specified destinationPoint
-  !  neumannCoefficients - the coefficients used to interpolate a function with Neumann
-  !    boundary conditions to the specified destinationPoint
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_func_3D_sca_const_dirNeu_compCoeffs( &amp;
-    pointCount, sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
-    alpha, dirichletCoefficients, neumannCoefficients)
-
-    integer, intent(in) :: pointCount
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
-    logical, dimension(pointCount), intent(in) :: isInterface
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals
-    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(pointCount), intent(out) :: &amp;
-      dirichletCoefficients, neumannCoefficients
-
-    integer :: i, j
-    integer :: matrixSize
-
-    real(kind=RKIND), dimension(:,:), pointer :: dirichletMatrix, neumannMatrix
-    real(kind=RKIND), dimension(:), pointer :: rhs, rhsCopy, coeffs
-    integer, dimension(:), pointer :: pivotIndices
-
-    matrixSize = pointCount+1 !! 1 extra space for constant 
-
-    allocate(dirichletMatrix(matrixSize,matrixSize))  
-    allocate(neumannMatrix(matrixSize,matrixSize))  
-    allocate(rhs(matrixSize))  
-    allocate(rhsCopy(matrixSize))  
-    allocate(coeffs(matrixSize))  
-    allocate(pivotIndices(matrixSize))  
-
-    dirichletMatrix = 0.0
-    neumannMatrix = 0.0
-    rhs = 0.0
-    rhsCopy = 0.0
-    coeffs = 0.0
-
-    call setUpScalarRBFMatrixAndRHS(pointCount, &amp;
-      sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
-      alpha, dirichletMatrix(1:pointCount,1:pointCount), &amp;
-      neumannMatrix(1:pointCount,1:pointCount), rhs(1:pointCount))
-
-    do i = 1, pointCount
-      dirichletMatrix(i,pointCount+1) = 1.0
-      if(isInterface(i)) then
-        neumannMatrix(i,pointCount+1) = 0.0
-      else
-        neumannMatrix(i,pointCount+1) = dirichletMatrix(i,pointCount+1)
-      end if
-      dirichletMatrix(pointCount+1,i) = dirichletMatrix(i,pointCount+1)
-      neumannMatrix(pointCount+1,i) = neumannMatrix(i,pointCount+1)
-    end do
-
-    rhs(pointCount+1) = 1.0
-
-    ! solve each linear system
-    rhsCopy = rhs
-    call LEGS(dirichletMatrix, matrixSize, rhs, coeffs, pivotIndices)
-    dirichletCoefficients = coeffs(1:pointCount)
-
-    call LEGS(neumannMatrix, matrixSize, rhsCopy, coeffs, pivotIndices)
-    neumannCoefficients = coeffs(1:pointCount)
-
-    deallocate(dirichletMatrix)  
-    deallocate(neumannMatrix)  
-    deallocate(rhs)  
-    deallocate(rhsCopy)  
-    deallocate(coeffs)  
-    deallocate(pivotIndices) 
-
-  end subroutine rbfInterp_func_3D_sca_const_dirNeu_compCoeffs
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Compute interpolation coefficients in a plane in 3D that can be used to
-  !  interpolate a number of scalar functions at a given locations. This is useful
-  !  if the interpolation location does not change with time, or if several
-  !  fields are to be interpolated at a given time step.  (If both the fields
-  !  and the interpolation locations vary with time, there is no clear advantage in
-  !  using either this method or the method for 2D interpoaltion above; for simplicity
-  !  and because we foresee more uses for the method of this subroutine, we have not
-  !  implemented a 3D version of the fixed field, variable interpolation location method
-  !  as we have in 2D.) Coefficients are produced for handling both Dirichlet and Neumann
-  !  boundary conditions.  The interpolation is performed with basis functions that are
-  !  RBFs plus constant and linear.  All points are projected into the plane given by the
-  !  planeBasisVectors.
-  ! Input:
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
-  !    the function are known.  The sourcePoints will be projected into the plane given by
-  !    planeBasisVectors
-  !  isInterface - a logical array indicating which of the source points (if any) are at
-  !    at the domain interface.  These points and their normals will be used to compute the
-  !    neumannCoefficients below
-  !  interfaceNormals - a 3D normal vector for each sourcePoint.  These vectors are only used
-  !    at points where isInterface == .true., and can take arbitrary values elsewehere.  The
-  !    normal vector is used to compute coefficients for the normal derivative of the
-  !    interpolating function in order to impose the Neumann Boundary condition
-  !  destinationPoint - the point in 3D where the interpolation will be performed.  The
-  !    destinationPoint will be projected into the plane given by planeBasisVectors.
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  !  planeBasisVectors - the basis fectors for the plane where interpolation is performed.
-  !    All points are projected into this plane. 
-  ! Output:
-  !  dirichletCoefficients - the coefficients used to interpolate a function with Dirichlet
-  !    boundary conditions to the specified destinationPoint
-  !  neumannCoefficients - the coefficients used to interpolate a function with Neumann
-  !    boundary conditions to the specified destinationPoint
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_func_3DPlane_sca_lin_dirNeu_compCoeffs( &amp;
-    pointCount, sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
-    alpha, planeBasisVectors, dirichletCoefficients, neumannCoefficients)
-
-    integer, intent(in) :: pointCount
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
-    logical, dimension(pointCount), intent(in) :: isInterface
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals
-    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(2,3) :: planeBasisVectors
-    real(kind=RKIND), dimension(pointCount), intent(out) :: &amp;
-      dirichletCoefficients, neumannCoefficients
-
-    integer :: i, j
-    integer :: matrixSize
-
-    real(kind=RKIND), dimension(:,:), pointer :: dirichletMatrix, neumannMatrix
-    real(kind=RKIND), dimension(:), pointer :: rhs, rhsCopy, coeffs
-    integer, dimension(:), pointer :: pivotIndices
-
-    matrixSize = pointCount+3 !! 3 extra space for constant and 2 planar dimensions
-
-    allocate(dirichletMatrix(matrixSize,matrixSize))  
-    allocate(neumannMatrix(matrixSize,matrixSize))  
-    allocate(rhs(matrixSize))  
-    allocate(rhsCopy(matrixSize))  
-    allocate(coeffs(matrixSize))  
-    allocate(pivotIndices(matrixSize))  
-
-    dirichletMatrix = 0.0
-    neumannMatrix = 0.0
-    rhs = 0.0
-    rhsCopy = 0.0
-    coeffs = 0.0
-
-    call setUpScalarRBFMatrixAndRHS(pointCount, &amp;
-      sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
-      alpha, dirichletMatrix(1:pointCount,1:pointCount), &amp;
-      neumannMatrix(1:pointCount,1:pointCount), rhs(1:pointCount))
-
-    do i = 1, pointCount
-      dirichletMatrix(i,pointCount+1) = 1.0
-      dirichletMatrix(i,pointCount+2) = sum(sourcePoints(i,1:3)*planeBasisVectors(1,:))
-      dirichletMatrix(i,pointCount+3) = sum(sourcePoints(i,1:3)*planeBasisVectors(2,:))
-      if(isInterface(i)) then
-        neumannMatrix(i,pointCount+1) = 0.0
-        neumannMatrix(i,pointCount+2) = sum(interfaceNormals(i,1:3)*planeBasisVectors(1,:))
-        neumannMatrix(i,pointCount+3) = sum(interfaceNormals(i,1:3)*planeBasisVectors(2,:))
-      else
-        neumannMatrix(i,pointCount+1:pointCount+3) &amp;
-          = dirichletMatrix(i,pointCount+1:pointCount+3)
-      end if
-      dirichletMatrix(pointCount+1:pointCount+3,i) &amp;
-        = dirichletMatrix(i,pointCount+1:pointCount+3)
-      neumannMatrix(pointCount+1:pointCount+3,i) &amp;
-        = neumannMatrix(i,pointCount+1:pointCount+3)
-    end do
-
-    rhs(pointCount+1) = 1.0
-    rhs(pointCount+2) = sum(destinationPoint(1:3)*planeBasisVectors(1,:))
-    rhs(pointCount+3) = sum(destinationPoint(1:3)*planeBasisVectors(2,:))
-
-    ! solve each linear system
-    rhsCopy = rhs
-    call LEGS(dirichletMatrix, matrixSize, rhs, coeffs, pivotIndices)
-    dirichletCoefficients = coeffs(1:pointCount)
-
-    call LEGS(neumannMatrix, matrixSize, rhsCopy, coeffs, pivotIndices)
-    neumannCoefficients = coeffs(1:pointCount)
-
-    deallocate(dirichletMatrix)  
-    deallocate(neumannMatrix)  
-    deallocate(rhs)  
-    deallocate(rhsCopy)  
-    deallocate(coeffs)  
-    deallocate(pivotIndices) 
-
-  end subroutine rbfInterp_func_3DPlane_sca_lin_dirNeu_compCoeffs
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Compute interpolation coefficients in 3D that can be used to
-  !  interpolate a number of scalar functions at a given locations. This is useful
-  !  if the interpolation location does not change with time, or if several
-  !  fields are to be interpolated at a given time step.  (If both the fields
-  !  and the interpolation locations vary with time, there is no clear advantage in
-  !  using either this method or the method for 2D interpoaltion above; for simplicity
-  !  and because we foresee more uses for the method of this subroutine, we have not
-  !  implemented a 3D version of the fixed field, variable interpolation location method
-  !  as we have in 2D.) Coefficients are produced for handling both Dirichlet and Neumann
-  !  boundary conditions.  The interpolation is performed with basis functions that are
-  !  RBFs plus constant and linear.
-  ! Input:
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
-  !    the function are known
-  !  isInterface - a logical array indicating which of the source points (if any) are at
-  !    at the domain interface.  These points and their normals will be used to compute the
-  !    neumannCoefficients below
-  !  interfaceNormals - a 3D normal vector for each sourcePoint.  These vectors are only used
-  !    at points where isInterface == .true., and can take arbitrary values elsewehere.  The
-  !    normal vector is used to compute coefficients for the normal derivative of the
-  !    interpolating function in order to impose the Neumann Boundary condition
-  !  destinationPoint - the point where the interpolation will be performed
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  ! Output:
-  !  dirichletCoefficients - the coefficients used to interpolate a function with Dirichlet
-  !    boundary conditions to the specified destinationPoint
-  !  neumannCoefficients - the coefficients used to interpolate a function with Neumann
-  !    boundary conditions to the specified destinationPoint
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_func_3D_sca_lin_dirNeu_compCoeffs(pointCount, &amp;
-    sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
-    alpha, dirichletCoefficients, neumannCoefficients)
-
-    integer, intent(in) :: pointCount
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
-    logical, dimension(pointCount), intent(in) :: isInterface
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals
-    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(pointCount), intent(out) :: &amp;
-      dirichletCoefficients, neumannCoefficients
-
-    integer :: i, j
-    integer :: matrixSize
-
-    real(kind=RKIND), dimension(:,:), pointer :: dirichletMatrix, neumannMatrix
-    real(kind=RKIND), dimension(:), pointer :: rhs, rhsCopy, coeffs
-    integer, dimension(:), pointer :: pivotIndices
-
-    matrixSize = pointCount+4 !! 4 extra space for constant and linear in 3D
-
-    allocate(dirichletMatrix(matrixSize,matrixSize))  
-    allocate(neumannMatrix(matrixSize,matrixSize))  
-    allocate(rhs(matrixSize))  
-    allocate(rhsCopy(matrixSize))  
-    allocate(coeffs(matrixSize))  
-    allocate(pivotIndices(matrixSize))  
-
-    dirichletMatrix = 0.0
-    neumannMatrix = 0.0
-    rhs = 0.0
-    rhsCopy = 0.0
-    coeffs = 0.0
-
-    call setUpScalarRBFMatrixAndRHS(pointCount, &amp;
-      sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
-      alpha, dirichletMatrix(1:pointCount,1:pointCount), &amp;
-      neumannMatrix(1:pointCount,1:pointCount), rhs(1:pointCount))
-
-    do i = 1, pointCount
-      dirichletMatrix(i,pointCount+1) = 1.0
-      dirichletMatrix(i,pointCount+2:pointCount+4) = sourcePoints(i,1:3)
-      if(isInterface(i)) then
-        neumannMatrix(i,pointCount+1) = 0.0
-        neumannMatrix(i,pointCount+2:pointCount+4) = interfaceNormals(i,1:3)
-      else
-        neumannMatrix(i,pointCount+1:pointCount+4) &amp;
-          = dirichletMatrix(i,pointCount+1:pointCount+4)
-      end if
-      dirichletMatrix(pointCount+1:pointCount+4,i) &amp;
-        = dirichletMatrix(i,pointCount+1:pointCount+4)
-      neumannMatrix(pointCount+1:pointCount+4,i) &amp;
-        = neumannMatrix(i,pointCount+1:pointCount+4)
-    end do
-
-    rhs(pointCount+1) = 1.0
-    rhs(pointCount+2:pointCount+4) = destinationPoint(1:3)
-
-    ! solve each linear system
-    rhsCopy = rhs
-    call LEGS(dirichletMatrix, matrixSize, rhs, coeffs, pivotIndices)
-    dirichletCoefficients = coeffs(1:pointCount)
-
-    call LEGS(neumannMatrix, matrixSize, rhsCopy, coeffs, pivotIndices)
-    neumannCoefficients = coeffs(1:pointCount)
-
-    deallocate(dirichletMatrix)  
-    deallocate(neumannMatrix)  
-    deallocate(rhs)  
-    deallocate(rhsCopy)  
-    deallocate(coeffs)  
-    deallocate(pivotIndices) 
-
-  end subroutine rbfInterp_func_3D_sca_lin_dirNeu_compCoeffs
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Compute interpolation coefficients in 3D that can be used to
-  !  interpolate a number of vector functions at a given locations. This is useful
-  !  if the interpolation location does not change with time, or if several
-  !  fields are to be interpolated at a given time step.  (If both the vector fields
-  !  and the interpolation locations vary with time, there is no clear advantage in
-  !  using either this method or the method for 2D interpoaltion above; for simplicity
-  !  and because we foresee more uses for the method of this subroutine, we have not
-  !  implemented a 3D version of the fixed field, variable interpolation location method
-  !  as we have in 2D.) Coefficients are produced for handling Dirichlet boundary
-  !  conditions (or no boundaries).  The interpolation is performed with basis functions
-  !  that are RBFs plus a constant.
-  ! Input:
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
-  !    the function are known
-  !  unitVectors - the unit vectors associated with each of the sourcePoints.  Interpolation
-  !    is performed by supplying the value of the vector function dotted into each of these unit
-  !    vectors.  If multiple unit vectors are supplied at the same sourcePoint, they *must* be
-  !    orthogonal for the interpolation to succeed.
-  !  destinationPoint - the point where the interpolation will be performed
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  ! Output:
-  !  coefficients - the coefficients used to interpolate a function with Dirichlet
-  !    boundary conditions to the specified destinationPoint
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_func_3D_vec_const_dir_compCoeffs(pointCount, &amp;
-    sourcePoints, unitVectors, destinationPoint, &amp;
-    alpha, coefficients)
-
-    integer, intent(in) :: pointCount
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors
-    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients
-
-    integer :: i, j
-    integer :: matrixSize
-
-    real(kind=RKIND), dimension(:,:), pointer :: matrix, matrixCopy
-    real(kind=RKIND), dimension(:,:), pointer :: rhs, coeffs
-    integer, dimension(:), pointer :: pivotIndices
-
-    matrixSize = pointCount+3 ! extra space for constant vector 
-
-    allocate(matrix(matrixSize,matrixSize))  
-    allocate(matrixCopy(matrixSize,matrixSize))  
-    allocate(rhs(matrixSize,3))  
-    allocate(coeffs(matrixSize,3))  
-    allocate(pivotIndices(matrixSize))  
-
-    matrix = 0.0
-    rhs = 0.0
-    coeffs = 0.0
-
-    call setUpVectorDirichletRBFMatrixAndRHS(pointCount, 3, &amp;
-      sourcePoints, unitVectors, destinationPoint, &amp;
-      alpha, matrix(1:pointCount,1:pointCount), rhs(1:pointCount,:))
-
-    do i = 1, pointCount
-      matrix(i,pointCount+1:pointCount+3) = unitVectors(i,:)
-      matrix(pointCount+1:pointCount+3,i) &amp;
-        = matrix(i,pointCount+1:pointCount+3)
-    end do
-    do i = 1, 3
-      rhs(pointCount+i,i) = 1.0 ! the unit vector in the ith direction
-    end do
-
-    ! solve each linear system
-    do i = 1, 3
-      matrixCopy = matrix
-      call LEGS(matrixCopy, matrixSize, rhs(:,i), coeffs(:,i), pivotIndices)
-    end do
-    coefficients = coeffs(1:pointCount,:)
-
-    deallocate(matrix)  
-    deallocate(matrixCopy)  
-    deallocate(rhs)  
-    deallocate(coeffs)  
-    deallocate(pivotIndices) 
-
-  end subroutine rbfInterp_func_3D_vec_const_dir_compCoeffs 
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Compute interpolation coefficients in 3D that can be used to
-  !  interpolate a number of vector functions at a given locations. This is useful
-  !  if the interpolation location does not change with time, or if several
-  !  fields are to be interpolated at a given time step.  (If both the vector fields
-  !  and the interpolation locations vary with time, there is no clear advantage in
-  !  using either this method or the method for 2D interpoaltion above; for simplicity
-  !  and because we foresee more uses for the method of this subroutine, we have not
-  !  implemented a 3D version of the fixed field, variable interpolation location method
-  !  as we have in 2D.) Coefficients are produced for handling Dirichlet boundary
-  !  conditions (or no boundaries).  The interpolation is performed with basis functions
-  !  that are RBFs plus a constant.
-  ! Input:
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
-  !    the function are known.  The sourcePoints are projected into the plane given by
-  !    planeBasisVectors
-  !  unitVectors - the unit vectors associated with each of the sourcePoints.  Interpolation
-  !    is performed by supplying the value of the vector function dotted into each of these unit
-  !    vectors.  If multiple unit vectors are supplied at the same sourcePoint, they *must* be
-  !    orthogonal for the interpolation to succeed.  The unitVectors are projected into the
-  !    plane given by planeBasisVectors
-  !  destinationPoint - the point where the interpolation will be performed.  The destinationPoint
-  !    is projected into the plane given by planeBasisVectors
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  !  planeBasisVectors - the basis fectors for the plane where interpolation is performed.
-  !    All points are projected into this plane. 
-  ! Output:
-  !  coefficients - the coefficients used to interpolate a function with Dirichlet
-  !    boundary conditions to the specified destinationPoint
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_func_3DPlane_vec_const_dir_compCoeffs(pointCount, &amp;
-    sourcePoints, unitVectors, destinationPoint, &amp;
-    alpha, planeBasisVectors, coefficients)
-
-    integer, intent(in) :: pointCount
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors
-    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(2,3) :: planeBasisVectors
-    real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients
-
-    integer :: i, j
-    integer :: matrixSize
-
-    real(kind=RKIND) :: rSquared, rbfValue, unitVectorDotProduct
-
-    real(kind=RKIND), dimension(pointCount,2) :: planarSourcePoints
-    real(kind=RKIND), dimension(pointCount,2) :: planarUnitVectors
-    real(kind=RKIND), dimension(2) :: planarDestinationPoint
-
-    real(kind=RKIND), dimension(:,:), pointer :: matrix, matrixCopy
-    real(kind=RKIND), dimension(:,:), pointer :: rhs, coeffs
-    integer, dimension(:), pointer :: pivotIndices
-
-    matrixSize = pointCount+2 ! space for constant vector in plane
-
-    allocate(matrix(matrixSize,matrixSize))  
-    allocate(matrixCopy(matrixSize,matrixSize))  
-    allocate(rhs(matrixSize,2))  
-    allocate(coeffs(matrixSize,2))  
-    allocate(pivotIndices(matrixSize)) 
-
-    matrix = 0.0
-    rhs = 0.0
-    coeffs = 0.0
-
-    do i = 1, pointCount
-      planarSourcePoints(i,1) = sum(sourcePoints(i,:)*planeBasisVectors(1,:)) 
-      planarSourcePoints(i,2) = sum(sourcePoints(i,:)*planeBasisVectors(2,:)) 
-      planarUnitVectors(i,1) = sum(unitVectors(i,:)*planeBasisVectors(1,:)) 
-      planarUnitVectors(i,2) = sum(unitVectors(i,:)*planeBasisVectors(2,:)) 
-    end do
-    planarDestinationPoint(1) = sum(destinationPoint*planeBasisVectors(1,:)) 
-    planarDestinationPoint(2) = sum(destinationPoint*planeBasisVectors(2,:)) 
-
-    call setUpVectorDirichletRBFMatrixAndRHS(pointCount, 2, &amp;
-      planarSourcePoints, planarUnitVectors, planarDestinationPoint, &amp;
-      alpha, matrix(1:pointCount,1:pointCount), rhs(1:pointCount,:))
-
-    do i = 1, pointCount
-      matrix(i,pointCount+1:pointCount+2) = planarUnitVectors(i,:) 
-      matrix(pointCount+1:pointCount+2,i) = matrix(i,pointCount+1:pointCount+2)
-    end do
-    do i = 1,2 
-      rhs(pointCount+i,i) = 1.0 ! the unit vector in the ith direction
-    end do
-
-    ! solve each linear system
-    matrixCopy = matrix
-    call LEGS(matrix, matrixSize, rhs(:,1), coeffs(:,1), pivotIndices)
-    call LEGS(matrixCopy, matrixSize, rhs(:,2), coeffs(:,2), pivotIndices)
-
-
-    do i = 1,3 
-      coefficients(:,i) = planeBasisVectors(1,i)*coeffs(1:pointCount,1) &amp;
-        + planeBasisVectors(2,i)*coeffs(1:pointCount,2) 
-    end do
-
-    deallocate(matrix)  
-    deallocate(matrixCopy)  
-    deallocate(rhs)  
-    deallocate(coeffs)  
-    deallocate(pivotIndices)
-
-  end subroutine rbfInterp_func_3DPlane_vec_const_dir_compCoeffs 
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Compute interpolation coefficients in 3D that can be used to
-  !  interpolate a number of vector functions at a given locations. This is useful
-  !  if the interpolation location does not change with time, or if several
-  !  fields are to be interpolated at a given time step.  (If both the vector fields
-  !  and the interpolation locations vary with time, there is no clear advantage in
-  !  using either this method or the method for 2D interpoaltion above; for simplicity
-  !  and because we foresee more uses for the method of this subroutine, we have not
-  !  implemented a 3D version of the fixed field, variable interpolation location method
-  !  as we have in 2D.) Coefficients are produced for handling Dirichlet normal /
-  !  Neumann tangential boundary conditions (such as free slip).  The interpolation is 
-  !  performed with basis functions that are RBFs plus a constant.
-  ! Input:
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
-  !    the function are known
-  !  isTangentToInterface - a logical array indicating which sourcePoints/unitVectors are
-  !    tangent to the interface where the boundary condition will be applied.  A Neumann
-  !    boundary condition will be applied at these points in these directions.
-  !  normalVectorIndex - where isTangentToInterface == .true., the index into unitVectors that
-  !    gives the normal vector at the same sourcePoint.  This information is needed to compute
-  !    the Neumann boundary condition at this point.
-  !  unitVectors - the unit vectors associated with each of the sourcePoints.  Interpolation
-  !    is performed by supplying the value of the vector function dotted into each of these unit
-  !    vectors.  If multiple unit vectors are supplied at the same sourcePoint, they *must* be
-  !    orthogonal for the interpolation to succeed.  A normal vector and two tangential vectors
-  !    are needed at each interface point in order to satisfy the Dirichlet normal boundary
-  !    condition and the Neumann tangential boundary conditions at these points.
-  !  destinationPoint - the point where the interpolation will be performed
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  ! Output:
-  !  coefficients - the coefficients used to interpolate a function with Dirichlet
-  !    boundary conditions to the specified destinationPoint
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_func_3D_vec_const_tanNeu_compCoeffs(pointCount, &amp;
-    sourcePoints, isTangentToInterface, normalVectorIndex, unitVectors, destinationPoint, &amp;
-    alpha, coefficients)
-
-    integer, intent(in) :: pointCount
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
-    logical, dimension(pointCount), intent(in) :: isTangentToInterface
-    integer, dimension(pointCount), intent(in) :: normalVectorIndex
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors
-    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients
-
-    integer :: i, j
-    integer :: matrixSize
-
-    real(kind=RKIND), dimension(:,:), pointer :: matrix, matrixCopy
-    real(kind=RKIND), dimension(:,:), pointer :: rhs, coeffs
-    integer, dimension(:), pointer :: pivotIndices
-
-    matrixSize = pointCount+3 ! extra space for constant vector 
-
-    allocate(matrix(matrixSize,matrixSize))  
-    allocate(matrixCopy(matrixSize,matrixSize))  
-    allocate(rhs(matrixSize,3))  
-    allocate(coeffs(matrixSize,3))  
-    allocate(pivotIndices(matrixSize))  
-
-    matrix = 0.0
-    rhs = 0.0
-    coeffs = 0.0
-
-    call setUpVectorFreeSlipRBFMatrixAndRHS(pointCount, 3, &amp;
-      sourcePoints, isTangentToInterface, normalVectorIndex, unitVectors, destinationPoint, &amp;
-      alpha, matrix(1:pointCount,1:pointCount), rhs(1:pointCount,:))
-
-    do i = 1, pointCount
-      matrix(pointCount+1:pointCount+3,i) = unitVectors(i,:)
-      if(.not. isTangentToInterface(i)) then
-        matrix(i,pointCount+1:pointCount+3) = matrix(pointCount+1:pointCount+3,i)
-      end if
-    end do
-    do i = 1, 3
-      rhs(pointCount+i,i) = 1.0 ! the unit vector in the ith direction
-    end do
-
-    ! solve each linear system
-    do i = 1, 3
-      matrixCopy = matrix
-      call LEGS(matrixCopy, matrixSize, rhs(:,i), coeffs(:,i), pivotIndices)
-    end do
-    coefficients = coeffs(1:pointCount,:)
-
-    deallocate(matrix)  
-    deallocate(matrixCopy)  
-    deallocate(rhs)  
-    deallocate(coeffs)  
-    deallocate(pivotIndices)
-
-  end subroutine rbfInterp_func_3D_vec_const_tanNeu_compCoeffs 
-
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: Compute interpolation coefficients in 3D that can be used to
-  !  interpolate a number of vector functions at a given locations. This is useful
-  !  if the interpolation location does not change with time, or if several
-  !  fields are to be interpolated at a given time step.  (If both the vector fields
-  !  and the interpolation locations vary with time, there is no clear advantage in
-  !  using either this method or the method for 2D interpoaltion above; for simplicity
-  !  and because we foresee more uses for the method of this subroutine, we have not
-  !  implemented a 3D version of the fixed field, variable interpolation location method
-  !  as we have in 2D.) Coefficients are produced for handling Dirichlet normal /
-  !  Neumann tangential boundary conditions (such as free slip).  The interpolation is 
-  !  performed with basis functions that are RBFs plus a constant.
-  ! Input:
-  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
-  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
-  !    the function are known.  The sourcePoints are projected into the plane given by
-  !    planeBasisVectors
-  !  isTangentToInterface - a logical array indicating which sourcePoints/unitVectors are
-  !    tangent to the interface where the boundary condition will be applied.  A Neumann
-  !    boundary condition will be applied at these points in these directions.
-  !  normalVectorIndex - where isTangentToInterface == .true., the index into unitVectors that
-  !    gives the normal vector at the same sourcePoint.  This information is needed to compute
-  !    the Neumann boundary condition at this point.
-  !  unitVectors - the unit vectors associated with each of the sourcePoints.  Interpolation
-  !    is performed by supplying the value of the vector function dotted into each of these unit
-  !    vectors.  If multiple unit vectors are supplied at the same sourcePoint, they *must* be
-  !    orthogonal for the interpolation to succeed.  A normal vector and two tangential vectors
-  !    are needed at each interface point in order to satisfy the Dirichlet normal boundary
-  !    condition and the Neumann tangential boundary conditions at these points. The unitVectors
-  !    are projected into the plane given by planeBasisVectors
-  !  destinationPoint - the point where the interpolation will be performed.  The destinationPoint
-  !    is projected into the plane given by planeBasisVectors
-  !  alpha - a constant that give the characteristic length scale of the RBFs,
-  !    should be on the order of the distance between points
-  !  planeBasisVectors - the basis fectors for the plane where interpolation is performed.
-  !    All points are projected into this plane. 
-  ! Output:
-  !  coefficients - the coefficients used to interpolate a function with Dirichlet
-  !    boundary conditions to the specified destinationPoint
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  subroutine rbfInterp_func_3DPlane_vec_const_tanNeu_compCoeffs(&amp;
-    pointCount, sourcePoints, isTangentToInterface, normalVectorIndex, unitVectors, &amp;
-    destinationPoint, alpha, planeBasisVectors, coefficients)
-
-    integer, intent(in) :: pointCount
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
-    logical, dimension(pointCount), intent(in) :: isTangentToInterface
-    integer, dimension(pointCount), intent(in) :: normalVectorIndex
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors
-    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(2,3), intent(in) :: planeBasisVectors
-    real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients
-
-    integer :: i, j
-    integer :: matrixSize
-
-    real(kind=RKIND), dimension(pointCount,2) :: planarSourcePoints
-    real(kind=RKIND), dimension(pointCount,2) :: planarUnitVectors
-    real(kind=RKIND), dimension(2) :: planarDestinationPoint
-
-    real(kind=RKIND), dimension(:,:), pointer :: matrix, matrixCopy
-    real(kind=RKIND), dimension(:,:), pointer :: rhs, coeffs
-    integer, dimension(:), pointer :: pivotIndices
-
-    matrixSize = pointCount+2 ! space for constant vector in plane
-
-    allocate(matrix(matrixSize,matrixSize))  
-    allocate(matrixCopy(matrixSize,matrixSize))  
-    allocate(rhs(matrixSize,2))  
-    allocate(coeffs(matrixSize,2))  
-    allocate(pivotIndices(matrixSize)) 
-
-    matrix = 0.0
-    rhs = 0.0
-    coeffs = 0.0
-
-    do i = 1, pointCount
-      planarSourcePoints(i,1) = sum(sourcePoints(i,:)*planeBasisVectors(1,:)) 
-      planarSourcePoints(i,2) = sum(sourcePoints(i,:)*planeBasisVectors(2,:)) 
-      planarUnitVectors(i,1) = sum(unitVectors(i,:)*planeBasisVectors(1,:)) 
-      planarUnitVectors(i,2) = sum(unitVectors(i,:)*planeBasisVectors(2,:)) 
-    end do
-    planarDestinationPoint(1) = sum(destinationPoint*planeBasisVectors(1,:)) 
-    planarDestinationPoint(2) = sum(destinationPoint*planeBasisVectors(2,:)) 
-    call setUpVectorFreeSlipRBFMatrixAndRHS(pointCount, 2, &amp;
-      planarSourcePoints, isTangentToInterface, normalVectorIndex, planarUnitVectors, &amp;
-      planarDestinationPoint, alpha, matrix(1:pointCount,1:pointCount), rhs(1:pointCount,:))
-
-    do i = 1, pointCount
-      matrix(pointCount+1,i) = sum(unitVectors(i,:)*planeBasisVectors(1,:))
-      matrix(pointCount+2,i) = sum(unitVectors(i,:)*planeBasisVectors(2,:))
-      if(.not. isTangentToInterface(i)) then
-        matrix(i,pointCount+1:pointCount+2) = matrix(pointCount+1:pointCount+2,i)
-      end if
-    end do
-    do i = 1,2 
-      rhs(pointCount+i,i) = 1.0 ! the unit vector in the ith direction
-    end do
-
-    ! solve each linear system
-    matrixCopy = matrix
-    call LEGS(matrix, matrixSize, rhs(:,1), coeffs(:,1), pivotIndices)
-    call LEGS(matrixCopy, matrixSize, rhs(:,2), coeffs(:,2), pivotIndices)
-
-    coefficients(:,1) = planeBasisVectors(1,1)*coeffs(1:pointCount,1) &amp;
-      + planeBasisVectors(2,1)*coeffs(1:pointCount,2) 
-    coefficients(:,2) = planeBasisVectors(1,2)*coeffs(1:pointCount,1) &amp;
-      + planeBasisVectors(2,2)*coeffs(1:pointCount,2) 
-    coefficients(:,3) = planeBasisVectors(1,3)*coeffs(1:pointCount,1) &amp;
-      + planeBasisVectors(2,3)*coeffs(1:pointCount,2) 
-
-    deallocate(matrix)  
-    deallocate(matrixCopy)  
-    deallocate(rhs)  
-    deallocate(coeffs)  
-    deallocate(pivotIndices)
-
-   end subroutine rbfInterp_func_3DPlane_vec_const_tanNeu_compCoeffs 
-
-
-!!!!!!!!!!!!!!!!!!!!!
-! private subroutines
-!!!!!!!!!!!!!!!!!!!!!
-
-  function evaluateRBF(rSquared) result(rbfValue)
-    real(kind=RKIND), intent(in) :: rSquared
-    real(kind=RKIND) :: rbfValue
-
-    ! inverse multiquadratic
-    rbfValue = 1/sqrt(1 + rSquared)
-
-  end function evaluateRBF
-
-  subroutine evaluateRBFAndDeriv(rSquared, rbfValue, rbfDerivOverR)
-    real(kind=RKIND), intent(in) :: rSquared
-    real(kind=RKIND), intent(out) :: rbfValue, rbfDerivOverR
-
-    ! inverse multiquadratic
-    rbfValue = 1/sqrt(1 + rSquared)
-    rbfDerivOverR = -rbfValue**3
-
-  end subroutine evaluateRBFAndDeriv
-
-  subroutine evaluateRBFAndDerivs(rSquared, rbfValue, rbfDerivOverR, rbfSecondDeriv)
-    real(kind=RKIND), intent(in) :: rSquared
-    real(kind=RKIND), intent(out) :: rbfValue, rbfDerivOverR, rbfSecondDeriv
-
-    ! inverse multiquadratic
-    rbfValue = 1/sqrt(1 + rSquared)
-    rbfDerivOverR = -rbfValue**3
-    rbfSecondDeriv = (2*rSquared-1)*rbfValue**5
-
-  end subroutine evaluateRBFAndDerivs
-
-  subroutine setUpScalarRBFDirichletMatrixAndRHS(pointCount, sourcePoints, destinationPoint, &amp;
-    alpha, dirichletMatrix, rhs)
-
-    integer, intent(in) :: pointCount
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
-    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: dirichletMatrix
-    real(kind=RKIND), dimension(pointCount), intent(out) :: rhs
-
-    integer :: i, j
-
-    real(kind=RKIND) :: rSquared, rbfValue
-
-    do j = 1, pointCount
-      do i = 1, pointCount
-        rSquared = sum((sourcePoints(i,:)-sourcePoints(j,:))**2)/alpha**2
-        rbfValue = evaluateRBF(rSquared)
-        dirichletMatrix(i,j) = rbfValue
-      end do
-    end do
-
-    do j = 1, pointCount
-      rSquared = sum((destinationPoint-sourcePoints(j,:))**2)/alpha**2
-      rhs(j) = evaluateRBF(rSquared)
-    end do
-
-  end subroutine setUpScalarRBFDirichletMatrixAndRHS
-
-  subroutine setUpScalarRBFMatrixAndRHS(pointCount, &amp;
-    sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
-    alpha, dirichletMatrix, neumannMatrix, rhs)
-
-    integer, intent(in) :: pointCount
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
-    logical, dimension(pointCount), intent(in) :: isInterface
-    real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals
-    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: &amp;
-      dirichletMatrix, neumannMatrix
-    real(kind=RKIND), dimension(pointCount), intent(out) :: rhs
-
-    integer :: i, j
-
-    real(kind=RKIND) :: rSquared, rbfValue, rbfDerivOverR, normalDotX
-
-    do j = 1, pointCount
-      if(isInterface(j)) then
-        do i = 1, pointCount 
-          rSquared = sum((sourcePoints(i,:)-sourcePoints(j,:))**2)/alpha**2
-          normalDotX = sum(interfaceNormals(j,:) &amp;
-            * (sourcePoints(j,:)-sourcePoints(i,:)))
-          call evaluateRBFAndDeriv(rSquared, rbfValue, rbfDerivOverR)
-          rbfDerivOverR = rbfDerivOverR/alpha**2
-          dirichletMatrix(i,j) = rbfValue
-          neumannMatrix(i,j) = rbfDerivOverR*normalDotX
-        end do
-      else
-        do i = 1, pointCount
-          rSquared = sum((sourcePoints(i,:)-sourcePoints(j,:))**2)/alpha**2
-          rbfValue = evaluateRBF(rSquared)
-          dirichletMatrix(i,j) = rbfValue
-          neumannMatrix(i,j) = rbfValue
-        end do
-      end if
-    end do
-
-    do j = 1, pointCount
-      rSquared = sum((destinationPoint-sourcePoints(j,:))**2)/alpha**2
-      rhs(j) = evaluateRBF(rSquared)
-    end do
-
-  end subroutine setUpScalarRBFMatrixAndRHS
-
-  subroutine setUpVectorDirichletRBFMatrixAndRHS(pointCount, dimensions, &amp;
-    sourcePoints, unitVectors, destinationPoint, &amp;
-    alpha, matrix, rhs)
-
-    integer, intent(in) :: pointCount, dimensions
-    real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: sourcePoints
-    real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: unitVectors
-    real(kind=RKIND), dimension(dimensions), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: matrix
-    real(kind=RKIND), dimension(pointCount,dimensions), intent(out) :: rhs
-
-    integer :: i, j
-
-    real(kind=RKIND) :: rSquared, rbfValue, unitVectorDotProduct
-
-    do j = 1, pointCount
-      do i = j, pointCount
-        rSquared = sum((sourcePoints(i,:)-sourcePoints(j,:))**2)/alpha**2
-        rbfValue = evaluateRBF(rSquared)
-        unitVectorDotProduct = sum(unitVectors(i,:)*unitVectors(j,:))
-        matrix(i,j) = rbfValue*unitVectorDotProduct
-        matrix(j,i) = matrix(i,j)
-      end do
-    end do
-
-    do j = 1, pointCount
-      rSquared = sum((destinationPoint-sourcePoints(j,:))**2)/alpha**2
-      rhs(j,:) = evaluateRBF(rSquared)*unitVectors(j,:)
-    end do
-
-  end subroutine setUpVectorDirichletRBFMatrixAndRHS
-
-  subroutine setUpVectorFreeSlipRBFMatrixAndRHS(pointCount, dimensions, &amp;
-    sourcePoints, isTangentToInterface, normalVectorIndex, unitVectors, destinationPoint, &amp;
-    alpha, matrix, rhs)
-
-    integer, intent(in) :: pointCount, dimensions
-    real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: sourcePoints
-    logical, dimension(pointCount), intent(in) :: isTangentToInterface
-    integer, dimension(pointCount), intent(in) :: normalVectorIndex
-    real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: unitVectors
-    real(kind=RKIND), dimension(dimensions), intent(in) :: destinationPoint
-    real(kind=RKIND), intent(in) :: alpha
-    real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: matrix
-    real(kind=RKIND), dimension(pointCount,dimensions), intent(out) :: rhs
-
-    integer :: i, j
-
-    real(kind=RKIND) :: rSquared, rbfValue, rbfDerivOverR, normalVector(dimensions), &amp;
-      normalDotX, unitVectorDotProduct
-
-    do j = 1, pointCount
-      if(isTangentToInterface(j)) then
-         do i = 1, pointCount
-          rSquared = sum((sourcePoints(i,:)-sourcePoints(j,:))**2)/alpha**2
-          normalVector = unitVectors(normalVectorIndex(j),:) 
-          normalDotX = sum(normalVector * (sourcePoints(j,:)-sourcePoints(i,:)))
-          call evaluateRBFAndDeriv(rSquared, rbfValue, rbfDerivOverR)
-          rbfDerivOverR = rbfDerivOverR/alpha**2
-          unitVectorDotProduct = sum(unitVectors(i,:)*unitVectors(j,:))
-          matrix(i,j) = rbfDerivOverR*normalDotX*unitVectorDotProduct
-        end do
-      else
-        do i = 1, pointCount
-          rSquared = sum((sourcePoints(i,:)-sourcePoints(j,:))**2)/alpha**2
-          rbfValue = evaluateRBF(rSquared)
-          unitVectorDotProduct = sum(unitVectors(i,:)*unitVectors(j,:))
-          matrix(i,j) = rbfValue*unitVectorDotProduct
-        end do
-      end if
-    end do
-
-    do j = 1, pointCount
-      rSquared = sum((destinationPoint-sourcePoints(j,:))**2)/alpha**2
-      rhs(j,:) = evaluateRBF(rSquared)*unitVectors(j,:)
-    end do
-
-  end subroutine setUpVectorFreeSlipRBFMatrixAndRHS
-
-  subroutine unit_vec_in_R3(xin)
-    implicit none
-    real (kind=RKIND), intent(inout) :: xin(3)
-    real (kind=RKIND) :: mag
-    mag = sqrt(xin(1)**2+xin(2)**2+xin(3)**2)
-    xin(:) = xin(:) / mag
-  end subroutine unit_vec_in_R3
-
-  subroutine cross_product_in_R3(p_1,p_2,p_out)
-    real (kind=RKIND), intent(in) :: p_1 (3), p_2 (3)
-    real (kind=RKIND), intent(out) :: p_out (3)
-
-    p_out(1) = p_1(2)*p_2(3)-p_1(3)*p_2(2)
-    p_out(2) = p_1(3)*p_2(1)-p_1(1)*p_2(3)
-    p_out(3) = p_1(1)*p_2(2)-p_1(2)*p_2(1)
-  end subroutine cross_product_in_R3
-
-! Updated 10/24/2001.
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!   Program 4.3   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!                                                                       !
-! Please Note:                                                          !
-!                                                                       !
-! (1) This computer program is written by Tao Pang in conjunction with  !
-!     his book, &quot;An Introduction to Computational Physics,&quot; published   !
-!     by Cambridge University Press in 1997.                            !
-!                                                                       !
-! (2) No warranties, express or implied, are made for this program.     !
-!                                                                       !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-!PROGRAM EX43
-!
-!
-! An example of solving linear equation set A(N,N)*X(N) = B(N)
-! with the partial-pivoting Gaussian elimination scheme.  The
-! numerical values are for the Wheatstone bridge example discussed
-! in Section 4.1 in the book with all resistances being 100 ohms
-! and the voltage 200 volts.
-!
-!  IMPLICIT NONE
-!  INTEGER, PARAMETER :: N=3
-!  INTEGER :: I,J
-!  INTEGER, DIMENSION (N) :: INDX
-!  REAL, DIMENSION (N) :: X,B
-!  REAL, DIMENSION (N,N) :: A
-!  DATA B /200.0,0.0,0.0/, &amp;
-!       ((A(I,J), J=1,N),I=1,N) /100.0,100.0,100.0,-100.0, &amp;
-!                         300.0,-100.0,-100.0,-100.0, 300.0/
-!
-!  CALL LEGS (A,N,B,X,INDX)
-!
-!  WRITE (6, &quot;(F16.8)&quot;) (X(I), I=1,N)
-!END PROGRAM EX43
-
-
-SUBROUTINE LEGS (A,N,B,X,INDX)
-!
-! Subroutine to solve the equation A(N,N)*X(N) = B(N) with the
-! partial-pivoting Gaussian elimination scheme.
-! Copyright (c) Tao Pang 2001.
-!
-  IMPLICIT NONE
-  integer, INTENT (IN) :: N
-  integer :: I,J
-  integer, INTENT (OUT), DIMENSION (N) :: INDX
-  real(kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
-  real(kind=RKIND), INTENT (INOUT), DIMENSION (N) :: B
-  real(kind=RKIND), INTENT (OUT), DIMENSION (N) :: X
-!
-  CALL ELGS (A,N,INDX)
-!
-  DO I = 1, N-1
-    DO J = I+1, N
-      B(INDX(J)) = B(INDX(J))-A(INDX(J),I)*B(INDX(I))
-    END DO
-  END DO
-!
-  X(N) = B(INDX(N))/A(INDX(N),N)
-  DO I = N-1, 1, -1
-    X(I) = B(INDX(I))
-    DO J = I+1, N
-      X(I) = X(I)-A(INDX(I),J)*X(J)
-    END DO
-    X(I) =  X(I)/A(INDX(I),I)
-  END DO
-!
-END SUBROUTINE LEGS
-!
-
-
-
-! Updated 10/24/2001.
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!   Program 4.4   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!                                                                       !
-! Please Note:                                                          !
-!                                                                       !
-! (1) This computer program is written by Tao Pang in conjunction with  !
-!     his book, &quot;An Introduction to Computational Physics,&quot; published   !
-!     by Cambridge University Press in 1997.                            !
-!                                                                       !
-! (2) No warranties, express or implied, are made for this program.     !
-!                                                                       !
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!
-SUBROUTINE MIGS (A,N,X,INDX)
-!
-! Subroutine to invert matrix A(N,N) with the inverse stored
-! in X(N,N) in the output.  Copyright (c) Tao Pang 2001.
-!
-  IMPLICIT NONE
-  integer, INTENT (IN) :: N
-  integer :: I,J,K
-  integer, INTENT (OUT), DIMENSION (N) :: INDX
-  real(kind=RKIND), INTENT (INOUT), DIMENSION (N,N):: A
-  real(kind=RKIND), INTENT (OUT), DIMENSION (N,N):: X
-  real(kind=RKIND), DIMENSION (N,N) :: B
-!
-  DO I = 1, N
-    DO J = 1, N
-      B(I,J) = 0.0
-    END DO
-  END DO
-  DO I = 1, N
-    B(I,I) = 1.0
-  END DO
-!
-  CALL ELGS (A,N,INDX)
-!
-  DO I = 1, N-1
-    DO J = I+1, N
-      DO K = 1, N
-        B(INDX(J),K) = B(INDX(J),K)-A(INDX(J),I)*B(INDX(I),K)
-      END DO
-    END DO
-  END DO
-!
-  DO I = 1, N
-    X(N,I) = B(INDX(N),I)/A(INDX(N),N)
-    DO J = N-1, 1, -1
-      X(J,I) = B(INDX(J),I)
-      DO K = J+1, N
-        X(J,I) = X(J,I)-A(INDX(J),K)*X(K,I)
-      END DO
-      X(J,I) =  X(J,I)/A(INDX(J),J)
-    END DO
-  END DO
-END SUBROUTINE MIGS
-
-
-SUBROUTINE ELGS (A,N,INDX)
-!
-! Subroutine to perform the partial-pivoting Gaussian elimination.
-! A(N,N) is the original matrix in the input and transformed matrix
-! plus the pivoting element ratios below the diagonal in the output.
-! INDX(N) records the pivoting order.  Copyright (c) Tao Pang 2001.
-!
-  IMPLICIT NONE
-  integer, INTENT (IN) :: N
-  integer :: I,J,K,ITMP
-  integer, INTENT (OUT), DIMENSION (N) :: INDX
-  real(kind=RKIND) :: C1,PI,PI1,PJ
-  real(kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
-  real(kind=RKIND), DIMENSION (N) :: C
-!
-! Initialize the index
-!
-  DO I = 1, N
-    INDX(I) = I
-  END DO
-!
-! Find the rescaling factors, one from each row
-!
-  DO I = 1, N
-    C1= 0.0
-    DO J = 1, N
-      !C1 = AMAX1(C1,ABS(A(I,J)))
-      C1 = MAX(C1,ABS(A(I,J)))
-    END DO
-    C(I) = C1
-  END DO
-!
-! Search the pivoting (largest) element from each column
-!
-  DO J = 1, N-1
-    PI1 = 0.0
-    DO I = J, N
-      PI = ABS(A(INDX(I),J))/C(INDX(I))
-      IF (PI.GT.PI1) THEN
-        PI1 = PI
-        K   = I
-      ENDIF
-    END DO
-!
-! Interchange the rows via INDX(N) to record pivoting order
-!
-    ITMP    = INDX(J)
-    INDX(J) = INDX(K)
-    INDX(K) = ITMP
-    DO I = J+1, N
-      PJ  = A(INDX(I),J)/A(INDX(J),J)
-!
-! Record pivoting ratios below the diagonal
-!
-      A(INDX(I),J) = PJ
-!
-! Modify other elements accordingly
-!
-      DO K = J+1, N
-        A(INDX(I),K) = A(INDX(I),K)-PJ*A(INDX(J),K)
-      END DO
-    END DO
-  END DO
-!
-END SUBROUTINE ELGS
-
-end module RBF_interpolation
-

Deleted: branches/source_condensing/src/operators/module_spline_interpolation.F
===================================================================
--- trunk/mpas/src/operators/module_spline_interpolation.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/operators/module_spline_interpolation.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,427 +0,0 @@
-module spline_interpolation
-
-  implicit none
-
-  private
-
-  public ::   CubicSplineCoefficients, InterpolateCubicSpline, &amp;
-    IntegrateCubicSpline, IntegrateColumnCubicSpline, InterpolateLinear, &amp;
-    TestInterpolate
-
-! Short Descriptions:
-
-!   CubicSplineCoefficients: Compute second derivatives at nodes.  
-!      This must be run before any of the other cubic spine functions.
-
-!   InterpolateCubicSpline: Compute cubic spline interpolation. 
-
-!   IntegrateCubicSpline:  Compute a single integral from spline data.
-
-!   IntegrateColumnCubicSpline:  Compute multiple integrals from spline data.
-
-!   InterpolateLinear:  Compute linear interpolation.
-
-!   TestInterpolate:  Test spline interpolation subroutines.
-
-  contains
-
- subroutine CubicSplineCoefficients(x,y,n,y2ndDer)  
-
-!  Given arrays x(1:n) and y(1:n) containing a function,
-!  i.e., y(i) = f(x(i)), with x monotonically increasing
-!  this routine returns an array y2ndDer(1:n) that contains 
-!  the second derivatives of the interpolating function at x(1:n). 
-!  This routine uses boundary conditions for a natural spline, 
-!  with zero second derivative on that boundary.
-
-! INPUT PARAMETERS:
-
-  integer, intent(in) :: &amp;
-    n     ! number of nodes
-  real(kind=RKIND), intent(in), dimension(n) :: &amp;
-    x,   &amp;! location of nodes
-    y     ! value at nodes
-
-! OUTPUT PARAMETERS:
-
-  real(kind=RKIND), intent(out), dimension(n) :: &amp;
-    y2ndDer    ! dy^2/dx^2 at each node
-
-!  local variables:
-
-  integer :: i
-  real(kind=RKIND) :: &amp;
-    temp,xRatio,a(n)  
-
-   y2ndDer(1)=0.0
-   y2ndDer(n)=0.0
-   a(1)=0.0
-
-   do i=2,n-1  
-      xRatio=(x(i)-x(i-1))/(x(i+1)-x(i-1))  
-      temp=1.0/(2.0+xRatio*y2ndDer(i-1))
-      y2ndDer(i)=temp*(xRatio-1.0)
-      a(i) = temp*(6.0*((y(i+1)-y(i))/(x(i+1)-x(i)) &amp;
-          -(y(i)-y(i-1))/(x(i)-x(i-1)))/(x(i+1)-x(i-1)) &amp;
-          -xRatio*a(i-1)) 
-   enddo
-
-   do i=n-1,1,-1  
-      y2ndDer(i)=y2ndDer(i)*y2ndDer(i+1)+a(i)  
-   enddo
-
-  end subroutine CubicSplineCoefficients
-
-
-  subroutine InterpolateCubicSpline( &amp;
-                x,y,y2ndDer,n, &amp;
-                xOut,yOut,nOut)  
-
-!  Given the arrays x(1:n) and y(1:n), which tabulate a function,
-!  and given the array y2ndDer(1:n), which is the output from 
-!  CubicSplineCoefficients above, this routine returns the 
-!  cubic-spline interpolated values of yOut(1:nOut) at xOut(1:nOut).
-!  This subroutine assumes that both x and xOut are monotonically
-!  increasing, and that all values of xOut are within the first and
-!  last values of x.
-
-! INPUT PARAMETERS:
-
-  real (kind=RKIND), dimension(n), intent(in) :: &amp;
-    x,         &amp;! node location, input grid
-    y,       &amp;! interpolation variable, input grid
-    y2ndDer     ! 2nd derivative of y at nodes
-
-  real (kind=RKIND), dimension(nOut), intent(in) :: &amp;
-    xOut          ! node location, output grid
-
-  integer, intent(in) :: &amp;
-    n,      &amp;! number of nodes, input grid
-    nOut       ! number of nodes, output grid
-
-! OUTPUT PARAMETERS:
-
-  real (kind=RKIND), dimension(nOut), intent(out) :: &amp;
-    yOut        ! interpolation variable, output grid
-
-!  local variables:
-
-  integer :: &amp;
-    kIn, kOut ! counters
-
-  real (kind=RKIND) :: &amp;
-    a, b, h
-
-  kOut = 1
-
-  kInLoop: do kIn = 1,n-1
-
-    h = x(kIn+1)-x(kIn)
-
-    do while(xOut(kOut) &lt; x(kIn+1)) 
-
-      a = (x(kIn+1)-xOut(kOut))/h  
-      b = (xOut(kOut)-x (kIn) )/h  
-      yOut(kOut) = a*y(kIn) + b*y(kIn+1) &amp;
-        + ((a**3-a)*y2ndDer(kIn) + (b**3-b)*y2ndDer(kIn+1)) &amp;
-         *(h**2)/6.0
-
-      kOut = kOut + 1
-
-      if (kOut&gt;nOut) exit kInLoop
-
-    enddo
-  
-  enddo kInLoop
-
-end subroutine InterpolateCubicSpline
-
-
-subroutine IntegrateCubicSpline(x,y,y2ndDer,n,x1,x2,y_integral)  
-
-!  Given the arrays x(1:n) and y(1:n), which tabulate a function,
-!  and given the array y2ndDer(1:n), which is the output from 
-!  CubicSplineCoefficients above, this routine returns y_integral,
-!  the integral of y from x1 to x2.  The integration formula was 
-!  created by analytically integrating a cubic spline between each node.
-!  This subroutine assumes that x is monotonically increasing, and
-!  that x1 &lt; x2.
-
-! INPUT PARAMETERS:
-
-  integer, intent(in) :: &amp;
-    n     ! number of nodes
-  real(kind=RKIND), intent(in), dimension(n) :: &amp;
-    x,   &amp;! location of nodes
-    y,   &amp;! value at nodes
-    y2ndDer    ! dy^2/dx^2 at each node
-  real(kind=RKIND), intent(in) :: &amp;
-    x1,x2 ! limits of integration
-
-! OUTPUT PARAMETERS:
-
-  real(kind=RKIND), intent(out) :: &amp;
-    y_integral  ! integral of y
-
-!  local variables:
-  
-  integer :: i,j,k
-  real(kind=RKIND) :: h,h2, A2,B2, F1,F2, eps1
-
-  if (x1&lt;x(1).or.x2&gt;x(n).or.x1&gt;x2) then
-    print *, 'error on integration bounds'
-  endif
-
-  y_integral = 0.0
-  eps1 = 1e-14*x2
-
-  do j=1,n-1  ! loop through sections
-    ! section x(j) ... x(j+1)
-
-    if (x2&lt;=x(j)  +eps1) exit
-    if (x1&gt;=x(j+1)-eps1) cycle
-
-      h = x(j+1) - x(j)
-      h2 = h**2
-
-      ! left side:
-      if (x1&lt;x(j)) then
-        F1 = -y(j)*h*0.5 + y2ndDer(j)*h**3/24.0
-      else
-        A2 = (x(j+1)-x1  )**2/h2
-        B2 = (x1    -x(j))**2/h2
-        F1 = 0.5*h*( -y(j)*A2 + y(j+1)*B2 &amp;
-             + y2ndDer(j)  *h2*(-0.5*A2**2 + A2)/6.0 &amp;
-             + y2ndDer(j+1)*h2*( 0.5*B2**2 - B2)/6.0 )
-      endif
-
-      ! right side:
-      if (x2&gt;x(j+1)) then
-        F2 = y(j+1)*h*0.5 - y2ndDer(j+1)*h**3/24.0
-      else
-        A2 = (x(j+1)-x2  )**2/h2
-        B2 = (x2    -x(j))**2/h2
-        F2 = 0.5*h*( -y(j)*A2 + y(j+1)*B2 &amp;
-             + y2ndDer(j)  *h2*(-0.5*A2**2 + A2)/6.0 &amp;
-             + y2ndDer(j+1)*h2*( 0.5*B2**2 - B2)/6.0 )
-      endif
-
-      y_integral = y_integral + F2 - F1
-
-  enddo ! j
-
-  end subroutine IntegrateCubicSpline
-
-
-  subroutine IntegrateColumnCubicSpline( &amp;
-               x,y,y2ndDer,n, &amp;
-               xOut,y_integral, nOut)  
-
-!  Given the arrays x(1:n) and y(1:n), which tabulate a function,
-!  and given the array y2ndDer(1:n), which is the output from 
-!  CubicSplineCoefficients above, this routine returns 
-!  y_integral(1:nOut), the integral of y.
-!  This is a cumulative integration, so that
-!  y_integral(j) holds the integral of y from x(1) to xOut(j).
-!  The integration formula was created by analytically integrating a 
-!  cubic spline between each node.
-!  This subroutine assumes that both x and xOut are monotonically
-!  increasing, and that all values of xOut are within the first and
-
-! INPUT PARAMETERS:
-
-  integer, intent(in) :: &amp;
-    n,   &amp;! number of nodes
-    nOut  ! number of output locations to compute integral
-  real(kind=RKIND), intent(in), dimension(n) :: &amp;
-    x,   &amp;! location of nodes
-    y,   &amp;! value at nodes
-    y2ndDer    ! dy^2/dx^2 at each node
-  real(kind=RKIND), dimension(nOut), intent(in) :: &amp;
-    xOut  ! output locations to compute integral
-
-! OUTPUT PARAMETERS:
-
-  real(kind=RKIND), dimension(nOut), intent(out) :: &amp;
-    y_integral  ! integral from 0 to xOut
-
-!  local variables:
-
-  integer :: i,j,k
-  real(kind=RKIND) :: h,h2, A2,B2, F1,F2, eps1
-
-  y_integral = 0.0
-  j = 1
-  h = x(j+1) - x(j)
-  h2 = h**2
-  F1 = -y(j)*h*0.5 + y2ndDer(j)*h**3/24.0
-  eps1 = 0.0 ! note: could use 1e-12*xOut(nOut)
-
-  k_loop: do k = 1,nOut
-
-    if (k&gt;1) y_integral(k) = y_integral(k-1)
-
-    do while(xOut(k) &gt; x(j+1)-eps1) 
-      F2 = y(j+1)*h*0.5 - y2ndDer(j+1)*h**3/24.0
-      
-      y_integral(k) = y_integral(k) + F2 - F1
-      j = j+1
-      h = x(j+1) - x(j)
-      h2 = h**2
-      F1 = -y(j)*h*0.5 + y2ndDer(j)*h**3/24.0
-      if (abs(xOut(k) - x(j+1))&lt;eps1) cycle k_loop
-    enddo
-
-    A2 = (x(j+1)  - xOut(k))**2/h2
-    B2 = (xOut(k) - x(j)   )**2/h2
-    F2 = 0.5*h*( -y(j)*A2 + y(j+1)*B2 &amp;
-             + y2ndDer(j)  *h2*(-0.5*A2**2 + A2)/6.0 &amp;
-             + y2ndDer(j+1)*h2*( 0.5*B2**2 - B2)/6.0 )
-
-    y_integral(k) = y_integral(k) + F2 - F1
-
-    if (k &lt; nOut) then
-      A2 = (x(j+1)  -xOut(k))**2/h2
-      B2 = (xOut(k) -x(j)   )**2/h2
-      F1 = 0.5*h*( -y(j)*A2 + y(j+1)*B2 &amp;
-             + y2ndDer(j)  *h2*(-0.5*A2**2 + A2)/6.0 &amp;
-             + y2ndDer(j+1)*h2*( 0.5*B2**2 - B2)/6.0 )
-    endif
-
-  enddo k_loop
-
- end subroutine IntegrateColumnCubicSpline
-
-
- subroutine InterpolateLinear( &amp;
-                x,y,n, &amp;
-                xOut,yOut,nOut)  
-
-!  Given the arrays x(1:n) and y(1:n), which tabulate a function,
-!  this routine returns the linear interpolated values of yOut(1:nOut)
-!  at xOut(1:nOut).
-!  This subroutine assumes that both x and xOut are monotonically
-!  increasing, and that all values of xOut are within the first and
-!  last values of x.
-
-! !INPUT PARAMETERS:
-
-  real (kind=RKIND), dimension(n), intent(in) :: &amp;
-    x,         &amp;! node location, input grid
-    y         ! interpolation variable, input grid
-
-  real (kind=RKIND), dimension(nOut), intent(in) :: &amp;
-    xOut          ! node location, output grid
-
-  integer, intent(in) :: &amp;
-    N,      &amp;! number of nodes, input grid
-    NOut       ! number of nodes, output grid
-
-! !OUTPUT PARAMETERS:
-
-  real (kind=RKIND), dimension(nOut), intent(out) :: &amp;
-    yOut        ! interpolation variable, output grid
-
-!-----------------------------------------------------------------------
-!
-!  local variables
-!
-!-----------------------------------------------------------------------
-
-  integer :: &amp;
-    kIn, kOut ! counters
-
-  kOut = 1
-
-  kInLoop: do kIn = 1,n-1
-
-    do while(xOut(kOut) &lt; x(kIn+1)) 
-
-      yOut(kOut) = y(kIn)  &amp;
-        + (y(kIn+1)-y(kIn)) &amp;
-         /(x(kIn+1)  -x(kIn)  ) &amp;
-         *(xOut(kOut)  -x(kIn)  )
-
-      kOut = kOut + 1
-
-      if (kOut&gt;nOut) exit kInLoop
-
-    enddo
-  
-  enddo kInLoop
-
-  end subroutine InterpolateLinear
-
-
-  subroutine TestInterpolate
-
-!  Test function to show how to operate the cubic spline subroutines
-
-  integer, parameter :: &amp;
-    n = 10
-  real (kind=RKIND), dimension(n) :: &amp;
-    y, x, y2ndDer
-
-  integer, parameter :: &amp;
-    nOut = 100
-  real (kind=RKIND), dimension(nOut) :: &amp;
-    yOut, xOut
-
-  integer :: &amp;
-    k
-
-!-----------------------------------------------------------------------
-!
-!  Create x, y, xOut
-!
-!-----------------------------------------------------------------------
-
-   do k=1,n
-      x(k) = k-4
-      ! trig function:
-      y(k) = sin(x(k)/2)
-   enddo
-
-   do k=1,nOut
-      xOut(k) = x(1) + k/(nOut+1.0)*(x(n)-x(1))
-   enddo
-
-!-----------------------------------------------------------------------
-!
-!  Interpolate
-!
-!-----------------------------------------------------------------------
-
-   ! First, compute second derivative values at each node, y2ndDer.
-   call CubicSplineCoefficients(x,y,n,y2ndDer)
-
-   ! Compute interpolated values yOut.
-   call InterpolateCubicSpline( &amp;
-      x,y,y2ndDer,n, &amp;
-      xOut,yOut,nOut)
-
-   ! The following output can be copied directly into Matlab
-   print *, 'subplot(2,1,1)'
-   print '(a,10f8.4,a)', 'x = [',x,'];'
-   print '(a,10f8.4,a)', 'y = [',y,'];'
-   print '(a,100f8.4,a)', 'xOut = [',xOut,'];'
-   print '(a,100f8.4,a)', 'yOut = [',yOut,'];'
-   print *, &quot;plot(x,y,'-*r',xOut,yOut,'x')&quot;
-
-   ! Compute interpolated values yOut.
-   call IntegrateColumnCubicSpline( &amp;
-      x,y,y2ndDer,n, &amp;
-      xOut,yOut,nOut)  
-
-   ! The following output can be copied directly into Matlab
-   print *, 'subplot(2,1,2)'
-   print '(a,10f8.4,a)', 'x = [',x,'];'
-   print '(a,10f8.4,a)', 'y = 2*cos(-3/2) -2*cos(x/2);'
-   print '(a,100f8.4,a)', 'xOut = [',xOut,'];'
-   print '(a,100f8.4,a)', 'yOut = [',yOut,'];'
-   print *, &quot;plot(x,y,'-*r',xOut,yOut,'x')&quot;
-
-  end subroutine TestInterpolate
-
-end module spline_interpolation
-

Deleted: branches/source_condensing/src/operators/module_vector_reconstruction.F
===================================================================
--- trunk/mpas/src/operators/module_vector_reconstruction.F        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/operators/module_vector_reconstruction.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,196 +0,0 @@
-module vector_reconstruction
-
-  use grid_types
-  use configure
-  use constants
-  use RBF_interpolation
-
-  implicit none
-
-  public :: init_reconstruct, reconstruct
-
-  contains
-
-  subroutine init_reconstruct(grid)
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-  ! Purpose: pre-compute coefficients used by the reconstruct() routine
-  !
-  ! Input: grid meta data
-  !
-  ! Output: grid % coeffs_reconstruct - coefficients used to reconstruct 
-  !                                     velocity vectors at cell centers 
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-
-    implicit none
-
-    type (mesh_type), intent(inout) :: grid 
-
-    ! temporary arrays needed in the (to be constructed) init procedure
-    integer :: nCellsSolve
-    integer, dimension(:,:), pointer :: edgesOnCell
-    integer, dimension(:), pointer :: nEdgesOnCell
-    integer :: i, iCell, iEdge, pointCount, maxEdgeCount
-    real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell, xEdge, yEdge, zEdge
-    real (kind=RKIND) :: r, cellCenter(3), alpha, tangentPlane(2,3)
-    real (kind=RKIND), allocatable, dimension(:,:) :: edgeOnCellLocations, edgeOnCellNormals, &amp;
-      coeffs
-
-    real(kind=RKIND), dimension(:,:), pointer :: edgeNormalVectors
-    real(kind=RKIND), dimension(:,:,:), pointer :: cellTangentPlane
-
-    real (kind=RKIND), dimension(:,:,:), pointer :: coeffs_reconstruct
-
-    !========================================================
-    ! arrays filled and saved during init procedure
-    !========================================================
-    coeffs_reconstruct =&gt; grid % coeffs_reconstruct % array
-
-    !========================================================
-    ! temporary variables needed for init procedure
-    !========================================================
-    xCell       =&gt; grid % xCell % array
-    yCell       =&gt; grid % yCell % array
-    zCell       =&gt; grid % zCell % array
-    xEdge       =&gt; grid % xEdge % array
-    yEdge       =&gt; grid % yEdge % array
-    zEdge       =&gt; grid % zEdge % array
-    edgesOnCell =&gt; grid % edgesOnCell % array
-    nEdgesOnCell=&gt; grid % nEdgesOnCell % array
-    nCellsSolve = grid % nCellsSolve
-    edgeNormalVectors =&gt; grid % edgeNormalVectors % array
-    cellTangentPlane =&gt; grid % cellTangentPlane % array
-
-
-    ! init arrays
-    coeffs_reconstruct = 0.0
-
-    maxEdgeCount = maxval(nEdgesOnCell)
-
-    allocate(edgeOnCellLocations(maxEdgeCount,3))
-    allocate(edgeOnCellNormals(maxEdgeCount,3))
-    allocate(coeffs(maxEdgeCount,3))
-
-    ! loop over all cells to be solved on this block
-    do iCell=1,nCellsSolve
-      pointCount = nEdgesOnCell(iCell)
-      cellCenter(1) = xCell(iCell)
-      cellCenter(2) = yCell(iCell)
-      cellCenter(3) = zCell(iCell)
-
-      do i=1,pointCount
-        iEdge = edgesOnCell(i,iCell)
-        edgeOnCellLocations(i,1)  = xEdge(iEdge)
-        edgeOnCellLocations(i,2)  = yEdge(iEdge)
-        edgeOnCellLocations(i,3)  = zEdge(iEdge)
-        edgeOnCellNormals(i,:)  = edgeNormalVectors(:, iEdge)
-      end do
-
-      alpha = 0.0
-      do i=1,pointCount
-        r = sqrt(sum((cellCenter - edgeOnCellLocations(i,:))**2))
-        alpha = alpha + r
-      enddo
-      alpha = alpha/pointCount
-
-      tangentPlane(1,:) = cellTangentPlane(:,1,iCell)
-      tangentPlane(2,:) = cellTangentPlane(:,2,iCell)
-
-      call rbfInterp_func_3DPlane_vec_const_dir_compCoeffs(pointCount, &amp;
-        edgeOnCellLocations(1:pointCount,:), &amp;
-        edgeOnCellNormals(1:pointCount,:), &amp;
-        cellCenter, alpha, tangentPlane, coeffs(1:pointCount,:))
-      
-      do i=1,pointCount
-        coeffs_reconstruct(:,i,iCell) = coeffs(i,:)
-      end do
-
-    enddo   ! iCell
-
-    deallocate(edgeOnCellLocations)
-    deallocate(edgeOnCellNormals)
-    deallocate(coeffs)
-
-  end subroutine init_reconstruct
-
-  subroutine reconstruct(grid, u, uReconstructX, uReconstructY, uReconstructZ, uReconstructZonal, uReconstructMeridional)
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-  ! Purpose: reconstruct vector field at cell centers based on radial basis functions
-  !
-  ! Input: grid meta data and vector component data residing at cell edges
-  !
-  ! Output: reconstructed vector field (measured in X,Y,Z) located at cell centers
-  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-    implicit none
-
-    type (mesh_type), intent(in) :: grid
-    real (kind=RKIND), dimension(:,:), intent(in) :: u
-    real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructX, uReconstructY, uReconstructZ
-    real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructZonal, uReconstructMeridional
-
-    !   temporary arrays needed in the compute procedure
-    integer :: nCellsSolve
-    integer, dimension(:,:), pointer :: edgesOnCell
-    integer, dimension(:), pointer :: nEdgesOnCell
-    integer :: iCell,iEdge, i
-    real(kind=RKIND), dimension(:), pointer :: latCell, lonCell
-
-    real (kind=RKIND), dimension(:,:,:), pointer :: coeffs_reconstruct
-
-    logical :: on_a_sphere
-
-    real (kind=RKIND) :: clat, slat, clon, slon
-
-
-    ! stored arrays used during compute procedure
-    coeffs_reconstruct =&gt; grid % coeffs_reconstruct % array
-
-    ! temporary variables
-    edgesOnCell =&gt; grid % edgesOnCell % array
-    nEdgesOnCell=&gt; grid % nEdgesOnCell % array
-    nCellsSolve = grid % nCellsSolve
-
-    latCell       =&gt; grid % latCell % array
-    lonCell       =&gt; grid % lonCell % array
-    on_a_sphere = grid % on_a_sphere
-
-    ! init the intent(out)
-    uReconstructX = 0.0
-    uReconstructY = 0.0
-    uReconstructZ = 0.0
-
-    ! loop over cell centers
-    do iCell=1,nCellsSolve
-      ! a more efficient reconstruction where rbf_values*matrix_reconstruct has been precomputed
-      ! in coeffs_reconstruct
-      do i=1,nEdgesOnCell(iCell)
-        iEdge = edgesOnCell(i,iCell)
-        uReconstructX(:,iCell) = uReconstructX(:,iCell) &amp;
-          + coeffs_reconstruct(1,i,iCell) * u(:,iEdge)
-        uReconstructY(:,iCell) = uReconstructY(:,iCell) &amp;
-          + coeffs_reconstruct(2,i,iCell) * u(:,iEdge)
-        uReconstructZ(:,iCell) = uReconstructZ(:,iCell) &amp;
-          + coeffs_reconstruct(3,i,iCell) * u(:,iEdge)
-
-      enddo
-    enddo   ! iCell
-
-    if(on_a_sphere) then
-      do iCell=1,nCellsSolve
-        clat = cos(latCell(iCell))
-        slat = sin(latCell(iCell))
-        clon = cos(lonCell(iCell))
-        slon = sin(lonCell(iCell))
-        uReconstructZonal(:,iCell) = -uReconstructX(:,iCell)*slon + uReconstructY(:,iCell)*clon
-        uReconstructMeridional(:,iCell) = -(uReconstructX(:,iCell)*clon &amp;
-          + uReconstructY(:,iCell)*slon)*slat &amp;
-          + uReconstructZ(:,iCell)*clat
-      end do
-    else
-      uReconstructZonal = uReconstructX
-      uReconstructMeridional = uReconstructY
-    end if
-
-  end subroutine reconstruct
-
-end module vector_reconstruction

Copied: branches/source_condensing/src/operators/mpas_rbf_interpolation.F (from rev 1114, trunk/mpas/src/operators/mpas_rbf_interpolation.F)
===================================================================
--- branches/source_condensing/src/operators/mpas_rbf_interpolation.F                                (rev 0)
+++ branches/source_condensing/src/operators/mpas_rbf_interpolation.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,1824 @@
+module mpas_rbf_interpolation
+   use mpas_dmpar
+   use mpas_grid_types
+
+   implicit none
+   private
+   save
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+! Purpose: perform interpolation of scalar and vector functions in 2D
+!   and 3D using Radial Basis Functions (RBFs).
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+   ! Initialize the geometry that will be useful from interpolation
+  public :: mpas_rbf_interp_initialize
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Routines for perofrming interpolation in 2D (including Jacobian and Hessian)
+  !  at locations that vary using a function that is fixed.  This is useful
+  !  for finding the location on the the RBF reconstruction of a function
+  !  (e.g., a height field) that minimizes the distance to a point in 3D space
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  public :: mpas_rbf_interp_loc_2D_sca_const_comp_coeffs, &amp;
+    mpas_rbf_interp_loc_2D_sca_lin_comp_coeffs, &amp;
+    mpas_rbf_interp_loc_2D_sca_const_eval_with_derivs, &amp;
+    mpas_rbf_interp_loc_2D_sca_lin_eval_with_derivs
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Routines for computing scalar interpolaiton coefficients in 3D (coplanar points
+  !  in 3D) with support for either constant or constant and linear basis
+  !  functions in addition to RBFs.  In constrast to the two subroutines
+  !  above, these coefficients are valid for computing the value of the
+  !  interpolant at a fixe point in space using function values that may
+  !  vary (e.g., in time) at each of the interpolation &quot;source&quot; points.
+  !  The last 3 routines can be used to compute coefficients for imposing both Neumann
+  !  and Dirichlet boundary conditions.
+  ! Pseudocode for function reconstruction at the destinationPoint is as follows
+  !  Dirichlet:  functionAtDestination = sum(functionAtSources*dirichletCoefficients)
+  !  Neumann:    functionAtDestination = sum(functionOrDerivAtSources*neumannCoefficients)
+  !    where functionOrDerivAtSource = functionAtSources where .not.(isInterface)
+  !                                  = functionNormalDerivAtSources where isInterface
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  public :: mpas_rbf_interp_func_3D_sca_const_dir_comp_coeffs, &amp;
+    mpas_rbf_interp_func_3D_plane_sca_lin_dir_comp_coeffs, &amp;
+    mpas_rbf_interp_func_3D_sca_lin_dir_comp_coeffs, &amp;
+    mpas_rbf_interp_func_3D_sca_const_dir_neu_comp_coeffs, &amp;
+    mpas_rbf_interp_func_3D_plane_sca_lin_dir_neu_comp_coeffs, &amp;
+    mpas_rbf_interp_func_3D_sca_lin_dir_neu_comp_coeffs
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Routines for computing vector interpolaiton coefficients in 3D (coplanar points
+  !  in 3D) with support for only constant basis functions in addition to RBFs. 
+  !  (Linear basis functions can cause problems: a linear vortex flow u = y xHat - x yHat
+  !  cannot be reconstructed from vectors that are only normal to the cell edges in 2D.
+  !  Therefore, we don't support them). As with the scalar 3D subroutines
+  !  above, these coefficients are valid for computing the value of the
+  !  interpolant at a fixe point in space using function values that may
+  !  vary (e.g., in time) at each of the interpolation &quot;source&quot; points.
+  !  The user supplies to these routines a set of sourcePoints and unitVectors
+  !  as well as a destinationPoint and, for the last 2 routines, flags for
+  !  which points are tangent to the interface and which of the supplied unitVectors
+  !  is the normal at the corresponding point.
+  !
+  ! The first two routines compute coefficients that can be used to interpolate
+  !  a vector function to the destination point given &quot;function dot unitVector&quot; values
+  !  at each source point.  These routines are useful, for example, for reconstructing
+  !  the full vector velocity at cell centers from the normal components of the velocity
+  !  at cell faces (or cell edges in 2D), or for computing the full velocity at an
+  !  immersed boundary image point based on the normal velocity at several faces and
+  !  the full velocity at boundary points (e.g., a no-slip boundary condition).
+  !
+  ! The last two routines compute coefficients that can be used to interpolate
+  !  a vector function to the destination point given &quot;function dot unitVector&quot; values
+  !  at non-tangent source point and &quot;dFunction/dn dot unitVector&quot; values at
+  !  tangent source point.  These routines are useful, for example, for computing the 
+  !  full velocity at an immersed boundary image point based on the normal velocity at
+  !  several faces, the normal velocity at boundary points (e.g., u dot n = 0 for a
+  !  no-penetration boundary condition on a fixed boundary), and the normal derivative
+  !  of the tangential components of velocity at the boundary points (e.g., a free-slip
+  !  boundary condition).
+  ! Pseudocode for function reconstruction at the destinationPoint is as follows
+  !  dirichlet:  functionAtDestination_i = sum_j(functionDotUnitVectorAtSources_j*coefficients_j,i)
+  !    for i = x,y,z
+  !  tangentNeumann:    functionAtDestination_i &amp;
+  !    = sum_(j where .not isTangent) (functionDotUnitVectorAtSources_j*coefficients_j,i) &amp;
+  !    + sum_(j where isTangent) ((dFunction/dn dot UnitVector)_j*coefficients_j,i)
+  !    for i = x,y,z
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  public :: mpas_rbf_interp_func_3D_vec_const_dir_comp_coeffs, &amp;
+    mpas_rbf_interp_func_3D_plane_vec_const_dir_comp_coeffs!, &amp;
+    !mpas_rbf_interp_func_3D_vec_const_tan_neu_comp_coeffs, &amp;
+    !mpas_rbf_interp_func_3D_plane_vec_const_tan_neu_comp_coeffs
+
+  contains
+
+  subroutine mpas_rbf_interp_initialize(grid)
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: compute geometric fields that will be potentially useful for calling
+  !          the interpolation routines
+  !
+  ! Input: the grid
+  !
+  ! Output: 
+  !  edgeNormalVectors - the unit vector at the center of each edge tangent to the sphere
+  !  cellTangentPlane - 2 orthogonal unit vectors in the tangent plane of each cell
+  !                     The first unit vector is chosen to point toward the center of the first
+  !                     edge on the cell.
+  !  localVerticalUnitVectors - the unit normal vector of the tangent plane at the center 
+  !                             of each cell
+  !       
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+    implicit none
+
+    type (mesh_type), intent(inout) :: grid 
+
+    integer :: nCells, nEdges
+    integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell
+    integer :: iEdge, iCell, cell1, cell2
+    real(kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell, xEdge, yEdge, zEdge
+    real(kind=RKIND), dimension(:,:), pointer :: localVerticalUnitVectors, edgeNormalVectors
+    real(kind=RKIND), dimension(:,:,:), pointer :: cellTangentPlane
+    real(kind=RKIND), dimension(3) :: xHatPlane, yHatPlane, rHat
+    real(kind=RKIND) :: normalDotRHat
+    logical :: on_a_sphere
+
+    xCell       =&gt; grid % xCell % array
+    yCell       =&gt; grid % yCell % array
+    zCell       =&gt; grid % zCell % array
+    xEdge       =&gt; grid % xEdge % array
+    yEdge       =&gt; grid % yEdge % array
+    zEdge       =&gt; grid % zEdge % array
+    cellsOnEdge =&gt; grid % cellsOnEdge % array
+    edgesOnCell =&gt; grid % edgesOnCell % array
+    nCells      = grid % nCells
+    nEdges      = grid % nEdges
+    on_a_sphere = grid % on_a_sphere
+
+    localVerticalUnitVectors =&gt; grid % localVerticalUnitVectors % array
+    edgeNormalVectors =&gt; grid % edgeNormalVectors % array
+    cellTangentPlane =&gt; grid % cellTangentPlane % array
+
+    ! init arrays
+    edgeNormalVectors = 0
+    localVerticalUnitVectors = 0
+
+    ! loop over all cells to be solved on this block
+    do iCell=1,nCells
+      if(on_a_sphere) then
+        localVerticalUnitVectors(1,iCell) = xCell(iCell)
+        localVerticalUnitVectors(2,iCell) = yCell(iCell)
+        localVerticalUnitVectors(3,iCell) = zCell(iCell)
+        call mpas_unit_vec_in_r3(localVerticalUnitVectors(:,iCell))
+      else ! on a plane
+        localVerticalUnitVectors(:,iCell) = (/ 0., 0., 1. /)
+      end if
+    end do
+
+    do iEdge = 1,nEdges
+      iCell = cellsOnEdge(1,iEdge) ! the normal vector points from the first cell toward the edge
+      if(iCell == nCells+1) then ! this is a boundary edge
+        ! the first cell bordering this edge is not real, use the second cell
+        !  The normal should always point outward at boundaries, away from the valid cell center
+        iCell = cellsOnEdge(2,iEdge)
+      end if
+      ! the normal points from the cell location to the edge location
+      edgeNormalVectors(1,iEdge) = xEdge(iEdge) - xCell(iCell)
+      edgeNormalVectors(2,iEdge) = yEdge(iEdge) - yCell(iCell)
+      edgeNormalVectors(3,iEdge) = zEdge(iEdge) - zCell(iCell)
+      call mpas_unit_vec_in_r3(edgeNormalVectors(:,iEdge))
+    end do
+
+    do iCell=1,nCells
+      iEdge = edgesOnCell(1,iCell)
+      ! xHat and yHat are a local basis in the plane of the horizontal cell
+      ! we arbitrarily choose xHat to point toward the first edge
+      rHat = localVerticalUnitVectors(:,iCell)
+      normalDotRHat = sum(edgeNormalVectors(:,iEdge)*rHat)
+      xHatPlane = edgeNormalVectors(:,iEdge) - normalDotRHat*rHat
+      call mpas_unit_vec_in_r3(xHatPlane)
+
+      call mpas_cross_product_in_r3(rHat, xHatPlane, yHatPlane)
+      call mpas_unit_vec_in_r3(yHatPlane) ! just to be sure...
+      cellTangentPlane(:,1,iCell) = xHatPlane
+      cellTangentPlane(:,2,iCell) = yHatPlane
+    end do
+
+  end subroutine mpas_rbf_interp_initialize
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Compute interpolation coefficients in 2D that can be used to
+  !  reconstruct a given scalar function at varying locations. This is useful
+  !  for finding the location on the the RBF reconstruction of a function
+  !  (e.g., a height field) that minimizes the distance to a point in 3D space.
+  !  The reconstruction is performed with basis functions that are RBFs and constant 
+  ! Input:
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  coeffCount - the size of coefficients, must be at least pointCount + 1
+  !  points - the location of the &quot;source&quot; points in the 2D space where the values of
+  !    the function are known
+  !  fieldValues - the values of the function of interest at the points
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  ! Output:
+  !  coefficients - the coefficients needed to perform interpolation of the funciton
+  !    at destination points yet to be specified
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_loc_2D_sca_const_comp_coeffs(pointCount, coeffCount, &amp;
+    points, fieldValues, alpha, coefficients)

+    integer, intent(in) :: pointCount, coeffCount
+    real(kind=RKIND), dimension(pointCount,2), intent(in) :: points
+    real(kind=RKIND), dimension(pointCount), intent(in) :: fieldValues
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(coeffCount), intent(out) :: coefficients
+
+    integer :: i, j, matrixSize
+    real(kind=RKIND), dimension(pointCount+1,pointCount+1) :: matrix
+    real(kind=RKIND), dimension(pointCount+1) :: rhs
+    integer, dimension(pointCount+1) :: pivotIndices
+    real(kind=RKIND) :: rSquared
+
+    matrixSize = pointCount+1
+    coefficients = 0.0
+    matrix = 0.0
+    rhs = 0.0
+
+    rhs(1:pointCount) = fieldValues
+
+    do j=1,pointCount
+      do i=j,pointCount
+        rSquared = sum((points(j,:) - points(i,:))**2)/alpha**2
+        matrix(i,j) = evaluate_rbf(rSquared)
+        matrix(j,i) = matrix(i,j)
+      end do
+    end do
+    do j=1,pointCount
+      matrix(pointCount+1,j) = 1.0
+      matrix(j,pointCount+1) = 1.0
+    end do
+
+    call mpas_legs(matrix(1:matrixSize,1:matrixSize), matrixSize, rhs(1:matrixSize), &amp;
+      coefficients(1:matrixSize), pivotIndices(1:matrixSize))
+
+  end subroutine mpas_rbf_interp_loc_2D_sca_const_comp_coeffs
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Compute interpolation coefficients in 2D that can be used to
+  !  reconstruct a given scalar function at varying locations. This is useful
+  !  for finding the location on the the RBF reconstruction of a function
+  !  (e.g., a height field) that minimizes the distance to a point in 3D space.
+  !  The reconstruction is performed with basis functions that are RBFs plus constant
+  !  and linear 
+  ! Input:
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  coeffCount - the size of coefficients, must be at least pointCount + 3
+  !  points - the location of the &quot;source&quot; points in the 2D space where the values of
+  !    the function are known
+  !  fieldValues - the values of the function of interest at the points
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  ! Output:
+  !  coefficients - the coefficients needed to perform interpolation of the funciton
+  !    at destination points yet to be specified
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_loc_2D_sca_lin_comp_coeffs(pointCount, coeffCount, &amp;
+    points, fieldValues, alpha, coefficients)

+    integer, intent(in) :: pointCount, coeffCount
+    real(kind=RKIND), dimension(pointCount,2), intent(in) :: points
+    real(kind=RKIND), dimension(pointCount), intent(in) :: fieldValues
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(coeffCount), intent(out) :: coefficients
+
+    integer :: i, j, matrixSize
+    real(kind=RKIND), dimension(pointCount+3,pointCount+3) :: matrix
+    real(kind=RKIND), dimension(pointCount+3) :: rhs
+    integer, dimension(pointCount+3) :: pivotIndices
+    real(kind=RKIND) :: rSquared
+
+    coefficients = 0.0
+    matrix = 0.0
+    rhs = 0.0
+
+    rhs(1:pointCount) = fieldValues
+
+    do j=1,pointCount
+      do i=j,pointCount
+        rSquared = sum((points(j,:) - points(i,:))**2)/alpha**2
+        matrix(i,j) = evaluate_rbf(rSquared)
+        matrix(j,i) = matrix(i,j)
+      end do
+    end do
+    matrixSize = pointCount+3
+    do j=1,pointCount
+      matrix(pointCount+1,j) = 1.0
+      matrix(pointCount+2,j) = points(j,1)
+      matrix(pointCount+3,j) = points(j,2)
+      matrix(j,pointCount+1:pointCount+3) = matrix(pointCount+1:pointCount+3, j)
+    end do
+    call mpas_legs(matrix(1:matrixSize,1:matrixSize), matrixSize, rhs(1:matrixSize), &amp;
+      coefficients(1:matrixSize), pivotIndices(1:matrixSize))
+
+  end subroutine mpas_rbf_interp_loc_2D_sca_lin_comp_coeffs
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Evalute a scalar function in 2D using coefficients computed in
+  !  rbfInterp_loc_2D_sca_const_compCoeffs.  This 
+  !  function can be called repeatedly with different destination points
+  !  to quickly evaluate the interpolating function using the same
+  !  coefficients.  This is useful for finding the location on the the 
+  !  RBF reconstruction of a function (e.g., a height field) that minimizes
+  !  the distance to a point in 3D space. The reconstruction is performed
+  !  with basis functions that are RBFs and constant 
+  ! Input:
+  !  fieldCount - the number fields to be evaluated.  This is useful for reconstructing,
+  !    for example, the x-, y- and z-components of a vector field at the same
+  !    point in 2D
+  !  coeffCount - the size of coefficients, must be at least pointCount + 1
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  coefficients - the coefficients needed to perform interpolation of the funciton
+  !    at the evaluationPoint
+  !  evaluationPoint - the point in 2D where the function is to be reconstructed
+  !  points - the location of the &quot;source&quot; points in the 2D space where the values of
+  !    the function are known
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  ! Output:
+  !  derivs - the value of the function, the 2 components of its Jacobian and
+  !    the 3 unique components of its Hessian at the evaluationPoint
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_loc_2D_sca_const_eval_with_derivs(fieldCount, coeffCount, &amp;
+    pointCount, coefficients, evaluationPoint, points, alpha, derivs)
+    integer, intent(in) :: fieldCount, coeffCount, pointCount
+    real(kind=RKIND), dimension(coeffCount, fieldCount), intent(in) :: coefficients
+    real(kind=RKIND), dimension(2), intent(in) :: evaluationPoint
+    real(kind=RKIND), dimension(pointCount,2), intent(in) :: points
+    real(kind=RKIND), intent(in) :: alpha
+
+    real(kind=RKIND), dimension(6,fieldCount), intent(out) :: derivs
+
+    integer :: pointIndex
+    real(kind=RKIND) :: x, y, rSquared, rbfValue, rbfDerivOverR, rbfSecondDeriv
+
+    derivs = 0.0
+    do pointIndex = 1, pointCount
+      x = (evaluationPoint(1) - points(pointIndex,1))
+      y = (evaluationPoint(2) - points(pointIndex,2))
+      rSquared = x**2 + y**2
+      call mpas_evaluate_rbf_and_derivs(rSquared/alpha**2,  rbfValue, rbfDerivOverR, rbfSecondDeriv)
+      rbfDerivOverR = rbfDerivOverR/alpha**2
+      rbfSecondDeriv = rbfSecondDeriv/alpha**2
+      if(rSquared/alpha**2 &lt; 1e-7) then
+        ! terms 2,3 and 5 are zero by radial symmetry of the RBF
+        derivs(1,:) = derivs(1,:) + coefficients(pointIndex,:)*rbfValue
+        derivs(4,:) = derivs(4,:) + coefficients(pointIndex,:)*rbfSecondDeriv
+        derivs(6,:) = derivs(6,:) + coefficients(pointIndex,:)*rbfSecondDeriv
+      else
+        call mpas_evaluate_rbf_and_derivs(rSquared,  rbfValue, rbfDerivOverR, rbfSecondDeriv)
+        derivs(1,:) = derivs(1,:) + coefficients(pointIndex,:)*rbfValue
+        derivs(2,:) = derivs(2,:) + coefficients(pointIndex,:)*rbfDerivOverR*x
+        derivs(3,:) = derivs(3,:) + coefficients(pointIndex,:)*rbfDerivOverR*y
+        derivs(4,:) = derivs(4,:) + coefficients(pointIndex,:) &amp;
+          * (rbfSecondDeriv*x**2 + rbfDerivOverR*y**2)/rSquared
+        derivs(5,:) = derivs(5,:) + coefficients(pointIndex,:) &amp;
+          * (rbfSecondDeriv - rbfDerivOverR)*x*y/rSquared
+        derivs(6,:) = derivs(6,:) + coefficients(pointIndex,:) &amp;
+          * (rbfSecondDeriv*y**2 + rbfDerivOverR*x**2)/rSquared
+      end if
+    end do
+    derivs(1,:) = derivs(1,:) + coefficients(pointCount+1,:)
+  end subroutine mpas_rbf_interp_loc_2D_sca_const_eval_with_derivs
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Evalute a scalar function in 2D using coefficients computed in
+  !  rbfInterp_loc_2D_sca_const_compCoeffs.  This 
+  !  function can be called repeatedly with different destination points
+  !  to quickly evaluate the interpolating function using the same
+  !  coefficients.  This is useful for finding the location on the the 
+  !  RBF reconstruction of a function (e.g., a height field) that minimizes
+  !  the distance to a point in 3D space. The reconstruction is performed
+  !  with basis functions that are RBFs, constant and linear
+  ! Input:
+  !  fieldCount - the number fields to be evaluated.  This is useful for reconstructing,
+  !    for example, the x-, y- and z-components of a vector field at the same
+  !    point in 2D
+  !  coeffCount - the size of coefficients, must be at least pointCount + 1
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  coefficients - the coefficients needed to perform interpolation of the funciton
+  !    at the evaluationPoint
+  !  evaluationPoint - the point in 2D where the function is to be reconstructed
+  !  points - the location of the &quot;source&quot; points in the 2D space where the values of
+  !    the function are known
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  ! Output:
+  !  derivs - the value of the function, the 2 components of its Jacobian and
+  !    the 3 unique components of its Hessian at the evaluationPoint
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_loc_2D_sca_lin_eval_with_derivs(fieldCount, coeffCount, &amp;
+    pointCount, coefficients, evaluationPoint, points, alpha, derivs)
+    integer, intent(in) :: fieldCount, coeffCount, pointCount
+    real(kind=RKIND), dimension(coeffCount, fieldCount), intent(in) :: coefficients
+    real(kind=RKIND), dimension(2), intent(in) :: evaluationPoint
+    real(kind=RKIND), dimension(pointCount,2), intent(in) :: points
+    real(kind=RKIND), intent(in) :: alpha
+
+    real(kind=RKIND), dimension(6,fieldCount), intent(out) :: derivs
+
+    integer :: pointIndex
+    real(kind=RKIND) :: x, y, rSquared, rbfValue, rbfDerivOverR, rbfSecondDeriv
+
+    derivs = 0.0
+    do pointIndex = 1, pointCount
+      x = (evaluationPoint(1) - points(pointIndex,1))
+      y = (evaluationPoint(2) - points(pointIndex,2))
+      rSquared = x**2 + y**2
+      call mpas_evaluate_rbf_and_derivs(rSquared/alpha**2,  rbfValue, rbfDerivOverR, rbfSecondDeriv)
+      rbfDerivOverR = rbfDerivOverR/alpha**2
+      rbfSecondDeriv = rbfSecondDeriv/alpha**2
+      if(rSquared/alpha**2 &lt; 1e-7) then
+        ! terms 2,3 and 5 are zero by radial symmetry of the RBF
+        derivs(1,:) = derivs(1,:) + coefficients(pointIndex,:)*rbfValue
+        derivs(4,:) = derivs(4,:) + coefficients(pointIndex,:)*rbfSecondDeriv
+        derivs(6,:) = derivs(6,:) + coefficients(pointIndex,:)*rbfSecondDeriv
+      else
+        call mpas_evaluate_rbf_and_derivs(rSquared,  rbfValue, rbfDerivOverR, rbfSecondDeriv)
+        derivs(1,:) = derivs(1,:) + coefficients(pointIndex,:)*rbfValue
+        derivs(2,:) = derivs(2,:) + coefficients(pointIndex,:)*rbfDerivOverR*x
+        derivs(3,:) = derivs(3,:) + coefficients(pointIndex,:)*rbfDerivOverR*y
+        derivs(4,:) = derivs(4,:) + coefficients(pointIndex,:) &amp;
+          * (rbfSecondDeriv*x**2 + rbfDerivOverR*y**2)/rSquared
+        derivs(5,:) = derivs(5,:) + coefficients(pointIndex,:) &amp;
+          * (rbfSecondDeriv - rbfDerivOverR)*x*y/rSquared
+        derivs(6,:) = derivs(6,:) + coefficients(pointIndex,:) &amp;
+          * (rbfSecondDeriv*y**2 + rbfDerivOverR*x**2)/rSquared
+      end if
+    end do
+    derivs(1,:) = derivs(1,:) + coefficients(pointCount+1,:) &amp;
+      + coefficients(pointCount+2,:)*evaluationPoint(1) &amp;
+      + coefficients(pointCount+3,:)*evaluationPoint(2)
+    derivs(2,:) = derivs(2,:) + coefficients(pointCount+2,:)
+    derivs(3,:) = derivs(3,:) + coefficients(pointCount+3,:)
+
+  end subroutine mpas_rbf_interp_loc_2D_sca_lin_eval_with_derivs
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Compute interpolation coefficients in 3D that can be used to
+  !  interpolate a number of scalar functions at a given locations. This is useful
+  !  if the interpolation location does not change with time, or if several
+  !  fields are to be interpolated at a given time step.  (If both the fields
+  !  and the interpolation locations vary with time, there is no clear advantage in
+  !  using either this method or the method for 2D interpoaltion above; for simplicity
+  !  and because we foresee more uses for the method of this subroutine, we have not
+  !  implemented a 3D version of the fixed field, variable interpolation location method
+  !  as we have in 2D.) Coefficients are produced for handling Dirichlet boundary
+  !  conditions (or no boundaries).  The interpolation is performed with basis functions
+  !  that are RBFs plus a constant.
+  ! Input:
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
+  !    the function are known
+  !  destinationPoint - the point where the interpolation will be performed
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  ! Output:
+  !  coefficients - the coefficients used to interpolate a function with Dirichlet
+  !    boundary conditions to the specified destinationPoint
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_func_3D_sca_const_dir_comp_coeffs( &amp;
+    pointCount, sourcePoints, destinationPoint, alpha, coefficients)
+
+    integer, intent(in) :: pointCount
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
+    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(pointCount), intent(out) :: coefficients
+
+    integer :: i, j
+    integer :: matrixSize
+
+    real(kind=RKIND), dimension(:,:), pointer :: dirichletMatrix
+    real(kind=RKIND), dimension(:), pointer :: rhs, coeffs
+    integer, dimension(:), pointer :: pivotIndices
+
+    matrixSize = pointCount+1 !! 1 extra space for constant 
+
+    allocate(dirichletMatrix(matrixSize,matrixSize))  
+    allocate(rhs(matrixSize))  
+    allocate(coeffs(matrixSize))  
+    allocate(pivotIndices(matrixSize))  
+
+    dirichletMatrix = 0.0
+    rhs = 0.0
+    coeffs = 0.0
+
+    call mpas_set_up_scalar_rbf_dirichlet_matrix_and_rhs(pointCount, sourcePoints, destinationPoint, &amp;
+      alpha, dirichletMatrix(1:pointCount,1:pointCount), rhs(1:pointCount))
+
+    do i = 1, pointCount
+      dirichletMatrix(i,pointCount+1) = 1.0
+      dirichletMatrix(pointCount+1,i) = dirichletMatrix(i,pointCount+1)
+    end do
+
+    rhs(pointCount+1) = 1.0
+
+    ! solve each linear system
+    call mpas_legs(dirichletMatrix, matrixSize, rhs, coeffs, pivotIndices)
+    coefficients = coeffs(1:pointCount)
+
+    deallocate(dirichletMatrix)  
+    deallocate(rhs)  
+    deallocate(coeffs)  
+    deallocate(pivotIndices) 
+
+  end subroutine mpas_rbf_interp_func_3D_sca_const_dir_comp_coeffs
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Compute interpolation coefficients in a plane in 3D that can be used to
+  !  interpolate a number of scalar functions at a given locations. This is useful
+  !  if the interpolation location does not change with time, or if several
+  !  fields are to be interpolated at a given time step.  (If both the fields
+  !  and the interpolation locations vary with time, there is no clear advantage in
+  !  using either this method or the method for 2D interpoaltion above; for simplicity
+  !  and because we foresee more uses for the method of this subroutine, we have not
+  !  implemented a 3D version of the fixed field, variable interpolation location method
+  !  as we have in 2D.) Coefficients are produced for handling both Dirichlet (or no)
+  !  boundary conditions.  The interpolation is performed with basis functions that are
+  !  RBFs plus constant and linear.  All points are projected into the plane given by the
+  !  planeBasisVectors.
+  ! Input:
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
+  !    the function are known.  The points will be projected into the plane given by 
+  !    planeBasisVectors
+  !  destinationPoint - the point in 3D where the interpolation will be performed.  The
+  !    destinationPoint will be projected into the plane given by planeBasisVectors.
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  !  planeBasisVectors - the basis fectors for the plane where interpolation is performed.
+  !    All points are projected into this plane. 
+  ! Output:
+  !  coefficients - the coefficients used to interpolate a function with Dirichlet
+  !    boundary conditions to the specified destinationPoint
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_func_3D_plane_sca_lin_dir_comp_coeffs( &amp;
+    pointCount, sourcePoints, destinationPoint, &amp;
+    alpha, planeBasisVectors, coefficients)
+
+    integer, intent(in) :: pointCount
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
+    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(2,3) :: planeBasisVectors
+    real(kind=RKIND), dimension(pointCount), intent(out) :: coefficients
+
+    integer :: i, j
+    integer :: matrixSize
+
+    real(kind=RKIND), dimension(:,:), pointer :: dirichletMatrix
+    real(kind=RKIND), dimension(:), pointer :: rhs, coeffs
+    integer, dimension(:), pointer :: pivotIndices
+
+    matrixSize = pointCount+3 !! 3 extra space for constant and 2 planar dimensions
+
+    allocate(dirichletMatrix(matrixSize,matrixSize))  
+    allocate(rhs(matrixSize))  
+    allocate(coeffs(matrixSize))  
+    allocate(pivotIndices(matrixSize))  
+
+    dirichletMatrix = 0.0
+    rhs = 0.0
+    coeffs = 0.0
+
+    call mpas_set_up_scalar_rbf_dirichlet_matrix_and_rhs(pointCount, sourcePoints, destinationPoint, &amp;
+      alpha, dirichletMatrix(1:pointCount,1:pointCount), rhs(1:pointCount))
+
+    do i = 1, pointCount
+      dirichletMatrix(i,pointCount+1) = 1.0
+      dirichletMatrix(i,pointCount+2) = sum(sourcePoints(i,1:3)*planeBasisVectors(1,:))
+      dirichletMatrix(i,pointCount+3) = sum(sourcePoints(i,1:3)*planeBasisVectors(2,:))
+      dirichletMatrix(pointCount+1:pointCount+3,i) &amp;
+        = dirichletMatrix(i,pointCount+1:pointCount+3)
+    end do
+
+    rhs(pointCount+1) = 1.0
+    rhs(pointCount+2) = sum(destinationPoint(1:3)*planeBasisVectors(1,:))
+    rhs(pointCount+3) = sum(destinationPoint(1:3)*planeBasisVectors(2,:))
+
+    ! solve each linear system
+    call mpas_legs(dirichletMatrix, matrixSize, rhs, coeffs, pivotIndices)
+    coefficients = coeffs(1:pointCount)
+
+    deallocate(dirichletMatrix)  
+    deallocate(rhs)  
+    deallocate(coeffs)  
+    deallocate(pivotIndices) 
+
+  end subroutine mpas_rbf_interp_func_3D_plane_sca_lin_dir_comp_coeffs
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Compute interpolation coefficients in 3D that can be used to
+  !  interpolate a number of scalar functions at a given locations. This is useful
+  !  if the interpolation location does not change with time, or if several
+  !  fields are to be interpolated at a given time step.  (If both the fields
+  !  and the interpolation locations vary with time, there is no clear advantage in
+  !  using either this method or the method for 2D interpoaltion above; for simplicity
+  !  and because we foresee more uses for the method of this subroutine, we have not
+  !  implemented a 3D version of the fixed field, variable interpolation location method
+  !  as we have in 2D.) Coefficients are produced for handling both Dirichlet (or no)
+  !  boundary conditions.  The interpolation is performed with basis functions that are
+  !  RBFs plus constant and linear.
+  ! Input:
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
+  !    the function are known
+  !  destinationPoint - the point where the interpolation will be performed
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  ! Output:
+  !  coefficients - the coefficients used to interpolate a function with Dirichlet
+  !    boundary conditions to the specified destinationPoint
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_func_3D_sca_lin_dir_comp_coeffs(pointCount, &amp;
+    sourcePoints, destinationPoint, alpha, coefficients)
+
+    integer, intent(in) :: pointCount
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
+    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(pointCount), intent(out) :: coefficients
+
+    integer :: i, j
+    integer :: matrixSize
+
+    real(kind=RKIND), dimension(:,:), pointer :: dirichletMatrix
+    real(kind=RKIND), dimension(:), pointer :: rhs, coeffs
+    integer, dimension(:), pointer :: pivotIndices
+
+    matrixSize = pointCount+4 !! 4 extra space for constant and linear in 3D
+
+    allocate(dirichletMatrix(matrixSize,matrixSize))  
+    allocate(rhs(matrixSize))  
+    allocate(coeffs(matrixSize))  
+    allocate(pivotIndices(matrixSize))  
+
+    dirichletMatrix = 0.0
+    rhs = 0.0
+    coeffs = 0.0
+
+    call mpas_set_up_scalar_rbf_dirichlet_matrix_and_rhs(pointCount, sourcePoints, destinationPoint, &amp;
+      alpha, dirichletMatrix(1:pointCount,1:pointCount), rhs(1:pointCount))
+
+    do i = 1, pointCount
+      dirichletMatrix(i,pointCount+1) = 1.0
+      dirichletMatrix(i,pointCount+2:pointCount+4) = sourcePoints(i,1:3)
+      dirichletMatrix(pointCount+1:pointCount+4,i) &amp;
+        = dirichletMatrix(i,pointCount+1:pointCount+4)
+    end do
+
+    rhs(pointCount+1) = 1.0
+    rhs(pointCount+2:pointCount+4) = destinationPoint(1:3)
+
+    ! solve each linear system
+    call mpas_legs(dirichletMatrix, matrixSize, rhs, coeffs, pivotIndices)
+    coefficients = coeffs(1:pointCount)
+
+    deallocate(dirichletMatrix)  
+    deallocate(rhs)  
+    deallocate(coeffs)  
+    deallocate(pivotIndices) 
+
+  end subroutine mpas_rbf_interp_func_3D_sca_lin_dir_comp_coeffs
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Compute interpolation coefficients in 3D that can be used to
+  !  interpolate a number of scalar functions at a given locations. This is useful
+  !  if the interpolation location does not change with time, or if several
+  !  fields are to be interpolated at a given time step.  (If both the fields
+  !  and the interpolation locations vary with time, there is no clear advantage in
+  !  using either this method or the method for 2D interpoaltion above; for simplicity
+  !  and because we foresee more uses for the method of this subroutine, we have not
+  !  implemented a 3D version of the fixed field, variable interpolation location method
+  !  as we have in 2D.) Coefficients are produced for handling both Dirichlet and Neumann
+  !  boundary conditions.  The interpolation is performed with basis functions that are
+  !  RBFs plus a constant.
+  ! Input:
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
+  !    the function are known
+  !  isInterface - a logical array indicating which of the source points (if any) are at
+  !    at the domain interface.  These points and their normals will be used to compute the
+  !    neumannCoefficients below
+  !  interfaceNormals - a 3D normal vector for each sourcePoint.  These vectors are only used
+  !    at points where isInterface == .true., and can take arbitrary values elsewehere.  The
+  !    normal vector is used to compute coefficients for the normal derivative of the
+  !    interpolating function in order to impose the Neumann Boundary condition
+  !  destinationPoint - the point where the interpolation will be performed
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  ! Output:
+  !  dirichletCoefficients - the coefficients used to interpolate a function with Dirichlet
+  !    boundary conditions to the specified destinationPoint
+  !  neumannCoefficients - the coefficients used to interpolate a function with Neumann
+  !    boundary conditions to the specified destinationPoint
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_func_3D_sca_const_dir_neu_comp_coeffs( &amp;
+    pointCount, sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
+    alpha, dirichletCoefficients, neumannCoefficients)
+
+    integer, intent(in) :: pointCount
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
+    logical, dimension(pointCount), intent(in) :: isInterface
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals
+    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(pointCount), intent(out) :: &amp;
+      dirichletCoefficients, neumannCoefficients
+
+    integer :: i, j
+    integer :: matrixSize
+
+    real(kind=RKIND), dimension(:,:), pointer :: dirichletMatrix, neumannMatrix
+    real(kind=RKIND), dimension(:), pointer :: rhs, rhsCopy, coeffs
+    integer, dimension(:), pointer :: pivotIndices
+
+    matrixSize = pointCount+1 !! 1 extra space for constant 
+
+    allocate(dirichletMatrix(matrixSize,matrixSize))  
+    allocate(neumannMatrix(matrixSize,matrixSize))  
+    allocate(rhs(matrixSize))  
+    allocate(rhsCopy(matrixSize))  
+    allocate(coeffs(matrixSize))  
+    allocate(pivotIndices(matrixSize))  
+
+    dirichletMatrix = 0.0
+    neumannMatrix = 0.0
+    rhs = 0.0
+    rhsCopy = 0.0
+    coeffs = 0.0
+
+    call mpas_set_up_scalar_rbf_matrix_and_rhs(pointCount, &amp;
+      sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
+      alpha, dirichletMatrix(1:pointCount,1:pointCount), &amp;
+      neumannMatrix(1:pointCount,1:pointCount), rhs(1:pointCount))
+
+    do i = 1, pointCount
+      dirichletMatrix(i,pointCount+1) = 1.0
+      if(isInterface(i)) then
+        neumannMatrix(i,pointCount+1) = 0.0
+      else
+        neumannMatrix(i,pointCount+1) = dirichletMatrix(i,pointCount+1)
+      end if
+      dirichletMatrix(pointCount+1,i) = dirichletMatrix(i,pointCount+1)
+      neumannMatrix(pointCount+1,i) = neumannMatrix(i,pointCount+1)
+    end do
+
+    rhs(pointCount+1) = 1.0
+
+    ! solve each linear system
+    rhsCopy = rhs
+    call mpas_legs(dirichletMatrix, matrixSize, rhs, coeffs, pivotIndices)
+    dirichletCoefficients = coeffs(1:pointCount)
+
+    call mpas_legs(neumannMatrix, matrixSize, rhsCopy, coeffs, pivotIndices)
+    neumannCoefficients = coeffs(1:pointCount)
+
+    deallocate(dirichletMatrix)  
+    deallocate(neumannMatrix)  
+    deallocate(rhs)  
+    deallocate(rhsCopy)  
+    deallocate(coeffs)  
+    deallocate(pivotIndices) 
+
+  end subroutine mpas_rbf_interp_func_3D_sca_const_dir_neu_comp_coeffs
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Compute interpolation coefficients in a plane in 3D that can be used to
+  !  interpolate a number of scalar functions at a given locations. This is useful
+  !  if the interpolation location does not change with time, or if several
+  !  fields are to be interpolated at a given time step.  (If both the fields
+  !  and the interpolation locations vary with time, there is no clear advantage in
+  !  using either this method or the method for 2D interpoaltion above; for simplicity
+  !  and because we foresee more uses for the method of this subroutine, we have not
+  !  implemented a 3D version of the fixed field, variable interpolation location method
+  !  as we have in 2D.) Coefficients are produced for handling both Dirichlet and Neumann
+  !  boundary conditions.  The interpolation is performed with basis functions that are
+  !  RBFs plus constant and linear.  All points are projected into the plane given by the
+  !  planeBasisVectors.
+  ! Input:
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
+  !    the function are known.  The sourcePoints will be projected into the plane given by
+  !    planeBasisVectors
+  !  isInterface - a logical array indicating which of the source points (if any) are at
+  !    at the domain interface.  These points and their normals will be used to compute the
+  !    neumannCoefficients below
+  !  interfaceNormals - a 3D normal vector for each sourcePoint.  These vectors are only used
+  !    at points where isInterface == .true., and can take arbitrary values elsewehere.  The
+  !    normal vector is used to compute coefficients for the normal derivative of the
+  !    interpolating function in order to impose the Neumann Boundary condition
+  !  destinationPoint - the point in 3D where the interpolation will be performed.  The
+  !    destinationPoint will be projected into the plane given by planeBasisVectors.
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  !  planeBasisVectors - the basis fectors for the plane where interpolation is performed.
+  !    All points are projected into this plane. 
+  ! Output:
+  !  dirichletCoefficients - the coefficients used to interpolate a function with Dirichlet
+  !    boundary conditions to the specified destinationPoint
+  !  neumannCoefficients - the coefficients used to interpolate a function with Neumann
+  !    boundary conditions to the specified destinationPoint
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_func_3D_plane_sca_lin_dir_neu_comp_coeffs( &amp;
+    pointCount, sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
+    alpha, planeBasisVectors, dirichletCoefficients, neumannCoefficients)
+
+    integer, intent(in) :: pointCount
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
+    logical, dimension(pointCount), intent(in) :: isInterface
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals
+    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(2,3) :: planeBasisVectors
+    real(kind=RKIND), dimension(pointCount), intent(out) :: &amp;
+      dirichletCoefficients, neumannCoefficients
+
+    integer :: i, j
+    integer :: matrixSize
+
+    real(kind=RKIND), dimension(:,:), pointer :: dirichletMatrix, neumannMatrix
+    real(kind=RKIND), dimension(:), pointer :: rhs, rhsCopy, coeffs
+    integer, dimension(:), pointer :: pivotIndices
+
+    matrixSize = pointCount+3 !! 3 extra space for constant and 2 planar dimensions
+
+    allocate(dirichletMatrix(matrixSize,matrixSize))  
+    allocate(neumannMatrix(matrixSize,matrixSize))  
+    allocate(rhs(matrixSize))  
+    allocate(rhsCopy(matrixSize))  
+    allocate(coeffs(matrixSize))  
+    allocate(pivotIndices(matrixSize))  
+
+    dirichletMatrix = 0.0
+    neumannMatrix = 0.0
+    rhs = 0.0
+    rhsCopy = 0.0
+    coeffs = 0.0
+
+    call mpas_set_up_scalar_rbf_matrix_and_rhs(pointCount, &amp;
+      sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
+      alpha, dirichletMatrix(1:pointCount,1:pointCount), &amp;
+      neumannMatrix(1:pointCount,1:pointCount), rhs(1:pointCount))
+
+    do i = 1, pointCount
+      dirichletMatrix(i,pointCount+1) = 1.0
+      dirichletMatrix(i,pointCount+2) = sum(sourcePoints(i,1:3)*planeBasisVectors(1,:))
+      dirichletMatrix(i,pointCount+3) = sum(sourcePoints(i,1:3)*planeBasisVectors(2,:))
+      if(isInterface(i)) then
+        neumannMatrix(i,pointCount+1) = 0.0
+        neumannMatrix(i,pointCount+2) = sum(interfaceNormals(i,1:3)*planeBasisVectors(1,:))
+        neumannMatrix(i,pointCount+3) = sum(interfaceNormals(i,1:3)*planeBasisVectors(2,:))
+      else
+        neumannMatrix(i,pointCount+1:pointCount+3) &amp;
+          = dirichletMatrix(i,pointCount+1:pointCount+3)
+      end if
+      dirichletMatrix(pointCount+1:pointCount+3,i) &amp;
+        = dirichletMatrix(i,pointCount+1:pointCount+3)
+      neumannMatrix(pointCount+1:pointCount+3,i) &amp;
+        = neumannMatrix(i,pointCount+1:pointCount+3)
+    end do
+
+    rhs(pointCount+1) = 1.0
+    rhs(pointCount+2) = sum(destinationPoint(1:3)*planeBasisVectors(1,:))
+    rhs(pointCount+3) = sum(destinationPoint(1:3)*planeBasisVectors(2,:))
+
+    ! solve each linear system
+    rhsCopy = rhs
+    call mpas_legs(dirichletMatrix, matrixSize, rhs, coeffs, pivotIndices)
+    dirichletCoefficients = coeffs(1:pointCount)
+
+    call mpas_legs(neumannMatrix, matrixSize, rhsCopy, coeffs, pivotIndices)
+    neumannCoefficients = coeffs(1:pointCount)
+
+    deallocate(dirichletMatrix)  
+    deallocate(neumannMatrix)  
+    deallocate(rhs)  
+    deallocate(rhsCopy)  
+    deallocate(coeffs)  
+    deallocate(pivotIndices) 
+
+  end subroutine mpas_rbf_interp_func_3D_plane_sca_lin_dir_neu_comp_coeffs
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Compute interpolation coefficients in 3D that can be used to
+  !  interpolate a number of scalar functions at a given locations. This is useful
+  !  if the interpolation location does not change with time, or if several
+  !  fields are to be interpolated at a given time step.  (If both the fields
+  !  and the interpolation locations vary with time, there is no clear advantage in
+  !  using either this method or the method for 2D interpoaltion above; for simplicity
+  !  and because we foresee more uses for the method of this subroutine, we have not
+  !  implemented a 3D version of the fixed field, variable interpolation location method
+  !  as we have in 2D.) Coefficients are produced for handling both Dirichlet and Neumann
+  !  boundary conditions.  The interpolation is performed with basis functions that are
+  !  RBFs plus constant and linear.
+  ! Input:
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
+  !    the function are known
+  !  isInterface - a logical array indicating which of the source points (if any) are at
+  !    at the domain interface.  These points and their normals will be used to compute the
+  !    neumannCoefficients below
+  !  interfaceNormals - a 3D normal vector for each sourcePoint.  These vectors are only used
+  !    at points where isInterface == .true., and can take arbitrary values elsewehere.  The
+  !    normal vector is used to compute coefficients for the normal derivative of the
+  !    interpolating function in order to impose the Neumann Boundary condition
+  !  destinationPoint - the point where the interpolation will be performed
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  ! Output:
+  !  dirichletCoefficients - the coefficients used to interpolate a function with Dirichlet
+  !    boundary conditions to the specified destinationPoint
+  !  neumannCoefficients - the coefficients used to interpolate a function with Neumann
+  !    boundary conditions to the specified destinationPoint
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_func_3D_sca_lin_dir_neu_comp_coeffs(pointCount, &amp;
+    sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
+    alpha, dirichletCoefficients, neumannCoefficients)
+
+    integer, intent(in) :: pointCount
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
+    logical, dimension(pointCount), intent(in) :: isInterface
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals
+    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(pointCount), intent(out) :: &amp;
+      dirichletCoefficients, neumannCoefficients
+
+    integer :: i, j
+    integer :: matrixSize
+
+    real(kind=RKIND), dimension(:,:), pointer :: dirichletMatrix, neumannMatrix
+    real(kind=RKIND), dimension(:), pointer :: rhs, rhsCopy, coeffs
+    integer, dimension(:), pointer :: pivotIndices
+
+    matrixSize = pointCount+4 !! 4 extra space for constant and linear in 3D
+
+    allocate(dirichletMatrix(matrixSize,matrixSize))  
+    allocate(neumannMatrix(matrixSize,matrixSize))  
+    allocate(rhs(matrixSize))  
+    allocate(rhsCopy(matrixSize))  
+    allocate(coeffs(matrixSize))  
+    allocate(pivotIndices(matrixSize))  
+
+    dirichletMatrix = 0.0
+    neumannMatrix = 0.0
+    rhs = 0.0
+    rhsCopy = 0.0
+    coeffs = 0.0
+
+    call mpas_set_up_scalar_rbf_matrix_and_rhs(pointCount, &amp;
+      sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
+      alpha, dirichletMatrix(1:pointCount,1:pointCount), &amp;
+      neumannMatrix(1:pointCount,1:pointCount), rhs(1:pointCount))
+
+    do i = 1, pointCount
+      dirichletMatrix(i,pointCount+1) = 1.0
+      dirichletMatrix(i,pointCount+2:pointCount+4) = sourcePoints(i,1:3)
+      if(isInterface(i)) then
+        neumannMatrix(i,pointCount+1) = 0.0
+        neumannMatrix(i,pointCount+2:pointCount+4) = interfaceNormals(i,1:3)
+      else
+        neumannMatrix(i,pointCount+1:pointCount+4) &amp;
+          = dirichletMatrix(i,pointCount+1:pointCount+4)
+      end if
+      dirichletMatrix(pointCount+1:pointCount+4,i) &amp;
+        = dirichletMatrix(i,pointCount+1:pointCount+4)
+      neumannMatrix(pointCount+1:pointCount+4,i) &amp;
+        = neumannMatrix(i,pointCount+1:pointCount+4)
+    end do
+
+    rhs(pointCount+1) = 1.0
+    rhs(pointCount+2:pointCount+4) = destinationPoint(1:3)
+
+    ! solve each linear system
+    rhsCopy = rhs
+    call mpas_legs(dirichletMatrix, matrixSize, rhs, coeffs, pivotIndices)
+    dirichletCoefficients = coeffs(1:pointCount)
+
+    call mpas_legs(neumannMatrix, matrixSize, rhsCopy, coeffs, pivotIndices)
+    neumannCoefficients = coeffs(1:pointCount)
+
+    deallocate(dirichletMatrix)  
+    deallocate(neumannMatrix)  
+    deallocate(rhs)  
+    deallocate(rhsCopy)  
+    deallocate(coeffs)  
+    deallocate(pivotIndices) 
+
+  end subroutine mpas_rbf_interp_func_3D_sca_lin_dir_neu_comp_coeffs
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Compute interpolation coefficients in 3D that can be used to
+  !  interpolate a number of vector functions at a given locations. This is useful
+  !  if the interpolation location does not change with time, or if several
+  !  fields are to be interpolated at a given time step.  (If both the vector fields
+  !  and the interpolation locations vary with time, there is no clear advantage in
+  !  using either this method or the method for 2D interpoaltion above; for simplicity
+  !  and because we foresee more uses for the method of this subroutine, we have not
+  !  implemented a 3D version of the fixed field, variable interpolation location method
+  !  as we have in 2D.) Coefficients are produced for handling Dirichlet boundary
+  !  conditions (or no boundaries).  The interpolation is performed with basis functions
+  !  that are RBFs plus a constant.
+  ! Input:
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
+  !    the function are known
+  !  unitVectors - the unit vectors associated with each of the sourcePoints.  Interpolation
+  !    is performed by supplying the value of the vector function dotted into each of these unit
+  !    vectors.  If multiple unit vectors are supplied at the same sourcePoint, they *must* be
+  !    orthogonal for the interpolation to succeed.
+  !  destinationPoint - the point where the interpolation will be performed
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  ! Output:
+  !  coefficients - the coefficients used to interpolate a function with Dirichlet
+  !    boundary conditions to the specified destinationPoint
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_func_3D_vec_const_dir_comp_coeffs(pointCount, &amp;
+    sourcePoints, unitVectors, destinationPoint, &amp;
+    alpha, coefficients)
+
+    integer, intent(in) :: pointCount
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors
+    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients
+
+    integer :: i, j
+    integer :: matrixSize
+
+    real(kind=RKIND), dimension(:,:), pointer :: matrix, matrixCopy
+    real(kind=RKIND), dimension(:,:), pointer :: rhs, coeffs
+    integer, dimension(:), pointer :: pivotIndices
+
+    matrixSize = pointCount+3 ! extra space for constant vector 
+
+    allocate(matrix(matrixSize,matrixSize))  
+    allocate(matrixCopy(matrixSize,matrixSize))  
+    allocate(rhs(matrixSize,3))  
+    allocate(coeffs(matrixSize,3))  
+    allocate(pivotIndices(matrixSize))  
+
+    matrix = 0.0
+    rhs = 0.0
+    coeffs = 0.0
+
+    call mpas_set_up_vector_dirichlet_rbf_matrix_and_rhs(pointCount, 3, &amp;
+      sourcePoints, unitVectors, destinationPoint, &amp;
+      alpha, matrix(1:pointCount,1:pointCount), rhs(1:pointCount,:))
+
+    do i = 1, pointCount
+      matrix(i,pointCount+1:pointCount+3) = unitVectors(i,:)
+      matrix(pointCount+1:pointCount+3,i) &amp;
+        = matrix(i,pointCount+1:pointCount+3)
+    end do
+    do i = 1, 3
+      rhs(pointCount+i,i) = 1.0 ! the unit vector in the ith direction
+    end do
+
+    ! solve each linear system
+    do i = 1, 3
+      matrixCopy = matrix
+      call mpas_legs(matrixCopy, matrixSize, rhs(:,i), coeffs(:,i), pivotIndices)
+    end do
+    coefficients = coeffs(1:pointCount,:)
+
+    deallocate(matrix)  
+    deallocate(matrixCopy)  
+    deallocate(rhs)  
+    deallocate(coeffs)  
+    deallocate(pivotIndices) 
+
+  end subroutine mpas_rbf_interp_func_3D_vec_const_dir_comp_coeffs 
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Compute interpolation coefficients in 3D that can be used to
+  !  interpolate a number of vector functions at a given locations. This is useful
+  !  if the interpolation location does not change with time, or if several
+  !  fields are to be interpolated at a given time step.  (If both the vector fields
+  !  and the interpolation locations vary with time, there is no clear advantage in
+  !  using either this method or the method for 2D interpoaltion above; for simplicity
+  !  and because we foresee more uses for the method of this subroutine, we have not
+  !  implemented a 3D version of the fixed field, variable interpolation location method
+  !  as we have in 2D.) Coefficients are produced for handling Dirichlet boundary
+  !  conditions (or no boundaries).  The interpolation is performed with basis functions
+  !  that are RBFs plus a constant.
+  ! Input:
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
+  !    the function are known.  The sourcePoints are projected into the plane given by
+  !    planeBasisVectors
+  !  unitVectors - the unit vectors associated with each of the sourcePoints.  Interpolation
+  !    is performed by supplying the value of the vector function dotted into each of these unit
+  !    vectors.  If multiple unit vectors are supplied at the same sourcePoint, they *must* be
+  !    orthogonal for the interpolation to succeed.  The unitVectors are projected into the
+  !    plane given by planeBasisVectors
+  !  destinationPoint - the point where the interpolation will be performed.  The destinationPoint
+  !    is projected into the plane given by planeBasisVectors
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  !  planeBasisVectors - the basis fectors for the plane where interpolation is performed.
+  !    All points are projected into this plane. 
+  ! Output:
+  !  coefficients - the coefficients used to interpolate a function with Dirichlet
+  !    boundary conditions to the specified destinationPoint
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_func_3D_plane_vec_const_dir_comp_coeffs(pointCount, &amp;
+    sourcePoints, unitVectors, destinationPoint, &amp;
+    alpha, planeBasisVectors, coefficients)
+
+    integer, intent(in) :: pointCount
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors
+    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(2,3) :: planeBasisVectors
+    real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients
+
+    integer :: i, j
+    integer :: matrixSize
+
+    real(kind=RKIND) :: rSquared, rbfValue, unitVectorDotProduct
+
+    real(kind=RKIND), dimension(pointCount,2) :: planarSourcePoints
+    real(kind=RKIND), dimension(pointCount,2) :: planarUnitVectors
+    real(kind=RKIND), dimension(2) :: planarDestinationPoint
+
+    real(kind=RKIND), dimension(:,:), pointer :: matrix, matrixCopy
+    real(kind=RKIND), dimension(:,:), pointer :: rhs, coeffs
+    integer, dimension(:), pointer :: pivotIndices
+
+    matrixSize = pointCount+2 ! space for constant vector in plane
+
+    allocate(matrix(matrixSize,matrixSize))  
+    allocate(matrixCopy(matrixSize,matrixSize))  
+    allocate(rhs(matrixSize,2))  
+    allocate(coeffs(matrixSize,2))  
+    allocate(pivotIndices(matrixSize)) 
+
+    matrix = 0.0
+    rhs = 0.0
+    coeffs = 0.0
+
+    do i = 1, pointCount
+      planarSourcePoints(i,1) = sum(sourcePoints(i,:)*planeBasisVectors(1,:)) 
+      planarSourcePoints(i,2) = sum(sourcePoints(i,:)*planeBasisVectors(2,:)) 
+      planarUnitVectors(i,1) = sum(unitVectors(i,:)*planeBasisVectors(1,:)) 
+      planarUnitVectors(i,2) = sum(unitVectors(i,:)*planeBasisVectors(2,:)) 
+    end do
+    planarDestinationPoint(1) = sum(destinationPoint*planeBasisVectors(1,:)) 
+    planarDestinationPoint(2) = sum(destinationPoint*planeBasisVectors(2,:)) 
+
+    call mpas_set_up_vector_dirichlet_rbf_matrix_and_rhs(pointCount, 2, &amp;
+      planarSourcePoints, planarUnitVectors, planarDestinationPoint, &amp;
+      alpha, matrix(1:pointCount,1:pointCount), rhs(1:pointCount,:))
+
+    do i = 1, pointCount
+      matrix(i,pointCount+1:pointCount+2) = planarUnitVectors(i,:) 
+      matrix(pointCount+1:pointCount+2,i) = matrix(i,pointCount+1:pointCount+2)
+    end do
+    do i = 1,2 
+      rhs(pointCount+i,i) = 1.0 ! the unit vector in the ith direction
+    end do
+
+    ! solve each linear system
+    matrixCopy = matrix
+    call mpas_legs(matrix, matrixSize, rhs(:,1), coeffs(:,1), pivotIndices)
+    call mpas_legs(matrixCopy, matrixSize, rhs(:,2), coeffs(:,2), pivotIndices)
+
+
+    do i = 1,3 
+      coefficients(:,i) = planeBasisVectors(1,i)*coeffs(1:pointCount,1) &amp;
+        + planeBasisVectors(2,i)*coeffs(1:pointCount,2) 
+    end do
+
+    deallocate(matrix)  
+    deallocate(matrixCopy)  
+    deallocate(rhs)  
+    deallocate(coeffs)  
+    deallocate(pivotIndices)
+
+  end subroutine mpas_rbf_interp_func_3D_plane_vec_const_dir_comp_coeffs 
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Compute interpolation coefficients in 3D that can be used to
+  !  interpolate a number of vector functions at a given locations. This is useful
+  !  if the interpolation location does not change with time, or if several
+  !  fields are to be interpolated at a given time step.  (If both the vector fields
+  !  and the interpolation locations vary with time, there is no clear advantage in
+  !  using either this method or the method for 2D interpoaltion above; for simplicity
+  !  and because we foresee more uses for the method of this subroutine, we have not
+  !  implemented a 3D version of the fixed field, variable interpolation location method
+  !  as we have in 2D.) Coefficients are produced for handling Dirichlet normal /
+  !  Neumann tangential boundary conditions (such as free slip).  The interpolation is 
+  !  performed with basis functions that are RBFs plus a constant.
+  ! Input:
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
+  !    the function are known
+  !  isTangentToInterface - a logical array indicating which sourcePoints/unitVectors are
+  !    tangent to the interface where the boundary condition will be applied.  A Neumann
+  !    boundary condition will be applied at these points in these directions.
+  !  normalVectorIndex - where isTangentToInterface == .true., the index into unitVectors that
+  !    gives the normal vector at the same sourcePoint.  This information is needed to compute
+  !    the Neumann boundary condition at this point.
+  !  unitVectors - the unit vectors associated with each of the sourcePoints.  Interpolation
+  !    is performed by supplying the value of the vector function dotted into each of these unit
+  !    vectors.  If multiple unit vectors are supplied at the same sourcePoint, they *must* be
+  !    orthogonal for the interpolation to succeed.  A normal vector and two tangential vectors
+  !    are needed at each interface point in order to satisfy the Dirichlet normal boundary
+  !    condition and the Neumann tangential boundary conditions at these points.
+  !  destinationPoint - the point where the interpolation will be performed
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  ! Output:
+  !  coefficients - the coefficients used to interpolate a function with Dirichlet
+  !    boundary conditions to the specified destinationPoint
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_func_3D_vec_const_tan_neu_comp_coeffs(pointCount, &amp;
+    sourcePoints, isTangentToInterface, normalVectorIndex, unitVectors, destinationPoint, &amp;
+    alpha, coefficients)
+
+    integer, intent(in) :: pointCount
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
+    logical, dimension(pointCount), intent(in) :: isTangentToInterface
+    integer, dimension(pointCount), intent(in) :: normalVectorIndex
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors
+    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients
+
+    integer :: i, j
+    integer :: matrixSize
+
+    real(kind=RKIND), dimension(:,:), pointer :: matrix, matrixCopy
+    real(kind=RKIND), dimension(:,:), pointer :: rhs, coeffs
+    integer, dimension(:), pointer :: pivotIndices
+
+    matrixSize = pointCount+3 ! extra space for constant vector 
+
+    allocate(matrix(matrixSize,matrixSize))  
+    allocate(matrixCopy(matrixSize,matrixSize))  
+    allocate(rhs(matrixSize,3))  
+    allocate(coeffs(matrixSize,3))  
+    allocate(pivotIndices(matrixSize))  
+
+    matrix = 0.0
+    rhs = 0.0
+    coeffs = 0.0
+
+    call mpas_set_up_vector_free_slip_rbf_matrix_and_rhs(pointCount, 3, &amp;
+      sourcePoints, isTangentToInterface, normalVectorIndex, unitVectors, destinationPoint, &amp;
+      alpha, matrix(1:pointCount,1:pointCount), rhs(1:pointCount,:))
+
+    do i = 1, pointCount
+      matrix(pointCount+1:pointCount+3,i) = unitVectors(i,:)
+      if(.not. isTangentToInterface(i)) then
+        matrix(i,pointCount+1:pointCount+3) = matrix(pointCount+1:pointCount+3,i)
+      end if
+    end do
+    do i = 1, 3
+      rhs(pointCount+i,i) = 1.0 ! the unit vector in the ith direction
+    end do
+
+    ! solve each linear system
+    do i = 1, 3
+      matrixCopy = matrix
+      call mpas_legs(matrixCopy, matrixSize, rhs(:,i), coeffs(:,i), pivotIndices)
+    end do
+    coefficients = coeffs(1:pointCount,:)
+
+    deallocate(matrix)  
+    deallocate(matrixCopy)  
+    deallocate(rhs)  
+    deallocate(coeffs)  
+    deallocate(pivotIndices)
+
+  end subroutine mpas_rbf_interp_func_3D_vec_const_tan_neu_comp_coeffs 
+
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: Compute interpolation coefficients in 3D that can be used to
+  !  interpolate a number of vector functions at a given locations. This is useful
+  !  if the interpolation location does not change with time, or if several
+  !  fields are to be interpolated at a given time step.  (If both the vector fields
+  !  and the interpolation locations vary with time, there is no clear advantage in
+  !  using either this method or the method for 2D interpoaltion above; for simplicity
+  !  and because we foresee more uses for the method of this subroutine, we have not
+  !  implemented a 3D version of the fixed field, variable interpolation location method
+  !  as we have in 2D.) Coefficients are produced for handling Dirichlet normal /
+  !  Neumann tangential boundary conditions (such as free slip).  The interpolation is 
+  !  performed with basis functions that are RBFs plus a constant.
+  ! Input:
+  !  pointCount - the number of &quot;source&quot; points and functionValues supplied
+  !  sourcePoints - the location of the &quot;source&quot; points in the 3D space where the values of
+  !    the function are known.  The sourcePoints are projected into the plane given by
+  !    planeBasisVectors
+  !  isTangentToInterface - a logical array indicating which sourcePoints/unitVectors are
+  !    tangent to the interface where the boundary condition will be applied.  A Neumann
+  !    boundary condition will be applied at these points in these directions.
+  !  normalVectorIndex - where isTangentToInterface == .true., the index into unitVectors that
+  !    gives the normal vector at the same sourcePoint.  This information is needed to compute
+  !    the Neumann boundary condition at this point.
+  !  unitVectors - the unit vectors associated with each of the sourcePoints.  Interpolation
+  !    is performed by supplying the value of the vector function dotted into each of these unit
+  !    vectors.  If multiple unit vectors are supplied at the same sourcePoint, they *must* be
+  !    orthogonal for the interpolation to succeed.  A normal vector and two tangential vectors
+  !    are needed at each interface point in order to satisfy the Dirichlet normal boundary
+  !    condition and the Neumann tangential boundary conditions at these points. The unitVectors
+  !    are projected into the plane given by planeBasisVectors
+  !  destinationPoint - the point where the interpolation will be performed.  The destinationPoint
+  !    is projected into the plane given by planeBasisVectors
+  !  alpha - a constant that give the characteristic length scale of the RBFs,
+  !    should be on the order of the distance between points
+  !  planeBasisVectors - the basis fectors for the plane where interpolation is performed.
+  !    All points are projected into this plane. 
+  ! Output:
+  !  coefficients - the coefficients used to interpolate a function with Dirichlet
+  !    boundary conditions to the specified destinationPoint
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  subroutine mpas_rbf_interp_func_3D_plane_vec_const_tan_neu_comp_coeffs(&amp;
+    pointCount, sourcePoints, isTangentToInterface, normalVectorIndex, unitVectors, &amp;
+    destinationPoint, alpha, planeBasisVectors, coefficients)
+
+    integer, intent(in) :: pointCount
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
+    logical, dimension(pointCount), intent(in) :: isTangentToInterface
+    integer, dimension(pointCount), intent(in) :: normalVectorIndex
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: unitVectors
+    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(2,3), intent(in) :: planeBasisVectors
+    real(kind=RKIND), dimension(pointCount, 3), intent(out) :: coefficients
+
+    integer :: i, j
+    integer :: matrixSize
+
+    real(kind=RKIND), dimension(pointCount,2) :: planarSourcePoints
+    real(kind=RKIND), dimension(pointCount,2) :: planarUnitVectors
+    real(kind=RKIND), dimension(2) :: planarDestinationPoint
+
+    real(kind=RKIND), dimension(:,:), pointer :: matrix, matrixCopy
+    real(kind=RKIND), dimension(:,:), pointer :: rhs, coeffs
+    integer, dimension(:), pointer :: pivotIndices
+
+    matrixSize = pointCount+2 ! space for constant vector in plane
+
+    allocate(matrix(matrixSize,matrixSize))  
+    allocate(matrixCopy(matrixSize,matrixSize))  
+    allocate(rhs(matrixSize,2))  
+    allocate(coeffs(matrixSize,2))  
+    allocate(pivotIndices(matrixSize)) 
+
+    matrix = 0.0
+    rhs = 0.0
+    coeffs = 0.0
+
+    do i = 1, pointCount
+      planarSourcePoints(i,1) = sum(sourcePoints(i,:)*planeBasisVectors(1,:)) 
+      planarSourcePoints(i,2) = sum(sourcePoints(i,:)*planeBasisVectors(2,:)) 
+      planarUnitVectors(i,1) = sum(unitVectors(i,:)*planeBasisVectors(1,:)) 
+      planarUnitVectors(i,2) = sum(unitVectors(i,:)*planeBasisVectors(2,:)) 
+    end do
+    planarDestinationPoint(1) = sum(destinationPoint*planeBasisVectors(1,:)) 
+    planarDestinationPoint(2) = sum(destinationPoint*planeBasisVectors(2,:)) 
+    call mpas_set_up_vector_free_slip_rbf_matrix_and_rhs(pointCount, 2, &amp;
+      planarSourcePoints, isTangentToInterface, normalVectorIndex, planarUnitVectors, &amp;
+      planarDestinationPoint, alpha, matrix(1:pointCount,1:pointCount), rhs(1:pointCount,:))
+
+    do i = 1, pointCount
+      matrix(pointCount+1,i) = sum(unitVectors(i,:)*planeBasisVectors(1,:))
+      matrix(pointCount+2,i) = sum(unitVectors(i,:)*planeBasisVectors(2,:))
+      if(.not. isTangentToInterface(i)) then
+        matrix(i,pointCount+1:pointCount+2) = matrix(pointCount+1:pointCount+2,i)
+      end if
+    end do
+    do i = 1,2 
+      rhs(pointCount+i,i) = 1.0 ! the unit vector in the ith direction
+    end do
+
+    ! solve each linear system
+    matrixCopy = matrix
+    call mpas_legs(matrix, matrixSize, rhs(:,1), coeffs(:,1), pivotIndices)
+    call mpas_legs(matrixCopy, matrixSize, rhs(:,2), coeffs(:,2), pivotIndices)
+
+    coefficients(:,1) = planeBasisVectors(1,1)*coeffs(1:pointCount,1) &amp;
+      + planeBasisVectors(2,1)*coeffs(1:pointCount,2) 
+    coefficients(:,2) = planeBasisVectors(1,2)*coeffs(1:pointCount,1) &amp;
+      + planeBasisVectors(2,2)*coeffs(1:pointCount,2) 
+    coefficients(:,3) = planeBasisVectors(1,3)*coeffs(1:pointCount,1) &amp;
+      + planeBasisVectors(2,3)*coeffs(1:pointCount,2) 
+
+    deallocate(matrix)  
+    deallocate(matrixCopy)  
+    deallocate(rhs)  
+    deallocate(coeffs)  
+    deallocate(pivotIndices)
+
+   end subroutine mpas_rbf_interp_func_3D_plane_vec_const_tan_neu_comp_coeffs 
+
+
+!!!!!!!!!!!!!!!!!!!!!
+! private subroutines
+!!!!!!!!!!!!!!!!!!!!!
+
+  function evaluate_rbf(rSquared) result(rbfValue)
+    real(kind=RKIND), intent(in) :: rSquared
+    real(kind=RKIND) :: rbfValue
+
+    ! inverse multiquadratic
+    rbfValue = 1/sqrt(1 + rSquared)
+
+  end function evaluate_rbf
+
+  subroutine mpas_evaluate_rbf_and_deriv(rSquared, rbfValue, rbfDerivOverR)
+    real(kind=RKIND), intent(in) :: rSquared
+    real(kind=RKIND), intent(out) :: rbfValue, rbfDerivOverR
+
+    ! inverse multiquadratic
+    rbfValue = 1/sqrt(1 + rSquared)
+    rbfDerivOverR = -rbfValue**3
+
+  end subroutine mpas_evaluate_rbf_and_deriv
+
+  subroutine mpas_evaluate_rbf_and_derivs(rSquared, rbfValue, rbfDerivOverR, rbfSecondDeriv)
+    real(kind=RKIND), intent(in) :: rSquared
+    real(kind=RKIND), intent(out) :: rbfValue, rbfDerivOverR, rbfSecondDeriv
+
+    ! inverse multiquadratic
+    rbfValue = 1/sqrt(1 + rSquared)
+    rbfDerivOverR = -rbfValue**3
+    rbfSecondDeriv = (2*rSquared-1)*rbfValue**5
+
+  end subroutine mpas_evaluate_rbf_and_derivs
+
+  subroutine mpas_set_up_scalar_rbf_dirichlet_matrix_and_rhs(pointCount, sourcePoints, destinationPoint, &amp;
+    alpha, dirichletMatrix, rhs)
+
+    integer, intent(in) :: pointCount
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
+    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: dirichletMatrix
+    real(kind=RKIND), dimension(pointCount), intent(out) :: rhs
+
+    integer :: i, j
+
+    real(kind=RKIND) :: rSquared, rbfValue
+
+    do j = 1, pointCount
+      do i = 1, pointCount
+        rSquared = sum((sourcePoints(i,:)-sourcePoints(j,:))**2)/alpha**2
+        rbfValue = evaluate_rbf(rSquared)
+        dirichletMatrix(i,j) = rbfValue
+      end do
+    end do
+
+    do j = 1, pointCount
+      rSquared = sum((destinationPoint-sourcePoints(j,:))**2)/alpha**2
+      rhs(j) = evaluate_rbf(rSquared)
+    end do
+
+  end subroutine mpas_set_up_scalar_rbf_dirichlet_matrix_and_rhs
+
+  subroutine mpas_set_up_scalar_rbf_matrix_and_rhs(pointCount, &amp;
+    sourcePoints, isInterface, interfaceNormals, destinationPoint, &amp;
+    alpha, dirichletMatrix, neumannMatrix, rhs)
+
+    integer, intent(in) :: pointCount
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: sourcePoints
+    logical, dimension(pointCount), intent(in) :: isInterface
+    real(kind=RKIND), dimension(pointCount,3), intent(in) :: interfaceNormals
+    real(kind=RKIND), dimension(3), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: &amp;
+      dirichletMatrix, neumannMatrix
+    real(kind=RKIND), dimension(pointCount), intent(out) :: rhs
+
+    integer :: i, j
+
+    real(kind=RKIND) :: rSquared, rbfValue, rbfDerivOverR, normalDotX
+
+    do j = 1, pointCount
+      if(isInterface(j)) then
+        do i = 1, pointCount 
+          rSquared = sum((sourcePoints(i,:)-sourcePoints(j,:))**2)/alpha**2
+          normalDotX = sum(interfaceNormals(j,:) &amp;
+            * (sourcePoints(j,:)-sourcePoints(i,:)))
+          call mpas_evaluate_rbf_and_deriv(rSquared, rbfValue, rbfDerivOverR)
+          rbfDerivOverR = rbfDerivOverR/alpha**2
+          dirichletMatrix(i,j) = rbfValue
+          neumannMatrix(i,j) = rbfDerivOverR*normalDotX
+        end do
+      else
+        do i = 1, pointCount
+          rSquared = sum((sourcePoints(i,:)-sourcePoints(j,:))**2)/alpha**2
+          rbfValue = evaluate_rbf(rSquared)
+          dirichletMatrix(i,j) = rbfValue
+          neumannMatrix(i,j) = rbfValue
+        end do
+      end if
+    end do
+
+    do j = 1, pointCount
+      rSquared = sum((destinationPoint-sourcePoints(j,:))**2)/alpha**2
+      rhs(j) = evaluate_rbf(rSquared)
+    end do
+
+  end subroutine mpas_set_up_scalar_rbf_matrix_and_rhs
+
+  subroutine mpas_set_up_vector_dirichlet_rbf_matrix_and_rhs(pointCount, dimensions, &amp;
+    sourcePoints, unitVectors, destinationPoint, &amp;
+    alpha, matrix, rhs)
+
+    integer, intent(in) :: pointCount, dimensions
+    real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: sourcePoints
+    real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: unitVectors
+    real(kind=RKIND), dimension(dimensions), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: matrix
+    real(kind=RKIND), dimension(pointCount,dimensions), intent(out) :: rhs
+
+    integer :: i, j
+
+    real(kind=RKIND) :: rSquared, rbfValue, unitVectorDotProduct
+
+    do j = 1, pointCount
+      do i = j, pointCount
+        rSquared = sum((sourcePoints(i,:)-sourcePoints(j,:))**2)/alpha**2
+        rbfValue = evaluate_rbf(rSquared)
+        unitVectorDotProduct = sum(unitVectors(i,:)*unitVectors(j,:))
+        matrix(i,j) = rbfValue*unitVectorDotProduct
+        matrix(j,i) = matrix(i,j)
+      end do
+    end do
+
+    do j = 1, pointCount
+      rSquared = sum((destinationPoint-sourcePoints(j,:))**2)/alpha**2
+      rhs(j,:) = evaluate_rbf(rSquared)*unitVectors(j,:)
+    end do
+
+  end subroutine mpas_set_up_vector_dirichlet_rbf_matrix_and_rhs
+
+  subroutine mpas_set_up_vector_free_slip_rbf_matrix_and_rhs(pointCount, dimensions, &amp;
+    sourcePoints, isTangentToInterface, normalVectorIndex, unitVectors, destinationPoint, &amp;
+    alpha, matrix, rhs)
+
+    integer, intent(in) :: pointCount, dimensions
+    real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: sourcePoints
+    logical, dimension(pointCount), intent(in) :: isTangentToInterface
+    integer, dimension(pointCount), intent(in) :: normalVectorIndex
+    real(kind=RKIND), dimension(pointCount,dimensions), intent(in) :: unitVectors
+    real(kind=RKIND), dimension(dimensions), intent(in) :: destinationPoint
+    real(kind=RKIND), intent(in) :: alpha
+    real(kind=RKIND), dimension(pointCount,pointCount), intent(out) :: matrix
+    real(kind=RKIND), dimension(pointCount,dimensions), intent(out) :: rhs
+
+    integer :: i, j
+
+    real(kind=RKIND) :: rSquared, rbfValue, rbfDerivOverR, normalVector(dimensions), &amp;
+      normalDotX, unitVectorDotProduct
+
+    do j = 1, pointCount
+      if(isTangentToInterface(j)) then
+         do i = 1, pointCount
+          rSquared = sum((sourcePoints(i,:)-sourcePoints(j,:))**2)/alpha**2
+          normalVector = unitVectors(normalVectorIndex(j),:) 
+          normalDotX = sum(normalVector * (sourcePoints(j,:)-sourcePoints(i,:)))
+          call mpas_evaluate_rbf_and_deriv(rSquared, rbfValue, rbfDerivOverR)
+          rbfDerivOverR = rbfDerivOverR/alpha**2
+          unitVectorDotProduct = sum(unitVectors(i,:)*unitVectors(j,:))
+          matrix(i,j) = rbfDerivOverR*normalDotX*unitVectorDotProduct
+        end do
+      else
+        do i = 1, pointCount
+          rSquared = sum((sourcePoints(i,:)-sourcePoints(j,:))**2)/alpha**2
+          rbfValue = evaluate_rbf(rSquared)
+          unitVectorDotProduct = sum(unitVectors(i,:)*unitVectors(j,:))
+          matrix(i,j) = rbfValue*unitVectorDotProduct
+        end do
+      end if
+    end do
+
+    do j = 1, pointCount
+      rSquared = sum((destinationPoint-sourcePoints(j,:))**2)/alpha**2
+      rhs(j,:) = evaluate_rbf(rSquared)*unitVectors(j,:)
+    end do
+
+  end subroutine mpas_set_up_vector_free_slip_rbf_matrix_and_rhs
+
+  subroutine mpas_unit_vec_in_r3(xin)
+    implicit none
+    real (kind=RKIND), intent(inout) :: xin(3)
+    real (kind=RKIND) :: mag
+    mag = sqrt(xin(1)**2+xin(2)**2+xin(3)**2)
+    xin(:) = xin(:) / mag
+  end subroutine mpas_unit_vec_in_r3
+
+  subroutine mpas_cross_product_in_r3(p_1,p_2,p_out)
+    real (kind=RKIND), intent(in) :: p_1 (3), p_2 (3)
+    real (kind=RKIND), intent(out) :: p_out (3)
+
+    p_out(1) = p_1(2)*p_2(3)-p_1(3)*p_2(2)
+    p_out(2) = p_1(3)*p_2(1)-p_1(1)*p_2(3)
+    p_out(3) = p_1(1)*p_2(2)-p_1(2)*p_2(1)
+  end subroutine mpas_cross_product_in_r3
+
+! Updated 10/24/2001.
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!   Program 4.3   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!                                                                       !
+! Please Note:                                                          !
+!                                                                       !
+! (1) This computer program is written by Tao Pang in conjunction with  !
+!     his book, &quot;An Introduction to Computational Physics,&quot; published   !
+!     by Cambridge University Press in 1997.                            !
+!                                                                       !
+! (2) No warranties, express or implied, are made for this program.     !
+!                                                                       !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!PROGRAM EX43
+!
+!
+! An example of solving linear equation set A(N,N)*X(N) = B(N)
+! with the partial-pivoting Gaussian elimination scheme.  The
+! numerical values are for the Wheatstone bridge example discussed
+! in Section 4.1 in the book with all resistances being 100 ohms
+! and the voltage 200 volts.
+!
+!  IMPLICIT NONE
+!  INTEGER, PARAMETER :: N=3
+!  INTEGER :: I,J
+!  INTEGER, DIMENSION (N) :: INDX
+!  REAL, DIMENSION (N) :: X,B
+!  REAL, DIMENSION (N,N) :: A
+!  DATA B /200.0,0.0,0.0/, &amp;
+!       ((A(I,J), J=1,N),I=1,N) /100.0,100.0,100.0,-100.0, &amp;
+!                         300.0,-100.0,-100.0,-100.0, 300.0/
+!
+!  call mpas_legs (A,N,B,X,INDX)
+!
+!  WRITE (6, &quot;(F16.8)&quot;) (X(I), I=1,N)
+!END PROGRAM EX43
+
+
+subroutine mpas_legs (A,N,B,X,INDX)
+!
+! subroutine to solve the equation A(N,N)*X(N) = B(N) with the
+! partial-pivoting Gaussian elimination scheme.
+! Copyright (c) Tao Pang 2001.
+!
+  IMPLICIT NONE
+  integer, INTENT (IN) :: N
+  integer :: I,J
+  integer, INTENT (OUT), DIMENSION (N) :: INDX
+  real(kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
+  real(kind=RKIND), INTENT (INOUT), DIMENSION (N) :: B
+  real(kind=RKIND), INTENT (OUT), DIMENSION (N) :: X
+!
+  CALL elgs (A,N,INDX)
+!
+  DO I = 1, N-1
+    DO J = I+1, N
+      B(INDX(J)) = B(INDX(J))-A(INDX(J),I)*B(INDX(I))
+    END DO
+  END DO
+!
+  X(N) = B(INDX(N))/A(INDX(N),N)
+  DO I = N-1, 1, -1
+    X(I) = B(INDX(I))
+    DO J = I+1, N
+      X(I) = X(I)-A(INDX(I),J)*X(J)
+    END DO
+    X(I) =  X(I)/A(INDX(I),I)
+  END DO
+!
+END subroutine mpas_legs
+!
+
+
+
+! Updated 10/24/2001.
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!   Program 4.4   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!                                                                       !
+! Please Note:                                                          !
+!                                                                       !
+! (1) This computer program is written by Tao Pang in conjunction with  !
+!     his book, &quot;An Introduction to Computational Physics,&quot; published   !
+!     by Cambridge University Press in 1997.                            !
+!                                                                       !
+! (2) No warranties, express or implied, are made for this program.     !
+!                                                                       !
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+subroutine migs (A,N,X,INDX)
+!
+! subroutine to invert matrix A(N,N) with the inverse stored
+! in X(N,N) in the output.  Copyright (c) Tao Pang 2001.
+!
+  IMPLICIT NONE
+  integer, INTENT (IN) :: N
+  integer :: I,J,K
+  integer, INTENT (OUT), DIMENSION (N) :: INDX
+  real(kind=RKIND), INTENT (INOUT), DIMENSION (N,N):: A
+  real(kind=RKIND), INTENT (OUT), DIMENSION (N,N):: X
+  real(kind=RKIND), DIMENSION (N,N) :: B
+!
+  DO I = 1, N
+    DO J = 1, N
+      B(I,J) = 0.0
+    END DO
+  END DO
+  DO I = 1, N
+    B(I,I) = 1.0
+  END DO
+!
+  CALL elgs (A,N,INDX)
+!
+  DO I = 1, N-1
+    DO J = I+1, N
+      DO K = 1, N
+        B(INDX(J),K) = B(INDX(J),K)-A(INDX(J),I)*B(INDX(I),K)
+      END DO
+    END DO
+  END DO
+!
+  DO I = 1, N
+    X(N,I) = B(INDX(N),I)/A(INDX(N),N)
+    DO J = N-1, 1, -1
+      X(J,I) = B(INDX(J),I)
+      DO K = J+1, N
+        X(J,I) = X(J,I)-A(INDX(J),K)*X(K,I)
+      END DO
+      X(J,I) =  X(J,I)/A(INDX(J),J)
+    END DO
+  END DO
+END subroutine migs
+
+
+subroutine elgs (A,N,INDX)
+!
+! subroutine to perform the partial-pivoting Gaussian elimination.
+! A(N,N) is the original matrix in the input and transformed matrix
+! plus the pivoting element ratios below the diagonal in the output.
+! INDX(N) records the pivoting order.  Copyright (c) Tao Pang 2001.
+!
+  IMPLICIT NONE
+  integer, INTENT (IN) :: N
+  integer :: I,J,K,ITMP
+  integer, INTENT (OUT), DIMENSION (N) :: INDX
+  real(kind=RKIND) :: C1,PI,PI1,PJ
+  real(kind=RKIND), INTENT (INOUT), DIMENSION (N,N) :: A
+  real(kind=RKIND), DIMENSION (N) :: C
+!
+! Initialize the index
+!
+  DO I = 1, N
+    INDX(I) = I
+  END DO
+!
+! Find the rescaling factors, one from each row
+!
+  DO I = 1, N
+    C1= 0.0
+    DO J = 1, N
+      !C1 = AMAX1(C1,ABS(A(I,J)))
+      C1 = MAX(C1,ABS(A(I,J)))
+    END DO
+    C(I) = C1
+  END DO
+!
+! Search the pivoting (largest) element from each column
+!
+  DO J = 1, N-1
+    PI1 = 0.0
+    DO I = J, N
+      PI = ABS(A(INDX(I),J))/C(INDX(I))
+      IF (PI.GT.PI1) THEN
+        PI1 = PI
+        K   = I
+      ENDIF
+    END DO
+!
+! Interchange the rows via INDX(N) to record pivoting order
+!
+    ITMP    = INDX(J)
+    INDX(J) = INDX(K)
+    INDX(K) = ITMP
+    DO I = J+1, N
+      PJ  = A(INDX(I),J)/A(INDX(J),J)
+!
+! Record pivoting ratios below the diagonal
+!
+      A(INDX(I),J) = PJ
+!
+! Modify other elements accordingly
+!
+      DO K = J+1, N
+        A(INDX(I),K) = A(INDX(I),K)-PJ*A(INDX(J),K)
+      END DO
+    END DO
+  END DO
+!
+END subroutine elgs
+
+end module mpas_rbf_interpolation
+

Copied: branches/source_condensing/src/operators/mpas_spline_interpolation.F (from rev 1114, trunk/mpas/src/operators/mpas_spline_interpolation.F)
===================================================================
--- branches/source_condensing/src/operators/mpas_spline_interpolation.F                                (rev 0)
+++ branches/source_condensing/src/operators/mpas_spline_interpolation.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,430 @@
+module mpas_spline_interpolation
+
+  implicit none
+
+  private
+
+  public ::   mpas_cubic_spline_coefficients, &amp;
+              mpas_interpolate_cubic_spline, &amp;
+              mpas_integrate_cubic_spline, &amp;
+              mpas_integrate_column_cubic_spline, &amp;
+              mpas_interpolate_linear, &amp;
+              mpas_test_interpolate
+
+! Short Descriptions:
+
+!   mpas_cubic_spline_coefficients: Compute second derivatives at nodes.  
+!      This must be run before any of the other cubic spine functions.
+
+!   mpas_interpolate_cubic_spline: Compute cubic spline interpolation. 
+
+!   mpas_integrate_cubic_spline:  Compute a single integral from spline data.
+
+!   mpas_integrate_column_cubic_spline:  Compute multiple integrals from spline data.
+
+!   mpas_interpolate_linear:  Compute linear interpolation.
+
+!   mpas_test_interpolate:  Test spline interpolation subroutines.
+
+  contains
+
+ subroutine mpas_cubic_spline_coefficients(x,y,n,y2ndDer)  
+
+!  Given arrays x(1:n) and y(1:n) containing a function,
+!  i.e., y(i) = f(x(i)), with x monotonically increasing
+!  this routine returns an array y2ndDer(1:n) that contains 
+!  the second derivatives of the interpolating function at x(1:n). 
+!  This routine uses boundary conditions for a natural spline, 
+!  with zero second derivative on that boundary.
+
+! INPUT PARAMETERS:
+
+  integer, intent(in) :: &amp;
+    n     ! number of nodes
+  real(kind=RKIND), intent(in), dimension(n) :: &amp;
+    x,   &amp;! location of nodes
+    y     ! value at nodes
+
+! OUTPUT PARAMETERS:
+
+  real(kind=RKIND), intent(out), dimension(n) :: &amp;
+    y2ndDer    ! dy^2/dx^2 at each node
+
+!  local variables:
+
+  integer :: i
+  real(kind=RKIND) :: &amp;
+    temp,xRatio,a(n)  
+
+   y2ndDer(1)=0.0
+   y2ndDer(n)=0.0
+   a(1)=0.0
+
+   do i=2,n-1  
+      xRatio=(x(i)-x(i-1))/(x(i+1)-x(i-1))  
+      temp=1.0/(2.0+xRatio*y2ndDer(i-1))
+      y2ndDer(i)=temp*(xRatio-1.0)
+      a(i) = temp*(6.0*((y(i+1)-y(i))/(x(i+1)-x(i)) &amp;
+          -(y(i)-y(i-1))/(x(i)-x(i-1)))/(x(i+1)-x(i-1)) &amp;
+          -xRatio*a(i-1)) 
+   enddo
+
+   do i=n-1,1,-1  
+      y2ndDer(i)=y2ndDer(i)*y2ndDer(i+1)+a(i)  
+   enddo
+
+  end subroutine mpas_cubic_spline_coefficients
+
+
+  subroutine mpas_interpolate_cubic_spline( &amp;
+                x,y,y2ndDer,n, &amp;
+                xOut,yOut,nOut)  
+
+!  Given the arrays x(1:n) and y(1:n), which tabulate a function,
+!  and given the array y2ndDer(1:n), which is the output from 
+!  CubicSplineCoefficients above, this routine returns the 
+!  cubic-spline interpolated values of yOut(1:nOut) at xOut(1:nOut).
+!  This subroutine assumes that both x and xOut are monotonically
+!  increasing, and that all values of xOut are within the first and
+!  last values of x.
+
+! INPUT PARAMETERS:
+
+  real (kind=RKIND), dimension(n), intent(in) :: &amp;
+    x,         &amp;! node location, input grid
+    y,       &amp;! interpolation variable, input grid
+    y2ndDer     ! 2nd derivative of y at nodes
+
+  real (kind=RKIND), dimension(nOut), intent(in) :: &amp;
+    xOut          ! node location, output grid
+
+  integer, intent(in) :: &amp;
+    n,      &amp;! number of nodes, input grid
+    nOut       ! number of nodes, output grid
+
+! OUTPUT PARAMETERS:
+
+  real (kind=RKIND), dimension(nOut), intent(out) :: &amp;
+    yOut        ! interpolation variable, output grid
+
+!  local variables:
+
+  integer :: &amp;
+    kIn, kOut ! counters
+
+  real (kind=RKIND) :: &amp;
+    a, b, h
+
+  kOut = 1
+
+  kInLoop: do kIn = 1,n-1
+
+    h = x(kIn+1)-x(kIn)
+
+    do while(xOut(kOut) &lt; x(kIn+1)) 
+
+      a = (x(kIn+1)-xOut(kOut))/h  
+      b = (xOut(kOut)-x (kIn) )/h  
+      yOut(kOut) = a*y(kIn) + b*y(kIn+1) &amp;
+        + ((a**3-a)*y2ndDer(kIn) + (b**3-b)*y2ndDer(kIn+1)) &amp;
+         *(h**2)/6.0
+
+      kOut = kOut + 1
+
+      if (kOut&gt;nOut) exit kInLoop
+
+    enddo
+  
+  enddo kInLoop
+
+end subroutine mpas_interpolate_cubic_spline
+
+
+subroutine mpas_integrate_cubic_spline(x,y,y2ndDer,n,x1,x2,y_integral)  
+
+!  Given the arrays x(1:n) and y(1:n), which tabulate a function,
+!  and given the array y2ndDer(1:n), which is the output from 
+!  CubicSplineCoefficients above, this routine returns y_integral,
+!  the integral of y from x1 to x2.  The integration formula was 
+!  created by analytically integrating a cubic spline between each node.
+!  This subroutine assumes that x is monotonically increasing, and
+!  that x1 &lt; x2.
+
+! INPUT PARAMETERS:
+
+  integer, intent(in) :: &amp;
+    n     ! number of nodes
+  real(kind=RKIND), intent(in), dimension(n) :: &amp;
+    x,   &amp;! location of nodes
+    y,   &amp;! value at nodes
+    y2ndDer    ! dy^2/dx^2 at each node
+  real(kind=RKIND), intent(in) :: &amp;
+    x1,x2 ! limits of integration
+
+! OUTPUT PARAMETERS:
+
+  real(kind=RKIND), intent(out) :: &amp;
+    y_integral  ! integral of y
+
+!  local variables:
+  
+  integer :: i,j,k
+  real(kind=RKIND) :: h,h2, A2,B2, F1,F2, eps1
+
+  if (x1&lt;x(1).or.x2&gt;x(n).or.x1&gt;x2) then
+    print *, 'error on integration bounds'
+  endif
+
+  y_integral = 0.0
+  eps1 = 1e-14*x2
+
+  do j=1,n-1  ! loop through sections
+    ! section x(j) ... x(j+1)
+
+    if (x2&lt;=x(j)  +eps1) exit
+    if (x1&gt;=x(j+1)-eps1) cycle
+
+      h = x(j+1) - x(j)
+      h2 = h**2
+
+      ! left side:
+      if (x1&lt;x(j)) then
+        F1 = -y(j)*h*0.5 + y2ndDer(j)*h**3/24.0
+      else
+        A2 = (x(j+1)-x1  )**2/h2
+        B2 = (x1    -x(j))**2/h2
+        F1 = 0.5*h*( -y(j)*A2 + y(j+1)*B2 &amp;
+             + y2ndDer(j)  *h2*(-0.5*A2**2 + A2)/6.0 &amp;
+             + y2ndDer(j+1)*h2*( 0.5*B2**2 - B2)/6.0 )
+      endif
+
+      ! right side:
+      if (x2&gt;x(j+1)) then
+        F2 = y(j+1)*h*0.5 - y2ndDer(j+1)*h**3/24.0
+      else
+        A2 = (x(j+1)-x2  )**2/h2
+        B2 = (x2    -x(j))**2/h2
+        F2 = 0.5*h*( -y(j)*A2 + y(j+1)*B2 &amp;
+             + y2ndDer(j)  *h2*(-0.5*A2**2 + A2)/6.0 &amp;
+             + y2ndDer(j+1)*h2*( 0.5*B2**2 - B2)/6.0 )
+      endif
+
+      y_integral = y_integral + F2 - F1
+
+  enddo ! j
+
+  end subroutine mpas_integrate_cubic_spline
+
+
+  subroutine mpas_integrate_column_cubic_spline( &amp;
+               x,y,y2ndDer,n, &amp;
+               xOut,y_integral, nOut)  
+
+!  Given the arrays x(1:n) and y(1:n), which tabulate a function,
+!  and given the array y2ndDer(1:n), which is the output from 
+!  CubicSplineCoefficients above, this routine returns 
+!  y_integral(1:nOut), the integral of y.
+!  This is a cumulative integration, so that
+!  y_integral(j) holds the integral of y from x(1) to xOut(j).
+!  The integration formula was created by analytically integrating a 
+!  cubic spline between each node.
+!  This subroutine assumes that both x and xOut are monotonically
+!  increasing, and that all values of xOut are within the first and
+
+! INPUT PARAMETERS:
+
+  integer, intent(in) :: &amp;
+    n,   &amp;! number of nodes
+    nOut  ! number of output locations to compute integral
+  real(kind=RKIND), intent(in), dimension(n) :: &amp;
+    x,   &amp;! location of nodes
+    y,   &amp;! value at nodes
+    y2ndDer    ! dy^2/dx^2 at each node
+  real(kind=RKIND), dimension(nOut), intent(in) :: &amp;
+    xOut  ! output locations to compute integral
+
+! OUTPUT PARAMETERS:
+
+  real(kind=RKIND), dimension(nOut), intent(out) :: &amp;
+    y_integral  ! integral from 0 to xOut
+
+!  local variables:
+
+  integer :: i,j,k
+  real(kind=RKIND) :: h,h2, A2,B2, F1,F2, eps1
+
+  y_integral = 0.0
+  j = 1
+  h = x(j+1) - x(j)
+  h2 = h**2
+  F1 = -y(j)*h*0.5 + y2ndDer(j)*h**3/24.0
+  eps1 = 0.0 ! note: could use 1e-12*xOut(nOut)
+
+  k_loop: do k = 1,nOut
+
+    if (k&gt;1) y_integral(k) = y_integral(k-1)
+
+    do while(xOut(k) &gt; x(j+1)-eps1) 
+      F2 = y(j+1)*h*0.5 - y2ndDer(j+1)*h**3/24.0
+      
+      y_integral(k) = y_integral(k) + F2 - F1
+      j = j+1
+      h = x(j+1) - x(j)
+      h2 = h**2
+      F1 = -y(j)*h*0.5 + y2ndDer(j)*h**3/24.0
+      if (abs(xOut(k) - x(j+1))&lt;eps1) cycle k_loop
+    enddo
+
+    A2 = (x(j+1)  - xOut(k))**2/h2
+    B2 = (xOut(k) - x(j)   )**2/h2
+    F2 = 0.5*h*( -y(j)*A2 + y(j+1)*B2 &amp;
+             + y2ndDer(j)  *h2*(-0.5*A2**2 + A2)/6.0 &amp;
+             + y2ndDer(j+1)*h2*( 0.5*B2**2 - B2)/6.0 )
+
+    y_integral(k) = y_integral(k) + F2 - F1
+
+    if (k &lt; nOut) then
+      A2 = (x(j+1)  -xOut(k))**2/h2
+      B2 = (xOut(k) -x(j)   )**2/h2
+      F1 = 0.5*h*( -y(j)*A2 + y(j+1)*B2 &amp;
+             + y2ndDer(j)  *h2*(-0.5*A2**2 + A2)/6.0 &amp;
+             + y2ndDer(j+1)*h2*( 0.5*B2**2 - B2)/6.0 )
+    endif
+
+  enddo k_loop
+
+ end subroutine mpas_integrate_column_cubic_spline
+
+
+ subroutine mpas_interpolate_linear( &amp;
+                x,y,n, &amp;
+                xOut,yOut,nOut)  
+
+!  Given the arrays x(1:n) and y(1:n), which tabulate a function,
+!  this routine returns the linear interpolated values of yOut(1:nOut)
+!  at xOut(1:nOut).
+!  This subroutine assumes that both x and xOut are monotonically
+!  increasing, and that all values of xOut are within the first and
+!  last values of x.
+
+! !INPUT PARAMETERS:
+
+  real (kind=RKIND), dimension(n), intent(in) :: &amp;
+    x,         &amp;! node location, input grid
+    y         ! interpolation variable, input grid
+
+  real (kind=RKIND), dimension(nOut), intent(in) :: &amp;
+    xOut          ! node location, output grid
+
+  integer, intent(in) :: &amp;
+    N,      &amp;! number of nodes, input grid
+    NOut       ! number of nodes, output grid
+
+! !OUTPUT PARAMETERS:
+
+  real (kind=RKIND), dimension(nOut), intent(out) :: &amp;
+    yOut        ! interpolation variable, output grid
+
+!-----------------------------------------------------------------------
+!
+!  local variables
+!
+!-----------------------------------------------------------------------
+
+  integer :: &amp;
+    kIn, kOut ! counters
+
+  kOut = 1
+
+  kInLoop: do kIn = 1,n-1
+
+    do while(xOut(kOut) &lt; x(kIn+1)) 
+
+      yOut(kOut) = y(kIn)  &amp;
+        + (y(kIn+1)-y(kIn)) &amp;
+         /(x(kIn+1)  -x(kIn)  ) &amp;
+         *(xOut(kOut)  -x(kIn)  )
+
+      kOut = kOut + 1
+
+      if (kOut&gt;nOut) exit kInLoop
+
+    enddo
+  
+  enddo kInLoop
+
+  end subroutine mpas_interpolate_linear
+
+
+  subroutine mpas_test_interpolate
+
+!  Test function to show how to operate the cubic spline subroutines
+
+  integer, parameter :: &amp;
+    n = 10
+  real (kind=RKIND), dimension(n) :: &amp;
+    y, x, y2ndDer
+
+  integer, parameter :: &amp;
+    nOut = 100
+  real (kind=RKIND), dimension(nOut) :: &amp;
+    yOut, xOut
+
+  integer :: &amp;
+    k
+
+!-----------------------------------------------------------------------
+!
+!  Create x, y, xOut
+!
+!-----------------------------------------------------------------------
+
+   do k=1,n
+      x(k) = k-4
+      ! trig function:
+      y(k) = sin(x(k)/2)
+   enddo
+
+   do k=1,nOut
+      xOut(k) = x(1) + k/(nOut+1.0)*(x(n)-x(1))
+   enddo
+
+!-----------------------------------------------------------------------
+!
+!  Interpolate
+!
+!-----------------------------------------------------------------------
+
+   ! First, compute second derivative values at each node, y2ndDer.
+   call mpas_cubic_spline_coefficients(x,y,n,y2ndDer)
+
+   ! Compute interpolated values yOut.
+   call mpas_interpolate_cubic_spline( &amp;
+      x,y,y2ndDer,n, &amp;
+      xOut,yOut,nOut)
+
+   ! The following output can be copied directly into Matlab
+   print *, 'subplot(2,1,1)'
+   print '(a,10f8.4,a)', 'x = [',x,'];'
+   print '(a,10f8.4,a)', 'y = [',y,'];'
+   print '(a,100f8.4,a)', 'xOut = [',xOut,'];'
+   print '(a,100f8.4,a)', 'yOut = [',yOut,'];'
+   print *, &quot;plot(x,y,'-*r',xOut,yOut,'x')&quot;
+
+   ! Compute interpolated values yOut.
+   call mpas_integrate_column_cubic_spline( &amp;
+      x,y,y2ndDer,n, &amp;
+      xOut,yOut,nOut)  
+
+   ! The following output can be copied directly into Matlab
+   print *, 'subplot(2,1,2)'
+   print '(a,10f8.4,a)', 'x = [',x,'];'
+   print '(a,10f8.4,a)', 'y = 2*cos(-3/2) -2*cos(x/2);'
+   print '(a,100f8.4,a)', 'xOut = [',xOut,'];'
+   print '(a,100f8.4,a)', 'yOut = [',yOut,'];'
+   print *, &quot;plot(x,y,'-*r',xOut,yOut,'x')&quot;
+
+  end subroutine mpas_test_interpolate
+
+end module mpas_spline_interpolation
+

Copied: branches/source_condensing/src/operators/mpas_vector_reconstruction.F (from rev 1114, trunk/mpas/src/operators/mpas_vector_reconstruction.F)
===================================================================
--- branches/source_condensing/src/operators/mpas_vector_reconstruction.F                                (rev 0)
+++ branches/source_condensing/src/operators/mpas_vector_reconstruction.F        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,196 @@
+module mpas_vector_reconstruction
+
+  use mpas_grid_types
+  use mpas_configure
+  use mpas_constants
+  use mpas_rbf_interpolation
+
+  implicit none
+
+  public :: mpas_init_reconstruct, mpas_reconstruct
+
+  contains
+
+  subroutine mpas_init_reconstruct(grid)
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+  ! Purpose: pre-compute coefficients used by the reconstruct() routine
+  !
+  ! Input: grid meta data
+  !
+  ! Output: grid % coeffs_reconstruct - coefficients used to reconstruct 
+  !                                     velocity vectors at cell centers 
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
+
+    implicit none
+
+    type (mesh_type), intent(inout) :: grid 
+
+    ! temporary arrays needed in the (to be constructed) init procedure
+    integer :: nCellsSolve
+    integer, dimension(:,:), pointer :: edgesOnCell
+    integer, dimension(:), pointer :: nEdgesOnCell
+    integer :: i, iCell, iEdge, pointCount, maxEdgeCount
+    real (kind=RKIND), dimension(:), pointer :: xCell, yCell, zCell, xEdge, yEdge, zEdge
+    real (kind=RKIND) :: r, cellCenter(3), alpha, tangentPlane(2,3)
+    real (kind=RKIND), allocatable, dimension(:,:) :: edgeOnCellLocations, edgeOnCellNormals, &amp;
+      coeffs
+
+    real(kind=RKIND), dimension(:,:), pointer :: edgeNormalVectors
+    real(kind=RKIND), dimension(:,:,:), pointer :: cellTangentPlane
+
+    real (kind=RKIND), dimension(:,:,:), pointer :: coeffs_reconstruct
+
+    !========================================================
+    ! arrays filled and saved during init procedure
+    !========================================================
+    coeffs_reconstruct =&gt; grid % coeffs_reconstruct % array
+
+    !========================================================
+    ! temporary variables needed for init procedure
+    !========================================================
+    xCell       =&gt; grid % xCell % array
+    yCell       =&gt; grid % yCell % array
+    zCell       =&gt; grid % zCell % array
+    xEdge       =&gt; grid % xEdge % array
+    yEdge       =&gt; grid % yEdge % array
+    zEdge       =&gt; grid % zEdge % array
+    edgesOnCell =&gt; grid % edgesOnCell % array
+    nEdgesOnCell=&gt; grid % nEdgesOnCell % array
+    nCellsSolve = grid % nCellsSolve
+    edgeNormalVectors =&gt; grid % edgeNormalVectors % array
+    cellTangentPlane =&gt; grid % cellTangentPlane % array
+
+
+    ! init arrays
+    coeffs_reconstruct = 0.0
+
+    maxEdgeCount = maxval(nEdgesOnCell)
+
+    allocate(edgeOnCellLocations(maxEdgeCount,3))
+    allocate(edgeOnCellNormals(maxEdgeCount,3))
+    allocate(coeffs(maxEdgeCount,3))
+
+    ! loop over all cells to be solved on this block
+    do iCell=1,nCellsSolve
+      pointCount = nEdgesOnCell(iCell)
+      cellCenter(1) = xCell(iCell)
+      cellCenter(2) = yCell(iCell)
+      cellCenter(3) = zCell(iCell)
+
+      do i=1,pointCount
+        iEdge = edgesOnCell(i,iCell)
+        edgeOnCellLocations(i,1)  = xEdge(iEdge)
+        edgeOnCellLocations(i,2)  = yEdge(iEdge)
+        edgeOnCellLocations(i,3)  = zEdge(iEdge)
+        edgeOnCellNormals(i,:)  = edgeNormalVectors(:, iEdge)
+      end do
+
+      alpha = 0.0
+      do i=1,pointCount
+        r = sqrt(sum((cellCenter - edgeOnCellLocations(i,:))**2))
+        alpha = alpha + r
+      enddo
+      alpha = alpha/pointCount
+
+      tangentPlane(1,:) = cellTangentPlane(:,1,iCell)
+      tangentPlane(2,:) = cellTangentPlane(:,2,iCell)
+
+      call mpas_rbf_interp_func_3D_plane_vec_const_dir_comp_coeffs(pointCount, &amp;
+        edgeOnCellLocations(1:pointCount,:), &amp;
+        edgeOnCellNormals(1:pointCount,:), &amp;
+        cellCenter, alpha, tangentPlane, coeffs(1:pointCount,:))
+      
+      do i=1,pointCount
+        coeffs_reconstruct(:,i,iCell) = coeffs(i,:)
+      end do
+
+    enddo   ! iCell
+
+    deallocate(edgeOnCellLocations)
+    deallocate(edgeOnCellNormals)
+    deallocate(coeffs)
+
+  end subroutine mpas_init_reconstruct
+
+  subroutine mpas_reconstruct(grid, u, uReconstructX, uReconstructY, uReconstructZ, uReconstructZonal, uReconstructMeridional)
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  ! Purpose: reconstruct vector field at cell centers based on radial basis functions
+  !
+  ! Input: grid meta data and vector component data residing at cell edges
+  !
+  ! Output: reconstructed vector field (measured in X,Y,Z) located at cell centers
+  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+    implicit none
+
+    type (mesh_type), intent(in) :: grid
+    real (kind=RKIND), dimension(:,:), intent(in) :: u
+    real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructX, uReconstructY, uReconstructZ
+    real (kind=RKIND), dimension(:,:), intent(out) :: uReconstructZonal, uReconstructMeridional
+
+    !   temporary arrays needed in the compute procedure
+    integer :: nCellsSolve
+    integer, dimension(:,:), pointer :: edgesOnCell
+    integer, dimension(:), pointer :: nEdgesOnCell
+    integer :: iCell,iEdge, i
+    real(kind=RKIND), dimension(:), pointer :: latCell, lonCell
+
+    real (kind=RKIND), dimension(:,:,:), pointer :: coeffs_reconstruct
+
+    logical :: on_a_sphere
+
+    real (kind=RKIND) :: clat, slat, clon, slon
+
+
+    ! stored arrays used during compute procedure
+    coeffs_reconstruct =&gt; grid % coeffs_reconstruct % array
+
+    ! temporary variables
+    edgesOnCell =&gt; grid % edgesOnCell % array
+    nEdgesOnCell=&gt; grid % nEdgesOnCell % array
+    nCellsSolve = grid % nCellsSolve
+
+    latCell       =&gt; grid % latCell % array
+    lonCell       =&gt; grid % lonCell % array
+    on_a_sphere = grid % on_a_sphere
+
+    ! init the intent(out)
+    uReconstructX = 0.0
+    uReconstructY = 0.0
+    uReconstructZ = 0.0
+
+    ! loop over cell centers
+    do iCell=1,nCellsSolve
+      ! a more efficient reconstruction where rbf_values*matrix_reconstruct has been precomputed
+      ! in coeffs_reconstruct
+      do i=1,nEdgesOnCell(iCell)
+        iEdge = edgesOnCell(i,iCell)
+        uReconstructX(:,iCell) = uReconstructX(:,iCell) &amp;
+          + coeffs_reconstruct(1,i,iCell) * u(:,iEdge)
+        uReconstructY(:,iCell) = uReconstructY(:,iCell) &amp;
+          + coeffs_reconstruct(2,i,iCell) * u(:,iEdge)
+        uReconstructZ(:,iCell) = uReconstructZ(:,iCell) &amp;
+          + coeffs_reconstruct(3,i,iCell) * u(:,iEdge)
+
+      enddo
+    enddo   ! iCell
+
+    if(on_a_sphere) then
+      do iCell=1,nCellsSolve
+        clat = cos(latCell(iCell))
+        slat = sin(latCell(iCell))
+        clon = cos(lonCell(iCell))
+        slon = sin(lonCell(iCell))
+        uReconstructZonal(:,iCell) = -uReconstructX(:,iCell)*slon + uReconstructY(:,iCell)*clon
+        uReconstructMeridional(:,iCell) = -(uReconstructX(:,iCell)*clon &amp;
+          + uReconstructY(:,iCell)*slon)*slat &amp;
+          + uReconstructZ(:,iCell)*clat
+      end do
+    else
+      uReconstructZonal = uReconstructX
+      uReconstructMeridional = uReconstructY
+    end if
+
+  end subroutine mpas_reconstruct
+
+end module mpas_vector_reconstruction

Deleted: branches/source_condensing/src/registry/gen_inc.c
===================================================================
--- trunk/mpas/src/registry/gen_inc.c        2011-10-18 22:32:04 UTC (rev 1108)
+++ branches/source_condensing/src/registry/gen_inc.c        2011-10-21 19:22:38 UTC (rev 1115)
@@ -1,2190 +0,0 @@
-#include &lt;stdio.h&gt;
-#include &lt;stdlib.h&gt;
-#include &lt;string.h&gt;
-#include &quot;dictionary.h&quot;
-#include &quot;registry_types.h&quot;
-#include &quot;gen_inc.h&quot;
-#include &quot;fortprintf.h&quot;
-
-int is_derived_dim(char * d)
-{
-   if (strchr(d, (int)'+')) return 1;
-   if (strchr(d, (int)'-')) return 1;
-
-   return 0;
-}
-
-void split_derived_dim_string(char * dim, char ** p1, char ** p2)
-{
-   char * cp, * cm, * c;
-   int n;
-
-   cp = strchr(dim, (int)'+');
-   cm = strchr(dim, (int)'-');
-   if (!cp) 
-      c = cm;
-   else if (!cm) 
-      c = cp;
-   else if (cm &lt; cp) 
-      c = cm;
-   else 
-      c = cp;
-
-   n = c - dim;
-   *p1 = (char *)malloc(n*sizeof(char));
-   snprintf(*p1, n, &quot;%s&quot;, dim+1);
-
-   *p2 = (char *)malloc((strlen(dim)-n+1)*sizeof(char));
-   sprintf(*p2, &quot;%s&quot;, dim+n);
-}
-
-void gen_namelists(struct namelist * nls)
-{
-   struct namelist * nls_ptr;
-   struct dtable * dictionary;
-   int done;
-   char nlrecord[1024];
-   FILE * fd;
-
-   /*
-    *  Generate config_type.inc
-    */
-   fd = fopen(&quot;config_defs.inc&quot;, &quot;w&quot;);
-
-   nls_ptr = nls;
-   while (nls_ptr) {
-      if (nls_ptr-&gt;vtype == INTEGER)   fortprintf(fd, &quot;   integer :: %s</font>
<font color="red">&quot;,nls_ptr-&gt;name);
-      if (nls_ptr-&gt;vtype == REAL)      fortprintf(fd, &quot;   real (KIND=RKIND) :: %s</font>
<font color="red">&quot;,nls_ptr-&gt;name);
-      if (nls_ptr-&gt;vtype == LOGICAL)   fortprintf(fd, &quot;   logical :: %s</font>
<font color="red">&quot;,nls_ptr-&gt;name);
-      if (nls_ptr-&gt;vtype == CHARACTER) fortprintf(fd, &quot;   character (len=32) :: %s</font>
<font color="red">&quot;,nls_ptr-&gt;name);
-
-      nls_ptr = nls_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-
-   /*
-    *  Generate namelist_defs.inc
-    */
-   fd = fopen(&quot;config_namelist_defs.inc&quot;, &quot;w&quot;);
-   dict_alloc(&amp;dictionary);
-
-   done = 0;
-  
-   while (!done) {
-      nls_ptr = nls;
-      while (nls_ptr &amp;&amp; dict_search(dictionary, nls_ptr-&gt;record))
-         nls_ptr = nls_ptr-&gt;next;
-
-      if (nls_ptr) {
-         dict_insert(dictionary, nls_ptr-&gt;record);
-         strncpy(nlrecord, nls_ptr-&gt;record, 1024);
-         fortprintf(fd, &quot;      namelist /%s/ %s&quot;, nls_ptr-&gt;record, nls_ptr-&gt;name);
-         nls_ptr = nls_ptr-&gt;next;
-         while(nls_ptr) {
-            if (strncmp(nls_ptr-&gt;record, nlrecord, 1024) == 0)
-               fortprintf(fd, &quot;, &amp;</font>
<font color="red">                    %s&quot;, nls_ptr-&gt;name);
-            nls_ptr = nls_ptr-&gt;next;
-         }
-         fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-      }
-      else
-         done = 1;
-   }
-   
-
-   dict_free(&amp;dictionary);
-   fclose(fd);
-
-
-   /*
-    *  Generate namelist_reads.inc
-    */
-   fd = fopen(&quot;config_set_defaults.inc&quot;, &quot;w&quot;);
-   nls_ptr = nls;
-   while (nls_ptr) {
-      if (nls_ptr-&gt;vtype == INTEGER) fortprintf(fd, &quot;      %s = %i</font>
<font color="red">&quot;, nls_ptr-&gt;name, nls_ptr-&gt;defval.ival);
-      if (nls_ptr-&gt;vtype == REAL)    fortprintf(fd, &quot;      %s = %f</font>
<font color="red">&quot;, nls_ptr-&gt;name, nls_ptr-&gt;defval.rval);
-      if (nls_ptr-&gt;vtype == LOGICAL) {
-         if (nls_ptr-&gt;defval.lval == 0) 
-            fortprintf(fd, &quot;      %s = .false.</font>
<font color="red">&quot;, nls_ptr-&gt;name);
-         else
-            fortprintf(fd, &quot;      %s = .true.</font>
<font color="red">&quot;, nls_ptr-&gt;name);
-      }
-      if (nls_ptr-&gt;vtype == CHARACTER)
-         fortprintf(fd, &quot;      %s = \&quot;%s\&quot;</font>
<font color="red">&quot;, nls_ptr-&gt;name, nls_ptr-&gt;defval.cval);
-      nls_ptr = nls_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-   fclose(fd);
-
-
-   fd = fopen(&quot;config_namelist_reads.inc&quot;, &quot;w&quot;);
-   dict_alloc(&amp;dictionary);
-   nls_ptr = nls;
-   while (nls_ptr) {
-      if (!dict_search(dictionary, nls_ptr-&gt;record)) {
-         fortprintf(fd, &quot;         read(funit,%s)</font>
<font color="red">&quot;, nls_ptr-&gt;record);
-         dict_insert(dictionary, nls_ptr-&gt;record);
-      }
-      nls_ptr = nls_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-   dict_free(&amp;dictionary);
-   fclose(fd);
-
-
-   fd = fopen(&quot;config_bcast_namelist.inc&quot;, &quot;w&quot;);
-   nls_ptr = nls;
-   while (nls_ptr) {
-      if (nls_ptr-&gt;vtype == INTEGER)   fortprintf(fd, &quot;      call dmpar_bcast_int(dminfo, %s)</font>
<font color="red">&quot;, nls_ptr-&gt;name);
-      if (nls_ptr-&gt;vtype == REAL)      fortprintf(fd, &quot;      call dmpar_bcast_real(dminfo, %s)</font>
<font color="red">&quot;, nls_ptr-&gt;name);
-      if (nls_ptr-&gt;vtype == LOGICAL)   fortprintf(fd, &quot;      call dmpar_bcast_logical(dminfo, %s)</font>
<font color="red">&quot;, nls_ptr-&gt;name);
-      if (nls_ptr-&gt;vtype == CHARACTER) fortprintf(fd, &quot;      call dmpar_bcast_char(dminfo, %s)</font>
<font color="red">&quot;, nls_ptr-&gt;name);
-      nls_ptr = nls_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-   fclose(fd);
-}
-
-
-void gen_field_defs(struct group_list * groups, struct variable * vars, struct dimension * dims)
-{
-   struct variable * var_ptr;
-   struct variable * var_ptr2;
-   struct variable_list * var_list_ptr;
-   struct variable_list * var_list_ptr2;
-   struct dimension * dim_ptr;
-   struct dimension_list * dimlist_ptr;
-   struct group_list * group_ptr;
-   FILE * fd;
-   char super_array[1024];
-   char array_class[1024];
-   int i;
-   int class_start, class_end;
-   int vtype;
-
-
-   /*
-    *  Generate declarations of dimensions
-    */
-   fd = fopen(&quot;field_dimensions.inc&quot;, &quot;w&quot;);
-   dim_ptr = dims;
-   while (dim_ptr) {
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code);
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   dim_ptr = dims;
-   while (dim_ptr) {
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %sSolve</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code);
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %sSolve</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-
-   /*
-    *  Generate dummy dimension argument list
-    */
-   fd = fopen(&quot;dim_dummy_args.inc&quot;, &quot;w&quot;);
-   dim_ptr = dims;
-   if (dim_ptr &amp;&amp; dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
-      fortprintf(fd, &quot;                            %s&quot;, dim_ptr-&gt;name_in_code);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   else if (dim_ptr &amp;&amp; dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
-      fortprintf(fd, &quot;                            %s&quot;, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   while (dim_ptr) {
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;, %s&quot;, dim_ptr-&gt;name_in_code);
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;, %s&quot;, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot; &amp;</font>
<font color="red">&quot;);
-
-   fclose(fd);
-
-
-   /*
-    *  Generate dummy dimension argument declaration list
-    */
-   fd = fopen(&quot;dim_dummy_decls.inc&quot;, &quot;w&quot;);
-   dim_ptr = dims;
-   if (dim_ptr &amp;&amp; dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
-      fortprintf(fd, &quot;      integer, intent(in) :: %s&quot;, dim_ptr-&gt;name_in_code);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   else if (dim_ptr &amp;&amp; dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
-      fortprintf(fd, &quot;      integer, intent(in) :: %s&quot;, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   while (dim_ptr) {
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;, %s&quot;, dim_ptr-&gt;name_in_code);
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;, %s&quot;, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-   fclose(fd);
-
-
-   /*
-    *  Generate declarations of dimensions
-    */
-   fd = fopen(&quot;dim_decls.inc&quot;, &quot;w&quot;);
-   dim_ptr = dims;
-   while (dim_ptr) {
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code);
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-
-   /*
-    *  Generate calls to read dimensions from input file
-    */
-   fd = fopen(&quot;read_dims.inc&quot;, &quot;w&quot;);
-   dim_ptr = dims;
-   while (dim_ptr) {
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      call io_input_get_dimension(input_obj, \'%s\', %s)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
-      else if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      call io_input_get_dimension(input_obj, \'%s\', %s)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-
-   /*
-    *  Generate declarations of mesh group
-    */
-   fd = fopen(&quot;time_invariant_fields.inc&quot;, &quot;w&quot;);
-   group_ptr = groups;
-   while (group_ptr) {
-
-      if (!strncmp(group_ptr-&gt;name, &quot;mesh&quot;, 1024)) {
-
-         var_list_ptr = group_ptr-&gt;vlist;
-         memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
-         i = 1;
-         while (var_list_ptr) {
-            if (strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) != 0) {
-               memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
-               i = 1;
-             }
-            if (strncmp(var_list_ptr-&gt;var-&gt;array_class, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: index_%s = %i</font>
<font color="red">&quot;, var_list_ptr-&gt;var-&gt;name_in_code, i++);
-            var_list_ptr = var_list_ptr-&gt;next;
-         }
-
-         var_list_ptr = group_ptr-&gt;vlist;
-         memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
-         memcpy(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024);
-         class_start = 1;
-         class_end = 1;
-         i = 1;
-         while (var_list_ptr) {
-            if (strncmp(var_list_ptr-&gt;var-&gt;super_array, &quot;-&quot;, 1024) != 0) {
-               if (strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) != 0) {
-                  if (strncmp(super_array, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: %s_end = %i</font>
<font color="red">&quot;, array_class, class_end);
-                  if (strncmp(super_array, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: num_%s = %i</font>
<font color="red">&quot;, super_array, i);
-                  class_start = 1;
-                  class_end = 1;
-                  i = 1;
-                  memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
-                  memcpy(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024);
-                  fortprintf(fd, &quot;      integer :: %s_start = %i</font>
<font color="red">&quot;, array_class, class_start);
-               }
-               else if (strncmp(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024) != 0) {
-                  fortprintf(fd, &quot;      integer :: %s_end = %i</font>
<font color="red">&quot;, array_class, class_end);
-                  class_start = class_end+1;
-                  class_end = class_start;
-                  memcpy(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024);
-                  fortprintf(fd, &quot;      integer :: %s_start = %i</font>
<font color="red">&quot;, array_class, class_start);
-                  i++;
-               }
-               else {
-                  class_end++;
-                  i++;
-               }
-            }
-            var_list_ptr = var_list_ptr-&gt;next;
-         }
-         if (strncmp(super_array, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: %s_end = %i</font>
<font color="red">&quot;, array_class, class_end);
-         if (strncmp(super_array, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: num_%s = %i</font>
<font color="red">&quot;, super_array, i);
-
-         var_list_ptr = group_ptr-&gt;vlist;
-         while (var_list_ptr) {
-            var_ptr = var_list_ptr-&gt;var;
-            if (!strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024)) {
-              if (var_ptr-&gt;vtype == INTEGER)   fortprintf(fd, &quot;      type (field%idInteger), pointer :: %s</font>
<font color="red">&quot;, var_ptr-&gt;ndims, var_ptr-&gt;name_in_code);
-              if (var_ptr-&gt;vtype == REAL)      fortprintf(fd, &quot;      type (field%idReal), pointer :: %s</font>
<font color="red">&quot;, var_ptr-&gt;ndims, var_ptr-&gt;name_in_code);
-              if (var_ptr-&gt;vtype == CHARACTER) fortprintf(fd, &quot;      type (field%idChar), pointer :: %s</font>
<font color="red">&quot;, var_ptr-&gt;ndims, var_ptr-&gt;name_in_code);
-            }
-            else {
-              if (var_ptr-&gt;vtype == INTEGER)   fortprintf(fd, &quot;      type (field%idInteger), pointer :: %s</font>
<font color="red">&quot;, var_ptr-&gt;ndims+1, var_ptr-&gt;super_array);
-              if (var_ptr-&gt;vtype == REAL)      fortprintf(fd, &quot;      type (field%idReal), pointer :: %s</font>
<font color="red">&quot;, var_ptr-&gt;ndims+1, var_ptr-&gt;super_array);
-              if (var_ptr-&gt;vtype == CHARACTER) fortprintf(fd, &quot;      type (field%idChar), pointer :: %s</font>
<font color="red">&quot;, var_ptr-&gt;ndims+1, var_ptr-&gt;super_array);
-              while (var_list_ptr-&gt;next &amp;&amp; !strncmp(var_list_ptr-&gt;next-&gt;var-&gt;super_array, var_list_ptr-&gt;var-&gt;super_array, 1024)) var_list_ptr = var_list_ptr-&gt;next;
-            }
-            var_list_ptr = var_list_ptr-&gt;next;
-         }
-         break;
-      }
-      group_ptr = group_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-
-   /*
-    *  Generate declarations of non-mesh groups
-    */
-   fd = fopen(&quot;variable_groups.inc&quot;, &quot;w&quot;);
-
-   group_ptr = groups;
-   while (group_ptr) {
-      if (strncmp(group_ptr-&gt;name, &quot;mesh&quot;, 1024)) {
-         fortprintf(fd, &quot;   type %s_type</font>
<font color="red">&quot;, group_ptr-&gt;name);
-
-         var_list_ptr = group_ptr-&gt;vlist;
-         memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
-         i = 1;
-         while (var_list_ptr) {
-            if (strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) != 0) {
-               memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
-               i = 1;
-             }
-            if (strncmp(var_list_ptr-&gt;var-&gt;array_class, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: index_%s = %i</font>
<font color="red">&quot;, var_list_ptr-&gt;var-&gt;name_in_code, i++);
-            var_list_ptr = var_list_ptr-&gt;next;
-         }
-
-         var_list_ptr = group_ptr-&gt;vlist;
-         sprintf(super_array, &quot;-&quot;);
-         sprintf(array_class, &quot;-&quot;);
-         class_start = 1;
-         class_end = 1;
-         i = 1;
-
-         while (var_list_ptr) {
-
-            /* Is the current variable in a super array? */
-            if (strncmp(var_list_ptr-&gt;var-&gt;super_array, &quot;-&quot;, 1024) != 0) {
-
-               /* Have we hit the beginning of a new super array? */
-               if (strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) != 0) {
-                  /* Finish off the previous super array? */
-                  if (strncmp(super_array, &quot;-&quot;, 1024) != 0) {
-                     fortprintf(fd, &quot;      integer :: %s_end = %i</font>
<font color="red">&quot;, array_class, class_end);
-                     fortprintf(fd, &quot;      integer :: num_%s = %i</font>
<font color="red">&quot;, super_array, i);
-                  }
-                  class_start = 1;
-                  class_end = 1;
-                  i = 1;
-                  memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
-                  memcpy(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024);
-                  fortprintf(fd, &quot;      integer :: %s_start = %i</font>
<font color="red">&quot;, array_class, class_start);
-               }
-               /* Or have we hit the beginning of a new array class? */
-               else if (strncmp(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024) != 0) {
-                  fortprintf(fd, &quot;      integer :: %s_end = %i</font>
<font color="red">&quot;, array_class, class_end);
-                  class_start = class_end+1;
-                  class_end = class_start;
-                  memcpy(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024);
-                  fortprintf(fd, &quot;      integer :: %s_start = %i</font>
<font color="red">&quot;, array_class, class_start);
-                  i++;
-               }
-               else {
-                  class_end++;
-                  i++;
-               }
-
-            }
-            var_list_ptr = var_list_ptr-&gt;next;
-
-         }
-         if (strncmp(super_array, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: %s_end = %i</font>
<font color="red">&quot;, array_class, class_end);
-         if (strncmp(super_array, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: num_%s = %i</font>
<font color="red">&quot;, super_array, i);
-
-         var_list_ptr = group_ptr-&gt;vlist;
-         while (var_list_ptr) {
-            var_ptr = var_list_ptr-&gt;var;
-            if (!strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024)) {
-              if (var_ptr-&gt;vtype == INTEGER)   fortprintf(fd, &quot;      type (field%idInteger), pointer :: %s</font>
<font color="red">&quot;, var_ptr-&gt;ndims, var_ptr-&gt;name_in_code);
-              if (var_ptr-&gt;vtype == REAL)      fortprintf(fd, &quot;      type (field%idReal), pointer :: %s</font>
<font color="red">&quot;, var_ptr-&gt;ndims, var_ptr-&gt;name_in_code);
-              if (var_ptr-&gt;vtype == CHARACTER) fortprintf(fd, &quot;      type (field%idChar), pointer :: %s</font>
<font color="red">&quot;, var_ptr-&gt;ndims, var_ptr-&gt;name_in_code);
-            }
-            else {
-              if (var_ptr-&gt;vtype == INTEGER)   fortprintf(fd, &quot;      type (field%idInteger), pointer :: %s</font>
<font color="red">&quot;, var_ptr-&gt;ndims+1, var_ptr-&gt;super_array);
-              if (var_ptr-&gt;vtype == REAL)      fortprintf(fd, &quot;      type (field%idReal), pointer :: %s</font>
<font color="red">&quot;, var_ptr-&gt;ndims+1, var_ptr-&gt;super_array);
-              if (var_ptr-&gt;vtype == CHARACTER) fortprintf(fd, &quot;      type (field%idChar), pointer :: %s</font>
<font color="red">&quot;, var_ptr-&gt;ndims+1, var_ptr-&gt;super_array);
-              while (var_list_ptr-&gt;next &amp;&amp; !strncmp(var_list_ptr-&gt;next-&gt;var-&gt;super_array, var_list_ptr-&gt;var-&gt;super_array, 1024)) var_list_ptr = var_list_ptr-&gt;next;
-            }
-            var_list_ptr = var_list_ptr-&gt;next;
-         }
-   
-         fortprintf(fd, &quot;   end type %s_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="red">&quot;, group_ptr-&gt;name);
-   
-         if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1) {
-            fortprintf(fd, &quot;   type %s_pointer_type</font>
<font color="red">&quot;, group_ptr-&gt;name);
-            fortprintf(fd, &quot;      type (%s_type), pointer :: %s </font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-            fortprintf(fd, &quot;   end type %s_pointer_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="red">&quot;, group_ptr-&gt;name);
-   
-            fortprintf(fd, &quot;   type %s_multilevel_type</font>
<font color="red">&quot;, group_ptr-&gt;name);
-            fortprintf(fd, &quot;      integer :: nTimeLevels</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;      type (%s_pointer_type), dimension(:), pointer :: time_levs</font>
<font color="red">&quot;, group_ptr-&gt;name);
-            fortprintf(fd, &quot;   end type %s_multilevel_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="red">&quot;, group_ptr-&gt;name);
-         }
-   
-      }
-      group_ptr = group_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-   /*
-    *  Generate instantiations of variable groups in block_type
-    */
-   fd = fopen(&quot;block_group_members.inc&quot;, &quot;w&quot;);
-
-   group_ptr = groups;
-   while (group_ptr) {
-      if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1)
-         fortprintf(fd, &quot;      type (%s_multilevel_type), pointer :: %s</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-      else
-         fortprintf(fd, &quot;      type (%s_type), pointer :: %s</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-      group_ptr = group_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-
-   /* To be included in allocate_block */
-   fd = fopen(&quot;block_allocs.inc&quot;, &quot;w&quot;);
-   group_ptr = groups;
-   while (group_ptr) {
-      fortprintf(fd, &quot;      allocate(b %% %s)</font>
<font color="red">&quot;, group_ptr-&gt;name);
-      if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1) {
-         fortprintf(fd, &quot;      b %% %s %% nTimeLevels = %i</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs);
-         fortprintf(fd, &quot;      allocate(b %% %s %% time_levs(%i))</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs);
-         fortprintf(fd, &quot;      do i=1,b %% %s %% nTimeLevels</font>
<font color="red">&quot;, group_ptr-&gt;name);
-         fortprintf(fd, &quot;         allocate(b %% %s %% time_levs(i) %% %s)</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-         fortprintf(fd, &quot;         call allocate_%s(b %% %s %% time_levs(i) %% %s, &amp;</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name, group_ptr-&gt;name);
-         fortprintf(fd, &quot;#include \&quot;dim_dummy_args.inc\&quot;</font>
<font color="red">&quot;);
-         fortprintf(fd, &quot;                         )</font>
<font color="red">&quot;);
-         fortprintf(fd, &quot;      end do</font>
<font color="black"></font>
<font color="red">&quot;);
-      }
-      else {
-         fortprintf(fd, &quot;      call allocate_%s(b %% %s, &amp;</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-         fortprintf(fd, &quot;#include \&quot;dim_dummy_args.inc\&quot;</font>
<font color="red">&quot;);
-         fortprintf(fd, &quot;                      )</font>
<font color="black"></font>
<font color="red">&quot;);
-      }
-      group_ptr = group_ptr-&gt;next;
-   }
-   fclose(fd);
-
-   
-   /* To be included in deallocate_block */
-   fd = fopen(&quot;block_deallocs.inc&quot;, &quot;w&quot;);
-   group_ptr = groups;
-   while (group_ptr) {
-      if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1) {
-         fortprintf(fd, &quot;      do i=1,b %% %s %% nTimeLevels</font>
<font color="red">&quot;, group_ptr-&gt;name);
-         fortprintf(fd, &quot;         call deallocate_%s(b %% %s %% time_levs(i) %% %s)</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name, group_ptr-&gt;name);
-         fortprintf(fd, &quot;         deallocate(b %% %s %% time_levs(i) %% %s)</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-         fortprintf(fd, &quot;      end do</font>
<font color="red">&quot;);
-         fortprintf(fd, &quot;      deallocate(b %% %s %% time_levs)</font>
<font color="red">&quot;, group_ptr-&gt;name);
-      }
-      else {
-         fortprintf(fd, &quot;      call deallocate_%s(b %% %s)</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-      }
-      fortprintf(fd, &quot;      deallocate(b %% %s)</font>
<font color="black"></font>
<font color="red">&quot;, group_ptr-&gt;name);
-      group_ptr = group_ptr-&gt;next;
-   }
-   fclose(fd);
-
-   /* Definitions of allocate subroutines */
-   fd = fopen(&quot;group_alloc_routines.inc&quot;, &quot;w&quot;);
-   group_ptr = groups;
-   while (group_ptr) {
-      fortprintf(fd, &quot;   subroutine allocate_%s(%s, &amp;</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-      fortprintf(fd, &quot;#include \&quot;dim_dummy_args.inc\&quot;</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;                         )</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;      implicit none</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;      type (%s_type), intent(inout) :: %s</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-      fortprintf(fd, &quot;#include \&quot;dim_dummy_decls.inc\&quot;</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-      if (!strncmp(group_ptr-&gt;name, &quot;mesh&quot;, 1024)) {
-         dim_ptr = dims;
-         while (dim_ptr) {
-            if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      %s %% %s = %s</font>
<font color="red">&quot;, group_ptr-&gt;name, dim_ptr-&gt;name_in_code, dim_ptr-&gt;name_in_code);
-            if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      %s %% %s = %s</font>
<font color="red">&quot;, group_ptr-&gt;name, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
-            dim_ptr = dim_ptr-&gt;next;
-         }
-         fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-      }
-
-
-      var_list_ptr = group_ptr-&gt;vlist;
-      while (var_list_ptr) {
-         var_ptr = var_list_ptr-&gt;var;
-         if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
-            memcpy(super_array, var_ptr-&gt;super_array, 1024);
-            memcpy(array_class, var_ptr-&gt;array_class, 1024);
-            i = 0;
-            while (var_list_ptr &amp;&amp; strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) == 0) {
-               i++;
-               var_list_ptr2 = var_list_ptr;
-               var_list_ptr = var_list_ptr-&gt;next;
-            }
-            var_ptr2 = var_list_ptr2-&gt;var;
-            fortprintf(fd, &quot;      allocate(%s %% %s)</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
-            fortprintf(fd, &quot;      allocate(%s %% %s %% ioinfo)</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
-            fortprintf(fd, &quot;      allocate(%s %% %s %% array(%i, &quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array, i);
-            dimlist_ptr = var_ptr2-&gt;dimlist;
-            if (!strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nCells&quot;, 1024) ||
-                !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nEdges&quot;, 1024) ||
-                !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nVertices&quot;, 1024))
-               if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;%s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-               else fortprintf(fd, &quot;%s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-            else
-               if (dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-               else fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-            dimlist_ptr = dimlist_ptr-&gt;next;
-            while (dimlist_ptr) {
-               if (!strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nCells&quot;, 1024) ||
-                   !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nEdges&quot;, 1024) ||
-                   !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nVertices&quot;, 1024))
-                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, %s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                  else fortprintf(fd, &quot;, %s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-               else
-                  if (dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  else fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-               dimlist_ptr = dimlist_ptr-&gt;next;
-            }
-            fortprintf(fd, &quot;))</font>
<font color="red">&quot;);
-            if (var_ptr-&gt;vtype == INTEGER)
-               fortprintf(fd, &quot;      %s %% %s %% array = 0</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array ); /* initialize field to zero */
-            else if (var_ptr-&gt;vtype == REAL)
-               fortprintf(fd, &quot;      %s %% %s %% array = 0.0</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array ); /* initialize field to zero */
-            else if (var_ptr-&gt;vtype == CHARACTER)
-               fortprintf(fd, &quot;      %s %% %s %% array = \'\'</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array ); /* initialize field to zero */
-
-            if (var_ptr2-&gt;iostreams &amp; INPUT0) 
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% input = .true.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
-            else
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% input = .false.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
-
-            if (var_ptr2-&gt;iostreams &amp; SFC0) 
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% sfc = .true.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
-            else
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% sfc = .false.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
-
-            if (var_ptr2-&gt;iostreams &amp; RESTART0) 
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
-            else
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
-
-            if (var_ptr2-&gt;iostreams &amp; OUTPUT0) 
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% output = .true.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
-            else
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% output = .false.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
-            fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         }
-         else {
-            fortprintf(fd, &quot;      allocate(%s %% %s)</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;      allocate(%s %% %s %% ioinfo)</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-            if (var_ptr-&gt;ndims &gt; 0) {
-               fortprintf(fd, &quot;      allocate(%s %% %s %% array(&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-               dimlist_ptr = var_ptr-&gt;dimlist;
-               if (!strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nCells&quot;, 1024) ||
-                   !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nEdges&quot;, 1024) ||
-                   !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nVertices&quot;, 1024))
-                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;%s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                  else fortprintf(fd, &quot;%s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-               else
-                  if (dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  else fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-               dimlist_ptr = dimlist_ptr-&gt;next;
-               while (dimlist_ptr) {
-                  if (!strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nCells&quot;, 1024) ||
-                      !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nEdges&quot;, 1024) ||
-                      !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nVertices&quot;, 1024))
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, %s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                     else fortprintf(fd, &quot;, %s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  else
-                     if (dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                     else fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                  dimlist_ptr = dimlist_ptr-&gt;next;
-               }
-               fortprintf(fd, &quot;))</font>
<font color="red">&quot;);
-               if (var_ptr-&gt;vtype == INTEGER)
-                  fortprintf(fd, &quot;      %s %% %s %% array = 0</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code ); /* initialize field to zero */
-               else if (var_ptr-&gt;vtype == REAL)
-                  fortprintf(fd, &quot;      %s %% %s %% array = 0.0</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code ); /* initialize field to zero */
-               else if (var_ptr-&gt;vtype == CHARACTER)
-                  fortprintf(fd, &quot;      %s %% %s %% array = \'\'</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code ); /* initialize field to zero */
-
-            }
-            if (var_ptr-&gt;iostreams &amp; INPUT0) 
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% input = .true.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-            else
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% input = .false.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-
-            if (var_ptr-&gt;iostreams &amp; SFC0) 
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% sfc = .true.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-            else
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% sfc = .false.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-
-            if (var_ptr-&gt;iostreams &amp; RESTART0) 
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% restart = .true.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-            else
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% restart = .false.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-
-            if (var_ptr-&gt;iostreams &amp; OUTPUT0) 
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% output = .true.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-            else
-               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% output = .false.</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-            var_list_ptr = var_list_ptr-&gt;next;
-         }
-      }
-
-      fortprintf(fd, &quot;   end subroutine allocate_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="red">&quot;, group_ptr-&gt;name);
-      group_ptr = group_ptr-&gt;next;
-   }
-   fclose(fd);
-   
-   /* Definitions of deallocate subroutines */
-   fd = fopen(&quot;group_dealloc_routines.inc&quot;, &quot;w&quot;);
-   group_ptr = groups;
-   while (group_ptr) {
-      fortprintf(fd, &quot;   subroutine deallocate_%s(%s)</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-      fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;      implicit none</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;      type (%s_type), intent(inout) :: %s</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-      fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-      var_list_ptr = group_ptr-&gt;vlist;
-      while (var_list_ptr) {
-         var_ptr = var_list_ptr-&gt;var;
-         if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
-            memcpy(super_array, var_ptr-&gt;super_array, 1024);
-            memcpy(array_class, var_ptr-&gt;array_class, 1024);
-            i = 0;
-            while (var_list_ptr &amp;&amp; strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) == 0) {
-               i++;
-               var_list_ptr2 = var_list_ptr;
-               var_list_ptr = var_list_ptr-&gt;next;
-            }
-            fortprintf(fd, &quot;      deallocate(%s %% %s %% array)</font>
<font color="red">&quot;, group_ptr-&gt;name, var_list_ptr2-&gt;var-&gt;super_array);
-            fortprintf(fd, &quot;      deallocate(%s %% %s %% ioinfo)</font>
<font color="red">&quot;, group_ptr-&gt;name, var_list_ptr2-&gt;var-&gt;super_array);
-            fortprintf(fd, &quot;      deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="red">&quot;, group_ptr-&gt;name, var_list_ptr2-&gt;var-&gt;super_array);
-         }
-         else {
-            if (var_ptr-&gt;ndims &gt; 0) {
-               fortprintf(fd, &quot;      deallocate(%s %% %s %% array)</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-               fortprintf(fd, &quot;      deallocate(%s %% %s %% ioinfo)</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-               fortprintf(fd, &quot;      deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-            }
-            else {
-               fortprintf(fd, &quot;      deallocate(%s %% %s %% ioinfo)</font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-               fortprintf(fd, &quot;      deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="red">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
-            }
-            var_list_ptr = var_list_ptr-&gt;next;
-         }
-      }
-
-      fortprintf(fd, &quot;   end subroutine deallocate_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="red">&quot;, group_ptr-&gt;name);
-      group_ptr = group_ptr-&gt;next;
-   }
-   fclose(fd);
-
-   /* Definitions of copy subroutines */
-   fd = fopen(&quot;group_copy_routines.inc&quot;, &quot;w&quot;);
-   group_ptr = groups;
-   while (group_ptr) {
-      fortprintf(fd, &quot;   subroutine copy_%s(dest, src)</font>
<font color="red">&quot;, group_ptr-&gt;name);
-      fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;      implicit none</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;      type (%s_type), intent(in) :: src</font>
<font color="red">&quot;, group_ptr-&gt;name);
-      fortprintf(fd, &quot;      type (%s_type), intent(inout) :: dest</font>
<font color="red">&quot;, group_ptr-&gt;name);
-      fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-      var_list_ptr = group_ptr-&gt;vlist;
-      while (var_list_ptr) {
-         var_ptr = var_list_ptr-&gt;var;
-         if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
-            memcpy(super_array, var_ptr-&gt;super_array, 1024);
-            memcpy(array_class, var_ptr-&gt;array_class, 1024);
-            i = 0;
-            while (var_list_ptr &amp;&amp; strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) == 0) {
-               i++;
-               var_list_ptr2 = var_list_ptr;
-               var_list_ptr = var_list_ptr-&gt;next;
-            }
-            var_ptr2 = var_list_ptr2-&gt;var;
-            if (var_ptr2-&gt;ndims &gt; 0) 
-               fortprintf(fd, &quot;      dest %% %s %% array = src %% %s %% array</font>
<font color="red">&quot;, var_ptr2-&gt;super_array, var_ptr2-&gt;super_array);
-            else
-               fortprintf(fd, &quot;      dest %% %s %% scalar = src %% %s %% scalar</font>
<font color="red">&quot;, var_ptr2-&gt;super_array, var_ptr2-&gt;super_array);
-         }
-         else {
-            if (var_ptr-&gt;ndims &gt; 0) 
-               fortprintf(fd, &quot;      dest %% %s %% array = src %% %s %% array</font>
<font color="red">&quot;, var_ptr-&gt;name_in_code, var_ptr-&gt;name_in_code);
-            else
-               fortprintf(fd, &quot;      dest %% %s %% scalar = src %% %s %% scalar</font>
<font color="red">&quot;, var_ptr-&gt;name_in_code, var_ptr-&gt;name_in_code);
-            var_list_ptr = var_list_ptr-&gt;next;
-         }
-      }
-      fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;   end subroutine copy_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="red">&quot;, group_ptr-&gt;name);
-      group_ptr = group_ptr-&gt;next;
-   }
-   fclose(fd);
-
-   /* Definitions of shift_time_level subroutines */
-   fd = fopen(&quot;group_shift_level_routines.inc&quot;, &quot;w&quot;);
-   group_ptr = groups;
-   while (group_ptr) {
-      if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1) {
-         fortprintf(fd, &quot;   subroutine shift_time_levels_%s(%s)</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-         fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         fortprintf(fd, &quot;      implicit none</font>
<font color="red">&quot;);
-         fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         fortprintf(fd, &quot;      type (%s_multilevel_type), intent(inout) :: %s</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-         fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         fortprintf(fd, &quot;      integer :: i</font>
<font color="red">&quot;);
-         fortprintf(fd, &quot;      type (%s_type), pointer :: sptr</font>
<font color="red">&quot;, group_ptr-&gt;name);
-         fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         fortprintf(fd, &quot;      sptr =&gt; %s %% time_levs(1) %% %s</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-         fortprintf(fd, &quot;      do i=1,%s %% nTimeLevels-1</font>
<font color="red">&quot;, group_ptr-&gt;name);
-         fortprintf(fd, &quot;         %s %% time_levs(i) %% %s =&gt; %s %% time_levs(i+1) %% %s</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name, group_ptr-&gt;name, group_ptr-&gt;name);
-         fortprintf(fd, &quot;      end do</font>
<font color="red">&quot;);
-         fortprintf(fd, &quot;      %s %% time_levs(%s %% nTimeLevels) %% %s =&gt; sptr</font>
<font color="red">&quot;, group_ptr-&gt;name, group_ptr-&gt;name, group_ptr-&gt;name);
-         fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         fortprintf(fd, &quot;   end subroutine shift_time_levels_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="red">&quot;, group_ptr-&gt;name);
-      }
-      group_ptr = group_ptr-&gt;next;
-   }
-   fclose(fd);

-}
-
-
-void gen_reads(struct group_list * groups, struct variable * vars, struct dimension * dims)
-{
-   struct variable * var_ptr;
-   struct variable_list * var_list_ptr;
-   struct dimension * dim_ptr;
-   struct dimension_list * dimlist_ptr, * lastdim;
-   struct group_list * group_ptr;
-   struct dtable * dictionary;
-   FILE * fd;
-   char vtype[5];
-   char fname[32];
-   char struct_deref[1024];
-   char * cp1, * cp2;
-   int i, j;
-   int ivtype;
-
-
-   /*
-    *  Generate declarations of IDs belonging in io_input_object
-    */
-   fd = fopen(&quot;io_input_obj_decls.inc&quot;, &quot;w&quot;);
-
-   fortprintf(fd, &quot;      integer :: rdDimIDTime</font>
<font color="red">&quot;);
-   dim_ptr = dims;
-   while (dim_ptr) {
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: rdDimID%s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-   fortprintf(fd, &quot;      integer :: rdLocalTime</font>
<font color="red">&quot;);
-   dim_ptr = dims;
-   while (dim_ptr) {
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: rdLocal%s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-   var_ptr = vars;
-   while (var_ptr) {
-      fortprintf(fd, &quot;      integer :: rdVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-      var_ptr = var_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-   /*
-    *  Definitions of read bounds and exchange lists for non-decomposed fields
-    */
-   fd = fopen(&quot;nondecomp_dims.inc&quot;, &quot;w&quot;);
-
-   dim_ptr = dims;
-   while (dim_ptr) {
-
-      if (strncmp(dim_ptr-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
-         ) {
-
-         if (is_derived_dim(dim_ptr-&gt;name_in_code)) {
-            fortprintf(fd, &quot;      integer :: read%sStart</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      integer :: read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-         }
-         else if (dim_ptr-&gt;constant_value &gt; 0) {
-            fortprintf(fd, &quot;      integer :: read%sStart</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      integer :: read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-         }
-         else if (dim_ptr-&gt;namelist_defined) {
-            fortprintf(fd, &quot;      integer :: read%sStart</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      integer :: read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-         }
-         else {
-            fortprintf(fd, &quot;      integer :: read%sStart</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      integer :: read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-         }
-      }
-
-      dim_ptr = dim_ptr-&gt;next;
-   }
-
-   fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-   dim_ptr = dims;
-   while (dim_ptr) {
-
-      if (strncmp(dim_ptr-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
-         ) {
-
-         if (is_derived_dim(dim_ptr-&gt;name_in_code)) {
-            fortprintf(fd, &quot;      read%sStart = 1</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      read%sCount = block %% mesh %% %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;      allocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      allocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      nullify(send%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      nullify(recv%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      recv%sList %% procID = dminfo %% my_proc_id</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      send%sList %% procID = dminfo %% my_proc_id</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      recv%sList %% nlist = read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      send%sList %% nlist = read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      allocate(recv%sList %% list(read%sCount))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      allocate(send%sList %% list(read%sCount))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      do i=1,read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         recv%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         send%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      end do</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         }
-         else if (dim_ptr-&gt;constant_value &gt; 0) {
-            fortprintf(fd, &quot;      read%sStart = 1</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      read%sCount = %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;      allocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      allocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      nullify(send%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      nullify(recv%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      recv%sList %% procID = dminfo %% my_proc_id</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      send%sList %% procID = dminfo %% my_proc_id</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      recv%sList %% nlist = read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      send%sList %% nlist = read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      allocate(recv%sList %% list(read%sCount))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      allocate(send%sList %% list(read%sCount))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      do i=1,read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         recv%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         send%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      end do</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         }
-         else if (dim_ptr-&gt;namelist_defined) {
-            fortprintf(fd, &quot;      read%sStart = 1</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      read%sCount = block %% mesh %% %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      allocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      allocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      nullify(send%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      nullify(recv%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      recv%sList %% procID = dminfo %% my_proc_id</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      send%sList %% procID = dminfo %% my_proc_id</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      recv%sList %% nlist = read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      send%sList %% nlist = read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      allocate(recv%sList %% list(read%sCount))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      allocate(send%sList %% list(read%sCount))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      do i=1,read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         recv%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         send%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      end do</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         }
-         else {
-            fortprintf(fd, &quot;      read%sStart = 1</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      read%sCount = block %% mesh %% %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;      allocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      allocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      nullify(send%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      nullify(recv%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      recv%sList %% procID = dminfo %% my_proc_id</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      send%sList %% procID = dminfo %% my_proc_id</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      recv%sList %% nlist = read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      send%sList %% nlist = read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      allocate(recv%sList %% list(read%sCount))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      allocate(send%sList %% list(read%sCount))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      do i=1,read%sCount</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;         recv%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;         send%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      end do</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         }
-
-      }
-
-      dim_ptr = dim_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-
-   /*
-    *  Deallocation of exchange lists for non-decomposed fields
-    */
-   fd = fopen(&quot;nondecomp_dims_dealloc.inc&quot;, &quot;w&quot;);
-
-   dim_ptr = dims;
-   while (dim_ptr) {
-
-      if (strncmp(dim_ptr-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
-         ) {
-
-         if (is_derived_dim(dim_ptr-&gt;name_in_code)) {
-            fortprintf(fd, &quot;      deallocate(recv%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      deallocate(send%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      deallocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      deallocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-         }
-         else if (dim_ptr-&gt;constant_value &gt; 0) {
-            fortprintf(fd, &quot;      deallocate(recv%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      deallocate(send%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      deallocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      deallocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-         }
-         else if (dim_ptr-&gt;namelist_defined) {
-            fortprintf(fd, &quot;      deallocate(recv%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      deallocate(send%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      deallocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      deallocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-         }
-         else {
-            fortprintf(fd, &quot;      deallocate(recv%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      deallocate(send%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      deallocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      deallocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-         }
-
-      }
-
-      dim_ptr = dim_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-
-   /*
-    *  Definitions of read bounds and exchange lists for non-decomposed fields
-    */
-   fd = fopen(&quot;nondecomp_outputs.inc&quot;, &quot;w&quot;);
-
-   dim_ptr = dims;
-   while (dim_ptr) {
-
-      if (strncmp(dim_ptr-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
-         ) {
-
-         if (is_derived_dim(dim_ptr-&gt;name_in_code)) {
-            fortprintf(fd, &quot;      integer :: %sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-         }
-         else if (dim_ptr-&gt;constant_value &gt; 0) {
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-         }
-         else if (dim_ptr-&gt;namelist_defined) {
-            fortprintf(fd, &quot;      integer :: %sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-         }
-         else {
-            fortprintf(fd, &quot;      integer :: %sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-         }
-
-      }
-
-      dim_ptr = dim_ptr-&gt;next;
-   }
-
-   fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-   dim_ptr = dims;
-   while (dim_ptr) {
-
-      if (strncmp(dim_ptr-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
-         ) {
-
-         if (is_derived_dim(dim_ptr-&gt;name_in_code)) {
-            fortprintf(fd, &quot;      %sGlobal = domain %% blocklist %% mesh %% %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;         allocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         allocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         nullify(send%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         nullify(recv%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         recv%sList %% procID = 0</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         send%sList %% procID = 0</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         recv%sList %% nlist = %sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         send%sList %% nlist = %sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         allocate(recv%sList %% list(%sGlobal))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         allocate(send%sList %% list(%sGlobal))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         do i=1,%sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;            recv%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;            send%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         end do</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;      else</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;         nullify(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         nullify(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         }
-         else if (dim_ptr-&gt;constant_value &gt; 0) {
-            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;         allocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         allocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         nullify(send%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         nullify(recv%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         recv%sList %% procID = 0</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         send%sList %% procID = 0</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         recv%sList %% nlist = %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;         send%sList %% nlist = %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;         allocate(recv%sList %% list(%s))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;         allocate(send%sList %% list(%s))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;         do i=1,%s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;            recv%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;            send%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         end do</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;      else</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;         nullify(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         nullify(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         }
-         else if (dim_ptr-&gt;namelist_defined) {
-            fortprintf(fd, &quot;      %sGlobal = domain %% blocklist %% mesh %% %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;         allocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         allocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         nullify(send%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         nullify(recv%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         recv%sList %% procID = 0</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         send%sList %% procID = 0</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         recv%sList %% nlist = %sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         send%sList %% nlist = %sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         allocate(recv%sList %% list(%sGlobal))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         allocate(send%sList %% list(%sGlobal))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         do i=1,%sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;            recv%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;            send%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         end do</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;      else</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;         nullify(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         nullify(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         }
-         else {
-            fortprintf(fd, &quot;      %sGlobal = domain %% blocklist %% mesh %% %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;         allocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;         allocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;         nullify(send%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;         nullify(recv%sList %% next)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;         recv%sList %% procID = 0</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;         send%sList %% procID = 0</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;         recv%sList %% nlist = %sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;         send%sList %% nlist = %sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;         allocate(recv%sList %% list(%sGlobal))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;         allocate(send%sList %% list(%sGlobal))</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;         do i=1,%sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;            recv%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;            send%sList %% list(i) = i</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;         end do</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;      else</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;         nullify(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;         nullify(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-         }
-
-      }
-
-      dim_ptr = dim_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-
-   /*
-    *  Deallocation of exchange lists for non-decomposed fields
-    */
-   fd = fopen(&quot;nondecomp_outputs_dealloc.inc&quot;, &quot;w&quot;);
-
-   dim_ptr = dims;
-   while (dim_ptr) {
-
-      if (strncmp(dim_ptr-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
-          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
-         ) {
-
-         if (is_derived_dim(dim_ptr-&gt;name_in_code)) {
-            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;         deallocate(recv%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         deallocate(send%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         deallocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         deallocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-         }
-         else if (dim_ptr-&gt;constant_value &gt; 0) {
-            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;         deallocate(recv%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         deallocate(send%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         deallocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         deallocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-         }
-         else if (dim_ptr-&gt;namelist_defined) {
-            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;         deallocate(recv%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         deallocate(send%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         deallocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;         deallocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file+1);
-            fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-         }
-         else {
-            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="red">&quot;);
-            fortprintf(fd, &quot;         deallocate(recv%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;         deallocate(send%sList %% list)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;         deallocate(send%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;         deallocate(recv%sList)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code+1);
-            fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-         }
-
-      }
-
-      dim_ptr = dim_ptr-&gt;next;
-   }
-
-   fclose(fd);
-   
-
-   /*
-    *  Generate read and distribute code
-    */
-   fd = fopen(&quot;io_input_fields.inc&quot;, &quot;w&quot;);
-
-   group_ptr = groups;
-   while (group_ptr) {
-      var_list_ptr = group_ptr-&gt;vlist;
-      while (var_list_ptr) {
-         var_ptr = var_list_ptr-&gt;var;
-
-         if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1)
-            snprintf(struct_deref, 1024, &quot;block %% %s %% time_levs(1) %% %s&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-         else
-            snprintf(struct_deref, 1024, &quot;block %% %s&quot;, group_ptr-&gt;name);
-
-         i = 1;
-         dimlist_ptr = var_ptr-&gt;dimlist;
-         if (var_ptr-&gt;vtype == INTEGER) sprintf(vtype, &quot;int&quot;); 
-         else if (var_ptr-&gt;vtype == REAL) sprintf(vtype, &quot;real&quot;); 
-         else if (var_ptr-&gt;vtype == CHARACTER) sprintf(vtype, &quot;char&quot;); 
-   
-         if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
-            fortprintf(fd, &quot;      if ((%s %% %s %% ioinfo %% input .and. input_obj %% stream == STREAM_INPUT) .or. &amp;</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;super_array);
-            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% sfc .and. input_obj %% stream == STREAM_SFC) .or. &amp;</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;super_array);
-            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% restart .and. input_obj %% stream == STREAM_RESTART)) then</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;super_array);
-         }
-         else {
-            fortprintf(fd, &quot;      if ((%s %% %s %% ioinfo %% input .and. input_obj %% stream == STREAM_INPUT) .or. &amp;</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% sfc .and. input_obj %% stream == STREAM_SFC) .or. &amp;</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% restart .and. input_obj %% stream == STREAM_RESTART)) then</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;name_in_code);
-         }
-         while (dimlist_ptr) {
-               if (i &lt; var_ptr-&gt;ndims) {
-                  fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = 1</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i);
-                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                     else fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  else
-                     fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = %s</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
-               }
-               else {
-                  if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) {
-                     fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
-                     fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
-                  }
-                  else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) {
-                     fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                     fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  }
-                  else {
-                     if (dimlist_ptr-&gt;dim-&gt;namelist_defined) {
-                        fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
-                        fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
-                     }
-                     else {
-                        fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code+1);
-                        fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code+1);
-                     }
-                  }
-               }
-            dimlist_ptr = dimlist_ptr-&gt;next;
-            i++;
-         }
-   
-         if (var_ptr-&gt;ndims &gt; 0) {
-            fortprintf(fd, &quot;      allocate(%s%id %% array(&quot;, vtype, var_ptr-&gt;ndims);
-            i = 1;
-            dimlist_ptr = var_ptr-&gt;dimlist;
-      
-            if (i &lt; var_ptr-&gt;ndims) {
-               if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                  else fortprintf(fd, &quot;block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-               else
-                  fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-            }
-            else {
-               if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) 
-                  fortprintf(fd, &quot;read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
-               else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) 
-                  fortprintf(fd, &quot;read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-               else
-                  if (dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
-                  else fortprintf(fd, &quot;read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code+1);
-            }
-       
-            dimlist_ptr = dimlist_ptr-&gt;next;
-            i++;
-            while (dimlist_ptr) {
-               if (i &lt; var_ptr-&gt;ndims) {
-                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                     else fortprintf(fd, &quot;, block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  else
-                     fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-               }
-               else {
-                  if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code))
-                     fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
-                  else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0)
-                     fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  else
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code+1);
-                     else fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
-               }
-               dimlist_ptr = dimlist_ptr-&gt;next;
-               i++;
-            }
-            fortprintf(fd, &quot;))</font>
<font color="black"></font>
<font color="red">&quot;);
-   
-            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
-               fortprintf(fd, &quot;      allocate(super_%s%id(&quot;, vtype, var_ptr-&gt;ndims);
-               i = 1;
-               dimlist_ptr = var_ptr-&gt;dimlist;
-         
-               if (i &lt; var_ptr-&gt;ndims) {
-                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                     else fortprintf(fd, &quot;block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  else
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                     else fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-               }
-               dimlist_ptr = dimlist_ptr-&gt;next;
-               i++;
-               while (dimlist_ptr) {
-                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                     else fortprintf(fd, &quot;, block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  else
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                     else fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-
-                  dimlist_ptr = dimlist_ptr-&gt;next;
-                  i++;
-               }
-               fortprintf(fd, &quot;))</font>
<font color="black"></font>
<font color="red">&quot;);
-            }
-         }
-   
-         fortprintf(fd, &quot;      %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, var_ptr-&gt;name_in_file);
-         if (var_ptr-&gt;timedim)
-            fortprintf(fd, &quot;      call io_input_field_time(input_obj, %s%id)</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims);
-         else
-            fortprintf(fd, &quot;      call io_input_field(input_obj, %s%id)</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims);
-   
-         if (var_ptr-&gt;ndims &gt; 0) {
-            fortprintf(fd, &quot;      call dmpar_alltoall_field(dminfo, &amp;</font>
<font color="red">&quot;);
-            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0)
-               fortprintf(fd, &quot;                                %s%id %% array, super_%s%id, &amp;</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, vtype, var_ptr-&gt;ndims);
-            else
-               fortprintf(fd, &quot;                                %s%id %% array, %s %% %s %% array, &amp;</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, struct_deref, var_ptr-&gt;name_in_code);
-      
-            i = 1;
-            dimlist_ptr = var_ptr-&gt;dimlist;
-            
-            if (i &lt; var_ptr-&gt;ndims)
-               if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;                                block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                  else fortprintf(fd, &quot;                                block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-               else
-                  fortprintf(fd, &quot;                                %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-            else {
-               lastdim = dimlist_ptr;
-               if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) {
-                  fortprintf(fd, &quot;                                read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
-               }
-               else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) {
-                  fortprintf(fd, &quot;                                read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-               }
-               else
-                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;                                read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code+1);
-                  else fortprintf(fd, &quot;                                read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
-            }
-       
-            dimlist_ptr = dimlist_ptr-&gt;next;
-            i++;
-            while (dimlist_ptr) {
-               if (i &lt; var_ptr-&gt;ndims)
-                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                     else fortprintf(fd, &quot;, block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  else
-                     fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-               else {
-                  lastdim = dimlist_ptr;
-                  if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) {
-                     fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
-                  }
-                  else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) {
-                     fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  }
-                  else
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code+1);
-                     else fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
-               }
-               dimlist_ptr = dimlist_ptr-&gt;next;
-               i++;
-            }
-            if (lastdim-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, block %% mesh %% %s, &amp;</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_file);
-            else if (lastdim-&gt;dim-&gt;constant_value &gt; 0) fortprintf(fd, &quot;, %s, &amp;</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_code);
-            else fortprintf(fd, &quot;, block %% mesh %% %s, &amp;</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_code);
-      
-            if (is_derived_dim(lastdim-&gt;dim-&gt;name_in_code)) 
-               fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_file+1, lastdim-&gt;dim-&gt;name_in_file+1);
-            else if (lastdim-&gt;dim-&gt;constant_value &gt; 0) 
-               fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_file, lastdim-&gt;dim-&gt;name_in_file);
-            else
-               if (lastdim-&gt;dim-&gt;namelist_defined) 
-                  fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_file+1, lastdim-&gt;dim-&gt;name_in_file+1);
-               else
-                  fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_code+1, lastdim-&gt;dim-&gt;name_in_code+1);
-   
-   
-            /* Copy from super_ array to field */
-            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
-               i = 1;
-               dimlist_ptr = var_ptr-&gt;dimlist;
-               while (i &lt;= var_ptr-&gt;ndims) {
-                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;      do i%i=1,block %% mesh %% %s</font>
<font color="red">&quot;, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                     else fortprintf(fd, &quot;      do i%i=1,block %% mesh %% %s</font>
<font color="red">&quot;, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  else
-                     fortprintf(fd, &quot;      do i%i=1,%s</font>
<font color="red">&quot;, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
-      
-                  i++;
-                  dimlist_ptr = dimlist_ptr-&gt;next;
-               }
-      
-               fortprintf(fd, &quot;         %s %% %s %% array(%s %% index_%s,&quot;, struct_deref, var_ptr-&gt;super_array, struct_deref, var_ptr-&gt;name_in_code);
-
-               for(i=1; i&lt;=var_ptr-&gt;ndims; i++) {
-                  fortprintf(fd, &quot;i%i&quot;,i);
-                  if (i &lt; var_ptr-&gt;ndims) fortprintf(fd, &quot;,&quot;);
-               }
-               fortprintf(fd, &quot;) = super_%s%id(&quot;, vtype, var_ptr-&gt;ndims);
-               for(i=1; i&lt;=var_ptr-&gt;ndims; i++) {
-                  fortprintf(fd, &quot;i%i&quot;,i);
-                  if (i &lt; var_ptr-&gt;ndims) fortprintf(fd, &quot;,&quot;);
-               }
-               fortprintf(fd, &quot;)</font>
<font color="red">&quot;);
-      
-               i = 1;
-               while (i &lt;= var_ptr-&gt;ndims) {
-                  fortprintf(fd, &quot;      end do</font>
<font color="red">&quot;);
-                  i++;
-               }
-            }
-   
-            fortprintf(fd, &quot;      deallocate(%s%id %% array)</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims);
-            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0)
-               fortprintf(fd, &quot;      deallocate(super_%s%id)</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims);
-         }
-         else {
-            fortprintf(fd, &quot;      %s %% %s %% scalar = %s%id %% scalar</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;name_in_code, vtype, var_ptr-&gt;ndims);
-         }
-        
-         fortprintf(fd, &quot;      end if</font>
<font color="black"></font>
<font color="red">&quot;);
-   
-         var_list_ptr = var_list_ptr-&gt;next;
-      }
-      group_ptr = group_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-
-   /*
-    *  Generate NetCDF reads of dimension and variable IDs
-    */
-   fd = fopen(&quot;netcdf_read_ids.inc&quot;, &quot;w&quot;);
-
-   fortprintf(fd, &quot;      nferr = nf_inq_unlimdim(input_obj %% rd_ncid, input_obj %% rdDimIDTime)</font>
<font color="red">&quot;);
-   fortprintf(fd, &quot;      nferr = nf_inq_dimlen(input_obj %% rd_ncid, input_obj %% rdDimIDTime, input_obj %% rdLocalTime)</font>
<font color="red">&quot;);
-   dim_ptr = dims;
-   while (dim_ptr) {
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
-         fortprintf(fd, &quot;      nferr = nf_inq_dimid(input_obj %% rd_ncid, \'%s\', input_obj %% rdDimID%s)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
-         fortprintf(fd, &quot;      nferr = nf_inq_dimlen(input_obj %% rd_ncid, input_obj %% rdDimID%s, input_obj %% rdLocal%s)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
-      }
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-   var_ptr = vars;
-   while (var_ptr) {
-      fortprintf(fd, &quot;      nferr = nf_inq_varid(input_obj %% rd_ncid, \'%s\', input_obj %% rdVarID%s)</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file, var_ptr-&gt;name_in_file);
-      var_ptr = var_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-
-   /*
-    *  Generate code to return dimension given its name
-    */
-   fd = fopen(&quot;get_dimension_by_name.inc&quot;, &quot;w&quot;);
-
-   dim_ptr = dims;
-   while (dim_ptr-&gt;constant_value &gt;= 0 || is_derived_dim(dim_ptr-&gt;name_in_code)) dim_ptr = dim_ptr-&gt;next;
-   if (!dim_ptr-&gt;namelist_defined) {
-      fortprintf(fd, &quot;      if (trim(dimname) == \'%s\') then</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code);
-      fortprintf(fd, &quot;         dimsize = input_obj %% rdLocal%s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-   }
-   else {
-      fortprintf(fd, &quot;      if (trim(dimname) == \'%s\') then</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-      fortprintf(fd, &quot;         dimsize = %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code);
-   }
-   dim_ptr = dim_ptr-&gt;next;
-   while (dim_ptr) {
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
-         if (!dim_ptr-&gt;namelist_defined) {
-            fortprintf(fd, &quot;      else if (trim(dimname) == \'%s\') then</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;         dimsize = input_obj %% rdLocal%s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-         }
-         else {
-            fortprintf(fd, &quot;      else if (trim(dimname) == \'%s\') then</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         dimsize = %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code);
-         }
-      }
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-
-   fclose(fd);
-   
-   
-   /*
-    *  Generate code to read 0d, 1d, 2d, 3d time-invariant fields
-    */
-   for(j=0; j&lt;3; j++) {
-      for(i=0; i&lt;=3; i++) {
-         if (j == 0) {
-            sprintf(fname, &quot;input_field%idinteger.inc&quot;, i);
-            ivtype = INTEGER;
-         }
-         else if (j == 1) {
-            sprintf(fname, &quot;input_field%idreal.inc&quot;, i);
-            ivtype = REAL;
-         }
-         else if (j == 2) {
-            sprintf(fname, &quot;input_field%idchar.inc&quot;, i);
-            ivtype = CHARACTER;
-         }
-         fd = fopen(fname, &quot;w&quot;);
-   
-         var_ptr = vars;
-         while (var_ptr &amp;&amp; (var_ptr-&gt;ndims != i || var_ptr-&gt;vtype != ivtype || var_ptr-&gt;timedim)) var_ptr = var_ptr-&gt;next;
-         if (var_ptr) {
-            fortprintf(fd, &quot;      if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         varID = input_obj %% rdVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-            var_ptr = var_ptr-&gt;next;
-            while (var_ptr) {
-               if (var_ptr-&gt;ndims == i &amp;&amp; var_ptr-&gt;vtype == ivtype &amp;&amp; !var_ptr-&gt;timedim) {
-                  fortprintf(fd, &quot;      else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-                  fortprintf(fd, &quot;         varID = input_obj %% rdVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-               }
-               var_ptr = var_ptr-&gt;next;
-            }
-            fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-         }
-      
-         fclose(fd);
-      } 
-   } 
-   
-   
-   /*
-    *  Generate code to read 0d, 1d, 2d, 3d time-varying fields
-    */
-   for(j=0; j&lt;2; j++) {
-      for(i=0; i&lt;=3; i++) { 
-         if (j == 0) {
-            sprintf(fname, &quot;input_field%idinteger_time.inc&quot;, i);
-            ivtype = INTEGER;
-         }
-         else {
-            sprintf(fname, &quot;input_field%idreal_time.inc&quot;, i);
-            ivtype = REAL;
-         }
-         fd = fopen(fname, &quot;w&quot;);
-      
-         var_ptr = vars;
-         while (var_ptr &amp;&amp; (var_ptr-&gt;ndims != i || var_ptr-&gt;vtype != ivtype || !var_ptr-&gt;timedim)) var_ptr = var_ptr-&gt;next;
-         if (var_ptr) {
-            fortprintf(fd, &quot;      if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         varID = input_obj %% rdVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-            var_ptr = var_ptr-&gt;next;
-            while (var_ptr) {
-               if (var_ptr-&gt;ndims == i &amp;&amp; var_ptr-&gt;vtype == ivtype &amp;&amp; var_ptr-&gt;timedim) {
-                  fortprintf(fd, &quot;      else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-                  fortprintf(fd, &quot;         varID = input_obj %% rdVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-               }
-               var_ptr = var_ptr-&gt;next;
-   
-            }
-            fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-         }
-   
-         fclose(fd);
-      }
-   } 
-   
-   
-   /*
-    *  Generate code to read 0d and 1d time-varying character fields
-    */
-   for(i=0; i&lt;=1; i++) { 
-      sprintf(fname, &quot;input_field%idchar_time.inc&quot;, i);
-      fd = fopen(fname, &quot;w&quot;);
-   
-      var_ptr = vars;
-      while (var_ptr &amp;&amp; (var_ptr-&gt;ndims != i || var_ptr-&gt;vtype != CHARACTER || !var_ptr-&gt;timedim)) var_ptr = var_ptr-&gt;next;
-      if (var_ptr) {
-         fortprintf(fd, &quot;      if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-         fortprintf(fd, &quot;         varID = input_obj %% rdVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-         var_ptr = var_ptr-&gt;next;
-         while (var_ptr) {
-            if (var_ptr-&gt;ndims == i &amp;&amp; var_ptr-&gt;vtype == CHARACTER &amp;&amp; var_ptr-&gt;timedim) {
-               fortprintf(fd, &quot;      else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-               fortprintf(fd, &quot;         varID = input_obj %% rdVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-            }
-            var_ptr = var_ptr-&gt;next;
-         }
-         fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-      }
-   
-      fclose(fd);
-   } 
-   
-}
-
-
-void gen_writes(struct group_list * groups, struct variable * vars, struct dimension * dims, struct namelist * namelists)
-{
-   struct variable * var_ptr;
-   struct variable_list * var_list_ptr;
-   struct dimension * dim_ptr;
-   struct dimension_list * dimlist_ptr, * lastdim;
-   struct group_list * group_ptr;
-   struct dtable * dictionary;
-   struct namelist * nl;
-   FILE * fd;
-   char vtype[5];
-   char fname[32];
-   char struct_deref[1024];
-   char * cp1, * cp2;
-   int i, j;
-   int ivtype;
-   
-   
-   /*
-    *  Generate declarations of IDs belonging in io_output_object
-    */
-   fd = fopen(&quot;io_output_obj_decls.inc&quot;, &quot;w&quot;);
-
-   fortprintf(fd, &quot;      integer :: wrDimIDTime</font>
<font color="red">&quot;);
-   dim_ptr = dims;
-   while (dim_ptr) {
-      fortprintf(fd, &quot;      integer :: wrDimID%s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-   var_ptr = vars;
-   while (var_ptr) {
-      fortprintf(fd, &quot;      integer :: wrVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-      var_ptr = var_ptr-&gt;next;
-   }
-
-   fclose(fd);
-
-
-   /*
-    *  Generate declarations of temporary dimension variables used for arguments
-    */
-   fd = fopen(&quot;output_dim_actual_decls.inc&quot;, &quot;w&quot;);
-
-   dim_ptr = dims;
-   while (dim_ptr) {
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code);
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %sGlobal</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-   fclose(fd);
-
-
-   /*
-    *  Generate initialization of temporary dimension variables used for arguments
-    */
-   fd = fopen(&quot;output_dim_inits.inc&quot;, &quot;w&quot;);
-
-   dim_ptr = dims;
-   while (dim_ptr) {
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      %sGlobal = block_ptr %% mesh %% %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_code, dim_ptr-&gt;name_in_code);
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      %sGlobal = block_ptr %% mesh %% %s</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-   fclose(fd);
-
-
-   /*
-    *  Generate actual dimension argument list
-    */
-   fd = fopen(&quot;output_dim_actual_args.inc&quot;, &quot;w&quot;);
-   dim_ptr = dims;
-   if (dim_ptr &amp;&amp; dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
-      if (!dim_ptr-&gt;namelist_defined) fortprintf(fd, &quot;                            %sGlobal&quot;, dim_ptr-&gt;name_in_code);
-      else fortprintf(fd, &quot;                            %sGlobal&quot;, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   while (dim_ptr) {
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;, %sGlobal&quot;, dim_ptr-&gt;name_in_code);
-      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;, %sGlobal&quot;, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot; &amp;</font>
<font color="red">&quot;);
-
-   fclose(fd);
-
-
-   /*
-    *  Generate NetCDF calls to define dimensions, variables, and global attributes
-    */
-   fd = fopen(&quot;netcdf_def_dims_vars.inc&quot;, &quot;w&quot;);
-
-   fortprintf(fd, &quot;      nferr = nf_def_dim(output_obj %% wr_ncid, \'Time\', NF_UNLIMITED, output_obj %% wrDimIDTime)</font>
<font color="red">&quot;);
-   dim_ptr = dims;
-   while (dim_ptr) {
-      fortprintf(fd, &quot;      nferr = nf_def_dim(output_obj %% wr_ncid, \'%s\', %s, output_obj %% wrDimID%s)</font>
<font color="red">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code, dim_ptr-&gt;name_in_file);
-      dim_ptr = dim_ptr-&gt;next;
-   }
-   fortprintf(fd, &quot;</font>
<font color="red">&quot;);
-
-   var_ptr = vars;
-   while (var_ptr) {
-      fortprintf(fd, &quot;      if (.false. &amp;</font>
<font color="red">&quot;);
-      if (var_ptr-&gt;iostreams &amp; RESTART0) fortprintf(fd, &quot;          .or. output_obj %% stream == RESTART &amp;</font>
<font color="red">&quot;);
-      if (var_ptr-&gt;iostreams &amp; OUTPUT0)  fortprintf(fd, &quot;          .or. output_obj %% stream == OUTPUT &amp;</font>
<font color="red">&quot;);
-      if (var_ptr-&gt;iostreams &amp; SFC0)     fortprintf(fd, &quot;          .or. output_obj %% stream == SFC &amp;</font>
<font color="red">&quot;);
-      fortprintf(fd, &quot;      ) then</font>
<font color="red">&quot;);
-      dimlist_ptr = var_ptr-&gt;dimlist;
-      i = 1;
-      if (var_ptr-&gt;vtype == CHARACTER)
-         fortprintf(fd, &quot;      dimlist(%i) = output_obj %% wrDimIDStrLen</font>
<font color="red">&quot;, i++);
-      while(dimlist_ptr) {
-         fortprintf(fd, &quot;      dimlist(%i) = output_obj %% wrDimID%s</font>
<font color="red">&quot;, i++, dimlist_ptr-&gt;dim-&gt;name_in_file);
-         dimlist_ptr = dimlist_ptr-&gt;next;
-      }
-      if (var_ptr-&gt;timedim) fortprintf(fd, &quot;      dimlist(%i) = output_obj %% wrDimIDTime</font>
<font color="red">&quot;, i++);
-      if (var_ptr-&gt;vtype == INTEGER)
-         fortprintf(fd, &quot;      nferr = nf_def_var(output_obj %% wr_ncid, \'%s\', NF_INT, %i, dimlist, output_obj %% wrVarID%s)</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file, var_ptr-&gt;ndims + var_ptr-&gt;timedim, var_ptr-&gt;name_in_file);
-      else if (var_ptr-&gt;vtype == REAL)
-         fortprintf(fd, &quot;      nferr = nf_def_var(output_obj %% wr_ncid, \'%s\', NF_DOUBLE, %i, dimlist, output_obj %% wrVarID%s)</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file, var_ptr-&gt;ndims + var_ptr-&gt;timedim, var_ptr-&gt;name_in_file);
-      else if (var_ptr-&gt;vtype == CHARACTER)
-         fortprintf(fd, &quot;      nferr = nf_def_var(output_obj %% wr_ncid, \'%s\', NF_CHAR, %i, dimlist, output_obj %% wrVarID%s)</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file, var_ptr-&gt;ndims + var_ptr-&gt;timedim + 1, var_ptr-&gt;name_in_file);
-
-      fortprintf(fd, &quot;      end if</font>
<font color="black"></font>
<font color="red">&quot;);
-
-      var_ptr = var_ptr-&gt;next;
-   }
-
-   nl = namelists;
-   while (nl) {
-      if (nl-&gt;vtype == INTEGER)
-         fortprintf(fd, &quot;      nferr = nf_put_att_int(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', NF_INT, 1, %s)</font>
<font color="red">&quot;, nl-&gt;name, nl-&gt;name);
-      else if (nl-&gt;vtype == REAL) {
-         fortprintf(fd, &quot;      if (RKIND == 8) then</font>
<font color="red">&quot;, nl-&gt;name);
-         fortprintf(fd, &quot;         nferr = nf_put_att_double(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', NF_DOUBLE, 1, %s)</font>
<font color="red">&quot;, nl-&gt;name, nl-&gt;name);
-         fortprintf(fd, &quot;      else if (RKIND == 4) then</font>
<font color="red">&quot;, nl-&gt;name);
-         fortprintf(fd, &quot;         nferr = nf_put_att_real(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', NF_FLOAT, 1, %s)</font>
<font color="red">&quot;, nl-&gt;name, nl-&gt;name);
-         fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-      }
-      else if (nl-&gt;vtype == CHARACTER)
-         fortprintf(fd, &quot;      nferr = nf_put_att_text(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', len_trim(%s), trim(%s))</font>
<font color="red">&quot;, nl-&gt;name, nl-&gt;name, nl-&gt;name);
-      else if (nl-&gt;vtype == LOGICAL) {
-         fortprintf(fd, &quot;      if (%s) then</font>
<font color="red">&quot;, nl-&gt;name);
-         fortprintf(fd, &quot;         nferr = nf_put_att_text(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', 1, \'T\')</font>
<font color="red">&quot;, nl-&gt;name);
-         fortprintf(fd, &quot;      else</font>
<font color="red">&quot;);
-         fortprintf(fd, &quot;         nferr = nf_put_att_text(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', 1, \'F\')</font>
<font color="red">&quot;, nl-&gt;name);
-         fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-      }
-      nl = nl-&gt;next;
-   }
-
-   fclose(fd);   
-   
-   
-   /*
-    *  Generate collect and write code
-    */
-   fd = fopen(&quot;io_output_fields.inc&quot;, &quot;w&quot;);
-
-   group_ptr = groups;
-   while (group_ptr) {
-      var_list_ptr = group_ptr-&gt;vlist;
-      while (var_list_ptr) {
-         var_ptr = var_list_ptr-&gt;var;
-
-         if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1)
-            snprintf(struct_deref, 1024, &quot;domain %% blocklist %% %s %% time_levs(1) %% %s&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
-         else
-            snprintf(struct_deref, 1024, &quot;domain %% blocklist %% %s&quot;, group_ptr-&gt;name);
-         
-         i = 1;
-         dimlist_ptr = var_ptr-&gt;dimlist;
-         if (var_ptr-&gt;vtype == INTEGER) sprintf(vtype, &quot;int&quot;); 
-         else if (var_ptr-&gt;vtype == REAL) sprintf(vtype, &quot;real&quot;); 
-         else if (var_ptr-&gt;vtype == CHARACTER) sprintf(vtype, &quot;char&quot;); 
-   
-         if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
-            fortprintf(fd, &quot;      if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &amp;</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;super_array);
-            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART) .or. &amp;</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;super_array);
-            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% sfc .and. output_obj %% stream == SFC)) then</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;super_array);
-         }
-         else {
-            fortprintf(fd, &quot;      if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &amp;</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART) .or. &amp;</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;name_in_code);
-            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% sfc .and. output_obj %% stream == SFC)) then</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;name_in_code);
-         }
-   
-         if (var_ptr-&gt;ndims &gt; 0) {
-            while (dimlist_ptr) {
-                  if (i &lt; var_ptr-&gt;ndims) {
-                     fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = 1</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i);
-                     if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                        if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                        else fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                     else
-                        fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = %s</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                  }
-                  else {
-                     fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = 1</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i);
-                     if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) {
-                        split_derived_dim_string(dimlist_ptr-&gt;dim-&gt;name_in_code, &amp;cp1, &amp;cp2);
-                        fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = n%sGlobal%s</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, cp1, cp2);
-                        free(cp1);
-                        free(cp2);
-                     }
-                     else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) {
-                        fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = %s</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                     }
-                     else
-                        if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                        else fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  }
-               dimlist_ptr = dimlist_ptr-&gt;next;
-               i++;
-            }
-      
-            fortprintf(fd, &quot;      allocate(%s%id %% array(&quot;, vtype, var_ptr-&gt;ndims);
-            i = 1;
-            dimlist_ptr = var_ptr-&gt;dimlist;
-      
-            if (i &lt; var_ptr-&gt;ndims)
-               if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                  else fortprintf(fd, &quot;domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-               else
-                  fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-            else {
-               if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) {
-                  split_derived_dim_string(dimlist_ptr-&gt;dim-&gt;name_in_code, &amp;cp1, &amp;cp2);
-                  fortprintf(fd, &quot;n%sGlobal%s&quot;, cp1, cp2);
-                  free(cp1);
-                  free(cp2);
-               }
-               else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) {
-                  fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-               }
-               else
-                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;%sGlobal&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                  else fortprintf(fd, &quot;%sGlobal&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-               lastdim = dimlist_ptr;
-            }
-            dimlist_ptr = dimlist_ptr-&gt;next;
-            i++;
-            while (dimlist_ptr) {
-               if (i &lt; var_ptr-&gt;ndims)
-                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                     else fortprintf(fd, &quot;, domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  else
-                     fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-               else {
-                  if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) {
-                     split_derived_dim_string(dimlist_ptr-&gt;dim-&gt;name_in_code, &amp;cp1, &amp;cp2);
-                     fortprintf(fd, &quot;, n%sGlobal%s&quot;, cp1, cp2);
-                     free(cp1);
-                     free(cp2);
-                  }
-                  else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) {
-                     fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                  }
-                  else
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, %sGlobal&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                     else fortprintf(fd, &quot;, %sGlobal&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  lastdim = dimlist_ptr;
-               }
-               dimlist_ptr = dimlist_ptr-&gt;next;
-               i++;
-            }
-            fortprintf(fd, &quot;))</font>
<font color="black"></font>
<font color="red">&quot;);
-   
-            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
-               if (var_ptr-&gt;ndims &gt; 0) {
-                  fortprintf(fd, &quot;      allocate(super_%s%id(&quot;, vtype, var_ptr-&gt;ndims);
-                  i = 1;
-                  dimlist_ptr = var_ptr-&gt;dimlist;
-                  while (dimlist_ptr) {
-                     if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                        if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                        else fortprintf(fd, &quot;domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                     else
-                        fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-      
-                     if (i &lt; var_ptr-&gt;ndims) fortprintf(fd, &quot;, &quot;);
-         
-                     dimlist_ptr = dimlist_ptr-&gt;next;
-                     i++;
-                  }
-                  fortprintf(fd, &quot;))</font>
<font color="black"></font>
<font color="red">&quot;);
-               }
-   
-               /* Copy from field to super_ array */
-               i = 1;
-               dimlist_ptr = var_ptr-&gt;dimlist;
-               while (i &lt;= var_ptr-&gt;ndims) {
-                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;      do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="red">&quot;, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                     else fortprintf(fd, &quot;      do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="red">&quot;, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
-                  else
-                     fortprintf(fd, &quot;      do i%i=1,%s</font>
<font color="red">&quot;, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
-   
-                  i++;
-                  dimlist_ptr = dimlist_ptr-&gt;next;
-               }
-   
-               fortprintf(fd, &quot;         super_%s%id(&quot;, vtype, var_ptr-&gt;ndims);
-               for(i=1; i&lt;=var_ptr-&gt;ndims; i++) {
-                  fortprintf(fd, &quot;i%i&quot;,i);
-                  if (i &lt; var_ptr-&gt;ndims) fortprintf(fd, &quot;,&quot;);
-               }
-               fortprintf(fd, &quot;) = %s %% %s %% array(&quot;, struct_deref, var_ptr-&gt;super_array);
-               fortprintf(fd, &quot;%s %% index_%s&quot;, struct_deref, var_ptr-&gt;name_in_code);
-               for(i=1; i&lt;=var_ptr-&gt;ndims; i++) {
-                  fortprintf(fd, &quot;,i%i&quot;,i);
-               }
-               fortprintf(fd, &quot;)</font>
<font color="red">&quot;);
-   
-               i = 1;
-               while (i &lt;= var_ptr-&gt;ndims) {
-                  fortprintf(fd, &quot;      end do</font>
<font color="red">&quot;);
-                  i++;
-               }
-            }
-   
-            fortprintf(fd, &quot;      %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, var_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      call dmpar_alltoall_field(domain %% dminfo, &amp;</font>
<font color="red">&quot;);
-            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0)
-               fortprintf(fd, &quot;                                super_%s%id, %s%id %% array, &amp;</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, vtype, var_ptr-&gt;ndims);
-            else
-               fortprintf(fd, &quot;                                %s %% %s %% array, %s%id %% array, &amp;</font>
<font color="red">&quot;, struct_deref, var_ptr-&gt;name_in_code, vtype, var_ptr-&gt;ndims);
-      
-            i = 1;
-            dimlist_ptr = var_ptr-&gt;dimlist;
-            
-            if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-               if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;                                domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-               else fortprintf(fd, &quot;                                domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-            else
-               fortprintf(fd, &quot;                                %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-       
-            dimlist_ptr = dimlist_ptr-&gt;next;
-            i++;
-            while (dimlist_ptr) {
-               if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
-                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-                  else fortprintf(fd, &quot;, domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
-               else
-                  fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
-      
-               dimlist_ptr = dimlist_ptr-&gt;next;
-               i++;
-            }     
-      
-            /* 
-             *  Need to avoid output_obj in case this is a non-decomposed dimension, in which case 
-             *   the send/recv lists are local variables 
-             */
-            if (strncmp(lastdim-&gt;dim-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
-                strncmp(lastdim-&gt;dim-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
-                strncmp(lastdim-&gt;dim-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
-                strncmp(lastdim-&gt;dim-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
-               ) {
-               if (is_derived_dim(lastdim-&gt;dim-&gt;name_in_code)) {
-                  split_derived_dim_string(lastdim-&gt;dim-&gt;name_in_code, &amp;cp1, &amp;cp2);
-                  fortprintf(fd, &quot;, n%sGlobal%s, &amp;</font>
<font color="red">&quot;, cp1, cp2);
-                  fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_file+1, lastdim-&gt;dim-&gt;name_in_file+1);
-                  free(cp1);
-                  free(cp2);
-               }
-               else if (lastdim-&gt;dim-&gt;constant_value &gt; 0) {
-                  fortprintf(fd, &quot;, %s, &amp;</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_code);
-                  fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_file, lastdim-&gt;dim-&gt;name_in_file);
-               }
-               else {
-                  if (!lastdim-&gt;dim-&gt;namelist_defined) {
-                     fortprintf(fd, &quot;, %sGlobal, &amp;</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_code);
-                     fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_code+1, lastdim-&gt;dim-&gt;name_in_code+1);
-                  }
-                  else {
-                     fortprintf(fd, &quot;, %sGlobal, &amp;</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_file);
-                     fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_file+1, lastdim-&gt;dim-&gt;name_in_file+1);
-                  }
-               }
-            }
-            else {
-               if (is_derived_dim(lastdim-&gt;dim-&gt;name_in_code)) {
-                  split_derived_dim_string(lastdim-&gt;dim-&gt;name_in_code, &amp;cp1, &amp;cp2);
-                  fortprintf(fd, &quot;, n%sGlobal%s, &amp;</font>
<font color="red">&quot;, cp1, cp2);
-                  fortprintf(fd, &quot;                                output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_file+1, lastdim-&gt;dim-&gt;name_in_file+1);
-                  free(cp1);
-                  free(cp2);
-               }
-               else {
-                  if (!lastdim-&gt;dim-&gt;namelist_defined) {
-                     fortprintf(fd, &quot;, %sGlobal, &amp;</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_code);
-                     fortprintf(fd, &quot;                                output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_code+1, lastdim-&gt;dim-&gt;name_in_code+1);
-                  }
-                  else {
-                     fortprintf(fd, &quot;, %sGlobal, &amp;</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_file);
-                     fortprintf(fd, &quot;                                output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">&quot;, lastdim-&gt;dim-&gt;name_in_file+1, lastdim-&gt;dim-&gt;name_in_file+1);
-                  }
-               }
-            }
-         }
-         else {
-            fortprintf(fd, &quot;      %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, var_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;      %s%id %% scalar = %s %% %s %% scalar</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims, struct_deref, var_ptr-&gt;name_in_code);
-         }
-   
-         if (var_ptr-&gt;timedim)
-            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field_time(output_obj, %s%id)</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims);
-         else
-            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == IO_NODE) call io_output_field(output_obj, %s%id)</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims);
-         if (var_ptr-&gt;ndims &gt; 0) {
-            fortprintf(fd, &quot;      deallocate(%s%id %% array)</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims);
-            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0)
-               fortprintf(fd, &quot;      deallocate(super_%s%id)</font>
<font color="red">&quot;, vtype, var_ptr-&gt;ndims);
-         }
-         fortprintf(fd, &quot;      end if</font>
<font color="black"></font>
<font color="red">&quot;);
-   
-         var_list_ptr = var_list_ptr-&gt;next;
-      }
-      group_ptr = group_ptr-&gt;next;
-   }
-
-   fclose(fd);
-   
-   
-   /*
-    *  Generate code to write 0d, 1d, 2d, 3d time-invariant fields
-    */
-   for(j=0; j&lt;3; j++) {
-      for(i=0; i&lt;=3; i++) {
-         if (j == 0) {
-            sprintf(fname, &quot;output_field%idinteger.inc&quot;, i);
-            ivtype = INTEGER;
-         }
-         else if (j == 1) {
-            sprintf(fname, &quot;output_field%idreal.inc&quot;, i);
-            ivtype = REAL;
-         }
-         else if (j == 2) {
-            sprintf(fname, &quot;output_field%idchar.inc&quot;, i);
-            ivtype = CHARACTER;
-         }
-         fd = fopen(fname, &quot;w&quot;);
-   
-         var_ptr = vars;
-         while (var_ptr &amp;&amp; (var_ptr-&gt;ndims != i || var_ptr-&gt;vtype != ivtype || var_ptr-&gt;timedim)) var_ptr = var_ptr-&gt;next;
-         if (var_ptr) {
-            fortprintf(fd, &quot;      if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         varID = output_obj %% wrVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-            var_ptr = var_ptr-&gt;next;
-            while (var_ptr) {
-               if (var_ptr-&gt;ndims == i &amp;&amp; var_ptr-&gt;vtype == ivtype &amp;&amp; !var_ptr-&gt;timedim) {
-                  fortprintf(fd, &quot;      else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-                  fortprintf(fd, &quot;         varID = output_obj %% wrVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-               }
-               var_ptr = var_ptr-&gt;next;
-            }
-            fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-         }
-      
-         fclose(fd);
-      } 
-   } 
-
-   
-   /*
-    *  Generate code to write 0d, 1d, 2d, 3d time-varying fields
-    */
-   for(j=0; j&lt;2; j++) {
-      for(i=0; i&lt;=3; i++) {
-         if (j == 0) {
-            sprintf(fname, &quot;output_field%idinteger_time.inc&quot;, i);
-            ivtype = INTEGER;
-         }
-         else {
-            sprintf(fname, &quot;output_field%idreal_time.inc&quot;, i);
-            ivtype = REAL;
-         }
-         fd = fopen(fname, &quot;w&quot;);
-   
-         var_ptr = vars;
-         while (var_ptr &amp;&amp; (var_ptr-&gt;ndims != i || var_ptr-&gt;vtype != ivtype || !var_ptr-&gt;timedim)) var_ptr = var_ptr-&gt;next;
-         if (var_ptr) {
-            fortprintf(fd, &quot;      if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-            fortprintf(fd, &quot;         varID = output_obj %% wrVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-            var_ptr = var_ptr-&gt;next;
-            while (var_ptr) {
-               if (var_ptr-&gt;ndims == i &amp;&amp; var_ptr-&gt;vtype == ivtype &amp;&amp; var_ptr-&gt;timedim) {
-                  fortprintf(fd, &quot;      else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-                  fortprintf(fd, &quot;         varID = output_obj %% wrVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-               }
-               var_ptr = var_ptr-&gt;next;
-            }
-            fortprintf(fd, &quot;      end if</font>
<font color="red">&quot;);
-         }
-      
-         fclose(fd);
-      }
-   }
-
-   
-   /*
-    *  Generate code to write 0d and 1d character time-varying fields
-    */
-   for(i=0; i&lt;=1; i++) {
-      sprintf(fname, &quot;output_field%idchar_time.inc&quot;, i);
-      fd = fopen(fname, &quot;w&quot;);
-
-      var_ptr = vars;
-      while (var_ptr &amp;&amp; (var_ptr-&gt;ndims != i || var_ptr-&gt;vtype != CHARACTER || !var_ptr-&gt;timedim)) var_ptr = var_ptr-&gt;next;
-      if (var_ptr) {
-         fortprintf(fd, &quot;      if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-         fortprintf(fd, &quot;         varID = output_obj %% wrVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-         var_ptr = var_ptr-&gt;next;
-         while (var_ptr) {
-            if (var_ptr-&gt;ndims == i &amp;&amp; var_ptr-&gt;vtype == CHARACTER &amp;&amp; var_ptr-&gt;timedim) {
-               fortprintf(fd, &quot;      else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-               fortprintf(fd, &quot;         varID = output_obj %% wrVarID%s</font>
<font color="red">&quot;, var_ptr-&gt;name_in_file);
-            }
-            var_ptr = var_ptr-&gt;next;
-         }
-         fortprintf(fd, &quot;      end if</font>
<font color="gray">&quot;);
-      }
-   
-      fclose(fd);
-   }
-   
-}

Copied: branches/source_condensing/src/registry/gen_inc.c (from rev 1114, trunk/mpas/src/registry/gen_inc.c)
===================================================================
--- branches/source_condensing/src/registry/gen_inc.c                                (rev 0)
+++ branches/source_condensing/src/registry/gen_inc.c        2011-10-21 19:22:38 UTC (rev 1115)
@@ -0,0 +1,2190 @@
+#include &lt;stdio.h&gt;
+#include &lt;stdlib.h&gt;
+#include &lt;string.h&gt;
+#include &quot;dictionary.h&quot;
+#include &quot;registry_types.h&quot;
+#include &quot;gen_inc.h&quot;
+#include &quot;fortprintf.h&quot;
+
+int is_derived_dim(char * d)
+{
+   if (strchr(d, (int)'+')) return 1;
+   if (strchr(d, (int)'-')) return 1;
+
+   return 0;
+}
+
+void split_derived_dim_string(char * dim, char ** p1, char ** p2)
+{
+   char * cp, * cm, * c;
+   int n;
+
+   cp = strchr(dim, (int)'+');
+   cm = strchr(dim, (int)'-');
+   if (!cp) 
+      c = cm;
+   else if (!cm) 
+      c = cp;
+   else if (cm &lt; cp) 
+      c = cm;
+   else 
+      c = cp;
+
+   n = c - dim;
+   *p1 = (char *)malloc(n*sizeof(char));
+   snprintf(*p1, n, &quot;%s&quot;, dim+1);
+
+   *p2 = (char *)malloc((strlen(dim)-n+1)*sizeof(char));
+   sprintf(*p2, &quot;%s&quot;, dim+n);
+}
+
+void gen_namelists(struct namelist * nls)
+{
+   struct namelist * nls_ptr;
+   struct dtable * dictionary;
+   int done;
+   char nlrecord[1024];
+   FILE * fd;
+
+   /*
+    *  Generate config_type.inc
+    */
+   fd = fopen(&quot;config_defs.inc&quot;, &quot;w&quot;);
+
+   nls_ptr = nls;
+   while (nls_ptr) {
+      if (nls_ptr-&gt;vtype == INTEGER)   fortprintf(fd, &quot;   integer :: %s</font>
<font color="blue">&quot;,nls_ptr-&gt;name);
+      if (nls_ptr-&gt;vtype == REAL)      fortprintf(fd, &quot;   real (KIND=RKIND) :: %s</font>
<font color="blue">&quot;,nls_ptr-&gt;name);
+      if (nls_ptr-&gt;vtype == LOGICAL)   fortprintf(fd, &quot;   logical :: %s</font>
<font color="blue">&quot;,nls_ptr-&gt;name);
+      if (nls_ptr-&gt;vtype == CHARACTER) fortprintf(fd, &quot;   character (len=32) :: %s</font>
<font color="blue">&quot;,nls_ptr-&gt;name);
+
+      nls_ptr = nls_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+
+   /*
+    *  Generate namelist_defs.inc
+    */
+   fd = fopen(&quot;config_namelist_defs.inc&quot;, &quot;w&quot;);
+   dict_alloc(&amp;dictionary);
+
+   done = 0;
+  
+   while (!done) {
+      nls_ptr = nls;
+      while (nls_ptr &amp;&amp; dict_search(dictionary, nls_ptr-&gt;record))
+         nls_ptr = nls_ptr-&gt;next;
+
+      if (nls_ptr) {
+         dict_insert(dictionary, nls_ptr-&gt;record);
+         strncpy(nlrecord, nls_ptr-&gt;record, 1024);
+         fortprintf(fd, &quot;      namelist /%s/ %s&quot;, nls_ptr-&gt;record, nls_ptr-&gt;name);
+         nls_ptr = nls_ptr-&gt;next;
+         while(nls_ptr) {
+            if (strncmp(nls_ptr-&gt;record, nlrecord, 1024) == 0)
+               fortprintf(fd, &quot;, &amp;</font>
<font color="blue">                    %s&quot;, nls_ptr-&gt;name);
+            nls_ptr = nls_ptr-&gt;next;
+         }
+         fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+      }
+      else
+         done = 1;
+   }
+   
+
+   dict_free(&amp;dictionary);
+   fclose(fd);
+
+
+   /*
+    *  Generate namelist_reads.inc
+    */
+   fd = fopen(&quot;config_set_defaults.inc&quot;, &quot;w&quot;);
+   nls_ptr = nls;
+   while (nls_ptr) {
+      if (nls_ptr-&gt;vtype == INTEGER) fortprintf(fd, &quot;      %s = %i</font>
<font color="blue">&quot;, nls_ptr-&gt;name, nls_ptr-&gt;defval.ival);
+      if (nls_ptr-&gt;vtype == REAL)    fortprintf(fd, &quot;      %s = %f</font>
<font color="blue">&quot;, nls_ptr-&gt;name, nls_ptr-&gt;defval.rval);
+      if (nls_ptr-&gt;vtype == LOGICAL) {
+         if (nls_ptr-&gt;defval.lval == 0) 
+            fortprintf(fd, &quot;      %s = .false.</font>
<font color="blue">&quot;, nls_ptr-&gt;name);
+         else
+            fortprintf(fd, &quot;      %s = .true.</font>
<font color="blue">&quot;, nls_ptr-&gt;name);
+      }
+      if (nls_ptr-&gt;vtype == CHARACTER)
+         fortprintf(fd, &quot;      %s = \&quot;%s\&quot;</font>
<font color="blue">&quot;, nls_ptr-&gt;name, nls_ptr-&gt;defval.cval);
+      nls_ptr = nls_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+   fclose(fd);
+
+
+   fd = fopen(&quot;config_namelist_reads.inc&quot;, &quot;w&quot;);
+   dict_alloc(&amp;dictionary);
+   nls_ptr = nls;
+   while (nls_ptr) {
+      if (!dict_search(dictionary, nls_ptr-&gt;record)) {
+         fortprintf(fd, &quot;         read(funit,%s)</font>
<font color="blue">&quot;, nls_ptr-&gt;record);
+         dict_insert(dictionary, nls_ptr-&gt;record);
+      }
+      nls_ptr = nls_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+   dict_free(&amp;dictionary);
+   fclose(fd);
+
+
+   fd = fopen(&quot;config_bcast_namelist.inc&quot;, &quot;w&quot;);
+   nls_ptr = nls;
+   while (nls_ptr) {
+      if (nls_ptr-&gt;vtype == INTEGER)   fortprintf(fd, &quot;      call mpas_dmpar_bcast_int(dminfo, %s)</font>
<font color="blue">&quot;, nls_ptr-&gt;name);
+      if (nls_ptr-&gt;vtype == REAL)      fortprintf(fd, &quot;      call mpas_dmpar_bcast_real(dminfo, %s)</font>
<font color="blue">&quot;, nls_ptr-&gt;name);
+      if (nls_ptr-&gt;vtype == LOGICAL)   fortprintf(fd, &quot;      call mpas_dmpar_bcast_logical(dminfo, %s)</font>
<font color="blue">&quot;, nls_ptr-&gt;name);
+      if (nls_ptr-&gt;vtype == CHARACTER) fortprintf(fd, &quot;      call mpas_dmpar_bcast_char(dminfo, %s)</font>
<font color="blue">&quot;, nls_ptr-&gt;name);
+      nls_ptr = nls_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+   fclose(fd);
+}
+
+
+void gen_field_defs(struct group_list * groups, struct variable * vars, struct dimension * dims)
+{
+   struct variable * var_ptr;
+   struct variable * var_ptr2;
+   struct variable_list * var_list_ptr;
+   struct variable_list * var_list_ptr2;
+   struct dimension * dim_ptr;
+   struct dimension_list * dimlist_ptr;
+   struct group_list * group_ptr;
+   FILE * fd;
+   char super_array[1024];
+   char array_class[1024];
+   int i;
+   int class_start, class_end;
+   int vtype;
+
+
+   /*
+    *  Generate declarations of dimensions
+    */
+   fd = fopen(&quot;field_dimensions.inc&quot;, &quot;w&quot;);
+   dim_ptr = dims;
+   while (dim_ptr) {
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code);
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   dim_ptr = dims;
+   while (dim_ptr) {
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %sSolve</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code);
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %sSolve</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+
+   /*
+    *  Generate dummy dimension argument list
+    */
+   fd = fopen(&quot;dim_dummy_args.inc&quot;, &quot;w&quot;);
+   dim_ptr = dims;
+   if (dim_ptr &amp;&amp; dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
+      fortprintf(fd, &quot;                            %s&quot;, dim_ptr-&gt;name_in_code);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   else if (dim_ptr &amp;&amp; dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
+      fortprintf(fd, &quot;                            %s&quot;, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   while (dim_ptr) {
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;, %s&quot;, dim_ptr-&gt;name_in_code);
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;, %s&quot;, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot; &amp;</font>
<font color="blue">&quot;);
+
+   fclose(fd);
+
+
+   /*
+    *  Generate dummy dimension argument declaration list
+    */
+   fd = fopen(&quot;dim_dummy_decls.inc&quot;, &quot;w&quot;);
+   dim_ptr = dims;
+   if (dim_ptr &amp;&amp; dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
+      fortprintf(fd, &quot;      integer, intent(in) :: %s&quot;, dim_ptr-&gt;name_in_code);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   else if (dim_ptr &amp;&amp; dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
+      fortprintf(fd, &quot;      integer, intent(in) :: %s&quot;, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   while (dim_ptr) {
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;, %s&quot;, dim_ptr-&gt;name_in_code);
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;, %s&quot;, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+   fclose(fd);
+
+
+   /*
+    *  Generate declarations of dimensions
+    */
+   fd = fopen(&quot;dim_decls.inc&quot;, &quot;w&quot;);
+   dim_ptr = dims;
+   while (dim_ptr) {
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code);
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+
+   /*
+    *  Generate calls to read dimensions from input file
+    */
+   fd = fopen(&quot;read_dims.inc&quot;, &quot;w&quot;);
+   dim_ptr = dims;
+   while (dim_ptr) {
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      call mpas_io_input_get_dimension(input_obj, \'%s\', %s)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
+      else if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      call mpas_io_input_get_dimension(input_obj, \'%s\', %s)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+
+   /*
+    *  Generate declarations of mesh group
+    */
+   fd = fopen(&quot;time_invariant_fields.inc&quot;, &quot;w&quot;);
+   group_ptr = groups;
+   while (group_ptr) {
+
+      if (!strncmp(group_ptr-&gt;name, &quot;mesh&quot;, 1024)) {
+
+         var_list_ptr = group_ptr-&gt;vlist;
+         memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
+         i = 1;
+         while (var_list_ptr) {
+            if (strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) != 0) {
+               memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
+               i = 1;
+             }
+            if (strncmp(var_list_ptr-&gt;var-&gt;array_class, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: index_%s = %i</font>
<font color="blue">&quot;, var_list_ptr-&gt;var-&gt;name_in_code, i++);
+            var_list_ptr = var_list_ptr-&gt;next;
+         }
+
+         var_list_ptr = group_ptr-&gt;vlist;
+         memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
+         memcpy(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024);
+         class_start = 1;
+         class_end = 1;
+         i = 1;
+         while (var_list_ptr) {
+            if (strncmp(var_list_ptr-&gt;var-&gt;super_array, &quot;-&quot;, 1024) != 0) {
+               if (strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) != 0) {
+                  if (strncmp(super_array, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: %s_end = %i</font>
<font color="blue">&quot;, array_class, class_end);
+                  if (strncmp(super_array, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: num_%s = %i</font>
<font color="blue">&quot;, super_array, i);
+                  class_start = 1;
+                  class_end = 1;
+                  i = 1;
+                  memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
+                  memcpy(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024);
+                  fortprintf(fd, &quot;      integer :: %s_start = %i</font>
<font color="blue">&quot;, array_class, class_start);
+               }
+               else if (strncmp(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024) != 0) {
+                  fortprintf(fd, &quot;      integer :: %s_end = %i</font>
<font color="blue">&quot;, array_class, class_end);
+                  class_start = class_end+1;
+                  class_end = class_start;
+                  memcpy(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024);
+                  fortprintf(fd, &quot;      integer :: %s_start = %i</font>
<font color="blue">&quot;, array_class, class_start);
+                  i++;
+               }
+               else {
+                  class_end++;
+                  i++;
+               }
+            }
+            var_list_ptr = var_list_ptr-&gt;next;
+         }
+         if (strncmp(super_array, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: %s_end = %i</font>
<font color="blue">&quot;, array_class, class_end);
+         if (strncmp(super_array, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: num_%s = %i</font>
<font color="blue">&quot;, super_array, i);
+
+         var_list_ptr = group_ptr-&gt;vlist;
+         while (var_list_ptr) {
+            var_ptr = var_list_ptr-&gt;var;
+            if (!strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024)) {
+              if (var_ptr-&gt;vtype == INTEGER)   fortprintf(fd, &quot;      type (field%idInteger), pointer :: %s</font>
<font color="blue">&quot;, var_ptr-&gt;ndims, var_ptr-&gt;name_in_code);
+              if (var_ptr-&gt;vtype == REAL)      fortprintf(fd, &quot;      type (field%idReal), pointer :: %s</font>
<font color="blue">&quot;, var_ptr-&gt;ndims, var_ptr-&gt;name_in_code);
+              if (var_ptr-&gt;vtype == CHARACTER) fortprintf(fd, &quot;      type (field%idChar), pointer :: %s</font>
<font color="blue">&quot;, var_ptr-&gt;ndims, var_ptr-&gt;name_in_code);
+            }
+            else {
+              if (var_ptr-&gt;vtype == INTEGER)   fortprintf(fd, &quot;      type (field%idInteger), pointer :: %s</font>
<font color="blue">&quot;, var_ptr-&gt;ndims+1, var_ptr-&gt;super_array);
+              if (var_ptr-&gt;vtype == REAL)      fortprintf(fd, &quot;      type (field%idReal), pointer :: %s</font>
<font color="blue">&quot;, var_ptr-&gt;ndims+1, var_ptr-&gt;super_array);
+              if (var_ptr-&gt;vtype == CHARACTER) fortprintf(fd, &quot;      type (field%idChar), pointer :: %s</font>
<font color="blue">&quot;, var_ptr-&gt;ndims+1, var_ptr-&gt;super_array);
+              while (var_list_ptr-&gt;next &amp;&amp; !strncmp(var_list_ptr-&gt;next-&gt;var-&gt;super_array, var_list_ptr-&gt;var-&gt;super_array, 1024)) var_list_ptr = var_list_ptr-&gt;next;
+            }
+            var_list_ptr = var_list_ptr-&gt;next;
+         }
+         break;
+      }
+      group_ptr = group_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+
+   /*
+    *  Generate declarations of non-mesh groups
+    */
+   fd = fopen(&quot;variable_groups.inc&quot;, &quot;w&quot;);
+
+   group_ptr = groups;
+   while (group_ptr) {
+      if (strncmp(group_ptr-&gt;name, &quot;mesh&quot;, 1024)) {
+         fortprintf(fd, &quot;   type %s_type</font>
<font color="blue">&quot;, group_ptr-&gt;name);
+
+         var_list_ptr = group_ptr-&gt;vlist;
+         memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
+         i = 1;
+         while (var_list_ptr) {
+            if (strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) != 0) {
+               memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
+               i = 1;
+             }
+            if (strncmp(var_list_ptr-&gt;var-&gt;array_class, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: index_%s = %i</font>
<font color="blue">&quot;, var_list_ptr-&gt;var-&gt;name_in_code, i++);
+            var_list_ptr = var_list_ptr-&gt;next;
+         }
+
+         var_list_ptr = group_ptr-&gt;vlist;
+         sprintf(super_array, &quot;-&quot;);
+         sprintf(array_class, &quot;-&quot;);
+         class_start = 1;
+         class_end = 1;
+         i = 1;
+
+         while (var_list_ptr) {
+
+            /* Is the current variable in a super array? */
+            if (strncmp(var_list_ptr-&gt;var-&gt;super_array, &quot;-&quot;, 1024) != 0) {
+
+               /* Have we hit the beginning of a new super array? */
+               if (strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) != 0) {
+                  /* Finish off the previous super array? */
+                  if (strncmp(super_array, &quot;-&quot;, 1024) != 0) {
+                     fortprintf(fd, &quot;      integer :: %s_end = %i</font>
<font color="blue">&quot;, array_class, class_end);
+                     fortprintf(fd, &quot;      integer :: num_%s = %i</font>
<font color="blue">&quot;, super_array, i);
+                  }
+                  class_start = 1;
+                  class_end = 1;
+                  i = 1;
+                  memcpy(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024);
+                  memcpy(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024);
+                  fortprintf(fd, &quot;      integer :: %s_start = %i</font>
<font color="blue">&quot;, array_class, class_start);
+               }
+               /* Or have we hit the beginning of a new array class? */
+               else if (strncmp(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024) != 0) {
+                  fortprintf(fd, &quot;      integer :: %s_end = %i</font>
<font color="blue">&quot;, array_class, class_end);
+                  class_start = class_end+1;
+                  class_end = class_start;
+                  memcpy(array_class, var_list_ptr-&gt;var-&gt;array_class, 1024);
+                  fortprintf(fd, &quot;      integer :: %s_start = %i</font>
<font color="blue">&quot;, array_class, class_start);
+                  i++;
+               }
+               else {
+                  class_end++;
+                  i++;
+               }
+
+            }
+            var_list_ptr = var_list_ptr-&gt;next;
+
+         }
+         if (strncmp(super_array, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: %s_end = %i</font>
<font color="blue">&quot;, array_class, class_end);
+         if (strncmp(super_array, &quot;-&quot;, 1024) != 0) fortprintf(fd, &quot;      integer :: num_%s = %i</font>
<font color="blue">&quot;, super_array, i);
+
+         var_list_ptr = group_ptr-&gt;vlist;
+         while (var_list_ptr) {
+            var_ptr = var_list_ptr-&gt;var;
+            if (!strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024)) {
+              if (var_ptr-&gt;vtype == INTEGER)   fortprintf(fd, &quot;      type (field%idInteger), pointer :: %s</font>
<font color="blue">&quot;, var_ptr-&gt;ndims, var_ptr-&gt;name_in_code);
+              if (var_ptr-&gt;vtype == REAL)      fortprintf(fd, &quot;      type (field%idReal), pointer :: %s</font>
<font color="blue">&quot;, var_ptr-&gt;ndims, var_ptr-&gt;name_in_code);
+              if (var_ptr-&gt;vtype == CHARACTER) fortprintf(fd, &quot;      type (field%idChar), pointer :: %s</font>
<font color="blue">&quot;, var_ptr-&gt;ndims, var_ptr-&gt;name_in_code);
+            }
+            else {
+              if (var_ptr-&gt;vtype == INTEGER)   fortprintf(fd, &quot;      type (field%idInteger), pointer :: %s</font>
<font color="blue">&quot;, var_ptr-&gt;ndims+1, var_ptr-&gt;super_array);
+              if (var_ptr-&gt;vtype == REAL)      fortprintf(fd, &quot;      type (field%idReal), pointer :: %s</font>
<font color="blue">&quot;, var_ptr-&gt;ndims+1, var_ptr-&gt;super_array);
+              if (var_ptr-&gt;vtype == CHARACTER) fortprintf(fd, &quot;      type (field%idChar), pointer :: %s</font>
<font color="blue">&quot;, var_ptr-&gt;ndims+1, var_ptr-&gt;super_array);
+              while (var_list_ptr-&gt;next &amp;&amp; !strncmp(var_list_ptr-&gt;next-&gt;var-&gt;super_array, var_list_ptr-&gt;var-&gt;super_array, 1024)) var_list_ptr = var_list_ptr-&gt;next;
+            }
+            var_list_ptr = var_list_ptr-&gt;next;
+         }
+   
+         fortprintf(fd, &quot;   end type %s_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">&quot;, group_ptr-&gt;name);
+   
+         if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1) {
+            fortprintf(fd, &quot;   type %s_pointer_type</font>
<font color="blue">&quot;, group_ptr-&gt;name);
+            fortprintf(fd, &quot;      type (%s_type), pointer :: %s </font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+            fortprintf(fd, &quot;   end type %s_pointer_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">&quot;, group_ptr-&gt;name);
+   
+            fortprintf(fd, &quot;   type %s_multilevel_type</font>
<font color="blue">&quot;, group_ptr-&gt;name);
+            fortprintf(fd, &quot;      integer :: nTimeLevels</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;      type (%s_pointer_type), dimension(:), pointer :: time_levs</font>
<font color="blue">&quot;, group_ptr-&gt;name);
+            fortprintf(fd, &quot;   end type %s_multilevel_type</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">&quot;, group_ptr-&gt;name);
+         }
+   
+      }
+      group_ptr = group_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+   /*
+    *  Generate instantiations of variable groups in block_type
+    */
+   fd = fopen(&quot;block_group_members.inc&quot;, &quot;w&quot;);
+
+   group_ptr = groups;
+   while (group_ptr) {
+      if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1)
+         fortprintf(fd, &quot;      type (%s_multilevel_type), pointer :: %s</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+      else
+         fortprintf(fd, &quot;      type (%s_type), pointer :: %s</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+      group_ptr = group_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+
+   /* To be included in allocate_block */
+   fd = fopen(&quot;block_allocs.inc&quot;, &quot;w&quot;);
+   group_ptr = groups;
+   while (group_ptr) {
+      fortprintf(fd, &quot;      allocate(b %% %s)</font>
<font color="blue">&quot;, group_ptr-&gt;name);
+      if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1) {
+         fortprintf(fd, &quot;      b %% %s %% nTimeLevels = %i</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs);
+         fortprintf(fd, &quot;      allocate(b %% %s %% time_levs(%i))</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs);
+         fortprintf(fd, &quot;      do i=1,b %% %s %% nTimeLevels</font>
<font color="blue">&quot;, group_ptr-&gt;name);
+         fortprintf(fd, &quot;         allocate(b %% %s %% time_levs(i) %% %s)</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+         fortprintf(fd, &quot;         call mpas_allocate_%s(b %% %s %% time_levs(i) %% %s, &amp;</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name, group_ptr-&gt;name);
+         fortprintf(fd, &quot;#include \&quot;dim_dummy_args.inc\&quot;</font>
<font color="blue">&quot;);
+         fortprintf(fd, &quot;                         )</font>
<font color="blue">&quot;);
+         fortprintf(fd, &quot;      end do</font>
<font color="black"></font>
<font color="blue">&quot;);
+      }
+      else {
+         fortprintf(fd, &quot;      call mpas_allocate_%s(b %% %s, &amp;</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+         fortprintf(fd, &quot;#include \&quot;dim_dummy_args.inc\&quot;</font>
<font color="blue">&quot;);
+         fortprintf(fd, &quot;                      )</font>
<font color="black"></font>
<font color="blue">&quot;);
+      }
+      group_ptr = group_ptr-&gt;next;
+   }
+   fclose(fd);
+
+   
+   /* To be included in deallocate_block */
+   fd = fopen(&quot;block_deallocs.inc&quot;, &quot;w&quot;);
+   group_ptr = groups;
+   while (group_ptr) {
+      if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1) {
+         fortprintf(fd, &quot;      do i=1,b %% %s %% nTimeLevels</font>
<font color="blue">&quot;, group_ptr-&gt;name);
+         fortprintf(fd, &quot;         call mpas_deallocate_%s(b %% %s %% time_levs(i) %% %s)</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name, group_ptr-&gt;name);
+         fortprintf(fd, &quot;         deallocate(b %% %s %% time_levs(i) %% %s)</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+         fortprintf(fd, &quot;      end do</font>
<font color="blue">&quot;);
+         fortprintf(fd, &quot;      deallocate(b %% %s %% time_levs)</font>
<font color="blue">&quot;, group_ptr-&gt;name);
+      }
+      else {
+         fortprintf(fd, &quot;      call mpas_deallocate_%s(b %% %s)</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+      }
+      fortprintf(fd, &quot;      deallocate(b %% %s)</font>
<font color="black"></font>
<font color="blue">&quot;, group_ptr-&gt;name);
+      group_ptr = group_ptr-&gt;next;
+   }
+   fclose(fd);
+
+   /* Definitions of allocate subroutines */
+   fd = fopen(&quot;group_alloc_routines.inc&quot;, &quot;w&quot;);
+   group_ptr = groups;
+   while (group_ptr) {
+      fortprintf(fd, &quot;   subroutine mpas_allocate_%s(%s, &amp;</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+      fortprintf(fd, &quot;#include \&quot;dim_dummy_args.inc\&quot;</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;                         )</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;      implicit none</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;      type (%s_type), intent(inout) :: %s</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+      fortprintf(fd, &quot;#include \&quot;dim_dummy_decls.inc\&quot;</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+      if (!strncmp(group_ptr-&gt;name, &quot;mesh&quot;, 1024)) {
+         dim_ptr = dims;
+         while (dim_ptr) {
+            if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      %s %% %s = %s</font>
<font color="blue">&quot;, group_ptr-&gt;name, dim_ptr-&gt;name_in_code, dim_ptr-&gt;name_in_code);
+            if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      %s %% %s = %s</font>
<font color="blue">&quot;, group_ptr-&gt;name, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
+            dim_ptr = dim_ptr-&gt;next;
+         }
+         fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+      }
+
+
+      var_list_ptr = group_ptr-&gt;vlist;
+      while (var_list_ptr) {
+         var_ptr = var_list_ptr-&gt;var;
+         if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
+            memcpy(super_array, var_ptr-&gt;super_array, 1024);
+            memcpy(array_class, var_ptr-&gt;array_class, 1024);
+            i = 0;
+            while (var_list_ptr &amp;&amp; strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) == 0) {
+               i++;
+               var_list_ptr2 = var_list_ptr;
+               var_list_ptr = var_list_ptr-&gt;next;
+            }
+            var_ptr2 = var_list_ptr2-&gt;var;
+            fortprintf(fd, &quot;      allocate(%s %% %s)</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
+            fortprintf(fd, &quot;      allocate(%s %% %s %% ioinfo)</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
+            fortprintf(fd, &quot;      allocate(%s %% %s %% array(%i, &quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array, i);
+            dimlist_ptr = var_ptr2-&gt;dimlist;
+            if (!strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nCells&quot;, 1024) ||
+                !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nEdges&quot;, 1024) ||
+                !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nVertices&quot;, 1024))
+               if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;%s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+               else fortprintf(fd, &quot;%s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+            else
+               if (dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+               else fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+            dimlist_ptr = dimlist_ptr-&gt;next;
+            while (dimlist_ptr) {
+               if (!strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nCells&quot;, 1024) ||
+                   !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nEdges&quot;, 1024) ||
+                   !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nVertices&quot;, 1024))
+                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, %s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                  else fortprintf(fd, &quot;, %s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+               else
+                  if (dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  else fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+               dimlist_ptr = dimlist_ptr-&gt;next;
+            }
+            fortprintf(fd, &quot;))</font>
<font color="blue">&quot;);
+            if (var_ptr-&gt;vtype == INTEGER)
+               fortprintf(fd, &quot;      %s %% %s %% array = 0</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array ); /* initialize field to zero */
+            else if (var_ptr-&gt;vtype == REAL)
+               fortprintf(fd, &quot;      %s %% %s %% array = 0.0</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array ); /* initialize field to zero */
+            else if (var_ptr-&gt;vtype == CHARACTER)
+               fortprintf(fd, &quot;      %s %% %s %% array = \'\'</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array ); /* initialize field to zero */
+
+            if (var_ptr2-&gt;iostreams &amp; INPUT0) 
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% input = .true.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
+            else
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% input = .false.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
+
+            if (var_ptr2-&gt;iostreams &amp; SFC0) 
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% sfc = .true.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
+            else
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% sfc = .false.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
+
+            if (var_ptr2-&gt;iostreams &amp; RESTART0) 
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% restart = .true.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
+            else
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
+
+            if (var_ptr2-&gt;iostreams &amp; OUTPUT0) 
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% output = .true.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
+            else
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% output = .false.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr2-&gt;super_array);
+            fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         }
+         else {
+            fortprintf(fd, &quot;      allocate(%s %% %s)</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;      allocate(%s %% %s %% ioinfo)</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+            if (var_ptr-&gt;ndims &gt; 0) {
+               fortprintf(fd, &quot;      allocate(%s %% %s %% array(&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+               dimlist_ptr = var_ptr-&gt;dimlist;
+               if (!strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nCells&quot;, 1024) ||
+                   !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nEdges&quot;, 1024) ||
+                   !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nVertices&quot;, 1024))
+                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;%s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                  else fortprintf(fd, &quot;%s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+               else
+                  if (dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  else fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+               dimlist_ptr = dimlist_ptr-&gt;next;
+               while (dimlist_ptr) {
+                  if (!strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nCells&quot;, 1024) ||
+                      !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nEdges&quot;, 1024) ||
+                      !strncmp(dimlist_ptr-&gt;dim-&gt;name_in_file, &quot;nVertices&quot;, 1024))
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, %s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                     else fortprintf(fd, &quot;, %s + 1&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  else
+                     if (dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                     else fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                  dimlist_ptr = dimlist_ptr-&gt;next;
+               }
+               fortprintf(fd, &quot;))</font>
<font color="blue">&quot;);
+               if (var_ptr-&gt;vtype == INTEGER)
+                  fortprintf(fd, &quot;      %s %% %s %% array = 0</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code ); /* initialize field to zero */
+               else if (var_ptr-&gt;vtype == REAL)
+                  fortprintf(fd, &quot;      %s %% %s %% array = 0.0</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code ); /* initialize field to zero */
+               else if (var_ptr-&gt;vtype == CHARACTER)
+                  fortprintf(fd, &quot;      %s %% %s %% array = \'\'</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code ); /* initialize field to zero */
+
+            }
+            if (var_ptr-&gt;iostreams &amp; INPUT0) 
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% input = .true.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+            else
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% input = .false.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+
+            if (var_ptr-&gt;iostreams &amp; SFC0) 
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% sfc = .true.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+            else
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% sfc = .false.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+
+            if (var_ptr-&gt;iostreams &amp; RESTART0) 
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% restart = .true.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+            else
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% restart = .false.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+
+            if (var_ptr-&gt;iostreams &amp; OUTPUT0) 
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% output = .true.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+            else
+               fortprintf(fd, &quot;      %s %% %s %% ioinfo %% output = .false.</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+            var_list_ptr = var_list_ptr-&gt;next;
+         }
+      }
+
+      fortprintf(fd, &quot;   end subroutine mpas_allocate_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">&quot;, group_ptr-&gt;name);
+      group_ptr = group_ptr-&gt;next;
+   }
+   fclose(fd);
+   
+   /* Definitions of deallocate subroutines */
+   fd = fopen(&quot;group_dealloc_routines.inc&quot;, &quot;w&quot;);
+   group_ptr = groups;
+   while (group_ptr) {
+      fortprintf(fd, &quot;   subroutine mpas_deallocate_%s(%s)</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+      fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;      implicit none</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;      type (%s_type), intent(inout) :: %s</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+      fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+      var_list_ptr = group_ptr-&gt;vlist;
+      while (var_list_ptr) {
+         var_ptr = var_list_ptr-&gt;var;
+         if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
+            memcpy(super_array, var_ptr-&gt;super_array, 1024);
+            memcpy(array_class, var_ptr-&gt;array_class, 1024);
+            i = 0;
+            while (var_list_ptr &amp;&amp; strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) == 0) {
+               i++;
+               var_list_ptr2 = var_list_ptr;
+               var_list_ptr = var_list_ptr-&gt;next;
+            }
+            fortprintf(fd, &quot;      deallocate(%s %% %s %% array)</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_list_ptr2-&gt;var-&gt;super_array);
+            fortprintf(fd, &quot;      deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_list_ptr2-&gt;var-&gt;super_array);
+            fortprintf(fd, &quot;      deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="blue">&quot;, group_ptr-&gt;name, var_list_ptr2-&gt;var-&gt;super_array);
+         }
+         else {
+            if (var_ptr-&gt;ndims &gt; 0) {
+               fortprintf(fd, &quot;      deallocate(%s %% %s %% array)</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+               fortprintf(fd, &quot;      deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+               fortprintf(fd, &quot;      deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+            }
+            else {
+               fortprintf(fd, &quot;      deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+               fortprintf(fd, &quot;      deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="blue">&quot;, group_ptr-&gt;name, var_ptr-&gt;name_in_code);
+            }
+            var_list_ptr = var_list_ptr-&gt;next;
+         }
+      }
+
+      fortprintf(fd, &quot;   end subroutine mpas_deallocate_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">&quot;, group_ptr-&gt;name);
+      group_ptr = group_ptr-&gt;next;
+   }
+   fclose(fd);
+
+   /* Definitions of copy subroutines */
+   fd = fopen(&quot;group_copy_routines.inc&quot;, &quot;w&quot;);
+   group_ptr = groups;
+   while (group_ptr) {
+      fortprintf(fd, &quot;   subroutine mpas_copy_%s(dest, src)</font>
<font color="blue">&quot;, group_ptr-&gt;name);
+      fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;      implicit none</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;      type (%s_type), intent(in) :: src</font>
<font color="blue">&quot;, group_ptr-&gt;name);
+      fortprintf(fd, &quot;      type (%s_type), intent(inout) :: dest</font>
<font color="blue">&quot;, group_ptr-&gt;name);
+      fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+      var_list_ptr = group_ptr-&gt;vlist;
+      while (var_list_ptr) {
+         var_ptr = var_list_ptr-&gt;var;
+         if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
+            memcpy(super_array, var_ptr-&gt;super_array, 1024);
+            memcpy(array_class, var_ptr-&gt;array_class, 1024);
+            i = 0;
+            while (var_list_ptr &amp;&amp; strncmp(super_array, var_list_ptr-&gt;var-&gt;super_array, 1024) == 0) {
+               i++;
+               var_list_ptr2 = var_list_ptr;
+               var_list_ptr = var_list_ptr-&gt;next;
+            }
+            var_ptr2 = var_list_ptr2-&gt;var;
+            if (var_ptr2-&gt;ndims &gt; 0) 
+               fortprintf(fd, &quot;      dest %% %s %% array = src %% %s %% array</font>
<font color="blue">&quot;, var_ptr2-&gt;super_array, var_ptr2-&gt;super_array);
+            else
+               fortprintf(fd, &quot;      dest %% %s %% scalar = src %% %s %% scalar</font>
<font color="blue">&quot;, var_ptr2-&gt;super_array, var_ptr2-&gt;super_array);
+         }
+         else {
+            if (var_ptr-&gt;ndims &gt; 0) 
+               fortprintf(fd, &quot;      dest %% %s %% array = src %% %s %% array</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_code, var_ptr-&gt;name_in_code);
+            else
+               fortprintf(fd, &quot;      dest %% %s %% scalar = src %% %s %% scalar</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_code, var_ptr-&gt;name_in_code);
+            var_list_ptr = var_list_ptr-&gt;next;
+         }
+      }
+      fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;   end subroutine mpas_copy_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">&quot;, group_ptr-&gt;name);
+      group_ptr = group_ptr-&gt;next;
+   }
+   fclose(fd);
+
+   /* Definitions of shift_time_level subroutines */
+   fd = fopen(&quot;group_shift_level_routines.inc&quot;, &quot;w&quot;);
+   group_ptr = groups;
+   while (group_ptr) {
+      if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1) {
+         fortprintf(fd, &quot;   subroutine mpas_shift_time_levels_%s(%s)</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+         fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         fortprintf(fd, &quot;      implicit none</font>
<font color="blue">&quot;);
+         fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         fortprintf(fd, &quot;      type (%s_multilevel_type), intent(inout) :: %s</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+         fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         fortprintf(fd, &quot;      integer :: i</font>
<font color="blue">&quot;);
+         fortprintf(fd, &quot;      type (%s_type), pointer :: sptr</font>
<font color="blue">&quot;, group_ptr-&gt;name);
+         fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         fortprintf(fd, &quot;      sptr =&gt; %s %% time_levs(1) %% %s</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+         fortprintf(fd, &quot;      do i=1,%s %% nTimeLevels-1</font>
<font color="blue">&quot;, group_ptr-&gt;name);
+         fortprintf(fd, &quot;         %s %% time_levs(i) %% %s =&gt; %s %% time_levs(i+1) %% %s</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name, group_ptr-&gt;name, group_ptr-&gt;name);
+         fortprintf(fd, &quot;      end do</font>
<font color="blue">&quot;);
+         fortprintf(fd, &quot;      %s %% time_levs(%s %% nTimeLevels) %% %s =&gt; sptr</font>
<font color="blue">&quot;, group_ptr-&gt;name, group_ptr-&gt;name, group_ptr-&gt;name);
+         fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         fortprintf(fd, &quot;   end subroutine mpas_shift_time_levels_%s</font>
<font color="black"></font>
<font color="black"></font>
<font color="blue">&quot;, group_ptr-&gt;name);
+      }
+      group_ptr = group_ptr-&gt;next;
+   }
+   fclose(fd);

+}
+
+
+void gen_reads(struct group_list * groups, struct variable * vars, struct dimension * dims)
+{
+   struct variable * var_ptr;
+   struct variable_list * var_list_ptr;
+   struct dimension * dim_ptr;
+   struct dimension_list * dimlist_ptr, * lastdim;
+   struct group_list * group_ptr;
+   struct dtable * dictionary;
+   FILE * fd;
+   char vtype[5];
+   char fname[32];
+   char struct_deref[1024];
+   char * cp1, * cp2;
+   int i, j;
+   int ivtype;
+
+
+   /*
+    *  Generate declarations of IDs belonging in io_input_object
+    */
+   fd = fopen(&quot;io_input_obj_decls.inc&quot;, &quot;w&quot;);
+
+   fortprintf(fd, &quot;      integer :: rdDimIDTime</font>
<font color="blue">&quot;);
+   dim_ptr = dims;
+   while (dim_ptr) {
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: rdDimID%s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+   fortprintf(fd, &quot;      integer :: rdLocalTime</font>
<font color="blue">&quot;);
+   dim_ptr = dims;
+   while (dim_ptr) {
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: rdLocal%s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+   var_ptr = vars;
+   while (var_ptr) {
+      fortprintf(fd, &quot;      integer :: rdVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+      var_ptr = var_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+   /*
+    *  Definitions of read bounds and exchange lists for non-decomposed fields
+    */
+   fd = fopen(&quot;nondecomp_dims.inc&quot;, &quot;w&quot;);
+
+   dim_ptr = dims;
+   while (dim_ptr) {
+
+      if (strncmp(dim_ptr-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
+         ) {
+
+         if (is_derived_dim(dim_ptr-&gt;name_in_code)) {
+            fortprintf(fd, &quot;      integer :: read%sStart</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      integer :: read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+         }
+         else if (dim_ptr-&gt;constant_value &gt; 0) {
+            fortprintf(fd, &quot;      integer :: read%sStart</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      integer :: read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+         }
+         else if (dim_ptr-&gt;namelist_defined) {
+            fortprintf(fd, &quot;      integer :: read%sStart</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      integer :: read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+         }
+         else {
+            fortprintf(fd, &quot;      integer :: read%sStart</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      integer :: read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+         }
+      }
+
+      dim_ptr = dim_ptr-&gt;next;
+   }
+
+   fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+   dim_ptr = dims;
+   while (dim_ptr) {
+
+      if (strncmp(dim_ptr-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
+         ) {
+
+         if (is_derived_dim(dim_ptr-&gt;name_in_code)) {
+            fortprintf(fd, &quot;      read%sStart = 1</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      read%sCount = block %% mesh %% %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;      allocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      allocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      nullify(send%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      nullify(recv%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      recv%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      send%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      recv%sList %% nlist = read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      send%sList %% nlist = read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      allocate(recv%sList %% list(read%sCount))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      allocate(send%sList %% list(read%sCount))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      do i=1,read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         recv%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         send%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      end do</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         }
+         else if (dim_ptr-&gt;constant_value &gt; 0) {
+            fortprintf(fd, &quot;      read%sStart = 1</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      read%sCount = %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;      allocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      allocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      nullify(send%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      nullify(recv%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      recv%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      send%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      recv%sList %% nlist = read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      send%sList %% nlist = read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      allocate(recv%sList %% list(read%sCount))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      allocate(send%sList %% list(read%sCount))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      do i=1,read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         recv%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         send%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      end do</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         }
+         else if (dim_ptr-&gt;namelist_defined) {
+            fortprintf(fd, &quot;      read%sStart = 1</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      read%sCount = block %% mesh %% %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      allocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      allocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      nullify(send%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      nullify(recv%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      recv%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      send%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      recv%sList %% nlist = read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      send%sList %% nlist = read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      allocate(recv%sList %% list(read%sCount))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      allocate(send%sList %% list(read%sCount))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      do i=1,read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         recv%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         send%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      end do</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         }
+         else {
+            fortprintf(fd, &quot;      read%sStart = 1</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      read%sCount = block %% mesh %% %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;      allocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      allocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      nullify(send%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      nullify(recv%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      recv%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      send%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      recv%sList %% nlist = read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      send%sList %% nlist = read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      allocate(recv%sList %% list(read%sCount))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      allocate(send%sList %% list(read%sCount))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      do i=1,read%sCount</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;         recv%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;         send%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      end do</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         }
+
+      }
+
+      dim_ptr = dim_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+
+   /*
+    *  Deallocation of exchange lists for non-decomposed fields
+    */
+   fd = fopen(&quot;nondecomp_dims_dealloc.inc&quot;, &quot;w&quot;);
+
+   dim_ptr = dims;
+   while (dim_ptr) {
+
+      if (strncmp(dim_ptr-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
+         ) {
+
+         if (is_derived_dim(dim_ptr-&gt;name_in_code)) {
+            fortprintf(fd, &quot;      deallocate(recv%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      deallocate(send%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      deallocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      deallocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+         }
+         else if (dim_ptr-&gt;constant_value &gt; 0) {
+            fortprintf(fd, &quot;      deallocate(recv%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      deallocate(send%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      deallocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      deallocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+         }
+         else if (dim_ptr-&gt;namelist_defined) {
+            fortprintf(fd, &quot;      deallocate(recv%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      deallocate(send%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      deallocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      deallocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+         }
+         else {
+            fortprintf(fd, &quot;      deallocate(recv%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      deallocate(send%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      deallocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      deallocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+         }
+
+      }
+
+      dim_ptr = dim_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+
+   /*
+    *  Definitions of read bounds and exchange lists for non-decomposed fields
+    */
+   fd = fopen(&quot;nondecomp_outputs.inc&quot;, &quot;w&quot;);
+
+   dim_ptr = dims;
+   while (dim_ptr) {
+
+      if (strncmp(dim_ptr-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
+         ) {
+
+         if (is_derived_dim(dim_ptr-&gt;name_in_code)) {
+            fortprintf(fd, &quot;      integer :: %sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+         }
+         else if (dim_ptr-&gt;constant_value &gt; 0) {
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+         }
+         else if (dim_ptr-&gt;namelist_defined) {
+            fortprintf(fd, &quot;      integer :: %sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+         }
+         else {
+            fortprintf(fd, &quot;      integer :: %sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: send%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      type (exchange_list), pointer :: recv%sList</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+         }
+
+      }
+
+      dim_ptr = dim_ptr-&gt;next;
+   }
+
+   fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+   dim_ptr = dims;
+   while (dim_ptr) {
+
+      if (strncmp(dim_ptr-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
+         ) {
+
+         if (is_derived_dim(dim_ptr-&gt;name_in_code)) {
+            fortprintf(fd, &quot;      %sGlobal = domain %% blocklist %% mesh %% %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;         allocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         allocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         nullify(send%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         nullify(recv%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         recv%sList %% procID = 0</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         send%sList %% procID = 0</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         recv%sList %% nlist = %sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         send%sList %% nlist = %sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         allocate(recv%sList %% list(%sGlobal))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         allocate(send%sList %% list(%sGlobal))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         do i=1,%sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;            recv%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;            send%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         end do</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;      else</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;         nullify(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         nullify(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         }
+         else if (dim_ptr-&gt;constant_value &gt; 0) {
+            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;         allocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         allocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         nullify(send%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         nullify(recv%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         recv%sList %% procID = 0</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         send%sList %% procID = 0</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         recv%sList %% nlist = %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;         send%sList %% nlist = %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;         allocate(recv%sList %% list(%s))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;         allocate(send%sList %% list(%s))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;         do i=1,%s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;            recv%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;            send%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         end do</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;      else</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;         nullify(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         nullify(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         }
+         else if (dim_ptr-&gt;namelist_defined) {
+            fortprintf(fd, &quot;      %sGlobal = domain %% blocklist %% mesh %% %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;         allocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         allocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         nullify(send%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         nullify(recv%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         recv%sList %% procID = 0</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         send%sList %% procID = 0</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         recv%sList %% nlist = %sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         send%sList %% nlist = %sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         allocate(recv%sList %% list(%sGlobal))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         allocate(send%sList %% list(%sGlobal))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         do i=1,%sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;            recv%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;            send%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         end do</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;      else</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;         nullify(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         nullify(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         }
+         else {
+            fortprintf(fd, &quot;      %sGlobal = domain %% blocklist %% mesh %% %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;         allocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;         allocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;         nullify(send%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;         nullify(recv%sList %% next)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;         recv%sList %% procID = 0</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;         send%sList %% procID = 0</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;         recv%sList %% nlist = %sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;         send%sList %% nlist = %sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;         allocate(recv%sList %% list(%sGlobal))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;         allocate(send%sList %% list(%sGlobal))</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;         do i=1,%sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;            recv%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;            send%sList %% list(i) = i</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;         end do</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;      else</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;         nullify(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;         nullify(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+         }
+
+      }
+
+      dim_ptr = dim_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+
+   /*
+    *  Deallocation of exchange lists for non-decomposed fields
+    */
+   fd = fopen(&quot;nondecomp_outputs_dealloc.inc&quot;, &quot;w&quot;);
+
+   dim_ptr = dims;
+   while (dim_ptr) {
+
+      if (strncmp(dim_ptr-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
+          strncmp(dim_ptr-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
+         ) {
+
+         if (is_derived_dim(dim_ptr-&gt;name_in_code)) {
+            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;         deallocate(recv%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         deallocate(send%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         deallocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         deallocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+         }
+         else if (dim_ptr-&gt;constant_value &gt; 0) {
+            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;         deallocate(recv%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         deallocate(send%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         deallocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         deallocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+         }
+         else if (dim_ptr-&gt;namelist_defined) {
+            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;         deallocate(recv%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         deallocate(send%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         deallocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;         deallocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file+1);
+            fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+         }
+         else {
+            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">&quot;);
+            fortprintf(fd, &quot;         deallocate(recv%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;         deallocate(send%sList %% list)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;         deallocate(send%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;         deallocate(recv%sList)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code+1);
+            fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+         }
+
+      }
+
+      dim_ptr = dim_ptr-&gt;next;
+   }
+
+   fclose(fd);
+   
+
+   /*
+    *  Generate read and distribute code
+    */
+   fd = fopen(&quot;io_input_fields.inc&quot;, &quot;w&quot;);
+
+   group_ptr = groups;
+   while (group_ptr) {
+      var_list_ptr = group_ptr-&gt;vlist;
+      while (var_list_ptr) {
+         var_ptr = var_list_ptr-&gt;var;
+
+         if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1)
+            snprintf(struct_deref, 1024, &quot;block %% %s %% time_levs(1) %% %s&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+         else
+            snprintf(struct_deref, 1024, &quot;block %% %s&quot;, group_ptr-&gt;name);
+
+         i = 1;
+         dimlist_ptr = var_ptr-&gt;dimlist;
+         if (var_ptr-&gt;vtype == INTEGER) sprintf(vtype, &quot;int&quot;); 
+         else if (var_ptr-&gt;vtype == REAL) sprintf(vtype, &quot;real&quot;); 
+         else if (var_ptr-&gt;vtype == CHARACTER) sprintf(vtype, &quot;char&quot;); 
+   
+         if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
+            fortprintf(fd, &quot;      if ((%s %% %s %% ioinfo %% input .and. input_obj %% stream == STREAM_INPUT) .or. &amp;</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;super_array);
+            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% sfc .and. input_obj %% stream == STREAM_SFC) .or. &amp;</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;super_array);
+            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% restart .and. input_obj %% stream == STREAM_RESTART)) then</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;super_array);
+         }
+         else {
+            fortprintf(fd, &quot;      if ((%s %% %s %% ioinfo %% input .and. input_obj %% stream == STREAM_INPUT) .or. &amp;</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% sfc .and. input_obj %% stream == STREAM_SFC) .or. &amp;</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% restart .and. input_obj %% stream == STREAM_RESTART)) then</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;name_in_code);
+         }
+         while (dimlist_ptr) {
+               if (i &lt; var_ptr-&gt;ndims) {
+                  fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = 1</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i);
+                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                     else fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  else
+                     fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = %s</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
+               }
+               else {
+                  if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) {
+                     fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
+                     fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
+                  }
+                  else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) {
+                     fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                     fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  }
+                  else {
+                     if (dimlist_ptr-&gt;dim-&gt;namelist_defined) {
+                        fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
+                        fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
+                     }
+                     else {
+                        fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code+1);
+                        fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code+1);
+                     }
+                  }
+               }
+            dimlist_ptr = dimlist_ptr-&gt;next;
+            i++;
+         }
+   
+         if (var_ptr-&gt;ndims &gt; 0) {
+            fortprintf(fd, &quot;      allocate(%s%id %% array(&quot;, vtype, var_ptr-&gt;ndims);
+            i = 1;
+            dimlist_ptr = var_ptr-&gt;dimlist;
+      
+            if (i &lt; var_ptr-&gt;ndims) {
+               if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                  else fortprintf(fd, &quot;block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+               else
+                  fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+            }
+            else {
+               if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) 
+                  fortprintf(fd, &quot;read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
+               else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) 
+                  fortprintf(fd, &quot;read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+               else
+                  if (dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
+                  else fortprintf(fd, &quot;read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code+1);
+            }
+       
+            dimlist_ptr = dimlist_ptr-&gt;next;
+            i++;
+            while (dimlist_ptr) {
+               if (i &lt; var_ptr-&gt;ndims) {
+                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                     else fortprintf(fd, &quot;, block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  else
+                     fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+               }
+               else {
+                  if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code))
+                     fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
+                  else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0)
+                     fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  else
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code+1);
+                     else fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
+               }
+               dimlist_ptr = dimlist_ptr-&gt;next;
+               i++;
+            }
+            fortprintf(fd, &quot;))</font>
<font color="black"></font>
<font color="blue">&quot;);
+   
+            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
+               fortprintf(fd, &quot;      allocate(super_%s%id(&quot;, vtype, var_ptr-&gt;ndims);
+               i = 1;
+               dimlist_ptr = var_ptr-&gt;dimlist;
+         
+               if (i &lt; var_ptr-&gt;ndims) {
+                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                     else fortprintf(fd, &quot;block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  else
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                     else fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+               }
+               dimlist_ptr = dimlist_ptr-&gt;next;
+               i++;
+               while (dimlist_ptr) {
+                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                     else fortprintf(fd, &quot;, block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  else
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                     else fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+
+                  dimlist_ptr = dimlist_ptr-&gt;next;
+                  i++;
+               }
+               fortprintf(fd, &quot;))</font>
<font color="black"></font>
<font color="blue">&quot;);
+            }
+         }
+   
+         fortprintf(fd, &quot;      %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, var_ptr-&gt;name_in_file);
+         if (var_ptr-&gt;timedim)
+            fortprintf(fd, &quot;      call mpas_io_input_field_time(input_obj, %s%id)</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims);
+         else
+            fortprintf(fd, &quot;      call mpas_io_input_field(input_obj, %s%id)</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims);
+   
+         if (var_ptr-&gt;ndims &gt; 0) {
+            fortprintf(fd, &quot;      call mpas_dmpar_alltoall_field(dminfo, &amp;</font>
<font color="blue">&quot;);
+            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0)
+               fortprintf(fd, &quot;                                %s%id %% array, super_%s%id, &amp;</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, vtype, var_ptr-&gt;ndims);
+            else
+               fortprintf(fd, &quot;                                %s%id %% array, %s %% %s %% array, &amp;</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, struct_deref, var_ptr-&gt;name_in_code);
+      
+            i = 1;
+            dimlist_ptr = var_ptr-&gt;dimlist;
+            
+            if (i &lt; var_ptr-&gt;ndims)
+               if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;                                block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                  else fortprintf(fd, &quot;                                block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+               else
+                  fortprintf(fd, &quot;                                %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+            else {
+               lastdim = dimlist_ptr;
+               if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) {
+                  fortprintf(fd, &quot;                                read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
+               }
+               else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) {
+                  fortprintf(fd, &quot;                                read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+               }
+               else
+                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;                                read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code+1);
+                  else fortprintf(fd, &quot;                                read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
+            }
+       
+            dimlist_ptr = dimlist_ptr-&gt;next;
+            i++;
+            while (dimlist_ptr) {
+               if (i &lt; var_ptr-&gt;ndims)
+                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                     else fortprintf(fd, &quot;, block %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  else
+                     fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+               else {
+                  lastdim = dimlist_ptr;
+                  if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) {
+                     fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
+                  }
+                  else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) {
+                     fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  }
+                  else
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code+1);
+                     else fortprintf(fd, &quot;, read%sCount&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file+1);
+               }
+               dimlist_ptr = dimlist_ptr-&gt;next;
+               i++;
+            }
+            if (lastdim-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, block %% mesh %% %s, &amp;</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_file);
+            else if (lastdim-&gt;dim-&gt;constant_value &gt; 0) fortprintf(fd, &quot;, %s, &amp;</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_code);
+            else fortprintf(fd, &quot;, block %% mesh %% %s, &amp;</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_code);
+      
+            if (is_derived_dim(lastdim-&gt;dim-&gt;name_in_code)) 
+               fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_file+1, lastdim-&gt;dim-&gt;name_in_file+1);
+            else if (lastdim-&gt;dim-&gt;constant_value &gt; 0) 
+               fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_file, lastdim-&gt;dim-&gt;name_in_file);
+            else
+               if (lastdim-&gt;dim-&gt;namelist_defined) 
+                  fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_file+1, lastdim-&gt;dim-&gt;name_in_file+1);
+               else
+                  fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_code+1, lastdim-&gt;dim-&gt;name_in_code+1);
+   
+   
+            /* Copy from super_ array to field */
+            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
+               i = 1;
+               dimlist_ptr = var_ptr-&gt;dimlist;
+               while (i &lt;= var_ptr-&gt;ndims) {
+                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;      do i%i=1,block %% mesh %% %s</font>
<font color="blue">&quot;, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                     else fortprintf(fd, &quot;      do i%i=1,block %% mesh %% %s</font>
<font color="blue">&quot;, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  else
+                     fortprintf(fd, &quot;      do i%i=1,%s</font>
<font color="blue">&quot;, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
+      
+                  i++;
+                  dimlist_ptr = dimlist_ptr-&gt;next;
+               }
+      
+               fortprintf(fd, &quot;         %s %% %s %% array(%s %% index_%s,&quot;, struct_deref, var_ptr-&gt;super_array, struct_deref, var_ptr-&gt;name_in_code);
+
+               for(i=1; i&lt;=var_ptr-&gt;ndims; i++) {
+                  fortprintf(fd, &quot;i%i&quot;,i);
+                  if (i &lt; var_ptr-&gt;ndims) fortprintf(fd, &quot;,&quot;);
+               }
+               fortprintf(fd, &quot;) = super_%s%id(&quot;, vtype, var_ptr-&gt;ndims);
+               for(i=1; i&lt;=var_ptr-&gt;ndims; i++) {
+                  fortprintf(fd, &quot;i%i&quot;,i);
+                  if (i &lt; var_ptr-&gt;ndims) fortprintf(fd, &quot;,&quot;);
+               }
+               fortprintf(fd, &quot;)</font>
<font color="blue">&quot;);
+      
+               i = 1;
+               while (i &lt;= var_ptr-&gt;ndims) {
+                  fortprintf(fd, &quot;      end do</font>
<font color="blue">&quot;);
+                  i++;
+               }
+            }
+   
+            fortprintf(fd, &quot;      deallocate(%s%id %% array)</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims);
+            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0)
+               fortprintf(fd, &quot;      deallocate(super_%s%id)</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims);
+         }
+         else {
+            fortprintf(fd, &quot;      %s %% %s %% scalar = %s%id %% scalar</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;name_in_code, vtype, var_ptr-&gt;ndims);
+         }
+        
+         fortprintf(fd, &quot;      end if</font>
<font color="black"></font>
<font color="blue">&quot;);
+   
+         var_list_ptr = var_list_ptr-&gt;next;
+      }
+      group_ptr = group_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+
+   /*
+    *  Generate NetCDF reads of dimension and variable IDs
+    */
+   fd = fopen(&quot;netcdf_read_ids.inc&quot;, &quot;w&quot;);
+
+   fortprintf(fd, &quot;      nferr = nf_inq_unlimdim(input_obj %% rd_ncid, input_obj %% rdDimIDTime)</font>
<font color="blue">&quot;);
+   fortprintf(fd, &quot;      nferr = nf_inq_dimlen(input_obj %% rd_ncid, input_obj %% rdDimIDTime, input_obj %% rdLocalTime)</font>
<font color="blue">&quot;);
+   dim_ptr = dims;
+   while (dim_ptr) {
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
+         fortprintf(fd, &quot;      nferr = nf_inq_dimid(input_obj %% rd_ncid, \'%s\', input_obj %% rdDimID%s)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
+         fortprintf(fd, &quot;      nferr = nf_inq_dimlen(input_obj %% rd_ncid, input_obj %% rdDimID%s, input_obj %% rdLocal%s)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
+      }
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+   var_ptr = vars;
+   while (var_ptr) {
+      fortprintf(fd, &quot;      nferr = nf_inq_varid(input_obj %% rd_ncid, \'%s\', input_obj %% rdVarID%s)</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file, var_ptr-&gt;name_in_file);
+      var_ptr = var_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+
+   /*
+    *  Generate code to return dimension given its name
+    */
+   fd = fopen(&quot;get_dimension_by_name.inc&quot;, &quot;w&quot;);
+
+   dim_ptr = dims;
+   while (dim_ptr-&gt;constant_value &gt;= 0 || is_derived_dim(dim_ptr-&gt;name_in_code)) dim_ptr = dim_ptr-&gt;next;
+   if (!dim_ptr-&gt;namelist_defined) {
+      fortprintf(fd, &quot;      if (trim(dimname) == \'%s\') then</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code);
+      fortprintf(fd, &quot;         dimsize = input_obj %% rdLocal%s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+   }
+   else {
+      fortprintf(fd, &quot;      if (trim(dimname) == \'%s\') then</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+      fortprintf(fd, &quot;         dimsize = %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code);
+   }
+   dim_ptr = dim_ptr-&gt;next;
+   while (dim_ptr) {
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
+         if (!dim_ptr-&gt;namelist_defined) {
+            fortprintf(fd, &quot;      else if (trim(dimname) == \'%s\') then</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;         dimsize = input_obj %% rdLocal%s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+         }
+         else {
+            fortprintf(fd, &quot;      else if (trim(dimname) == \'%s\') then</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         dimsize = %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code);
+         }
+      }
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+
+   fclose(fd);
+   
+   
+   /*
+    *  Generate code to read 0d, 1d, 2d, 3d time-invariant fields
+    */
+   for(j=0; j&lt;3; j++) {
+      for(i=0; i&lt;=3; i++) {
+         if (j == 0) {
+            sprintf(fname, &quot;input_field%idinteger.inc&quot;, i);
+            ivtype = INTEGER;
+         }
+         else if (j == 1) {
+            sprintf(fname, &quot;input_field%idreal.inc&quot;, i);
+            ivtype = REAL;
+         }
+         else if (j == 2) {
+            sprintf(fname, &quot;input_field%idchar.inc&quot;, i);
+            ivtype = CHARACTER;
+         }
+         fd = fopen(fname, &quot;w&quot;);
+   
+         var_ptr = vars;
+         while (var_ptr &amp;&amp; (var_ptr-&gt;ndims != i || var_ptr-&gt;vtype != ivtype || var_ptr-&gt;timedim)) var_ptr = var_ptr-&gt;next;
+         if (var_ptr) {
+            fortprintf(fd, &quot;      if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         varID = input_obj %% rdVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+            var_ptr = var_ptr-&gt;next;
+            while (var_ptr) {
+               if (var_ptr-&gt;ndims == i &amp;&amp; var_ptr-&gt;vtype == ivtype &amp;&amp; !var_ptr-&gt;timedim) {
+                  fortprintf(fd, &quot;      else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+                  fortprintf(fd, &quot;         varID = input_obj %% rdVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+               }
+               var_ptr = var_ptr-&gt;next;
+            }
+            fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+         }
+      
+         fclose(fd);
+      } 
+   } 
+   
+   
+   /*
+    *  Generate code to read 0d, 1d, 2d, 3d time-varying fields
+    */
+   for(j=0; j&lt;2; j++) {
+      for(i=0; i&lt;=3; i++) { 
+         if (j == 0) {
+            sprintf(fname, &quot;input_field%idinteger_time.inc&quot;, i);
+            ivtype = INTEGER;
+         }
+         else {
+            sprintf(fname, &quot;input_field%idreal_time.inc&quot;, i);
+            ivtype = REAL;
+         }
+         fd = fopen(fname, &quot;w&quot;);
+      
+         var_ptr = vars;
+         while (var_ptr &amp;&amp; (var_ptr-&gt;ndims != i || var_ptr-&gt;vtype != ivtype || !var_ptr-&gt;timedim)) var_ptr = var_ptr-&gt;next;
+         if (var_ptr) {
+            fortprintf(fd, &quot;      if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         varID = input_obj %% rdVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+            var_ptr = var_ptr-&gt;next;
+            while (var_ptr) {
+               if (var_ptr-&gt;ndims == i &amp;&amp; var_ptr-&gt;vtype == ivtype &amp;&amp; var_ptr-&gt;timedim) {
+                  fortprintf(fd, &quot;      else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+                  fortprintf(fd, &quot;         varID = input_obj %% rdVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+               }
+               var_ptr = var_ptr-&gt;next;
+   
+            }
+            fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+         }
+   
+         fclose(fd);
+      }
+   } 
+   
+   
+   /*
+    *  Generate code to read 0d and 1d time-varying character fields
+    */
+   for(i=0; i&lt;=1; i++) { 
+      sprintf(fname, &quot;input_field%idchar_time.inc&quot;, i);
+      fd = fopen(fname, &quot;w&quot;);
+   
+      var_ptr = vars;
+      while (var_ptr &amp;&amp; (var_ptr-&gt;ndims != i || var_ptr-&gt;vtype != CHARACTER || !var_ptr-&gt;timedim)) var_ptr = var_ptr-&gt;next;
+      if (var_ptr) {
+         fortprintf(fd, &quot;      if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+         fortprintf(fd, &quot;         varID = input_obj %% rdVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+         var_ptr = var_ptr-&gt;next;
+         while (var_ptr) {
+            if (var_ptr-&gt;ndims == i &amp;&amp; var_ptr-&gt;vtype == CHARACTER &amp;&amp; var_ptr-&gt;timedim) {
+               fortprintf(fd, &quot;      else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+               fortprintf(fd, &quot;         varID = input_obj %% rdVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+            }
+            var_ptr = var_ptr-&gt;next;
+         }
+         fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+      }
+   
+      fclose(fd);
+   } 
+   
+}
+
+
+void gen_writes(struct group_list * groups, struct variable * vars, struct dimension * dims, struct namelist * namelists)
+{
+   struct variable * var_ptr;
+   struct variable_list * var_list_ptr;
+   struct dimension * dim_ptr;
+   struct dimension_list * dimlist_ptr, * lastdim;
+   struct group_list * group_ptr;
+   struct dtable * dictionary;
+   struct namelist * nl;
+   FILE * fd;
+   char vtype[5];
+   char fname[32];
+   char struct_deref[1024];
+   char * cp1, * cp2;
+   int i, j;
+   int ivtype;
+   
+   
+   /*
+    *  Generate declarations of IDs belonging in io_output_object
+    */
+   fd = fopen(&quot;io_output_obj_decls.inc&quot;, &quot;w&quot;);
+
+   fortprintf(fd, &quot;      integer :: wrDimIDTime</font>
<font color="blue">&quot;);
+   dim_ptr = dims;
+   while (dim_ptr) {
+      fortprintf(fd, &quot;      integer :: wrDimID%s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+   var_ptr = vars;
+   while (var_ptr) {
+      fortprintf(fd, &quot;      integer :: wrVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+      var_ptr = var_ptr-&gt;next;
+   }
+
+   fclose(fd);
+
+
+   /*
+    *  Generate declarations of temporary dimension variables used for arguments
+    */
+   fd = fopen(&quot;output_dim_actual_decls.inc&quot;, &quot;w&quot;);
+
+   dim_ptr = dims;
+   while (dim_ptr) {
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code);
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      integer :: %sGlobal</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+   fclose(fd);
+
+
+   /*
+    *  Generate initialization of temporary dimension variables used for arguments
+    */
+   fd = fopen(&quot;output_dim_inits.inc&quot;, &quot;w&quot;);
+
+   dim_ptr = dims;
+   while (dim_ptr) {
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      %sGlobal = block_ptr %% mesh %% %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_code, dim_ptr-&gt;name_in_code);
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;      %sGlobal = block_ptr %% mesh %% %s</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+   fclose(fd);
+
+
+   /*
+    *  Generate actual dimension argument list
+    */
+   fd = fopen(&quot;output_dim_actual_args.inc&quot;, &quot;w&quot;);
+   dim_ptr = dims;
+   if (dim_ptr &amp;&amp; dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) {
+      if (!dim_ptr-&gt;namelist_defined) fortprintf(fd, &quot;                            %sGlobal&quot;, dim_ptr-&gt;name_in_code);
+      else fortprintf(fd, &quot;                            %sGlobal&quot;, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   while (dim_ptr) {
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; !dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;, %sGlobal&quot;, dim_ptr-&gt;name_in_code);
+      if (dim_ptr-&gt;constant_value &lt; 0 &amp;&amp; dim_ptr-&gt;namelist_defined &amp;&amp; !is_derived_dim(dim_ptr-&gt;name_in_code)) fortprintf(fd, &quot;, %sGlobal&quot;, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot; &amp;</font>
<font color="blue">&quot;);
+
+   fclose(fd);
+
+
+   /*
+    *  Generate NetCDF calls to define dimensions, variables, and global attributes
+    */
+   fd = fopen(&quot;netcdf_def_dims_vars.inc&quot;, &quot;w&quot;);
+
+   fortprintf(fd, &quot;      nferr = nf_def_dim(output_obj %% wr_ncid, \'Time\', NF_UNLIMITED, output_obj %% wrDimIDTime)</font>
<font color="blue">&quot;);
+   dim_ptr = dims;
+   while (dim_ptr) {
+      fortprintf(fd, &quot;      nferr = nf_def_dim(output_obj %% wr_ncid, \'%s\', %s, output_obj %% wrDimID%s)</font>
<font color="blue">&quot;, dim_ptr-&gt;name_in_file, dim_ptr-&gt;name_in_code, dim_ptr-&gt;name_in_file);
+      dim_ptr = dim_ptr-&gt;next;
+   }
+   fortprintf(fd, &quot;</font>
<font color="blue">&quot;);
+
+   var_ptr = vars;
+   while (var_ptr) {
+      fortprintf(fd, &quot;      if (.false. &amp;</font>
<font color="blue">&quot;);
+      if (var_ptr-&gt;iostreams &amp; RESTART0) fortprintf(fd, &quot;          .or. output_obj %% stream == RESTART &amp;</font>
<font color="blue">&quot;);
+      if (var_ptr-&gt;iostreams &amp; OUTPUT0)  fortprintf(fd, &quot;          .or. output_obj %% stream == OUTPUT &amp;</font>
<font color="blue">&quot;);
+      if (var_ptr-&gt;iostreams &amp; SFC0)     fortprintf(fd, &quot;          .or. output_obj %% stream == SFC &amp;</font>
<font color="blue">&quot;);
+      fortprintf(fd, &quot;      ) then</font>
<font color="blue">&quot;);
+      dimlist_ptr = var_ptr-&gt;dimlist;
+      i = 1;
+      if (var_ptr-&gt;vtype == CHARACTER)
+         fortprintf(fd, &quot;      dimlist(%i) = output_obj %% wrDimIDStrLen</font>
<font color="blue">&quot;, i++);
+      while(dimlist_ptr) {
+         fortprintf(fd, &quot;      dimlist(%i) = output_obj %% wrDimID%s</font>
<font color="blue">&quot;, i++, dimlist_ptr-&gt;dim-&gt;name_in_file);
+         dimlist_ptr = dimlist_ptr-&gt;next;
+      }
+      if (var_ptr-&gt;timedim) fortprintf(fd, &quot;      dimlist(%i) = output_obj %% wrDimIDTime</font>
<font color="blue">&quot;, i++);
+      if (var_ptr-&gt;vtype == INTEGER)
+         fortprintf(fd, &quot;      nferr = nf_def_var(output_obj %% wr_ncid, \'%s\', NF_INT, %i, dimlist, output_obj %% wrVarID%s)</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file, var_ptr-&gt;ndims + var_ptr-&gt;timedim, var_ptr-&gt;name_in_file);
+      else if (var_ptr-&gt;vtype == REAL)
+         fortprintf(fd, &quot;      nferr = nf_def_var(output_obj %% wr_ncid, \'%s\', NF_DOUBLE, %i, dimlist, output_obj %% wrVarID%s)</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file, var_ptr-&gt;ndims + var_ptr-&gt;timedim, var_ptr-&gt;name_in_file);
+      else if (var_ptr-&gt;vtype == CHARACTER)
+         fortprintf(fd, &quot;      nferr = nf_def_var(output_obj %% wr_ncid, \'%s\', NF_CHAR, %i, dimlist, output_obj %% wrVarID%s)</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file, var_ptr-&gt;ndims + var_ptr-&gt;timedim + 1, var_ptr-&gt;name_in_file);
+
+      fortprintf(fd, &quot;      end if</font>
<font color="black"></font>
<font color="blue">&quot;);
+
+      var_ptr = var_ptr-&gt;next;
+   }
+
+   nl = namelists;
+   while (nl) {
+      if (nl-&gt;vtype == INTEGER)
+         fortprintf(fd, &quot;      nferr = nf_put_att_int(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', NF_INT, 1, %s)</font>
<font color="blue">&quot;, nl-&gt;name, nl-&gt;name);
+      else if (nl-&gt;vtype == REAL) {
+         fortprintf(fd, &quot;      if (RKIND == 8) then</font>
<font color="blue">&quot;, nl-&gt;name);
+         fortprintf(fd, &quot;         nferr = nf_put_att_double(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', NF_DOUBLE, 1, %s)</font>
<font color="blue">&quot;, nl-&gt;name, nl-&gt;name);
+         fortprintf(fd, &quot;      else if (RKIND == 4) then</font>
<font color="blue">&quot;, nl-&gt;name);
+         fortprintf(fd, &quot;         nferr = nf_put_att_real(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', NF_FLOAT, 1, %s)</font>
<font color="blue">&quot;, nl-&gt;name, nl-&gt;name);
+         fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+      }
+      else if (nl-&gt;vtype == CHARACTER)
+         fortprintf(fd, &quot;      nferr = nf_put_att_text(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', len_trim(%s), trim(%s))</font>
<font color="blue">&quot;, nl-&gt;name, nl-&gt;name, nl-&gt;name);
+      else if (nl-&gt;vtype == LOGICAL) {
+         fortprintf(fd, &quot;      if (%s) then</font>
<font color="blue">&quot;, nl-&gt;name);
+         fortprintf(fd, &quot;         nferr = nf_put_att_text(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', 1, \'T\')</font>
<font color="blue">&quot;, nl-&gt;name);
+         fortprintf(fd, &quot;      else</font>
<font color="blue">&quot;);
+         fortprintf(fd, &quot;         nferr = nf_put_att_text(output_obj %% wr_ncid, NF_GLOBAL, \'%s\', 1, \'F\')</font>
<font color="blue">&quot;, nl-&gt;name);
+         fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+      }
+      nl = nl-&gt;next;
+   }
+
+   fclose(fd);   
+   
+   
+   /*
+    *  Generate collect and write code
+    */
+   fd = fopen(&quot;io_output_fields.inc&quot;, &quot;w&quot;);
+
+   group_ptr = groups;
+   while (group_ptr) {
+      var_list_ptr = group_ptr-&gt;vlist;
+      while (var_list_ptr) {
+         var_ptr = var_list_ptr-&gt;var;
+
+         if (group_ptr-&gt;vlist-&gt;var-&gt;ntime_levs &gt; 1)
+            snprintf(struct_deref, 1024, &quot;domain %% blocklist %% %s %% time_levs(1) %% %s&quot;, group_ptr-&gt;name, group_ptr-&gt;name);
+         else
+            snprintf(struct_deref, 1024, &quot;domain %% blocklist %% %s&quot;, group_ptr-&gt;name);
+         
+         i = 1;
+         dimlist_ptr = var_ptr-&gt;dimlist;
+         if (var_ptr-&gt;vtype == INTEGER) sprintf(vtype, &quot;int&quot;); 
+         else if (var_ptr-&gt;vtype == REAL) sprintf(vtype, &quot;real&quot;); 
+         else if (var_ptr-&gt;vtype == CHARACTER) sprintf(vtype, &quot;char&quot;); 
+   
+         if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
+            fortprintf(fd, &quot;      if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &amp;</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;super_array);
+            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART) .or. &amp;</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;super_array);
+            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% sfc .and. output_obj %% stream == SFC)) then</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;super_array);
+         }
+         else {
+            fortprintf(fd, &quot;      if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &amp;</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART) .or. &amp;</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;name_in_code);
+            fortprintf(fd, &quot;          (%s %% %s %% ioinfo %% sfc .and. output_obj %% stream == SFC)) then</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;name_in_code);
+         }
+   
+         if (var_ptr-&gt;ndims &gt; 0) {
+            while (dimlist_ptr) {
+                  if (i &lt; var_ptr-&gt;ndims) {
+                     fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = 1</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i);
+                     if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                        if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                        else fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = domain %% blocklist %% mesh %% %s</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                     else
+                        fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = %s</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                  }
+                  else {
+                     fortprintf(fd, &quot;      %s%id %% ioinfo %% start(%i) = 1</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i);
+                     if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) {
+                        split_derived_dim_string(dimlist_ptr-&gt;dim-&gt;name_in_code, &amp;cp1, &amp;cp2);
+                        fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = n%sGlobal%s</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, cp1, cp2);
+                        free(cp1);
+                        free(cp2);
+                     }
+                     else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) {
+                        fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = %s</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                     }
+                     else
+                        if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                        else fortprintf(fd, &quot;      %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  }
+               dimlist_ptr = dimlist_ptr-&gt;next;
+               i++;
+            }
+      
+            fortprintf(fd, &quot;      allocate(%s%id %% array(&quot;, vtype, var_ptr-&gt;ndims);
+            i = 1;
+            dimlist_ptr = var_ptr-&gt;dimlist;
+      
+            if (i &lt; var_ptr-&gt;ndims)
+               if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                  else fortprintf(fd, &quot;domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+               else
+                  fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+            else {
+               if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) {
+                  split_derived_dim_string(dimlist_ptr-&gt;dim-&gt;name_in_code, &amp;cp1, &amp;cp2);
+                  fortprintf(fd, &quot;n%sGlobal%s&quot;, cp1, cp2);
+                  free(cp1);
+                  free(cp2);
+               }
+               else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) {
+                  fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+               }
+               else
+                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;%sGlobal&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                  else fortprintf(fd, &quot;%sGlobal&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+               lastdim = dimlist_ptr;
+            }
+            dimlist_ptr = dimlist_ptr-&gt;next;
+            i++;
+            while (dimlist_ptr) {
+               if (i &lt; var_ptr-&gt;ndims)
+                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                     else fortprintf(fd, &quot;, domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  else
+                     fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+               else {
+                  if (is_derived_dim(dimlist_ptr-&gt;dim-&gt;name_in_code)) {
+                     split_derived_dim_string(dimlist_ptr-&gt;dim-&gt;name_in_code, &amp;cp1, &amp;cp2);
+                     fortprintf(fd, &quot;, n%sGlobal%s&quot;, cp1, cp2);
+                     free(cp1);
+                     free(cp2);
+                  }
+                  else if (dimlist_ptr-&gt;dim-&gt;constant_value &gt; 0) {
+                     fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                  }
+                  else
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, %sGlobal&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                     else fortprintf(fd, &quot;, %sGlobal&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  lastdim = dimlist_ptr;
+               }
+               dimlist_ptr = dimlist_ptr-&gt;next;
+               i++;
+            }
+            fortprintf(fd, &quot;))</font>
<font color="black"></font>
<font color="blue">&quot;);
+   
+            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0) {
+               if (var_ptr-&gt;ndims &gt; 0) {
+                  fortprintf(fd, &quot;      allocate(super_%s%id(&quot;, vtype, var_ptr-&gt;ndims);
+                  i = 1;
+                  dimlist_ptr = var_ptr-&gt;dimlist;
+                  while (dimlist_ptr) {
+                     if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                        if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                        else fortprintf(fd, &quot;domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                     else
+                        fortprintf(fd, &quot;%s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+      
+                     if (i &lt; var_ptr-&gt;ndims) fortprintf(fd, &quot;, &quot;);
+         
+                     dimlist_ptr = dimlist_ptr-&gt;next;
+                     i++;
+                  }
+                  fortprintf(fd, &quot;))</font>
<font color="black"></font>
<font color="blue">&quot;);
+               }
+   
+               /* Copy from field to super_ array */
+               i = 1;
+               dimlist_ptr = var_ptr-&gt;dimlist;
+               while (i &lt;= var_ptr-&gt;ndims) {
+                  if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                     if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;      do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="blue">&quot;, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                     else fortprintf(fd, &quot;      do i%i=1,domain %% blocklist %% mesh %% %s</font>
<font color="blue">&quot;, i, dimlist_ptr-&gt;dim-&gt;name_in_file);
+                  else
+                     fortprintf(fd, &quot;      do i%i=1,%s</font>
<font color="blue">&quot;, i, dimlist_ptr-&gt;dim-&gt;name_in_code);
+   
+                  i++;
+                  dimlist_ptr = dimlist_ptr-&gt;next;
+               }
+   
+               fortprintf(fd, &quot;         super_%s%id(&quot;, vtype, var_ptr-&gt;ndims);
+               for(i=1; i&lt;=var_ptr-&gt;ndims; i++) {
+                  fortprintf(fd, &quot;i%i&quot;,i);
+                  if (i &lt; var_ptr-&gt;ndims) fortprintf(fd, &quot;,&quot;);
+               }
+               fortprintf(fd, &quot;) = %s %% %s %% array(&quot;, struct_deref, var_ptr-&gt;super_array);
+               fortprintf(fd, &quot;%s %% index_%s&quot;, struct_deref, var_ptr-&gt;name_in_code);
+               for(i=1; i&lt;=var_ptr-&gt;ndims; i++) {
+                  fortprintf(fd, &quot;,i%i&quot;,i);
+               }
+               fortprintf(fd, &quot;)</font>
<font color="blue">&quot;);
+   
+               i = 1;
+               while (i &lt;= var_ptr-&gt;ndims) {
+                  fortprintf(fd, &quot;      end do</font>
<font color="blue">&quot;);
+                  i++;
+               }
+            }
+   
+            fortprintf(fd, &quot;      %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, var_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      call mpas_dmpar_alltoall_field(domain %% dminfo, &amp;</font>
<font color="blue">&quot;);
+            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0)
+               fortprintf(fd, &quot;                                super_%s%id, %s%id %% array, &amp;</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, vtype, var_ptr-&gt;ndims);
+            else
+               fortprintf(fd, &quot;                                %s %% %s %% array, %s%id %% array, &amp;</font>
<font color="blue">&quot;, struct_deref, var_ptr-&gt;name_in_code, vtype, var_ptr-&gt;ndims);
+      
+            i = 1;
+            dimlist_ptr = var_ptr-&gt;dimlist;
+            
+            if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+               if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;                                domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+               else fortprintf(fd, &quot;                                domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+            else
+               fortprintf(fd, &quot;                                %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+       
+            dimlist_ptr = dimlist_ptr-&gt;next;
+            i++;
+            while (dimlist_ptr) {
+               if (dimlist_ptr-&gt;dim-&gt;constant_value &lt; 0)
+                  if (!dimlist_ptr-&gt;dim-&gt;namelist_defined) fortprintf(fd, &quot;, domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+                  else fortprintf(fd, &quot;, domain %% blocklist %% mesh %% %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_file);
+               else
+                  fortprintf(fd, &quot;, %s&quot;, dimlist_ptr-&gt;dim-&gt;name_in_code);
+      
+               dimlist_ptr = dimlist_ptr-&gt;next;
+               i++;
+            }     
+      
+            /* 
+             *  Need to avoid output_obj in case this is a non-decomposed dimension, in which case 
+             *   the send/recv lists are local variables 
+             */
+            if (strncmp(lastdim-&gt;dim-&gt;name_in_file,&quot;nCells&quot;,1024) != 0 &amp;&amp;
+                strncmp(lastdim-&gt;dim-&gt;name_in_file,&quot;nEdges&quot;,1024) != 0 &amp;&amp;
+                strncmp(lastdim-&gt;dim-&gt;name_in_file,&quot;nVertices&quot;,1024) != 0 &amp;&amp;
+                strncmp(lastdim-&gt;dim-&gt;name_in_file,&quot;nVertLevels&quot;,1024) != 0
+               ) {
+               if (is_derived_dim(lastdim-&gt;dim-&gt;name_in_code)) {
+                  split_derived_dim_string(lastdim-&gt;dim-&gt;name_in_code, &amp;cp1, &amp;cp2);
+                  fortprintf(fd, &quot;, n%sGlobal%s, &amp;</font>
<font color="blue">&quot;, cp1, cp2);
+                  fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_file+1, lastdim-&gt;dim-&gt;name_in_file+1);
+                  free(cp1);
+                  free(cp2);
+               }
+               else if (lastdim-&gt;dim-&gt;constant_value &gt; 0) {
+                  fortprintf(fd, &quot;, %s, &amp;</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_code);
+                  fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_file, lastdim-&gt;dim-&gt;name_in_file);
+               }
+               else {
+                  if (!lastdim-&gt;dim-&gt;namelist_defined) {
+                     fortprintf(fd, &quot;, %sGlobal, &amp;</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_code);
+                     fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_code+1, lastdim-&gt;dim-&gt;name_in_code+1);
+                  }
+                  else {
+                     fortprintf(fd, &quot;, %sGlobal, &amp;</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_file);
+                     fortprintf(fd, &quot;                                send%sList, recv%sList)</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_file+1, lastdim-&gt;dim-&gt;name_in_file+1);
+                  }
+               }
+            }
+            else {
+               if (is_derived_dim(lastdim-&gt;dim-&gt;name_in_code)) {
+                  split_derived_dim_string(lastdim-&gt;dim-&gt;name_in_code, &amp;cp1, &amp;cp2);
+                  fortprintf(fd, &quot;, n%sGlobal%s, &amp;</font>
<font color="blue">&quot;, cp1, cp2);
+                  fortprintf(fd, &quot;                                output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_file+1, lastdim-&gt;dim-&gt;name_in_file+1);
+                  free(cp1);
+                  free(cp2);
+               }
+               else {
+                  if (!lastdim-&gt;dim-&gt;namelist_defined) {
+                     fortprintf(fd, &quot;, %sGlobal, &amp;</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_code);
+                     fortprintf(fd, &quot;                                output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_code+1, lastdim-&gt;dim-&gt;name_in_code+1);
+                  }
+                  else {
+                     fortprintf(fd, &quot;, %sGlobal, &amp;</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_file);
+                     fortprintf(fd, &quot;                                output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="blue">&quot;, lastdim-&gt;dim-&gt;name_in_file+1, lastdim-&gt;dim-&gt;name_in_file+1);
+                  }
+               }
+            }
+         }
+         else {
+            fortprintf(fd, &quot;      %s%id %% ioinfo %% fieldName = \'%s\'</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, var_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;      %s%id %% scalar = %s %% %s %% scalar</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims, struct_deref, var_ptr-&gt;name_in_code);
+         }
+   
+         if (var_ptr-&gt;timedim)
+            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == IO_NODE) call mpas_io_output_field_time(output_obj, %s%id)</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims);
+         else
+            fortprintf(fd, &quot;      if (domain %% dminfo %% my_proc_id == IO_NODE) call mpas_io_output_field(output_obj, %s%id)</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims);
+         if (var_ptr-&gt;ndims &gt; 0) {
+            fortprintf(fd, &quot;      deallocate(%s%id %% array)</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims);
+            if (strncmp(var_ptr-&gt;super_array, &quot;-&quot;, 1024) != 0)
+               fortprintf(fd, &quot;      deallocate(super_%s%id)</font>
<font color="blue">&quot;, vtype, var_ptr-&gt;ndims);
+         }
+         fortprintf(fd, &quot;      end if</font>
<font color="black"></font>
<font color="blue">&quot;);
+   
+         var_list_ptr = var_list_ptr-&gt;next;
+      }
+      group_ptr = group_ptr-&gt;next;
+   }
+
+   fclose(fd);
+   
+   
+   /*
+    *  Generate code to write 0d, 1d, 2d, 3d time-invariant fields
+    */
+   for(j=0; j&lt;3; j++) {
+      for(i=0; i&lt;=3; i++) {
+         if (j == 0) {
+            sprintf(fname, &quot;output_field%idinteger.inc&quot;, i);
+            ivtype = INTEGER;
+         }
+         else if (j == 1) {
+            sprintf(fname, &quot;output_field%idreal.inc&quot;, i);
+            ivtype = REAL;
+         }
+         else if (j == 2) {
+            sprintf(fname, &quot;output_field%idchar.inc&quot;, i);
+            ivtype = CHARACTER;
+         }
+         fd = fopen(fname, &quot;w&quot;);
+   
+         var_ptr = vars;
+         while (var_ptr &amp;&amp; (var_ptr-&gt;ndims != i || var_ptr-&gt;vtype != ivtype || var_ptr-&gt;timedim)) var_ptr = var_ptr-&gt;next;
+         if (var_ptr) {
+            fortprintf(fd, &quot;      if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         varID = output_obj %% wrVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+            var_ptr = var_ptr-&gt;next;
+            while (var_ptr) {
+               if (var_ptr-&gt;ndims == i &amp;&amp; var_ptr-&gt;vtype == ivtype &amp;&amp; !var_ptr-&gt;timedim) {
+                  fortprintf(fd, &quot;      else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+                  fortprintf(fd, &quot;         varID = output_obj %% wrVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+               }
+               var_ptr = var_ptr-&gt;next;
+            }
+            fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+         }
+      
+         fclose(fd);
+      } 
+   } 
+
+   
+   /*
+    *  Generate code to write 0d, 1d, 2d, 3d time-varying fields
+    */
+   for(j=0; j&lt;2; j++) {
+      for(i=0; i&lt;=3; i++) {
+         if (j == 0) {
+            sprintf(fname, &quot;output_field%idinteger_time.inc&quot;, i);
+            ivtype = INTEGER;
+         }
+         else {
+            sprintf(fname, &quot;output_field%idreal_time.inc&quot;, i);
+            ivtype = REAL;
+         }
+         fd = fopen(fname, &quot;w&quot;);
+   
+         var_ptr = vars;
+         while (var_ptr &amp;&amp; (var_ptr-&gt;ndims != i || var_ptr-&gt;vtype != ivtype || !var_ptr-&gt;timedim)) var_ptr = var_ptr-&gt;next;
+         if (var_ptr) {
+            fortprintf(fd, &quot;      if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+            fortprintf(fd, &quot;         varID = output_obj %% wrVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+            var_ptr = var_ptr-&gt;next;
+            while (var_ptr) {
+               if (var_ptr-&gt;ndims == i &amp;&amp; var_ptr-&gt;vtype == ivtype &amp;&amp; var_ptr-&gt;timedim) {
+                  fortprintf(fd, &quot;      else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+                  fortprintf(fd, &quot;         varID = output_obj %% wrVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+               }
+               var_ptr = var_ptr-&gt;next;
+            }
+            fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+         }
+      
+         fclose(fd);
+      }
+   }
+
+   
+   /*
+    *  Generate code to write 0d and 1d character time-varying fields
+    */
+   for(i=0; i&lt;=1; i++) {
+      sprintf(fname, &quot;output_field%idchar_time.inc&quot;, i);
+      fd = fopen(fname, &quot;w&quot;);
+
+      var_ptr = vars;
+      while (var_ptr &amp;&amp; (var_ptr-&gt;ndims != i || var_ptr-&gt;vtype != CHARACTER || !var_ptr-&gt;timedim)) var_ptr = var_ptr-&gt;next;
+      if (var_ptr) {
+         fortprintf(fd, &quot;      if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+         fortprintf(fd, &quot;         varID = output_obj %% wrVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+         var_ptr = var_ptr-&gt;next;
+         while (var_ptr) {
+            if (var_ptr-&gt;ndims == i &amp;&amp; var_ptr-&gt;vtype == CHARACTER &amp;&amp; var_ptr-&gt;timedim) {
+               fortprintf(fd, &quot;      else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+               fortprintf(fd, &quot;         varID = output_obj %% wrVarID%s</font>
<font color="blue">&quot;, var_ptr-&gt;name_in_file);
+            }
+            var_ptr = var_ptr-&gt;next;
+         }
+         fortprintf(fd, &quot;      end if</font>
<font color="blue">&quot;);
+      }
+   
+      fclose(fd);
+   }
+   
+}

</font>
</pre>