<p><b>duda</b> 2011-09-15 11:43:05 -0600 (Thu, 15 Sep 2011)</p><p>Bring infrastructure improvements to the trunk, including:<br>
<br>
* Add changes to I/O and registry infrastructure to support <br>
periodic input on a separate stream. <br>
<br>
* Add changes to registry and I/O modules so that nVertLevelsP1 is <br>
treated as just another non-decomposed dimension, rather than as a <br>
special case. These changes allow us to dimension a variable with <br>
nVertLevelsP1 as the outer-most dimension. <br>
<br>
* Changes to allow registry-defined fields to have a <br>
non-decomposed dimension as their outer-most dimension, i.e., to <br>
have a dimension other than nCells, nEdges, nVertices, or <br>
nVertLevels outer-most. <br>
<br>
* Add I/O support for time-varying, 1d integer fields. <br>
<br>
* Create a version of the quicksort routine to work with real <br>
values, and create generic interface for the quicksort routine <br>
that can select between sorting real and integer values <br>
<br>
<br>
M src/registry/registry_types.h<br>
M src/registry/gen_inc.c<br>
M src/registry/parse.c<br>
M src/framework/module_io_input.F<br>
M src/framework/module_io_output.F<br>
M src/framework/module_sort.F<br>
M src/framework/module_grid_types.F<br>
</p><hr noshade><pre><font color="gray">Modified: trunk/mpas/src/framework/module_grid_types.F
===================================================================
--- trunk/mpas/src/framework/module_grid_types.F 2011-09-15 17:39:20 UTC (rev 1000)
+++ trunk/mpas/src/framework/module_grid_types.F 2011-09-15 17:43:05 UTC (rev 1001)
@@ -11,6 +11,7 @@
integer, dimension(4) :: start
integer, dimension(4) :: count
logical :: input
+ logical :: sfc
logical :: restart
logical :: output
end type io_info
Modified: trunk/mpas/src/framework/module_io_input.F
===================================================================
--- trunk/mpas/src/framework/module_io_input.F 2011-09-15 17:39:20 UTC (rev 1000)
+++ trunk/mpas/src/framework/module_io_input.F 2011-09-15 17:43:05 UTC (rev 1001)
@@ -12,9 +12,12 @@
use zoltan_interface
#endif
+ integer, parameter :: STREAM_INPUT=1, STREAM_SFC=2, STREAM_RESTART=3
+
type io_input_object
character (len=1024) :: filename
integer :: rd_ncid
+ integer :: stream
integer :: time
@@ -38,10 +41,21 @@
module procedure io_input_field1dReal_time
module procedure io_input_field2dReal_time
module procedure io_input_field3dReal_time
+ module procedure io_input_field1dInteger_time
module procedure io_input_field0dChar_time
module procedure io_input_field1dChar_time
end interface io_input_field_time
+
+ type (exchange_list), pointer :: sendCellList, recvCellList
+ type (exchange_list), pointer :: sendEdgeList, recvEdgeList
+ type (exchange_list), pointer :: sendVertexList, recvVertexList
+ type (exchange_list), pointer :: sendVertLevelList, recvVertLevelList
+ integer :: readCellStart, readCellEnd, nReadCells
+ integer :: readEdgeStart, readEdgeEnd, nReadEdges
+ integer :: readVertexStart, readVertexEnd, nReadVertices
+ integer :: readVertLevelStart, readVertLevelEnd, nReadVertLevels
+
contains
@@ -59,11 +73,6 @@
character (len=16) :: c_on_a_sphere
real (kind=RKIND) :: r_sphere_radius
- integer :: readCellStart, readCellEnd, nReadCells
- integer :: readEdgeStart, readEdgeEnd, nReadEdges
- integer :: readVertexStart, readVertexEnd, nReadVertices
- integer :: readVertLevelStart, readVertLevelEnd, nReadVertLevels
-
type (field1dInteger) :: indexToCellIDField
type (field1dInteger) :: indexToEdgeIDField
type (field1dInteger) :: indexToVertexIDField
@@ -108,11 +117,6 @@
integer, dimension(:), pointer :: local_cell_list, local_edge_list, local_vertex_list
integer, dimension(:), pointer :: local_vertlevel_list, needed_vertlevel_list
integer :: nlocal_edges, nlocal_vertices
- type (exchange_list), pointer :: sendCellList, recvCellList
- type (exchange_list), pointer :: sendEdgeList, recvEdgeList
- type (exchange_list), pointer :: sendVertexList, recvVertexList
- type (exchange_list), pointer :: sendVertLevelList, recvVertLevelList
- type (exchange_list), pointer :: sendVertLevelP1List, recvVertLevelP1List
type (exchange_list), pointer :: send1Halo, recv1Halo
type (exchange_list), pointer :: send2Halo, recv2Halo
type (graph) :: partial_global_graph_info
@@ -127,8 +131,10 @@
if (config_do_restart) then
input_obj % filename = trim(config_restart_name)
+ input_obj % stream = STREAM_RESTART
else
input_obj % filename = trim(config_input_name)
+ input_obj % stream = STREAM_INPUT
end if
call io_input_init(input_obj, domain % dminfo)
@@ -706,28 +712,7 @@
deallocate(local_vertlevel_list)
deallocate(needed_vertlevel_list)
- if (domain % dminfo % my_proc_id == 0) then
- allocate(local_vertlevel_list(nVertLevels+1))
- do i=1,nVertLevels+1
- local_vertlevel_list(i) = i
- end do
- else
- allocate(local_vertlevel_list(0))
- end if
- allocate(needed_vertlevel_list(nVertLevels+1))
- do i=1,nVertLevels+1
- needed_vertlevel_list(i) = i
- end do
- call dmpar_get_owner_list(domain % dminfo, &
- size(local_vertlevel_list), size(needed_vertlevel_list), &
- local_vertlevel_list, needed_vertlevel_list, &
- sendVertLevelP1List, recvVertLevelP1List)
-
- deallocate(local_vertlevel_list)
- deallocate(needed_vertlevel_list)
-
-
!
! Read and distribute all fields given ownership lists and exchange lists (maybe already in block?)
!
@@ -815,7 +800,7 @@
readCellStart, nReadCells, readEdgeStart, nReadEdges, readVertexStart, nReadVertices, &
readVertLevelStart, nReadVertLevels, &
sendCellList, recvCellList, sendEdgeList, recvEdgeList, sendVertexList, recvVertexList, &
- sendVertLevelList, recvVertLevelList, sendVertLevelP1List, recvVertLevelP1List)
+ sendVertLevelList, recvVertLevelList)
call io_input_finalize(input_obj, domain % dminfo)
@@ -1027,8 +1012,7 @@
sendCellsList, recvCellsList, &
sendEdgesList, recvEdgesList, &
sendVerticesList, recvVerticesList, &
- sendVertLevelsList, recvVertLevelsList, &
- sendVertLevelsP1List, recvVertLevelsP1List)
+ sendVertLevelsList, recvVertLevelsList)
implicit none
@@ -1041,7 +1025,6 @@
type (exchange_list), pointer :: sendEdgesList, recvEdgesList
type (exchange_list), pointer :: sendVerticesList, recvVerticesList
type (exchange_list), pointer :: sendVertLevelsList, recvVertLevelsList
- type (exchange_list), pointer :: sendVertLevelsP1List, recvVertLevelsP1List
type (field1dInteger) :: int1d
type (field2dInteger) :: int2d
@@ -1063,8 +1046,10 @@
character (len=64) :: super_char0d
character (len=64), dimension(:), pointer :: super_char1d
- integer :: k
+ integer :: i, k
+#include "nondecomp_dims.inc"
+
allocate(int1d % ioinfo)
allocate(int2d % ioinfo)
allocate(real0d % ioinfo)
@@ -1077,6 +1062,8 @@
#include "io_input_fields.inc"
+#include "nondecomp_dims_dealloc.inc"
+
end subroutine read_and_distribute_fields
@@ -1101,10 +1088,12 @@
if (nferr /= NF_NOERR) then
write(0,*) ' '
- if (config_do_restart) then
+ if (input_obj % stream == STREAM_RESTART) then
write(0,*) 'Error opening restart file ''', trim(input_obj % filename), ''''
- else
+ else if (input_obj % stream == STREAM_INPUT) then
write(0,*) 'Error opening input file ''', trim(input_obj % filename), ''''
+ else if (input_obj % stream == STREAM_SFC) then
+ write(0,*) 'Error opening sfc file ''', trim(input_obj % filename), ''''
end if
write(0,*) ' '
call dmpar_abort(dminfo)
@@ -1472,6 +1461,31 @@
end subroutine io_input_field2dInteger
+ subroutine io_input_field1dInteger_time(input_obj, field)
+
+ implicit none
+
+ type (io_input_object), intent(in) :: input_obj
+ type (field1dInteger), intent(inout) :: field
+
+ include 'netcdf.inc'
+
+ integer :: nferr
+ integer :: varID
+ integer, dimension(2) :: start2, count2
+
+ start2(1) = field % ioinfo % start(1)
+ start2(2) = input_obj % time
+ count2(1) = field % ioinfo % count(1)
+ count2(2) = 1
+
+#include "input_field1dinteger_time.inc"
+
+ nferr = nf_get_vara_int(input_obj % rd_ncid, varID, start2, count2, field % array)
+
+ end subroutine io_input_field1dInteger_time
+
+
subroutine io_input_field0dChar_time(input_obj, field)
implicit none
Modified: trunk/mpas/src/framework/module_io_output.F
===================================================================
--- trunk/mpas/src/framework/module_io_output.F 2011-09-15 17:39:20 UTC (rev 1000)
+++ trunk/mpas/src/framework/module_io_output.F 2011-09-15 17:43:05 UTC (rev 1001)
@@ -7,6 +7,7 @@
integer, parameter :: OUTPUT = 1
integer, parameter :: RESTART = 2
+ integer, parameter :: SFC = 3
type io_output_object
integer :: wr_ncid
@@ -24,7 +25,6 @@
type (exchange_list), pointer :: sendEdgesList, recvEdgesList
type (exchange_list), pointer :: sendVerticesList, recvVerticesList
type (exchange_list), pointer :: sendVertLevelsList, recvVertLevelsList
- type (exchange_list), pointer :: sendVertLevelsP1List, recvVertLevelsP1List
end type io_output_object
@@ -44,6 +44,7 @@
module procedure io_output_field1dReal_time
module procedure io_output_field2dReal_time
module procedure io_output_field3dReal_time
+ module procedure io_output_field1dInteger_time
module procedure io_output_field0dChar_time
module procedure io_output_field1dChar_time
end interface io_output_field_time
@@ -75,8 +76,6 @@
nullify(output_obj % recvVerticesList)
nullify(output_obj % sendVertLevelsList)
nullify(output_obj % recvVertLevelsList)
- nullify(output_obj % sendVertLevelsP1List)
- nullify(output_obj % recvVertLevelsP1List)
output_obj % validExchangeLists = .false.
#include "output_dim_inits.inc"
@@ -97,6 +96,9 @@
else if (trim(stream) == 'RESTART') then
output_obj % filename = trim(config_restart_name)
output_obj % stream = RESTART
+ else if (trim(stream) == 'SFC') then
+ ! Keep filename as whatever was set by the user
+ output_obj % stream = SFC
end if
! For now, we assume that a domain consists only of one block,
@@ -149,7 +151,6 @@
integer, dimension(:), pointer :: neededEdgeList
integer, dimension(:), pointer :: neededVertexList
integer, dimension(:), pointer :: neededVertLevelList
- integer, dimension(:), pointer :: neededVertLevelP1List
integer, dimension(:,:), pointer :: cellsOnCell, edgesOnCell, verticesOnCell, &
cellsOnEdge, verticesOnEdge, edgesOnEdge, cellsOnVertex, edgesOnVertex
integer, dimension(:,:), pointer :: cellsOnCell_save, edgesOnCell_save, verticesOnCell_save, &
@@ -175,6 +176,8 @@
character (len=64) :: super_char0d
character (len=64), dimension(:), pointer :: super_char1d
+#include "nondecomp_outputs.inc"
+
output_obj % time = itime
allocate(int1d % ioinfo)
@@ -256,7 +259,6 @@
allocate(neededEdgeList(nEdgesGlobal))
allocate(neededVertexList(nVerticesGlobal))
allocate(neededVertLevelList(nVertLevelsGlobal))
- allocate(neededVertLevelP1List(nVertLevelsGlobal+1))
do i=1,nCellsGlobal
neededCellList(i) = i
end do
@@ -269,15 +271,11 @@
do i=1,nVertLevelsGlobal
neededVertLevelList(i) = i
end do
- do i=1,nVertLevelsGlobal+1
- neededVertLevelP1List(i) = i
- end do
else
allocate(neededCellList(0))
allocate(neededEdgeList(0))
allocate(neededVertexList(0))
allocate(neededVertLevelList(0))
- allocate(neededVertLevelP1List(0))
end if
if (.not. output_obj % validExchangeLists) then
@@ -301,11 +299,6 @@
neededVertLevelList, neededVertLevelList, &
output_obj % sendVertLevelsList, output_obj % recvVertLevelsList)
- call dmpar_get_owner_list(domain % dminfo, &
- size(neededVertLevelP1List), size(neededVertLevelP1List), &
- neededVertLevelP1List, neededVertLevelP1List, &
- output_obj % sendVertLevelsP1List, output_obj % recvVertLevelsP1List)
-
output_obj % validExchangeLists = .true.
end if
@@ -351,6 +344,8 @@
deallocate(cellsOnVertex)
deallocate(edgesOnVertex)
+#include "nondecomp_outputs_dealloc.inc"
+
end subroutine output_state_for_domain
@@ -713,6 +708,33 @@
end subroutine io_output_field2dInteger
+ subroutine io_output_field1dInteger_time(output_obj, field)
+
+ implicit none
+
+ type (io_output_object), intent(in) :: output_obj
+ type (field1dInteger), intent(inout) :: field
+
+ include 'netcdf.inc'
+
+ integer :: nferr
+ integer :: varID
+ integer, dimension(2) :: start2, count2
+
+ start2(1) = field % ioinfo % start(1)
+ start2(2) = output_obj % time
+ count2(1) = field % ioinfo % count(1)
+ count2(2) = 1
+
+#include "output_field1dinteger_time.inc"
+
+ nferr = nf_put_vara_int(output_obj % wr_ncid, varID, start2, count2, field % array)
+
+ nferr = nf_sync(output_obj % wr_ncid)
+
+ end subroutine io_output_field1dInteger_time
+
+
subroutine io_output_field0dChar_time(output_obj, field)
implicit none
Modified: trunk/mpas/src/framework/module_sort.F
===================================================================
--- trunk/mpas/src/framework/module_sort.F 2011-09-15 17:39:20 UTC (rev 1000)
+++ trunk/mpas/src/framework/module_sort.F 2011-09-15 17:43:05 UTC (rev 1001)
@@ -1,6 +1,11 @@
module sort
+ interface quicksort
+ module procedure quicksort_int
+ module procedure quicksort_real
+ end interface
+
contains
@@ -67,7 +72,7 @@
end subroutine mergesort
- subroutine quicksort(nArray, array)
+ subroutine quicksort_int(nArray, array)
implicit none
@@ -127,9 +132,72 @@
end if
end do
- end subroutine quicksort
+ end subroutine quicksort_int
+ subroutine quicksort_real(nArray, array)
+
+ implicit none
+
+ integer, intent(in) :: nArray
+ real (kind=RKIND), dimension(2,nArray), intent(inout) :: array
+
+ integer :: i, j, top, l, r, pivot, s
+ real (kind=RKIND) :: pivot_value
+ real (kind=RKIND), dimension(2) :: temp
+ integer, dimension(1000) :: lstack, rstack
+
+ if (nArray < 1) return
+
+ top = 1
+ lstack(top) = 1
+ rstack(top) = nArray
+
+ do while (top > 0)
+
+ l = lstack(top)
+ r = rstack(top)
+ top = top - 1
+
+ pivot = (l+r)/2
+
+ pivot_value = array(1,pivot)
+ temp(:) = array(:,pivot)
+ array(:,pivot) = array(:,r)
+ array(:,r) = temp(:)
+
+ s = l
+ do i=l,r-1
+ if (array(1,i) <= pivot_value) then
+ temp(:) = array(:,s)
+ array(:,s) = array(:,i)
+ array(:,i) = temp(:)
+ s = s + 1
+ end if
+ end do
+
+ temp(:) = array(:,s)
+ array(:,s) = array(:,r)
+ array(:,r) = temp(:)
+
+ if (s-1 > l) then
+ top = top + 1
+if (top > 1000) write(0,*) 'Error: Quicksort exhausted its stack.'
+ lstack(top) = l
+ rstack(top) = s-1
+ end if
+
+ if (r > s+1) then
+ top = top + 1
+if (top > 1000) write(0,*) 'Error: Quicksort exhausted its stack.'
+ lstack(top) = s+1
+ rstack(top) = r
+ end if
+ end do
+
+ end subroutine quicksort_real
+
+
integer function binary_search(array, d1, n1, n2, key)
implicit none
Modified: trunk/mpas/src/registry/gen_inc.c
===================================================================
--- trunk/mpas/src/registry/gen_inc.c 2011-09-15 17:39:20 UTC (rev 1000)
+++ trunk/mpas/src/registry/gen_inc.c 2011-09-15 17:43:05 UTC (rev 1001)
@@ -583,6 +583,11 @@
else
fortprintf(fd, " %s %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+ if (var_ptr2->iostreams & SFC0)
+ fortprintf(fd, " %s %% %s %% ioinfo %% sfc = .true.</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+ else
+ fortprintf(fd, " %s %% %s %% ioinfo %% sfc = .false.</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+
if (var_ptr2->iostreams & RESTART0)
fortprintf(fd, " %s %% %s %% ioinfo %% restart = .true.</font>
<font color="gray">", group_ptr->name, var_ptr2->super_array);
else
@@ -634,6 +639,11 @@
else
fortprintf(fd, " %s %% %s %% ioinfo %% input = .false.</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ if (var_ptr->iostreams & SFC0)
+ fortprintf(fd, " %s %% %s %% ioinfo %% sfc = .true.</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ else
+ fortprintf(fd, " %s %% %s %% ioinfo %% sfc = .false.</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+
if (var_ptr->iostreams & RESTART0)
fortprintf(fd, " %s %% %s %% ioinfo %% restart = .true.</font>
<font color="gray">", group_ptr->name, var_ptr->name_in_code);
else
@@ -817,6 +827,396 @@
}
fclose(fd);
+
+ /*
+ * Definitions of read bounds and exchange lists for non-decomposed fields
+ */
+ fd = fopen("nondecomp_dims.inc", "w");
+
+ dim_ptr = dims;
+ while (dim_ptr) {
+
+ if (strncmp(dim_ptr->name_in_file,"nCells",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nEdges",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nVertices",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nVertLevels",1024) != 0
+ ) {
+
+ if (is_derived_dim(dim_ptr->name_in_code)) {
+ fortprintf(fd, " integer :: read%sStart</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " integer :: read%sCount</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " type (exchange_list), pointer :: send%sList</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " type (exchange_list), pointer :: recv%sList</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ }
+ else if (dim_ptr->constant_value > 0) {
+ fortprintf(fd, " integer :: read%sStart</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " integer :: read%sCount</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " type (exchange_list), pointer :: send%sList</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " type (exchange_list), pointer :: recv%sList</font>
<font color="blue">", dim_ptr->name_in_file);
+ }
+ else if (dim_ptr->namelist_defined) {
+ fortprintf(fd, " integer :: read%sStart</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " integer :: read%sCount</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " type (exchange_list), pointer :: send%sList</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " type (exchange_list), pointer :: recv%sList</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ }
+ else {
+ fortprintf(fd, " integer :: read%sStart</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " integer :: read%sCount</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " type (exchange_list), pointer :: send%sList</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " type (exchange_list), pointer :: recv%sList</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ }
+ }
+
+ dim_ptr = dim_ptr->next;
+ }
+
+ fortprintf(fd, "</font>
<font color="blue">");
+
+ dim_ptr = dims;
+ while (dim_ptr) {
+
+ if (strncmp(dim_ptr->name_in_file,"nCells",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nEdges",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nVertices",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nVertLevels",1024) != 0
+ ) {
+
+ if (is_derived_dim(dim_ptr->name_in_code)) {
+ fortprintf(fd, " read%sStart = 1</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " read%sCount = block %% mesh %% %s</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_code);
+ fortprintf(fd, " allocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " allocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " nullify(send%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " nullify(recv%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " recv%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " send%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " recv%sList %% nlist = read%sCount</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file+1);
+ fortprintf(fd, " send%sList %% nlist = read%sCount</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file+1);
+ fortprintf(fd, " allocate(recv%sList %% list(read%sCount))</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file+1);
+ fortprintf(fd, " allocate(send%sList %% list(read%sCount))</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file+1);
+ fortprintf(fd, " do i=1,read%sCount</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " recv%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " send%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ }
+ else if (dim_ptr->constant_value > 0) {
+ fortprintf(fd, " read%sStart = 1</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " read%sCount = %s</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_code);
+ fortprintf(fd, " allocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " allocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " nullify(send%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " nullify(recv%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " recv%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " send%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " recv%sList %% nlist = read%sCount</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_file);
+ fortprintf(fd, " send%sList %% nlist = read%sCount</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_file);
+ fortprintf(fd, " allocate(recv%sList %% list(read%sCount))</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_file);
+ fortprintf(fd, " allocate(send%sList %% list(read%sCount))</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_file);
+ fortprintf(fd, " do i=1,read%sCount</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " recv%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " send%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ }
+ else if (dim_ptr->namelist_defined) {
+ fortprintf(fd, " read%sStart = 1</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " read%sCount = block %% mesh %% %s</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file);
+ fortprintf(fd, " allocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " allocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " nullify(send%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " nullify(recv%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " recv%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " send%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " recv%sList %% nlist = read%sCount</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file+1);
+ fortprintf(fd, " send%sList %% nlist = read%sCount</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file+1);
+ fortprintf(fd, " allocate(recv%sList %% list(read%sCount))</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file+1);
+ fortprintf(fd, " allocate(send%sList %% list(read%sCount))</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file+1);
+ fortprintf(fd, " do i=1,read%sCount</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " recv%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " send%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ }
+ else {
+ fortprintf(fd, " read%sStart = 1</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " read%sCount = block %% mesh %% %s</font>
<font color="blue">", dim_ptr->name_in_code+1, dim_ptr->name_in_code);
+ fortprintf(fd, " allocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " allocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " nullify(send%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " nullify(recv%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " recv%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " send%sList %% procID = dminfo %% my_proc_id</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " recv%sList %% nlist = read%sCount</font>
<font color="blue">", dim_ptr->name_in_code+1, dim_ptr->name_in_code+1);
+ fortprintf(fd, " send%sList %% nlist = read%sCount</font>
<font color="blue">", dim_ptr->name_in_code+1, dim_ptr->name_in_code+1);
+ fortprintf(fd, " allocate(recv%sList %% list(read%sCount))</font>
<font color="blue">", dim_ptr->name_in_code+1, dim_ptr->name_in_code+1);
+ fortprintf(fd, " allocate(send%sList %% list(read%sCount))</font>
<font color="blue">", dim_ptr->name_in_code+1, dim_ptr->name_in_code+1);
+ fortprintf(fd, " do i=1,read%sCount</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " recv%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " send%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ }
+
+ }
+
+ dim_ptr = dim_ptr->next;
+ }
+
+ fclose(fd);
+
+
+ /*
+ * Deallocation of exchange lists for non-decomposed fields
+ */
+ fd = fopen("nondecomp_dims_dealloc.inc", "w");
+
+ dim_ptr = dims;
+ while (dim_ptr) {
+
+ if (strncmp(dim_ptr->name_in_file,"nCells",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nEdges",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nVertices",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nVertLevels",1024) != 0
+ ) {
+
+ if (is_derived_dim(dim_ptr->name_in_code)) {
+ fortprintf(fd, " deallocate(recv%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " deallocate(send%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " deallocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " deallocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ }
+ else if (dim_ptr->constant_value > 0) {
+ fortprintf(fd, " deallocate(recv%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " deallocate(send%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " deallocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " deallocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file);
+ }
+ else if (dim_ptr->namelist_defined) {
+ fortprintf(fd, " deallocate(recv%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " deallocate(send%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " deallocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " deallocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ }
+ else {
+ fortprintf(fd, " deallocate(recv%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " deallocate(send%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " deallocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " deallocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ }
+
+ }
+
+ dim_ptr = dim_ptr->next;
+ }
+
+ fclose(fd);
+
+
+ /*
+ * Definitions of read bounds and exchange lists for non-decomposed fields
+ */
+ fd = fopen("nondecomp_outputs.inc", "w");
+
+ dim_ptr = dims;
+ while (dim_ptr) {
+
+ if (strncmp(dim_ptr->name_in_file,"nCells",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nEdges",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nVertices",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nVertLevels",1024) != 0
+ ) {
+
+ if (is_derived_dim(dim_ptr->name_in_code)) {
+ fortprintf(fd, " integer :: %sGlobal</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " type (exchange_list), pointer :: send%sList</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " type (exchange_list), pointer :: recv%sList</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ }
+ else if (dim_ptr->constant_value > 0) {
+ fortprintf(fd, " type (exchange_list), pointer :: send%sList</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " type (exchange_list), pointer :: recv%sList</font>
<font color="blue">", dim_ptr->name_in_file);
+ }
+ else if (dim_ptr->namelist_defined) {
+ fortprintf(fd, " integer :: %sGlobal</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " type (exchange_list), pointer :: send%sList</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " type (exchange_list), pointer :: recv%sList</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ }
+ else {
+ fortprintf(fd, " integer :: %sGlobal</font>
<font color="blue">", dim_ptr->name_in_code);
+ fortprintf(fd, " type (exchange_list), pointer :: send%sList</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " type (exchange_list), pointer :: recv%sList</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ }
+
+ }
+
+ dim_ptr = dim_ptr->next;
+ }
+
+ fortprintf(fd, "</font>
<font color="blue">");
+
+ dim_ptr = dims;
+ while (dim_ptr) {
+
+ if (strncmp(dim_ptr->name_in_file,"nCells",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nEdges",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nVertices",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nVertLevels",1024) != 0
+ ) {
+
+ if (is_derived_dim(dim_ptr->name_in_code)) {
+ fortprintf(fd, " %sGlobal = domain %% blocklist %% mesh %% %s</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_code);
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">");
+ fortprintf(fd, " allocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " allocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " nullify(send%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " nullify(recv%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " recv%sList %% procID = 0</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " send%sList %% procID = 0</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " recv%sList %% nlist = %sGlobal</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file);
+ fortprintf(fd, " send%sList %% nlist = %sGlobal</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file);
+ fortprintf(fd, " allocate(recv%sList %% list(%sGlobal))</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file);
+ fortprintf(fd, " allocate(send%sList %% list(%sGlobal))</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file);
+ fortprintf(fd, " do i=1,%sGlobal</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " recv%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " send%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, " nullify(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " nullify(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ }
+ else if (dim_ptr->constant_value > 0) {
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">");
+ fortprintf(fd, " allocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " allocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " nullify(send%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " nullify(recv%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " recv%sList %% procID = 0</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " send%sList %% procID = 0</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " recv%sList %% nlist = %s</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_code);
+ fortprintf(fd, " send%sList %% nlist = %s</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_code);
+ fortprintf(fd, " allocate(recv%sList %% list(%s))</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_code);
+ fortprintf(fd, " allocate(send%sList %% list(%s))</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_code);
+ fortprintf(fd, " do i=1,%s</font>
<font color="blue">", dim_ptr->name_in_code);
+ fortprintf(fd, " recv%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " send%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, " nullify(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " nullify(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ }
+ else if (dim_ptr->namelist_defined) {
+ fortprintf(fd, " %sGlobal = domain %% blocklist %% mesh %% %s</font>
<font color="blue">", dim_ptr->name_in_file, dim_ptr->name_in_file);
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">");
+ fortprintf(fd, " allocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " allocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " nullify(send%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " nullify(recv%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " recv%sList %% procID = 0</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " send%sList %% procID = 0</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " recv%sList %% nlist = %sGlobal</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file);
+ fortprintf(fd, " send%sList %% nlist = %sGlobal</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file);
+ fortprintf(fd, " allocate(recv%sList %% list(%sGlobal))</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file);
+ fortprintf(fd, " allocate(send%sList %% list(%sGlobal))</font>
<font color="blue">", dim_ptr->name_in_file+1, dim_ptr->name_in_file);
+ fortprintf(fd, " do i=1,%sGlobal</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " recv%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " send%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, " nullify(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " nullify(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ }
+ else {
+ fortprintf(fd, " %sGlobal = domain %% blocklist %% mesh %% %s</font>
<font color="blue">", dim_ptr->name_in_code, dim_ptr->name_in_code);
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">");
+ fortprintf(fd, " allocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " allocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " nullify(send%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " nullify(recv%sList %% next)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " recv%sList %% procID = 0</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " send%sList %% procID = 0</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " recv%sList %% nlist = %sGlobal</font>
<font color="blue">", dim_ptr->name_in_code+1, dim_ptr->name_in_code);
+ fortprintf(fd, " send%sList %% nlist = %sGlobal</font>
<font color="blue">", dim_ptr->name_in_code+1, dim_ptr->name_in_code);
+ fortprintf(fd, " allocate(recv%sList %% list(%sGlobal))</font>
<font color="blue">", dim_ptr->name_in_code+1, dim_ptr->name_in_code);
+ fortprintf(fd, " allocate(send%sList %% list(%sGlobal))</font>
<font color="blue">", dim_ptr->name_in_code+1, dim_ptr->name_in_code);
+ fortprintf(fd, " do i=1,%sGlobal</font>
<font color="blue">", dim_ptr->name_in_code);
+ fortprintf(fd, " recv%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " send%sList %% list(i) = i</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " end do</font>
<font color="blue">");
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, " nullify(send%sList)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " nullify(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ fortprintf(fd, "</font>
<font color="blue">");
+ }
+
+ }
+
+ dim_ptr = dim_ptr->next;
+ }
+
+ fclose(fd);
+
+
+ /*
+ * Deallocation of exchange lists for non-decomposed fields
+ */
+ fd = fopen("nondecomp_outputs_dealloc.inc", "w");
+
+ dim_ptr = dims;
+ while (dim_ptr) {
+
+ if (strncmp(dim_ptr->name_in_file,"nCells",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nEdges",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nVertices",1024) != 0 &&
+ strncmp(dim_ptr->name_in_file,"nVertLevels",1024) != 0
+ ) {
+
+ if (is_derived_dim(dim_ptr->name_in_code)) {
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">");
+ fortprintf(fd, " deallocate(recv%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " deallocate(send%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " deallocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " deallocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ }
+ else if (dim_ptr->constant_value > 0) {
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">");
+ fortprintf(fd, " deallocate(recv%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " deallocate(send%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " deallocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " deallocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ }
+ else if (dim_ptr->namelist_defined) {
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">");
+ fortprintf(fd, " deallocate(recv%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " deallocate(send%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " deallocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " deallocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_file+1);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ }
+ else {
+ fortprintf(fd, " if (domain %% dminfo %% my_proc_id == 0) then</font>
<font color="blue">");
+ fortprintf(fd, " deallocate(recv%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " deallocate(send%sList %% list)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " deallocate(send%sList)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " deallocate(recv%sList)</font>
<font color="blue">", dim_ptr->name_in_code+1);
+ fortprintf(fd, " end if</font>
<font color="gray">");
+ }
+
+ }
+
+ dim_ptr = dim_ptr->next;
+ }
+
+ fclose(fd);
/*
@@ -842,12 +1242,14 @@
else if (var_ptr->vtype == CHARACTER) sprintf(vtype, "char");
if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
- fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", struct_deref, var_ptr->super_array);
- fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="blue">", struct_deref, var_ptr->super_array);
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. input_obj %% stream == STREAM_INPUT) .or. &</font>
<font color="blue">", struct_deref, var_ptr->super_array);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% sfc .and. input_obj %% stream == STREAM_SFC) .or. &</font>
<font color="blue">", struct_deref, var_ptr->super_array);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. input_obj %% stream == STREAM_RESTART)) then</font>
<font color="red">", struct_deref, var_ptr->super_array);
}
else {
- fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. .not. config_do_restart) .or. &</font>
<font color="red">", struct_deref, var_ptr->name_in_code);
- fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. config_do_restart)) then</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% input .and. input_obj %% stream == STREAM_INPUT) .or. &</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% sfc .and. input_obj %% stream == STREAM_SFC) .or. &</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. input_obj %% stream == STREAM_RESTART)) then</font>
<font color="gray">", struct_deref, var_ptr->name_in_code);
}
while (dimlist_ptr) {
if (i < var_ptr->ndims) {
@@ -860,12 +1262,13 @@
}
else {
if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="red">", vtype, var_ptr->ndims, i, cp1);
- fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount%s</font>
<font color="red">", vtype, var_ptr->ndims, i, cp1, cp2);
- free(cp1);
- free(cp2);
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file+1);
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file+1);
}
+ else if (dimlist_ptr->dim->constant_value > 0) {
+ fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = read%sCount</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
+ }
else {
if (dimlist_ptr->dim->namelist_defined) {
fortprintf(fd, " %s%id %% ioinfo %% start(%i) = read%sStart</font>
<font color="gray">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file+1);
@@ -894,12 +1297,10 @@
fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
}
else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, "read%sCount%s", cp1, cp2);
- free(cp1);
- free(cp2);
- }
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code))
+ fortprintf(fd, "read%sCount", dimlist_ptr->dim->name_in_file+1);
+ else if (dimlist_ptr->dim->constant_value > 0)
+ fortprintf(fd, "read%sCount", dimlist_ptr->dim->name_in_file);
else
if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, "read%sCount", dimlist_ptr->dim->name_in_file+1);
else fortprintf(fd, "read%sCount", dimlist_ptr->dim->name_in_code+1);
@@ -916,12 +1317,10 @@
fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
}
else {
- if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", read%sCount%s", cp1, cp2);
- free(cp1);
- free(cp2);
- }
+ if (is_derived_dim(dimlist_ptr->dim->name_in_code))
+ fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_file+1);
+ else if (dimlist_ptr->dim->constant_value > 0)
+ fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_file);
else
if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
else fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_file+1);
@@ -986,11 +1385,11 @@
else {
lastdim = dimlist_ptr;
if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, " read%sCount%s", cp1, cp2);
- free(cp1);
- free(cp2);
+ fortprintf(fd, " read%sCount", dimlist_ptr->dim->name_in_file+1);
}
+ else if (dimlist_ptr->dim->constant_value > 0) {
+ fortprintf(fd, " read%sCount", dimlist_ptr->dim->name_in_file);
+ }
else
if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " read%sCount", dimlist_ptr->dim->name_in_code+1);
else fortprintf(fd, " read%sCount", dimlist_ptr->dim->name_in_file+1);
@@ -1008,11 +1407,11 @@
else {
lastdim = dimlist_ptr;
if (is_derived_dim(dimlist_ptr->dim->name_in_code)) {
- split_derived_dim_string(dimlist_ptr->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", read%sCount%s", cp1, cp2);
- free(cp1);
- free(cp2);
+ fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_file+1);
}
+ else if (dimlist_ptr->dim->constant_value > 0) {
+ fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_file);
+ }
else
if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_code+1);
else fortprintf(fd, ", read%sCount", dimlist_ptr->dim->name_in_file+1);
@@ -1020,11 +1419,14 @@
dimlist_ptr = dimlist_ptr->next;
i++;
}
- if (!lastdim->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s, &</font>
<font color="red">", lastdim->dim->name_in_code);
- else fortprintf(fd, ", block %% mesh %% %s, &</font>
<font color="blue">", lastdim->dim->name_in_file);
+ if (lastdim->dim->namelist_defined) fortprintf(fd, ", block %% mesh %% %s, &</font>
<font color="blue">", lastdim->dim->name_in_file);
+ else if (lastdim->dim->constant_value > 0) fortprintf(fd, ", %s, &</font>
<font color="blue">", lastdim->dim->name_in_code);
+ else fortprintf(fd, ", block %% mesh %% %s, &</font>
<font color="black">", lastdim->dim->name_in_code);
if (is_derived_dim(lastdim->dim->name_in_code))
fortprintf(fd, " send%sList, recv%sList)</font>
<font color="blue">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
+ else if (lastdim->dim->constant_value > 0)
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="black">", lastdim->dim->name_in_file, lastdim->dim->name_in_file);
else
if (lastdim->dim->namelist_defined)
fortprintf(fd, " send%sList, recv%sList)</font>
<font color="gray">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
@@ -1186,29 +1588,39 @@
/*
- * Generate code to read 0d, 1d, 2d, 3d time-varying real fields
+ * Generate code to read 0d, 1d, 2d, 3d time-varying fields
*/
- for(i=0; i<=3; i++) {
- sprintf(fname, "input_field%idreal_time.inc", i);
- fd = fopen(fname, "w");
+ for(j=0; j<2; j++) {
+ for(i=0; i<=3; i++) {
+ if (j == 0) {
+ sprintf(fname, "input_field%idinteger_time.inc", i);
+ ivtype = INTEGER;
+ }
+ else {
+ sprintf(fname, "input_field%idreal_time.inc", i);
+ ivtype = REAL;
+ }
+ fd = fopen(fname, "w");
+
+ var_ptr = vars;
+ while (var_ptr && (var_ptr->ndims != i || var_ptr->vtype != ivtype || !var_ptr->timedim)) var_ptr = var_ptr->next;
+ if (var_ptr) {
+ fortprintf(fd, " if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">", var_ptr->name_in_file);
+ fortprintf(fd, " varID = input_obj %% rdVarID%s</font>
<font color="blue">", var_ptr->name_in_file);
+ var_ptr = var_ptr->next;
+ while (var_ptr) {
+ if (var_ptr->ndims == i && var_ptr->vtype == ivtype && var_ptr->timedim) {
+ fortprintf(fd, " else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">", var_ptr->name_in_file);
+ fortprintf(fd, " varID = input_obj %% rdVarID%s</font>
<font color="red">", var_ptr->name_in_file);
+ }
+ var_ptr = var_ptr->next;
- var_ptr = vars;
- while (var_ptr && (var_ptr->ndims != i || var_ptr->vtype != REAL || !var_ptr->timedim)) var_ptr = var_ptr->next;
- if (var_ptr) {
- fortprintf(fd, " if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">", var_ptr->name_in_file);
- fortprintf(fd, " varID = input_obj %% rdVarID%s</font>
<font color="red">", var_ptr->name_in_file);
- var_ptr = var_ptr->next;
- while (var_ptr) {
- if (var_ptr->ndims == i && var_ptr->vtype == REAL && var_ptr->timedim) {
- fortprintf(fd, " else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">", var_ptr->name_in_file);
- fortprintf(fd, " varID = input_obj %% rdVarID%s</font>
<font color="red">", var_ptr->name_in_file);
- }
- var_ptr = var_ptr->next;
- }
- fortprintf(fd, " end if</font>
<font color="blue">");
+ }
+ fortprintf(fd, " end if</font>
<font color="gray">");
+ }
+
+ fclose(fd);
}
-
- fclose(fd);
}
@@ -1351,6 +1763,7 @@
fortprintf(fd, " if (.false. &</font>
<font color="black">");
if (var_ptr->iostreams & RESTART0) fortprintf(fd, " .or. output_obj %% stream == RESTART &</font>
<font color="black">");
if (var_ptr->iostreams & OUTPUT0) fortprintf(fd, " .or. output_obj %% stream == OUTPUT &</font>
<font color="blue">");
+ if (var_ptr->iostreams & SFC0) fortprintf(fd, " .or. output_obj %% stream == SFC &</font>
<font color="black">");
fortprintf(fd, " ) then</font>
<font color="gray">");
dimlist_ptr = var_ptr->dimlist;
i = 1;
@@ -1423,11 +1836,13 @@
if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
fortprintf(fd, " if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", struct_deref, var_ptr->super_array);
- fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="blue">", struct_deref, var_ptr->super_array);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART) .or. &</font>
<font color="blue">", struct_deref, var_ptr->super_array);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% sfc .and. output_obj %% stream == SFC)) then</font>
<font color="black">", struct_deref, var_ptr->super_array);
}
else {
fortprintf(fd, " if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</font>
<font color="red">", struct_deref, var_ptr->name_in_code);
- fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART)) then</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% restart .and. output_obj %% stream == RESTART) .or. &</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, " (%s %% %s %% ioinfo %% sfc .and. output_obj %% stream == SFC)) then</font>
<font color="gray">", struct_deref, var_ptr->name_in_code);
}
if (var_ptr->ndims > 0) {
@@ -1448,6 +1863,9 @@
free(cp1);
free(cp2);
}
+ else if (dimlist_ptr->dim->constant_value > 0) {
+ fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %s</font>
<font color="blue">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
+ }
else
if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="black">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_code);
else fortprintf(fd, " %s%id %% ioinfo %% count(%i) = %sGlobal</font>
<font color="gray">", vtype, var_ptr->ndims, i, dimlist_ptr->dim->name_in_file);
@@ -1473,6 +1891,9 @@
free(cp1);
free(cp2);
}
+ else if (dimlist_ptr->dim->constant_value > 0) {
+ fortprintf(fd, "%s", dimlist_ptr->dim->name_in_code);
+ }
else
if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, "%sGlobal", dimlist_ptr->dim->name_in_code);
else fortprintf(fd, "%sGlobal", dimlist_ptr->dim->name_in_file);
@@ -1494,6 +1915,9 @@
free(cp1);
free(cp2);
}
+ else if (dimlist_ptr->dim->constant_value > 0) {
+ fortprintf(fd, ", %s", dimlist_ptr->dim->name_in_code);
+ }
else
if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, ", %sGlobal", dimlist_ptr->dim->name_in_code);
else fortprintf(fd, ", %sGlobal", dimlist_ptr->dim->name_in_file);
@@ -1586,21 +2010,54 @@
i++;
}
- if (is_derived_dim(lastdim->dim->name_in_code)) {
- split_derived_dim_string(lastdim->dim->name_in_code, &cp1, &cp2);
- fortprintf(fd, ", n%sGlobal%s, &</font>
<font color="red">", cp1, cp2);
- fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
- free(cp1);
- free(cp2);
+ /*
+ * Need to avoid output_obj in case this is a non-decomposed dimension, in which case
+ * the send/recv lists are local variables
+ */
+ if (strncmp(lastdim->dim->name_in_file,"nCells",1024) != 0 &&
+ strncmp(lastdim->dim->name_in_file,"nEdges",1024) != 0 &&
+ strncmp(lastdim->dim->name_in_file,"nVertices",1024) != 0 &&
+ strncmp(lastdim->dim->name_in_file,"nVertLevels",1024) != 0
+ ) {
+ if (is_derived_dim(lastdim->dim->name_in_code)) {
+ split_derived_dim_string(lastdim->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", n%sGlobal%s, &</font>
<font color="blue">", cp1, cp2);
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="blue">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
+ free(cp1);
+ free(cp2);
+ }
+ else if (lastdim->dim->constant_value > 0) {
+ fortprintf(fd, ", %s, &</font>
<font color="blue">", lastdim->dim->name_in_code);
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="blue">", lastdim->dim->name_in_file, lastdim->dim->name_in_file);
+ }
+ else {
+ if (!lastdim->dim->namelist_defined) {
+ fortprintf(fd, ", %sGlobal, &</font>
<font color="blue">", lastdim->dim->name_in_code);
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="blue">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
+ }
+ else {
+ fortprintf(fd, ", %sGlobal, &</font>
<font color="blue">", lastdim->dim->name_in_file);
+ fortprintf(fd, " send%sList, recv%sList)</font>
<font color="red">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
+ }
+ }
}
else {
- if (!lastdim->dim->namelist_defined) {
- fortprintf(fd, ", %sGlobal, &</font>
<font color="red">", lastdim->dim->name_in_code);
- fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="blue">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
+ if (is_derived_dim(lastdim->dim->name_in_code)) {
+ split_derived_dim_string(lastdim->dim->name_in_code, &cp1, &cp2);
+ fortprintf(fd, ", n%sGlobal%s, &</font>
<font color="blue">", cp1, cp2);
+ fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="red">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
+ free(cp1);
+ free(cp2);
}
else {
- fortprintf(fd, ", %sGlobal, &</font>
<font color="red">", lastdim->dim->name_in_file);
- fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="blue">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
+ if (!lastdim->dim->namelist_defined) {
+ fortprintf(fd, ", %sGlobal, &</font>
<font color="blue">", lastdim->dim->name_in_code);
+ fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="blue">", lastdim->dim->name_in_code+1, lastdim->dim->name_in_code+1);
+ }
+ else {
+ fortprintf(fd, ", %sGlobal, &</font>
<font color="blue">", lastdim->dim->name_in_file);
+ fortprintf(fd, " output_obj %% send%sList, output_obj %% recv%sList)</font>
<font color="gray">", lastdim->dim->name_in_file+1, lastdim->dim->name_in_file+1);
+ }
}
}
}
@@ -1669,29 +2126,38 @@
/*
- * Generate code to write 0d, 1d, 2d, 3d real time-varying fields
+ * Generate code to write 0d, 1d, 2d, 3d time-varying fields
*/
- for(i=0; i<=3; i++) {
- sprintf(fname, "output_field%idreal_time.inc", i);
- fd = fopen(fname, "w");
-
- var_ptr = vars;
- while (var_ptr && (var_ptr->ndims != i || var_ptr->vtype != REAL || !var_ptr->timedim)) var_ptr = var_ptr->next;
- if (var_ptr) {
- fortprintf(fd, " if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">", var_ptr->name_in_file);
- fortprintf(fd, " varID = output_obj %% wrVarID%s</font>
<font color="red">", var_ptr->name_in_file);
- var_ptr = var_ptr->next;
- while (var_ptr) {
- if (var_ptr->ndims == i && var_ptr->vtype == REAL && var_ptr->timedim) {
- fortprintf(fd, " else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="red">", var_ptr->name_in_file);
- fortprintf(fd, " varID = output_obj %% wrVarID%s</font>
<font color="blue">", var_ptr->name_in_file);
+ for(j=0; j<2; j++) {
+ for(i=0; i<=3; i++) {
+ if (j == 0) {
+ sprintf(fname, "output_field%idinteger_time.inc", i);
+ ivtype = INTEGER;
+ }
+ else {
+ sprintf(fname, "output_field%idreal_time.inc", i);
+ ivtype = REAL;
+ }
+ fd = fopen(fname, "w");
+
+ var_ptr = vars;
+ while (var_ptr && (var_ptr->ndims != i || var_ptr->vtype != ivtype || !var_ptr->timedim)) var_ptr = var_ptr->next;
+ if (var_ptr) {
+ fortprintf(fd, " if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">", var_ptr->name_in_file);
+ fortprintf(fd, " varID = output_obj %% wrVarID%s</font>
<font color="blue">", var_ptr->name_in_file);
+ var_ptr = var_ptr->next;
+ while (var_ptr) {
+ if (var_ptr->ndims == i && var_ptr->vtype == ivtype && var_ptr->timedim) {
+ fortprintf(fd, " else if (trim(field %% ioinfo %% fieldName) == \'%s\') then</font>
<font color="blue">", var_ptr->name_in_file);
+ fortprintf(fd, " varID = output_obj %% wrVarID%s</font>
<font color="red">", var_ptr->name_in_file);
+ }
+ var_ptr = var_ptr->next;
}
- var_ptr = var_ptr->next;
+ fortprintf(fd, " end if</font>
<font color="red">");
}
- fortprintf(fd, " end if</font>
<font color="gray">");
+
+ fclose(fd);
}
-
- fclose(fd);
}
Modified: trunk/mpas/src/registry/parse.c
===================================================================
--- trunk/mpas/src/registry/parse.c 2011-09-15 17:39:20 UTC (rev 1000)
+++ trunk/mpas/src/registry/parse.c 2011-09-15 17:43:05 UTC (rev 1001)
@@ -197,6 +197,7 @@
*/
getword(regfile, word);
if (strchr(word, (int)'i')) var_ptr->iostreams |= INPUT0;
+ if (strchr(word, (int)'s')) var_ptr->iostreams |= SFC0;
if (strchr(word, (int)'r')) var_ptr->iostreams |= RESTART0;
if (strchr(word, (int)'o')) var_ptr->iostreams |= OUTPUT0;
Modified: trunk/mpas/src/registry/registry_types.h
===================================================================
--- trunk/mpas/src/registry/registry_types.h 2011-09-15 17:39:20 UTC (rev 1000)
+++ trunk/mpas/src/registry/registry_types.h 2011-09-15 17:43:05 UTC (rev 1001)
@@ -9,6 +9,7 @@
#define INPUT0 0x00000001
#define RESTART0 0x00000002
#define OUTPUT0 0x00000004
+#define SFC0 0x00000008
#define NEW_NAMELIST(X) X = (struct namelist *)malloc(sizeof(struct namelist)); X->next = NULL;
#define NEW_DIMENSION(X) X = (struct dimension *)malloc(sizeof(struct dimension)); X->next = NULL;
</font>
</pre>