<p><b>duda</b> 2009-08-25 17:50:46 -0600 (Tue, 25 Aug 2009)</p><p>Merge in John's changes to run the model with multiple, duplicate<br>
vertical levels. When reading in the initial state, nVertLevels is<br>
increased to EXPAND_LEVELS levels, with levels 2 through EXPAND_LEVELS<br>
being a duplicate of the first level. In the current solver, each of<br>
these new levels is treated independently, but with this change,<br>
development and performance testing work requiring multiple levels can<br>
take place. To activate multiple vertical levels, uncomment and set<br>
EXPAND_LEVELS in the Makefile before building.<br>
<br>
M swmodel/src/module_io_input.F<br>
M swmodel/src/module_test_cases.F<br>
M swmodel/Registry/gen_inc.c<br>
M swmodel/Makefile<br>
</p><hr noshade><pre><font color="gray">Modified: trunk/swmodel/Makefile
===================================================================
--- trunk/swmodel/Makefile 2009-08-25 20:03:57 UTC (rev 36)
+++ trunk/swmodel/Makefile 2009-08-25 23:50:46 UTC (rev 37)
@@ -1,6 +1,8 @@
#MODEL_FORMULATION = -DNCAR_FORMULATION
MODEL_FORMULATION = -DLANL_FORMULATION
+#EXPAND_LEVELS = -DEXPAND_LEVELS=32
+
# IBM with Xlf compilers
#FC = mpxlf90
#CC = mpcc
@@ -27,8 +29,8 @@
#CFLAGS = -O3
#LDFLAGS = -O3
+CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) $(EXPAND_LEVELS) -D_MPI -DUNDERSCORE # -DOFFSET64BIT
-CPPFLAGS = -DRKIND=8 $(MODEL_FORMULATION) -D_MPI -DUNDERSCORE # -DOFFSET64BIT
CPPINCLUDES = -I../inc -I$(NETCDF)/include
FCINCLUDES = -I../inc -I$(NETCDF)/include
LIBS = -L$(NETCDF)/lib -lnetcdf
Modified: trunk/swmodel/Registry/gen_inc.c
===================================================================
--- trunk/swmodel/Registry/gen_inc.c 2009-08-25 20:03:57 UTC (rev 36)
+++ trunk/swmodel/Registry/gen_inc.c 2009-08-25 23:50:46 UTC (rev 37)
@@ -414,6 +414,7 @@
FILE * fd;
char vtype[5];
int i;
+ int has_vert_dim, vert_dim;
/*
@@ -466,13 +467,28 @@
fprintf(fd, " if ((block %% mesh %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="black">", var_ptr->name_in_code);
fprintf(fd, " (block %% mesh %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="blue">", var_ptr->name_in_code);
}
+ vert_dim = 0;
while (dimlist_ptr) {
if (i < var_ptr->ndims) {
+ has_vert_dim = !strcmp( "nVertLevels", dimlist_ptr->dim->name_in_code);
fprintf(fd, " %s%id %% ioinfo %% start(%i) = 1</font>
<font color="blue">", vtype, var_ptr->ndims, i);
+ if (has_vert_dim) {
+ vert_dim = i;
+ fprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="blue">");
+ fprintf(fd, " if (.not. config_do_restart) then</font>
<font color="blue">");
+ fprintf(fd, " %s%id %% ioinfo %% count(%i) = 1</font>
<font color="blue">", vtype, var_ptr->ndims, i);
+ fprintf(fd, " else</font>
<font color="blue">");
+ fprintf(fd, "#endif</font>
<font color="blue">");
+ }
if (dimlist_ptr->dim->constant_value < 0)
fprintf(fd, " %s%id %% ioinfo %% count(%i) = block %% mesh %% %s</font>
<font color="black">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
else
fprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ if (has_vert_dim) {
+ fprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="blue">");
+ fprintf(fd, " end if</font>
<font color="blue">");
+ fprintf(fd, "#endif</font>
<font color="blue">");
+ }
}
else {
fprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="gray">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code+1);
@@ -516,6 +532,26 @@
else
fprintf(fd, " call io_input_field(input_obj, %s%id)</font>
<font color="blue">", vtype, var_ptr->ndims);
+ if (vert_dim > 0) {
+ fprintf(fd, "#ifdef EXPAND_LEVELS</font>
<font color="blue">");
+ fprintf(fd, " if (.not. config_do_restart) then</font>
<font color="blue">");
+ fprintf(fd, " do k=2,EXPAND_LEVELS</font>
<font color="blue">");
+ fprintf(fd, " %s%id %% array(", vtype, var_ptr->ndims);
+ for (i=1; i<=var_ptr->ndims; i++) {
+ if (i > 1) fprintf(fd, ",");
+ fprintf(fd, "%s", i == vert_dim ? "k" : ":");
+ }
+ fprintf(fd, ") = %s%id %% array(", vtype, var_ptr->ndims);
+ for (i=1; i<=var_ptr->ndims; i++) {
+ if (i > 1) fprintf(fd, ",");
+ fprintf(fd, "%s", i == vert_dim ? "1" : ":");
+ }
+ fprintf(fd, ")</font>
<font color="blue">");
+ fprintf(fd, " end do</font>
<font color="blue">");
+ fprintf(fd, " end if</font>
<font color="blue">");
+ fprintf(fd, "#endif</font>
<font color="blue">");
+ }
+
if (var_ptr->ndims > 0) {
fprintf(fd, " call dmpar_alltoall_field(dminfo, &</font>
<font color="gray">");
if (var_ptr->timedim)
Modified: trunk/swmodel/src/module_io_input.F
===================================================================
--- trunk/swmodel/src/module_io_input.F 2009-08-25 20:03:57 UTC (rev 36)
+++ trunk/swmodel/src/module_io_input.F 2009-08-25 23:50:46 UTC (rev 37)
@@ -635,6 +635,8 @@
type (field2dReal) :: real2d
type (field3dReal) :: real3d
+ integer :: k
+
allocate(int1d % ioinfo)
allocate(int2d % ioinfo)
allocate(real0d % ioinfo)
@@ -669,6 +671,13 @@
#include "netcdf_read_ids.inc"
+#ifdef EXPAND_LEVELS
+ if (.not. config_do_restart) then
+ input_obj % rdLocalnVertLevels = EXPAND_LEVELS
+ write(0,*) 'Expanding nVertLevels to ',input_obj % rdLocalnVertLevels,' by duplicating the first level.'
+ end if
+#endif
+
end subroutine io_input_init
Modified: trunk/swmodel/src/module_test_cases.F
===================================================================
--- trunk/swmodel/src/module_test_cases.F 2009-08-25 20:03:57 UTC (rev 36)
+++ trunk/swmodel/src/module_test_cases.F 2009-08-25 23:50:46 UTC (rev 37)
@@ -145,6 +145,9 @@
psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
) / grid%dvEdge%array(iEdge)
+#ifdef EXPAND_LEVELS
+ state % u % array(2:EXPAND_LEVELS, iEdge) = state % u % array(1,iEdge)
+#endif
end do
deallocate(psiVertex)
@@ -158,6 +161,9 @@
else
state % h % array(1,iCell) = 0.0
end if
+#ifdef EXPAND_LEVELS
+ state % h % array(2:EXPAND_LEVELS, iCell) = state % h % array(1,iCell)
+#endif
end do
end subroutine sw_test_case_1
@@ -221,6 +227,9 @@
psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
) / grid%dvEdge%array(iEdge)
+#ifdef EXPAND_LEVELS
+ state % u % array(2:EXPAND_LEVELS, iEdge) = state % u % array(1,iEdge)
+#endif
end do
deallocate(psiVertex)
@@ -250,6 +259,9 @@
)**2.0 &
) / &
gravity
+#ifdef EXPAND_LEVELS
+ state % h % array(2:EXPAND_LEVELS, iCell) = state % h % array(1,iCell)
+#endif
end do
end subroutine sw_test_case_2
@@ -315,6 +327,9 @@
psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
) / grid%dvEdge%array(iEdge)
+#ifdef EXPAND_LEVELS
+ state % u % array(2:EXPAND_LEVELS, iEdge) = state % u % array(1,iEdge)
+#endif
end do
deallocate(psiVertex)
@@ -369,6 +384,9 @@
) / &
gravity
state % h % array(1,iCell) = state % h % array(1,iCell) - grid % h_s % array(iCell)
+#ifdef EXPAND_LEVELS
+ state % h % array(2:EXPAND_LEVELS, iCell) = state % h % array(1,iCell)
+#endif
end do
end subroutine sw_test_case_5
@@ -430,6 +448,9 @@
psiVertex(grid%verticesOnEdge%array(2,iEdge)) - &
psiVertex(grid%verticesOnEdge%array(1,iEdge)) &
) / grid%dvEdge%array(iEdge)
+#ifdef EXPAND_LEVELS
+ state % u % array(2:EXPAND_LEVELS, iEdge) = state % u % array(1,iEdge)
+#endif
end do
deallocate(psiVertex)
@@ -441,6 +462,9 @@
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
+#ifdef EXPAND_LEVELS
+ state % h % array(2:EXPAND_LEVELS, iCell) = state % h % array(1,iCell)
+#endif
end do
end subroutine sw_test_case_6
</font>
</pre>