<p><b>duda</b> 2010-03-26 11:29:45 -0600 (Fri, 26 Mar 2010)</p><p>BRANCH COMMIT<br>
<br>
Allocate fields to have one extra cell, edge, or vertex at array<br>
index nCells+1, nEdges+1, or nVertices+1. This extra<br>
cell/edge/vertex gives us a dummy cell/edge/vertex that may be<br>
used to (1) remove if-tests of the form "if (iCell > 0) then" from<br>
many loops, and (2) implement boundaries by mapping areas outside<br>
the simulation domain onto the dummy cell/edge/vertex.<br>
<br>
Also, update advection and hydrostatic model time integration code<br>
to perform correct checks and to allocate temporary arrays with<br>
the dummy cell/edge/vertex to prevent segmentation faults; no such<br>
updates to the ocean and shallow water core appear to be<br>
necessary.<br>
<br>
M src/core_hyd_atmos/module_advection.F<br>
M src/core_hyd_atmos/module_time_integration.F<br>
M src/registry/gen_inc.c<br>
M src/framework/module_io_input.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/lateral_boundary_conditions/src/core_hyd_atmos/module_advection.F
===================================================================
--- branches/lateral_boundary_conditions/src/core_hyd_atmos/module_advection.F 2010-03-26 17:21:55 UTC (rev 163)
+++ branches/lateral_boundary_conditions/src/core_hyd_atmos/module_advection.F 2010-03-26 17:29:45 UTC (rev 164)
@@ -96,7 +96,7 @@
do_the_cell = .true.
do i=1,n
- if (cell_list(i) <= 0) do_the_cell = .false.
+ if (cell_list(i) > grid % nCells) do_the_cell = .false.
end do
Modified: branches/lateral_boundary_conditions/src/core_hyd_atmos/module_time_integration.F
===================================================================
--- branches/lateral_boundary_conditions/src/core_hyd_atmos/module_time_integration.F 2010-03-26 17:21:55 UTC (rev 163)
+++ branches/lateral_boundary_conditions/src/core_hyd_atmos/module_time_integration.F 2010-03-26 17:29:45 UTC (rev 164)
@@ -671,10 +671,10 @@
if ( h_mom_eddy_visc4 > 0.0 ) then
- allocate(delsq_divergence(nVertLevels, nCells))
- allocate(delsq_u(nVertLevels, nEdges))
- allocate(delsq_circulation(nVertLevels, nVertices))
- allocate(delsq_vorticity(nVertLevels, nVertices))
+ 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
@@ -849,7 +849,7 @@
if ( h_theta_eddy_visc4 > 0.0 ) then
- allocate(delsq_theta(nVertLevels, nCells))
+ allocate(delsq_theta(nVertLevels, nCells+1))
delsq_theta(:,:) = 0.
@@ -1519,9 +1519,9 @@
real (kind=RKIND), dimension(:), pointer :: dvEdge, dcEdge, areaCell
integer, dimension(:,:), pointer :: cellsOnEdge
- real (kind=RKIND), dimension( num_scalars, grid % nEdges) :: h_flux
- real (kind=RKIND), dimension( num_scalars, grid % nCells, 2 ) :: v_flux, v_flux_upwind, s_update
- real (kind=RKIND), dimension( num_scalars, grid % nCells, 2 ) :: scale_out, scale_in
+ real (kind=RKIND), dimension( num_scalars, grid % nEdges+1) :: h_flux
+ real (kind=RKIND), dimension( num_scalars, grid % nCells+1, 2 ) :: v_flux, v_flux_upwind, s_update
+ real (kind=RKIND), dimension( num_scalars, grid % nCells+1, 2 ) :: scale_out, scale_in
real (kind=RKIND), dimension( num_scalars ) :: s_max, s_min, s_max_update, s_min_update
integer :: nVertLevels, km0, km1, ktmp, kcp1, kcm1
Modified: branches/lateral_boundary_conditions/src/framework/module_io_input.F
===================================================================
--- branches/lateral_boundary_conditions/src/framework/module_io_input.F 2010-03-26 17:21:55 UTC (rev 163)
+++ branches/lateral_boundary_conditions/src/framework/module_io_input.F 2010-03-26 17:29:45 UTC (rev 164)
@@ -804,7 +804,8 @@
if (k <= domain % blocklist % mesh % nCells) then
domain % blocklist % mesh % cellsOnCell % array(j,i) = cellIDSorted(2,k)
else
- domain % blocklist % mesh % cellsOnCell % array(j,i) = 0
+ domain % blocklist % mesh % cellsOnCell % array(j,i) = domain % blocklist % mesh % nCells + 1
+! domain % blocklist % mesh % cellsOnCell % array(j,i) = 0
end if
k = binary_search(edgeIDSorted, 2, 1, domain % blocklist % mesh % nEdges, &
@@ -812,7 +813,8 @@
if (k <= domain % blocklist % mesh % nEdges) then
domain % blocklist % mesh % edgesOnCell % array(j,i) = edgeIDSorted(2,k)
else
- domain % blocklist % mesh % edgesOnCell % array(j,i) = 0
+ domain % blocklist % mesh % edgesOnCell % array(j,i) = domain % blocklist % mesh % nEdges + 1
+! domain % blocklist % mesh % edgesOnCell % array(j,i) = 0
end if
k = binary_search(vertexIDSorted, 2, 1, domain % blocklist % mesh % nVertices, &
@@ -820,7 +822,8 @@
if (k <= domain % blocklist % mesh % nVertices) then
domain % blocklist % mesh % verticesOnCell % array(j,i) = vertexIDSorted(2,k)
else
- domain % blocklist % mesh % verticesOnCell % array(j,i) = 0
+ domain % blocklist % mesh % verticesOnCell % array(j,i) = domain % blocklist % mesh % nVertices + 1
+! domain % blocklist % mesh % verticesOnCell % array(j,i) = 0
end if
end do
@@ -834,7 +837,8 @@
if (k <= domain % blocklist % mesh % nCells) then
domain % blocklist % mesh % cellsOnEdge % array(j,i) = cellIDSorted(2,k)
else
- domain % blocklist % mesh % cellsOnEdge % array(j,i) = 0
+ domain % blocklist % mesh % cellsOnEdge % array(j,i) = domain % blocklist % mesh % nCells + 1
+! domain % blocklist % mesh % cellsOnEdge % array(j,i) = 0
end if
k = binary_search(vertexIDSorted, 2, 1, domain % blocklist % mesh % nVertices, &
@@ -842,7 +846,8 @@
if (k <= domain % blocklist % mesh % nVertices) then
domain % blocklist % mesh % verticesOnEdge % array(j,i) = vertexIDSorted(2,k)
else
- domain % blocklist % mesh % verticesOnEdge % array(j,i) = 0
+ domain % blocklist % mesh % verticesOnEdge % array(j,i) = domain % blocklist % mesh % nVertices + 1
+! domain % blocklist % mesh % verticesOnEdge % array(j,i) = 0
end if
end do
@@ -854,7 +859,8 @@
if (k <= domain % blocklist % mesh % nEdges) then
domain % blocklist % mesh % edgesOnEdge % array(j,i) = edgeIDSorted(2,k)
else
- domain % blocklist % mesh % edgesOnEdge % array(j,i) = 0
+ domain % blocklist % mesh % edgesOnEdge % array(j,i) = domain % blocklist % mesh % nEdges + 1
+! domain % blocklist % mesh % edgesOnEdge % array(j,i) = 0
end if
end do
@@ -868,7 +874,8 @@
if (k <= domain % blocklist % mesh % nCells) then
domain % blocklist % mesh % cellsOnVertex % array(j,i) = cellIDSorted(2,k)
else
- domain % blocklist % mesh % cellsOnVertex % array(j,i) = 0
+ domain % blocklist % mesh % cellsOnVertex % array(j,i) = domain % blocklist % mesh % nCells + 1
+! domain % blocklist % mesh % cellsOnVertex % array(j,i) = 0
end if
k = binary_search(edgeIDSorted, 2, 1, domain % blocklist % mesh % nEdges, &
@@ -876,7 +883,8 @@
if (k <= domain % blocklist % mesh % nEdges) then
domain % blocklist % mesh % edgesOnVertex % array(j,i) = edgeIDSorted(2,k)
else
- domain % blocklist % mesh % edgesOnVertex % array(j,i) = 0
+ domain % blocklist % mesh % edgesOnVertex % array(j,i) = domain % blocklist % mesh % nEdges + 1
+! domain % blocklist % mesh % edgesOnVertex % array(j,i) = 0
end if
end do
Modified: branches/lateral_boundary_conditions/src/registry/gen_inc.c
===================================================================
--- branches/lateral_boundary_conditions/src/registry/gen_inc.c 2010-03-26 17:21:55 UTC (rev 163)
+++ branches/lateral_boundary_conditions/src/registry/gen_inc.c 2010-03-26 17:29:45 UTC (rev 164)
@@ -387,10 +387,20 @@
fortprintf(fd, " allocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
fortprintf(fd, " allocate(g %% %s %% array(%i, ", var_ptr2->super_array, i);
dimlist_ptr = var_ptr2->dimlist;
- fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
+ fortprintf(fd, "%s + 1", dimlist_ptr->dim->name_in_code);
+ else
+ fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
dimlist_ptr = dimlist_ptr->next;
while (dimlist_ptr) {
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
+ fortprintf(fd, ", %s + 1", dimlist_ptr->dim->name_in_code);
+ else
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
dimlist_ptr = dimlist_ptr->next;
}
fortprintf(fd, "))</font>
<font color="gray">");
@@ -416,10 +426,20 @@
fortprintf(fd, " allocate(g %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
fortprintf(fd, " allocate(g %% %s %% array(", var_ptr->name_in_code);
dimlist_ptr = var_ptr->dimlist;
- fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
+ fortprintf(fd, "%s + 1", dimlist_ptr->dim->name_in_code);
+ else
+ fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
dimlist_ptr = dimlist_ptr->next;
while (dimlist_ptr) {
- fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
+ fortprintf(fd, ", %s + 1", dimlist_ptr->dim->name_in_code);
+ else
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
dimlist_ptr = dimlist_ptr->next;
}
fortprintf(fd, "))</font>
<font color="gray">");
@@ -508,10 +528,20 @@
fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr2->super_array);
fortprintf(fd, " allocate(s %% %s %% array(%i, ", var_ptr2->super_array, i);
dimlist_ptr = var_ptr2->dimlist;
- fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
+ fortprintf(fd, "b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
+ else
+ fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
dimlist_ptr = dimlist_ptr->next;
while (dimlist_ptr) {
- fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
+ fortprintf(fd, ", b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
+ else
+ fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
dimlist_ptr = dimlist_ptr->next;
}
fortprintf(fd, "))</font>
<font color="gray">");
@@ -538,10 +568,20 @@
fortprintf(fd, " allocate(s %% %s %% ioinfo)</font>
<font color="red">", var_ptr->name_in_code);
fortprintf(fd, " allocate(s %% %s %% array(", var_ptr->name_in_code);
dimlist_ptr = var_ptr->dimlist;
- fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
+ fortprintf(fd, "b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
+ else
+ fortprintf(fd, "b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
dimlist_ptr = dimlist_ptr->next;
while (dimlist_ptr) {
- fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
+ if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
+ !strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
+ fortprintf(fd, ", b %% mesh %% %s + 1", dimlist_ptr->dim->name_in_code);
+ else
+ fortprintf(fd, ", b %% mesh %% %s", dimlist_ptr->dim->name_in_code);
dimlist_ptr = dimlist_ptr->next;
}
fortprintf(fd, "))</font>
<font color="black">");
</font>
</pre>