<p><b>dwj07@fsu.edu</b> 2011-09-29 14:46:51 -0600 (Thu, 29 Sep 2011)</p><p><br>
-- BRANCH COMMIT --<br>
<br>
Migrating files to the new naming scheme.<br>
<br>
Also adding folds to files that didn't have them previously.<br>
</p><hr noshade><pre><font color="gray">Modified: branches/ocean_projects/performance/src/core_ocean/Makefile
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/Makefile 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/Makefile 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,47 +1,47 @@
.SUFFIXES: .F .o
-OBJS = module_mpas_core.o \
- module_test_cases.o \
- module_advection.o \
- module_OcnThickHadv.o \
- module_OcnThickVadv.o \
- module_OcnVelCoriolis.o \
- module_OcnVelVadv.o \
- module_OcnVelHmix.o \
- module_OcnVelHmixDel2.o \
- module_OcnVelHmixDel4.o \
- module_OcnVelForcing.o \
- module_OcnVelForcingWindStress.o \
- module_OcnVelForcingBottomDrag.o \
- module_OcnVelPressureGrad.o \
- module_OcnTracerVadv.o \
- module_OcnTracerVadvSpline.o \
- module_OcnTracerVadvSpline2.o \
- module_OcnTracerVadvSpline3.o \
- module_OcnTracerVadvStencil.o \
- module_OcnTracerVadvStencil2.o \
- module_OcnTracerVadvStencil3.o \
- module_OcnTracerVadvStencil4.o \
- module_OcnTracerHadv.o \
- module_OcnTracerHadv2.o \
- module_OcnTracerHadv3.o \
- module_OcnTracerHadv4.o \
- module_OcnTracerHmix.o \
- module_OcnTracerHmixDel2.o \
- module_OcnTracerHmixDel4.o \
- module_OcnVmix.o \
- module_OcnVmixCoefsConst.o \
- module_OcnVmixCoefsRich.o \
- module_OcnVmixCoefsTanh.o \
- module_OcnRestoring.o \
- module_OcnTendency.o \
- module_OcnTimeIntegration.o \
- module_OcnTimeIntegrationRK4.o \
- module_OcnTimeIntegrationSplit.o \
- module_OcnEquationOfState.o \
- module_OcnEquationOfStateJM.o \
- module_OcnEquationOfStateLinear.o \
- module_global_diagnostics.o
+OBJS = mpas_ocn_mpas_core.o \
+ mpas_ocn_test_cases.o \
+ mpas_ocn_advection.o \
+ mpas_ocn_thick_hadv.o \
+ mpas_ocn_thick_vadv.o \
+ mpas_ocn_vel_coriolis.o \
+ mpas_ocn_vel_vadv.o \
+ mpas_ocn_vel_hmix.o \
+ mpas_ocn_vel_hmix_del2.o \
+ mpas_ocn_vel_hmix_del4.o \
+ mpas_ocn_vel_forcing.o \
+ mpas_ocn_vel_forcing_windstress.o \
+ mpas_ocn_vel_forcing_bottomdrag.o \
+ mpas_ocn_vel_pressure_grad.o \
+ mpas_ocn_tracer_vadv.o \
+ mpas_ocn_tracer_vadv_spline.o \
+ mpas_ocn_tracer_vadv_spline2.o \
+ mpas_ocn_tracer_vadv_spline3.o \
+ mpas_ocn_tracer_vadv_stencil.o \
+ mpas_ocn_tracer_vadv_stencil2.o \
+ mpas_ocn_tracer_vadv_stencil3.o \
+ mpas_ocn_tracer_vadv_stencil4.o \
+ mpas_ocn_tracer_hadv.o \
+ mpas_ocn_tracer_hadv2.o \
+ mpas_ocn_tracer_hadv3.o \
+ mpas_ocn_tracer_hadv4.o \
+ mpas_ocn_tracer_hmix.o \
+ mpas_ocn_tracer_hmix_del2.o \
+ mpas_ocn_tracer_hmix_del4.o \
+ mpas_ocn_vmix.o \
+ mpas_ocn_vmix_coefs_const.o \
+ mpas_ocn_vmix_coefs_rich.o \
+ mpas_ocn_vmix_coefs_tanh.o \
+ mpas_ocn_restoring.o \
+ mpas_ocn_tendency.o \
+ mpas_ocn_time_integration.o \
+ mpas_ocn_time_integration_rk4.o \
+ mpas_ocn_time_integration_split.o \
+ mpas_ocn_equation_of_state.o \
+ mpas_ocn_equation_of_state_jm.o \
+ mpas_ocn_equation_of_state_linear.o \
+ mpas_ocn_global_diagnostics.o
all: core_hyd
@@ -49,131 +49,131 @@
core_hyd: $(OBJS)
ar -ru libdycore.a $(OBJS)
-module_test_cases.o:
+mpas_ocn_test_cases.o:
-module_advection.o:
+mpas_ocn_advection.o:
-module_OcnTimeIntegration.o: module_OcnTimeIntegrationRK4.o module_OcnTimeIntegrationSplit.o
+mpas_ocn_time_integration.o: mpas_ocn_time_integration_rk4.o mpas_ocn_time_integration_split.o
-module_OcnTimeIntegrationRK4.o:
+mpas_ocn_time_integration_rk4.o:
-module_OcnTimeIntegrationSplit.o:
+mpas_ocn_time_integration_split.o:
-module_OcnTendency.o:
+mpas_ocn_tendency.o:
-module_global_diagnostics.o:
+mpas_ocn_global_diagnostics.o:
-module_OcnThickHadv.o:
+mpas_ocn_thick_hadv.o:
-module_OcnThickVadv.o:
+mpas_ocn_thick_vadv.o:
-module_OcnVelPressureGrad.o:
+mpas_ocn_vel_pressure_grad.o:
-module_OcnVelVadv.o:
+mpas_ocn_vel_vadv.o:
-module_OcnVelHmix.o: module_OcnVelHmixDel2.o module_OcnVelHmixDel4.o
+mpas_ocn_vel_hmix.o: mpas_ocn_vel_hmix_del2.o mpas_ocn_vel_hmix_del4.o
-module_OcnVelHmixDel2.o:
+mpas_ocn_vel_hmix_del2.o:
-module_OcnVelHmixDel4.o:
+mpas_ocn_vel_hmix_del4.o:
-module_OcnVelForcing.o: module_OcnVelForcingWindStress.o module_OcnVelForcingBottomDrag.o
+mpas_ocn_vel_forcing.o: mpas_ocn_vel_forcing_windstress.o mpas_ocn_vel_forcing_bottomdrag.o
-module_OcnVelForcingWindStress.o:
+mpas_ocn_vel_forcing_windstress.o:
-module_OcnVelForcingBottomDrag.o:
+mpas_ocn_velforcing_bottomdrag.o:
-module_OcnVelCoriolis.o:
+mpas_ocn_vel_coriolis.o:
-module_OcnTracerHadv.o: module_OcnTracerHadv2.o module_OcnTracerHadv3.o module_OcnTracerHadv4.o
+mpas_ocn_tracer_hadv.o: mpas_ocn_tracer_hadv2.o mpas_ocn_tracer_hadv3.o mpas_ocn_tracer_hadv4.o
-module_OcnTracerHadv2.o:
+mpas_ocn_tracer_hadv2.o:
-module_OcnTracerHadv3.o:
+mpas_ocn_tracer_hadv3.o:
-module_OcnTracerHadv4.o:
+mpas_ocn_tracer_hadv4.o:
-module_OcnTracerVadv.o: module_OcnTracerVadvSpline.o module_OcnTracerVadvStencil.o
+mpas_ocn_tracer_vadv.o: mpas_ocn_tracer_vadv_spline.o mpas_ocn_tracer_vadv_stencil.o
-module_OcnTracerVadvSpline.o: module_OcnTracerVadvSpline2.o module_OcnTracerVadvSpline3.o
+mpas_ocn_tracer_vadv_spline.o: mpas_ocn_tracer_vadv_spline2.o mpas_ocn_tracer_vadv_spline3.o
-module_OcnTracerVadvSpline2.o:
+mpas_ocn_tracer_vadv_spline2.o:
-module_OcnTracerVadvSpline3.o:
+mpas_ocn_tracer_vadv_spline3.o:
-module_OcnTracerVadvStencil.o: module_OcnTracerVadvStencil2.o module_OcnTracerVadvStencil3.o module_OcnTracerVadvStencil4.o
+mpas_ocn_tracer_vadv_stencil.o: mpas_ocn_tracer_vadv_stencil2.o mpas_ocn_tracer_vadv_stencil3.o mpas_ocn_tracer_vadv_stencil4.o
-module_OcnTracerVadvStencil2.o:
+mpas_ocn_tracer_vadv_stencil2.o:
-module_OcnTracerVadvStencil3.o:
+mpas_ocn_tracer_vadv_stencil3.o:
-module_OcnTracerVadvStencil4.o:
+mpas_ocn_tracer_vadv_stencil4.o:
-module_OcnTracerHmix.o: module_OcnTracerHmixDel2.o module_OcnTracerHmixDel4.o
+mpas_ocn_tracer_hmix.o: mpas_ocn_tracer_hmix_del2.o mpas_ocn_tracer_hmix_del4.o
-module_OcnTracerHmixDel2.o:
+mpas_ocn_tracer_hmix_del2.o:
-module_OcnTracerHmixDel4.o:
+mpas_ocn_tracer_hmix_del4.o:
-module_OcnRestoring.o:
+mpas_ocn_restoring.o:
-module_OcnVmix.o: module_OcnVmixCoefsConst.o module_OcnVmixCoefsRich.o module_OcnVmixCoefsTanh.o
+mpas_ocn_vmix.o: mpas_ocn_vmix_coefs_const.o mpas_ocn_vmix_coefs_rich.o mpas_ocn_vmix_coefs_tanh.o
-module_OcnVmixCoefsConst.o:
+mpas_ocn_vmix_coefs_const.o:
-module_OcnVmixCoefsRich.o: module_OcnEquationOfState.o
+mpas_ocn_vmix_coefs_rich.o: mpas_ocn_equation_of_state.o
-module_OcnVmixCoefsTanh.o:
+mpas_ocn_vmix_coefs_tanh.o:
-module_OcnEquationOfState.o: module_OcnEquationOfStateJM.o module_OcnEquationOfStateLinear.o
+mpas_ocn_equation_of_state.o: mpas_ocn_equation_of_state_jm.o mpas_ocn_equation_of_state_linear.o
-module_OcnEquationOfStateJM.o:
+mpas_ocn_equation_of_state_jm.o:
-module_OcnEquationOfStateLinear.o:
+mpas_ocn_equation_of_state_linear.o:
+mpas_ocn_mpas_core.o: mpas_ocn_mpas_core.o \
+ mpas_ocn_test_cases.o \
+ mpas_ocn_advection.o \
+ mpas_ocn_thick_hadv.o \
+ mpas_ocn_thick_vadv.o \
+ mpas_ocn_vel_coriolis.o \
+ mpas_ocn_vel_vadv.o \
+ mpas_ocn_vel_hmix.o \
+ mpas_ocn_vel_hmix_del2.o \
+ mpas_ocn_vel_hmix_del4.o \
+ mpas_ocn_vel_forcing.o \
+ mpas_ocn_vel_forcing_windstress.o \
+ mpas_ocn_vel_forcing_bottomdrag.o \
+ mpas_ocn_vel_pressure_grad.o \
+ mpas_ocn_tracer_vadv.o \
+ mpas_ocn_tracer_vadv_spline.o \
+ mpas_ocn_tracer_vadv_spline2.o \
+ mpas_ocn_tracer_vadv_spline3.o \
+ mpas_ocn_tracer_vadv_stencil.o \
+ mpas_ocn_tracer_vadv_stencil2.o \
+ mpas_ocn_tracer_vadv_stencil3.o \
+ mpas_ocn_tracer_vadv_stencil4.o \
+ mpas_ocn_tracer_hadv.o \
+ mpas_ocn_tracer_hadv2.o \
+ mpas_ocn_tracer_hadv3.o \
+ mpas_ocn_tracer_hadv4.o \
+ mpas_ocn_tracer_hmix.o \
+ mpas_ocn_tracer_hmix_del2.o \
+ mpas_ocn_tracer_hmix_del4.o \
+ mpas_ocn_vmix.o \
+ mpas_ocn_vmix_coefs_const.o \
+ mpas_ocn_vmix_coefs_rich.o \
+ mpas_ocn_vmix_coefs_tanh.o \
+ mpas_ocn_restoring.o \
+ mpas_ocn_tendency.o \
+ mpas_ocn_time_integration.o \
+ mpas_ocn_time_integration_rk4.o \
+ mpas_ocn_time_integration_split.o \
+ mpas_ocn_equation_of_state.o \
+ mpas_ocn_equation_of_state_jm.o \
+ mpas_ocn_equation_of_state_linear.o \
+ mpas_ocn_global_diagnostics.o
-module_mpas_core.o: module_advection.o \
- module_OcnThickHadv.o \
- module_OcnThickVadv.o \
- module_global_diagnostics.o \
- module_test_cases.o \
- module_OcnVelCoriolis.o \
- module_OcnVelVadv.o \
- module_OcnVelHmix.o \
- module_OcnVelHmixDel2.o \
- module_OcnVelHmixDel4.o \
- module_OcnVelForcing.o \
- module_OcnVelForcingWindStress.o \
- module_OcnVelForcingBottomDrag.o \
- module_OcnVelPressureGrad.o \
- module_OcnTracerHadv.o \
- module_OcnTracerHadv2.o \
- module_OcnTracerHadv3.o \
- module_OcnTracerHadv4.o \
- module_OcnTracerVadv.o \
- module_OcnTracerVadvSpline.o \
- module_OcnTracerVadvSpline2.o \
- module_OcnTracerVadvSpline3.o \
- module_OcnTracerVadvStencil.o \
- module_OcnTracerVadvStencil2.o \
- module_OcnTracerVadvStencil3.o \
- module_OcnTracerVadvStencil4.o \
- module_OcnTracerHmix.o \
- module_OcnTracerHmixDel2.o \
- module_OcnTracerHmixDel4.o \
- module_OcnRestoring.o \
- module_OcnVmix.o \
- module_OcnVmixCoefsConst.o \
- module_OcnVmixCoefsRich.o \
- module_OcnVmixCoefsTanh.o \
- module_OcnEquationOfState.o \
- module_OcnEquationOfStateJM.o \
- module_OcnEquationOfStateLinear.o \
- module_OcnTendency.o \
- module_OcnTimeIntegration.o \
- module_OcnTimeIntegrationRK4.o \
- module_OcnTimeIntegrationSplit.o
-
clean:
$(RM) *.o *.mod *.f90 libdycore.a
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnEquationOfState.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnEquationOfState.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnEquationOfState.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,181 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnEquationOfState
-!
-!> \brief MPAS ocean equation of state driver
-!> \author Doug Jacobsen
-!> \date 28 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for calling
-!> the equation of state.
-!
-!-----------------------------------------------------------------------
-
-module OcnEquationOfState
-
- use grid_types
- use configure
- use timer
- use OcnEquationOfStateJM
- use OcnEquationOfStateLinear
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnEquationOfStateRho, &
- OcnEquationOfStateInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: eosON
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnEquationOfStateRho
-!
-!> \brief Calls equation of state
-!> \author Doug Jacobsen
-!> \date 28 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine calls the equation of state to update the density
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnEquationOfStateRho(s, grid, k_displaced, displacement_type)!{{{
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! 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<=0, state % rho is returned with no displaced
- ! If k_displaced>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 :: 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
-
- call timer_start("equation_of_state")
-
- if (config_eos_type.eq.'linear') then
-
- call OcnEquationOfStateLinearRho(s, grid, k_displaced, displacement_type)
-
- elseif (config_eos_type.eq.'jm') then
-
- tracers => s % tracers % array
- indexT = s % index_temperature
- indexS = s % index_salinity
-
- if(k_displaced == 0) then
- rho => s % rho % array
- else
- rho => s % rhoDisplaced % array
- endif
-
- call OcnEquationOfStateJMRho(grid, k_displaced, displacement_type, indexT, indexS, tracers, rho)
-! call equation_of_state_jm_bak(s, grid, k_displaced, displacement_type)
-
- else
- print *, ' Incorrect choice of config_eos_type:',&
- config_eos_type
- call dmpar_abort(dminfo)
- endif
-
- call timer_stop("equation_of_state")
-
- end subroutine OcnEquationOfStateRho!}}}
-
-!***********************************************************************
-!
-! routine OcnEquationOfStateInit
-!
-!> \brief Initializes ocean momentum horizontal mixing quantities
-!> \author Doug Jacobsen
-!> \date 28 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity mixing in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnEquationOfStateInit(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- integer :: err1, err2
-
- err = 0
- ! For an isopycnal model, density should remain constant.
- ! For zlevel, calculate in-situ density
- eosON = .false.
-
- if(config_vert_grid_type.eq.'zlevel') then
- eosON = .true.
-! call OcnEquationOfStateLinearInit(err1)
-! call OcnEquationOfStateJMInit(err2)
-
- err = err1 .or. err2
- endif
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnEquationOfStateInit!}}}
-
-!***********************************************************************
-
-end module OcnEquationOfState
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnEquationOfStateJM.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnEquationOfStateJM.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnEquationOfStateJM.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,351 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnEquationOfStateJM
-!
-!> \brief MPAS ocean equation of state driver
-!> \author Doug Jacobsen
-!> \date 28 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for calling
-!> the equation of state.
-!
-!-----------------------------------------------------------------------
-
-module OcnEquationOfStateJM
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnEquationOfStateJMRho, &
- OcnEquationOfStateJMInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnEquationOfStateJMRho
-!
-!> \brief Calls JM equation of state
-!> \author Doug Jacobsen
-!> \date 28 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine uses a JM equation of state to update the density
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnEquationOfStateJMRho(grid, k_displaced, displacement_type, indexT, indexS, tracers, rho)!{{{
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! 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<=0, density is returned with no displaced
- ! If k_displaced>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
-
- type (dm_info) :: dminfo
- integer :: iEdge, iCell, iVertex, k
-
- integer :: nCells, nEdges, nVertices, nVertLevels
-
-
- real (kind=RKIND), dimension(:), pointer :: &
- zMidZLevel, pRefEOS
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- rho
- real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
-
- integer, dimension(:), pointer :: maxLevelCell
-
- real (kind=RKIND) :: &
- TQ,SQ, &! adjusted T,S
- BULK_MOD, &! Bulk modulus
- RHO_S, &! density at the surface
- DRDT0, &! d(density)/d(temperature), for surface
- DRDS0, &! d(density)/d(salinity ), for surface
- DKDT, &! d(bulk modulus)/d(pot. temp.)
- DKDS, &! d(bulk modulus)/d(salinity )
- SQR,DENOMK, &! work arrays
- WORK1, WORK2, WORK3, WORK4, T2, depth
-
- real (kind=RKIND) :: &
- tmin, tmax, &! valid temperature range for level k
- smin, smax ! valid salinity range for level k
-
- real (kind=RKIND), dimension(:), allocatable :: &
- p, p2 ! temporary pressure scalars
-
-!-----------------------------------------------------------------------
-!
-! UNESCO EOS constants and JMcD bulk modulus constants
-!
-!-----------------------------------------------------------------------
-
- !*** for density of fresh water (standard UNESCO)
-
- real (kind=RKIND), parameter :: &
- unt0 = 999.842594, &
- unt1 = 6.793952e-2, &
- unt2 = -9.095290e-3, &
- unt3 = 1.001685e-4, &
- unt4 = -1.120083e-6, &
- unt5 = 6.536332e-9
-
- !*** for dependence of surface density on salinity (UNESCO)
-
- real (kind=RKIND), parameter :: &
- uns1t0 = 0.824493 , &
- uns1t1 = -4.0899e-3, &
- uns1t2 = 7.6438e-5, &
- uns1t3 = -8.2467e-7, &
- uns1t4 = 5.3875e-9, &
- unsqt0 = -5.72466e-3, &
- unsqt1 = 1.0227e-4, &
- unsqt2 = -1.6546e-6, &
- uns2t0 = 4.8314e-4
-
- !*** from Table A1 of Jackett and McDougall
-
- real (kind=RKIND), parameter :: &
- bup0s0t0 = 1.965933e+4, &
- bup0s0t1 = 1.444304e+2, &
- bup0s0t2 = -1.706103 , &
- bup0s0t3 = 9.648704e-3, &
- bup0s0t4 = -4.190253e-5
-
- real (kind=RKIND), parameter :: &
- bup0s1t0 = 5.284855e+1, &
- bup0s1t1 = -3.101089e-1, &
- bup0s1t2 = 6.283263e-3, &
- bup0s1t3 = -5.084188e-5
-
- real (kind=RKIND), parameter :: &
- bup0sqt0 = 3.886640e-1, &
- bup0sqt1 = 9.085835e-3, &
- bup0sqt2 = -4.619924e-4
-
- real (kind=RKIND), parameter :: &
- bup1s0t0 = 3.186519 , &
- bup1s0t1 = 2.212276e-2, &
- bup1s0t2 = -2.984642e-4, &
- bup1s0t3 = 1.956415e-6
-
- real (kind=RKIND), parameter :: &
- bup1s1t0 = 6.704388e-3, &
- bup1s1t1 = -1.847318e-4, &
- bup1s1t2 = 2.059331e-7, &
- bup1sqt0 = 1.480266e-4
-
- real (kind=RKIND), parameter :: &
- bup2s0t0 = 2.102898e-4, &
- bup2s0t1 = -1.202016e-5, &
- bup2s0t2 = 1.394680e-7, &
- bup2s1t0 = -2.040237e-6, &
- bup2s1t1 = 6.128773e-8, &
- bup2s1t2 = 6.207323e-10
-
- integer :: k_test, k_ref
-
- call timer_start("equation_of_state_jm")
-
- nCells = grid % nCells
- maxLevelCell => grid % maxLevelCell % array
- nVertLevels = grid % nVertLevels
- zMidZLevel => 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) &
- + 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 > nVertLevels is incompatible with 'absolute'
- ! so abort if necessary
-
- if (displacement_type == 'absolute' .and. &
- (k_displaced <= 0 .or. k_displaced > nVertLevels) ) then
- write(0,*) 'Abort: In equation_of_state_jm', &
- ' k_displaced must be between 1 and nVertLevels for ', &
- '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 + &
- (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 &
- + (uns2t0*SQ + WORK1 + WORK2)*SQ
-
- !***
- !*** now calculate bulk modulus at pressure p from
- !*** Jackett and McDougall formula
- !***
-
- WORK3 = bup0s1t0 + bup0s1t1*TQ + &
- (bup0s1t2 + bup0s1t3*TQ)*T2 + &
- p(k) *(bup1s1t0 + bup1s1t1*TQ + bup1s1t2*T2) + &
- p2(k)*(bup2s1t0 + bup2s1t1*TQ + bup2s1t2*T2)
- WORK4 = SQR*(bup0sqt0 + bup0sqt1*TQ + bup0sqt2*T2 + &
- bup1sqt0*p(k))
-
- BULK_MOD = bup0s0t0 + bup0s0t1*TQ + &
- (bup0s0t2 + bup0s0t3*TQ + bup0s0t4*T2)*T2 + &
- p(k) *(bup1s0t0 + bup1s0t1*TQ + &
- (bup1s0t2 + bup1s0t3*TQ)*T2) + &
- p2(k)*(bup2s0t0 + bup2s0t1*TQ + bup2s0t2*T2) + &
- 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("equation_of_state_jm")
-
- end subroutine OcnEquationOfStateJMRho!}}}
-
-!***********************************************************************
-!
-! routine OcnEquationOfStateJMInit
-!
-!> \brief Initializes ocean momentum horizontal mixing quantities
-!> \author Doug Jacobsen
-!> \date 28 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity mixing in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnEquationOfStateJMInit(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- integer :: err1, err2
- !--------------------------------------------------------------------
-
- end subroutine OcnEquationOfStateJMInit!}}}
-
-!***********************************************************************
-
-end module OcnEquationOfStateJM
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnEquationOfStateLinear.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnEquationOfStateLinear.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnEquationOfStateLinear.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,152 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnEquationOfStateLinear
-!
-!> \brief MPAS ocean equation of state driver
-!> \author Doug Jacobsen
-!> \date 28 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for calling
-!> the equation of state.
-!
-!-----------------------------------------------------------------------
-
-module OcnEquationOfStateLinear
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnEquationOfStateLinearRho, &
- OcnEquationOfStateLinearInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnEquationOfStateLinearRho
-!
-!> \brief Calls equation of state
-!> \author Doug Jacobsen
-!> \date 28 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine uses a linear equation of state to update the density
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnEquationOfStateLinearRho(s, grid, k_displaced, displacement_type)!{{{
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! 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<=0, state % rho is returned with no displaced
- ! If k_displaced>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 :: 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
- type (dm_info) :: dminfo
-
- call timer_start("equation_of_state_linear")
-
- rho => s % rho % array
- tracers => s % tracers % array
- maxLevelCell => grid % maxLevelCell % array
- nCells = grid % nCells
-
- do iCell=1,nCells
- do k=1,maxLevelCell(iCell)
- ! Linear equation of state
- rho(k,iCell) = 1000.0*( 1.0 &
- - 2.5e-4*tracers(s % index_temperature,k,iCell) &
- + 7.6e-4*tracers(s % index_salinity,k,iCell))
- end do
- end do
-
- call timer_stop("equation_of_state_linear")
-
- end subroutine OcnEquationOfStateLinearRho!}}}
-
-!***********************************************************************
-!
-! routine OcnEquationOfStateLinearInit
-!
-!> \brief Initializes ocean momentum horizontal mixing quantities
-!> \author Doug Jacobsen
-!> \date 28 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity mixing in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnEquationOfStateLinearInit(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- integer :: err1, err2
-
- err = 0
-
- !--------------------------------------------------------------------
-
- end subroutine OcnEquationOfStateLinearInit!}}}
-
-!***********************************************************************
-
-end module OcnEquationOfStateLinear
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnRestoring.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnRestoring.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnRestoring.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,199 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnRestoring
-!
-!> \brief MPAS ocean restoring
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> tendencies for restoring.
-!
-!-----------------------------------------------------------------------
-
-module OcnRestoring
-
- use grid_types
- use configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnRestoringTend, &
- OcnRestoringInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: restoringOn
-
- real (kind=RKIND) :: temperatureTimeScale, salinityTimeScale
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnRestoringTend
-!
-!> \brief Computes tendency term for restoring
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the restoring tendency for tracers
-!> based on current state.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnRestoringTend(grid, h, indexT, indexS, tracers, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h !< Input: thickness
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracer quantities
-
- integer, intent(in) :: indexT, indexS
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iCell, nCellsSolve, k
-
- real (kind=RKIND), dimension(:), pointer :: temperatureRestore, salinityRestore
-
- !-----------------------------------------------------------------
- !
- ! 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.restoringOn) return
-
- nCellsSolve = grid % nCellsSolve
-
- temperatureRestore => grid % temperatureRestore % array
- salinityRestore => grid % salinityRestore % array
-
- k = 1 ! restoring only in top layer
- do iCell=1,nCellsSolve
-
- tend(indexT, k, iCell) = tend(indexT, k, iCell) &
- - h(k,iCell)*(tracers(indexT, k, iCell) - temperatureRestore(iCell)) &
- / (temperatureTimeScale * 86400.0)
-
- tend(indexS, k, iCell) = tend(indexS, k, iCell) &
- - h(k,iCell)*(tracers(indexS, k, iCell) - salinityRestore(iCell)) &
- / (salinityTimeScale * 86400.0)
-
-! write(6,10) iCell, tracers(indexT, k, iCell), &
-! temperatureRestore(iCell), tracers(indexT, k, iCell), &
-! (tracers(indexT, k, iCell) - temperatureRestore(iCell)) &
-! / (config_restoreT_timescale * 86400.0)
-
- enddo
-
- !--------------------------------------------------------------------
-
- end subroutine OcnRestoringTend
-
-!***********************************************************************
-!
-! routine OcnRestoringInit
-!
-!> \brief Initializes ocean tracer horizontal mixing quantities
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity mixing in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnRestoringInit(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- err = 0
- restoringOn = .false.
-
- if(config_restoreTS) then
- restoringOn = .true.
- temperatureTimeScale = config_restoreT_timescale
- salinityTimeScale = config_restoreS_timescale
- endif
-
- !--------------------------------------------------------------------
-
- end subroutine OcnRestoringInit
-
-!***********************************************************************
-
-end module OcnRestoring
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTendency.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTendency.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTendency.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,1318 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTendency
-!
-!> \brief MPAS ocean tendency driver
-!> \author Doug Jacobsen
-!> \date 23 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the routines for computing
-!> various tendencies for the ocean. As well as routines
-!> for computing diagnostic variables, and other quantities
-!> such as wTop.
-!
-!-----------------------------------------------------------------------
-
-module OcnTendency
-
- use grid_types
- use configure
- use constants
- use timer
-
- use OcnThickHadv
- use OcnThickVadv
-
- use OcnVelCoriolis
- use OcnVelPressureGrad
- use OcnVelVadv
- use OcnVelHmix
- use OcnVelForcing
-
- use OcnTracerHadv
- use OcnTracerVadv
- use OcnTracerHmix
- use OcnRestoring
-
- use OcnEquationOfState
- use OcnVmix
-
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTendH, &
- OcnTendU, &
- OcnTendScalar, &
- OcnDiagnosticSolve, &
- OcnWtop, &
- OcnFUPerp
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTendH
-!
-!> \brief Computes thickness tendency
-!> \author Doug Jacobsen
-!> \date 23 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the thickness tendency for the ocean
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTendH(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, &
- vertex1, vertex2, eoe, i, j, err
-
-! mrp 110512 I just split compute_tend into compute_tend_u and OcnTendH.
-! 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, &
- upstream_bias, wTopEdge, rho0Inv, r
- real (kind=RKIND), dimension(:), pointer :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- zMidZLevel, zTopZLevel
- real (kind=RKIND), dimension(:,:), pointer :: &
- weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
- tend_h, circulation, vorticity, ke, ke_edge, pv_edge, &
- MontPot, wTop, divergence, vertViscTopOfEdge
- type (dm_info) :: dminfo
-
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
- integer, dimension(:,:), pointer :: &
- cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
- edgesOnEdge, edgesOnVertex
- real (kind=RKIND) :: u_diffusion
- real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
- 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("OcnTendH")
-
- h => s % h % array
- u => s % u % array
- v => s % v % array
- wTop => s % wTop % array
- h_edge => s % h_edge % array
- circulation => s % circulation % array
- vorticity => s % vorticity % array
- divergence => s % divergence % array
- ke => s % ke % array
- ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
- MontPot => s % MontPot % array
- pressure => s % pressure % array
- vertViscTopOfEdge => d % vertViscTopOfEdge % array
-
- weightsOnEdge => grid % weightsOnEdge % array
- kiteAreasOnVertex => grid % kiteAreasOnVertex % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnVertex => grid % cellsOnVertex % array
- verticesOnEdge => grid % verticesOnEdge % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- edgesOnCell => grid % edgesOnCell % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
- edgesOnEdge => grid % edgesOnEdge % array
- edgesOnVertex => grid % edgesOnVertex % array
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => grid % areaCell % array
- areaTriangle => grid % areaTriangle % array
- h_s => grid % h_s % array
- fVertex => grid % fVertex % array
- fEdge => grid % fEdge % array
- zMidZLevel => grid % zMidZLevel % array
- zTopZLevel => grid % zTopZLevel % array
- maxLevelCell => grid % maxLevelCell % array
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
-
- tend_h => 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("OcnTendH-horiz adv")
-
- call OcnThickHadvTend(grid, u, h_edge, tend_h, err)
-
- call timer_stop("OcnTendH-horiz adv")
-
- !
- ! height tendency: vertical advection term -d/dz(hw)
- !
- ! Vertical advection computed for top layer of a z grid only.
- call timer_start("OcnTendH-vert adv")
-
- call OcnThickVadvTend(grid, wTop, tend_h, err)
-
- call timer_stop("OcnTendH-vert adv")
- call timer_stop("OcnTendH")
-
- end subroutine OcnTendH!}}}
-
-!***********************************************************************
-!
-! routine OcnTendU
-!
-!> \brief Computes velocity tendency
-!> \author Doug Jacobsen
-!> \date 23 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the velocity tendency for the ocean
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTendU(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 OcnTendU and compute_tend_h.
-! Some of these variables can be removed, but at a later time.
- integer :: iEdge, iCell, iVertex, k, cell1, cell2, &
- vertex1, vertex2, eoe, i, j
-
- integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve, err
- real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, &
- upstream_bias, wTopEdge, rho0Inv, r, visc_vorticity_coef
- real (kind=RKIND), dimension(:), pointer :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
- real (kind=RKIND), dimension(:,:), pointer :: &
- weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
- tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
- MontPot, wTop, divergence, vertViscTopOfEdge
- type (dm_info) :: dminfo
-
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
- integer, dimension(:,:), pointer :: &
- cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
- edgesOnEdge, edgesOnVertex
- real (kind=RKIND) :: u_diffusion
- real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
- 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("OcnTendU")
-
- h => s % h % array
- u => s % u % array
- v => s % v % array
- wTop => s % wTop % array
- h_edge => s % h_edge % array
- circulation => s % circulation % array
- vorticity => s % vorticity % array
- divergence => s % divergence % array
- ke => s % ke % array
- ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
- MontPot => s % MontPot % array
- pressure => s % pressure % array
- vertViscTopOfEdge => d % vertViscTopOfEdge % array
-
- weightsOnEdge => grid % weightsOnEdge % array
- kiteAreasOnVertex => grid % kiteAreasOnVertex % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnVertex => grid % cellsOnVertex % array
- verticesOnEdge => grid % verticesOnEdge % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- edgesOnCell => grid % edgesOnCell % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
- edgesOnEdge => grid % edgesOnEdge % array
- edgesOnVertex => grid % edgesOnVertex % array
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => grid % areaCell % array
- areaTriangle => grid % areaTriangle % array
- h_s => grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
- fVertex => grid % fVertex % array
- fEdge => grid % fEdge % array
- zMidZLevel => grid % zMidZLevel % array
- zTopZLevel => grid % zTopZLevel % array
- maxLevelCell => grid % maxLevelCell % array
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
-
- tend_u => tend % u % array
-
- nCells = grid % nCells
- nEdges = grid % nEdges
- nEdgesSolve = grid % nEdgesSolve
- nVertices = grid % nVertices
- nVertLevels = grid % nVertLevels
-
- u_src => grid % u_src % array
-
- meshScalingDel2 => grid % meshScalingDel2 % array
- meshScalingDel4 => 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("OcnTendU-coriolis")
-
- call OcnVelCoriolisTend(grid, pv_edge, h_edge, u, ke, tend_u, err)
-
- call timer_stop("OcnTendU-coriolis")
-
- !
- ! velocity tendency: vertical advection term -w du/dz
- !
- call timer_start("OcnTendU-vert adv")
-
- call OcnVelVadvTend(grid, u, wTop, tend_u, err)
-
- call timer_stop("OcnTendU-vert adv")
-
- !
- ! velocity tendency: pressure gradient
- !
- call timer_start("OcnTendU-pressure grad")
-
- if (config_vert_grid_type.eq.'isopycnal') then
- call OcnVelPressureGradTend(grid, MontPot, tend_u, err)
- elseif (config_vert_grid_type.eq.'zlevel') then
- call OcnVelPressureGradTend(grid, pressure, tend_u, err)
- end if
-
- call timer_stop("OcnTendU-pressure grad")
-
- !
- ! 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("OcnTendU-horiz mix")
-
- call OcnVelHmixTend(grid, divergence, vorticity, tend_u, err)
-
- call timer_stop("OcnTendU-horiz mix")
-
- !
- ! 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("OcnTendU-forcings")
-
- call OcnVelForcingTend(grid, u, u_src, ke_edge, h_edge, tend_u, err)
-
- call timer_stop("OcnTendU-forcings")
-
- !
- ! velocity tendency: vertical mixing d/dz( nu_v du/dz))
- !
- if (.not.config_implicit_vertical_mix) then
- call timer_start("OcnTendU-explicit vert mix")
-
- call OcnVelVmixTendExplicit(grid, u, h_edge, vertViscTopOfEdge, tend_u, err)
-
- call timer_stop("OcnTendU-explicit vert mix")
- endif
- call timer_stop("OcnTendU")
-
- end subroutine OcnTendU!}}}
-
-!***********************************************************************
-!
-! routine OcnTendSalar
-!
-!> \brief Computes scalar tendency
-!> \author Doug Jacobsen
-!> \date 23 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the scalar (tracer) tendency for the ocean
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTendScalar(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,&
- 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 :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
- real (kind=RKIND), dimension(:,:), pointer :: &
- u,h,wTop, h_edge, vertDiffTopOfCell
- real (kind=RKIND), dimension(:,:,:), pointer :: &
- tracers, tend_tr
- integer, dimension(:,:), pointer :: boundaryEdge
- type (dm_info) :: dminfo
-
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
- integer, dimension(:,:), pointer :: cellsOnEdge, boundaryCell
- real (kind=RKIND), dimension(:), pointer :: zTopZLevel,zMidZLevel, &
- hRatioZLevelK, hRatioZLevelKm1, meshScalingDel2, meshScalingDel4
- real (kind=RKIND), dimension(:), allocatable:: tracer2ndDer, tracersIn, tracersOut, posZMidZLevel, &
- 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("OcnTendScalar")
-
- u => s % u % array
- h => s % h % array
- boundaryCell=> grid % boundaryCell % array
- wTop => s % wTop % array
- tracers => s % tracers % array
- h_edge => s % h_edge % array
- vertDiffTopOfCell => d % vertDiffTopOfCell % array
-
- tend_tr => tend % tracers % array
-
- areaCell => grid % areaCell % array
- cellsOnEdge => grid % cellsOnEdge % array
- dvEdge => grid % dvEdge % array
- dcEdge => grid % dcEdge % array
- zTopZLevel => grid % zTopZLevel % array
- zMidZLevel => grid % zMidZLevel % array
- hRatioZLevelK => grid % hRatioZLevelK % array
- hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
- boundaryEdge => grid % boundaryEdge % array
- maxLevelCell => grid % maxLevelCell % array
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
-
- nEdges = grid % nEdges
- nCells = grid % nCells
- nCellsSolve = grid % nCellsSolve
- nVertLevels = grid % nVertLevels
- num_tracers = s % num_tracers
-
- meshScalingDel2 => grid % meshScalingDel2 % array
- meshScalingDel4 => grid % meshScalingDel4 % array
-
-
- deriv_two => 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("OcnTendScalar-horiz adv")
-
- call OcnTracerHadvTend(grid, u, h_edge, tracers, tend_tr, err)
-
- call timer_stop("OcnTendScalar-horiz adv")
-
-
- !
- ! tracer tendency: vertical advection term -d/dz( h \phi w)
- !
-
- call timer_start("OcnTendScalar-vert adv")
-
- call OcnTracerVadvTend(grid, wTop, tracers, tend_tr, err)
-
- call timer_stop("OcnTendScalar-vert adv")
-
- !
- ! tracer tendency: del2 horizontal tracer diffusion, div(h \kappa_2 </font>
<font color="gray">abla \phi)
- !
- call timer_start("OcnTendScalar-horiz diff")
-
- call OcnTracerHmixTend(grid, h_edge, tracers, tend_tr, err)
-
- call timer_stop("OcnTendScalar-horiz diff")
-
-! mrp 110516 printing
-!print *, 'tend_tr 1',minval(tend_tr(3,1,1:nCells)),&
-! maxval(tend_tr(3,1,1:nCells))
-!print *, 'tracer 1',minval(tracers(3,1,1:nCells)),&
-! 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("OcnTendScalar-explicit vert diff")
-
- call OcnTracerVmixTendExplicit(grid, h, vertDiffTopOfCell, tracers, tend_tr, err)
-
- call timer_stop("OcnTendScalar-explicit vert diff")
- endif
-
-! mrp 110516 printing
-!print *, 'tend_tr 2',minval(tend_tr(3,1,1:nCells)),&
-! maxval(tend_tr(3,1,1:nCells))
-! mrp 110516 printing end
-
- !
- ! add restoring to T and S in top model layer
- !
- call timer_start("OcnTendScalar-restoring")
-
- call OcnRestoringTend(grid, h, s%index_temperature, s%index_salinity, tracers, tend_tr, err)
-
- call timer_stop("OcnTendScalar-restoring")
-
- 10 format(2i8,10e20.10)
- call timer_stop("OcnTendScalar")
-
- end subroutine OcnTendScalar!}}}
-
-!***********************************************************************
-!
-! routine OcnDiagnosticSolve
-!
-!> \brief Computes diagnostic variables
-!> \author Doug Jacobsen
-!> \date 23 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the diagnostic variables for the ocean
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnDiagnosticSolve(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
-
-
- real (kind=RKIND), dimension(:), pointer :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- hZLevel
- real (kind=RKIND), dimension(:,:), pointer :: &
- weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, w, pressure,&
- circulation, vorticity, ke, ke_edge, MontPot, wTop, &
- pv_edge, pv_vertex, pv_cell, gradPVn, gradPVt, divergence, &
- 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, &
- verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex, &
- boundaryEdge, boundaryCell
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &
- 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("OcnDiagnosticSolve")
-
- h => s % h % array
- u => s % u % array
- v => s % v % array
- wTop => s % wTop % array
- h_edge => s % h_edge % array
- circulation => s % circulation % array
- vorticity => s % vorticity % array
- divergence => s % divergence % array
- ke => s % ke % array
- ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
- pv_vertex => s % pv_vertex % array
- pv_cell => s % pv_cell % array
- gradPVn => s % gradPVn % array
- gradPVt => s % gradPVt % array
- rho => s % rho % array
- tracers => s % tracers % array
- MontPot => s % MontPot % array
- pressure => s % pressure % array
-
- weightsOnEdge => grid % weightsOnEdge % array
- kiteAreasOnVertex => grid % kiteAreasOnVertex % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnVertex => grid % cellsOnVertex % array
- verticesOnEdge => grid % verticesOnEdge % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- edgesOnCell => grid % edgesOnCell % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
- edgesOnEdge => grid % edgesOnEdge % array
- edgesOnVertex => grid % edgesOnVertex % array
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => grid % areaCell % array
- areaTriangle => grid % areaTriangle % array
- h_s => grid % h_s % array
- fVertex => grid % fVertex % array
- fEdge => grid % fEdge % array
- hZLevel => grid % hZLevel % array
- deriv_two => grid % deriv_two % array
- maxLevelCell => grid % maxLevelCell % array
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelEdgeBot => grid % maxLevelEdgeBot % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
- maxLevelVertexTop => grid % maxLevelVertexTop % array
-
- nCells = grid % nCells
- nEdges = grid % nEdges
- nVertices = grid % nVertices
- nVertLevels = grid % nVertLevels
- vertexDegree = grid % vertexDegree
-
- boundaryEdge => grid % boundaryEdge % array
- boundaryCell => 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("OcnDiagnosticSolve-hEdge")
-
- 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("OcnDiagnosticSolve-hEdge 2")
-
- 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("OcnDiagnosticSolve-hEdge 2")
-
- else if (config_thickness_adv_order == 3) then
- call timer_start("OcnDiagnosticSolve-hEdge 3")
-
- 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 + &
- 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 + &
- deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
- end do
-
- endif
-
- !-- if u > 0:
- if (u(k,iEdge) > 0) then
- h_edge(k,iEdge) = &
- 0.5*(h(k,cell1) + h(k,cell2)) &
- -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
- -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
- !-- else u <= 0:
- else
- h_edge(k,iEdge) = &
- 0.5*(h(k,cell1) + h(k,cell2)) &
- -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
- +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
- end if
-
- end do ! do k
- end do ! do iEdge
-
- call timer_stop("OcnDiagnosticSolve-hEdge 3")
- else if (config_thickness_adv_order == 4) then
- call timer_start("OcnDiagnosticSolve-hEdge 4")
-
- 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 + &
- 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 + &
- deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
- end do
-
- endif
-
- h_edge(k,iEdge) = &
- 0.5*(h(k,cell1) + h(k,cell2)) &
- -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.
-
- end do ! do k
- end do ! do iEdge
-
- call timer_stop("OcnDiagnosticSolve-hEdge 4")
- endif ! if(config_thickness_adv_order == 2)
- call timer_stop("OcnDiagnosticSolve-hEdge")
-
- !
- ! 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' &
- .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) &
- + kiteAreasOnVertex(i, iVertex) * pv_vertex(k, iVertex) &
- / 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)) &
- - pv_cell(k,cellsOnEdge(1,iEdge))) &
- / 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)) &
- - pv_vertex(k,verticesOnEdge(1,iEdge))) &
- /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) &
- - 0.5 * dt* ( u(k,iEdge) * gradPVn(k,iEdge) &
- + 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 OcnEquationOfStateRho(s, grid, 0, 'relative')
- ! mrp 110324 In order to visualize rhoDisplaced, include the following
- call OcnEquationOfStateRho(s, grid, 1, 'relative')
- 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 &
- * (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) &
- + 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 &
- * (h(1,iCell)-0.5*hZLevel(1))
-
- do k=2,maxLevelCell(iCell)
- pressure(k,iCell) = pressure(k-1,iCell) &
- + 0.5*gravity*( rho(k-1,iCell)*hZLevel(k-1) &
- + rho(k ,iCell)*hZLevel(k ))
- end do
-
- end do
-
- endif
-
- call OcnWtop(s,grid)
-
- call timer_stop("OcnDiagnosticSolve")
-
- end subroutine OcnDiagnosticSolve!}}}
-
-!***********************************************************************
-!
-! routine OcnWtop
-!
-!> \brief Computes vertical velocity
-!> \author Doug Jacobsen
-!> \date 23 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical velocity in the top layer for the ocean
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnWtop(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 :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- hZLevel
- real (kind=RKIND), dimension(:,:), pointer :: u,wTop
- real (kind=RKIND), dimension(:,:), allocatable:: div_u
-
- integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, &
- verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex, &
- boundaryEdge, boundaryCell
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &
- maxLevelVertexBot, maxLevelVertexTop
-
- call timer_start("wTop")
-
- u => s % u % array
- wTop => s % wTop % array
-
- areaCell => grid % areaCell % array
- cellsOnEdge => grid % cellsOnEdge % array
- hZLevel => grid % hZLevel % array
- maxLevelCell => grid % maxLevelCell % array
- maxLevelEdgeBot => grid % maxLevelEdgeBot % array
- dvEdge => grid % dvEdge % array
-
- 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) &
- - div_u(k,iCell)/areaCell(iCell)*hZLevel(k)
- end do
- end do
- deallocate(div_u)
-
- endif
-
- call timer_stop("wTop")
-
- end subroutine OcnWtop!}}}
-
-!***********************************************************************
-!
-! routine OcnFUPerp
-!
-!> \brief Computes f u_perp
-!> \author Doug Jacobsen
-!> \date 23 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes f u_perp for the ocean
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnFUPerp(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, &
- vertex1, vertex2, eoe, i, j
-
- integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
- real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, &
- upstream_bias, wTopEdge, rho0Inv, r
- real (kind=RKIND), dimension(:), pointer :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- zMidZLevel, zTopZLevel
- real (kind=RKIND), dimension(:,:), pointer :: &
- weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, uBcl, v, pressure, &
- tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
- MontPot, wTop, divergence, vertViscTopOfEdge
- type (dm_info) :: dminfo
-
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
- integer, dimension(:,:), pointer :: &
- cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
- edgesOnEdge, edgesOnVertex
- real (kind=RKIND) :: u_diffusion
- real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
- 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("OcnFUPerp")
-
- h => s % h % array
- u => s % u % array
- uBcl => s % uBcl % array
- v => s % v % array
- wTop => s % wTop % array
- h_edge => s % h_edge % array
- circulation => s % circulation % array
- vorticity => s % vorticity % array
- divergence => s % divergence % array
- ke => s % ke % array
- ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
- MontPot => s % MontPot % array
- pressure => s % pressure % array
-
- weightsOnEdge => grid % weightsOnEdge % array
- kiteAreasOnVertex => grid % kiteAreasOnVertex % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnVertex => grid % cellsOnVertex % array
- verticesOnEdge => grid % verticesOnEdge % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- edgesOnCell => grid % edgesOnCell % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
- edgesOnEdge => grid % edgesOnEdge % array
- edgesOnVertex => grid % edgesOnVertex % array
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => grid % areaCell % array
- areaTriangle => grid % areaTriangle % array
- h_s => grid % h_s % array
- fVertex => grid % fVertex % array
- fEdge => grid % fEdge % array
- zMidZLevel => grid % zMidZLevel % array
- zTopZLevel => grid % zTopZLevel % array
- maxLevelCell => grid % maxLevelCell % array
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
-
-
- nCells = grid % nCells
- nEdges = grid % nEdges
- nEdgesSolve = grid % nEdgesSolve
- nVertices = grid % nVertices
- nVertLevels = grid % nVertLevels
-
- !
- ! 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("OcnFUPerp")
-
- end subroutine OcnFUPerp!}}}
-
-!***********************************************************************
-
-end module OcnTendency
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-! vim: foldmethod=marker
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnThickHadv.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnThickHadv.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnThickHadv.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,210 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnThickHadv
-!
-!> \brief MPAS ocean horizontal advection for thickness
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the routine for computing
-!> tendencies for thickness from horizontal advection
-!
-!-----------------------------------------------------------------------
-
-module OcnThickHadv
-
- use grid_types
- use configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnThickHadvTend, &
- OcnThickHadvInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnThickHadvTend
-!
-!> \brief Computes tendency term from horizontal advection of thickness
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal advection tendency for
-!> thicknes based on current state and user choices of forcings.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnThickHadvTend(grid, u, h_edge, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: velocity
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 => grid % maxLevelEdgeTop % array
- cellsOnEdge => grid % cellsOnEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => 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 OcnThickHadvTend
-
-!***********************************************************************
-!
-! routine OcnThickHadvInit
-!
-!> \brief Initializes ocean forcings
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes quantities related to forcings
-!> in the ocean. Since a multiple forcings are available,
-!> this routine primarily calls the
-!> individual init routines for each forcing.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnThickHadvInit(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- err = 0
-
- !--------------------------------------------------------------------
-
- end subroutine OcnThickHadvInit
-
-!***********************************************************************
-
-end module OcnThickHadv
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnThickVadv.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnThickVadv.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnThickVadv.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,164 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnThickVadv
-!
-!> \brief MPAS ocean vertical advection for thickness
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the routine for computing
-!> tendencies for thickness from vertical advection
-!
-!-----------------------------------------------------------------------
-
-module OcnThickVadv
-
- use grid_types
- use configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnThickVadvTend, &
- OcnThickVadvInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnThickVadvTend
-!
-!> \brief Computes tendency term from vertical advection of thickness
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for
-!> thicknes based on current state and user choices of forcings.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnThickVadvTend(grid, wTop, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- wTop !< Input: vertical velocity on top layer
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 OcnThickVadvTend!}}}
-
-!***********************************************************************
-!
-! routine OcnThickVadvInit
-!
-!> \brief Initializes ocean forcings
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes quantities related to forcings
-!> in the ocean. Since a multiple forcings are available,
-!> this routine primarily calls the
-!> individual init routines for each forcing.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnThickVadvInit(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- err = 0
-
- !--------------------------------------------------------------------
-
- end subroutine OcnThickVadvInit!}}}
-
-!***********************************************************************
-
-end module OcnThickVadv
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTimeIntegration.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTimeIntegration.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTimeIntegration.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,137 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTimeIntegration
-!
-!> \brief MPAS ocean time integration driver
-!> \author Doug Jacobsen
-!> \date 26 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for calling
-!> the time integration scheme
-!
-!-----------------------------------------------------------------------
-
-module OcnTimeIntegration
-
- use grid_types
- use configure
- use constants
- use dmpar
- use vector_reconstruction
- use spline_interpolation
- use timer
-
- use OcnTimeIntegrationRK4
- use OcnTimeIntegrationSplit
-
- use OcnEquationOfState
- use OcnVmix
-
- implicit none
- private
- save
-
- public :: OcnTimestep, &
- OcnTimestepInit
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: rk4On, splitOn
-
- contains
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTimestep
-!
-!> \brief MPAS ocean time integration driver
-!> \author Doug Jacobsen
-!> \date 26 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This routine handles a single timestep for the ocean. It determines
-!> the time integrator that will be used for the run, and calls the
-!> appropriate one.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTimestep(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 OcnTimeIntegratorRK4(domain, dt)
- elseif (splitOn) then
- call OcnTimeIntegratorSplit(domain, dt)
- endif
-
- block => 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 => block % next
- end do
-
- end subroutine OcnTimestep!}}}
-
- subroutine OcnTimestepInit(err)!{{{
-
- integer, intent(out) :: err
-
- rk4On = .false.
- splitOn = .false.
-
- if (trim(config_time_integration) == 'RK4') then
- rk4On = .true.
- elseif (trim(config_time_integration) == 'split_explicit' &
- .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 OcnTimestepInit!}}}
-
-end module OcnTimeIntegration
-
-! vim: foldmethod=marker
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTimeIntegrationRK4.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTimeIntegrationRK4.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTimeIntegrationRK4.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,651 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTimeIntegrationRK4
-!
-!> \brief MPAS ocean RK4 Time integration scheme
-!> \author Doug Jacobsen
-!> \date 26 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the RK4 time integration routine.
-!
-!-----------------------------------------------------------------------
-
-module OcnTimeIntegrationRK4
-
- use grid_types
- use configure
- use constants
- use dmpar
- use vector_reconstruction
- use spline_interpolation
- use timer
-
- use OcnTendency
-
- use OcnEquationOfState
- use OcnVmix
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTimeIntegratorRK4
-
- contains
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTimeIntegratorRK4
-!
-!> \brief MPAS ocean RK4 Time integration scheme
-!> \author Doug Jacobsen
-!> \date 26 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This routine integrates one timestep (dt) using an RK4 time integrator.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTimeIntegratorRK4(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 !< Input/Output: domain information
- real (kind=RKIND), intent(in) :: dt !< 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 :: &
- u, h, h_edge, vertViscTopOfEdge, vertDiffTopOfCell, ke_edge
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
- integer, dimension(:), pointer :: &
- maxLevelCell, maxLevelEdgeTop
- real (kind=RKIND), dimension(:), allocatable:: A,C,uTemp
- real (kind=RKIND), dimension(:,:), allocatable:: tracersTemp
-
-
- block => domain % blocklist
- call allocate_state(provis, &
- block % mesh % nCells, block % mesh % nEdges, block % mesh % maxEdges, block % mesh % maxEdges2, &
- 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 => 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) &
- * 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 => 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("RK4-main loop")
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! BEGIN RK loop
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- do rk_step = 1, 4
-! --- update halos for diagnostic variables
-
- call timer_start("RK4-diagnostic halo update")
- block => domain % blocklist
- do while (associated(block))
- call dmpar_exch_halo_field2dReal(domain % dminfo, provis % pv_edge % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nEdges, &
- block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
- if (config_h_mom_eddy_visc4 > 0.0) then
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nCells, &
- block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nVertices, &
- block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
- end if
-
- block => block % next
- end do
- call timer_stop("RK4-diagnostic halo update")
-
-! --- compute tendencies
-
- call timer_start("RK4-tendency computations")
- block => domain % blocklist
- do while (associated(block))
- if (.not.config_implicit_vertical_mix) then
- call OcnVmixCoefs(block % mesh, provis, block % diagnostics, err)
- end if
- call OcnTendH(block % tend, provis, block % diagnostics, block % mesh)
- call OcnTendU(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 OcnTendScalar(block % tend, provis, block % diagnostics, block % mesh)
- call enforce_boundaryEdge(block % tend, block % mesh)
- block => block % next
- end do
- call timer_stop("RK4-tendency computations")
-
-! --- update halos for prognostic variables
-
- call timer_start("RK4-pronostic halo update")
- block => domain % blocklist
- do while (associated(block))
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % u % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nEdges, &
- block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % h % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nCells, &
- block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % tracers % array(:,:,:), &
- block % tend % num_tracers, block % mesh % nVertLevels, block % mesh % nCells, &
- block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- block => block % next
- end do
- call timer_stop("RK4-pronostic halo update")
-
-! --- compute next substep state
-
- call timer_start("RK4-update diagnostic variables")
- if (rk_step < 4) then
- block => domain % blocklist
- do while (associated(block))
-
- provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:) &
- + rk_substep_weights(rk_step) * block % tend % u % array(:,:)
-
- provis % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:) &
- + 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) = ( &
- block % state % time_levs(1) % state % h % array(k,iCell) * &
- block % state % time_levs(1) % state % tracers % array(:,k,iCell) &
- + rk_substep_weights(rk_step) * block % tend % tracers % array(:,k,iCell) &
- ) / 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 OcnDiagnosticSolve(dt, provis, block % mesh)
-
- block => block % next
- end do
- end if
- call timer_stop("RK4-update diagnostic variables")
-
-
-
-!--- accumulate update (for RK4)
-
- call timer_start("RK4-RK4 accumulate update")
- block => domain % blocklist
- do while (associated(block))
- block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % u % array(:,:) &
- + rk_weights(rk_step) * block % tend % u % array(:,:)
-
- block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(2) % state % h % array(:,:) &
- + 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) = &
- block % state % time_levs(2) % state % tracers % array(:,k,iCell) &
- + rk_weights(rk_step) * block % tend % tracers % array(:,k,iCell)
- end do
- end do
-
- block => block % next
- end do
- call timer_stop("RK4-RK4 accumulate update")
-
- end do
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! END RK loop
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- call timer_stop("RK4-main loop")
-
- !
- ! A little clean up at the end: decouple new scalar fields and compute diagnostics for new state
- !
- call timer_start("RK4-cleaup phase")
- block => domain % blocklist
- do while (associated(block))
-
- u => block % state % time_levs(2) % state % u % array
- tracers => block % state % time_levs(2) % state % tracers % array
- h => block % state % time_levs(2) % state % h % array
- h_edge => block % state % time_levs(2) % state % h_edge % array
- ke_edge => block % state % time_levs(2) % state % ke_edge % array
- num_tracers = block % state % time_levs(2) % state % num_tracers
- vertViscTopOfEdge => block % diagnostics % vertViscTopOfEdge % array
- vertDiffTopOfCell => block % diagnostics % vertDiffTopOfCell % array
- maxLevelCell => block % mesh % maxLevelCell % array
- maxLevelEdgeTop => block % mesh % maxLevelEdgeTop % array
-
- 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("RK4-implicit vert mix")
- allocate(A(nVertLevels),C(nVertLevels),uTemp(nVertLevels), &
- tracersTemp(num_tracers,nVertLevels))
-
- call OcnVmixCoefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
-
- !
- ! Implicit vertical solve for momentum
- !
- call OcnVelVmixTendImplicit(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 OcnTracerVmixTendImplicit(block % mesh, dt, vertDiffTopOfCell, h, tracers, err)
- end if
-
- ! mrp 110725 momentum decay term
- if (config_mom_decay) then
- call timer_start("RK4-momentum decay")
-
- !
- ! 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("RK4-momentum decay")
- 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 OcnDiagnosticSolve(dt, block % state % time_levs(2) % state, block % mesh)
-
- call reconstruct(block % state % time_levs(2) % state, block % mesh)
-
- block => block % next
- end do
- call timer_stop("RK4-cleaup phase")
-
- call deallocate_state(provis)
-
- end subroutine OcnTimeIntegratorRK4!}}}
-
- 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, &
- vertex1, vertex2, eoe, i, j
-
- integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
- real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
- real (kind=RKIND), dimension(:), pointer :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
- real (kind=RKIND), dimension(:,:), pointer :: &
- weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
- tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
- MontPot, wTop, divergence, vertViscTopOfEdge
- type (dm_info) :: dminfo
-
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
- integer, dimension(:,:), pointer :: &
- cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
- edgesOnEdge, edgesOnVertex
- real (kind=RKIND) :: u_diffusion
- real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
- 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("filter_btr_mode_tend_u")
-
- h => s % h % array
- u => s % u % array
- v => s % v % array
- wTop => s % wTop % array
- h_edge => s % h_edge % array
- circulation => s % circulation % array
- vorticity => s % vorticity % array
- divergence => s % divergence % array
- ke => s % ke % array
- ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
- MontPot => s % MontPot % array
- pressure => s % pressure % array
- vertViscTopOfEdge => d % vertViscTopOfEdge % array
-
- weightsOnEdge => grid % weightsOnEdge % array
- kiteAreasOnVertex => grid % kiteAreasOnVertex % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnVertex => grid % cellsOnVertex % array
- verticesOnEdge => grid % verticesOnEdge % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- edgesOnCell => grid % edgesOnCell % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
- edgesOnEdge => grid % edgesOnEdge % array
- edgesOnVertex => grid % edgesOnVertex % array
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => grid % areaCell % array
- areaTriangle => grid % areaTriangle % array
- h_s => grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
- fVertex => grid % fVertex % array
- fEdge => grid % fEdge % array
- zMidZLevel => grid % zMidZLevel % array
- zTopZLevel => grid % zTopZLevel % array
- maxLevelCell => grid % maxLevelCell % array
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
-
- tend_u => tend % u % array
-
- nCells = grid % nCells
- nEdges = grid % nEdges
- nEdgesSolve = grid % nEdgesSolve
- nVertices = grid % nVertices
- nVertLevels = grid % nVertLevels
-
- u_src => grid % u_src % array
-
- do iEdge=1,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("filter_btr_mode_tend_u")
-
- 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, &
- vertex1, vertex2, eoe, i, j
-
- integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
- real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
- real (kind=RKIND), dimension(:), pointer :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
- real (kind=RKIND), dimension(:,:), pointer :: &
- weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
- tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
- MontPot, wTop, divergence, vertViscTopOfEdge
- type (dm_info) :: dminfo
-
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
- integer, dimension(:,:), pointer :: &
- cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
- edgesOnEdge, edgesOnVertex
- real (kind=RKIND) :: u_diffusion
- real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
- 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("filter_btr_mode_u")
-
- h => s % h % array
- u => s % u % array
- v => s % v % array
- wTop => s % wTop % array
- h_edge => s % h_edge % array
- circulation => s % circulation % array
- vorticity => s % vorticity % array
- divergence => s % divergence % array
- ke => s % ke % array
- ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
- MontPot => s % MontPot % array
- pressure => s % pressure % array
-
- weightsOnEdge => grid % weightsOnEdge % array
- kiteAreasOnVertex => grid % kiteAreasOnVertex % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnVertex => grid % cellsOnVertex % array
- verticesOnEdge => grid % verticesOnEdge % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- edgesOnCell => grid % edgesOnCell % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
- edgesOnEdge => grid % edgesOnEdge % array
- edgesOnVertex => grid % edgesOnVertex % array
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => grid % areaCell % array
- areaTriangle => grid % areaTriangle % array
- h_s => grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
- fVertex => grid % fVertex % array
- fEdge => grid % fEdge % array
- zMidZLevel => grid % zMidZLevel % array
- zTopZLevel => grid % zTopZLevel % array
- maxLevelCell => grid % maxLevelCell % array
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
-
- nCells = grid % nCells
- nEdges = grid % nEdges
- nEdgesSolve = grid % nEdgesSolve
- nVertices = grid % nVertices
- nVertLevels = grid % nVertLevels
-
- u_src => grid % u_src % array
-
- do iEdge=1,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("filter_btr_mode_u")
-
- 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("enforce_boundaryEdge")
-
- nCells = grid % nCells
- nEdges = grid % nEdges
- nVertices = grid % nVertices
- nVertLevels = grid % nVertLevels
-
- boundaryEdge => grid % boundaryEdge % array
- tend_u => 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("enforce_boundaryEdge")
-
- end subroutine enforce_boundaryEdge!}}}
-
-end module OcnTimeIntegrationRK4
-
-! vim: foldmethod=marker
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTimeIntegrationSplit.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTimeIntegrationSplit.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTimeIntegrationSplit.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,1439 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTimeIntegrationSplit
-!
-!> \brief MPAS ocean split explicit time integration scheme
-!> \author Doug Jacobsen
-!> \date 26 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the routine for the split explicit
-!> time integration scheme
-!
-!-----------------------------------------------------------------------
-
-
-module OcnTimeIntegrationSplit
-
- use grid_types
- use configure
- use constants
- use dmpar
- use vector_reconstruction
- use spline_interpolation
- use timer
-
- use OcnTendency
-
- use OcnEquationOfState
- use OcnVmix
-
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTimeIntegratorSplit
-
- contains
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTimeIntegrationSplit
-!
-!> \brief MPAS ocean split explicit time integration scheme
-!> \author Doug Jacobsen
-!> \date 26 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This routine integrates a single time step (dt) using a
-!> split explicit time integrator.
-!
-!-----------------------------------------------------------------------
-
-subroutine OcnTimeIntegratorSplit(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, &
- eoe, oldBtrSubcycleTime, newBtrSubcycleTime, uPerpTime, BtrCorIter, &
- n_bcl_iter(config_n_ts_iter), &
- vertex1, vertex2, iVertex
-
- type (block_type), pointer :: block
- real (kind=RKIND) :: uhSum, hSum, sshEdge, flux, &
- uPerp, uCorr, tracerTemp, coef
- real (kind=RKIND), dimension(:), pointer :: sshNew
-
- integer :: num_tracers, ucorr_coef, err
- real (kind=RKIND), dimension(:,:), pointer :: &
- u, h, h_edge, ke_edge, vertViscTopOfEdge, vertDiffTopOfCell
- real (kind=RKIND), dimension(:,:,:), pointer :: tracers
- integer, dimension(:), pointer :: &
- maxLevelCell, maxLevelEdgeTop
- real (kind=RKIND), dimension(:), allocatable:: A,C,uTemp, hNew
- real (kind=RKIND), dimension(:,:), allocatable:: tracersTemp
-
- call timer_start("split_explicit_timestep")
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !
- ! Prep variables before first iteration
- !
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- block => 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) &
- = block % state % time_levs(1) % state % u % array(:,iEdge) &
- - block % state % time_levs(1) % state % uBtr % array(iEdge)
-
- block % state % time_levs(2) % state % u % array(:,iEdge) &
- = block % state % time_levs(1) % state % u % array(:,iEdge)
-
- block % state % time_levs(2) % state % uBcl % array(:,iEdge) &
- = 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(:) &
- = block % state % time_levs(1) % state % ssh % array(:)
-
- block % state % time_levs(2) % state % h_edge % array(:,:) &
- = 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) &
- = block % state % time_levs(1) % state % tracers % array(:,k,iCell)
- end do
-
- end do
-
- block => 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 => domain % blocklist
- do while (associated(block))
-! mrp 110512 not sure if I need the following three. Leave be, assume I need it.
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % pv_edge % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nEdges, &
- block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
- if (config_h_mom_eddy_visc4 > 0.0) then
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nCells, &
- block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nVertices, &
- block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
- end if
-
- block => block % next
- end do
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !
- ! Stage 1: Baroclinic velocity (3D) prediction, explicit with long timestep
- !
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- ! compute velocity tendencies, T(u*,w*,p*)
-
- block => domain % blocklist
- do while (associated(block))
- if (.not.config_implicit_vertical_mix) then
- call OcnVmixCoefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
- end if
- call OcnTendU(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
- call enforce_boundaryEdge(block % tend, block % mesh)
- block => 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 => domain % blocklist
- do while (associated(block))
- allocate(uTemp(block % mesh % nVertLevels))
-
- ! Put f*uBcl^{perp} in uNew as a work variable
- call OcnFUPerp(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) &
- = block % state % time_levs(1) % state % uBcl % array(k,iEdge) &
- + dt * (block % tend % u % array (k,iEdge) &
- + block % state % time_levs(2) % state % u % array (k,iEdge) & ! this is f*uBcl^{perp}
- + split*gravity &
- *( block % state % time_levs(2) % state % ssh % array(cell2) &
- - block % state % time_levs(2) % state % ssh % array(cell1) ) &
- /block % mesh % dcEdge % array(iEdge) )
- enddo
-
- ! Compute GBtrForcing, the vertically averaged forcing
- sshEdge = 0.5*( &
- block % state % time_levs(1) % state % ssh % array(cell1) &
- + block % state % time_levs(1) % state % ssh % array(cell2) )
-
- 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) &
- = 0.5*( &
- block % state % time_levs(1) % state % uBcl % array(k,iEdge) &
- + uTemp(k) - dt * block % state % time_levs(1) % state % GBtrForcing % array(iEdge))
- enddo
-
- enddo ! iEdge
-
- deallocate(uTemp)
-
- block => block % next
- end do
-
- block => domain % blocklist
- do while (associated(block))
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % uBcl % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nEdges, &
- block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
- block => block % next
- end do
-
- 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 => 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(:,:) &
- = block % state % time_levs(2) % state % uBcl % array(:,:)
-
- block => block % next
- end do ! block
-
- elseif (trim(config_time_integration) == 'split_explicit') then
-
- ! Initialize variables for barotropic subcycling
- block => domain % blocklist
- do while (associated(block))
-
- if (config_filter_btr_mode) then
- block % state % time_levs(1) % state % GBtrForcing % array(:) = 0.0
- endif
-
- do iCell=1,block % mesh % nCells
- ! sshSubcycleOld = sshOld
- block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
- = block % state % time_levs(1) % state % ssh % array(iCell)
-
- ! sshNew = sshOld This is the first for the summation
- block % state % time_levs(2) % state % ssh % array(iCell) &
- = block % state % time_levs(1) % state % ssh % array(iCell)
- enddo
-
- do iEdge=1,block % mesh % nEdges
-
- ! uBtrSubcycleOld = uBtrOld
- block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- = 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) &
- = block % state % time_levs(1) % state % uBtr % array(iEdge)
-
- ! FBtr = 0
- block % state % time_levs(1) % state % FBtr % array(iEdge) = 0.0
- enddo
-
- block => 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
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- uPerpTime = oldBtrSubcycleTime
-
- block => domain % blocklist
- do while (associated(block))
-
- do iEdge=1,block % mesh % nEdges
-
- cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
- cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-
- ! Compute -f*uPerp
- uPerp = 0.0
- do i = 1,block % mesh % nEdgesOnEdge % array(iEdge)
- eoe = block % mesh % edgesOnEdge % array(i,iEdge)
- uPerp = uPerp + block % mesh % weightsOnEdge % array(i,iEdge) &
- * block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &
- * block % mesh % fEdge % array(eoe)
- end do
-
- ! 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) &
- = block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- + dt/config_n_btr_subcycles *( &
- uPerp &
- - gravity &
- *( block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) &
- - block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) ) &
- /block % mesh % dcEdge % array(iEdge) &
- + block % state % time_levs(1) % state % GBtrForcing % array(iEdge) )
-
- 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) &
- = block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- * coef
- end do
-
- endif
-
-
- block => block % next
- end do ! block
-
-
- ! boundary update on uBtrNew
- block => domain % blocklist
- do while (associated(block))
-
- call dmpar_exch_halo_field1dReal(domain % dminfo, &
- block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:), &
- block % mesh % nEdges, &
- block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
- block => block % next
- end do ! block
-
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! Barotropic subcycle: Compute thickness flux and new SSH
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- block => domain % blocklist
- do while (associated(block))
-
- block % tend % ssh % array(:) = 0.0
-
- ! config_btr_flux_coef sets the forward weighting of velocity in the SSH computation
- ! config_btr_flux_coef= 1 flux = uBtrNew*H
- ! config_btr_flux_coef=0.5 flux = 1/2*(uBtrNew+uBtrOld)*H
- ! config_btr_flux_coef= 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 &
- *( block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &
- + block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) )
- hSum = sum(block % mesh % hZLevel % array (1:block % mesh % maxLevelEdgeTop % array(iEdge)))
-
- flux = ((1.0-config_btr_flux_coef) &
- * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- + config_btr_flux_coef &
- * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) &
- * block % mesh % dvEdge % array(iEdge) &
- * (sshEdge + hSum)
-
- block % tend % ssh % array(cell1) = block % tend % ssh % array(cell1) - flux
- block % tend % ssh % array(cell2) = block % tend % ssh % array(cell2) + flux
-
- block % state % time_levs(1) % state % FBtr % array(iEdge) &
- = block % state % time_levs(1) % state % FBtr % array(iEdge) &
- + flux
- end do
-
- ! SSHnew = SSHold + dt/J*(-div(Flux))
- do iCell=1,block % mesh % nCells
-
- block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
- = block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
- + dt/config_n_btr_subcycles &
- * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
-
- end do
-
- block => block % next
- end do ! block
-
- ! boundary update on SSNnew
- block => domain % blocklist
- do while (associated(block))
-
-! block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &
-
- call dmpar_exch_halo_field1dReal(domain % dminfo, &
- block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &
- block % mesh % nCells, &
- block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
-
- block => block % next
- end do ! block
-
- block => domain % blocklist
- do while (associated(block))
-
- do iCell=1,block % mesh % nCells
-
- ! Accumulate SSH in running sum over the subcycles.
- block % state % time_levs(2) % state % ssh % array(iCell) &
- = block % state % time_levs(2) % state % ssh % array(iCell) &
- + block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell)
-
- end do
-
- block => 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 => domain % blocklist
- do while (associated(block))
- block % state % time_levs(1) % state % u_diffusionBtr % array(:) = 0.0
- if ( config_btr_mom_eddy_visc2 > 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) &
- = block % state % time_levs(1) % state % circulationBtr % array(vertex1) &
- - block % mesh % dcEdge % array (iEdge) &
- *block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
-
- block % state % time_levs(1) % state % circulationBtr % array(vertex2) &
- = block % state % time_levs(1) % state % circulationBtr % array(vertex2) &
- + block % mesh % dcEdge % array (iEdge) &
- *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) &
- = 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) &
- = block % state % time_levs(1) % state % divergenceBtr % array (cell1) &
- + block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- *block % mesh % dvEdge % array(iEdge)
-
- block % state % time_levs(1) % state % divergenceBtr % array (cell2) &
- = block % state % time_levs(1) % state % divergenceBtr % array (cell2) &
- - block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- *block % mesh % dvEdge % array(iEdge)
- end do
- do iCell = 1,block % mesh % nCells
- block % state % time_levs(1) % state % divergenceBtr % array(iCell) &
- = block % state % time_levs(1) % state % divergenceBtr % array(iCell) &
- /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 * &
- (( block % state % time_levs(1) % state % divergenceBtr % array(cell2) - block % state % time_levs(1) % state % divergenceBtr % array(cell1) ) / block % mesh % dcEdge % array (iEdge) &
- -( 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 => 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 => domain % blocklist
- do while (associated(block))
-
- do iEdge=1,block % mesh % nEdges
-
- cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
- cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
-
- ! Compute -f*uPerp
- uPerp = 0.0
- do i = 1,block % mesh % nEdgesOnEdge % array(iEdge)
- eoe = block % mesh % edgesOnEdge % array(i,iEdge)
- uPerp = uPerp + block % mesh % weightsOnEdge % array(i,iEdge) &
- * block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &
- * block % mesh % fEdge % array(eoe)
- end do
-
- ! 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) &
- = block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- + dt/config_n_btr_subcycles *( &
- uPerp &
- - gravity &
- *( block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell2) &
- - block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell1) ) &
- /block % mesh % dcEdge % array(iEdge) &
- + block % state % time_levs(1) % state % GBtrForcing % array(iEdge) &
- + 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) &
- = block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
- * coef
- end do
-
- endif
-
- block => block % next
- end do ! block
-
-
- ! boundary update on uBtrNew
- block => domain % blocklist
- do while (associated(block))
-
- call dmpar_exch_halo_field1dReal(domain % dminfo, &
- block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:), &
- block % mesh % nEdges, &
- block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
- block => block % next
- end do ! block
-
- end do !do BtrCorIter=1,config_n_btr_cor_iter
-
-
- ! uBtrNew = uBtrNew + uBtrSubcycleNEW
- ! This accumulates the sum.
- ! If the Barotropic Coriolis iteration is limited to one, this could
- ! be merged with the above code.
- block => domain % blocklist
- do while (associated(block))
- do iEdge=1,block % mesh % nEdges
-
- block % state % time_levs(2) % state % uBtr % array(iEdge) &
- = block % state % time_levs(2) % state % uBtr % array(iEdge) &
- + block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
-
- end do ! iEdge
- block => 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 => domain % blocklist
- do while (associated(block))
-
- do iEdge=1,block % mesh % nEdges
- block % state % time_levs(1) % state % FBtr % array(iEdge) &
- = block % state % time_levs(1) % state % FBtr % array(iEdge) &
- / (config_n_btr_subcycles*config_btr_subcycle_loop_factor)
-
- block % state % time_levs(2) % state % uBtr % array(iEdge) &
- = block % state % time_levs(2) % state % uBtr % array(iEdge) &
- / (config_n_btr_subcycles*config_btr_subcycle_loop_factor + 1)
- end do
-
- if (config_SSH_from=='avg_of_SSH_subcycles') then
- do iCell=1,block % mesh % nCells
- block % state % time_levs(2) % state % ssh % array(iCell) &
- = block % state % time_levs(2) % state % ssh % array(iCell) &
- / (config_n_btr_subcycles*config_btr_subcycle_loop_factor + 1)
- end do
- elseif (config_SSH_from=='avg_flux') then
- ! see below
- else
- write(0,*) 'Abort: Unknown config_SSH_from option: '&
- //trim(config_SSH_from)
- call dmpar_abort(dminfo)
- endif
-
- block => block % next
- end do ! block
-
-
- ! boundary update on F
- block => domain % blocklist
- do while (associated(block))
-
- call dmpar_exch_halo_field1dReal(domain % dminfo, &
- block % state % time_levs(1) % state % FBtr % array(:), &
- block % mesh % nEdges, &
- block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
-
- block => block % next
- end do ! block
-
-
- ! Check that you can compute SSH using the total sum or the individual increments
- ! over the barotropic subcycles.
- ! efficiency: This next block of code is really a check for debugging, and can
- ! be removed later.
- block => domain % blocklist
- do while (associated(block))
-
- allocate(uTemp(block % mesh % nVertLevels))
-
- 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) &
- = block % tend % ssh % array(cell1) &
- - block % state % time_levs(1) % state % FBtr % array(iEdge)
-
- block % tend % ssh % array(cell2) &
- = block % tend % ssh % array(cell2) &
- + block % state % time_levs(1) % state % FBtr % array(iEdge)
-
- end do
-
- do iCell=1,block % mesh % nCells
-
- ! SSHnew = SSHold + dt*(-div(Flux))
- block % state % time_levs(2) % state % ssh % array(iCell) &
- = block % state % time_levs(1) % state % ssh % array(iCell) &
- + dt &
- * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
- end do
- endif
- ! Now can compare sshSubcycleNEW (big step using summed fluxes) with
- ! sshSubcycleOLD (individual steps to get there)
-!print *, 'ssh, by substeps',minval(block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(1:block % mesh % nCellsSolve)), &
-! maxval(block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(1:block % mesh % nCellsSolve))
-!print *, 'ssh, by 1 step ',minval(block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(1:block % mesh % nCellsSolve)), &
-! maxval(block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(1:block % mesh % nCellsSolve))
-
- ! 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 &
- *( block % state % time_levs(2) % state % ssh % array(cell1) &
- + block % state % time_levs(2) % state % ssh % array(cell2) )
-
- ! This is u*
- uTemp(:) &
- = block % state % time_levs(2) % state % uBtr % array(iEdge) &
- + 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) &
- /block % mesh % dvEdge % array(iEdge) &
- - 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
- block % state % time_levs(2) % state % u % array(:,iEdge) = uTemp(:) + uCorr
- 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) &
- = sshEdge + block % mesh % hZLevel % array(1)
-
- do k=2,block % mesh % nVertLevels
- block % state % time_levs(2) % state % h_edge % array(k,iEdge) &
- = block % mesh % hZLevel % array(k)
- enddo
-
- end do ! iEdge
-
- ! Put new SSH values in h array, for the OcnTendScalar call below.
- do iCell=1,block % mesh % nCells
- block % state % time_levs(2) % state % h % array(1,iCell) &
- = block % state % time_levs(2) % state % ssh % array(iCell) &
- + block % mesh % hZLevel % array(1)
-
- ! 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) &
- = block % mesh % hZLevel % array(k)
- enddo
- enddo ! iCell
-
- deallocate(uTemp)
-
- block => block % next
- end do ! block
-
-
- endif ! split_explicit
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !
- ! Stage 3: Tracer, density, pressure, vertical velocity prediction
- !
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- block => domain % blocklist
- do while (associated(block))
-
- call OcnWtop(block % state % time_levs(2) % state, block % mesh)
-
- if (trim(config_time_integration) == 'unsplit_explicit') then
- call OcnTendH(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
- endif
-
- call OcnTendScalar(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
-
- block => block % next
- end do
-
- ! --- update halos for prognostic variables
-
- block => domain % blocklist
- do while (associated(block))
- call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % h % array(:,:), &
- block % mesh % nVertLevels, block % mesh % nCells, &
- block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % tracers % array(:,:,:), &
- block % tend % num_tracers, block % mesh % nVertLevels, block % mesh % nCells, &
- block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
- block => block % next
- end do
-
-
- block => 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 => block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array
- elseif (trim(config_new_btr_variables_from) == 'btr_avg') then
- ! This points to the tendency variable SSH*
- sshNew => block % state % time_levs(2) % state % ssh % array
- endif
-
- 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) &
- = block % state % time_levs(1) % state % h % array(:,iCell) &
- + 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) &
- = block % state % time_levs(2) % state % h % array(1,iCell) &
- - block % mesh % hZLevel % array(1)
- end do ! iCell
-
- endif ! unsplit_explicit
-
- ! Only need T & S for earlier iterations,
- ! then all the tracers needed the last time through.
- if (split_explicit_step < config_n_ts_iter) then
-
- hNew(:) = block % mesh % hZLevel % array(:)
- do iCell=1,block % mesh % nCells
- ! sshNew is a pointer, defined above.
- hNew(1) = sshNew(iCell) + block % mesh % hZLevel % array(1)
- do k=1,block % mesh % maxLevelCell % array(iCell)
- do i=1,2
- ! This is Phi at n+1
- tracerTemp &
- = ( block % state % time_levs(1) % state % tracers % array(i,k,iCell) &
- * block % state % time_levs(1) % state % h % array(k,iCell) &
- + dt * block % tend % tracers % array(i,k,iCell) &
- ) / hNew(k)
-
- ! This is Phi at n+1/2
- block % state % time_levs(2) % state % tracers % array(i,k,iCell) &
- = 0.5*( &
- block % state % time_levs(1) % state % tracers % array(i,k,iCell) &
- + tracerTemp )
- enddo
- end do
- end do ! iCell
-
-
- 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) &
- = 0.5*( &
- block % state % time_levs(2) % state % h % array(1,iCell) &
- + block % state % time_levs(1) % state % h % array(1,iCell) )
-
- end do ! iCell
- endif ! unsplit_explicit
-
- ! compute u*, the velocity for tendency terms. Put in uNew.
- ! uBclNew is at time n+1/2 here.
- ! This overwrites u^{tr}, the tracer transport velocity, which was in uNew.
- ! The following must occur after call OcnTendScalar
- do iEdge=1,block % mesh % nEdges
- block % state % time_levs(2) % state % u % array(:,iEdge) &
- = block % state % time_levs(2) % state % uBtr % array(iEdge) &
- + block % state % time_levs(2) % state % uBcl % array(:,iEdge)
- end do ! iEdge
-
- ! mrp 110512 I really only need this to compute h_edge, density, pressure.
- ! I can par this down later.
- call OcnDiagnosticSolve(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) &
- = ( block % state % time_levs(1) % state % tracers % array(i,k,iCell) &
- * block % state % time_levs(1) % state % h % array(k,iCell) &
- + dt * block % tend % tracers % array(i,k,iCell) &
- ) / hNew(k)
-
- enddo
- end do
- end do
-
- endif ! split_explicit_step
- deallocate(hNew)
-
- block => block % next
- end do
-
- end do ! split_explicit_step = 1, config_n_ts_iter
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- ! END large iteration loop
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- !
- ! A little clean up at the end: decouple new scalar fields and compute diagnostics for new state
- !
- block => domain % blocklist
- do while (associated(block))
-
- if (trim(config_new_btr_variables_from) == 'last_subcycle') then
- do iEdge=1,block % mesh % nEdges
- ! uBtrNew = uBtrSubcycleNew (old here is because counter already flipped)
- ! This line is not needed if u is resplit at the beginning of the timestep.
- block % state % time_levs(2) % state % uBtr % array(iEdge) &
- = block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
- enddo ! iEdges
- elseif (trim(config_new_btr_variables_from) == 'btr_avg') then
- ! uBtrNew from u*. this is done above, so u* is already in
- ! block % state % time_levs(2) % state % uBtr % array(iEdge)
- else
- write(0,*) 'Abort: Unknown config_new_btr_variables_from: '&
- //trim(config_time_integration)
- call dmpar_abort(dminfo)
- endif
-
- ! Recompute final u to go on to next step.
- ! u_{n+1} = uBtr_{n+1} + uBcl_{n+1}
- ! Right now uBclNew is at time n+1/2, so back compute to get uBcl at time n+1
- ! using uBcl_{n+1/2} = 1/2*(uBcl_n + u_Bcl_{n+1})
- ! so the following lines are
- ! u_{n+1} = uBtr_{n+1} + 2*uBcl_{n+1/2} - uBcl_n
- ! note that uBcl is recomputed at the beginning of the next timestep due to Imp Vert mixing,
- ! so uBcl does not have to be recomputed here.
-
- do iEdge=1,block % mesh % nEdges
- do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
-
- block % state % time_levs(2) % state % u % array(k,iEdge) &
- = block % state % time_levs(2) % state % uBtr % array(iEdge) &
- +2*block % state % time_levs(2) % state % uBcl % array(k,iEdge) &
- - block % state % time_levs(1) % state % uBcl % array(k,iEdge)
- enddo
- ! 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) &
- = 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) &
- = block % state % time_levs(2) % state % ssh % array(iCell) &
- + 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) &
- = block % mesh % hZLevel % array(k)
- end do
- end do ! iCell
- end if ! split_explicit
-
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
- !
- ! Implicit vertical mixing, done after timestep is complete
- !
- !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
- u => block % state % time_levs(2) % state % u % array
- tracers => block % state % time_levs(2) % state % tracers % array
- h => block % state % time_levs(2) % state % h % array
- h_edge => block % state % time_levs(2) % state % h_edge % array
- ke_edge => block % state % time_levs(2) % state % ke_edge % array
- num_tracers = block % state % time_levs(2) % state % num_tracers
- vertViscTopOfEdge => block % diagnostics % vertViscTopOfEdge % array
- vertDiffTopOfCell => block % diagnostics % vertDiffTopOfCell % array
- maxLevelCell => block % mesh % maxLevelCell % array
- maxLevelEdgeTop => block % mesh % maxLevelEdgeTop % array
-
- if (config_implicit_vertical_mix) then
- allocate(A(block % mesh % nVertLevels),C(block % mesh % nVertLevels),uTemp(block % mesh % nVertLevels), &
- tracersTemp(num_tracers,block % mesh % nVertLevels))
-
- call OcnVmixCoefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
-
- !
- ! Implicit vertical solve for momentum
- !
-
- call OcnVelVmixTendImplicit(block % mesh, dt, ke_edge, vertViscTopOfEdge, h, h_edge, u, err)
-
- !
- ! Implicit vertical solve for tracers
- !
- call OcnTracerVmixTendImplicit(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 OcnDiagnosticSolve(dt, block % state % time_levs(2) % state, block % mesh)
-
- call reconstruct(block % state % time_levs(2) % state, block % mesh)
-
- block => block % next
- end do
- call timer_stop("split_explicit_timestep")
-
- end subroutine OcnTimeIntegratorSplit!}}}
-
- 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, &
- vertex1, vertex2, eoe, i, j
-
- integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
- real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
- real (kind=RKIND), dimension(:), pointer :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
- real (kind=RKIND), dimension(:,:), pointer :: &
- weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
- tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
- MontPot, wTop, divergence, vertViscTopOfEdge
- type (dm_info) :: dminfo
-
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
- integer, dimension(:,:), pointer :: &
- cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
- edgesOnEdge, edgesOnVertex
- real (kind=RKIND) :: u_diffusion
- real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
- 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("filter_btr_mode_tend_u")
-
- h => s % h % array
- u => s % u % array
- v => s % v % array
- wTop => s % wTop % array
- h_edge => s % h_edge % array
- circulation => s % circulation % array
- vorticity => s % vorticity % array
- divergence => s % divergence % array
- ke => s % ke % array
- ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
- MontPot => s % MontPot % array
- pressure => s % pressure % array
- vertViscTopOfEdge => d % vertViscTopOfEdge % array
-
- weightsOnEdge => grid % weightsOnEdge % array
- kiteAreasOnVertex => grid % kiteAreasOnVertex % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnVertex => grid % cellsOnVertex % array
- verticesOnEdge => grid % verticesOnEdge % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- edgesOnCell => grid % edgesOnCell % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
- edgesOnEdge => grid % edgesOnEdge % array
- edgesOnVertex => grid % edgesOnVertex % array
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => grid % areaCell % array
- areaTriangle => grid % areaTriangle % array
- h_s => grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
- fVertex => grid % fVertex % array
- fEdge => grid % fEdge % array
- zMidZLevel => grid % zMidZLevel % array
- zTopZLevel => grid % zTopZLevel % array
- maxLevelCell => grid % maxLevelCell % array
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
-
- tend_u => tend % u % array
-
- nCells = grid % nCells
- nEdges = grid % nEdges
- nEdgesSolve = grid % nEdgesSolve
- nVertices = grid % nVertices
- nVertLevels = grid % nVertLevels
-
- u_src => grid % u_src % array
-
- do iEdge=1,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("filter_btr_mode_tend_u")
-
- 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, &
- vertex1, vertex2, eoe, i, j
-
- integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
- real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
- real (kind=RKIND), dimension(:), pointer :: &
- h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
- zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
- real (kind=RKIND), dimension(:,:), pointer :: &
- weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
- tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
- MontPot, wTop, divergence, vertViscTopOfEdge
- type (dm_info) :: dminfo
-
- integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
- maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
- integer, dimension(:,:), pointer :: &
- cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
- edgesOnEdge, edgesOnVertex
- real (kind=RKIND) :: u_diffusion
- real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
-
- 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("filter_btr_mode_u")
-
- h => s % h % array
- u => s % u % array
- v => s % v % array
- wTop => s % wTop % array
- h_edge => s % h_edge % array
- circulation => s % circulation % array
- vorticity => s % vorticity % array
- divergence => s % divergence % array
- ke => s % ke % array
- ke_edge => s % ke_edge % array
- pv_edge => s % pv_edge % array
- MontPot => s % MontPot % array
- pressure => s % pressure % array
-
- weightsOnEdge => grid % weightsOnEdge % array
- kiteAreasOnVertex => grid % kiteAreasOnVertex % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnVertex => grid % cellsOnVertex % array
- verticesOnEdge => grid % verticesOnEdge % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- edgesOnCell => grid % edgesOnCell % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
- edgesOnEdge => grid % edgesOnEdge % array
- edgesOnVertex => grid % edgesOnVertex % array
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => grid % areaCell % array
- areaTriangle => grid % areaTriangle % array
- h_s => grid % h_s % array
-! mrp 110516 cleanup fvertex fedge not used in this subroutine
- fVertex => grid % fVertex % array
- fEdge => grid % fEdge % array
- zMidZLevel => grid % zMidZLevel % array
- zTopZLevel => grid % zTopZLevel % array
- maxLevelCell => grid % maxLevelCell % array
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
-
- nCells = grid % nCells
- nEdges = grid % nEdges
- nEdgesSolve = grid % nEdgesSolve
- nVertices = grid % nVertices
- nVertLevels = grid % nVertLevels
-
- u_src => grid % u_src % array
-
- do iEdge=1,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("filter_btr_mode_u")
-
- 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("enforce_boundaryEdge")
-
- nCells = grid % nCells
- nEdges = grid % nEdges
- nVertices = grid % nVertices
- nVertLevels = grid % nVertLevels
-
- boundaryEdge => grid % boundaryEdge % array
- tend_u => 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("enforce_boundaryEdge")
-
- end subroutine enforce_boundaryEdge!}}}
-
-end module OcnTimeIntegrationSplit
-
-! vim: foldmethod=marker
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,180 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerHadv
-!
-!> \brief MPAS ocean horizontal tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> horizontal advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerHadv
-
- use grid_types
- use configure
-
- use OcnTracerHadv2
- use OcnTracerHadv3
- use OcnTracerHadv4
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerHadvTend, &
- OcnTracerHadvInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerHadvTend
-!
-!> \brief Computes tendency term for horizontal tracer advection
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerHadvTend(grid, u, h_edge, tracers, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: velocity
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 OcnTracerHadv2Tend(grid, u, h_edge, tracers, tend, err1)
- call OcnTracerHadv3Tend(grid, u, h_edge, tracers, tend, err2)
- call OcnTracerHadv4Tend(grid, u, h_edge, tracers, tend, err3)
-
- err = err1 .or. err2 .or. err3
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerHadvTend
-
-!***********************************************************************
-!
-! routine OcnTracerHadvInit
-!
-!> \brief Initializes ocean tracer horizontal advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerHadvInit(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- integer :: err1, err2, err3
-
- call OcnTracerHadv2Init(err1)
- call OcnTracerHadv3Init(err2)
- call OcnTracerHadv4Init(err3)
-
- err = err1 .or. err2 .or. err3
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerHadvInit
-
-!***********************************************************************
-
-end module OcnTracerHadv
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv2.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv2.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv2.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,205 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerHadv2
-!
-!> \brief MPAS ocean horizontal tracer advection 2nd order
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> horizontal advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerHadv2
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerHadv2Tend, &
- OcnTracerHadv2Init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: hadv2On
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerHadv2Tend
-!
-!> \brief Computes tendency term for horizontal tracer advection
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerHadv2Tend(grid, u, h_edge, tracers , tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: velocity
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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("compute_scalar_tend-horiz adv 2")
-
- nEdges = grid % nEdges
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- cellsOnEdge => grid % cellsOnEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => 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("compute_scalar_tend-horiz adv 2")
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerHadv2Tend
-
-!***********************************************************************
-!
-! routine OcnTracerHadv2Init
-!
-!> \brief Initializes ocean tracer horizontal advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerHadv2Init(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- err = 0
- hadv2On = .false.
-
- if (config_tracer_adv_order == 2) then
- hadv2On = .true.
- end if
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerHadv2Init
-
-!***********************************************************************
-
-end module OcnTracerHadv2
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv3.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv3.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv3.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,254 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerHadv3
-!
-!> \brief MPAS ocean horizontal tracer advection 3rd order
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> horizontal advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerHadv3
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerHadv3Tend, &
- OcnTracerHadv3Init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: hadv3On
- real (kind=RKIND) :: coef_3rd_order
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerHadv3Tend
-!
-!> \brief Computes tendency term for horizontal tracer advection
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerHadv3Tend(grid, u, h_edge, tracers , tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: velocity
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iEdge, nEdges, cell1, cell2, iTracer, num_tracers, i, k
-
- integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnCell
- 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.hadv3On) return
-
- nEdges = grid % nEdges
- num_tracers = size(tracers, dim=1)
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- nEdgesOnCell => grid % nEdgesOnCell % array
- boundaryCell => grid % boundaryCell % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnCell => grid % cellsOnCell % array
- dvEdge => grid % dvEdge % array
- dcEdge => grid % dcEdge % array
- areaCell => grid % areaCell % array
- deriv_two => grid % deriv_two % array
-
- call timer_start("compute_scalar_tend-horiz adv 3")
- 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 + &
- 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 + &
- deriv_two(i+1,2,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell2))
- end do
-
- endif
-
- !-- if u > 0:
- if (u(k,iEdge) > 0) then
- flux = dvEdge(iEdge) * u(k,iEdge) * h_edge(k,iEdge) * ( &
- 0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2)) &
- -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
- -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
- !-- else u <= 0:
- else
- flux = dvEdge(iEdge) * u(k,iEdge) * h_edge(k,iEdge) * ( &
- 0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2)) &
- -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
- +(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("compute_scalar_tend-horiz adv 3")
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerHadv3Tend
-
-!***********************************************************************
-!
-! routine OcnTracerHadv3Init
-!
-!> \brief Initializes ocean tracer horizontal advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerHadv3Init(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- 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 OcnTracerHadv3Init
-
-!***********************************************************************
-
-end module OcnTracerHadv3
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv4.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv4.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv4.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,239 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerHadv4
-!
-!> \brief MPAS ocean horizontal tracer advection 4th order
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> horizontal advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerHadv4
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerHadv4Tend, &
- OcnTracerHadv4Init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: hadv4On
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerHadv4Tend
-!
-!> \brief Computes tendency term for horizontal tracer advection
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerHadv4Tend(grid, u, h_edge, tracers , tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: velocity
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 => grid % maxLevelEdgeTop % array
- boundaryCell => grid % boundaryCell % array
- cellsOnEdge => grid % cellsOnEdge % array
- cellsOnCell => grid % cellsOnCell % array
- dvEdge => grid % dvEdge % array
- dcEdge => grid % dcEdge % array
- areaCell => grid % areaCell % array
- deriv_two => grid % deriv_two % array
-
- call timer_start("compute_scalar_tend-horiz adv 4")
-
- 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 + &
- 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 + &
- 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) * ( &
- 0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2)) &
- -(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("compute_scalar_tend-horiz adv 4")
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerHadv4Tend
-
-!***********************************************************************
-!
-! routine OcnTracerHadv4Init
-!
-!> \brief Initializes ocean tracer horizontal advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerHadv4Init(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- err = 0
- hadv4On = .false.
-
- if (config_tracer_adv_order == 4) then
- hadv4On = .true.
- end if
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerHadv4Init
-
-!***********************************************************************
-
-end module OcnTracerHadv4
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHmix.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHmix.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHmix.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,175 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerHmix
-!
-!> \brief MPAS ocean horizontal tracer mixing driver
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> horizontal mixing tendencies.
-!>
-!> It provides an init and a tend function. Each are described below.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerHmix
-
- use grid_types
- use configure
- use OcnTracerHmixDel2
- use OcnTracerHmixDel4
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerHmixTend, &
- OcnTracerHmixInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerHmixTend
-!
-!> \brief Computes tendency term for horizontal tracer mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal mixing tendency for tracer
-!> based on current state and user choices of mixing parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerHmixTend(grid, h_edge, tracers, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracer quantities
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 OcnTracerHmixDel2Tend(grid, h_edge, tracers, tend, err1)
- call OcnTracerHmixDel4Tend(grid, h_edge, tracers, tend, err2)
-
- err = err1 .or. err2
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerHmixTend
-
-!***********************************************************************
-!
-! routine OcnTracerHmixInit
-!
-!> \brief Initializes ocean tracer horizontal mixing quantities
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity mixing in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerHmixInit(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- integer :: err1, err2
-
- call OcnTracerHmixDel2Init(err1)
- call OcnTracerHmixDel4Init(err2)
-
- err = err1 .or. err2
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerHmixInit
-
-!***********************************************************************
-
-end module OcnTracerHmix
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHmixDel2.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHmixDel2.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHmixDel2.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,232 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerHmixDel2
-!
-!> \brief MPAS ocean horizontal tracer mixing driver
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> horizontal mixing tendencies.
-!>
-!> It provides an init and a tend function. Each are described below.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerHmixDel2
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerHmixDel2Tend, &
- OcnTracerHmixDel2Init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: del2On
-
- real (kind=RKIND) :: eddyDiff2
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerHmixDel2Tend
-!
-!> \brief Computes laplacian tendency term for horizontal tracer mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal mixing tendency for tracers
-!> based on current state using a laplacian parameterization.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerHmixDel2Tend(grid, h_edge, tracers, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracer quantities
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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("compute_scalar_tend-horiz diff 2")
-
- nEdges = grid % nEdges
- nVertLevels = grid % nVertLevels
- num_tracers = size(tracers, dim=1)
-
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- cellsOnEdge => grid % cellsOnEdge % array
- boundaryEdge => grid % boundaryEdge % array
- areaCell => grid % areaCell % array
- dvEdge => grid % dvEdge % array
- dcEdge => grid % dcEdge % array
- meshScalingDel2 => 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 &
- *( tracers(iTracer,k,cell2) &
- - 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) &
- * 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("compute_scalar_tend-horiz diff 2")
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerHmixDel2Tend
-
-!***********************************************************************
-!
-! routine OcnTracerHmixDel2Init
-!
-!> \brief Initializes ocean tracer horizontal mixing quantities
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> laplacian horizontal velocity mixing in the ocean.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerHmixDel2Init(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- err = 0
-
- del2on = .false.
-
- if ( config_h_tracer_eddy_diff2 > 0.0 ) then
- del2On = .true.
- eddyDiff2 = config_h_tracer_eddy_diff2
- endif
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerHmixDel2Init
-
-!***********************************************************************
-
-end module OcnTracerHmixDel2
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHmixDel4.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHmixDel4.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHmixDel4.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,263 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerHmixDel4
-!
-!> \brief MPAS ocean horizontal tracer mixing driver
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> horizontal mixing tendencies.
-!>
-!> It provides an init and a tend function. Each are described below.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerHmixDel4
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerHmixDel4Tend, &
- OcnTracerHmixDel4Init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: Del4On
-
- real (kind=RKIND) :: eddyDiff4
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerHmixDel4Tend
-!
-!> \brief Computes biharmonic tendency term for horizontal tracer mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal mixing tendency for tracers
-!> based on current state using a biharmonic parameterization.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerHmixDel4Tend(grid, h_edge, tracers, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracer quantities
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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("compute_scalar_tend-horiz diff 4")
-
- nEdges = grid % nEdges
- nCells = grid % nCells
- num_tracers = size(tracers, dim=1)
- nVertLevels = grid % nVertLevels
-
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelCell => grid % maxLevelCell % array
- boundaryEdge => grid % boundaryEdge % array
- cellsOnEdge => grid % cellsOnEdge % array
-
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaCell => grid % areaCell % array
- meshScalingDel4 => 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) &
- + 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) &
- - 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,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 &
- *( delsq_tracer(iTracer,k,cell2) &
- - delsq_tracer(iTracer,k,cell1))/dcEdge(iEdge)
- flux = dvEdge (iEdge) * tracer_turb_flux
-
- tend(iTracer,k,cell1) = tend(iTracer,k,cell1) &
- - flux * invAreaCell1 * boundaryMask(k,iEdge)
- tend(iTracer,k,cell2) = tend(iTracer,k,cell2) &
- + flux * invAreaCell2 * boundaryMask(k,iEdge)
-
- enddo
- enddo
- end do
-
- deallocate(delsq_tracer)
- call timer_stop("compute_scalar_tend-horiz diff 4")
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerHmixDel4Tend
-
-!***********************************************************************
-!
-! routine OcnTracerHmixDel4Init
-!
-!> \brief Initializes ocean tracer horizontal mixing quantities
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> biharmonic horizontal velocity mixing in the ocean.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerHmixDel4Init(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- err = 0
- Del4on = .false.
-
- if ( config_h_tracer_eddy_diff4 > 0.0 ) then
- Del4On = .true.
- eddyDiff4 = config_h_tracer_eddy_diff4
- endif
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerHmixDel4Init
-
-!***********************************************************************
-
-end module OcnTracerHmixDel4
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadv.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadv.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadv.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,185 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerVadv
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerVadv
-
- use grid_types
- use configure
-
- use OcnTracerVadvStencil
- use OcnTracerVadvSpline
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerVadvTend, &
- OcnTracerVadvInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: vadvOn
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerVadvTend
-!
-!> \brief Computes tendency term for vertical tracer advection
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerVadvTend(grid, wTop, tracers, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- wTop !< Input: vertical velocity in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 OcnTracerVadvStencilTend(grid, wTop, tracers, tend, err1)
- call OcnTracerVadvSplineTend(grid, wTop, tracers, tend, err2)
-
- err = err1 .or. err2
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvTend
-
-!***********************************************************************
-!
-! routine OcnTracerVadvInit
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerVadvInit(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- integer :: err1, err2
-
- vadvOn = .false.
-
- if (config_vert_grid_type.eq.'zlevel') then
- vadvOn = .true.
- call OcnTracerVadvStencilInit(err1)
- call OcnTracerVadvSplineInit(err2)
-
- err = err1 .or. err2
- endif
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvInit
-
-!***********************************************************************
-
-end module OcnTracerVadv
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvSpline.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvSpline.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvSpline.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,186 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerVadvSpline
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerVadvSpline
-
- use grid_types
- use configure
-
- use OcnTracerVadvSpline2
- use OcnTracerVadvSpline3
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerVadvSplineTend, &
- OcnTracerVadvSplineInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: splineOn
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerVadvSplineTend
-!
-!> \brief Computes tendency term for vertical tracer advection
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerVadvSplineTend(grid, wTop, tracers, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- wTop !< Input: vertical velocity in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 OcnTracerVadvSpline2Tend(grid, wTop, tracers, tend, err1)
- call OcnTracerVadvSpline3Tend(grid, wTop, tracers, tend, err2)
-
- err = err1 .or. err2
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvSplineTend
-
-!***********************************************************************
-!
-! routine OcnTracerVadvSplineInit
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerVadvSplineInit(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- integer :: err1, err2
-
- splineOn = .false.
-
- if(config_vert_tracer_adv.eq.'spline') then
- splineOn = .true.
-
- call OcnTracerVadvSpline2Init(err2)
- call OcnTracerVadvSpline3Init(err2)
-
- err = err1 .or. err2
- endif
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvSplineInit
-
-!***********************************************************************
-
-end module OcnTracerVadvSpline
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvSpline2.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvSpline2.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvSpline2.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,220 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerVadvSpline2
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerVadvSpline2
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerVadvSpline2Tend, &
- OcnTracerVadvSpline2Init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: spline2On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerVadvSpline2Tend
-!
-!> \brief Computes tendency term for vertical tracer advection
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerVadvSpline2Tend(grid, wTop, tracers, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- wTop !< Input: vertical velocity in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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("compute_scalar_tend-vert adv spline 2")
-
- nCells = grid % nCells
- nCellsSolve = grid % nCellsSolve
- nVertLevels = grid % nVertLevels
- num_tracers = size(tracers, 1)
- maxLevelCell => grid % maxLevelCell % array
-
- hRatioZLevelK => grid % hRatioZLevelK % array
- hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
-
- allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
-
- do iCell=1,nCellsSolve
- 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) = &
- hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
- + 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) &
- - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
- - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
- end do
- end do
- end do
-
- deallocate(tracerTop)
-
- call timer_stop("compute_scalar_tend-vert adv spline 2")
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvSpline2Tend
-
-!***********************************************************************
-!
-! routine OcnTracerVadvSpline2Init
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerVadvSpline2Init(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- err = 0
-
- spline2On = .false.
-
- if(config_vert_tracer_adv_order.eq.2) then
- spline2On = .true.
- endif
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvSpline2Init
-
-!***********************************************************************
-
-end module OcnTracerVadvSpline2
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvSpline3.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvSpline3.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvSpline3.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,249 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerVadvSpline3
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerVadvSpline3
-
- use grid_types
- use configure
- use timer
- use spline_interpolation
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerVadvSpline3Tend, &
- OcnTracerVadvSpline3Init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: spline3On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerVadvSpline3Tend
-!
-!> \brief Computes tendency term for vertical tracer advection
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerVadvSpline3Tend(grid, wTop, tracers, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- wTop !< Input: vertical velocity in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iCell, nCells, nCellsSolve, k, iTracer, num_tracers, nVertLevels
-
- integer, dimension(:), pointer :: maxLevelCell
-
- real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, &
- hRatioZLevelKm1, zTopZLevel, zMidZLevel
-
- real (kind=RKIND), dimension(:), allocatable :: tracer2ndDer, &
- 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("compute_scalar_tend-vert adv spline 3")
-
- nCells = grid % nCells
- nCellsSolve = grid % nCellsSolve
- nVertLevels = grid % nVertLevels
- num_tracers = size(tracers, 1)
- maxLevelCell => grid % maxLevelCell % array
-
- hRatioZLevelK => grid % hRatioZLevelK % array
- hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
- zMidZLevel => grid % zMidZLevel % array
- zTopZLevel => grid % zTopZLevel % array
-
- allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
-
- ! Compute tracerTop using cubic spline interpolation.
-
- allocate(tracer2ndDer(nVertLevels))
- allocate(tracersIn(nVertLevels),tracersOut(nVertLevels), &
- posZMidZLevel(nVertLevels), posZTopZLevel(nVertLevels-1))
-
- ! 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, &
- tracersIn, maxLevelCell(iCell), tracer2ndDer)
-
- call InterpolateCubicSpline( &
- posZMidZLevel, tracersIn, tracer2ndDer, maxLevelCell(iCell), &
- 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) &
- - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
- - 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("compute_scalar_tend-vert adv spline 3")
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvSpline3Tend
-
-!***********************************************************************
-!
-! routine OcnTracerVadvSpline3Init
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerVadvSpline3Init(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- err = 0
-
- spline3On = .false.
-
- if(config_vert_tracer_adv_order.eq.3) then
- spline3On = .true.
- endif
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvSpline3Init
-
-!***********************************************************************
-
-end module OcnTracerVadvSpline3
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,191 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerVadvStencil
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerVadvStencil
-
- use grid_types
- use configure
-
- use OcnTracerVadvStencil2
- use OcnTracerVadvStencil3
- use OcnTracerVadvStencil4
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerVadvStencilTend, &
- OcnTracerVadvStencilInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: stencilOn
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerVadvStencilTend
-!
-!> \brief Computes tendency term for vertical tracer advection
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerVadvStencilTend(grid, wTop, tracers, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- wTop !< Input: vertical velocity in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 OcnTracerVadvStencil2Tend(grid, wTop, tracers, tend, err1)
- call OcnTracerVadvStencil3Tend(grid, wTop, tracers, tend, err1)
- call OcnTracerVadvStencil4Tend(grid, wTop, tracers, tend, err1)
-
- err = err1 .or. err2 .or. err3
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvStencilTend
-
-!***********************************************************************
-!
-! routine OcnTracerVadvStencilInit
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerVadvStencilInit(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- integer :: err1, err2, err3
-
- err = 0
-
- stencilOn = .false.
-
- if (config_vert_tracer_adv.eq.'stencil') then
- stencilOn = .true.
-
- call OcnTracerVadvStencil2Init(err1)
- call OcnTracerVadvStencil3Init(err2)
- call OcnTracerVadvStencil4Init(err3)
-
- err = err1 .or. err2 .or. err3
- endif
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvStencilInit
-
-!***********************************************************************
-
-end module OcnTracerVadvStencil
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil2.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil2.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil2.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,218 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerVadvStencil2
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerVadvStencil2
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerVadvStencil2Tend, &
- OcnTracerVadvStencil2Init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: stencil2On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerVadvStencil2Tend
-!
-!> \brief Computes tendency term for vertical tracer advection
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerVadvStencil2Tend(grid, wTop, tracers, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- wTop !< Input: vertical velocity in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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("compute_scalar_tend-vert adv stencil 2")
-
- nCells = grid % nCells
- nCellsSolve = grid % nCellsSolve
- num_tracers = size(tracers, 1)
- nVertLevels = grid % nVertLevels
- maxLevelCell => 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) = &
- ( tracers(iTracer,k-1,iCell) &
- +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) &
- - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
- - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
- end do
- end do
- end do
-
- deallocate(tracerTop)
- call timer_stop("compute_scalar_tend-vert adv stencil 2")
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvStencil2Tend
-
-!***********************************************************************
-!
-! routine OcnTracerVadvStencil2Init
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerVadvStencil2Init(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- integer :: err1, err2, err3
-
- err = 0
- stencil2On = .false.
-
- if(config_vert_tracer_adv_order.eq.2) then
- stencil2On = .true.
- endif
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvStencil2Init
-
-!***********************************************************************
-
-end module OcnTracerVadvStencil2
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil3.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil3.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil3.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,239 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerVadvStencil3
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerVadvStencil3
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerVadvStencil3Tend, &
- OcnTracerVadvStencil3Init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: stencil3On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerVadvStencil3Tend
-!
-!> \brief Computes tendency term for vertical tracer advection
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerVadvStencil3Tend(grid, wTop, tracers, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- wTop !< Input: vertical velocity in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 => grid % maxLevelCell % array
- hRatioZLevelK => grid % hRatioZLevelK % array
- hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
-
- call timer_start("compute_scalar_tend-vert adv stencil 3")
-
- 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) = &
- hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
- + 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) = &
- ( (-1.+ cSignWTop)*tracers(iTracer,k-2,iCell) &
- +( 7.-3.*cSignWTop)*tracers(iTracer,k-1,iCell) &
- +( 7.+3.*cSignWTop)*tracers(iTracer,k ,iCell) &
- +(-1.- cSignWTop)*tracers(iTracer,k+1,iCell) &
- )/12.
- end do
- end do
- k=maxLevelCell(iCell)
- do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
- + hRatioZLevelKm1(k)*tracers(iTracer,k ,iCell)
- 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) &
- - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
- - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
- end do
- end do
- end do
-
- deallocate(tracerTop)
- call timer_stop("compute_scalar_tend-vert adv stencil 3")
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvStencil3Tend
-
-!***********************************************************************
-!
-! routine OcnTracerVadvStencil3Init
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerVadvStencil3Init(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- err = 0
- stencil3On = .false.
-
- if(config_vert_tracer_adv_order.eq.3) then
- stencil3On = .true.
- endif
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvStencil3Init
-
-!***********************************************************************
-
-end module OcnTracerVadvStencil3
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil4.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil4.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil4.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,234 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnTracerVadvStencil4
-!
-!> \brief MPAS ocean vertical tracer advection driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> vertical advection tendencies.
-!
-!-----------------------------------------------------------------------
-
-module OcnTracerVadvStencil4
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnTracerVadvStencil4Tend, &
- OcnTracerVadvStencil4Init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: stencil4On
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnTracerVadvStencil4Tend
-!
-!> \brief Computes tendency term for vertical tracer advection
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for tracer
-!> based on current state and user choices of advection parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerVadvStencil4Tend(grid, wTop, tracers, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- wTop !< Input: vertical velocity in top layer
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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("compute_scalar_tend-vert adv stencil 4")
-
- nCells = grid % nCells
- nCellsSolve = grid % nCellsSolve
- num_tracers = size(tracers, 1)
- nVertLevels = grid % nVertLevels
- maxLevelCell => grid % maxLevelCell % array
- hRatioZLevelK => grid % hRatioZLevelK % array
- hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
-
- allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
-
- ! 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) = &
- hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
- + hRatioZLevelKm1(k)*tracers(iTracer,k ,iCell)
- end do
- do k=3,maxLevelCell(iCell)-1
- do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- (- tracers(iTracer,k-2,iCell) &
- +7.*tracers(iTracer,k-1,iCell) &
- +7.*tracers(iTracer,k ,iCell) &
- - tracers(iTracer,k+1,iCell) &
- )/12.
- end do
- end do
- k=maxLevelCell(iCell)
- do iTracer=1,num_tracers
- tracerTop(iTracer,k,iCell) = &
- hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
- + hRatioZLevelKm1(k)*tracers(iTracer,k ,iCell)
- 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) &
- - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
- - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
- end do
- end do
- end do
-
- deallocate(tracerTop)
- call timer_stop("compute_scalar_tend-vert adv stencil 4")
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvStencil4Tend
-
-!***********************************************************************
-!
-! routine OcnTracerVadvStencil4Init
-!
-!> \brief Initializes ocean tracer vertical advection quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity advection in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnTracerVadvStencil4Init(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- err = 0
- stencil4On = .false.
-
- if(config_vert_tracer_adv_order.eq.4) then
- stencil4On = .true.
- endif
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVadvStencil4Init
-
-!***********************************************************************
-
-end module OcnTracerVadvStencil4
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnVelCoriolis.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnVelCoriolis.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnVelCoriolis.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,185 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnVelCoriolis
-!
-!> \brief MPAS ocean horizontal momentum mixing driver
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the routine for computing
-!> tendencies from the coriolis force.
-!>
-!
-!-----------------------------------------------------------------------
-
-module OcnVelCoriolis
-
- use grid_types
- use configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnVelCoriolisTend, &
- OcnVelCoriolisInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnVelCoriolisTend
-!
-!> \brief Computes tendency term for coriolis force
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the coriolis tendency for momentum
-!> based on current state.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelCoriolisTend(grid, pv_edge, h_edge, u, ke, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- pv_edge, h_edge, u, ke
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< 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 => grid % maxLevelEdgeTop % array
- nEdgesOnEdge => grid % nEdgesOnEdge % array
- cellsOnEdge => grid % cellsOnEdge % array
- edgesOnEdge => grid % edgesOnEdge % array
- weightsOnEdge => grid % weightsOnEdge % array
- dcEdge => 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) &
- + q &
- - ( ke(k,cell2) - ke(k,cell1) ) / dcEdge(iEdge)
-
- end do
- end do
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelCoriolisTend
-
-!***********************************************************************
-!
-! routine OcnVelCoriolisInit
-!
-!> \brief Initializes ocean momentum horizontal mixing quantities
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity mixing in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnVelCoriolisInit(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! Output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- err = 0
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelCoriolisInit
-
-!***********************************************************************
-
-end module OcnVelCoriolis
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnVelForcing.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnVelForcing.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnVelForcing.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,180 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnVelForcing
-!
-!> \brief MPAS ocean forcing driver
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> tendencies from forcings.
-!
-!-----------------------------------------------------------------------
-
-module OcnVelForcing
-
- use grid_types
- use configure
-
- use OcnVelForcingWindStress
- use OcnVelForcingBottomDrag
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnVelForcingTend, &
- OcnVelForcingInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnVelForcingTend
-!
-!> \brief Computes tendency term from forcings
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the forcing tendency for momentum
-!> based on current state and user choices of forcings.
-!> Multiple forcings may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen forcing, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelForcingTend(grid, u, u_src, ke_edge, h_edge, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: velocity
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u_src !< Input: wind stress
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- ke_edge !< Input: kinetic energy at edge
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 OcnVelForcingWindStressTend(grid, u_src, h_edge, tend, err1)
- call OcnVelForcingBottomDragTend(grid, u, ke_edge, h_edge, tend, err2)
-
- err = err1 .or. err2
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelForcingTend
-
-!***********************************************************************
-!
-! routine OcnVelForcingInit
-!
-!> \brief Initializes ocean forcings
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes quantities related to forcings
-!> in the ocean. Since a multiple forcings are available,
-!> this routine primarily calls the
-!> individual init routines for each forcing.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnVelForcingInit(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- integer :: err1, err2
-
- call OcnVelForcingWindStressInit(err1)
- call OcnVelForcingBottomDragInit(err2)
-
- err = err1 .or. err2
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelForcingInit
-
-!***********************************************************************
-
-end module OcnVelForcing
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnVelForcingBottomDrag.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnVelForcingBottomDrag.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnVelForcingBottomDrag.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,201 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnVelForcingBottomDrag
-!
-!> \brief MPAS ocean bottom drag
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the routine for computing
-!> tendencies from bottom drag.
-!
-!-----------------------------------------------------------------------
-
-module OcnVelForcingBottomDrag
-
- use grid_types
- use configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnVelForcingBottomDragTend, &
- OcnVelForcingBottomDragInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: bottomDragOn
- real (kind=RKIND) :: bottomDragCoef
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnVelForcingBottomDragTend
-!
-!> \brief Computes tendency term from bottom drag
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the bottom drag tendency for momentum
-!> based on current state.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelForcingBottomDragTend(grid, u, ke_edge, h_edge, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: velocity
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- ke_edge !< Input: kinetic energy at edge
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 => 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>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) &
- -bottomDragCoef*u(k,iEdge) &
- *sqrt(2.0*ke_edge(k,iEdge))/h_edge(k,iEdge)
-
- endif
-
- enddo
-
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelForcingBottomDragTend
-
-!***********************************************************************
-!
-! routine OcnVelForcingBottomDragInit
-!
-!> \brief Initializes ocean bottom drag
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes quantities related to bottom drag
-!> in the ocean.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnVelForcingBottomDragInit(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
-
- err = 0
-
- bottomDragOn = .false.
-
- if (.not.config_implicit_vertical_mix) then
- bottomDragOn = .true.
- bottomDragCoef = config_bottom_drag_coeff
- endif
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelForcingBottomDragInit
-
-!***********************************************************************
-
-end module OcnVelForcingBottomDrag
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnVelForcingWindStress.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnVelForcingWindStress.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnVelForcingWindStress.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,190 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnVelForcingWindStress
-!
-!> \brief MPAS ocean wind stress
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the routine for computing
-!> tendencies from wind stress.
-!
-!-----------------------------------------------------------------------
-
-module OcnVelForcingWindStress
-
- use grid_types
- use configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnVelForcingWindStressTend, &
- OcnVelForcingWindStressInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: windStressOn
- real (kind=RKIND) :: rho_ref
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnVelForcingWindStressTend
-!
-!> \brief Computes tendency term from wind stress
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the wind stress tendency for momentum
-!> based on current state.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelForcingWindStressTend(grid, u_src, h_edge, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u_src !< Input: wind stress
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 => 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>0) then
- ! forcing in top layer only
- tend(1,iEdge) = tend(1,iEdge) &
- + u_src(1,iEdge)/rho_ref/h_edge(1,iEdge)
- endif
-
- enddo
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelForcingWindStressTend
-
-!***********************************************************************
-!
-! routine OcnVelForcingWindStressInit
-!
-!> \brief Initializes ocean wind stress forcing
-!> \author Doug Jacobsen
-!> \date 16 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes quantities related to wind stress
-!> in the ocean.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnVelForcingWindStressInit(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
-
- windStressOn = .true.
- rho_ref = 1000.0
-
- err = 0
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelForcingWindStressInit
-
-!***********************************************************************
-
-end module OcnVelForcingWindStress
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnVelHmix.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnVelHmix.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnVelHmix.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,175 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnVelHmix
-!
-!> \brief MPAS ocean horizontal momentum mixing driver
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the main driver routine for computing
-!> horizontal mixing tendencies.
-!>
-!> It provides an init and a tend function. Each are described below.
-!
-!-----------------------------------------------------------------------
-
-module OcnVelHmix
-
- use grid_types
- use configure
- use OcnVelHmixDel2
- use OcnVelHmixDel4
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnVelHmixTend, &
- OcnVelHmixInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnVelHmixTend
-!
-!> \brief Computes tendency term for horizontal momentum mixing
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal mixing tendency for momentum
-!> based on current state and user choices of mixing parameterization.
-!> Multiple parameterizations may be chosen and added together. These
-!> tendencies are generally computed by calling the specific routine
-!> for the chosen parameterization, so this routine is primarily a
-!> driver for managing these choices.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelHmixTend(grid, divergence, vorticity, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- divergence !< Input: velocity divergence
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- vorticity !< Input: vorticity
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 OcnVelHmixDel2Tend(grid, divergence, vorticity, tend, err1)
- call OcnVelHmixDel4Tend(grid, divergence, vorticity, tend, err2)
-
- err = err1 .or. err2
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelHmixTend
-
-!***********************************************************************
-!
-! routine OcnVelHmixInit
-!
-!> \brief Initializes ocean momentum horizontal mixing quantities
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> horizontal velocity mixing in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnVelHmixInit(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- integer :: err1, err2
-
- call OcnVelHmixDel2Init(err1)
- call OcnVelHmixDel4Init(err2)
-
- err = err1 .or. err2
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelHmixInit
-
-!***********************************************************************
-
-end module OcnVelHmix
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnVelHmixDel2.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnVelHmixDel2.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnVelHmixDel2.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,224 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnVelHmixDel2
-!
-!> \brief Ocean horizontal mixing - Laplacian parameterization
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains routines for computing horizontal mixing
-!> tendencies using a Laplacian formulation.
-!
-!-----------------------------------------------------------------------
-
-module OcnVelHmixDel2
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnVelHmixDel2Tend, &
- OcnVelHmixDel2Init
-
- !-------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: &
- hmixDel2On !< local flag to determine whether del2 chosen
-
- real (kind=RKIND) :: &
- eddyVisc2, &!< base eddy diffusivity for Laplacian
- viscVortCoef
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnVelHmixDel2Tend
-!
-!> \brief Computes tendency term for Laplacian horizontal momentum mixing
-!> \author Phil Jones, Doug Jacobsen
-!> \date 22 August 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal mixing tendency for momentum
-!> based on a Laplacian form for the mixing, </font>
<font color="black">u_2 </font>
<font color="red">abla^2 u
-!> This tendency takes the
-!> form </font>
<font color="black">u( </font>
<font color="black">abla divergence + k \times </font>
<font color="red">abla vorticity ),
-!> where </font>
<font color="red">u is a viscosity and k is the vertical unit vector.
-!> This form is strictly only valid for constant </font>
<font color="red">u .
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelHmixDel2Tend(grid, divergence, vorticity, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- divergence !< Input: velocity divergence
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- vorticity !< Input: vorticity
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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, &
- dcEdge, dvEdge
-
- !-----------------------------------------------------------------
- !
- ! exit if this mixing is not selected
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- if(.not.hmixDel2On) return
-
- call timer_start("compute_tend_u-horiz mix-del2")
-
- nEdgesSolve = grid % nEdgesSolve
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- cellsOnEdge => grid % cellsOnEdge % array
- verticesOnEdge => grid % verticesOnEdge % array
- meshScalingDel2 => grid % meshScalingDel2 % array
- dcEdge => grid % dcEdge % array
- dvEdge => 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) &
- -viscVortCoef &
- *( 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("compute_tend_u-horiz mix-del2")
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelHmixDel2Tend
-
-!***********************************************************************
-!
-! routine OcnVelHmixDel2Init
-!
-!> \brief Initializes ocean momentum Laplacian horizontal mixing
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> Laplacian horizontal momentum mixing in the ocean.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelHmixDel2Init(err)
-
-
- integer, intent(out) :: err
-
- !--------------------------------------------------------------------
- !
- ! set some local module variables based on input config choices
- !
- !--------------------------------------------------------------------
-
- err = 0
-
- hmixDel2On = .false.
-
- if ( config_h_mom_eddy_visc2 > 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 OcnVelHmixDel2Init
-
-!***********************************************************************
-
-end module OcnVelHmixDel2
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnVelHmixDel4.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnVelHmixDel4.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnVelHmixDel4.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,300 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnVelHmixDel4
-!
-!> \brief Ocean horizontal mixing - biharmonic parameterization
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains routines and variables for computing
-!> horizontal mixing tendencies using a biharmonic formulation.
-!
-!-----------------------------------------------------------------------
-
-module OcnVelHmixDel4
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnVelHmixDel4Tend, &
- OcnVelHmixDel4Init
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: &
- hmixDel4On !< local flag to determine whether del4 chosen
-
- real (kind=RKIND) :: &
- eddyVisc4, &!< base eddy diffusivity for biharmonic
- viscVortCoef
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnVelHmixDel4Tend
-!
-!> \brief Computes tendency term for biharmonic horizontal momentum mixing
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the horizontal mixing tendency for momentum
-!> based on a biharmonic form for the mixing. This mixing tendency
-!> takes the form -</font>
<font color="black">u_4 </font>
<font color="red">abla^4 u
-!> but is 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.
-!> This formulation is only valid for constant </font>
<font color="red">u_4 .
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelHmixDel4Tend(grid, divergence, vorticity, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- divergence !< Input: velocity divergence
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- vorticity !< Input: vorticity
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iEdge, nEdges, cell1, cell2, vertex1, vertex2, k
- integer :: iCell, iVertex
- integer :: nVertices, nVertLevels, nCells
-
- integer, dimension(:), pointer :: maxLevelEdgeTop, maxLevelVertexBot, &
- maxLevelCell
- integer, dimension(:,:), pointer :: cellsOnEdge, verticesOnEdge
-
-
- real (kind=RKIND) :: u_diffusion, r
- real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, areaTriangle, &
- meshScalingDel4, areaCell
-
- real (kind=RKIND), dimension(:,:), allocatable :: delsq_divergence, &
- delsq_u, delsq_circulation, delsq_vorticity
-
- err = 0
-
- if(.not.hmixDel4On) return
-
- call timer_start("compute_tend-horiz mix-del4")
-
- nCells = grid % nCells
- nEdges = grid % nEdges
- nVertices = grid % nVertices
- nVertLevels = grid % nVertLevels
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelVertexBot => grid % maxLevelVertexBot % array
- maxLevelCell => grid % maxLevelCell % array
- cellsOnEdge => grid % cellsOnEdge % array
- verticesOnEdge => grid % verticesOnEdge % array
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaTriangle => grid % areaTriangle % array
- areaCell => grid % areaCell % array
- meshScalingDel4 => 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) = &
- ( divergence(k,cell2) - divergence(k,cell1) ) / dcEdge(iEdge) &
- -viscVortCoef &
- *( 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) &
- - dcEdge(iEdge) * delsq_u(k,iEdge)
- delsq_circulation(k,vertex2) = delsq_circulation(k,vertex2) &
- + 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) &
- + 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,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) = &
- ( divergence(k,cell2) - divergence(k,cell1) ) / dcEdge(iEdge) &
- -( vorticity(k,vertex2) - vorticity(k,vertex1)) / dvEdge(iEdge)
-
- u_diffusion = ( delsq_divergence(k,cell2) &
- - delsq_divergence(k,cell1) ) / dcEdge(iEdge) &
- -viscVortCoef &
- *( delsq_vorticity(k,vertex2) &
- - 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("compute_tend-horiz mix-del4")
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelHmixDel4Tend
-
-!***********************************************************************
-!
-! routine OcnVelHmixDel4Init
-!
-!> \brief Initializes ocean momentum biharmonic horizontal mixing
-!> \author Phil Jones, Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> biharmonic horizontal tracer mixing in the ocean.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnVelHmixDel4Init(err)
-
- integer, intent(out) :: err
-
- !--------------------------------------------------------------------
- !
- ! set some local module variables based on input config choices
- !
- !--------------------------------------------------------------------
-
- err = 0
-
- hmixDel4On = .false.
-
- if ( config_h_mom_eddy_visc4 > 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 OcnVelHmixDel4Init
-
-!***********************************************************************
-
-end module OcnVelHmixDel4
-
-!||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnVelPressureGrad.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnVelPressureGrad.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnVelPressureGrad.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,196 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnVelPressureGrad
-!
-!> \brief MPAS ocean pressure gradient module
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the routine for computing
-!> tendencie from the horizontal pressure gradient.
-!>
-!
-!-----------------------------------------------------------------------
-
-module OcnVelPressureGrad
-
- use grid_types
- use configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnVelPressureGradTend, &
- OcnVelPressureGradInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- real (kind=RKIND) :: rho0Inv
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnVelPressureGradTend
-!
-!> \brief Computes tendency term for horizontal pressure gradient
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the pressure gradient tendency for momentum
-!> based on current state.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelPressureGradTend(grid, pressure, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- pressure !< Input: Pressure field or Mongomery potential
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< 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 => grid % maxLevelEdgeTop % array
- cellsOnEdge => grid % cellsOnEdge % array
- dcEdge => 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) &
- - (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) &
- - rho0Inv*( pressure(k,cell2) &
- - pressure(k,cell1) )/dcEdge(iEdge)
- end do
-
- enddo
- endif
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelPressureGradTend
-
-!***********************************************************************
-!
-! routine OcnVelPressureGradInit
-!
-!> \brief Initializes ocean momentum horizontal pressure gradient
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes parameters required for the computation of the
-!> horizontal pressure gradient.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnVelPressureGradInit(err)
-
- !--------------------------------------------------------------------
-
-
- !-----------------------------------------------------------------
- !
- ! Output Variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< 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 OcnVelPressureGradInit
-
-!***********************************************************************
-
-end module OcnVelPressureGrad
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnVelVadv.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnVelVadv.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnVelVadv.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,193 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnVelVadv
-!
-!> \brief MPAS ocean vertical advection
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the routine for computing
-!> tendencies for vertical advection.
-!>
-!
-!-----------------------------------------------------------------------
-
-module OcnVelVadv
-
- use grid_types
- use configure
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnVelVadvTend, &
- OcnVelVadvInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: velVadvOn
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnVelVadvTend
-!
-!> \brief Computes tendency term for vertical advection
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical advection tendency for momentum
-!> based on current state.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelVadvTend(grid, u, wTop, tend, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u, wTop
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- tend !< Input/Output: velocity tendency
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err !< 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 => grid % maxLevelEdgeTop % array
- cellsOnEdge => grid % cellsOnEdge % array
- zMidZLevel => 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)) &
- / (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) &
- - 0.5 * (w_dudzTopEdge(k) + w_dudzTopEdge(k+1))
- enddo
- enddo
- deallocate(w_dudzTopEdge)
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelVadvTend
-
-!***********************************************************************
-!
-! routine OcnVelVadvInit
-!
-!> \brief Initializes ocean momentum vertical advection
-!> \author Doug Jacobsen
-!> \date 15 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity advection in the ocean.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnVelVadvInit(err)
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! Output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- err = 0
- velVadvOn = .false.
-
- if (config_vert_grid_type.eq.'zlevel') then
- velVadvOn = .true.
- end if
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelVadvInit
-
-!***********************************************************************
-
-end module OcnVelVadv
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnVmix.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnVmix.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnVmix.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,724 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnVmix
-!
-!> \brief MPAS ocean vertical mixing driver
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module is the main driver for
-!> vertical mixing in the ocean.
-!>
-!
-!-----------------------------------------------------------------------
-
-module OcnVmix
-
- use grid_types
- use configure
- use timer
-
- use OcnVmixCoefsConst
- use OcnVmixCoefsTanh
- use OcnVmixCoefsRich
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- private :: tridiagonal_solve, &
- tridiagonal_solve_mult
-
- public :: OcnVmixCoefs, &
- OcnVelVmixTendExplicit, &
- OcnTracerVmixTendExplicit, &
- OcnVelVmixTendImplicit, &
- OcnTracerVmixTendImplicit, &
- OcnVmixInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: explicitOn, implicitOn
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnVmixCoefs
-!
-!> \brief Computes coefficients for vertical mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical mixing coefficients for momentum
-!> and tracers based user choices of mixing parameterization.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVmixCoefs(grid, s, d, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- type (state_type), intent(inout) :: &
- s !< Input/Output: state information
-
- type (diagnostics_type), intent(inout) :: &
- d !< Input/Output: diagnostic information
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: err1, err2, err3
-
- !-----------------------------------------------------------------
- !
- ! call relevant routines for computing coefficients
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- call OcnVmixCoefsConstBuild(grid, s, d, err1)
- call OcnVmixCoefsTanhBuild(grid, s, d, err2)
- call OcnVmixCoefsRichBuild(grid, s, d, err3)
-
- err = err1 .or. err2 .or. err3
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVmixCoefs!}}}
-
-!***********************************************************************
-!
-! routine OcnVelVmixTendExplict
-!
-!> \brief Computes tendencies for explict momentum vertical mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the tendencies for explicit vertical mixing for momentum
-!> using computed coefficients.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelVmixTendExplicit(grid, u, h_edge, vertViscTopOfEdge, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- u !< Input: velocity
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- vertViscTopOfEdge !< Input: vertical mixing coefficients
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- tend !< Input/Output: tendency information
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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("compute_tend_u-explicit vert mix")
-
- nEdgessolve = grid % nEdgesSolve
- nVertLevels = grid % nVertLevels
- maxLevelEdgeTop => 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) &
- * ( u(k-1,iEdge) - u(k,iEdge) ) &
- * 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) &
- + (fluxVertTop(k) - fluxVertTop(k+1)) &
- / h_edge(k,iEdge)
- enddo
-
- end do
- deallocate(fluxVertTop)
-
- call timer_stop("compute_tend_u-explicit vert mix")
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelVmixTendExplicit!}}}
-
-!***********************************************************************
-!
-! routine OcnVelVmixTendImplicit
-!
-!> \brief Computes tendencies for implicit momentum vertical mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the tendencies for implicit vertical mixing for momentum
-!> using computed coefficients.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelVmixTendImplicit(grid, dt, ke_edge, vertViscTopOfEdge, h, h_edge, u, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- ke_edge !< Input: kinetic energy at edge
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- vertViscTopOfEdge !< Input: vertical mixing coefficients
-
- real (kind=RKIND), intent(in) :: &
- dt !< Input: time step
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h !< Input: thickness at cell center
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- u !< Input: velocity
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: &
- h_edge !< Input: thickness at edge
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 => grid % maxLevelEdgeTop % array
- cellsOnEdge => 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) &
- / (h_edge(k,iEdge) + h_edge(k+1,iEdge)) &
- / h_edge(k,iEdge)
- enddo
- A(maxLevelEdgeTop(iEdge)) = -dt*config_bottom_drag_coeff &
- *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 OcnVelVmixTendImplicit!}}}
-
-!***********************************************************************
-!
-! routine OcnTracerVmixTendExplict
-!
-!> \brief Computes tendencies for explict tracer vertical mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the tendencies for explicit vertical mixing for
-!> tracers using computed coefficients.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerVmixTendExplicit(grid, h, vertDiffTopOfCell, tracers, tend, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h !< Input: thickness at cell center
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- vertDiffTopOfCell !< Input: vertical mixing coefficients
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: &
- tracers !< Input: tracers
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tend !< Input/Output: tendency information
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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("compute_scalar_tend-explicit vert diff")
-
- nCellsSolve = grid % nCellsSolve
- nVertLevels = grid % nVertLevels
- num_tracers = size(tracers, dim=1)
-
- maxLevelCell => 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) &
- * ( tracers(iTracer,k-1,iCell) &
- - tracers(iTracer,k ,iCell) ) &
- * 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) &
- + 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("compute_scalar_tend-explicit vert diff")
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVmixTendExplicit!}}}
-
-!***********************************************************************
-!
-! routine OcnTracerVmixTendImplicit
-!
-!> \brief Computes tendencies for implicit tracer vertical mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the tendencies for implicit vertical mixing for
-!> tracers using computed coefficients.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerVmixTendImplicit(grid, dt, vertDiffTopOfCell, h, tracers, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- vertDiffTopOfCell !< Input: vertical mixing coefficients
-
- real (kind=RKIND), intent(in) :: &
- dt !< Input: time step
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h !< Input: thickness at cell center
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
- tracers !< Input: tracers
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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 => 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) &
- / (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), &
- 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 OcnTracerVmixTendImplicit!}}}
-
-!***********************************************************************
-!
-! routine OcnVmixInit
-!
-!> \brief Initializes ocean vertical mixing quantities
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical mixing in the ocean. This primarily determines if
-!> explicit or implicit vertical mixing is to be used.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnVmixInit(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- integer :: err1, err2, err3
-
- err = 0
-
- explicitOn = .true.
- implicitOn = .false.
-
- if(config_implicit_vertical_mix) then
- explicitOn = .false.
- implicitOn =.true.
- end if
-
- call OcnVmixCoefsConstInit(err1)
- call OcnVmixCoefsTanhInit(err2)
- call OcnVmixCoefsRichInit(err3)
-
- err = err .or. err1 .or. err2 .or. err3
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVmixInit!}}}
-
-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("tridiagonal_solve")
-
- ! 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("tridiagonal_solve")
-
-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("tridiagonal_solve_mult")
-
- ! 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("tridiagonal_solve_mult")
-
-end subroutine tridiagonal_solve_mult!}}}
-
-!***********************************************************************
-
-end module OcnVmix
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-
-! vim: foldmethod=marker
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnVmixCoefsConst.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnVmixCoefsConst.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnVmixCoefsConst.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,306 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnVmixCoefsConst
-!
-!> \brief MPAS ocean vertical mixing coefficients
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the routines for computing
-!> constant vertical mixing coefficients.
-!>
-!
-!-----------------------------------------------------------------------
-
-module OcnVmixCoefsConst
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- private :: OcnVelVmixCoefsConst, &
- OcnTracerVmixCoefsConst
-
- public :: OcnVmixCoefsConstBuild, &
- OcnVmixCoefsConstInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: constViscOn, constDiffOn
-
- real (kind=RKIND) :: constVisc, constDiff
-
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnVmixCoefsConstBuild
-!
-!> \brief Computes coefficients for vertical mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical mixing coefficients for momentum
-!> and tracers based user choices of mixing parameterization.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVmixCoefsConstBuild(grid, s, d, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- type (state_type), intent(inout) :: &
- s !< Input/Output: state information
-
- type (diagnostics_type), intent(inout) :: &
- d !< Input/Output: diagnostic information
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: err1, err2
-
- real (kind=RKIND), dimension(:,:), pointer :: &
- 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 => d % vertViscTopOfEdge % array
- vertDiffTopOfCell => d % vertDiffTopOfCell % array
-
- call OcnVelVmixCoefsConst(grid, vertViscTopOfEdge, err1)
- call OcnTracerVmixCoefsConst(grid, vertDiffTopOfCell, err2)
-
- err = err1 .or. err2
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVmixCoefsConstBuild!}}}
-
-!***********************************************************************
-!
-! routine OcnVelVmixCoefsConst
-!
-!> \brief Computes coefficients for vertical momentum mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the constant vertical mixing coefficients for momentum
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelVmixCoefsConst(grid, vertViscTopOfEdge, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(out) :: vertViscTopOfEdge
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- if(.not.constViscOn) return
-
- vertViscTopOfEdge = constVisc
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelVmixCoefsConst!}}}
-
-!***********************************************************************
-!
-! routine OcnTracerVmixCoefsConst
-!
-!> \brief Computes coefficients for vertical tracer mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the constant vertical mixing coefficients for tracers
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerVmixCoefsConst(grid, vertDiffTopOfCell, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(out) :: vertDiffTopOfCell
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- err = 0
-
- if(.not.constDiffOn) return
-
- vertDiffTopOfCell = constDiff
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVmixCoefsConst!}}}
-
-
-!***********************************************************************
-!
-! routine OcnVmixCoefsConstInit
-!
-!> \brief Initializes ocean momentum vertical mixing quantities
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity mixing in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnVmixCoefsConstInit(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- 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 OcnVmixCoefsConstInit!}}}
-
-!***********************************************************************
-
-end module OcnVmixCoefsConst
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-
-! vim: foldmethod=marker
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnVmixCoefsRich.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnVmixCoefsRich.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnVmixCoefsRich.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,596 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnVmixCoefsRich
-!
-!> \brief MPAS ocean vertical mixing coefficients
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the routines for computing
-!> richardson vertical mixing coefficients.
-!>
-!
-!-----------------------------------------------------------------------
-
-module OcnVmixCoefsRich
-
- use grid_types
- use configure
- use constants
- use timer
-
- use OcnEquationOfState
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- public :: OcnVmixCoefsRichBuild, &
- OcnVmixCoefsRichInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: richViscOn, richDiffOn
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnVmixCoefsRichBuild
-!
-!> \brief Computes coefficients for vertical mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical mixing coefficients for momentum
-!> and tracers based user choices of mixing parameterization.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVmixCoefsRichBuild(grid, s, d, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- type (state_type), intent(inout) :: &
- s !< Input/Output: state information
-
- type (diagnostics_type), intent(inout) :: &
- d !< Input/Output: diagnostic information
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: err1, err2, err3, indexT, indexS
-
- real (kind=RKIND), dimension(:,:), pointer :: &
- 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 => d % vertViscTopOfEdge % array
- vertDiffTopOfCell => d % vertDiffTopOfCell % array
- RiTopOfEdge => d % RiTopOfEdge % array
- RiTopOfCell => d % RiTopOfCell % array
-
- u => s % u % array
- h => s % h % array
- h_edge => s % h_edge % array
- rho => s % rho % array
- rhoDisplaced => s % rhoDisplaced % array
- tracers => s % tracers % array
-
- call OcnEquationOfStateRho(s, grid, 0, 'relative')
- call OcnEquationOfStateRho(s, grid, 1, 'relative')
-
- call OcnVmixGetRichNumbers(grid, indexT, indexS, u, h, h_edge, &
- rho, rhoDisplaced, tracers, RiTopOfEdge, RiTopOfCell, err1)
-
- call OcnVelVmixCoefsRich(grid, RiTopOfEdge, h_edge, vertViscTopOfEdge, err2)
- call OcnTracerVmixCoefsRich(grid, RiTopOfCell, h, vertDiffTopOfCell, err3)
-
- err = err1 .or. err2 .or. err3
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVmixCoefsRichBuild!}}}
-
-!***********************************************************************
-!
-! routine OcnVelVmixCoefsRich
-!
-!> \brief Computes coefficients for vertical momentum mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the richardson vertical mixing coefficients for momentum
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelVmixCoefsRich(grid, RiTopOfEdge, h_edge, vertViscTopOfEdge, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h_edge !< Input: thickness at edge
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- RiTopOfEdge !< Richardson number at top of edge
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(out) :: vertViscTopOfEdge
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iEdge, nEdges, k
-
- integer, dimension(:), pointer :: maxLevelEdgeTop
-
- err = 0
-
- if(.not.richViscOn) return
-
- nEdges = grid % nEdges
-
- maxLevelEdgeTop => 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)>0.0) then
- vertViscTopOfEdge(k,iEdge) = config_bkrd_vert_visc &
- + 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) > config_convective_visc) then
- if( config_implicit_vertical_mix) then
- vertViscTopOfEdge(k,iEdge) = config_convective_visc
- else
- vertViscTopOfEdge(k,iEdge) = &
- ((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<0 and implicit mix, use convective diffusion
- vertViscTopOfEdge(k,iEdge) = config_convective_visc
- else
- ! for Ri<0 and explicit vertical mix,
- ! use maximum diffusion allowed by CFL criterion
- ! mrp 110324 efficiency note: for z-level, could use fixed
- ! grid array hMeanTopZLevel and compute maxdiff on startup.
- vertViscTopOfEdge(k,iEdge) = &
- ((h_edge(k-1,iEdge)+h_edge(k,iEdge))/2.0)**2/config_dt/4.0
- end if
- end if
- end do
- end do
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelVmixCoefsRich!}}}
-
-!***********************************************************************
-!
-! routine OcnTracerVmixCoefsRich
-!
-!> \brief Computes coefficients for vertical tracer mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the richardson vertical mixing coefficients for tracers
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerVmixCoefsRich(grid, RiTopOfCell, h, vertDiffTopOfCell, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- h !< Input: thickness at cell center
-
- real (kind=RKIND), dimension(:,:), intent(in) :: &
- RiTopOfCell !< Input: Richardson number at top of cell
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(out) :: vertDiffTopOfCell
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: iCell, nCells, k
-
- integer, dimension(:), pointer :: maxLevelCell
-
- real (kind=RKIND) :: coef
-
- err = 0
-
- if(.not.richDiffOn) return
-
- nCells = grid % nCells
-
- maxLevelCell => 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)>0.0) then
- vertDiffTopOfCell(k,iCell) = config_bkrd_vert_diff &
- + (config_bkrd_vert_visc &
- + config_rich_mix / (1.0 + 5.0*RiTopOfCell(k,iCell))**2) &
- / (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) > config_convective_diff) then
- if (config_implicit_vertical_mix) then
- vertDiffTopOfCell(k,iCell) = config_convective_diff
- else
- vertDiffTopOfCell(k,iCell) = &
- ((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<0 and implicit mix, use convective diffusion
- vertDiffTopOfCell(k,iCell) = config_convective_diff
- else
- ! for Ri<0 and explicit vertical mix,
- ! use maximum diffusion allowed by CFL criterion
- ! mrp 110324 efficiency note: for z-level, could use fixed
- ! grid array hMeanTopZLevel and compute maxdiff on startup.
- vertDiffTopOfCell(k,iCell) = &
- ((h(k-1,iCell)+h(k,iCell))/2.0)**2/config_dt/4.0
- end if
- end if
- end do
- end do
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVmixCoefsRich!}}}
-
-!***********************************************************************
-!
-! routine OcnVmixGetRichNumbers
-!
-!> \brief Build richardson numbers for vertical mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine builds the arrays needed for richardson number vertical
-!> mixing coefficients.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVmixGetRichNumbers(grid, indexT, indexS, u, h, h_edge, & !{{{
- rho, rhoDisplaced, tracers, RiTopOfEdge, RiTopOfCell, err)
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- integer, intent(in) :: indexT, indexS
-
- real (kind=RKIND), dimension(:,:), intent(in) :: u, h, h_edge
-
- real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(inout) :: rho, rhoDisplaced, &
- RiTopOfEdge, RiTopOfCell
-
- integer, intent(inout) :: err
-
- !-----------------------------------------------------------------
- !
- ! 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, &
- drhoTopOfEdge, du2TopOfEdge
-
- err = 0
-
- if(.not.richViscOn .and. .not.richDiffOn) return
-
- nVertLevels = grid % nVertLevels
- nCells = grid % nCells
- nEdges = grid % nEdges
-
- maxLevelCell => grid % maxLevelCell % array
- maxLevelEdgeTop => grid % maxLevelEdgeTop % array
- maxLevelEdgeBot => grid % maxLevelEdgeBot % array
- cellsOnEdge => grid % cellsOnEdge % array
- dvEdge => grid % dvEdge % array
- dcEdge => grid % dcEdge % array
- areaCell => grid % areaCell % array
-
- allocate( &
- drhoTopOfCell(nVertLevels+1,nCells+1), drhoTopOfEdge(nVertLevels+1,nEdges+1), &
- du2TopOfCell(nVertLevels+1,nCells+1), du2TopOfEdge(nVertLevels+1,nEdges+1))
-
- ! 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, &
-! tracers, rho, err)
- ! mrp 110324 In order to visualize rhoDisplaced, include the following
-! call OcnEquationOfStateRho(grid, 'relative', 1, indexT, indexS, &
-! 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) = &
- (drhoTopOfCell(k,cell1) + &
- 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) &
- + 0.5 * dcEdge(iEdge) * dvEdge(iEdge) * du2TopOfEdge(k,iEdge)
- du2TopOfCell(k,cell2) = du2TopOfCell(k,cell2) &
- + 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) &
- *(h_edge(k-1,iEdge)+h_edge(k,iEdge)) &
- / (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) &
- *(h(k-1,iCell)+h(k,iCell)) &
- / (du2TopOfCell(k,iCell) + 1e-20)
- end do
- end do
-
- deallocate(drhoTopOfCell, drhoTopOfEdge, &
- du2TopOfCell, du2TopOfEdge)
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVmixGetRichNumbers!}}}
-
-!***********************************************************************
-!
-! routine OcnVmixCoefsRichInit
-!
-!> \brief Initializes ocean momentum vertical mixing quantities
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> vertical velocity mixing in the ocean. Since a variety of
-!> parameterizations are available, this routine primarily calls the
-!> individual init routines for each parameterization.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnVmixCoefsRichInit(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- 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 OcnVmixCoefsRichInit!}}}
-
-!***********************************************************************
-
-end module OcnVmixCoefsRich
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-
-! vim: foldmethod=marker
Deleted: branches/ocean_projects/performance/src/core_ocean/module_OcnVmixCoefsTanh.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_OcnVmixCoefsTanh.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_OcnVmixCoefsTanh.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,332 +0,0 @@
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-!
-! OcnVmixCoefsTanh
-!
-!> \brief MPAS ocean vertical mixing coefficients
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id:$
-!> \details
-!> This module contains the routines for computing
-!> tanhant vertical mixing coefficients.
-!>
-!
-!-----------------------------------------------------------------------
-
-module OcnVmixCoefsTanh
-
- use grid_types
- use configure
- use timer
-
- implicit none
- private
- save
-
- !--------------------------------------------------------------------
- !
- ! Public parameters
- !
- !--------------------------------------------------------------------
-
- !--------------------------------------------------------------------
- !
- ! Public member functions
- !
- !--------------------------------------------------------------------
-
- private :: OcnVelVmixCoefsTanh, &
- OcnTracerVmixCoefsTanh
-
- public :: OcnVmixCoefsTanhBuild, &
- OcnVmixCoefsTanhInit
-
- !--------------------------------------------------------------------
- !
- ! Private module variables
- !
- !--------------------------------------------------------------------
-
- logical :: tanhViscOn, tanhDiffOn
-
-!***********************************************************************
-
-contains
-
-!***********************************************************************
-!
-! routine OcnVmixCoefsTanhBuild
-!
-!> \brief Computes coefficients for vertical mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the vertical mixing coefficients for momentum
-!> and tracers based user choices of mixing parameterization.
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVmixCoefsTanhBuild(grid, s, d, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- type (state_type), intent(inout) :: &
- s !< Input/Output: state information
-
- type (diagnostics_type), intent(inout) :: &
- d !< Input/Output: diagnostic information
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: err1, err2
-
- real (kind=RKIND), dimension(:,:), pointer :: &
- 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 => d % vertViscTopOfEdge % array
- vertDiffTopOfCell => d % vertDiffTopOfCell % array
-
- call OcnVelVmixCoefsTanh(grid, vertViscTopOfEdge, err1)
- call OcnTracerVmixCoefsTanh(grid, vertDiffTopOfCell, err2)
-
- err = err1 .or. err2
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVmixCoefsTanhBuild!}}}
-
-!***********************************************************************
-!
-! routine OcnVelVmixCoefsTanh
-!
-!> \brief Computes coefficients for vertical momentum mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the tanh vertical mixing coefficients for momentum
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnVelVmixCoefsTanh(grid, vertViscTopOfEdge, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(out) :: vertViscTopOfEdge
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: k, nVertLevels
-
- real (kind=RKIND), dimension(:), pointer :: zTopZLevel
-
- err = 0
-
- if(.not.tanhViscOn) return
-
- nVertLevels = grid % nVertLevels
- zTopZLevel => grid % zTopZLevel % array
-
- do k=1,nVertLevels+1
- vertViscTopOfEdge(k,:) = -(config_max_visc_tanh-config_min_visc_tanh)/2.0 &
- *tanh(-(zTopZLevel(k)-config_ZMid_tanh) &
- /config_zWidth_tanh) &
- + (config_max_visc_tanh+config_min_visc_tanh)/2
- end do
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVelVmixCoefsTanh!}}}
-
-!***********************************************************************
-!
-! routine OcnTracerVmixCoefsTanh
-!
-!> \brief Computes coefficients for vertical tracer mixing
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine computes the tanh vertical mixing coefficients for tracers
-!
-!-----------------------------------------------------------------------
-
- subroutine OcnTracerVmixCoefsTanh(grid, vertDiffTopOfCell, err)!{{{
-
- !-----------------------------------------------------------------
- !
- ! input variables
- !
- !-----------------------------------------------------------------
-
- type (mesh_type), intent(in) :: &
- grid !< Input: grid information
-
- !-----------------------------------------------------------------
- !
- ! input/output variables
- !
- !-----------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! output variables
- !
- !-----------------------------------------------------------------
-
- real (kind=RKIND), dimension(:,:), intent(out) :: vertDiffTopOfCell
-
- integer, intent(out) :: err
-
- !-----------------------------------------------------------------
- !
- ! local variables
- !
- !-----------------------------------------------------------------
-
- integer :: k, nVertLevels
-
- real (kind=RKIND), dimension(:), pointer :: zTopZLevel
-
- err = 0
-
- if(.not.tanhDiffOn) return
-
- nVertLevels = grid % nVertLevels
- zTopZLevel => grid % zTopZLevel % array
-
- do k=1,nVertLevels+1
- vertDiffTopOfCell(k,:) = -(config_max_diff_tanh-config_min_diff_tanh)/2.0 &
- *tanh(-(zTopZLevel(k)-config_ZMid_tanh) &
- /config_zWidth_tanh) &
- + (config_max_diff_tanh+config_min_diff_tanh)/2
- end do
-
-
- !--------------------------------------------------------------------
-
- end subroutine OcnTracerVmixCoefsTanh!}}}
-
-
-!***********************************************************************
-!
-! routine OcnVmixCoefsTanhInit
-!
-!> \brief Initializes ocean vertical mixing quantities
-!> \author Doug Jacobsen
-!> \date 19 September 2011
-!> \version SVN:$Id$
-!> \details
-!> This routine initializes a variety of quantities related to
-!> tanh vertical mixing in the ocean.
-!
-!-----------------------------------------------------------------------
-
-
- subroutine OcnVmixCoefsTanhInit(err)!{{{
-
- !--------------------------------------------------------------------
-
- !-----------------------------------------------------------------
- !
- ! call individual init routines for each parameterization
- !
- !-----------------------------------------------------------------
-
- integer, intent(out) :: err
-
- 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', &
- ' use config_vert_grid_type of zlevel at this time'
- err = 1
- endif
- endif
-
- !--------------------------------------------------------------------
-
- end subroutine OcnVmixCoefsTanhInit!}}}
-
-!***********************************************************************
-
-end module OcnVmixCoefsTanh
-
-!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
-
-! vim: foldmethod=marker
Deleted: branches/ocean_projects/performance/src/core_ocean/module_advection.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_advection.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_advection.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -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 => grid % advCells % array
- deriv_two => 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 > 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) > 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), &
- xc(2), yc(2), zc(2), &
- 0., 0., 1. )
-
-! angles from cell center to neighbor centers (thetav)
-
- do i=1,n-1
-
- ip2 = i+2
- if (ip2 > n) ip2 = 2
-
- thetav(i) = sphere_angle( xc(1), yc(1), zc(1), &
- xc(i+1), yc(i+1), zc(i+1), &
- xc(ip2), yc(ip2), zc(ip2) )
-
- dl_sphere(i) = a*arc_length( xc(1), yc(1), zc(1), &
- 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 ->
- 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)) &
- 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 > 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, &
- xv2, yv2, zv2, &
- xec, yec, zec )
-
- thetae_tmp = sphere_angle( xc(1), yc(1), zc(1), &
- xc(i+1), yc(i+1), zc(i+1), &
- 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) &
- + 2.*costsint*bmatrix(5,j) &
- + 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) &
- + 2.*costsint*bmatrix(5,j) &
- + 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) &
-! + 2.*xe(iEdge)*ye(iEdge)*bmatrix(5,j) &
-! + 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) &
- + 2.*costsint*bmatrix(5,j) &
- + 2.*sin2t*bmatrix(6,j)
- end do
- else
- do j=1,n
- deriv_two(j,2,iEdge) = 2.*cos2t*bmatrix(4,j) &
- + 2.*costsint*bmatrix(5,j) &
- + 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) >= 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) >= 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<n) .or. (ne<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, "An Introduction to Computational Physics," 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 => grid % defc_a % array
- defc_b => grid % defc_b % array
- cellsOnEdge => grid % cellsOnEdge % array
- edgesOnCell => 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) > 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), &
- xc(2), yc(2), zc(2), &
- 0., 0., 1. )
-
-! angles from cell center to neighbor centers (thetav)
-
- do i=1,n-1
-
- ip2 = i+2
- if (ip2 > n) ip2 = 2
-
- thetav(i) = sphere_angle( xc(1), yc(1), zc(1), &
- xc(i+1), yc(i+1), zc(i+1), &
- xc(ip2), yc(ip2), zc(ip2) )
-
- dl_sphere(i) = a*arc_length( xc(1), yc(1), zc(1), &
- 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 ->
-! 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., &
- xp(i)-xp(i-1), yp(i)-yp(i-1), 0., &
- xp(ip1)-xp(i), yp(ip1)-yp(i), 0., &
- 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/ocean_projects/performance/src/core_ocean/module_global_diagnostics.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_global_diagnostics.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_global_diagnostics.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -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, &
- 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 => grid % areaCell % array
- dcEdge => grid % dcEdge % array
- dvEdge => grid % dvEdge % array
- areaTriangle => grid % areaTriangle % array
- allocate(areaEdge(1:nEdgesSolve))
- areaEdge = dcEdge(1:nEdgesSolve)*dvEdge(1:nEdgesSolve)
-
- h => state % h % array
- u => state % u % array
- rho => state % rho % array
- tracers => state % tracers % array
- v => state % v % array
- wTop => state % wTop % array
- h_edge => state % h_edge % array
- circulation => state % circulation % array
- vorticity => state % vorticity % array
- ke => state % ke % array
- pv_edge => state % pv_edge % array
- pv_vertex => state % pv_vertex % array
- pv_cell => state % pv_cell % array
- gradPVn => state % gradPVn % array
- gradPVt => state % gradPVt % array
- MontPot => state % MontPot % array
- pressure => state % pressure % array
-
- variableIndex = 0
- ! h
- variableIndex = variableIndex + 1
- call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
- 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), &
- u(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
- verticalSumMaxes(variableIndex))
-
- ! v
- variableIndex = variableIndex + 1
- call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
- v(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
- verticalSumMaxes(variableIndex))
-
- ! h_edge
- variableIndex = variableIndex + 1
- call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
- sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
-
- ! circulation
- variableIndex = variableIndex + 1
- call computeFieldLocalStats(dminfo, nVertLevels, nVerticesSolve, circulation(:,1:nVerticesSolve), &
- sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
-
- ! vorticity
- variableIndex = variableIndex + 1
- call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nVerticesSolve, areaTriangle(1:nVerticesSolve), &
- vorticity(:,1:nVerticesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), &
- verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
-
- ! ke
- variableIndex = variableIndex + 1
- call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
- ke(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
- verticalSumMaxes(variableIndex))
-
- ! pv_edge
- variableIndex = variableIndex + 1
- call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
- pv_edge(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
- verticalSumMaxes(variableIndex))
-
- ! pv_vertex
- variableIndex = variableIndex + 1
- call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nVerticesSolve, areaTriangle(1:nVerticesSolve), &
- pv_vertex(:,1:nVerticesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), &
- verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
-
- ! pv_cell
- variableIndex = variableIndex + 1
- call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
- pv_cell(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
- verticalSumMaxes(variableIndex))
-
- ! gradPVn
- variableIndex = variableIndex + 1
- call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
- gradPVn(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
- verticalSumMaxes(variableIndex))
-
- ! gradPVt
- variableIndex = variableIndex + 1
- call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
- gradPVt(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
- verticalSumMaxes(variableIndex))
-
- ! pressure
- variableIndex = variableIndex + 1
- call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
- pressure(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
- verticalSumMaxes(variableIndex))
-
- ! MontPot
- variableIndex = variableIndex + 1
- call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
- MontPot(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
- verticalSumMaxes(variableIndex))
-
- ! wTop vertical velocity
- variableIndex = variableIndex + 1
- call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels+1, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
- wTop(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
- 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), &
- tracerTemp, sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
- 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, &
- state % xtime % scalar, dt, &
- 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, &
- 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, &
- 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, &
- 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, &
- 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, &
- 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, &
- 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, &
- 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, &
- 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
Deleted: branches/ocean_projects/performance/src/core_ocean/module_mpas_core.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_mpas_core.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_mpas_core.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -1,778 +0,0 @@
-module mpas_core
-
- use mpas_framework
- use mpas_timekeeping
- use dmpar
- use test_cases
-
- use OcnTimeIntegration
-
- use OcnTendency
-
- use OcnVelPressureGrad
- use OcnVelVadv
- use OcnVelHmix
- use OcnVelForcing
-
- use OcnTracerHadv
- use OcnTracerVadv
- use OcnTracerHmix
- use OcnRestoring
-
- use OcnVmix
-
- 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
-
- 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:',&
- config_vert_grid_type
- call dmpar_abort(dminfo)
- endif
-
- if (trim(config_new_btr_variables_from) == 'btr_avg' &
- .and.trim(config_time_integration) == 'unsplit_explicit') then
- print *, ' unsplit_explicit option must use',&
- ' config_new_btr_variables_from==last_subcycle'
- call dmpar_abort(dminfo)
- endif
-
-
- !
- ! Initialize core
- !
- dt = config_dt
-
- call simulation_clock_init(domain, dt, startTimeStamp)
-
- block => domain % blocklist
- do while (associated(block))
- call mpas_init_block(block, block % mesh, dt)
- block % state % time_levs(1) % state % xtime % scalar = startTimeStamp
- block => block % next
-
- !dwj 110919 This allows the restorings to grab the indices for
- ! temperature and salinity tracers from state.
- end do
-
- call OcnTimestepInit(err)
-
- call OcnVelPressureGradInit(err)
- call OcnVelVadvInit(err)
- call OcnVelHmixInit(err)
- call OcnVelForcingInit(err)
-
- call OcnTracerHadvInit(err)
- call OcnTracerVadvInit(err)
- call OcnTracerHmixInit(err)
- call OcnRestoringInit(err)
-
- call OcnVmixInit(err)
-
- ! 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("global diagnostics")
- ! call computeGlobalDiagnostics(domain % dminfo, block % state % time_levs(1) % state, mesh, 0, dt)
- ! call timer_stop("global diagnostics")
- ! call output_state_init(output_obj, domain, "OUTPUT")
- ! 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) /= "none") 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) /= "none") 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) /= "none") 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) /= "none") 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) /= "none") 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 OcnDiagnosticSolve(dt, block % state % time_levs(1) % state, mesh)
-
- call compute_mesh_scaling(mesh)
-
- call rbfInterp_initialize(mesh)
- call init_reconstruct(mesh)
- call reconstruct(block % state % time_levs(1) % state, mesh)
-
- ! 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( &
- block % mesh % maxLevelEdgeTop % array(iEdge)+1 &
- :block % mesh % maxLevelEdgeBot % array(iEdge), iEdge) = 0.0
-
- block % state % time_levs(1) % state % u % array( &
- block % mesh % maxLevelEdgeBot % array(iEdge)+1: &
- 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( &
- :, block % mesh % maxLevelCell % array(iCell)+1 &
- :block % mesh % nVertLevels,iCell) = 0.0
-! mrp changed to 0
-! :block % mesh % nVertLevels,iCell) = -1e34
-
-! mrp 110516 temp, 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, &
- 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, &
- 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("time integration")
- call mpas_timestep(domain, itimestep, dt, timeStamp)
- call timer_stop("time integration")
-
- ! 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, "OUTPUT", trim(timeStamp)) ! output_frame will always be > 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, "RESTART")
- 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 => domain % blocklist
- do while (associated(block_ptr))
- call compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
- block_ptr => 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 > 0) then
- current_outfile_frames = current_outfile_frames + 1
- if(current_outfile_frames >= 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 OcnTimestep(domain, dt, timeStamp)
-
- if (config_stats_interval > 0) then
- if (mod(itimestep, config_stats_interval) == 0) then
- block_ptr => domain % blocklist
- if (associated(block_ptr % next)) then
- write(0,*) 'Error: computeGlobalDiagnostics assumes ',&
- 'that there is only one block per processor.'
- end if
-
- call timer_start("global diagnostics")
- call computeGlobalDiagnostics(domain % dminfo, &
- block_ptr % state % time_levs(2) % state, block_ptr % mesh, &
- itimestep, dt)
- call timer_stop("global diagnostics")
- 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 => domain % blocklist
- ! if (associated(block_ptr % next)) then
- ! write(0,*) 'Error: computeGlobalDiagnostics assumes ',&
- ! 'that there is only one block per processor.'
- ! end if
-
- ! call timer_start("global diagnostics")
- ! call computeGlobalDiagnostics(domain % dminfo, &
- ! block_ptr % state % time_levs(2) % state, block_ptr % mesh, &
- ! timeStamp, dt)
- ! call timer_stop("global diagnostics")
- !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 :: &
- hZLevel, zMidZLevel, zTopZLevel, &
- hMeanTopZLevel, hRatioZLevelK, hRatioZLevelKm1
- real (kind=RKIND), dimension(:,:), pointer :: h
- integer :: nVertLevels
-
- ! Initialize z-level grid variables from h, read in from input file.
- block => domain % blocklist
- do while (associated(block))
-
- h => block % state % time_levs(1) % state % h % array
- hZLevel => block % mesh % hZLevel % array
- zMidZLevel => block % mesh % zMidZLevel % array
- zTopZLevel => block % mesh % zTopZLevel % array
- nVertLevels = block % mesh % nVertLevels
- hMeanTopZLevel => block % mesh % hMeanTopZLevel % array
- hRatioZLevelK => block % mesh % hRatioZLevelK % array
- hRatioZLevelKm1 => block % mesh % hRatioZLevelKm1 % array
-
- ! 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) &
- = block % state % time_levs(1) % state % h % array(1,iCell) &
- - block % mesh % hZLevel % array(1)
- enddo
-
- ! Compute barotropic velocity at first timestep
- ! This is only done upon start-up.
- if (trim(config_time_integration) == 'unsplit_explicit') then
- block % state % time_levs(1) % state % uBtr % array(:) = 0.0
-
- block % state % time_levs(1) % state % uBcl % array(:,:) &
- = 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) &
- = 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*( &
- block % state % time_levs(1) % state % ssh % array(cell1) &
- + block % state % time_levs(1) % state % ssh % array(cell2) )
-
- ! uBtr = sum(u)/sum(h) on each column
- uhSum = (sshEdge + block % mesh % hZLevel % array(1)) &
- * block % state % time_levs(1) % state % u % array(1,iEdge)
- hSum = sshEdge + block % mesh % hZLevel % array(1)
-
- do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
- uhSum = uhSum &
- + block % mesh % hZLevel % array(k) &
- *block % state % time_levs(1) % state % u % array(k,iEdge)
- hSum = hSum &
- + 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) &
- = block % state % time_levs(1) % state % u % array(k,iEdge) &
- - 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(:,:) &
- = 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)), &
-! maxval(domain % blocklist % state % time_levs(1) % state % u % array(:,1:domain % blocklist % mesh % nEdgesSolve))
-!print *, '11 uBtr ',minval(domain % blocklist % state % time_levs(1) % state % uBtr % array(1:domain % blocklist % mesh % nEdgesSolve)), &
-! maxval(domain % blocklist % state % time_levs(1) % state % uBtr % array(1:domain % blocklist % mesh % nEdgesSolve))
-!print *, '11 uBcl ',minval(domain % blocklist % state % time_levs(1) % state % uBcl % array(:,1:domain % blocklist % mesh % nEdgesSolve)), &
-! maxval(domain % blocklist % state % time_levs(1) % state % uBcl % array(:,1:domain % blocklist % mesh % nEdgesSolve))
-
-
-! mrp temp testing - is uBcl vert sum zero?
-! do iEdge=1,block % mesh % nEdges
-! uhSum = (sshEdge + block % mesh % hZLevel % array(1)) * block % state % time_levs(1) % state % uBcl % array(1,iEdge)
-! hSum = sshEdge + block % mesh % hZLevel % array(1)
-
-! do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
-! uhSum = uhSum + block % mesh % hZLevel % array(k) * block % state % time_levs(1) % state % uBcl % array(k,iEdge)
-! hSum = hSum + block % mesh % hZLevel % array(k)
-! enddo
-! block % state % time_levs(1) % state % FBtr % array(iEdge) = uhSum/hSum
-
-! enddo ! iEdge
-
-!print *, 'uBcl vert sum IC',minval(block % state % time_levs(1) % state % FBtr % array(1:block % mesh % nEdgesSolve)), &
-! maxval(block % state % time_levs(1) % state % FBtr % array(1:block % mesh % nEdgesSolve))
-
-! mrp temp testing - is uBcl vert sum zero? end
-
- block => block % next
-
- end do
-
-end 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 :: &
- maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &
- maxLevelVertexTop, maxLevelVertexBot
- integer, dimension(:,:), pointer :: &
- cellsOnEdge, cellsOnVertex, boundaryEdge, boundaryCell, &
- boundaryVertex, verticesOnEdge
-
- ! Initialize z-level grid variables from h, read in from input file.
- block => domain % blocklist
- do while (associated(block))
-
- maxLevelCell => block % mesh % maxLevelCell % array
- maxLevelEdgeTop => block % mesh % maxLevelEdgeTop % array
- maxLevelEdgeBot => block % mesh % maxLevelEdgeBot % array
- maxLevelVertexTop => block % mesh % maxLevelVertexTop % array
- maxLevelVertexBot => block % mesh % maxLevelVertexBot % array
- cellsOnEdge => block % mesh % cellsOnEdge % array
- cellsOnVertex => block % mesh % cellsOnVertex % array
- verticesOnEdge => block % mesh % verticesOnEdge % array
- boundaryEdge => block % mesh % boundaryEdge % array
- boundaryCell => block % mesh % boundaryCell % array
- boundaryVertex => 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) = &
- min( maxLevelCell(cellsOnEdge(1,iEdge)), &
- 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) = &
- max( maxLevelCell(cellsOnEdge(1,iEdge)), &
- 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) = &
- max( maxLevelVertexBot(iVertex), &
- 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) = &
- min( maxLevelVertexTop(iVertex), &
- 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 => 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 > 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 => mesh % meshDensity % array
- meshScalingDel2 => mesh % meshScalingDel2 % array
- meshScalingDel4 => 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/ocean_projects/performance/src/core_ocean/module_test_cases.F
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/module_test_cases.F 2011-09-29 15:06:23 UTC (rev 1041)
+++ branches/ocean_projects/performance/src/core_ocean/module_test_cases.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -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 => domain % blocklist
- do while (associated(block_ptr))
- call sw_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
- block_ptr => block_ptr % next
- end do
-
- else if (config_test_case == 2) then
- write(0,*) ' Setup shallow water test case 2: '// &
- 'Global Steady State Nonlinear Zonal Geostrophic Flow'
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
- call sw_test_case_2(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
- block_ptr => block_ptr % next
- end do
-
- else if (config_test_case == 5) then
- write(0,*) ' Setup shallow water test case 5:'// &
- ' Zonal Flow over an Isolated Mountain'
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
- call sw_test_case_5(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
- block_ptr => 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 => domain % blocklist
- do while (associated(block_ptr))
- call sw_test_case_6(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
- block_ptr => 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 ', &
- 'are currently supported. '
- call dmpar_abort(dminfo)
- end if
-
- block_ptr => domain % blocklist
- do while (associated(block_ptr))
-
- 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 => 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., "A Standard Test Set for Numerical
- ! Approximations to the Shallow Water Equations in Spherical
- ! Geometry" 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 * ( &
- sin(grid%latVertex%array(iVtx)) * cos(alpha) - &
- cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &
- )
- end do
- do iEdge=1,grid % nEdges
- state % u % array(1,iEdge) = -1.0 * ( &
- psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
- psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
- ) / 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 < 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., "A Standard Test Set for Numerical
- ! Approximations to the Shallow Water Equations in Spherical
- ! Geometry" 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 * ( &
- sin(grid%latVertex%array(iVtx)) * cos(alpha) - &
- cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &
- )
- end do
- do iEdge=1,grid % nEdges
- state % u % array(1,iEdge) = -1.0 * ( &
- psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
- psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
- ) / grid%dvEdge%array(iEdge)
- end do
- deallocate(psiVertex)
-
- !
- ! Generate rotated Coriolis field
- !
- do iEdge=1,grid % nEdges
- grid % fEdge % array(iEdge) = 2.0 * omega * &
- ( -cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &
- sin(grid%latEdge%array(iEdge)) * cos(alpha) &
- )
- end do
- do iVtx=1,grid % nVertices
- grid % fVertex % array(iVtx) = 2.0 * omega * &
- (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &
- sin(grid%latVertex%array(iVtx)) * cos(alpha) &
- )
- 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) * &
- (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &
- sin(grid%latCell%array(iCell)) * cos(alpha) &
- )**2.0 &
- ) / &
- 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., "A Standard Test Set for Numerical
- ! Approximations to the Shallow Water Equations in Spherical
- ! Geometry" 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 * ( &
- sin(grid%latVertex%array(iVtx)) * cos(alpha) - &
- cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &
- )
- end do
- do iEdge=1,grid % nEdges
- state % u % array(1,iEdge) = -1.0 * ( &
- psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
- psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
- ) / grid%dvEdge%array(iEdge)
- end do
- deallocate(psiVertex)
-
- !
- ! Generate rotated Coriolis field
- !
- do iEdge=1,grid % nEdges
- grid % fEdge % array(iEdge) = 2.0 * omega * &
- (-cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &
- sin(grid%latEdge%array(iEdge)) * cos(alpha) &
- )
- end do
- do iVtx=1,grid % nVertices
- grid % fVertex % array(iVtx) = 2.0 * omega * &
- (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &
- sin(grid%latVertex%array(iVtx)) * cos(alpha) &
- )
- end do
-
- !
- ! Initialize mountain
- !
- do iCell=1,grid % nCells
- if (grid % lonCell % array(iCell) < 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 + &
- (grid % latCell % array(iCell) - theta_c - pii/6.0)**2.0 &
- ) &
- )
- 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) * &
- (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &
- sin(grid%latCell%array(iCell)) * cos(alpha) &
- )**2.0 &
- ) / &
- 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., "A Standard Test Set for Numerical
- ! Approximations to the Shallow Water Equations in Spherical
- ! Geometry" 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)) + &
- a *a * K * (cos(grid%latVertex%array(iVtx))**R) * &
- 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 * ( &
- psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
- psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
- ) / 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)) + &
- a*a*BB(grid%latCell%array(iCell)) * cos(R*grid%lonCell%array(iCell)) + &
- a*a*CC(grid%latCell%array(iCell)) * cos(2.0*R*grid%lonCell%array(iCell)) &
- ) / 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 + &
- 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 + &
- 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/ocean_projects/performance/src/core_ocean/mpas_ocn_advection.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_advection.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_advection.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_advection.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,934 @@
+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 => grid % advCells % array
+ deriv_two => 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 > 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) > 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), &
+ xc(2), yc(2), zc(2), &
+ 0., 0., 1. )
+
+! angles from cell center to neighbor centers (thetav)
+
+ do i=1,n-1
+
+ ip2 = i+2
+ if (ip2 > n) ip2 = 2
+
+ thetav(i) = sphere_angle( xc(1), yc(1), zc(1), &
+ xc(i+1), yc(i+1), zc(i+1), &
+ xc(ip2), yc(ip2), zc(ip2) )
+
+ dl_sphere(i) = a*arc_length( xc(1), yc(1), zc(1), &
+ 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 ->
+ 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)) &
+ 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 > 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, &
+ xv2, yv2, zv2, &
+ xec, yec, zec )
+
+ thetae_tmp = sphere_angle( xc(1), yc(1), zc(1), &
+ xc(i+1), yc(i+1), zc(i+1), &
+ 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) &
+ + 2.*costsint*bmatrix(5,j) &
+ + 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) &
+ + 2.*costsint*bmatrix(5,j) &
+ + 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) &
+! + 2.*xe(iEdge)*ye(iEdge)*bmatrix(5,j) &
+! + 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) &
+ + 2.*costsint*bmatrix(5,j) &
+ + 2.*sin2t*bmatrix(6,j)
+ end do
+ else
+ do j=1,n
+ deriv_two(j,2,iEdge) = 2.*cos2t*bmatrix(4,j) &
+ + 2.*costsint*bmatrix(5,j) &
+ + 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) >= 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) >= 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<n) .or. (ne<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, "An Introduction to Computational Physics," 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 => grid % defc_a % array
+ defc_b => grid % defc_b % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ edgesOnCell => 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) > 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), &
+ xc(2), yc(2), zc(2), &
+ 0., 0., 1. )
+
+! angles from cell center to neighbor centers (thetav)
+
+ do i=1,n-1
+
+ ip2 = i+2
+ if (ip2 > n) ip2 = 2
+
+ thetav(i) = sphere_angle( xc(1), yc(1), zc(1), &
+ xc(i+1), yc(i+1), zc(i+1), &
+ xc(ip2), yc(ip2), zc(ip2) )
+
+ dl_sphere(i) = a*arc_length( xc(1), yc(1), zc(1), &
+ 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 ->
+! 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., &
+ xp(i)-xp(i-1), yp(i)-yp(i-1), 0., &
+ xp(ip1)-xp(i), yp(ip1)-yp(i), 0., &
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnEquationOfState.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,478 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_equation_of_state
+!
+!> \brief MPAS ocean equation of state driver
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for calling
+!> the equation of state.
+!
+!-----------------------------------------------------------------------
+
+module ocn_equation_of_state
+
+ use grid_types
+ use configure
+ use timer
+! use ocn_equation_of_stateLinear
+! use ocn_equation_of_stateJM
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_equation_of_state_rho, &
+ ocn_equation_of_state_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: eosON
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_equation_of_state
+!
+!> \brief Calls equation of state
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine calls the equation of state to update the density
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_equation_of_state_rho(s, grid, k_displaced, displacement_type)!{{{
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! 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<=0, state % rho is returned with no displaced
+ ! If k_displaced>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 :: 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
+
+ call timer_start("ocn_equation_of_state_rho")
+
+ if (config_eos_type.eq.'linear') then
+
+ call ocn_equation_of_state_linear_rho(s, grid, k_displaced, displacement_type)
+
+ elseif (config_eos_type.eq.'jm') then
+
+ tracers => s % tracers % array
+ indexT = s % index_temperature
+ indexS = s % index_salinity
+
+ if(k_displaced == 0) then
+ rho => s % rho % array
+ else
+ rho => s % rhoDisplaced % array
+ endif
+
+ call ocn_equation_of_state_jm_rho(grid, k_displaced, displacement_type, indexT, indexS, tracers, rho)
+! call ocn_equation_of_state_rho_jm_bak(s, grid, k_displaced, displacement_type)
+
+ else
+ print *, ' Incorrect choice of config_eos_type:',&
+ config_eos_type
+ call dmpar_abort(dminfo)
+ endif
+
+ call timer_stop("ocn_equation_of_state_rho")
+
+ end subroutine ocn_equation_of_state_rho!}}}
+
+!***********************************************************************
+!
+! routine ocn_equation_of_stateInit
+!
+!> \brief Initializes ocean momentum horizontal mixing quantities
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity mixing in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_equation_of_state_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ integer :: err1, err2
+
+ err = 0
+ ! For an isopycnal model, density should remain constant.
+ ! For zlevel, calculate in-situ density
+ eosON = .false.
+
+ if(config_vert_grid_type.eq.'zlevel') then
+ eosON = .true.
+! call ocn_equation_of_stateLinearInit(err1)
+! call ocn_equation_of_stateJMInit(err2)
+
+ err = err1 .or. err2
+ endif
+
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_equation_of_state_init!}}}
+
+ subroutine ocn_equation_of_state_linear_rho(s, grid, k_displaced, displacement_type)!{{{
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! 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<=0, state % rho is returned with no displaced
+ ! If k_displaced>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 :: 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
+ type (dm_info) :: dminfo
+
+ call timer_start("ocn_equation_of_state_linear")
+
+ rho => s % rho % array
+ tracers => s % tracers % array
+ maxLevelCell => grid % maxLevelCell % array
+ nCells = grid % nCells
+
+ do iCell=1,nCells
+ do k=1,maxLevelCell(iCell)
+ ! Linear equation of state
+ rho(k,iCell) = 1000.0*( 1.0 &
+ - 2.5e-4*tracers(s % index_temperature,k,iCell) &
+ + 7.6e-4*tracers(s % index_salinity,k,iCell))
+ end do
+ end do
+
+ call timer_stop("ocn_equation_of_state_linear")
+
+ end subroutine ocn_equation_of_state_linear_rho!}}}
+
+ subroutine ocn_equation_of_state_jm_rho(grid, k_displaced, displacement_type, indexT, indexS, tracers, rho)!{{{
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! 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<=0, density is returned with no displaced
+ ! If k_displaced>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
+
+ type (dm_info) :: dminfo
+ integer :: iEdge, iCell, iVertex, k
+
+ integer :: nCells, nEdges, nVertices, nVertLevels
+
+
+ real (kind=RKIND), dimension(:), pointer :: &
+ zMidZLevel, pRefEOS
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ rho
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
+
+ integer, dimension(:), pointer :: maxLevelCell
+
+ real (kind=RKIND) :: &
+ TQ,SQ, &! adjusted T,S
+ BULK_MOD, &! Bulk modulus
+ RHO_S, &! density at the surface
+ DRDT0, &! d(density)/d(temperature), for surface
+ DRDS0, &! d(density)/d(salinity ), for surface
+ DKDT, &! d(bulk modulus)/d(pot. temp.)
+ DKDS, &! d(bulk modulus)/d(salinity )
+ SQR,DENOMK, &! work arrays
+ WORK1, WORK2, WORK3, WORK4, T2, depth
+
+ real (kind=RKIND) :: &
+ tmin, tmax, &! valid temperature range for level k
+ smin, smax ! valid salinity range for level k
+
+ real (kind=RKIND), dimension(:), allocatable :: &
+ p, p2 ! temporary pressure scalars
+
+!-----------------------------------------------------------------------
+!
+! UNESCO EOS constants and JMcD bulk modulus constants
+!
+!-----------------------------------------------------------------------
+
+ !*** for density of fresh water (standard UNESCO)
+
+ real (kind=RKIND), parameter :: &
+ unt0 = 999.842594, &
+ unt1 = 6.793952e-2, &
+ unt2 = -9.095290e-3, &
+ unt3 = 1.001685e-4, &
+ unt4 = -1.120083e-6, &
+ unt5 = 6.536332e-9
+
+ !*** for dependence of surface density on salinity (UNESCO)
+
+ real (kind=RKIND), parameter :: &
+ uns1t0 = 0.824493 , &
+ uns1t1 = -4.0899e-3, &
+ uns1t2 = 7.6438e-5, &
+ uns1t3 = -8.2467e-7, &
+ uns1t4 = 5.3875e-9, &
+ unsqt0 = -5.72466e-3, &
+ unsqt1 = 1.0227e-4, &
+ unsqt2 = -1.6546e-6, &
+ uns2t0 = 4.8314e-4
+
+ !*** from Table A1 of Jackett and McDougall
+
+ real (kind=RKIND), parameter :: &
+ bup0s0t0 = 1.965933e+4, &
+ bup0s0t1 = 1.444304e+2, &
+ bup0s0t2 = -1.706103 , &
+ bup0s0t3 = 9.648704e-3, &
+ bup0s0t4 = -4.190253e-5
+
+ real (kind=RKIND), parameter :: &
+ bup0s1t0 = 5.284855e+1, &
+ bup0s1t1 = -3.101089e-1, &
+ bup0s1t2 = 6.283263e-3, &
+ bup0s1t3 = -5.084188e-5
+
+ real (kind=RKIND), parameter :: &
+ bup0sqt0 = 3.886640e-1, &
+ bup0sqt1 = 9.085835e-3, &
+ bup0sqt2 = -4.619924e-4
+
+ real (kind=RKIND), parameter :: &
+ bup1s0t0 = 3.186519 , &
+ bup1s0t1 = 2.212276e-2, &
+ bup1s0t2 = -2.984642e-4, &
+ bup1s0t3 = 1.956415e-6
+
+ real (kind=RKIND), parameter :: &
+ bup1s1t0 = 6.704388e-3, &
+ bup1s1t1 = -1.847318e-4, &
+ bup1s1t2 = 2.059331e-7, &
+ bup1sqt0 = 1.480266e-4
+
+ real (kind=RKIND), parameter :: &
+ bup2s0t0 = 2.102898e-4, &
+ bup2s0t1 = -1.202016e-5, &
+ bup2s0t2 = 1.394680e-7, &
+ bup2s1t0 = -2.040237e-6, &
+ bup2s1t1 = 6.128773e-8, &
+ bup2s1t2 = 6.207323e-10
+
+ integer :: k_test, k_ref
+
+ call timer_start("ocn_equation_of_state_jm")
+
+ nCells = grid % nCells
+ maxLevelCell => grid % maxLevelCell % array
+ nVertLevels = grid % nVertLevels
+ zMidZLevel => 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) &
+ + 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 > nVertLevels is incompatible with 'absolute'
+ ! so abort if necessary
+
+ if (displacement_type == 'absolute' .and. &
+ (k_displaced <= 0 .or. k_displaced > nVertLevels) ) then
+ write(0,*) 'Abort: In ocn_equation_of_state_jm', &
+ ' k_displaced must be between 1 and nVertLevels for ', &
+ '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 + &
+ (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 &
+ + (uns2t0*SQ + WORK1 + WORK2)*SQ
+
+ !***
+ !*** now calculate bulk modulus at pressure p from
+ !*** Jackett and McDougall formula
+ !***
+
+ WORK3 = bup0s1t0 + bup0s1t1*TQ + &
+ (bup0s1t2 + bup0s1t3*TQ)*T2 + &
+ p(k) *(bup1s1t0 + bup1s1t1*TQ + bup1s1t2*T2) + &
+ p2(k)*(bup2s1t0 + bup2s1t1*TQ + bup2s1t2*T2)
+ WORK4 = SQR*(bup0sqt0 + bup0sqt1*TQ + bup0sqt2*T2 + &
+ bup1sqt0*p(k))
+
+ BULK_MOD = bup0s0t0 + bup0s0t1*TQ + &
+ (bup0s0t2 + bup0s0t3*TQ + bup0s0t4*T2)*T2 + &
+ p(k) *(bup1s0t0 + bup1s0t1*TQ + &
+ (bup1s0t2 + bup1s0t3*TQ)*T2) + &
+ p2(k)*(bup2s0t0 + bup2s0t1*TQ + bup2s0t2*T2) + &
+ 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("ocn_equation_of_state_jm")
+
+ end subroutine ocn_equation_of_state_jm_rho!}}}
+
+!***********************************************************************
+
+end module ocn_equation_of_state
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
Copied: branches/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state_jm.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnEquationOfStateJM.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state_jm.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state_jm.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,352 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_equation_of_state_jm
+!
+!> \brief MPAS ocean equation of state driver
+!> \author Doug Jacobsen
+!> \date 28 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for calling
+!> 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, &
+ ocn_equation_of_state_jm_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_equation_of_state_jm_rho
+!
+!> \brief Calls JM equation of state
+!> \author Doug Jacobsen
+!> \date 28 September 2011
+!> \version SVN:$Id$
+!> \details
+!> 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)!{{{
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! 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<=0, density is returned with no displaced
+ ! If k_displaced>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
+
+ type (dm_info) :: dminfo
+ integer :: iEdge, iCell, iVertex, k
+
+ integer :: nCells, nEdges, nVertices, nVertLevels
+
+
+ real (kind=RKIND), dimension(:), pointer :: &
+ zMidZLevel, pRefEOS
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ rho
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
+
+ integer, dimension(:), pointer :: maxLevelCell
+
+ real (kind=RKIND) :: &
+ TQ,SQ, &! adjusted T,S
+ BULK_MOD, &! Bulk modulus
+ RHO_S, &! density at the surface
+ DRDT0, &! d(density)/d(temperature), for surface
+ DRDS0, &! d(density)/d(salinity ), for surface
+ DKDT, &! d(bulk modulus)/d(pot. temp.)
+ DKDS, &! d(bulk modulus)/d(salinity )
+ SQR,DENOMK, &! work arrays
+ WORK1, WORK2, WORK3, WORK4, T2, depth
+
+ real (kind=RKIND) :: &
+ tmin, tmax, &! valid temperature range for level k
+ smin, smax ! valid salinity range for level k
+
+ real (kind=RKIND), dimension(:), allocatable :: &
+ p, p2 ! temporary pressure scalars
+
+!-----------------------------------------------------------------------
+!
+! UNESCO EOS constants and JMcD bulk modulus constants
+!
+!-----------------------------------------------------------------------
+
+ !*** for density of fresh water (standard UNESCO)
+
+ real (kind=RKIND), parameter :: &
+ unt0 = 999.842594, &
+ unt1 = 6.793952e-2, &
+ unt2 = -9.095290e-3, &
+ unt3 = 1.001685e-4, &
+ unt4 = -1.120083e-6, &
+ unt5 = 6.536332e-9
+
+ !*** for dependence of surface density on salinity (UNESCO)
+
+ real (kind=RKIND), parameter :: &
+ uns1t0 = 0.824493 , &
+ uns1t1 = -4.0899e-3, &
+ uns1t2 = 7.6438e-5, &
+ uns1t3 = -8.2467e-7, &
+ uns1t4 = 5.3875e-9, &
+ unsqt0 = -5.72466e-3, &
+ unsqt1 = 1.0227e-4, &
+ unsqt2 = -1.6546e-6, &
+ uns2t0 = 4.8314e-4
+
+ !*** from Table A1 of Jackett and McDougall
+
+ real (kind=RKIND), parameter :: &
+ bup0s0t0 = 1.965933e+4, &
+ bup0s0t1 = 1.444304e+2, &
+ bup0s0t2 = -1.706103 , &
+ bup0s0t3 = 9.648704e-3, &
+ bup0s0t4 = -4.190253e-5
+
+ real (kind=RKIND), parameter :: &
+ bup0s1t0 = 5.284855e+1, &
+ bup0s1t1 = -3.101089e-1, &
+ bup0s1t2 = 6.283263e-3, &
+ bup0s1t3 = -5.084188e-5
+
+ real (kind=RKIND), parameter :: &
+ bup0sqt0 = 3.886640e-1, &
+ bup0sqt1 = 9.085835e-3, &
+ bup0sqt2 = -4.619924e-4
+
+ real (kind=RKIND), parameter :: &
+ bup1s0t0 = 3.186519 , &
+ bup1s0t1 = 2.212276e-2, &
+ bup1s0t2 = -2.984642e-4, &
+ bup1s0t3 = 1.956415e-6
+
+ real (kind=RKIND), parameter :: &
+ bup1s1t0 = 6.704388e-3, &
+ bup1s1t1 = -1.847318e-4, &
+ bup1s1t2 = 2.059331e-7, &
+ bup1sqt0 = 1.480266e-4
+
+ real (kind=RKIND), parameter :: &
+ bup2s0t0 = 2.102898e-4, &
+ bup2s0t1 = -1.202016e-5, &
+ bup2s0t2 = 1.394680e-7, &
+ bup2s1t0 = -2.040237e-6, &
+ bup2s1t1 = 6.128773e-8, &
+ bup2s1t2 = 6.207323e-10
+
+ integer :: k_test, k_ref
+
+ call timer_start("equation_of_state_jm")
+
+ nCells = grid % nCells
+ maxLevelCell => grid % maxLevelCell % array
+ nVertLevels = grid % nVertLevels
+ zMidZLevel => 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) &
+ + 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 > nVertLevels is incompatible with 'absolute'
+ ! so abort if necessary
+
+ if (displacement_type == 'absolute' .and. &
+ (k_displaced <= 0 .or. k_displaced > nVertLevels) ) then
+ write(0,*) 'Abort: In equation_of_state_jm', &
+ ' k_displaced must be between 1 and nVertLevels for ', &
+ '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 + &
+ (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 &
+ + (uns2t0*SQ + WORK1 + WORK2)*SQ
+
+ !***
+ !*** now calculate bulk modulus at pressure p from
+ !*** Jackett and McDougall formula
+ !***
+
+ WORK3 = bup0s1t0 + bup0s1t1*TQ + &
+ (bup0s1t2 + bup0s1t3*TQ)*T2 + &
+ p(k) *(bup1s1t0 + bup1s1t1*TQ + bup1s1t2*T2) + &
+ p2(k)*(bup2s1t0 + bup2s1t1*TQ + bup2s1t2*T2)
+ WORK4 = SQR*(bup0sqt0 + bup0sqt1*TQ + bup0sqt2*T2 + &
+ bup1sqt0*p(k))
+
+ BULK_MOD = bup0s0t0 + bup0s0t1*TQ + &
+ (bup0s0t2 + bup0s0t3*TQ + bup0s0t4*T2)*T2 + &
+ p(k) *(bup1s0t0 + bup1s0t1*TQ + &
+ (bup1s0t2 + bup1s0t3*TQ)*T2) + &
+ p2(k)*(bup2s0t0 + bup2s0t1*TQ + bup2s0t2*T2) + &
+ 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("equation_of_state_jm")
+
+ end subroutine ocn_equation_of_state_jm_rho!}}}
+
+!***********************************************************************
+!
+! routine ocn_equation_of_state_jm_init
+!
+!> \brief Initializes ocean momentum horizontal mixing quantities
+!> \author Doug Jacobsen
+!> \date 28 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity mixing in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> 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/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state_linear.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnEquationOfStateLinear.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state_linear.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_equation_of_state_linear.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,152 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_equation_of_state_linear
+!
+!> \brief MPAS ocean equation of state driver
+!> \author Doug Jacobsen
+!> \date 28 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for calling
+!> 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, &
+ ocn_equation_of_state_linear_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_equation_of_state_linear_rho
+!
+!> \brief Calls equation of state
+!> \author Doug Jacobsen
+!> \date 28 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine uses a linear equation of state to update the density
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_equation_of_state_linear_rho(s, grid, k_displaced, displacement_type)!{{{
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! 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<=0, state % rho is returned with no displaced
+ ! If k_displaced>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 :: 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
+ type (dm_info) :: dminfo
+
+ call timer_start("equation_of_state_linear")
+
+ rho => s % rho % array
+ tracers => s % tracers % array
+ maxLevelCell => grid % maxLevelCell % array
+ nCells = grid % nCells
+
+ do iCell=1,nCells
+ do k=1,maxLevelCell(iCell)
+ ! Linear equation of state
+ rho(k,iCell) = 1000.0*( 1.0 &
+ - 2.5e-4*tracers(s % index_temperature,k,iCell) &
+ + 7.6e-4*tracers(s % index_salinity,k,iCell))
+ end do
+ end do
+
+ call timer_stop("equation_of_state_linear")
+
+ end subroutine ocn_equation_of_state_linear_rho!}}}
+
+!***********************************************************************
+!
+! routine ocn_equation_of_state_linear_init
+!
+!> \brief Initializes ocean momentum horizontal mixing quantities
+!> \author Doug Jacobsen
+!> \date 28 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity mixing in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> 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/ocean_projects/performance/src/core_ocean/mpas_ocn_global_diagnostics.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_global_diagnostics.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_global_diagnostics.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_global_diagnostics.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,618 @@
+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, &
+ 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 => grid % areaCell % array
+ dcEdge => grid % dcEdge % array
+ dvEdge => grid % dvEdge % array
+ areaTriangle => grid % areaTriangle % array
+ allocate(areaEdge(1:nEdgesSolve))
+ areaEdge = dcEdge(1:nEdgesSolve)*dvEdge(1:nEdgesSolve)
+
+ h => state % h % array
+ u => state % u % array
+ rho => state % rho % array
+ tracers => state % tracers % array
+ v => state % v % array
+ wTop => state % wTop % array
+ h_edge => state % h_edge % array
+ circulation => state % circulation % array
+ vorticity => state % vorticity % array
+ ke => state % ke % array
+ pv_edge => state % pv_edge % array
+ pv_vertex => state % pv_vertex % array
+ pv_cell => state % pv_cell % array
+ gradPVn => state % gradPVn % array
+ gradPVt => state % gradPVt % array
+ MontPot => state % MontPot % array
+ pressure => state % pressure % array
+
+ variableIndex = 0
+ ! h
+ variableIndex = variableIndex + 1
+ call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
+ 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), &
+ u(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
+ verticalSumMaxes(variableIndex))
+
+ ! v
+ variableIndex = variableIndex + 1
+ call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
+ v(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
+ verticalSumMaxes(variableIndex))
+
+ ! h_edge
+ variableIndex = variableIndex + 1
+ call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
+ sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
+
+ ! circulation
+ variableIndex = variableIndex + 1
+ call computeFieldLocalStats(dminfo, nVertLevels, nVerticesSolve, circulation(:,1:nVerticesSolve), &
+ sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
+
+ ! vorticity
+ variableIndex = variableIndex + 1
+ call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nVerticesSolve, areaTriangle(1:nVerticesSolve), &
+ vorticity(:,1:nVerticesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), &
+ verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
+
+ ! ke
+ variableIndex = variableIndex + 1
+ call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
+ ke(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
+ verticalSumMaxes(variableIndex))
+
+ ! pv_edge
+ variableIndex = variableIndex + 1
+ call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
+ pv_edge(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
+ verticalSumMaxes(variableIndex))
+
+ ! pv_vertex
+ variableIndex = variableIndex + 1
+ call computeFieldAreaWeightedLocalStats(dminfo, nVertLevels, nVerticesSolve, areaTriangle(1:nVerticesSolve), &
+ pv_vertex(:,1:nVerticesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), &
+ verticalSumMins(variableIndex), verticalSumMaxes(variableIndex))
+
+ ! pv_cell
+ variableIndex = variableIndex + 1
+ call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
+ pv_cell(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
+ verticalSumMaxes(variableIndex))
+
+ ! gradPVn
+ variableIndex = variableIndex + 1
+ call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
+ gradPVn(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
+ verticalSumMaxes(variableIndex))
+
+ ! gradPVt
+ variableIndex = variableIndex + 1
+ call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nEdgesSolve, areaEdge(1:nEdgesSolve), h_edge(:,1:nEdgesSolve), &
+ gradPVt(:,1:nEdgesSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
+ verticalSumMaxes(variableIndex))
+
+ ! pressure
+ variableIndex = variableIndex + 1
+ call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
+ pressure(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
+ verticalSumMaxes(variableIndex))
+
+ ! MontPot
+ variableIndex = variableIndex + 1
+ call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
+ MontPot(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
+ verticalSumMaxes(variableIndex))
+
+ ! wTop vertical velocity
+ variableIndex = variableIndex + 1
+ call computeFieldVolumeWeightedLocalStats(dminfo, nVertLevels+1, nCellsSolve, areaCell(1:nCellsSolve), h(:,1:nCellsSolve), &
+ wTop(:,1:nCellsSolve), sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
+ 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), &
+ tracerTemp, sums(variableIndex), mins(variableIndex), maxes(variableIndex), verticalSumMins(variableIndex), &
+ 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, &
+ state % xtime % scalar, dt, &
+ 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, &
+ 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, &
+ 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, &
+ 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, &
+ 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, &
+ 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, &
+ 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, &
+ 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, &
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_mpas_core.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_mpas_core.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_mpas_core.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_mpas_core.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,774 @@
+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
+
+ 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:',&
+ config_vert_grid_type
+ call dmpar_abort(dminfo)
+ endif
+
+ if (trim(config_new_btr_variables_from) == 'btr_avg' &
+ .and.trim(config_time_integration) == 'unsplit_explicit') then
+ print *, ' unsplit_explicit option must use',&
+ ' config_new_btr_variables_from==last_subcycle'
+ call dmpar_abort(dminfo)
+ endif
+
+
+ !
+ ! Initialize core
+ !
+ dt = config_dt
+
+ call simulation_clock_init(domain, dt, startTimeStamp)
+
+ block => domain % blocklist
+ do while (associated(block))
+ call mpas_init_block(block, block % mesh, dt)
+ block % state % time_levs(1) % state % xtime % scalar = startTimeStamp
+ block => block % next
+
+ !dwj 110919 This allows the restorings to grab the indices for
+ ! temperature and salinity tracers from state.
+ end do
+
+ call ocn_timestep_init(err)
+
+ call ocn_vel_pressure_grad_init(err)
+ call ocn_vel_vadv_init(err)
+ call ocn_vel_hmix_init(err)
+ call ocn_vel_forcing_init(err)
+
+ call ocn_tracer_hadv_init(err)
+ call ocn_tracer_vadv_init(err)
+ call ocn_tracer_hmix_init(err)
+ call ocn_restoring_init(err)
+
+ call ocn_vmix_init(err)
+
+ call ocn_equation_of_state_init(err)
+
+ ! 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("global diagnostics")
+ ! call computeGlobalDiagnostics(domain % dminfo, block % state % time_levs(1) % state, mesh, 0, dt)
+ ! call timer_stop("global diagnostics")
+ ! call output_state_init(output_obj, domain, "OUTPUT")
+ ! 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) /= "none") 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) /= "none") 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) /= "none") 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) /= "none") 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) /= "none") 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(block % state % time_levs(1) % state, mesh)
+
+ ! 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( &
+ block % mesh % maxLevelEdgeTop % array(iEdge)+1 &
+ :block % mesh % maxLevelEdgeBot % array(iEdge), iEdge) = 0.0
+
+ block % state % time_levs(1) % state % u % array( &
+ block % mesh % maxLevelEdgeBot % array(iEdge)+1: &
+ 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( &
+ :, block % mesh % maxLevelCell % array(iCell)+1 &
+ :block % mesh % nVertLevels,iCell) = 0.0
+! mrp changed to 0
+! :block % mesh % nVertLevels,iCell) = -1e34
+
+! mrp 110516 temp, 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, &
+ 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, &
+ 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("time integration")
+ call mpas_timestep(domain, itimestep, dt, timeStamp)
+ call timer_stop("time integration")
+
+ ! 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, "OUTPUT", trim(timeStamp)) ! output_frame will always be > 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, "RESTART")
+ 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 => domain % blocklist
+ do while (associated(block_ptr))
+ call compute_output_diagnostics(block_ptr % state % time_levs(1) % state, block_ptr % mesh)
+ block_ptr => 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 > 0) then
+ current_outfile_frames = current_outfile_frames + 1
+ if(current_outfile_frames >= 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 > 0) then
+ if (mod(itimestep, config_stats_interval) == 0) then
+ block_ptr => domain % blocklist
+ if (associated(block_ptr % next)) then
+ write(0,*) 'Error: computeGlobalDiagnostics assumes ',&
+ 'that there is only one block per processor.'
+ end if
+
+ call timer_start("global diagnostics")
+ call computeGlobalDiagnostics(domain % dminfo, &
+ block_ptr % state % time_levs(2) % state, block_ptr % mesh, &
+ itimestep, dt)
+ call timer_stop("global diagnostics")
+ 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 => domain % blocklist
+ ! if (associated(block_ptr % next)) then
+ ! write(0,*) 'Error: computeGlobalDiagnostics assumes ',&
+ ! 'that there is only one block per processor.'
+ ! end if
+
+ ! call timer_start("global diagnostics")
+ ! call computeGlobalDiagnostics(domain % dminfo, &
+ ! block_ptr % state % time_levs(2) % state, block_ptr % mesh, &
+ ! timeStamp, dt)
+ ! call timer_stop("global diagnostics")
+ !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 :: &
+ hZLevel, zMidZLevel, zTopZLevel, &
+ hMeanTopZLevel, hRatioZLevelK, hRatioZLevelKm1
+ real (kind=RKIND), dimension(:,:), pointer :: h
+ integer :: nVertLevels
+
+ ! Initialize z-level grid variables from h, read in from input file.
+ block => domain % blocklist
+ do while (associated(block))
+
+ h => block % state % time_levs(1) % state % h % array
+ hZLevel => block % mesh % hZLevel % array
+ zMidZLevel => block % mesh % zMidZLevel % array
+ zTopZLevel => block % mesh % zTopZLevel % array
+ nVertLevels = block % mesh % nVertLevels
+ hMeanTopZLevel => block % mesh % hMeanTopZLevel % array
+ hRatioZLevelK => block % mesh % hRatioZLevelK % array
+ hRatioZLevelKm1 => block % mesh % hRatioZLevelKm1 % array
+
+ ! 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) &
+ = block % state % time_levs(1) % state % h % array(1,iCell) &
+ - block % mesh % hZLevel % array(1)
+ enddo
+
+ ! Compute barotropic velocity at first timestep
+ ! This is only done upon start-up.
+ if (trim(config_time_integration) == 'unsplit_explicit') then
+ block % state % time_levs(1) % state % uBtr % array(:) = 0.0
+
+ block % state % time_levs(1) % state % uBcl % array(:,:) &
+ = 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) &
+ = 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*( &
+ block % state % time_levs(1) % state % ssh % array(cell1) &
+ + block % state % time_levs(1) % state % ssh % array(cell2) )
+
+ ! uBtr = sum(u)/sum(h) on each column
+ uhSum = (sshEdge + block % mesh % hZLevel % array(1)) &
+ * block % state % time_levs(1) % state % u % array(1,iEdge)
+ hSum = sshEdge + block % mesh % hZLevel % array(1)
+
+ do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
+ uhSum = uhSum &
+ + block % mesh % hZLevel % array(k) &
+ *block % state % time_levs(1) % state % u % array(k,iEdge)
+ hSum = hSum &
+ + 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) &
+ = block % state % time_levs(1) % state % u % array(k,iEdge) &
+ - 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(:,:) &
+ = 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)), &
+! maxval(domain % blocklist % state % time_levs(1) % state % u % array(:,1:domain % blocklist % mesh % nEdgesSolve))
+!print *, '11 uBtr ',minval(domain % blocklist % state % time_levs(1) % state % uBtr % array(1:domain % blocklist % mesh % nEdgesSolve)), &
+! maxval(domain % blocklist % state % time_levs(1) % state % uBtr % array(1:domain % blocklist % mesh % nEdgesSolve))
+!print *, '11 uBcl ',minval(domain % blocklist % state % time_levs(1) % state % uBcl % array(:,1:domain % blocklist % mesh % nEdgesSolve)), &
+! maxval(domain % blocklist % state % time_levs(1) % state % uBcl % array(:,1:domain % blocklist % mesh % nEdgesSolve))
+
+
+! mrp temp testing - is uBcl vert sum zero?
+! do iEdge=1,block % mesh % nEdges
+! uhSum = (sshEdge + block % mesh % hZLevel % array(1)) * block % state % time_levs(1) % state % uBcl % array(1,iEdge)
+! hSum = sshEdge + block % mesh % hZLevel % array(1)
+
+! do k=2,block % mesh % maxLevelEdgeTop % array(iEdge)
+! uhSum = uhSum + block % mesh % hZLevel % array(k) * block % state % time_levs(1) % state % uBcl % array(k,iEdge)
+! hSum = hSum + block % mesh % hZLevel % array(k)
+! enddo
+! block % state % time_levs(1) % state % FBtr % array(iEdge) = uhSum/hSum
+
+! enddo ! iEdge
+
+!print *, 'uBcl vert sum IC',minval(block % state % time_levs(1) % state % FBtr % array(1:block % mesh % nEdgesSolve)), &
+! maxval(block % state % time_levs(1) % state % FBtr % array(1:block % mesh % nEdgesSolve))
+
+! mrp temp testing - is uBcl vert sum zero? end
+
+ block => block % next
+
+ end do
+
+end 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 :: &
+ maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &
+ maxLevelVertexTop, maxLevelVertexBot
+ integer, dimension(:,:), pointer :: &
+ cellsOnEdge, cellsOnVertex, boundaryEdge, boundaryCell, &
+ boundaryVertex, verticesOnEdge
+
+ ! Initialize z-level grid variables from h, read in from input file.
+ block => domain % blocklist
+ do while (associated(block))
+
+ maxLevelCell => block % mesh % maxLevelCell % array
+ maxLevelEdgeTop => block % mesh % maxLevelEdgeTop % array
+ maxLevelEdgeBot => block % mesh % maxLevelEdgeBot % array
+ maxLevelVertexTop => block % mesh % maxLevelVertexTop % array
+ maxLevelVertexBot => block % mesh % maxLevelVertexBot % array
+ cellsOnEdge => block % mesh % cellsOnEdge % array
+ cellsOnVertex => block % mesh % cellsOnVertex % array
+ verticesOnEdge => block % mesh % verticesOnEdge % array
+ boundaryEdge => block % mesh % boundaryEdge % array
+ boundaryCell => block % mesh % boundaryCell % array
+ boundaryVertex => 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) = &
+ min( maxLevelCell(cellsOnEdge(1,iEdge)), &
+ 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) = &
+ max( maxLevelCell(cellsOnEdge(1,iEdge)), &
+ 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) = &
+ max( maxLevelVertexBot(iVertex), &
+ 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) = &
+ min( maxLevelVertexTop(iVertex), &
+ 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 => 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 > 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 => mesh % meshDensity % array
+ meshScalingDel2 => mesh % meshScalingDel2 % array
+ meshScalingDel4 => 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/ocean_projects/performance/src/core_ocean/mpas_ocn_restoring.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnRestoring.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_restoring.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_restoring.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,200 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_restoring
+!
+!> \brief MPAS ocean restoring
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> tendencies for restoring.
+!
+!-----------------------------------------------------------------------
+
+module ocn_restoring
+
+ use grid_types
+ use configure
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_restoring_tend, &
+ ocn_restoring_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: restoringOn
+
+ real (kind=RKIND) :: temperatureTimeScale, salinityTimeScale
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_restoring_tend
+!
+!> \brief Computes tendency term for restoring
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the restoring tendency for tracers
+!> based on current state.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_restoring_tend(grid, h, indexT, indexS, tracers, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h !< Input: thickness
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracer quantities
+
+ integer, intent(in) :: indexT, indexS
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell, nCellsSolve, k
+
+ real (kind=RKIND), dimension(:), pointer :: temperatureRestore, salinityRestore
+
+ !-----------------------------------------------------------------
+ !
+ ! 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.restoringOn) return
+
+ nCellsSolve = grid % nCellsSolve
+
+ temperatureRestore => grid % temperatureRestore % array
+ salinityRestore => grid % salinityRestore % array
+
+ k = 1 ! restoring only in top layer
+ do iCell=1,nCellsSolve
+
+ tend(indexT, k, iCell) = tend(indexT, k, iCell) &
+ - h(k,iCell)*(tracers(indexT, k, iCell) - temperatureRestore(iCell)) &
+ / (temperatureTimeScale * 86400.0)
+
+ tend(indexS, k, iCell) = tend(indexS, k, iCell) &
+ - h(k,iCell)*(tracers(indexS, k, iCell) - salinityRestore(iCell)) &
+ / (salinityTimeScale * 86400.0)
+
+! write(6,10) iCell, tracers(indexT, k, iCell), &
+! temperatureRestore(iCell), tracers(indexT, k, iCell), &
+! (tracers(indexT, k, iCell) - temperatureRestore(iCell)) &
+! / (config_restoreT_timescale * 86400.0)
+
+ enddo
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_restoring_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_restoring_init
+!
+!> \brief Initializes ocean tracer horizontal mixing quantities
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity mixing in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+
+ subroutine ocn_restoring_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tendency.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTendency.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tendency.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tendency.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,1317 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tendency
+!
+!> \brief MPAS ocean tendency driver
+!> \author Doug Jacobsen
+!> \date 23 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the routines for computing
+!> various tendencies for the ocean. As well as routines
+!> for computing diagnostic variables, and other quantities
+!> 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, &
+ ocn_tend_u, &
+ ocn_tend_scalar, &
+ ocn_diagnostic_solve, &
+ ocn_wtop, &
+ ocn_fuperp
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tend_h
+!
+!> \brief Computes thickness tendency
+!> \author Doug Jacobsen
+!> \date 23 September 2011
+!> \version SVN:$Id$
+!> \details
+!> 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, &
+ 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, &
+ upstream_bias, wTopEdge, rho0Inv, r
+ real (kind=RKIND), dimension(:), pointer :: &
+ h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
+ zMidZLevel, zTopZLevel
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
+ tend_h, circulation, vorticity, ke, ke_edge, pv_edge, &
+ MontPot, wTop, divergence, vertViscTopOfEdge
+ type (dm_info) :: dminfo
+
+ integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
+ maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+ integer, dimension(:,:), pointer :: &
+ cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
+ edgesOnEdge, edgesOnVertex
+ real (kind=RKIND) :: u_diffusion
+ real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+ 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("ocn_tend_h")
+
+ h => s % h % array
+ u => s % u % array
+ v => s % v % array
+ wTop => s % wTop % array
+ h_edge => s % h_edge % array
+ circulation => s % circulation % array
+ vorticity => s % vorticity % array
+ divergence => s % divergence % array
+ ke => s % ke % array
+ ke_edge => s % ke_edge % array
+ pv_edge => s % pv_edge % array
+ MontPot => s % MontPot % array
+ pressure => s % pressure % array
+ vertViscTopOfEdge => d % vertViscTopOfEdge % array
+
+ weightsOnEdge => grid % weightsOnEdge % array
+ kiteAreasOnVertex => grid % kiteAreasOnVertex % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ cellsOnVertex => grid % cellsOnVertex % array
+ verticesOnEdge => grid % verticesOnEdge % array
+ nEdgesOnCell => grid % nEdgesOnCell % array
+ edgesOnCell => grid % edgesOnCell % array
+ nEdgesOnEdge => grid % nEdgesOnEdge % array
+ edgesOnEdge => grid % edgesOnEdge % array
+ edgesOnVertex => grid % edgesOnVertex % array
+ dcEdge => grid % dcEdge % array
+ dvEdge => grid % dvEdge % array
+ areaCell => grid % areaCell % array
+ areaTriangle => grid % areaTriangle % array
+ h_s => grid % h_s % array
+ fVertex => grid % fVertex % array
+ fEdge => grid % fEdge % array
+ zMidZLevel => grid % zMidZLevel % array
+ zTopZLevel => grid % zTopZLevel % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelVertexBot => grid % maxLevelVertexBot % array
+
+ tend_h => 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 timer_start("ocn_tend_h-horiz adv")
+
+ call ocn_thick_hadv_tend(grid, u, h_edge, tend_h, err)
+
+ call timer_stop("ocn_tend_h-horiz adv")
+
+ !
+ ! height tendency: vertical advection term -d/dz(hw)
+ !
+ ! Vertical advection computed for top layer of a z grid only.
+ call timer_start("ocn_tend_h-vert adv")
+
+ call ocn_thick_vadv_tend(grid, wtop, tend_h, err)
+
+ call timer_stop("ocn_tend_h-vert adv")
+ call timer_stop("ocn_tend_h")
+
+ end subroutine ocn_tend_h!}}}
+
+!***********************************************************************
+!
+! routine ocn_tend_u
+!
+!> \brief Computes velocity tendency
+!> \author Doug Jacobsen
+!> \date 23 September 2011
+!> \version SVN:$Id$
+!> \details
+!> 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, &
+ vertex1, vertex2, eoe, i, j
+
+ integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve, err
+ real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, &
+ upstream_bias, wTopEdge, rho0Inv, r, visc_vorticity_coef
+ real (kind=RKIND), dimension(:), pointer :: &
+ h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
+ zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
+ tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
+ MontPot, wTop, divergence, vertViscTopOfEdge
+ type (dm_info) :: dminfo
+
+ integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
+ maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+ integer, dimension(:,:), pointer :: &
+ cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
+ edgesOnEdge, edgesOnVertex
+ real (kind=RKIND) :: u_diffusion
+ real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+ 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("ocn_tend_u")
+
+ h => s % h % array
+ u => s % u % array
+ v => s % v % array
+ wTop => s % wTop % array
+ h_edge => s % h_edge % array
+ circulation => s % circulation % array
+ vorticity => s % vorticity % array
+ divergence => s % divergence % array
+ ke => s % ke % array
+ ke_edge => s % ke_edge % array
+ pv_edge => s % pv_edge % array
+ MontPot => s % MontPot % array
+ pressure => s % pressure % array
+ vertViscTopOfEdge => d % vertViscTopOfEdge % array
+
+ weightsOnEdge => grid % weightsOnEdge % array
+ kiteAreasOnVertex => grid % kiteAreasOnVertex % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ cellsOnVertex => grid % cellsOnVertex % array
+ verticesOnEdge => grid % verticesOnEdge % array
+ nEdgesOnCell => grid % nEdgesOnCell % array
+ edgesOnCell => grid % edgesOnCell % array
+ nEdgesOnEdge => grid % nEdgesOnEdge % array
+ edgesOnEdge => grid % edgesOnEdge % array
+ edgesOnVertex => grid % edgesOnVertex % array
+ dcEdge => grid % dcEdge % array
+ dvEdge => grid % dvEdge % array
+ areaCell => grid % areaCell % array
+ areaTriangle => grid % areaTriangle % array
+ h_s => grid % h_s % array
+! mrp 110516 cleanup fvertex fedge not used in this subroutine
+ fVertex => grid % fVertex % array
+ fEdge => grid % fEdge % array
+ zMidZLevel => grid % zMidZLevel % array
+ zTopZLevel => grid % zTopZLevel % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelVertexBot => grid % maxLevelVertexBot % array
+
+ tend_u => tend % u % array
+
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nEdgesSolve = grid % nEdgesSolve
+ nVertices = grid % nVertices
+ nVertLevels = grid % nVertLevels
+
+ u_src => grid % u_src % array
+
+ meshScalingDel2 => grid % meshScalingDel2 % array
+ meshScalingDel4 => 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("ocn_tend_u-coriolis")
+
+ call ocn_vel_coriolis_tend(grid, pv_edge, h_edge, u, ke, tend_u, err)
+
+ call timer_stop("ocn_tend_u-coriolis")
+
+ !
+ ! velocity tendency: vertical advection term -w du/dz
+ !
+ call timer_start("ocn_tend_u-vert adv")
+
+ call ocn_vel_vadv_tend(grid, u, wtop, tend_u, err)
+
+ call timer_stop("ocn_tend_u-vert adv")
+
+ !
+ ! velocity tendency: pressure gradient
+ !
+ call timer_start("ocn_tend_u-pressure grad")
+
+ 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("ocn_tend_u-pressure grad")
+
+ !
+ ! 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 timer_start("ocn_tend_u-horiz mix")
+
+ call ocn_vel_hmix_tend(grid, divergence, vorticity, tend_u, err)
+
+ call timer_stop("ocn_tend_u-horiz mix")
+
+ !
+ ! 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("ocn_tend_u-forcings")
+
+ call ocn_vel_forcing_tend(grid, u, u_src, ke_edge, h_edge, tend_u, err)
+
+ call timer_stop("ocn_tend_u-forcings")
+
+ !
+ ! velocity tendency: vertical mixing d/dz( nu_v du/dz))
+ !
+ if (.not.config_implicit_vertical_mix) then
+ call timer_start("ocn_tend_u-explicit vert mix")
+
+ call ocn_vel_vmix_tend_explicit(grid, u, h_edge, vertvisctopofedge, tend_u, err)
+
+ call timer_stop("ocn_tend_u-explicit vert mix")
+ endif
+ call timer_stop("ocn_tend_u")
+
+ end subroutine ocn_tend_u!}}}
+
+!***********************************************************************
+!
+! routine ocn_tendSalar
+!
+!> \brief Computes scalar tendency
+!> \author Doug Jacobsen
+!> \date 23 September 2011
+!> \version SVN:$Id$
+!> \details
+!> 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,&
+ 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 :: &
+ h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ u,h,wTop, h_edge, vertDiffTopOfCell
+ real (kind=RKIND), dimension(:,:,:), pointer :: &
+ tracers, tend_tr
+ integer, dimension(:,:), pointer :: boundaryEdge
+ type (dm_info) :: dminfo
+
+ integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
+ maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+ integer, dimension(:,:), pointer :: cellsOnEdge, boundaryCell
+ real (kind=RKIND), dimension(:), pointer :: zTopZLevel,zMidZLevel, &
+ hRatioZLevelK, hRatioZLevelKm1, meshScalingDel2, meshScalingDel4
+ real (kind=RKIND), dimension(:), allocatable:: tracer2ndDer, tracersIn, tracersOut, posZMidZLevel, &
+ 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("ocn_tend_scalar")
+
+ u => s % u % array
+ h => s % h % array
+ boundaryCell=> grid % boundaryCell % array
+ wTop => s % wTop % array
+ tracers => s % tracers % array
+ h_edge => s % h_edge % array
+ vertDiffTopOfCell => d % vertDiffTopOfCell % array
+
+ tend_tr => tend % tracers % array
+
+ areaCell => grid % areaCell % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ dvEdge => grid % dvEdge % array
+ dcEdge => grid % dcEdge % array
+ zTopZLevel => grid % zTopZLevel % array
+ zMidZLevel => grid % zMidZLevel % array
+ hRatioZLevelK => grid % hRatioZLevelK % array
+ hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
+ boundaryEdge => grid % boundaryEdge % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelVertexBot => grid % maxLevelVertexBot % array
+
+ nEdges = grid % nEdges
+ nCells = grid % nCells
+ nCellsSolve = grid % nCellsSolve
+ nVertLevels = grid % nVertLevels
+ num_tracers = s % num_tracers
+
+ meshScalingDel2 => grid % meshScalingDel2 % array
+ meshScalingDel4 => grid % meshScalingDel4 % array
+
+
+ deriv_two => 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("ocn_tend_scalar-horiz adv")
+
+ call ocn_tracer_hadv_tend(grid, u, h_edge, tracers, tend_tr, err)
+
+ call timer_stop("ocn_tend_scalar-horiz adv")
+
+
+ !
+ ! tracer tendency: vertical advection term -d/dz( h \phi w)
+ !
+
+ call timer_start("ocn_tend_scalar-vert adv")
+
+ call ocn_tracer_vadv_tend(grid, wtop, tracers, tend_tr, err)
+
+ call timer_stop("ocn_tend_scalar-vert adv")
+
+ !
+ ! tracer tendency: del2 horizontal tracer diffusion, div(h \kappa_2 </font>
<font color="gray">abla \phi)
+ !
+ call timer_start("ocn_tend_scalar-horiz diff")
+
+ call ocn_tracer_hmix_tend(grid, h_edge, tracers, tend_tr, err)
+
+ call timer_stop("ocn_tend_scalar-horiz diff")
+
+! mrp 110516 printing
+!print *, 'tend_tr 1',minval(tend_tr(3,1,1:nCells)),&
+! maxval(tend_tr(3,1,1:nCells))
+!print *, 'tracer 1',minval(tracers(3,1,1:nCells)),&
+! 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("ocn_tend_scalar-explicit vert diff")
+
+ call ocn_tracer_vmix_tend_explicit(grid, h, vertdifftopofcell, tracers, tend_tr, err)
+
+ call timer_stop("ocn_tend_scalar-explicit vert diff")
+ endif
+
+! mrp 110516 printing
+!print *, 'tend_tr 2',minval(tend_tr(3,1,1:nCells)),&
+! maxval(tend_tr(3,1,1:nCells))
+! mrp 110516 printing end
+
+ !
+ ! add restoring to T and S in top model layer
+ !
+ call timer_start("ocn_tend_scalar-restoring")
+
+ call ocn_restoring_tend(grid, h, s%index_temperature, s%index_salinity, tracers, tend_tr, err)
+
+ call timer_stop("ocn_tend_scalar-restoring")
+
+ 10 format(2i8,10e20.10)
+ call timer_stop("ocn_tend_scalar")
+
+ end subroutine ocn_tend_scalar!}}}
+
+!***********************************************************************
+!
+! routine ocn_diagnostic_solve
+!
+!> \brief Computes diagnostic variables
+!> \author Doug Jacobsen
+!> \date 23 September 2011
+!> \version SVN:$Id$
+!> \details
+!> 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
+
+
+ real (kind=RKIND), dimension(:), pointer :: &
+ h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
+ hZLevel
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, w, pressure,&
+ circulation, vorticity, ke, ke_edge, MontPot, wTop, &
+ pv_edge, pv_vertex, pv_cell, gradPVn, gradPVt, divergence, &
+ 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, &
+ verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex, &
+ boundaryEdge, boundaryCell
+ integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
+ maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &
+ 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("ocn_diagnostic_solve")
+
+ h => s % h % array
+ u => s % u % array
+ v => s % v % array
+ wTop => s % wTop % array
+ h_edge => s % h_edge % array
+ circulation => s % circulation % array
+ vorticity => s % vorticity % array
+ divergence => s % divergence % array
+ ke => s % ke % array
+ ke_edge => s % ke_edge % array
+ pv_edge => s % pv_edge % array
+ pv_vertex => s % pv_vertex % array
+ pv_cell => s % pv_cell % array
+ gradPVn => s % gradPVn % array
+ gradPVt => s % gradPVt % array
+ rho => s % rho % array
+ tracers => s % tracers % array
+ MontPot => s % MontPot % array
+ pressure => s % pressure % array
+
+ weightsOnEdge => grid % weightsOnEdge % array
+ kiteAreasOnVertex => grid % kiteAreasOnVertex % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ cellsOnVertex => grid % cellsOnVertex % array
+ verticesOnEdge => grid % verticesOnEdge % array
+ nEdgesOnCell => grid % nEdgesOnCell % array
+ edgesOnCell => grid % edgesOnCell % array
+ nEdgesOnEdge => grid % nEdgesOnEdge % array
+ edgesOnEdge => grid % edgesOnEdge % array
+ edgesOnVertex => grid % edgesOnVertex % array
+ dcEdge => grid % dcEdge % array
+ dvEdge => grid % dvEdge % array
+ areaCell => grid % areaCell % array
+ areaTriangle => grid % areaTriangle % array
+ h_s => grid % h_s % array
+ fVertex => grid % fVertex % array
+ fEdge => grid % fEdge % array
+ hZLevel => grid % hZLevel % array
+ deriv_two => grid % deriv_two % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelEdgeBot => grid % maxLevelEdgeBot % array
+ maxLevelVertexBot => grid % maxLevelVertexBot % array
+ maxLevelVertexTop => grid % maxLevelVertexTop % array
+
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nVertices = grid % nVertices
+ nVertLevels = grid % nVertLevels
+ vertexDegree = grid % vertexDegree
+
+ boundaryEdge => grid % boundaryEdge % array
+ boundaryCell => 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("ocn_diagnostic_solve-hEdge")
+
+ 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("ocn_diagnostic_solve-hEdge 2")
+
+ 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("ocn_diagnostic_solve-hEdge 2")
+
+ else if (config_thickness_adv_order == 3) then
+ call timer_start("ocn_diagnostic_solve-hEdge 3")
+
+ 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 + &
+ 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 + &
+ deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
+ end do
+
+ endif
+
+ !-- if u > 0:
+ if (u(k,iEdge) > 0) then
+ h_edge(k,iEdge) = &
+ 0.5*(h(k,cell1) + h(k,cell2)) &
+ -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
+ -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
+ !-- else u <= 0:
+ else
+ h_edge(k,iEdge) = &
+ 0.5*(h(k,cell1) + h(k,cell2)) &
+ -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
+ +(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12.
+ end if
+
+ end do ! do k
+ end do ! do iEdge
+
+ call timer_stop("ocn_diagnostic_solve-hEdge 3")
+ else if (config_thickness_adv_order == 4) then
+ call timer_start("ocn_diagnostic_solve-hEdge 4")
+
+ 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 + &
+ 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 + &
+ deriv_two(i+1,2,iEdge) * h(k,grid % CellsOnCell % array (i,cell2))
+ end do
+
+ endif
+
+ h_edge(k,iEdge) = &
+ 0.5*(h(k,cell1) + h(k,cell2)) &
+ -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12.
+
+ end do ! do k
+ end do ! do iEdge
+
+ call timer_stop("ocn_diagnostic_solve-hEdge 4")
+ endif ! if(config_thickness_adv_order == 2)
+ call timer_stop("ocn_diagnostic_solve-hEdge")
+
+ !
+ ! 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' &
+ .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) &
+ + kiteAreasOnVertex(i, iVertex) * pv_vertex(k, iVertex) &
+ / 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)) &
+ - pv_cell(k,cellsOnEdge(1,iEdge))) &
+ / 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)) &
+ - pv_vertex(k,verticesOnEdge(1,iEdge))) &
+ /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) &
+ - 0.5 * dt* ( u(k,iEdge) * gradPVn(k,iEdge) &
+ + 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')
+ ! mrp 110324 In order to visualize rhoDisplaced, include the following
+ call ocn_equation_of_state_rho(s, grid, 1, 'relative')
+ 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 &
+ * (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) &
+ + 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 &
+ * (h(1,iCell)-0.5*hZLevel(1))
+
+ do k=2,maxLevelCell(iCell)
+ pressure(k,iCell) = pressure(k-1,iCell) &
+ + 0.5*gravity*( rho(k-1,iCell)*hZLevel(k-1) &
+ + rho(k ,iCell)*hZLevel(k ))
+ end do
+
+ end do
+
+ endif
+
+ call ocn_wtop(s,grid)
+
+ call timer_stop("ocn_diagnostic_solve")
+
+ end subroutine ocn_diagnostic_solve!}}}
+
+!***********************************************************************
+!
+! routine ocn_wtop
+!
+!> \brief Computes vertical velocity
+!> \author Doug Jacobsen
+!> \date 23 September 2011
+!> \version SVN:$Id$
+!> \details
+!> 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 :: &
+ h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
+ hZLevel
+ real (kind=RKIND), dimension(:,:), pointer :: u,wTop
+ real (kind=RKIND), dimension(:,:), allocatable:: div_u
+
+ integer, dimension(:,:), pointer :: cellsOnEdge, cellsOnVertex, &
+ verticesOnEdge, edgesOnCell, edgesOnEdge, edgesOnVertex, &
+ boundaryEdge, boundaryCell
+ integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
+ maxLevelCell, maxLevelEdgeTop, maxLevelEdgeBot, &
+ maxLevelVertexBot, maxLevelVertexTop
+
+ call timer_start("wTop")
+
+ u => s % u % array
+ wTop => s % wTop % array
+
+ areaCell => grid % areaCell % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ hZLevel => grid % hZLevel % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeBot => grid % maxLevelEdgeBot % array
+ dvEdge => grid % dvEdge % array
+
+ 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) &
+ - div_u(k,iCell)/areaCell(iCell)*hZLevel(k)
+ end do
+ end do
+ deallocate(div_u)
+
+ endif
+
+ call timer_stop("wTop")
+
+ end subroutine ocn_wtop!}}}
+
+!***********************************************************************
+!
+! routine ocn_fuperp
+!
+!> \brief Computes f u_perp
+!> \author Doug Jacobsen
+!> \date 23 September 2011
+!> \version SVN:$Id$
+!> \details
+!> 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, &
+ vertex1, vertex2, eoe, i, j
+
+ integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
+ real (kind=RKIND) :: flux, vorticity_abs, h_vertex, workpv, q, &
+ upstream_bias, wTopEdge, rho0Inv, r
+ real (kind=RKIND), dimension(:), pointer :: &
+ h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
+ zMidZLevel, zTopZLevel
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, uBcl, v, pressure, &
+ tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
+ MontPot, wTop, divergence, vertViscTopOfEdge
+ type (dm_info) :: dminfo
+
+ integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
+ maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+ integer, dimension(:,:), pointer :: &
+ cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
+ edgesOnEdge, edgesOnVertex
+ real (kind=RKIND) :: u_diffusion
+ real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+ 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("ocn_fuperp")
+
+ h => s % h % array
+ u => s % u % array
+ uBcl => s % uBcl % array
+ v => s % v % array
+ wTop => s % wTop % array
+ h_edge => s % h_edge % array
+ circulation => s % circulation % array
+ vorticity => s % vorticity % array
+ divergence => s % divergence % array
+ ke => s % ke % array
+ ke_edge => s % ke_edge % array
+ pv_edge => s % pv_edge % array
+ MontPot => s % MontPot % array
+ pressure => s % pressure % array
+
+ weightsOnEdge => grid % weightsOnEdge % array
+ kiteAreasOnVertex => grid % kiteAreasOnVertex % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ cellsOnVertex => grid % cellsOnVertex % array
+ verticesOnEdge => grid % verticesOnEdge % array
+ nEdgesOnCell => grid % nEdgesOnCell % array
+ edgesOnCell => grid % edgesOnCell % array
+ nEdgesOnEdge => grid % nEdgesOnEdge % array
+ edgesOnEdge => grid % edgesOnEdge % array
+ edgesOnVertex => grid % edgesOnVertex % array
+ dcEdge => grid % dcEdge % array
+ dvEdge => grid % dvEdge % array
+ areaCell => grid % areaCell % array
+ areaTriangle => grid % areaTriangle % array
+ h_s => grid % h_s % array
+ fVertex => grid % fVertex % array
+ fEdge => grid % fEdge % array
+ zMidZLevel => grid % zMidZLevel % array
+ zTopZLevel => grid % zTopZLevel % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelVertexBot => grid % maxLevelVertexBot % array
+
+
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nEdgesSolve = grid % nEdgesSolve
+ nVertices = grid % nVertices
+ nVertLevels = grid % nVertLevels
+
+ !
+ ! 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("ocn_fuperp")
+
+ end subroutine ocn_fuperp!}}}
+
+!***********************************************************************
+
+end module ocn_tendency
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
Copied: branches/ocean_projects/performance/src/core_ocean/mpas_ocn_test_cases.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_test_cases.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_test_cases.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_test_cases.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,526 @@
+ 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 => domain % blocklist
+ do while (associated(block_ptr))
+ call sw_test_case_1(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
+ block_ptr => block_ptr % next
+ end do
+
+ else if (config_test_case == 2) then
+ write(0,*) ' Setup shallow water test case 2: '// &
+ 'Global Steady State Nonlinear Zonal Geostrophic Flow'
+
+ block_ptr => domain % blocklist
+ do while (associated(block_ptr))
+ call sw_test_case_2(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
+ block_ptr => block_ptr % next
+ end do
+
+ else if (config_test_case == 5) then
+ write(0,*) ' Setup shallow water test case 5:'// &
+ ' Zonal Flow over an Isolated Mountain'
+
+ block_ptr => domain % blocklist
+ do while (associated(block_ptr))
+ call sw_test_case_5(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
+ block_ptr => 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 => domain % blocklist
+ do while (associated(block_ptr))
+ call sw_test_case_6(block_ptr % mesh, block_ptr % state % time_levs(1) % state)
+ block_ptr => 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 ', &
+ 'are currently supported. '
+ call dmpar_abort(dminfo)
+ end if
+
+ block_ptr => domain % blocklist
+ do while (associated(block_ptr))
+
+ 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 => 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., "A Standard Test Set for Numerical
+ ! Approximations to the Shallow Water Equations in Spherical
+ ! Geometry" 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 * ( &
+ sin(grid%latVertex%array(iVtx)) * cos(alpha) - &
+ cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &
+ )
+ end do
+ do iEdge=1,grid % nEdges
+ state % u % array(1,iEdge) = -1.0 * ( &
+ psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
+ psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
+ ) / 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 < 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., "A Standard Test Set for Numerical
+ ! Approximations to the Shallow Water Equations in Spherical
+ ! Geometry" 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 * ( &
+ sin(grid%latVertex%array(iVtx)) * cos(alpha) - &
+ cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &
+ )
+ end do
+ do iEdge=1,grid % nEdges
+ state % u % array(1,iEdge) = -1.0 * ( &
+ psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
+ psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
+ ) / grid%dvEdge%array(iEdge)
+ end do
+ deallocate(psiVertex)
+
+ !
+ ! Generate rotated Coriolis field
+ !
+ do iEdge=1,grid % nEdges
+ grid % fEdge % array(iEdge) = 2.0 * omega * &
+ ( -cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &
+ sin(grid%latEdge%array(iEdge)) * cos(alpha) &
+ )
+ end do
+ do iVtx=1,grid % nVertices
+ grid % fVertex % array(iVtx) = 2.0 * omega * &
+ (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &
+ sin(grid%latVertex%array(iVtx)) * cos(alpha) &
+ )
+ 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) * &
+ (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &
+ sin(grid%latCell%array(iCell)) * cos(alpha) &
+ )**2.0 &
+ ) / &
+ 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., "A Standard Test Set for Numerical
+ ! Approximations to the Shallow Water Equations in Spherical
+ ! Geometry" 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 * ( &
+ sin(grid%latVertex%array(iVtx)) * cos(alpha) - &
+ cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) &
+ )
+ end do
+ do iEdge=1,grid % nEdges
+ state % u % array(1,iEdge) = -1.0 * ( &
+ psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
+ psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
+ ) / grid%dvEdge%array(iEdge)
+ end do
+ deallocate(psiVertex)
+
+ !
+ ! Generate rotated Coriolis field
+ !
+ do iEdge=1,grid % nEdges
+ grid % fEdge % array(iEdge) = 2.0 * omega * &
+ (-cos(grid%lonEdge%array(iEdge)) * cos(grid%latEdge%array(iEdge)) * sin(alpha) + &
+ sin(grid%latEdge%array(iEdge)) * cos(alpha) &
+ )
+ end do
+ do iVtx=1,grid % nVertices
+ grid % fVertex % array(iVtx) = 2.0 * omega * &
+ (-cos(grid%lonVertex%array(iVtx)) * cos(grid%latVertex%array(iVtx)) * sin(alpha) + &
+ sin(grid%latVertex%array(iVtx)) * cos(alpha) &
+ )
+ end do
+
+ !
+ ! Initialize mountain
+ !
+ do iCell=1,grid % nCells
+ if (grid % lonCell % array(iCell) < 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 + &
+ (grid % latCell % array(iCell) - theta_c - pii/6.0)**2.0 &
+ ) &
+ )
+ 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) * &
+ (-cos(grid%lonCell%array(iCell)) * cos(grid%latCell%array(iCell)) * sin(alpha) + &
+ sin(grid%latCell%array(iCell)) * cos(alpha) &
+ )**2.0 &
+ ) / &
+ 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., "A Standard Test Set for Numerical
+ ! Approximations to the Shallow Water Equations in Spherical
+ ! Geometry" 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)) + &
+ a *a * K * (cos(grid%latVertex%array(iVtx))**R) * &
+ 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 * ( &
+ psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
+ psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
+ ) / 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)) + &
+ a*a*BB(grid%latCell%array(iCell)) * cos(R*grid%lonCell%array(iCell)) + &
+ a*a*CC(grid%latCell%array(iCell)) * cos(2.0*R*grid%lonCell%array(iCell)) &
+ ) / 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 + &
+ 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 + &
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_thick_hadv.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnThickHadv.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_thick_hadv.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_thick_hadv.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,211 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_thick_hadv
+!
+!> \brief MPAS ocean horizontal advection for thickness
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the routine for computing
+!> 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, &
+ ocn_thick_hadv_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_thick_hadv_tend
+!
+!> \brief Computes tendency term from horizontal advection of thickness
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the horizontal advection tendency for
+!> 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) :: &
+ u !< Input: velocity
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h_edge !< Input: thickness at edge
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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 => grid % maxLevelEdgeTop % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ dvEdge => grid % dvEdge % array
+ areaCell => 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
+!
+!> \brief Initializes ocean forcings
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes quantities related to forcings
+!> in the ocean. Since a multiple forcings are available,
+!> this routine primarily calls the
+!> individual init routines for each forcing.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_thick_hadv_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ err = 0
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_thick_hadv_init!}}}
+
+!***********************************************************************
+
+end module ocn_thick_hadv
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+
+! vim: foldmethod=marker
Copied: branches/ocean_projects/performance/src/core_ocean/mpas_ocn_thick_vadv.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnThickVadv.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_thick_vadv.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_thick_vadv.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,165 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_thick_vadv
+!
+!> \brief MPAS ocean vertical advection for thickness
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the routine for computing
+!> 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, &
+ ocn_thick_vadv_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_thick_vadv_tend
+!
+!> \brief Computes tendency term from vertical advection of thickness
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical advection tendency for
+!> 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) :: &
+ wTop !< Input: vertical velocity on top layer
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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
+!
+!> \brief Initializes ocean forcings
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes quantities related to forcings
+!> in the ocean. Since a multiple forcings are available,
+!> this routine primarily calls the
+!> individual init routines for each forcing.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_thick_vadv_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ err = 0
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_thick_vadv_init!}}}
+
+!***********************************************************************
+
+end module ocn_thick_vadv
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
Copied: branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTimeIntegration.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,134 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_time_integration
+!
+!> \brief MPAS ocean time integration driver
+!> \author Doug Jacobsen
+!> \date 26 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for calling
+!> 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, &
+ ocn_timestep_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: rk4On, splitOn
+
+ contains
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_timestep
+!
+!> \brief MPAS ocean time integration driver
+!> \author Doug Jacobsen
+!> \date 26 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This routine handles a single timestep for the ocean. It determines
+!> the time integrator that will be used for the run, and calls the
+!> 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 => 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 => block % next
+ end do
+
+ end subroutine ocn_timestep!}}}
+
+ subroutine ocn_timestep_init(err)!{{{
+
+ integer, intent(out) :: err
+
+ rk4On = .false.
+ splitOn = .false.
+
+ if (trim(config_time_integration) == 'RK4') then
+ rk4On = .true.
+ elseif (trim(config_time_integration) == 'split_explicit' &
+ .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/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration_rk4.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTimeIntegrationRK4.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration_rk4.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration_rk4.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,651 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_time_integration_rk4
+!
+!> \brief MPAS ocean RK4 Time integration scheme
+!> \author Doug Jacobsen
+!> \date 26 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> 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
+!
+!> \brief MPAS ocean RK4 Time integration scheme
+!> \author Doug Jacobsen
+!> \date 26 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> 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 !< Input/Output: domain information
+ real (kind=RKIND), intent(in) :: dt !< 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 :: &
+ u, h, h_edge, vertViscTopOfEdge, vertDiffTopOfCell, ke_edge
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ integer, dimension(:), pointer :: &
+ maxLevelCell, maxLevelEdgeTop
+ real (kind=RKIND), dimension(:), allocatable:: A,C,uTemp
+ real (kind=RKIND), dimension(:,:), allocatable:: tracersTemp
+
+
+ block => domain % blocklist
+ call allocate_state(provis, &
+ block % mesh % nCells, block % mesh % nEdges, block % mesh % maxEdges, block % mesh % maxEdges2, &
+ 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 => 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) &
+ * 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 => 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("RK4-main loop")
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! BEGIN RK loop
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ do rk_step = 1, 4
+! --- update halos for diagnostic variables
+
+ call timer_start("RK4-diagnostic halo update")
+ block => domain % blocklist
+ do while (associated(block))
+ call dmpar_exch_halo_field2dReal(domain % dminfo, provis % pv_edge % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nEdges, &
+ block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+ if (config_h_mom_eddy_visc4 > 0.0) then
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nVertices, &
+ block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
+ end if
+
+ block => block % next
+ end do
+ call timer_stop("RK4-diagnostic halo update")
+
+! --- compute tendencies
+
+ call timer_start("RK4-tendency computations")
+ block => 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 => block % next
+ end do
+ call timer_stop("RK4-tendency computations")
+
+! --- update halos for prognostic variables
+
+ call timer_start("RK4-pronostic halo update")
+ block => domain % blocklist
+ do while (associated(block))
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % u % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nEdges, &
+ block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % h % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % tracers % array(:,:,:), &
+ block % tend % num_tracers, block % mesh % nVertLevels, block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+ block => block % next
+ end do
+ call timer_stop("RK4-pronostic halo update")
+
+! --- compute next substep state
+
+ call timer_start("RK4-update diagnostic variables")
+ if (rk_step < 4) then
+ block => domain % blocklist
+ do while (associated(block))
+
+ provis % u % array(:,:) = block % state % time_levs(1) % state % u % array(:,:) &
+ + rk_substep_weights(rk_step) * block % tend % u % array(:,:)
+
+ provis % h % array(:,:) = block % state % time_levs(1) % state % h % array(:,:) &
+ + 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) = ( &
+ block % state % time_levs(1) % state % h % array(k,iCell) * &
+ block % state % time_levs(1) % state % tracers % array(:,k,iCell) &
+ + rk_substep_weights(rk_step) * block % tend % tracers % array(:,k,iCell) &
+ ) / 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 => block % next
+ end do
+ end if
+ call timer_stop("RK4-update diagnostic variables")
+
+
+
+!--- accumulate update (for RK4)
+
+ call timer_start("RK4-RK4 accumulate update")
+ block => domain % blocklist
+ do while (associated(block))
+ block % state % time_levs(2) % state % u % array(:,:) = block % state % time_levs(2) % state % u % array(:,:) &
+ + rk_weights(rk_step) * block % tend % u % array(:,:)
+
+ block % state % time_levs(2) % state % h % array(:,:) = block % state % time_levs(2) % state % h % array(:,:) &
+ + 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) = &
+ block % state % time_levs(2) % state % tracers % array(:,k,iCell) &
+ + rk_weights(rk_step) * block % tend % tracers % array(:,k,iCell)
+ end do
+ end do
+
+ block => block % next
+ end do
+ call timer_stop("RK4-RK4 accumulate update")
+
+ end do
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! END RK loop
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ call timer_stop("RK4-main loop")
+
+ !
+ ! A little clean up at the end: decouple new scalar fields and compute diagnostics for new state
+ !
+ call timer_start("RK4-cleaup phase")
+ block => domain % blocklist
+ do while (associated(block))
+
+ u => block % state % time_levs(2) % state % u % array
+ tracers => block % state % time_levs(2) % state % tracers % array
+ h => block % state % time_levs(2) % state % h % array
+ h_edge => block % state % time_levs(2) % state % h_edge % array
+ ke_edge => block % state % time_levs(2) % state % ke_edge % array
+ num_tracers = block % state % time_levs(2) % state % num_tracers
+ vertViscTopOfEdge => block % diagnostics % vertViscTopOfEdge % array
+ vertDiffTopOfCell => block % diagnostics % vertDiffTopOfCell % array
+ maxLevelCell => block % mesh % maxLevelCell % array
+ maxLevelEdgeTop => block % mesh % maxLevelEdgeTop % array
+
+ 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("RK4-implicit vert mix")
+ allocate(A(nVertLevels),C(nVertLevels),uTemp(nVertLevels), &
+ 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("RK4-momentum decay")
+
+ !
+ ! 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("RK4-momentum decay")
+ 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 % state % time_levs(2) % state, block % mesh)
+
+ block => block % next
+ end do
+ call timer_stop("RK4-cleaup phase")
+
+ 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, &
+ vertex1, vertex2, eoe, i, j
+
+ integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
+ real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
+ real (kind=RKIND), dimension(:), pointer :: &
+ h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
+ zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
+ tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
+ MontPot, wTop, divergence, vertViscTopOfEdge
+ type (dm_info) :: dminfo
+
+ integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
+ maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+ integer, dimension(:,:), pointer :: &
+ cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
+ edgesOnEdge, edgesOnVertex
+ real (kind=RKIND) :: u_diffusion
+ real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+ 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("filter_btr_mode_tend_u")
+
+ h => s % h % array
+ u => s % u % array
+ v => s % v % array
+ wTop => s % wTop % array
+ h_edge => s % h_edge % array
+ circulation => s % circulation % array
+ vorticity => s % vorticity % array
+ divergence => s % divergence % array
+ ke => s % ke % array
+ ke_edge => s % ke_edge % array
+ pv_edge => s % pv_edge % array
+ MontPot => s % MontPot % array
+ pressure => s % pressure % array
+ vertViscTopOfEdge => d % vertViscTopOfEdge % array
+
+ weightsOnEdge => grid % weightsOnEdge % array
+ kiteAreasOnVertex => grid % kiteAreasOnVertex % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ cellsOnVertex => grid % cellsOnVertex % array
+ verticesOnEdge => grid % verticesOnEdge % array
+ nEdgesOnCell => grid % nEdgesOnCell % array
+ edgesOnCell => grid % edgesOnCell % array
+ nEdgesOnEdge => grid % nEdgesOnEdge % array
+ edgesOnEdge => grid % edgesOnEdge % array
+ edgesOnVertex => grid % edgesOnVertex % array
+ dcEdge => grid % dcEdge % array
+ dvEdge => grid % dvEdge % array
+ areaCell => grid % areaCell % array
+ areaTriangle => grid % areaTriangle % array
+ h_s => grid % h_s % array
+! mrp 110516 cleanup fvertex fedge not used in this subroutine
+ fVertex => grid % fVertex % array
+ fEdge => grid % fEdge % array
+ zMidZLevel => grid % zMidZLevel % array
+ zTopZLevel => grid % zTopZLevel % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelVertexBot => grid % maxLevelVertexBot % array
+
+ tend_u => tend % u % array
+
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nEdgesSolve = grid % nEdgesSolve
+ nVertices = grid % nVertices
+ nVertLevels = grid % nVertLevels
+
+ u_src => grid % u_src % array
+
+ do iEdge=1,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("filter_btr_mode_tend_u")
+
+ 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, &
+ vertex1, vertex2, eoe, i, j
+
+ integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
+ real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
+ real (kind=RKIND), dimension(:), pointer :: &
+ h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
+ zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
+ tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
+ MontPot, wTop, divergence, vertViscTopOfEdge
+ type (dm_info) :: dminfo
+
+ integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
+ maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+ integer, dimension(:,:), pointer :: &
+ cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
+ edgesOnEdge, edgesOnVertex
+ real (kind=RKIND) :: u_diffusion
+ real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+ 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("filter_btr_mode_u")
+
+ h => s % h % array
+ u => s % u % array
+ v => s % v % array
+ wTop => s % wTop % array
+ h_edge => s % h_edge % array
+ circulation => s % circulation % array
+ vorticity => s % vorticity % array
+ divergence => s % divergence % array
+ ke => s % ke % array
+ ke_edge => s % ke_edge % array
+ pv_edge => s % pv_edge % array
+ MontPot => s % MontPot % array
+ pressure => s % pressure % array
+
+ weightsOnEdge => grid % weightsOnEdge % array
+ kiteAreasOnVertex => grid % kiteAreasOnVertex % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ cellsOnVertex => grid % cellsOnVertex % array
+ verticesOnEdge => grid % verticesOnEdge % array
+ nEdgesOnCell => grid % nEdgesOnCell % array
+ edgesOnCell => grid % edgesOnCell % array
+ nEdgesOnEdge => grid % nEdgesOnEdge % array
+ edgesOnEdge => grid % edgesOnEdge % array
+ edgesOnVertex => grid % edgesOnVertex % array
+ dcEdge => grid % dcEdge % array
+ dvEdge => grid % dvEdge % array
+ areaCell => grid % areaCell % array
+ areaTriangle => grid % areaTriangle % array
+ h_s => grid % h_s % array
+! mrp 110516 cleanup fvertex fedge not used in this subroutine
+ fVertex => grid % fVertex % array
+ fEdge => grid % fEdge % array
+ zMidZLevel => grid % zMidZLevel % array
+ zTopZLevel => grid % zTopZLevel % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelVertexBot => grid % maxLevelVertexBot % array
+
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nEdgesSolve = grid % nEdgesSolve
+ nVertices = grid % nVertices
+ nVertLevels = grid % nVertLevels
+
+ u_src => grid % u_src % array
+
+ do iEdge=1,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("filter_btr_mode_u")
+
+ 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("enforce_boundaryEdge")
+
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nVertices = grid % nVertices
+ nVertLevels = grid % nVertLevels
+
+ boundaryEdge => grid % boundaryEdge % array
+ tend_u => 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("enforce_boundaryEdge")
+
+ end subroutine enforce_boundaryEdge!}}}
+
+end module ocn_time_integration_rk4
+
+! vim: foldmethod=marker
Copied: branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration_split.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTimeIntegrationSplit.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration_split.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_time_integration_split.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,1439 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_time_integration_split
+!
+!> \brief MPAS ocean split explicit time integration scheme
+!> \author Doug Jacobsen
+!> \date 26 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the routine for the split explicit
+!> 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
+!
+!> \brief MPAS ocean split explicit time integration scheme
+!> \author Doug Jacobsen
+!> \date 26 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This routine integrates a single time step (dt) using a
+!> 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, &
+ eoe, oldBtrSubcycleTime, newBtrSubcycleTime, uPerpTime, BtrCorIter, &
+ n_bcl_iter(config_n_ts_iter), &
+ vertex1, vertex2, iVertex
+
+ type (block_type), pointer :: block
+ real (kind=RKIND) :: uhSum, hSum, sshEdge, flux, &
+ uPerp, uCorr, tracerTemp, coef
+ real (kind=RKIND), dimension(:), pointer :: sshNew
+
+ integer :: num_tracers, ucorr_coef, err
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ u, h, h_edge, ke_edge, vertViscTopOfEdge, vertDiffTopOfCell
+ real (kind=RKIND), dimension(:,:,:), pointer :: tracers
+ integer, dimension(:), pointer :: &
+ maxLevelCell, maxLevelEdgeTop
+ real (kind=RKIND), dimension(:), allocatable:: A,C,uTemp, hNew
+ real (kind=RKIND), dimension(:,:), allocatable:: tracersTemp
+
+ call timer_start("split_explicit_timestep")
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! Prep variables before first iteration
+ !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ block => 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) &
+ = block % state % time_levs(1) % state % u % array(:,iEdge) &
+ - block % state % time_levs(1) % state % uBtr % array(iEdge)
+
+ block % state % time_levs(2) % state % u % array(:,iEdge) &
+ = block % state % time_levs(1) % state % u % array(:,iEdge)
+
+ block % state % time_levs(2) % state % uBcl % array(:,iEdge) &
+ = 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(:) &
+ = block % state % time_levs(1) % state % ssh % array(:)
+
+ block % state % time_levs(2) % state % h_edge % array(:,:) &
+ = 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) &
+ = block % state % time_levs(1) % state % tracers % array(:,k,iCell)
+ end do
+
+ end do
+
+ block => 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 => domain % blocklist
+ do while (associated(block))
+! mrp 110512 not sure if I need the following three. Leave be, assume I need it.
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % pv_edge % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nEdges, &
+ block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+ if (config_h_mom_eddy_visc4 > 0.0) then
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % divergence % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % vorticity % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nVertices, &
+ block % parinfo % verticesToSend, block % parinfo % verticesToRecv)
+ end if
+
+ block => block % next
+ end do
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! Stage 1: Baroclinic velocity (3D) prediction, explicit with long timestep
+ !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ ! compute velocity tendencies, T(u*,w*,p*)
+
+ block => domain % blocklist
+ do while (associated(block))
+ if (.not.config_implicit_vertical_mix) then
+ call ocn_vmix_coefs(block % mesh, block % state % time_levs(2) % state, block % diagnostics, err)
+ end if
+ call ocn_tend_u(block % tend, block % state % time_levs(2) % state , block % diagnostics, block % mesh)
+ call enforce_boundaryEdge(block % tend, block % mesh)
+ block => 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 => 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) &
+ = block % state % time_levs(1) % state % uBcl % array(k,iEdge) &
+ + dt * (block % tend % u % array (k,iEdge) &
+ + block % state % time_levs(2) % state % u % array (k,iEdge) & ! this is f*uBcl^{perp}
+ + split*gravity &
+ *( block % state % time_levs(2) % state % ssh % array(cell2) &
+ - block % state % time_levs(2) % state % ssh % array(cell1) ) &
+ /block % mesh % dcEdge % array(iEdge) )
+ enddo
+
+ ! Compute GBtrForcing, the vertically averaged forcing
+ sshEdge = 0.5*( &
+ block % state % time_levs(1) % state % ssh % array(cell1) &
+ + block % state % time_levs(1) % state % ssh % array(cell2) )
+
+ 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) &
+ = 0.5*( &
+ block % state % time_levs(1) % state % uBcl % array(k,iEdge) &
+ + uTemp(k) - dt * block % state % time_levs(1) % state % GBtrForcing % array(iEdge))
+ enddo
+
+ enddo ! iEdge
+
+ deallocate(uTemp)
+
+ block => block % next
+ end do
+
+ block => domain % blocklist
+ do while (associated(block))
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % state % time_levs(2) % state % uBcl % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nEdges, &
+ block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+ block => block % next
+ end do
+
+ 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 => 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(:,:) &
+ = block % state % time_levs(2) % state % uBcl % array(:,:)
+
+ block => block % next
+ end do ! block
+
+ elseif (trim(config_time_integration) == 'split_explicit') then
+
+ ! Initialize variables for barotropic subcycling
+ block => domain % blocklist
+ do while (associated(block))
+
+ if (config_filter_btr_mode) then
+ block % state % time_levs(1) % state % GBtrForcing % array(:) = 0.0
+ endif
+
+ do iCell=1,block % mesh % nCells
+ ! sshSubcycleOld = sshOld
+ block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
+ = block % state % time_levs(1) % state % ssh % array(iCell)
+
+ ! sshNew = sshOld This is the first for the summation
+ block % state % time_levs(2) % state % ssh % array(iCell) &
+ = block % state % time_levs(1) % state % ssh % array(iCell)
+ enddo
+
+ do iEdge=1,block % mesh % nEdges
+
+ ! uBtrSubcycleOld = uBtrOld
+ block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ = 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) &
+ = block % state % time_levs(1) % state % uBtr % array(iEdge)
+
+ ! FBtr = 0
+ block % state % time_levs(1) % state % FBtr % array(iEdge) = 0.0
+ enddo
+
+ block => 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
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ uPerpTime = oldBtrSubcycleTime
+
+ block => domain % blocklist
+ do while (associated(block))
+
+ do iEdge=1,block % mesh % nEdges
+
+ cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+ cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+
+ ! Compute -f*uPerp
+ uPerp = 0.0
+ do i = 1,block % mesh % nEdgesOnEdge % array(iEdge)
+ eoe = block % mesh % edgesOnEdge % array(i,iEdge)
+ uPerp = uPerp + block % mesh % weightsOnEdge % array(i,iEdge) &
+ * block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &
+ * block % mesh % fEdge % array(eoe)
+ end do
+
+ ! 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) &
+ = block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ + dt/config_n_btr_subcycles *( &
+ uPerp &
+ - gravity &
+ *( block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) &
+ - block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) ) &
+ /block % mesh % dcEdge % array(iEdge) &
+ + block % state % time_levs(1) % state % GBtrForcing % array(iEdge) )
+
+ 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) &
+ = block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ * coef
+ end do
+
+ endif
+
+
+ block => block % next
+ end do ! block
+
+
+ ! boundary update on uBtrNew
+ block => domain % blocklist
+ do while (associated(block))
+
+ call dmpar_exch_halo_field1dReal(domain % dminfo, &
+ block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:), &
+ block % mesh % nEdges, &
+ block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+ block => block % next
+ end do ! block
+
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Barotropic subcycle: Compute thickness flux and new SSH
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ block => domain % blocklist
+ do while (associated(block))
+
+ block % tend % ssh % array(:) = 0.0
+
+ ! config_btr_flux_coef sets the forward weighting of velocity in the SSH computation
+ ! config_btr_flux_coef= 1 flux = uBtrNew*H
+ ! config_btr_flux_coef=0.5 flux = 1/2*(uBtrNew+uBtrOld)*H
+ ! config_btr_flux_coef= 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 &
+ *( block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell1) &
+ + block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(cell2) )
+ hSum = sum(block % mesh % hZLevel % array (1:block % mesh % maxLevelEdgeTop % array(iEdge)))
+
+ flux = ((1.0-config_btr_flux_coef) &
+ * block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ + config_btr_flux_coef &
+ * block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)) &
+ * block % mesh % dvEdge % array(iEdge) &
+ * (sshEdge + hSum)
+
+ block % tend % ssh % array(cell1) = block % tend % ssh % array(cell1) - flux
+ block % tend % ssh % array(cell2) = block % tend % ssh % array(cell2) + flux
+
+ block % state % time_levs(1) % state % FBtr % array(iEdge) &
+ = block % state % time_levs(1) % state % FBtr % array(iEdge) &
+ + flux
+ end do
+
+ ! SSHnew = SSHold + dt/J*(-div(Flux))
+ do iCell=1,block % mesh % nCells
+
+ block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
+ = block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(iCell) &
+ + dt/config_n_btr_subcycles &
+ * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
+
+ end do
+
+ block => block % next
+ end do ! block
+
+ ! boundary update on SSNnew
+ block => domain % blocklist
+ do while (associated(block))
+
+! block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &
+
+ call dmpar_exch_halo_field1dReal(domain % dminfo, &
+ block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(:), &
+ block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+
+ block => block % next
+ end do ! block
+
+ block => domain % blocklist
+ do while (associated(block))
+
+ do iCell=1,block % mesh % nCells
+
+ ! Accumulate SSH in running sum over the subcycles.
+ block % state % time_levs(2) % state % ssh % array(iCell) &
+ = block % state % time_levs(2) % state % ssh % array(iCell) &
+ + block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(iCell)
+
+ end do
+
+ block => 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 => domain % blocklist
+ do while (associated(block))
+ block % state % time_levs(1) % state % u_diffusionBtr % array(:) = 0.0
+ if ( config_btr_mom_eddy_visc2 > 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) &
+ = block % state % time_levs(1) % state % circulationBtr % array(vertex1) &
+ - block % mesh % dcEdge % array (iEdge) &
+ *block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
+
+ block % state % time_levs(1) % state % circulationBtr % array(vertex2) &
+ = block % state % time_levs(1) % state % circulationBtr % array(vertex2) &
+ + block % mesh % dcEdge % array (iEdge) &
+ *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) &
+ = 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) &
+ = block % state % time_levs(1) % state % divergenceBtr % array (cell1) &
+ + block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ *block % mesh % dvEdge % array(iEdge)
+
+ block % state % time_levs(1) % state % divergenceBtr % array (cell2) &
+ = block % state % time_levs(1) % state % divergenceBtr % array (cell2) &
+ - block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ *block % mesh % dvEdge % array(iEdge)
+ end do
+ do iCell = 1,block % mesh % nCells
+ block % state % time_levs(1) % state % divergenceBtr % array(iCell) &
+ = block % state % time_levs(1) % state % divergenceBtr % array(iCell) &
+ /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 * &
+ (( block % state % time_levs(1) % state % divergenceBtr % array(cell2) - block % state % time_levs(1) % state % divergenceBtr % array(cell1) ) / block % mesh % dcEdge % array (iEdge) &
+ -( 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 => 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 => domain % blocklist
+ do while (associated(block))
+
+ do iEdge=1,block % mesh % nEdges
+
+ cell1 = block % mesh % cellsOnEdge % array(1,iEdge)
+ cell2 = block % mesh % cellsOnEdge % array(2,iEdge)
+
+ ! Compute -f*uPerp
+ uPerp = 0.0
+ do i = 1,block % mesh % nEdgesOnEdge % array(iEdge)
+ eoe = block % mesh % edgesOnEdge % array(i,iEdge)
+ uPerp = uPerp + block % mesh % weightsOnEdge % array(i,iEdge) &
+ * block % state % time_levs(uPerpTime) % state % uBtrSubcycle % array(eoe) &
+ * block % mesh % fEdge % array(eoe)
+ end do
+
+ ! 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) &
+ = block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ + dt/config_n_btr_subcycles *( &
+ uPerp &
+ - gravity &
+ *( block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell2) &
+ - block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(cell1) ) &
+ /block % mesh % dcEdge % array(iEdge) &
+ + block % state % time_levs(1) % state % GBtrForcing % array(iEdge) &
+ + 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) &
+ = block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge) &
+ * coef
+ end do
+
+ endif
+
+ block => block % next
+ end do ! block
+
+
+ ! boundary update on uBtrNew
+ block => domain % blocklist
+ do while (associated(block))
+
+ call dmpar_exch_halo_field1dReal(domain % dminfo, &
+ block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(:), &
+ block % mesh % nEdges, &
+ block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+ block => block % next
+ end do ! block
+
+ end do !do BtrCorIter=1,config_n_btr_cor_iter
+
+
+ ! uBtrNew = uBtrNew + uBtrSubcycleNEW
+ ! This accumulates the sum.
+ ! If the Barotropic Coriolis iteration is limited to one, this could
+ ! be merged with the above code.
+ block => domain % blocklist
+ do while (associated(block))
+ do iEdge=1,block % mesh % nEdges
+
+ block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ = block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ + block % state % time_levs(newBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
+
+ end do ! iEdge
+ block => 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 => domain % blocklist
+ do while (associated(block))
+
+ do iEdge=1,block % mesh % nEdges
+ block % state % time_levs(1) % state % FBtr % array(iEdge) &
+ = block % state % time_levs(1) % state % FBtr % array(iEdge) &
+ / (config_n_btr_subcycles*config_btr_subcycle_loop_factor)
+
+ block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ = block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ / (config_n_btr_subcycles*config_btr_subcycle_loop_factor + 1)
+ end do
+
+ if (config_SSH_from=='avg_of_SSH_subcycles') then
+ do iCell=1,block % mesh % nCells
+ block % state % time_levs(2) % state % ssh % array(iCell) &
+ = block % state % time_levs(2) % state % ssh % array(iCell) &
+ / (config_n_btr_subcycles*config_btr_subcycle_loop_factor + 1)
+ end do
+ elseif (config_SSH_from=='avg_flux') then
+ ! see below
+ else
+ write(0,*) 'Abort: Unknown config_SSH_from option: '&
+ //trim(config_SSH_from)
+ call dmpar_abort(dminfo)
+ endif
+
+ block => block % next
+ end do ! block
+
+
+ ! boundary update on F
+ block => domain % blocklist
+ do while (associated(block))
+
+ call dmpar_exch_halo_field1dReal(domain % dminfo, &
+ block % state % time_levs(1) % state % FBtr % array(:), &
+ block % mesh % nEdges, &
+ block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+
+ block => block % next
+ end do ! block
+
+
+ ! Check that you can compute SSH using the total sum or the individual increments
+ ! over the barotropic subcycles.
+ ! efficiency: This next block of code is really a check for debugging, and can
+ ! be removed later.
+ block => domain % blocklist
+ do while (associated(block))
+
+ allocate(uTemp(block % mesh % nVertLevels))
+
+ 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) &
+ = block % tend % ssh % array(cell1) &
+ - block % state % time_levs(1) % state % FBtr % array(iEdge)
+
+ block % tend % ssh % array(cell2) &
+ = block % tend % ssh % array(cell2) &
+ + block % state % time_levs(1) % state % FBtr % array(iEdge)
+
+ end do
+
+ do iCell=1,block % mesh % nCells
+
+ ! SSHnew = SSHold + dt*(-div(Flux))
+ block % state % time_levs(2) % state % ssh % array(iCell) &
+ = block % state % time_levs(1) % state % ssh % array(iCell) &
+ + dt &
+ * block % tend % ssh % array(iCell) / block % mesh % areaCell % array (iCell)
+ end do
+ endif
+ ! Now can compare sshSubcycleNEW (big step using summed fluxes) with
+ ! sshSubcycleOLD (individual steps to get there)
+!print *, 'ssh, by substeps',minval(block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(1:block % mesh % nCellsSolve)), &
+! maxval(block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array(1:block % mesh % nCellsSolve))
+!print *, 'ssh, by 1 step ',minval(block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(1:block % mesh % nCellsSolve)), &
+! maxval(block % state % time_levs(newBtrSubcycleTime) % state % sshSubcycle % array(1:block % mesh % nCellsSolve))
+
+ ! 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 &
+ *( block % state % time_levs(2) % state % ssh % array(cell1) &
+ + block % state % time_levs(2) % state % ssh % array(cell2) )
+
+ ! This is u*
+ uTemp(:) &
+ = block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ + 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) &
+ /block % mesh % dvEdge % array(iEdge) &
+ - 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
+ block % state % time_levs(2) % state % u % array(:,iEdge) = uTemp(:) + uCorr
+ 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) &
+ = sshEdge + block % mesh % hZLevel % array(1)
+
+ do k=2,block % mesh % nVertLevels
+ block % state % time_levs(2) % state % h_edge % array(k,iEdge) &
+ = block % mesh % hZLevel % array(k)
+ enddo
+
+ end do ! iEdge
+
+ ! Put new SSH values in h array, for the OcnTendScalar call below.
+ do iCell=1,block % mesh % nCells
+ block % state % time_levs(2) % state % h % array(1,iCell) &
+ = block % state % time_levs(2) % state % ssh % array(iCell) &
+ + block % mesh % hZLevel % array(1)
+
+ ! 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) &
+ = block % mesh % hZLevel % array(k)
+ enddo
+ enddo ! iCell
+
+ deallocate(uTemp)
+
+ block => block % next
+ end do ! block
+
+
+ endif ! split_explicit
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! Stage 3: Tracer, density, pressure, vertical velocity prediction
+ !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ block => 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 => block % next
+ end do
+
+ ! --- update halos for prognostic variables
+
+ block => domain % blocklist
+ do while (associated(block))
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % tend % h % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % tend % tracers % array(:,:,:), &
+ block % tend % num_tracers, block % mesh % nVertLevels, block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+ block => block % next
+ end do
+
+
+ block => 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 => block % state % time_levs(oldBtrSubcycleTime) % state % sshSubcycle % array
+ elseif (trim(config_new_btr_variables_from) == 'btr_avg') then
+ ! This points to the tendency variable SSH*
+ sshNew => block % state % time_levs(2) % state % ssh % array
+ endif
+
+ 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) &
+ = block % state % time_levs(1) % state % h % array(:,iCell) &
+ + 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) &
+ = block % state % time_levs(2) % state % h % array(1,iCell) &
+ - block % mesh % hZLevel % array(1)
+ end do ! iCell
+
+ endif ! unsplit_explicit
+
+ ! Only need T & S for earlier iterations,
+ ! then all the tracers needed the last time through.
+ if (split_explicit_step < config_n_ts_iter) then
+
+ hNew(:) = block % mesh % hZLevel % array(:)
+ do iCell=1,block % mesh % nCells
+ ! sshNew is a pointer, defined above.
+ hNew(1) = sshNew(iCell) + block % mesh % hZLevel % array(1)
+ do k=1,block % mesh % maxLevelCell % array(iCell)
+ do i=1,2
+ ! This is Phi at n+1
+ tracerTemp &
+ = ( block % state % time_levs(1) % state % tracers % array(i,k,iCell) &
+ * block % state % time_levs(1) % state % h % array(k,iCell) &
+ + dt * block % tend % tracers % array(i,k,iCell) &
+ ) / hNew(k)
+
+ ! This is Phi at n+1/2
+ block % state % time_levs(2) % state % tracers % array(i,k,iCell) &
+ = 0.5*( &
+ block % state % time_levs(1) % state % tracers % array(i,k,iCell) &
+ + tracerTemp )
+ enddo
+ end do
+ end do ! iCell
+
+
+ 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) &
+ = 0.5*( &
+ block % state % time_levs(2) % state % h % array(1,iCell) &
+ + block % state % time_levs(1) % state % h % array(1,iCell) )
+
+ end do ! iCell
+ endif ! unsplit_explicit
+
+ ! compute u*, the velocity for tendency terms. Put in uNew.
+ ! uBclNew is at time n+1/2 here.
+ ! This overwrites u^{tr}, the tracer transport velocity, which was in uNew.
+ ! The following must occur after call OcnTendScalar
+ do iEdge=1,block % mesh % nEdges
+ block % state % time_levs(2) % state % u % array(:,iEdge) &
+ = block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ + block % state % time_levs(2) % state % uBcl % array(:,iEdge)
+ end do ! iEdge
+
+ ! 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) &
+ = ( block % state % time_levs(1) % state % tracers % array(i,k,iCell) &
+ * block % state % time_levs(1) % state % h % array(k,iCell) &
+ + dt * block % tend % tracers % array(i,k,iCell) &
+ ) / hNew(k)
+
+ enddo
+ end do
+ end do
+
+ endif ! split_explicit_step
+ deallocate(hNew)
+
+ block => block % next
+ end do
+
+ end do ! split_explicit_step = 1, config_n_ts_iter
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! END large iteration loop
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ !
+ ! A little clean up at the end: decouple new scalar fields and compute diagnostics for new state
+ !
+ block => domain % blocklist
+ do while (associated(block))
+
+ if (trim(config_new_btr_variables_from) == 'last_subcycle') then
+ do iEdge=1,block % mesh % nEdges
+ ! uBtrNew = uBtrSubcycleNew (old here is because counter already flipped)
+ ! This line is not needed if u is resplit at the beginning of the timestep.
+ block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ = block % state % time_levs(oldBtrSubcycleTime) % state % uBtrSubcycle % array(iEdge)
+ enddo ! iEdges
+ elseif (trim(config_new_btr_variables_from) == 'btr_avg') then
+ ! uBtrNew from u*. this is done above, so u* is already in
+ ! block % state % time_levs(2) % state % uBtr % array(iEdge)
+ else
+ write(0,*) 'Abort: Unknown config_new_btr_variables_from: '&
+ //trim(config_time_integration)
+ call dmpar_abort(dminfo)
+ endif
+
+ ! Recompute final u to go on to next step.
+ ! u_{n+1} = uBtr_{n+1} + uBcl_{n+1}
+ ! Right now uBclNew is at time n+1/2, so back compute to get uBcl at time n+1
+ ! using uBcl_{n+1/2} = 1/2*(uBcl_n + u_Bcl_{n+1})
+ ! so the following lines are
+ ! u_{n+1} = uBtr_{n+1} + 2*uBcl_{n+1/2} - uBcl_n
+ ! note that uBcl is recomputed at the beginning of the next timestep due to Imp Vert mixing,
+ ! so uBcl does not have to be recomputed here.
+
+ do iEdge=1,block % mesh % nEdges
+ do k=1,block % mesh % maxLevelEdgeTop % array(iEdge)
+
+ block % state % time_levs(2) % state % u % array(k,iEdge) &
+ = block % state % time_levs(2) % state % uBtr % array(iEdge) &
+ +2*block % state % time_levs(2) % state % uBcl % array(k,iEdge) &
+ - block % state % time_levs(1) % state % uBcl % array(k,iEdge)
+ enddo
+ ! 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) &
+ = 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) &
+ = block % state % time_levs(2) % state % ssh % array(iCell) &
+ + 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) &
+ = block % mesh % hZLevel % array(k)
+ end do
+ end do ! iCell
+ end if ! split_explicit
+
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ !
+ ! Implicit vertical mixing, done after timestep is complete
+ !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ u => block % state % time_levs(2) % state % u % array
+ tracers => block % state % time_levs(2) % state % tracers % array
+ h => block % state % time_levs(2) % state % h % array
+ h_edge => block % state % time_levs(2) % state % h_edge % array
+ ke_edge => block % state % time_levs(2) % state % ke_edge % array
+ num_tracers = block % state % time_levs(2) % state % num_tracers
+ vertViscTopOfEdge => block % diagnostics % vertViscTopOfEdge % array
+ vertDiffTopOfCell => block % diagnostics % vertDiffTopOfCell % array
+ maxLevelCell => block % mesh % maxLevelCell % array
+ maxLevelEdgeTop => block % mesh % maxLevelEdgeTop % array
+
+ if (config_implicit_vertical_mix) then
+ allocate(A(block % mesh % nVertLevels),C(block % mesh % nVertLevels),uTemp(block % mesh % nVertLevels), &
+ 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 % state % time_levs(2) % state, block % mesh)
+
+ block => block % next
+ end do
+ call timer_stop("split_explicit_timestep")
+
+ 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, &
+ vertex1, vertex2, eoe, i, j
+
+ integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
+ real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
+ real (kind=RKIND), dimension(:), pointer :: &
+ h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
+ zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
+ tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
+ MontPot, wTop, divergence, vertViscTopOfEdge
+ type (dm_info) :: dminfo
+
+ integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
+ maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+ integer, dimension(:,:), pointer :: &
+ cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
+ edgesOnEdge, edgesOnVertex
+ real (kind=RKIND) :: u_diffusion
+ real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+ 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("filter_btr_mode_tend_u")
+
+ h => s % h % array
+ u => s % u % array
+ v => s % v % array
+ wTop => s % wTop % array
+ h_edge => s % h_edge % array
+ circulation => s % circulation % array
+ vorticity => s % vorticity % array
+ divergence => s % divergence % array
+ ke => s % ke % array
+ ke_edge => s % ke_edge % array
+ pv_edge => s % pv_edge % array
+ MontPot => s % MontPot % array
+ pressure => s % pressure % array
+ vertViscTopOfEdge => d % vertViscTopOfEdge % array
+
+ weightsOnEdge => grid % weightsOnEdge % array
+ kiteAreasOnVertex => grid % kiteAreasOnVertex % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ cellsOnVertex => grid % cellsOnVertex % array
+ verticesOnEdge => grid % verticesOnEdge % array
+ nEdgesOnCell => grid % nEdgesOnCell % array
+ edgesOnCell => grid % edgesOnCell % array
+ nEdgesOnEdge => grid % nEdgesOnEdge % array
+ edgesOnEdge => grid % edgesOnEdge % array
+ edgesOnVertex => grid % edgesOnVertex % array
+ dcEdge => grid % dcEdge % array
+ dvEdge => grid % dvEdge % array
+ areaCell => grid % areaCell % array
+ areaTriangle => grid % areaTriangle % array
+ h_s => grid % h_s % array
+! mrp 110516 cleanup fvertex fedge not used in this subroutine
+ fVertex => grid % fVertex % array
+ fEdge => grid % fEdge % array
+ zMidZLevel => grid % zMidZLevel % array
+ zTopZLevel => grid % zTopZLevel % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelVertexBot => grid % maxLevelVertexBot % array
+
+ tend_u => tend % u % array
+
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nEdgesSolve = grid % nEdgesSolve
+ nVertices = grid % nVertices
+ nVertLevels = grid % nVertLevels
+
+ u_src => grid % u_src % array
+
+ do iEdge=1,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("filter_btr_mode_tend_u")
+
+ 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, &
+ vertex1, vertex2, eoe, i, j
+
+ integer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve
+ real (kind=RKIND) :: vertSum, uhSum, hSum, sshEdge
+ real (kind=RKIND), dimension(:), pointer :: &
+ h_s, fVertex, fEdge, dvEdge, dcEdge, areaCell, areaTriangle, &
+ zMidZLevel, zTopZLevel, meshScalingDel2, meshScalingDel4
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ weightsOnEdge, kiteAreasOnVertex, h_edge, h, u, v, pressure, &
+ tend_u, circulation, vorticity, ke, ke_edge, pv_edge, &
+ MontPot, wTop, divergence, vertViscTopOfEdge
+ type (dm_info) :: dminfo
+
+ integer, dimension(:), pointer :: nEdgesOnCell, nEdgesOnEdge, &
+ maxLevelCell, maxLevelEdgeTop, maxLevelVertexBot
+ integer, dimension(:,:), pointer :: &
+ cellsOnEdge, cellsOnVertex, verticesOnEdge, edgesOnCell, &
+ edgesOnEdge, edgesOnVertex
+ real (kind=RKIND) :: u_diffusion
+ real (kind=RKIND), dimension(:), allocatable:: fluxVertTop,w_dudzTopEdge
+
+ 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("filter_btr_mode_u")
+
+ h => s % h % array
+ u => s % u % array
+ v => s % v % array
+ wTop => s % wTop % array
+ h_edge => s % h_edge % array
+ circulation => s % circulation % array
+ vorticity => s % vorticity % array
+ divergence => s % divergence % array
+ ke => s % ke % array
+ ke_edge => s % ke_edge % array
+ pv_edge => s % pv_edge % array
+ MontPot => s % MontPot % array
+ pressure => s % pressure % array
+
+ weightsOnEdge => grid % weightsOnEdge % array
+ kiteAreasOnVertex => grid % kiteAreasOnVertex % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ cellsOnVertex => grid % cellsOnVertex % array
+ verticesOnEdge => grid % verticesOnEdge % array
+ nEdgesOnCell => grid % nEdgesOnCell % array
+ edgesOnCell => grid % edgesOnCell % array
+ nEdgesOnEdge => grid % nEdgesOnEdge % array
+ edgesOnEdge => grid % edgesOnEdge % array
+ edgesOnVertex => grid % edgesOnVertex % array
+ dcEdge => grid % dcEdge % array
+ dvEdge => grid % dvEdge % array
+ areaCell => grid % areaCell % array
+ areaTriangle => grid % areaTriangle % array
+ h_s => grid % h_s % array
+! mrp 110516 cleanup fvertex fedge not used in this subroutine
+ fVertex => grid % fVertex % array
+ fEdge => grid % fEdge % array
+ zMidZLevel => grid % zMidZLevel % array
+ zTopZLevel => grid % zTopZLevel % array
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelVertexBot => grid % maxLevelVertexBot % array
+
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nEdgesSolve = grid % nEdgesSolve
+ nVertices = grid % nVertices
+ nVertLevels = grid % nVertLevels
+
+ u_src => grid % u_src % array
+
+ do iEdge=1,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("filter_btr_mode_u")
+
+ 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("enforce_boundaryEdge")
+
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nVertices = grid % nVertices
+ nVertLevels = grid % nVertLevels
+
+ boundaryEdge => grid % boundaryEdge % array
+ tend_u => 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("enforce_boundaryEdge")
+
+ end subroutine enforce_boundaryEdge!}}}
+
+end module ocn_time_integration_split
+
+! vim: foldmethod=marker
Copied: branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,179 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_hadv
+!
+!> \brief MPAS ocean horizontal tracer advection driver
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> 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, &
+ ocn_tracer_hadv_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_hadv_tend
+!
+!> \brief Computes tendency term for horizontal tracer advection
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the horizontal advection tendency for tracer
+!> based on current state and user choices of advection parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> 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) :: &
+ u !< Input: velocity
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h_edge !< Input: thickness at edge
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracers
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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
+!
+!> \brief Initializes ocean tracer horizontal advection quantities
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity advection in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_hadv_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Copied: branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv2.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv2.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv2.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv2.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,206 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_hadv2
+!
+!> \brief MPAS ocean horizontal tracer advection 2nd order
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> 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, &
+ ocn_tracer_hadv2_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: hadv2On
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_hadv2_tend
+!
+!> \brief Computes tendency term for horizontal tracer advection
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the horizontal advection tendency for tracer
+!> based on current state and user choices of advection parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_hadv2_tend(grid, u, h_edge, tracers , tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ u !< Input: velocity
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h_edge !< Input: thickness at edge
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracers
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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("compute_scalar_tend-horiz adv 2")
+
+ nEdges = grid % nEdges
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ dvEdge => grid % dvEdge % array
+ areaCell => 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("compute_scalar_tend-horiz adv 2")
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_hadv2_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_hadv2_init
+!
+!> \brief Initializes ocean tracer horizontal advection quantities
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity advection in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_hadv2_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv3.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv3.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv3.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv3.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,254 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_hadv3
+!
+!> \brief MPAS ocean horizontal tracer advection 3rd order
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> 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, &
+ ocn_tracer_hadv3_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: hadv3On
+ real (kind=RKIND) :: coef_3rd_order
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_hadv3_tend
+!
+!> \brief Computes tendency term for horizontal tracer advection
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the horizontal advection tendency for tracer
+!> based on current state and user choices of advection parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_hadv3_tend(grid, u, h_edge, tracers , tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ u !< Input: velocity
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h_edge !< Input: thickness at edge
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracers
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iEdge, nEdges, cell1, cell2, iTracer, num_tracers, i, k
+
+ integer, dimension(:), pointer :: maxLevelEdgeTop, nEdgesOnCell
+ 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.hadv3On) return
+
+ nEdges = grid % nEdges
+ num_tracers = size(tracers, dim=1)
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ nEdgesOnCell => grid % nEdgesOnCell % array
+ boundaryCell => grid % boundaryCell % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ cellsOnCell => grid % cellsOnCell % array
+ dvEdge => grid % dvEdge % array
+ dcEdge => grid % dcEdge % array
+ areaCell => grid % areaCell % array
+ deriv_two => grid % deriv_two % array
+
+ call timer_start("compute_scalar_tend-horiz adv 3")
+ 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 + &
+ 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 + &
+ deriv_two(i+1,2,iEdge) * tracers(iTracer,k,cellsOnCell(i,cell2))
+ end do
+
+ endif
+
+ !-- if u > 0:
+ if (u(k,iEdge) > 0) then
+ flux = dvEdge(iEdge) * u(k,iEdge) * h_edge(k,iEdge) * ( &
+ 0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2)) &
+ -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
+ -(dcEdge(iEdge) **2) * coef_3rd_order*(d2fdx2_cell1 - d2fdx2_cell2) / 12. )
+ !-- else u <= 0:
+ else
+ flux = dvEdge(iEdge) * u(k,iEdge) * h_edge(k,iEdge) * ( &
+ 0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2)) &
+ -(dcEdge(iEdge) **2) * (d2fdx2_cell1 + d2fdx2_cell2) / 12. &
+ +(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("compute_scalar_tend-horiz adv 3")
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_hadv3_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_hadv3_init
+!
+!> \brief Initializes ocean tracer horizontal advection quantities
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity advection in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_hadv3_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv4.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHadv4.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv4.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hadv4.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,239 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_hadv4
+!
+!> \brief MPAS ocean horizontal tracer advection 4th order
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> 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, &
+ ocn_tracer_hadv4_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: hadv4On
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_hadv4_tend
+!
+!> \brief Computes tendency term for horizontal tracer advection
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the horizontal advection tendency for tracer
+!> based on current state and user choices of advection parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_hadv4_tend(grid, u, h_edge, tracers , tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ u !< Input: velocity
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h_edge !< Input: thickness at edge
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracers
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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 => grid % maxLevelEdgeTop % array
+ boundaryCell => grid % boundaryCell % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ cellsOnCell => grid % cellsOnCell % array
+ dvEdge => grid % dvEdge % array
+ dcEdge => grid % dcEdge % array
+ areaCell => grid % areaCell % array
+ deriv_two => grid % deriv_two % array
+
+ call timer_start("compute_scalar_tend-horiz adv 4")
+
+ 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 + &
+ 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 + &
+ 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) * ( &
+ 0.5*(tracers(iTracer,k,cell1) + tracers(iTracer,k,cell2)) &
+ -(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("compute_scalar_tend-horiz adv 4")
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_hadv4_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_hadv4_init
+!
+!> \brief Initializes ocean tracer horizontal advection quantities
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity advection in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_hadv4_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHmix.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,174 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_hmix
+!
+!> \brief MPAS ocean horizontal tracer mixing driver
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> horizontal mixing tendencies.
+!>
+!> 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, &
+ ocn_tracer_hmix_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_hmix_tend
+!
+!> \brief Computes tendency term for horizontal tracer mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the horizontal mixing tendency for tracer
+!> based on current state and user choices of mixing parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_hmix_tend(grid, h_edge, tracers, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h_edge !< Input: thickness at edge
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracer quantities
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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
+!
+!> \brief Initializes ocean tracer horizontal mixing quantities
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity mixing in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_hmix_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix_del2.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHmixDel2.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix_del2.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix_del2.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,232 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_hmix_del2
+!
+!> \brief MPAS ocean horizontal tracer mixing driver
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> horizontal mixing tendencies.
+!>
+!> 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, &
+ ocn_tracer_hmix_del2_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: del2On
+
+ real (kind=RKIND) :: eddyDiff2
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_hmix_del2_tend
+!
+!> \brief Computes laplacian tendency term for horizontal tracer mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the horizontal mixing tendency for tracers
+!> 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) :: &
+ h_edge !< Input: thickness at edge
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracer quantities
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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("compute_scalar_tend-horiz diff 2")
+
+ nEdges = grid % nEdges
+ nVertLevels = grid % nVertLevels
+ num_tracers = size(tracers, dim=1)
+
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ boundaryEdge => grid % boundaryEdge % array
+ areaCell => grid % areaCell % array
+ dvEdge => grid % dvEdge % array
+ dcEdge => grid % dcEdge % array
+ meshScalingDel2 => 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 &
+ *( tracers(iTracer,k,cell2) &
+ - 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) &
+ * 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("compute_scalar_tend-horiz diff 2")
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_hmix_del2_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_hmix_del2_init
+!
+!> \brief Initializes ocean tracer horizontal mixing quantities
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> 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
+
+ err = 0
+
+ del2on = .false.
+
+ if ( config_h_tracer_eddy_diff2 > 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix_del4.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerHmixDel4.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix_del4.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_hmix_del4.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,263 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_hmix_del4
+!
+!> \brief MPAS ocean horizontal tracer mixing driver
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> horizontal mixing tendencies.
+!>
+!> 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, &
+ ocn_tracer_hmix_del4_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: Del4On
+
+ real (kind=RKIND) :: eddyDiff4
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_hmix_del4_tend
+!
+!> \brief Computes biharmonic tendency term for horizontal tracer mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the horizontal mixing tendency for tracers
+!> 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) :: &
+ h_edge !< Input: thickness at edge
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracer quantities
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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("compute_scalar_tend-horiz diff 4")
+
+ nEdges = grid % nEdges
+ nCells = grid % nCells
+ num_tracers = size(tracers, dim=1)
+ nVertLevels = grid % nVertLevels
+
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelCell => grid % maxLevelCell % array
+ boundaryEdge => grid % boundaryEdge % array
+ cellsOnEdge => grid % cellsOnEdge % array
+
+ dcEdge => grid % dcEdge % array
+ dvEdge => grid % dvEdge % array
+ areaCell => grid % areaCell % array
+ meshScalingDel4 => 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) &
+ + 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) &
+ - 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,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 &
+ *( delsq_tracer(iTracer,k,cell2) &
+ - delsq_tracer(iTracer,k,cell1))/dcEdge(iEdge)
+ flux = dvEdge (iEdge) * tracer_turb_flux
+
+ tend(iTracer,k,cell1) = tend(iTracer,k,cell1) &
+ - flux * invAreaCell1 * boundaryMask(k,iEdge)
+ tend(iTracer,k,cell2) = tend(iTracer,k,cell2) &
+ + flux * invAreaCell2 * boundaryMask(k,iEdge)
+
+ enddo
+ enddo
+ end do
+
+ deallocate(delsq_tracer)
+ call timer_stop("compute_scalar_tend-horiz diff 4")
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_hmix_del4_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_hmix_del4_init
+!
+!> \brief Initializes ocean tracer horizontal mixing quantities
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> 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
+
+ err = 0
+ Del4on = .false.
+
+ if ( config_h_tracer_eddy_diff4 > 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadv.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,185 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_vadv
+!
+!> \brief MPAS ocean vertical tracer advection driver
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> 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, &
+ ocn_tracer_vadv_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: vadvOn
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_vadv_tend
+!
+!> \brief Computes tendency term for vertical tracer advection
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical advection tendency for tracer
+!> based on current state and user choices of advection parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_tend(grid, wTop, tracers, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ wTop !< Input: vertical velocity in top layer
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracers
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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
+!
+!> \brief Initializes ocean tracer vertical advection quantities
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity advection in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvSpline.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,186 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_vadv_spline
+!
+!> \brief MPAS ocean vertical tracer advection driver
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> 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, &
+ ocn_tracer_vadv_spline_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: splineOn
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_vadv_spline_tend
+!
+!> \brief Computes tendency term for vertical tracer advection
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical advection tendency for tracer
+!> based on current state and user choices of advection parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_spline_tend(grid, wTop, tracers, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ wTop !< Input: vertical velocity in top layer
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracers
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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
+!
+!> \brief Initializes ocean tracer vertical advection quantities
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity advection in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_spline_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ integer :: err1, err2
+
+ splineOn = .false.
+
+ if(config_vert_tracer_adv.eq.'spline') then
+ splineOn = .true.
+
+ call ocn_tracer_vadv_spline2_init(err2)
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvSpline2.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline2.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,220 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_vadv_spline2
+!
+!> \brief MPAS ocean vertical tracer advection driver
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> 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, &
+ ocn_tracer_vadv_spline2_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: spline2On
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_vadv_spline2_tend
+!
+!> \brief Computes tendency term for vertical tracer advection
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical advection tendency for tracer
+!> based on current state and user choices of advection parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_spline2_tend(grid, wTop, tracers, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ wTop !< Input: vertical velocity in top layer
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracers
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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("compute_scalar_tend-vert adv spline 2")
+
+ nCells = grid % nCells
+ nCellsSolve = grid % nCellsSolve
+ nVertLevels = grid % nVertLevels
+ num_tracers = size(tracers, 1)
+ maxLevelCell => grid % maxLevelCell % array
+
+ hRatioZLevelK => grid % hRatioZLevelK % array
+ hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
+
+ allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
+
+ do iCell=1,nCellsSolve
+ 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) = &
+ hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
+ + 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) &
+ - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
+ - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
+ end do
+ end do
+ end do
+
+ deallocate(tracerTop)
+
+ call timer_stop("compute_scalar_tend-vert adv spline 2")
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_vadv_spline2_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_vadv_spline2_init
+!
+!> \brief Initializes ocean tracer vertical advection quantities
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity advection in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_spline2_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvSpline3.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_spline3.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,249 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_vadv_spline3
+!
+!> \brief MPAS ocean vertical tracer advection driver
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> 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, &
+ ocn_tracer_vadv_spline3_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: spline3On
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_vadv_spline3_tend
+!
+!> \brief Computes tendency term for vertical tracer advection
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical advection tendency for tracer
+!> based on current state and user choices of advection parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_spline3_tend(grid, wTop, tracers, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ wTop !< Input: vertical velocity in top layer
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracers
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell, nCells, nCellsSolve, k, iTracer, num_tracers, nVertLevels
+
+ integer, dimension(:), pointer :: maxLevelCell
+
+ real (kind=RKIND), dimension(:), pointer :: hRatioZLevelK, &
+ hRatioZLevelKm1, zTopZLevel, zMidZLevel
+
+ real (kind=RKIND), dimension(:), allocatable :: tracer2ndDer, &
+ 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("compute_scalar_tend-vert adv spline 3")
+
+ nCells = grid % nCells
+ nCellsSolve = grid % nCellsSolve
+ nVertLevels = grid % nVertLevels
+ num_tracers = size(tracers, 1)
+ maxLevelCell => grid % maxLevelCell % array
+
+ hRatioZLevelK => grid % hRatioZLevelK % array
+ hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
+ zMidZLevel => grid % zMidZLevel % array
+ zTopZLevel => grid % zTopZLevel % array
+
+ allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
+
+ ! Compute tracerTop using cubic spline interpolation.
+
+ allocate(tracer2ndDer(nVertLevels))
+ allocate(tracersIn(nVertLevels),tracersOut(nVertLevels), &
+ posZMidZLevel(nVertLevels), posZTopZLevel(nVertLevels-1))
+
+ ! 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, &
+ tracersIn, maxLevelCell(iCell), tracer2ndDer)
+
+ call InterpolateCubicSpline( &
+ posZMidZLevel, tracersIn, tracer2ndDer, maxLevelCell(iCell), &
+ 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) &
+ - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
+ - 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("compute_scalar_tend-vert adv spline 3")
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_vadv_spline3_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_vadv_spline3_init
+!
+!> \brief Initializes ocean tracer vertical advection quantities
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity advection in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_spline3_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,191 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_vadv_stencil
+!
+!> \brief MPAS ocean vertical tracer advection driver
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> 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, &
+ ocn_tracer_vadv_stencil_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: stencilOn
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_vadv_stencil_tend
+!
+!> \brief Computes tendency term for vertical tracer advection
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical advection tendency for tracer
+!> based on current state and user choices of advection parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_stencil_tend(grid, wTop, tracers, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ wTop !< Input: vertical velocity in top layer
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracers
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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
+!
+!> \brief Initializes ocean tracer vertical advection quantities
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity advection in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_stencil_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil2.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil2.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,218 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_vadv_stencil2
+!
+!> \brief MPAS ocean vertical tracer advection driver
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> 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, &
+ ocn_tracer_vadv_stencil2_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: stencil2On
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_vadv_stencil2_tend
+!
+!> \brief Computes tendency term for vertical tracer advection
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical advection tendency for tracer
+!> based on current state and user choices of advection parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_stencil2_tend(grid, wTop, tracers, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ wTop !< Input: vertical velocity in top layer
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracers
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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("compute_scalar_tend-vert adv stencil 2")
+
+ nCells = grid % nCells
+ nCellsSolve = grid % nCellsSolve
+ num_tracers = size(tracers, 1)
+ nVertLevels = grid % nVertLevels
+ maxLevelCell => 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) = &
+ ( tracers(iTracer,k-1,iCell) &
+ +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) &
+ - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
+ - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
+ end do
+ end do
+ end do
+
+ deallocate(tracerTop)
+ call timer_stop("compute_scalar_tend-vert adv stencil 2")
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_vadv_stencil2_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_vadv_stencil2_init
+!
+!> \brief Initializes ocean tracer vertical advection quantities
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity advection in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_stencil2_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil3.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil3.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,239 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_vadv_stencil3
+!
+!> \brief MPAS ocean vertical tracer advection driver
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> 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, &
+ ocn_tracer_vadv_stencil3_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: stencil3On
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_vadv_stencil3_tend
+!
+!> \brief Computes tendency term for vertical tracer advection
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical advection tendency for tracer
+!> based on current state and user choices of advection parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_stencil3_tend(grid, wTop, tracers, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ wTop !< Input: vertical velocity in top layer
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracers
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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 => grid % maxLevelCell % array
+ hRatioZLevelK => grid % hRatioZLevelK % array
+ hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
+
+ call timer_start("compute_scalar_tend-vert adv stencil 3")
+
+ 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) = &
+ hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
+ + 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) = &
+ ( (-1.+ cSignWTop)*tracers(iTracer,k-2,iCell) &
+ +( 7.-3.*cSignWTop)*tracers(iTracer,k-1,iCell) &
+ +( 7.+3.*cSignWTop)*tracers(iTracer,k ,iCell) &
+ +(-1.- cSignWTop)*tracers(iTracer,k+1,iCell) &
+ )/12.
+ end do
+ end do
+ k=maxLevelCell(iCell)
+ do iTracer=1,num_tracers
+ tracerTop(iTracer,k,iCell) = &
+ hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
+ + hRatioZLevelKm1(k)*tracers(iTracer,k ,iCell)
+ 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) &
+ - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
+ - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
+ end do
+ end do
+ end do
+
+ deallocate(tracerTop)
+ call timer_stop("compute_scalar_tend-vert adv stencil 3")
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_vadv_stencil3_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_vadv_stencil3_init
+!
+!> \brief Initializes ocean tracer vertical advection quantities
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity advection in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_stencil3_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnTracerVadvStencil4.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_tracer_vadv_stencil4.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,234 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_tracer_vadv_stencil4
+!
+!> \brief MPAS ocean vertical tracer advection driver
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> 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, &
+ ocn_tracer_vadv_stencil4_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: stencil4On
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_tracer_vadv_stencil4_tend
+!
+!> \brief Computes tendency term for vertical tracer advection
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical advection tendency for tracer
+!> based on current state and user choices of advection parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_stencil4_tend(grid, wTop, tracers, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ wTop !< Input: vertical velocity in top layer
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracers
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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("compute_scalar_tend-vert adv stencil 4")
+
+ nCells = grid % nCells
+ nCellsSolve = grid % nCellsSolve
+ num_tracers = size(tracers, 1)
+ nVertLevels = grid % nVertLevels
+ maxLevelCell => grid % maxLevelCell % array
+ hRatioZLevelK => grid % hRatioZLevelK % array
+ hRatioZLevelKm1 => grid % hRatioZLevelKm1 % array
+
+ allocate(tracerTop(num_tracers,nVertLevels+1,nCells))
+
+ ! 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) = &
+ hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
+ + hRatioZLevelKm1(k)*tracers(iTracer,k ,iCell)
+ end do
+ do k=3,maxLevelCell(iCell)-1
+ do iTracer=1,num_tracers
+ tracerTop(iTracer,k,iCell) = &
+ (- tracers(iTracer,k-2,iCell) &
+ +7.*tracers(iTracer,k-1,iCell) &
+ +7.*tracers(iTracer,k ,iCell) &
+ - tracers(iTracer,k+1,iCell) &
+ )/12.
+ end do
+ end do
+ k=maxLevelCell(iCell)
+ do iTracer=1,num_tracers
+ tracerTop(iTracer,k,iCell) = &
+ hRatioZLevelK(k) *tracers(iTracer,k-1,iCell) &
+ + hRatioZLevelKm1(k)*tracers(iTracer,k ,iCell)
+ 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) &
+ - ( wTop(k ,iCell)*tracerTop(iTracer,k ,iCell) &
+ - wTop(k+1,iCell)*tracerTop(iTracer,k+1,iCell))
+ end do
+ end do
+ end do
+
+ deallocate(tracerTop)
+ call timer_stop("compute_scalar_tend-vert adv stencil 4")
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_vadv_stencil4_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_vadv_stencil4_init
+!
+!> \brief Initializes ocean tracer vertical advection quantities
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity advection in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vadv_stencil4_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_coriolis.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnVelCoriolis.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_coriolis.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_coriolis.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,185 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_vel_coriolis
+!
+!> \brief MPAS ocean horizontal momentum mixing driver
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the routine for computing
+!> tendencies from the coriolis force.
+!>
+!
+!-----------------------------------------------------------------------
+
+module ocn_vel_coriolis
+
+ use grid_types
+ use configure
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_vel_coriolis_tend, &
+ ocn_vel_coriolis_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_vel_coriolis_tend
+!
+!> \brief Computes tendency term for coriolis force
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the coriolis tendency for momentum
+!> 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) :: &
+ pv_edge, h_edge, u, ke
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< 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 => grid % maxLevelEdgeTop % array
+ nEdgesOnEdge => grid % nEdgesOnEdge % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ edgesOnEdge => grid % edgesOnEdge % array
+ weightsOnEdge => grid % weightsOnEdge % array
+ dcEdge => 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) &
+ + q &
+ - ( ke(k,cell2) - ke(k,cell1) ) / dcEdge(iEdge)
+
+ end do
+ end do
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_vel_coriolis_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_vel_coriolis_init
+!
+!> \brief Initializes ocean momentum horizontal mixing quantities
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity mixing in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_coriolis_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! Output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ err = 0
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_vel_coriolis_init!}}}
+
+!***********************************************************************
+
+end module ocn_vel_coriolis
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
Copied: branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnVelForcing.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,180 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_vel_forcing
+!
+!> \brief MPAS ocean forcing driver
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> 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, &
+ ocn_vel_forcing_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_vel_forcing_tend
+!
+!> \brief Computes tendency term from forcings
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the forcing tendency for momentum
+!> based on current state and user choices of forcings.
+!> Multiple forcings may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen forcing, so this routine is primarily a
+!> 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) :: &
+ u !< Input: velocity
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ u_src !< Input: wind stress
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ ke_edge !< Input: kinetic energy at edge
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h_edge !< Input: thickness at edge
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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
+!
+!> \brief Initializes ocean forcings
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes quantities related to forcings
+!> in the ocean. Since a multiple forcings are available,
+!> this routine primarily calls the
+!> individual init routines for each forcing.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_forcing_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnVelForcingBottomDrag.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing_bottomdrag.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,201 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_vel_forcing_bottomdrag
+!
+!> \brief MPAS ocean bottom drag
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the routine for computing
+!> 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, &
+ ocn_vel_forcing_bottomdrag_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: bottomDragOn
+ real (kind=RKIND) :: bottomDragCoef
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_vel_forcing_bottomdrag_tend
+!
+!> \brief Computes tendency term from bottom drag
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the bottom drag tendency for momentum
+!> 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) :: &
+ u !< Input: velocity
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ ke_edge !< Input: kinetic energy at edge
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h_edge !< Input: thickness at edge
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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 => 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>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) &
+ -bottomDragCoef*u(k,iEdge) &
+ *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
+!
+!> \brief Initializes ocean bottom drag
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes quantities related to bottom drag
+!> in the ocean.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_forcing_bottomdrag_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing_windstress.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnVelForcingWindStress.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing_windstress.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_forcing_windstress.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,190 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_vel_forcing_windstress
+!
+!> \brief MPAS ocean wind stress
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the routine for computing
+!> 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, &
+ ocn_vel_forcing_windstress_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: windStressOn
+ real (kind=RKIND) :: rho_ref
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_vel_forcing_windstress_tend
+!
+!> \brief Computes tendency term from wind stress
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the wind stress tendency for momentum
+!> 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) :: &
+ u_src !< Input: wind stress
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h_edge !< Input: thickness at edge
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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 => 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>0) then
+ ! forcing in top layer only
+ tend(1,iEdge) = tend(1,iEdge) &
+ + 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
+!
+!> \brief Initializes ocean wind stress forcing
+!> \author Doug Jacobsen
+!> \date 16 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes quantities related to wind stress
+!> in the ocean.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_forcing_windstress_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnVelHmix.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,175 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_vel_hmix
+!
+!> \brief MPAS ocean horizontal momentum mixing driver
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the main driver routine for computing
+!> horizontal mixing tendencies.
+!>
+!> 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, &
+ ocn_vel_hmix_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_vel_hmix_tend
+!
+!> \brief Computes tendency term for horizontal momentum mixing
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the horizontal mixing tendency for momentum
+!> based on current state and user choices of mixing parameterization.
+!> Multiple parameterizations may be chosen and added together. These
+!> tendencies are generally computed by calling the specific routine
+!> for the chosen parameterization, so this routine is primarily a
+!> driver for managing these choices.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_hmix_tend(grid, divergence, vorticity, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ divergence !< Input: velocity divergence
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ vorticity !< Input: vorticity
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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
+!
+!> \brief Initializes ocean momentum horizontal mixing quantities
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> horizontal velocity mixing in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_hmix_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix_del2.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnVelHmixDel2.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix_del2.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix_del2.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,225 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_vel_hmix_del2
+!
+!> \brief Ocean horizontal mixing - Laplacian parameterization
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains routines for computing horizontal mixing
+!> 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, &
+ ocn_vel_hmix_del2_init
+
+ !-------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: &
+ hmixDel2On !< local flag to determine whether del2 chosen
+
+ real (kind=RKIND) :: &
+ eddyVisc2, &!< base eddy diffusivity for Laplacian
+ viscVortCoef
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_vel_hmix_del2_tend
+!
+!> \brief Computes tendency term for Laplacian horizontal momentum mixing
+!> \author Phil Jones, Doug Jacobsen
+!> \date 22 August 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the horizontal mixing tendency for momentum
+!> based on a Laplacian form for the mixing, </font>
<font color="black">u_2 </font>
<font color="blue">abla^2 u
+!> This tendency takes the
+!> form </font>
<font color="black">u( </font>
<font color="black">abla divergence + k \times </font>
<font color="blue">abla vorticity ),
+!> where </font>
<font color="blue">u is a viscosity and k is the vertical unit vector.
+!> This form is strictly only valid for constant </font>
<font color="blue">u .
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_hmix_del2_tend(grid, divergence, vorticity, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ divergence !< Input: velocity divergence
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ vorticity !< Input: vorticity
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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, &
+ dcEdge, dvEdge
+
+ !-----------------------------------------------------------------
+ !
+ ! exit if this mixing is not selected
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ if(.not.hmixDel2On) return
+
+ call timer_start("compute_tend_u-horiz mix-del2")
+
+ nEdgesSolve = grid % nEdgesSolve
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ verticesOnEdge => grid % verticesOnEdge % array
+ meshScalingDel2 => grid % meshScalingDel2 % array
+ dcEdge => grid % dcEdge % array
+ dvEdge => 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) &
+ -viscVortCoef &
+ *( 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("compute_tend_u-horiz mix-del2")
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_vel_hmix_del2_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_vel_hmix_del2_init
+!
+!> \brief Initializes ocean momentum Laplacian horizontal mixing
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> Laplacian horizontal momentum mixing in the ocean.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_hmix_del2_init(err)!{{{
+
+
+ integer, intent(out) :: err
+
+ !--------------------------------------------------------------------
+ !
+ ! set some local module variables based on input config choices
+ !
+ !--------------------------------------------------------------------
+
+ err = 0
+
+ hmixDel2On = .false.
+
+ if ( config_h_mom_eddy_visc2 > 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/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix_del4.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnVelHmixDel4.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix_del4.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_hmix_del4.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,300 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_vel_hmix_del4
+!
+!> \brief Ocean horizontal mixing - biharmonic parameterization
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains routines and variables for computing
+!> 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, &
+ ocn_vel_hmix_del4_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: &
+ hmixDel4On !< local flag to determine whether del4 chosen
+
+ real (kind=RKIND) :: &
+ eddyVisc4, &!< base eddy diffusivity for biharmonic
+ viscVortCoef
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_vel_hmix_del4_tend
+!
+!> \brief Computes tendency term for biharmonic horizontal momentum mixing
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the horizontal mixing tendency for momentum
+!> based on a biharmonic form for the mixing. This mixing tendency
+!> takes the form -</font>
<font color="black">u_4 </font>
<font color="blue">abla^4 u
+!> but is 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.
+!> This formulation is only valid for constant </font>
<font color="blue">u_4 .
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_hmix_del4_tend(grid, divergence, vorticity, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ divergence !< Input: velocity divergence
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ vorticity !< Input: vorticity
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iEdge, nEdges, cell1, cell2, vertex1, vertex2, k
+ integer :: iCell, iVertex
+ integer :: nVertices, nVertLevels, nCells
+
+ integer, dimension(:), pointer :: maxLevelEdgeTop, maxLevelVertexBot, &
+ maxLevelCell
+ integer, dimension(:,:), pointer :: cellsOnEdge, verticesOnEdge
+
+
+ real (kind=RKIND) :: u_diffusion, r
+ real (kind=RKIND), dimension(:), pointer :: dcEdge, dvEdge, areaTriangle, &
+ meshScalingDel4, areaCell
+
+ real (kind=RKIND), dimension(:,:), allocatable :: delsq_divergence, &
+ delsq_u, delsq_circulation, delsq_vorticity
+
+ err = 0
+
+ if(.not.hmixDel4On) return
+
+ call timer_start("compute_tend-horiz mix-del4")
+
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+ nVertices = grid % nVertices
+ nVertLevels = grid % nVertLevels
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelVertexBot => grid % maxLevelVertexBot % array
+ maxLevelCell => grid % maxLevelCell % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ verticesOnEdge => grid % verticesOnEdge % array
+ dcEdge => grid % dcEdge % array
+ dvEdge => grid % dvEdge % array
+ areaTriangle => grid % areaTriangle % array
+ areaCell => grid % areaCell % array
+ meshScalingDel4 => 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) = &
+ ( divergence(k,cell2) - divergence(k,cell1) ) / dcEdge(iEdge) &
+ -viscVortCoef &
+ *( 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) &
+ - dcEdge(iEdge) * delsq_u(k,iEdge)
+ delsq_circulation(k,vertex2) = delsq_circulation(k,vertex2) &
+ + 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) &
+ + 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,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) = &
+ ( divergence(k,cell2) - divergence(k,cell1) ) / dcEdge(iEdge) &
+ -( vorticity(k,vertex2) - vorticity(k,vertex1)) / dvEdge(iEdge)
+
+ u_diffusion = ( delsq_divergence(k,cell2) &
+ - delsq_divergence(k,cell1) ) / dcEdge(iEdge) &
+ -viscVortCoef &
+ *( delsq_vorticity(k,vertex2) &
+ - 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("compute_tend-horiz mix-del4")
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_vel_hmix_del4_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_vel_hmix_del4_init
+!
+!> \brief Initializes ocean momentum biharmonic horizontal mixing
+!> \author Phil Jones, Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> biharmonic horizontal tracer mixing in the ocean.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_hmix_del4_init(err)!{{{
+
+ integer, intent(out) :: err
+
+ !--------------------------------------------------------------------
+ !
+ ! set some local module variables based on input config choices
+ !
+ !--------------------------------------------------------------------
+
+ err = 0
+
+ hmixDel4On = .false.
+
+ if ( config_h_mom_eddy_visc4 > 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/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_pressure_grad.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnVelPressureGrad.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_pressure_grad.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_pressure_grad.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,195 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_vel_pressure_grad
+!
+!> \brief MPAS ocean pressure gradient module
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the routine for computing
+!> tendencie from the horizontal pressure gradient.
+!>
+!
+!-----------------------------------------------------------------------
+
+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, &
+ ocn_vel_pressure_grad_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ real (kind=RKIND) :: rho0Inv
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_vel_pressure_grad_tend
+!
+!> \brief Computes tendency term for horizontal pressure gradient
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the pressure gradient tendency for momentum
+!> based on current state.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_pressure_grad_tend(grid, pressure, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ pressure !< Input: Pressure field or Mongomery potential
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< 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 => grid % maxLevelEdgeTop % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ dcEdge => 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) &
+ - (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) &
+ - rho0Inv*( pressure(k,cell2) &
+ - pressure(k,cell1) )/dcEdge(iEdge)
+ end do
+
+ enddo
+ endif
+
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_vel_pressure_grad_tend!}}}
+
+!***********************************************************************
+!
+! routine ocn_vel_pressure_grad_init
+!
+!> \brief Initializes ocean momentum horizontal pressure gradient
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes parameters required for the computation of the
+!> horizontal pressure gradient.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_pressure_grad_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+
+ !-----------------------------------------------------------------
+ !
+ ! Output Variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< 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/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_vadv.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnVelVadv.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_vadv.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vel_vadv.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,193 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_vel_vadv
+!
+!> \brief MPAS ocean vertical advection
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the routine for computing
+!> tendencies for vertical advection.
+!>
+!
+!-----------------------------------------------------------------------
+
+module ocn_vel_vadv
+
+ use grid_types
+ use configure
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_vel_vadv_tend, &
+ ocn_vel_vadv_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: velVadvOn
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_vel_vadv_tend
+!
+!> \brief Computes tendency term for vertical advection
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical advection tendency for momentum
+!> based on current state.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_vadv_tend(grid, u, wTop, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ u, wTop
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tend !< Input/Output: velocity tendency
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< 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 => grid % maxLevelEdgeTop % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ zMidZLevel => 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)) &
+ / (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) &
+ - 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
+!
+!> \brief Initializes ocean momentum vertical advection
+!> \author Doug Jacobsen
+!> \date 15 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity advection in the ocean.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_vadv_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! Output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnVmix.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,724 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_vmix
+!
+!> \brief MPAS ocean vertical mixing driver
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module is the main driver for
+!> vertical mixing in the ocean.
+!>
+!
+!-----------------------------------------------------------------------
+
+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, &
+ tridiagonal_solve_mult
+
+ public :: ocn_vmix_coefs, &
+ ocn_vel_vmix_tend_explicit, &
+ ocn_tracer_vmix_tend_explicit, &
+ ocn_vel_vmix_tend_implicit, &
+ ocn_tracer_vmix_tend_implicit, &
+ ocn_vmix_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: explicitOn, implicitOn
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_vmix_coefs
+!
+!> \brief Computes coefficients for vertical mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical mixing coefficients for momentum
+!> and tracers based user choices of mixing parameterization.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vmix_coefs(grid, s, d, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (state_type), intent(inout) :: &
+ s !< Input/Output: state information
+
+ type (diagnostics_type), intent(inout) :: &
+ d !< Input/Output: diagnostic information
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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
+!
+!> \brief Computes tendencies for explict momentum vertical mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the tendencies for explicit vertical mixing for momentum
+!> using computed coefficients.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vel_vmix_tend_explicit(grid, u, h_edge, vertViscTopOfEdge, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ u !< Input: velocity
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h_edge !< Input: thickness at edge
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ vertViscTopOfEdge !< Input: vertical mixing coefficients
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ tend !< Input/Output: tendency information
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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("compute_tend_u-explicit vert mix")
+
+ nEdgessolve = grid % nEdgesSolve
+ nVertLevels = grid % nVertLevels
+ maxLevelEdgeTop => 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) &
+ * ( u(k-1,iEdge) - u(k,iEdge) ) &
+ * 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) &
+ + (fluxVertTop(k) - fluxVertTop(k+1)) &
+ / h_edge(k,iEdge)
+ enddo
+
+ end do
+ deallocate(fluxVertTop)
+
+ call timer_stop("compute_tend_u-explicit vert mix")
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_vel_vmix_tend_explicit!}}}
+
+!***********************************************************************
+!
+! routine ocn_vel_vmix_tend_implicit
+!
+!> \brief Computes tendencies for implicit momentum vertical mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the tendencies for implicit vertical mixing for momentum
+!> 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) :: &
+ grid !< Input: grid information
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ ke_edge !< Input: kinetic energy at edge
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ vertViscTopOfEdge !< Input: vertical mixing coefficients
+
+ real (kind=RKIND), intent(in) :: &
+ dt !< Input: time step
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h !< Input: thickness at cell center
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ u !< Input: velocity
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: &
+ h_edge !< Input: thickness at edge
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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 => grid % maxLevelEdgeTop % array
+ cellsOnEdge => 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) &
+ / (h_edge(k,iEdge) + h_edge(k+1,iEdge)) &
+ / h_edge(k,iEdge)
+ enddo
+ A(maxLevelEdgeTop(iEdge)) = -dt*config_bottom_drag_coeff &
+ *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
+!
+!> \brief Computes tendencies for explict tracer vertical mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the tendencies for explicit vertical mixing for
+!> tracers using computed coefficients.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vmix_tend_explicit(grid, h, vertDiffTopOfCell, tracers, tend, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h !< Input: thickness at cell center
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ vertDiffTopOfCell !< Input: vertical mixing coefficients
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: &
+ tracers !< Input: tracers
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tend !< Input/Output: tendency information
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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("compute_scalar_tend-explicit vert diff")
+
+ nCellsSolve = grid % nCellsSolve
+ nVertLevels = grid % nVertLevels
+ num_tracers = size(tracers, dim=1)
+
+ maxLevelCell => 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) &
+ * ( tracers(iTracer,k-1,iCell) &
+ - tracers(iTracer,k ,iCell) ) &
+ * 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) &
+ + 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("compute_scalar_tend-explicit vert diff")
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_vmix_tend_explicit!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_vmix_tend_implicit
+!
+!> \brief Computes tendencies for implicit tracer vertical mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the tendencies for implicit vertical mixing for
+!> tracers using computed coefficients.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_tracer_vmix_tend_implicit(grid, dt, vertDiffTopOfCell, h, tracers, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ vertDiffTopOfCell !< Input: vertical mixing coefficients
+
+ real (kind=RKIND), intent(in) :: &
+ dt !< Input: time step
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h !< Input: thickness at cell center
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:,:), intent(inout) :: &
+ tracers !< Input: tracers
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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 => 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) &
+ / (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), &
+ 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
+!
+!> \brief Initializes ocean vertical mixing quantities
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical mixing in the ocean. This primarily determines if
+!> 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
+
+ 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("tridiagonal_solve")
+
+ ! 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("tridiagonal_solve")
+
+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("tridiagonal_solve_mult")
+
+ ! 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("tridiagonal_solve_mult")
+
+end subroutine tridiagonal_solve_mult!}}}
+
+!***********************************************************************
+
+end module ocn_vmix
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+
+! vim: foldmethod=marker
Copied: branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_const.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnVmixCoefsConst.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_const.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_const.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,306 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_vmix_coefs_const
+!
+!> \brief MPAS ocean vertical mixing coefficients
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the routines for computing
+!> constant vertical mixing coefficients.
+!>
+!
+!-----------------------------------------------------------------------
+
+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, &
+ ocn_tracer_vmix_coefs_const
+
+ public :: ocn_vmix_coefs_const_build, &
+ ocn_vmix_coefs_const_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: constViscOn, constDiffOn
+
+ real (kind=RKIND) :: constVisc, constDiff
+
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_vmix_coefs_const_build
+!
+!> \brief Computes coefficients for vertical mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical mixing coefficients for momentum
+!> 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) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (state_type), intent(inout) :: &
+ s !< Input/Output: state information
+
+ type (diagnostics_type), intent(inout) :: &
+ d !< Input/Output: diagnostic information
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: err1, err2
+
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ 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 => d % vertViscTopOfEdge % array
+ vertDiffTopOfCell => 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
+!
+!> \brief Computes coefficients for vertical momentum mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> 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) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(out) :: vertViscTopOfEdge
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ if(.not.constViscOn) return
+
+ vertViscTopOfEdge = constVisc
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_vel_vmix_coefs_const!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_vmix_coefs_const
+!
+!> \brief Computes coefficients for vertical tracer mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> 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) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(out) :: vertDiffTopOfCell
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ err = 0
+
+ if(.not.constDiffOn) return
+
+ vertDiffTopOfCell = constDiff
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_vmix_coefs_const!}}}
+
+
+!***********************************************************************
+!
+! routine ocn_vmix_coefs_const_init
+!
+!> \brief Initializes ocean momentum vertical mixing quantities
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity mixing in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+
+ subroutine ocn_vmix_coefs_const_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_rich.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnVmixCoefsRich.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_rich.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_rich.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,596 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_vmix_coefs_rich
+!
+!> \brief MPAS ocean vertical mixing coefficients
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the routines for computing
+!> richardson vertical mixing coefficients.
+!>
+!
+!-----------------------------------------------------------------------
+
+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, &
+ ocn_vmix_coefs_rich_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: richViscOn, richDiffOn
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_vmix_coefs_rich_build
+!
+!> \brief Computes coefficients for vertical mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical mixing coefficients for momentum
+!> 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) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (state_type), intent(inout) :: &
+ s !< Input/Output: state information
+
+ type (diagnostics_type), intent(inout) :: &
+ d !< Input/Output: diagnostic information
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: err1, err2, err3, indexT, indexS
+
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ 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 => d % vertViscTopOfEdge % array
+ vertDiffTopOfCell => d % vertDiffTopOfCell % array
+ RiTopOfEdge => d % RiTopOfEdge % array
+ RiTopOfCell => d % RiTopOfCell % array
+
+ u => s % u % array
+ h => s % h % array
+ h_edge => s % h_edge % array
+ rho => s % rho % array
+ rhoDisplaced => s % rhoDisplaced % array
+ tracers => s % tracers % array
+
+ call ocn_equation_of_state_rho(s, grid, 0, 'relative')
+ call ocn_equation_of_state_rho(s, grid, 1, 'relative')
+
+ call ocn_vmix_get_rich_numbers(grid, indexT, indexS, u, h, h_edge, &
+ 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
+!
+!> \brief Computes coefficients for vertical momentum mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> 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) :: &
+ grid !< Input: grid information
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h_edge !< Input: thickness at edge
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ RiTopOfEdge !< Richardson number at top of edge
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(out) :: vertViscTopOfEdge
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iEdge, nEdges, k
+
+ integer, dimension(:), pointer :: maxLevelEdgeTop
+
+ err = 0
+
+ if(.not.richViscOn) return
+
+ nEdges = grid % nEdges
+
+ maxLevelEdgeTop => 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)>0.0) then
+ vertViscTopOfEdge(k,iEdge) = config_bkrd_vert_visc &
+ + 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) > config_convective_visc) then
+ if( config_implicit_vertical_mix) then
+ vertViscTopOfEdge(k,iEdge) = config_convective_visc
+ else
+ vertViscTopOfEdge(k,iEdge) = &
+ ((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<0 and implicit mix, use convective diffusion
+ vertViscTopOfEdge(k,iEdge) = config_convective_visc
+ else
+ ! for Ri<0 and explicit vertical mix,
+ ! use maximum diffusion allowed by CFL criterion
+ ! mrp 110324 efficiency note: for z-level, could use fixed
+ ! grid array hMeanTopZLevel and compute maxdiff on startup.
+ vertViscTopOfEdge(k,iEdge) = &
+ ((h_edge(k-1,iEdge)+h_edge(k,iEdge))/2.0)**2/config_dt/4.0
+ end if
+ end if
+ end do
+ end do
+
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_vel_vmix_coefs_rich!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_vmix_coefs_rich
+!
+!> \brief Computes coefficients for vertical tracer mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> 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) :: &
+ grid !< Input: grid information
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ h !< Input: thickness at cell center
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: &
+ RiTopOfCell !< Input: Richardson number at top of cell
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(out) :: vertDiffTopOfCell
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iCell, nCells, k
+
+ integer, dimension(:), pointer :: maxLevelCell
+
+ real (kind=RKIND) :: coef
+
+ err = 0
+
+ if(.not.richDiffOn) return
+
+ nCells = grid % nCells
+
+ maxLevelCell => 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)>0.0) then
+ vertDiffTopOfCell(k,iCell) = config_bkrd_vert_diff &
+ + (config_bkrd_vert_visc &
+ + config_rich_mix / (1.0 + 5.0*RiTopOfCell(k,iCell))**2) &
+ / (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) > config_convective_diff) then
+ if (config_implicit_vertical_mix) then
+ vertDiffTopOfCell(k,iCell) = config_convective_diff
+ else
+ vertDiffTopOfCell(k,iCell) = &
+ ((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<0 and implicit mix, use convective diffusion
+ vertDiffTopOfCell(k,iCell) = config_convective_diff
+ else
+ ! for Ri<0 and explicit vertical mix,
+ ! use maximum diffusion allowed by CFL criterion
+ ! mrp 110324 efficiency note: for z-level, could use fixed
+ ! grid array hMeanTopZLevel and compute maxdiff on startup.
+ vertDiffTopOfCell(k,iCell) = &
+ ((h(k-1,iCell)+h(k,iCell))/2.0)**2/config_dt/4.0
+ end if
+ end if
+ end do
+ end do
+
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_vmix_coefs_rich!}}}
+
+!***********************************************************************
+!
+! routine ocn_vmix_get_rich_numbers
+!
+!> \brief Build richardson numbers for vertical mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine builds the arrays needed for richardson number vertical
+!> mixing coefficients.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_vmix_get_rich_numbers(grid, indexT, indexS, u, h, h_edge, & !{{{
+ rho, rhoDisplaced, tracers, RiTopOfEdge, RiTopOfCell, err)
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mesh_type), intent(in) :: &
+ grid !< Input: grid information
+
+ integer, intent(in) :: indexT, indexS
+
+ real (kind=RKIND), dimension(:,:), intent(in) :: u, h, h_edge
+
+ real (kind=RKIND), dimension(:,:,:), intent(in) :: tracers
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(inout) :: rho, rhoDisplaced, &
+ RiTopOfEdge, RiTopOfCell
+
+ integer, intent(inout) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! 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, &
+ drhoTopOfEdge, du2TopOfEdge
+
+ err = 0
+
+ if(.not.richViscOn .and. .not.richDiffOn) return
+
+ nVertLevels = grid % nVertLevels
+ nCells = grid % nCells
+ nEdges = grid % nEdges
+
+ maxLevelCell => grid % maxLevelCell % array
+ maxLevelEdgeTop => grid % maxLevelEdgeTop % array
+ maxLevelEdgeBot => grid % maxLevelEdgeBot % array
+ cellsOnEdge => grid % cellsOnEdge % array
+ dvEdge => grid % dvEdge % array
+ dcEdge => grid % dcEdge % array
+ areaCell => grid % areaCell % array
+
+ allocate( &
+ drhoTopOfCell(nVertLevels+1,nCells+1), drhoTopOfEdge(nVertLevels+1,nEdges+1), &
+ du2TopOfCell(nVertLevels+1,nCells+1), du2TopOfEdge(nVertLevels+1,nEdges+1))
+
+ ! 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, &
+! tracers, rho, err)
+ ! mrp 110324 In order to visualize rhoDisplaced, include the following
+! call OcnEquationOfStateRho(grid, 'relative', 1, indexT, indexS, &
+! 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) = &
+ (drhoTopOfCell(k,cell1) + &
+ 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) &
+ + 0.5 * dcEdge(iEdge) * dvEdge(iEdge) * du2TopOfEdge(k,iEdge)
+ du2TopOfCell(k,cell2) = du2TopOfCell(k,cell2) &
+ + 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) &
+ *(h_edge(k-1,iEdge)+h_edge(k,iEdge)) &
+ / (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) &
+ *(h(k-1,iCell)+h(k,iCell)) &
+ / (du2TopOfCell(k,iCell) + 1e-20)
+ end do
+ end do
+
+ deallocate(drhoTopOfCell, drhoTopOfEdge, &
+ du2TopOfCell, du2TopOfEdge)
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_vmix_get_rich_numbers!}}}
+
+!***********************************************************************
+!
+! routine ocn_vmix_coefs_rich_init
+!
+!> \brief Initializes ocean momentum vertical mixing quantities
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> vertical velocity mixing in the ocean. Since a variety of
+!> parameterizations are available, this routine primarily calls the
+!> individual init routines for each parameterization.
+!
+!-----------------------------------------------------------------------
+
+
+ subroutine ocn_vmix_coefs_rich_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F (from rev 1041, branches/ocean_projects/performance/src/core_ocean/module_OcnVmixCoefsTanh.F)
===================================================================
--- branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F (rev 0)
+++ branches/ocean_projects/performance/src/core_ocean/mpas_ocn_vmix_coefs_tanh.F 2011-09-29 20:46:51 UTC (rev 1042)
@@ -0,0 +1,329 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_vmix_coefs_tanh
+!
+!> \brief MPAS ocean vertical mixing coefficients
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id:$
+!> \details
+!> This module contains the routines for computing
+!> tanhant vertical mixing coefficients.
+!>
+!
+!-----------------------------------------------------------------------
+
+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, &
+ ocn_vmix_coefs_tanh_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: tanhViscOn, tanhDiffOn
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_vmix_coefs_tanh_build
+!
+!> \brief Computes coefficients for vertical mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the vertical mixing coefficients for momentum
+!> 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) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (state_type), intent(inout) :: &
+ s !< Input/Output: state information
+
+ type (diagnostics_type), intent(inout) :: &
+ d !< Input/Output: diagnostic information
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: err1, err2
+
+ real (kind=RKIND), dimension(:,:), pointer :: &
+ 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 => d % vertViscTopOfEdge % array
+ vertDiffTopOfCell => 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
+!
+!> \brief Computes coefficients for vertical momentum mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> 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) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(out) :: vertViscTopOfEdge
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: k, nVertLevels
+
+ real (kind=RKIND), dimension(:), pointer :: zTopZLevel
+
+ err = 0
+
+ if(.not.tanhViscOn) return
+
+ nVertLevels = grid % nVertLevels
+ zTopZLevel => grid % zTopZLevel % array
+
+ do k=1,nVertLevels+1
+ vertViscTopOfEdge(k,:) = -(config_max_visc_tanh-config_min_visc_tanh)/2.0 &
+ *tanh(-(zTopZLevel(k)-config_ZMid_tanh) &
+ /config_zWidth_tanh) &
+ + (config_max_visc_tanh+config_min_visc_tanh)/2
+ end do
+
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_vel_vmix_coefs_tanh!}}}
+
+!***********************************************************************
+!
+! routine ocn_tracer_vmix_coefs_tanh
+!
+!> \brief Computes coefficients for vertical tracer mixing
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> 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) :: &
+ grid !< Input: grid information
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ real (kind=RKIND), dimension(:,:), intent(out) :: vertDiffTopOfCell
+
+ integer, intent(out) :: err
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: k, nVertLevels
+
+ real (kind=RKIND), dimension(:), pointer :: zTopZLevel
+
+ err = 0
+
+ if(.not.tanhDiffOn) return
+
+ nVertLevels = grid % nVertLevels
+ zTopZLevel => grid % zTopZLevel % array
+
+ do k=1,nVertLevels+1
+ vertDiffTopOfCell(k,:) = -(config_max_diff_tanh-config_min_diff_tanh)/2.0 &
+ *tanh(-(zTopZLevel(k)-config_ZMid_tanh) &
+ /config_zWidth_tanh) &
+ + (config_max_diff_tanh+config_min_diff_tanh)/2
+ end do
+
+
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_tracer_vmix_coefs_tanh!}}}
+
+
+!***********************************************************************
+!
+! routine ocn_vmix_coefs_tanh_init
+!
+!> \brief Initializes ocean vertical mixing quantities
+!> \author Doug Jacobsen
+!> \date 19 September 2011
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes a variety of quantities related to
+!> tanh vertical mixing in the ocean.
+!
+!-----------------------------------------------------------------------
+
+
+ subroutine ocn_vmix_coefs_tanh_init(err)!{{{
+
+ !--------------------------------------------------------------------
+
+ !-----------------------------------------------------------------
+ !
+ ! call individual init routines for each parameterization
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err
+
+ 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', &
+ ' 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
</font>
</pre>