<p><b>qchen3@fsu.edu</b> 2013-03-07 15:29:57 -0700 (Thu, 07 Mar 2013)</p><p>BRANCH COMMIT<br>
<br>
Branch not working yet. This is just to sync across different development platforms.<br>
</p><hr noshade><pre><font color="gray">Modified: branches/ocean_projects/gm_implement/src/core_ocean/Registry
===================================================================
--- branches/ocean_projects/gm_implement/src/core_ocean/Registry 2013-03-07 22:25:14 UTC (rev 2561)
+++ branches/ocean_projects/gm_implement/src/core_ocean/Registry 2013-03-07 22:29:57 UTC (rev 2562)
@@ -372,3 +372,18 @@
% Sea surface pressure, for coupling
var persistent real seaSurfacePressure ( nCells Time ) 0 ir seaSurfacePressure mesh - -
+
+% Scratch variables
+var scratch real scratch_cell_var1 ( nVertLevels nCells ) 0 - scratch_cell_var1 scratch - -
+var scratch real scratch_cell_var2 ( nVertLevels nCells ) 0 - scratch_cell_var2 scratch - -
+var scratch real scratch_cell_var3 ( nVertLevels nCells ) 0 - scratch_cell_var3 scratch - -
+
+var scratch real scratch_edge_var1 ( nVertLevels nEdges ) 0 - scratch_edge_var1 scratch - -
+var scratch real scratch_edge_var2 ( nVertLevels nEdges ) 0 - scratch_edge_var2 scratch - -
+var scratch real scratch_edge_var3 ( nVertLevels nEdges ) 0 - scratch_edge_var3 scratch - -
+var scratch real scratch_edge_var4 ( nVertLevels nEdges ) 0 - scratch_edge_var3 scratch - -
+var scratch real scratch_edge_var5 ( nVertLevels nEdges ) 0 - scratch_edge_var3 scratch - -
+
+var scratch real scratch_vertex_var1 ( nVertLevels nVertices ) 0 - scratch_vertex_var1 scratch - -
+var scratch real scratch_vertex_var2 ( nVertLevels nVertices ) 0 - scratch_vertex_var2 scratch - -
+var scratch real scratch_vertex_var3 ( nVertLevels nVertices ) 0 - scratch_vertex_var3 scratch - -
Modified: branches/ocean_projects/gm_implement/src/core_ocean/mpas_ocn_gm.F
===================================================================
--- branches/ocean_projects/gm_implement/src/core_ocean/mpas_ocn_gm.F 2013-03-07 22:25:14 UTC (rev 2561)
+++ branches/ocean_projects/gm_implement/src/core_ocean/mpas_ocn_gm.F 2013-03-07 22:29:57 UTC (rev 2562)
@@ -30,24 +30,86 @@
contains
- subroutine ocn_gm_compute_uBolus(s, grid)!{{{
+ subroutine ocn_gm_compute_uBolus(s, grid, scratch)!{{{
implicit none
type(state_type), intent(inout) :: s
type(mesh_type), intent(in) :: grid
+ type(scratch_type), intent(inout) :: scratch
- real(kind=RKIND), dimension(:,:), pointer :: uBolusGM, hEddyFlux, h_edge
+ real(kind=RKIND), dimension(:,:), pointer :: rho, zMid, uBolusGM, hEddyFlux, h_edge, &
+ grad_rho, grad_rho_interface, rhoz_edge, rhoz, grad_zMid, grad_zMid_interface
integer, dimension(:), pointer :: maxLevelEdgeTop
integer :: k, iEdge, nEdges
+ real(kind=RKIND) :: h1, h2
- uBolusGM => s % uBolusGM % array
- h_edge => s % h_edge % array
- hEddyFlux => s % hEddyFlux % array
+ call mpas_allocate_scratch_field(sratch % scratch_edge_var1, .True.)
+ call mpas_allocate_scratch_field(sratch % scratch_edge_var2, .True.)
+ call mpas_allocate_scratch_field(sratch % scratch_edge_var3, .True.)
+ call mpas_allocate_scratch_field(sratch % scratch_edge_var4, .True.)
+ call mpas_allocate_scratch_field(sratch % scratch_edge_var5, .True.)
+ call mpas_allocate_scratch_field(sratch % scratch_cell_var1, .True.)
+ rho => s % rho % array
+ zMid => s % zMid % array
+ uBolusGM => s % uBolusGM % array
+ h_edge => s % h_edge % array
+ hEddyFlux => s % hEddyFlux % array
+ zMid => s % zMid % array
+ grad_rho => scratch % scratch_edge_var1 % array
+ grad_rho_interface => scratch % scratch_edge_var2 % array
+ rhoz_edge => scratch % scratch_edge_var3 % array
+ grad_zMid => scratch % scratch_edge_var4 % array
+ grad_zMid_interface => scratch % scratch_edge_var5 % array
+ rhoz => scratch % scratch_cell_var1 % array
+
maxLevelEdgeTop => grid % maxLevelEdgeTop % array
nEdges = grid % nEdges
+ ! Compute density gradient (grad_rho) and gradient of zMid (grad_zMid)
+ ! along the constant coordinate surface.
+ ! The computed variables lives at cell edge and layer center
+ do iEdge = 1, nEdges
+ cell1 = cellsOnEdge(1,iEdge)
+ cell2 = cellsOnEdge(2,iEdge)
+
+ do k=1,maxLevelEdgeTop(iEdge)
+ grad_rho(k,iEdge) = (rho(k,cell2) - rho(k,cell1)) / dcEdge(iEdge)
+ grad_zMid(k,iEdge) = (zMid(k,cell2) - zMid(k,cell1)) / dcEdge(iEdge)
+ end do
+ end do
+
+ ! Compute vertical derivative of density (rhoz) at cell center and layer interface
+ do iCell = 1, nCells
+ do k = 2, nVertLevelCell(iCell)
+ rhoz(k,iCell) = (rho(k-1,iCell) - rho(k,iCell)) / (zMid(k-1,iCell) - zMid(k,iCell))
+ end do
+ end do
+
+ ! Interpolate grad_rho and grad_zMid to layer interface
+ do iEdge = 1, nEdges
+ do k = 2, maxLevelEdgeTop(iEdge)
+ h1 = h_edge(k-1,iEdge)
+ h2 = h_edge(k,iEdge)
+
+ ! Using second-order interpolation below
+ grad_rho_interface(k,iEdge) = (h2 * grad_rho(k-1,iEdge) + h1 * grad_rho(k,iEdge)) / (h1 + h2)
+ grad_zMid_interface(k,iEdge) = (h2 * grad_zMid(k-1,iEdge) + h1 * grad_zMid(k,iEdge)) / (h1 + h2)
+
+ end do
+ end do
+
+ ! Interpolate rhoz to cell edge and layer interface
+ do iEdge = 1, nEdges
+ do k = 2, maxLevelEdgeTop(iEdge)
+ cell1 = cellsOnEdge(iEdge)
+ cell2 = cellsOnEdge(iEdge)
+ rhoz_edge(k,iEdge) = 0.5 * (rhoz(k,cell1) + rhoz(k,cell2))
+ end do
+ end do
+
+
call ocn_gm_compute_hEddyFlux(s, grid)
if (config_vert_coord_movement .EQ. 'isopycnal') then
@@ -65,8 +127,23 @@
end if
+ call mpas_deallocate_scratch_field(scratch % grad_rho, .True.)
+
end subroutine ocn_gm_compute_uBolus!}}}
+ subroutine ocn_gm_compute_slopeRelative(s, grid, scratch)
+ implicit none
+ type(state_type), intent(inout) :: s
+ type(mesh_type), intent(in) :: grid
+ type(scratch_type), intent(inout) :: scratch
+
+
+
+
+ end subroutine ocn_gm_compute_slopeRelative
+
+
+
subroutine ocn_gm_compute_hEddyFlux(s, grid)!{{{
implicit none
type(state_type), intent(inout) :: s
</font>
</pre>