<p><b>duda</b> 2012-04-03 16:07:41 -0600 (Tue, 03 Apr 2012)</p><p>BRANCH COMMIT<br>
<br>
Convert mpas_io_output module to use new stream IO layer.<br>
<br>
<br>
M src/registry/gen_inc.c<br>
M src/framework/mpas_io_output.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/omp_blocks/io/src/framework/mpas_io_output.F
===================================================================
--- branches/omp_blocks/io/src/framework/mpas_io_output.F 2012-04-03 20:57:13 UTC (rev 1744)
+++ branches/omp_blocks/io/src/framework/mpas_io_output.F 2012-04-03 22:07:41 UTC (rev 1745)
@@ -11,47 +11,15 @@
integer, parameter :: SFC = 3
type io_output_object
- integer :: wr_ncid
character (len=1024) :: filename
integer :: stream
integer :: time
type (MPAS_Stream_type) :: io_stream
-
- integer :: wrDimIDStrLen
-#include "io_output_obj_decls.inc"
-
- logical :: validExchangeLists
- type (exchange_list), pointer :: sendCellsList, recvCellsList
- type (exchange_list), pointer :: sendEdgesList, recvEdgesList
- type (exchange_list), pointer :: sendVerticesList, recvVerticesList
- type (exchange_list), pointer :: sendVertLevelsList, recvVertLevelsList
end type io_output_object
- interface mpas_io_output_field
- module procedure mpas_io_output_field0d_real
- module procedure mpas_io_output_field1d_real
- module procedure mpas_io_output_field2d_real
- module procedure mpas_io_output_field3d_real
- module procedure mpas_io_output_field1d_integer
- module procedure mpas_io_output_field2d_integer
- module procedure mpas_io_output_field0d_char
- module procedure mpas_io_output_field1d_char
- end interface mpas_io_output_field
-
- interface mpas_io_output_field_time
- module procedure mpas_io_output_field0d_real_time
- module procedure mpas_io_output_field1d_real_time
- module procedure mpas_io_output_field2d_real_time
- module procedure mpas_io_output_field3d_real_time
- module procedure mpas_io_output_field1d_integer_time
- module procedure mpas_io_output_field0d_char_time
- module procedure mpas_io_output_field1d_char_time
- end interface mpas_io_output_field_time
-
-
contains
@@ -67,26 +35,9 @@
character (len=128) :: tempfilename
type (block_type), pointer :: block_ptr
-#include "output_dim_actual_decls.inc"
block_ptr => domain % blocklist
- nullify(output_obj % sendCellsList)
- nullify(output_obj % recvCellsList)
- nullify(output_obj % sendEdgesList)
- nullify(output_obj % recvEdgesList)
- nullify(output_obj % sendVerticesList)
- nullify(output_obj % recvVerticesList)
- nullify(output_obj % sendVertLevelsList)
- nullify(output_obj % recvVertLevelsList)
- output_obj % validExchangeLists = .false.
-#include "output_dim_inits.inc"
-
- call mpas_dmpar_sum_int(domain % dminfo, block_ptr % mesh % nCellsSolve, nCellsGlobal)
- call mpas_dmpar_sum_int(domain % dminfo, block_ptr % mesh % nEdgesSolve, nEdgesGlobal)
- call mpas_dmpar_sum_int(domain % dminfo, block_ptr % mesh % nVerticesSolve, nVerticesGlobal)
- nVertLevelsGlobal = block_ptr % mesh % nVertLevels
-
if (trim(stream) == 'OUTPUT') then
if(present(outputSuffix)) then
call mpas_insert_string_suffix(config_output_name, outputSuffix, tempfilename)
@@ -111,9 +62,8 @@
! For now, we assume that a domain consists only of one block,
! although in future, work needs to be done to write model state
! from many distributed blocks
- call mpas_io_output_init(output_obj, domain % dminfo, &
- block_ptr % mesh, &
-#include "output_dim_actual_args.inc"
+ call mpas_io_output_init(domain, output_obj, domain % dminfo, &
+ block_ptr % mesh &
)
end subroutine mpas_output_state_init
@@ -153,15 +103,8 @@
type (domain_type), intent(inout) :: domain
integer, intent(in) :: itime
+ integer :: ierr
integer :: i, j
- integer :: nCellsGlobal
- integer :: nEdgesGlobal
- integer :: nVerticesGlobal
- integer :: nVertLevelsGlobal
- integer, dimension(:), pointer :: neededCellList
- integer, dimension(:), pointer :: neededEdgeList
- integer, dimension(:), pointer :: neededVertexList
- integer, dimension(:), pointer :: neededVertLevelList
integer, dimension(:,:), pointer :: cellsOnCell, edgesOnCell, verticesOnCell, &
cellsOnEdge, verticesOnEdge, edgesOnEdge, cellsOnVertex, edgesOnVertex
integer, dimension(:,:), pointer :: cellsOnCell_save, edgesOnCell_save, verticesOnCell_save, &
@@ -176,35 +119,8 @@
type (field0dChar) :: char0d
type (field1dChar) :: char1d
- integer :: i1, i2, i3, i4
-
- integer, dimension(:), pointer :: super_int1d
- integer, dimension(:,:), pointer :: super_int2d
- real (kind=RKIND) :: super_real0d
- real (kind=RKIND), dimension(:), pointer :: super_real1d
- real (kind=RKIND), dimension(:,:), pointer :: super_real2d
- real (kind=RKIND), dimension(:,:,:), pointer :: super_real3d
- character (len=64) :: super_char0d
- character (len=64), dimension(:), pointer :: super_char1d
-
-#include "nondecomp_outputs.inc"
-
output_obj % time = itime
- allocate(int1d % ioinfo)
- allocate(int2d % ioinfo)
- allocate(real0d % ioinfo)
- allocate(real1d % ioinfo)
- allocate(real2d % ioinfo)
- allocate(real3d % ioinfo)
- allocate(char0d % ioinfo)
- allocate(char1d % ioinfo)
-
- call mpas_dmpar_sum_int(domain % dminfo, domain % blocklist % mesh % nCellsSolve, nCellsGlobal)
- call mpas_dmpar_sum_int(domain % dminfo, domain % blocklist % mesh % nEdgesSolve, nEdgesGlobal)
- call mpas_dmpar_sum_int(domain % dminfo, domain % blocklist % mesh % nVerticesSolve, nVerticesGlobal)
- nVertLevelsGlobal = domain % blocklist % mesh % nVertLevels
-
allocate(cellsOnCell(domain % blocklist % mesh % maxEdges, domain % blocklist % mesh % nCellsSolve))
allocate(edgesOnCell(domain % blocklist % mesh % maxEdges, domain % blocklist % mesh % nCellsSolve))
allocate(verticesOnCell(domain % blocklist % mesh % maxEdges, domain % blocklist % mesh % nCellsSolve))
@@ -265,58 +181,6 @@
end do
end do
- if (domain % dminfo % my_proc_id == 0) then
- allocate(neededCellList(nCellsGlobal))
- allocate(neededEdgeList(nEdgesGlobal))
- allocate(neededVertexList(nVerticesGlobal))
- allocate(neededVertLevelList(nVertLevelsGlobal))
- do i=1,nCellsGlobal
- neededCellList(i) = i
- end do
- do i=1,nEdgesGlobal
- neededEdgeList(i) = i
- end do
- do i=1,nVerticesGlobal
- neededVertexList(i) = i
- end do
- do i=1,nVertLevelsGlobal
- neededVertLevelList(i) = i
- end do
- else
- allocate(neededCellList(0))
- allocate(neededEdgeList(0))
- allocate(neededVertexList(0))
- allocate(neededVertLevelList(0))
- end if
-
- if (.not. output_obj % validExchangeLists) then
- call mpas_dmpar_get_owner_list(domain % dminfo, &
- domain % blocklist % mesh % nCellsSolve, size(neededCellList), &
- domain % blocklist % mesh % indexToCellID % array, neededCellList, &
- output_obj % sendCellsList, output_obj % recvCellsList)
-
- call mpas_dmpar_get_owner_list(domain % dminfo, &
- domain % blocklist % mesh % nEdgesSolve, size(neededEdgeList), &
- domain % blocklist % mesh % indexToEdgeID % array, neededEdgeList, &
- output_obj % sendEdgesList, output_obj % recvEdgesList)
-
- call mpas_dmpar_get_owner_list(domain % dminfo, &
- domain % blocklist % mesh % nVerticesSolve, size(neededVertexList), &
- domain % blocklist % mesh % indexToVertexID % array, neededVertexList, &
- output_obj % sendVerticesList, output_obj % recvVerticesList)
-
- call mpas_dmpar_get_owner_list(domain % dminfo, &
- size(neededVertLevelList), size(neededVertLevelList), &
- neededVertLevelList, neededVertLevelList, &
- output_obj % sendVertLevelsList, output_obj % recvVertLevelsList)
-
- output_obj % validExchangeLists = .true.
- end if
-
- deallocate(neededCellList)
- deallocate(neededEdgeList)
- deallocate(neededVertexList)
-
cellsOnCell_save => domain % blocklist % mesh % cellsOnCell % array
edgesOnCell_save => domain % blocklist % mesh % edgesOnCell % array
verticesOnCell_save => domain % blocklist % mesh % verticesOnCell % array
@@ -335,7 +199,7 @@
domain % blocklist % mesh % cellsOnVertex % array => cellsOnVertex
domain % blocklist % mesh % edgesOnVertex % array => edgesOnVertex
-#include "io_output_fields.inc"
+ call MPAS_writeStream(output_obj % io_stream, output_obj % time, ierr)
domain % blocklist % mesh % cellsOnCell % array => cellsOnCell_save
domain % blocklist % mesh % edgesOnCell % array => edgesOnCell_save
@@ -355,8 +219,6 @@
deallocate(cellsOnVertex)
deallocate(edgesOnVertex)
-#include "nondecomp_outputs_dealloc.inc"
-
end subroutine mpas_output_state_for_domain
@@ -372,504 +234,47 @@
end subroutine mpas_output_state_finalize
- subroutine mpas_io_output_init( output_obj, &
+ subroutine mpas_io_output_init( domain, output_obj, &
dminfo, &
- mesh, &
-#include "dim_dummy_args.inc"
+ mesh &
)
implicit none
- include 'netcdf.inc'
-
+ type (domain_type), intent(in) :: domain
type (io_output_object), intent(inout) :: output_obj
type (dm_info), intent(in) :: dminfo
type (mesh_type), intent(in) :: mesh
-#include "dim_dummy_decls.inc"
- integer :: nferr
+ integer :: nferr, ierr
integer, dimension(10) :: dimlist
- if (dminfo % my_proc_id == 0) then
-#ifdef OFFSET64BIT
- nferr = nf_create(trim(output_obj % filename), ior(NF_CLOBBER,NF_64BIT_OFFSET), output_obj % wr_ncid)
-#else
- nferr = nf_create(trim(output_obj % filename), NF_CLOBBER, output_obj % wr_ncid)
-#endif
-
- nferr = nf_def_dim(output_obj % wr_ncid, 'StrLen', 64, output_obj % wrDimIDStrLen)
-#include "netcdf_def_dims_vars.inc"
+ call MPAS_createStream(output_obj % io_stream, trim(output_obj % filename), MPAS_IO_PNETCDF, MPAS_IO_WRITE, 1, nferr)
+#include "add_output_fields.inc"
+
if (mesh % on_a_sphere) then
- nferr = nf_put_att_text(output_obj % wr_ncid, NF_GLOBAL, 'on_a_sphere', 16, 'YES ')
+ call MPAS_writeStreamAtt(output_obj % io_stream, 'on_a_sphere', 'YES ', nferr)
else
- nferr = nf_put_att_text(output_obj % wr_ncid, NF_GLOBAL, 'on_a_sphere', 16, 'NO ')
+ call MPAS_writeStreamAtt(output_obj % io_stream, 'on_a_sphere', 'NO ', nferr)
end if
- if (RKIND == 8) then
- nferr = nf_put_att_double(output_obj % wr_ncid, NF_GLOBAL, 'sphere_radius', NF_DOUBLE, 1, mesh % sphere_radius)
- else
- nferr = nf_put_att_real(output_obj % wr_ncid, NF_GLOBAL, 'sphere_radius', NF_FLOAT, 1, mesh % sphere_radius)
- end if
+ call MPAS_writeStreamAtt(output_obj % io_stream, 'sphere_radius', mesh % sphere_radius, nferr)
+
+#include "add_output_atts.inc"
- nferr = nf_enddef(output_obj % wr_ncid)
- end if
-
end subroutine mpas_io_output_init
- subroutine mpas_io_output_field0d_real(output_obj, field)
-
- implicit none
-
- type (io_output_object), intent(in) :: output_obj
- type (field0dReal), intent(inout) :: field
-
- include 'netcdf.inc'
-
- integer :: nferr
- integer :: varID
- integer, dimension(1) :: start1, count1
-
- start1(1) = 1
- count1(1) = 1
-
-#include "output_field0dreal.inc"
-
-#ifdef SINGLE_PRECISION
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start1, count1, field % scalar)
-#else
- nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start1, count1, field % scalar)
-#endif
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field0d_real
-
-
- subroutine mpas_io_output_field1d_real(output_obj, field)
-
- implicit none
-
- type (io_output_object), intent(in) :: output_obj
- type (field1dReal), intent(inout) :: field
-
- include 'netcdf.inc'
-
- integer :: nferr
- integer :: varID
- integer, dimension(1) :: start1, count1
-
- start1(1) = field % ioinfo % start(1)
- count1(1) = field % ioinfo % count(1)
-
-#include "output_field1dreal.inc"
-
-#ifdef SINGLE_PRECISION
- nferr = nf_put_vara_real(output_obj % wr_ncid, VarID, start1, count1, field % array)
-#else
- nferr = nf_put_vara_double(output_obj % wr_ncid, VarID, start1, count1, field % array)
-#endif
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field1d_real
-
-
- subroutine mpas_io_output_field2d_real(output_obj, field)
-
- implicit none
-
- type (io_output_object), intent(in) :: output_obj
- type (field2dReal), intent(inout) :: field
-
- include 'netcdf.inc'
-
- integer :: nferr
- integer :: varID
- integer, dimension(2) :: start2, count2
-
- start2(1) = field % ioinfo % start(1)
- start2(2) = field % ioinfo % start(2)
- count2(1) = field % ioinfo % count(1)
- count2(2) = field % ioinfo % count(2)
-
-#include "output_field2dreal.inc"
-
-#ifdef SINGLE_PRECISION
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start2, count2, field % array)
-#else
- nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start2, count2, field % array)
-#endif
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field2d_real
-
-
- subroutine mpas_io_output_field3d_real(output_obj, field)
-
- implicit none
-
- type (io_output_object), intent(in) :: output_obj
- type (field3dReal), intent(inout) :: field
-
- include 'netcdf.inc'
-
- integer :: nferr
- integer :: varID
- integer, dimension(3) :: start3, count3
-
- start3(1) = field % ioinfo % start(1)
- start3(2) = field % ioinfo % start(2)
- start3(3) = field % ioinfo % start(3)
- count3(1) = field % ioinfo % count(1)
- count3(2) = field % ioinfo % count(2)
- count3(3) = field % ioinfo % count(3)
-
-#include "output_field3dreal.inc"
-
-#ifdef SINGLE_PRECISION
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start3, count3, field % array)
-#else
- nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start3, count3, field % array)
-#endif
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field3d_real
-
-
- subroutine mpas_io_output_field0d_real_time(output_obj, field)
-
- implicit none
-
- type (io_output_object), intent(in) :: output_obj
- type (field0dReal), intent(inout) :: field
-
- include 'netcdf.inc'
-
- integer :: nferr
- integer :: varID
- integer, dimension(1) :: start1, count1
-
- start1(1) = output_obj % time
- count1(1) = 1
-
-#include "output_field0dreal_time.inc"
-
-#ifdef SINGLE_PRECISION
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start1, count1, field % scalar)
-#else
- nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start1, count1, field % scalar)
-#endif
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field0d_real_time
-
-
- subroutine mpas_io_output_field1d_real_time(output_obj, field)
-
- implicit none
-
- type (io_output_object), intent(in) :: output_obj
- type (field1dReal), 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_field1dreal_time.inc"
-
-#ifdef SINGLE_PRECISION
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start2, count2, field % array)
-#else
- nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start2, count2, field % array)
-#endif
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field1d_real_time
-
-
- subroutine mpas_io_output_field2d_real_time(output_obj, field)
-
- implicit none
-
- type (io_output_object), intent(in) :: output_obj
- type (field2dReal), intent(inout) :: field
-
- include 'netcdf.inc'
-
- integer :: nferr
- integer :: varID
- integer, dimension(3) :: start3, count3
-
- start3(1) = field % ioinfo % start(1)
- start3(2) = field % ioinfo % start(2)
- start3(3) = output_obj % time
- count3(1) = field % ioinfo % count(1)
- count3(2) = field % ioinfo % count(2)
- count3(3) = 1
-
-#include "output_field2dreal_time.inc"
-
-#ifdef SINGLE_PRECISION
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start3, count3, field % array)
-#else
- nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start3, count3, field % array)
-#endif
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field2d_real_time
-
-
- subroutine mpas_io_output_field3d_real_time(output_obj, field)
-
- implicit none
-
- type (io_output_object), intent(in) :: output_obj
- type (field3dReal), intent(inout) :: field
-
- include 'netcdf.inc'
-
- integer :: nferr
- integer :: varID
- integer, dimension(4) :: start4, count4
-
- start4(1) = field % ioinfo % start(1)
- start4(2) = field % ioinfo % start(2)
- start4(3) = field % ioinfo % start(3)
- start4(4) = output_obj % time
- count4(1) = field % ioinfo % count(1)
- count4(2) = field % ioinfo % count(2)
- count4(3) = field % ioinfo % count(3)
- count4(4) = 1
-
-#include "output_field3dreal_time.inc"
-
-#ifdef SINGLE_PRECISION
- nferr = nf_put_vara_real(output_obj % wr_ncid, varID, start4, count4, field % array)
-#else
- nferr = nf_put_vara_double(output_obj % wr_ncid, varID, start4, count4, field % array)
-#endif
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field3d_real_time
-
-
- subroutine mpas_io_output_field1d_integer(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(1) :: start1, count1
-
- start1(1) = field % ioinfo % start(1)
- count1(1) = field % ioinfo % count(1)
-
-#include "output_field1dinteger.inc"
-
- nferr = nf_put_vara_int(output_obj % wr_ncid, varID, start1, count1, field % array)
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field1d_integer
-
-
- subroutine mpas_io_output_field2d_integer(output_obj, field)
-
- implicit none
-
- type (io_output_object), intent(in) :: output_obj
- type (field2dInteger), intent(inout) :: field
-
- include 'netcdf.inc'
-
- integer :: nferr
- integer :: varID
- integer, dimension(2) :: start2, count2
-
- start2(1) = field % ioinfo % start(1)
- start2(2) = field % ioinfo % start(2)
- count2(1) = field % ioinfo % count(1)
- count2(2) = field % ioinfo % count(2)
-
-#include "output_field2dinteger.inc"
-
- nferr = nf_put_vara_int(output_obj % wr_ncid, varID, start2, count2, field % array)
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field2d_integer
-
-
- subroutine mpas_io_output_field1d_integer_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 mpas_io_output_field1d_integer_time
-
-
- subroutine mpas_io_output_field0d_char_time(output_obj, field)
-
- implicit none
-
- type (io_output_object), intent(in) :: output_obj
- type (field0dChar), intent(inout) :: field
-
- include 'netcdf.inc'
-
- integer :: nferr
- integer :: varID
- integer, dimension(2) :: start1, count1
-
- start1(1) = 1
- count1(1) = 64
- start1(2) = output_obj % time
- count1(2) = 1
-
-#include "output_field0dchar_time.inc"
-
- nferr = nf_put_vara_text(output_obj % wr_ncid, varID, start1, count1, field % scalar)
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field0d_char_time
-
-
- subroutine mpas_io_output_field1d_char_time(output_obj, field)
-
- implicit none
-
- type (io_output_object), intent(in) :: output_obj
- type (field1dChar), intent(inout) :: field
-
- include 'netcdf.inc'
-
- integer :: nferr
- integer :: varID
- integer, dimension(3) :: start2, count2
-
- start2(1) = 1
- start2(2) = field % ioinfo % start(1)
- start2(3) = output_obj % time
- count2(1) = 64
- count2(2) = field % ioinfo % count(1)
- count2(3) = 1
-
-#include "output_field1dchar_time.inc"
-
- nferr = nf_put_vara_text(output_obj % wr_ncid, varID, start2, count2, field % array)
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field1d_char_time
-
-
- subroutine mpas_io_output_field0d_char(output_obj, field)
-
- implicit none
-
- type (io_output_object), intent(in) :: output_obj
- type (field0dChar), intent(inout) :: field
-
- include 'netcdf.inc'
-
- integer :: nferr
- integer :: varID
- integer, dimension(2) :: start1, count1
-
- start1(1) = 1
- count1(1) = 64
- start1(2) = 1
- count1(2) = 1
-
-#include "output_field0dchar.inc"
-
- nferr = nf_put_vara_text(output_obj % wr_ncid, varID, start1, count1, field % scalar)
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field0d_char
-
-
- subroutine mpas_io_output_field1d_char(output_obj, field)
-
- implicit none
-
- type (io_output_object), intent(in) :: output_obj
- type (field1dChar), intent(inout) :: field
-
- include 'netcdf.inc'
-
- integer :: nferr
- integer :: varID
- integer, dimension(2) :: start1, count1
-
- start1(1) = 1
- count1(1) = 64
- start1(2) = field % ioinfo % start(1)
- count1(2) = field % ioinfo % count(1)
-
-#include "output_field1dchar.inc"
-
- nferr = nf_put_vara_text(output_obj % wr_ncid, VarID, start1, count1, field % array)
-
- nferr = nf_sync(output_obj % wr_ncid)
-
- end subroutine mpas_io_output_field1d_char
-
-
subroutine mpas_io_output_finalize(output_obj, dminfo)
implicit none
- include 'netcdf.inc'
-
type (io_output_object), intent(inout) :: output_obj
type (dm_info), intent(in) :: dminfo
integer :: nferr
- if (dminfo % my_proc_id == 0) then
- nferr = nf_close(output_obj % wr_ncid)
- end if
+ call MPAS_closeStream(output_obj % io_stream, nferr)
end subroutine mpas_io_output_finalize
Modified: branches/omp_blocks/io/src/registry/gen_inc.c
===================================================================
--- branches/omp_blocks/io/src/registry/gen_inc.c 2012-04-03 20:57:13 UTC (rev 1744)
+++ branches/omp_blocks/io/src/registry/gen_inc.c 2012-04-03 22:07:41 UTC (rev 1745)
@@ -1273,6 +1273,7 @@
fclose(fd);
+#ifdef LEGACY_CODE
/*
* Definitions of read bounds and exchange lists for non-decomposed fields
*/
@@ -1476,6 +1477,7 @@
}
fclose(fd);
+#endif
/*
@@ -1747,6 +1749,32 @@
/*
+ * MGD NEW CODE
+ */
+ fd = fopen("add_input_fields.inc", "w");
+
+ group_ptr = groups;
+ while (group_ptr) {
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
+
+ if (group_ptr->vlist->var->ntime_levs > 1)
+ snprintf(struct_deref, 1024, "block %% %s %% time_levs(1) %% %s", group_ptr->name, group_ptr->name);
+ else
+ snprintf(struct_deref, 1024, "block %% %s", group_ptr->name);
+
+ fortprintf(fd, " call MPAS_streamAddField(input_obj %% io_stream, %s %% %s, ierr)</font>
<font color="gray">", struct_deref, var_ptr->name_in_code);
+
+ var_list_ptr = var_list_ptr->next;
+ }
+ group_ptr = group_ptr->next;
+ }
+
+ fclose(fd);
+
+
+ /*
* Generate NetCDF reads of dimension and variable IDs
*/
fd = fopen("netcdf_read_ids.inc", "w");
@@ -1925,11 +1953,13 @@
char vtype[5];
char fname[32];
char struct_deref[1024];
+ char super_array[1024];
char * cp1, * cp2;
int i, j;
int ivtype;
+#ifdef LEGACY_CODE
/*
* Generate declarations of IDs belonging in io_output_object
*/
@@ -2069,9 +2099,77 @@
}
fclose(fd);
+#endif
+
+
+ /*
+ * MGD NEW CODE
+ */
+ fd = fopen("add_output_fields.inc", "w");
+
+ group_ptr = groups;
+ while (group_ptr) {
+ var_list_ptr = group_ptr->vlist;
+ while (var_list_ptr) {
+ var_ptr = var_list_ptr->var;
+
+ if (group_ptr->vlist->var->ntime_levs > 1)
+ snprintf(struct_deref, 1024, "domain %% blocklist %% %s %% time_levs(1) %% %s", group_ptr->name, group_ptr->name);
+ else
+ snprintf(struct_deref, 1024, "domain %% blocklist %% %s", group_ptr->name);
+
+ if (strncmp(var_ptr->super_array, "-", 1024) != 0) {
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</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="blue">", struct_deref, var_ptr->super_array);
+ memcpy(super_array, var_ptr->super_array, 1024);
+ fortprintf(fd, " call MPAS_streamAddField(output_obj %% io_stream, %s %% %s, ierr)</font>
<font color="blue">", struct_deref, super_array);
+ while (var_list_ptr && strncmp(super_array, var_list_ptr->var->super_array, 1024) == 0) {
+ var_list_ptr = var_list_ptr->next;
+ }
+ }
+ else {
+ fortprintf(fd, " if ((%s %% %s %% ioinfo %% output .and. output_obj %% stream == OUTPUT) .or. &</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="blue">", struct_deref, var_ptr->name_in_code);
+ fortprintf(fd, " call MPAS_streamAddField(output_obj %% io_stream, %s %% %s, ierr)</font>
<font color="blue">", struct_deref, var_ptr->name_in_code);
+ }
+ fortprintf(fd, " end if</font>
<font color="black"></font>
<font color="blue">");
+ if (var_list_ptr) var_list_ptr = var_list_ptr->next;
+ }
+ group_ptr = group_ptr->next;
+ }
+
+ fclose(fd);
+
+
/*
+ * MGD NEW CODE
+ */
+ fd = fopen("add_output_atts.inc", "w");
+
+ nl = namelists;
+ while (nl) {
+ if (nl->vtype == LOGICAL) {
+ fortprintf(fd, " if (%s) then</font>
<font color="blue">", nl->name);
+ fortprintf(fd, " call MPAS_writeStreamAtt(output_obj %% io_stream, \'%s\', 'T', ierr)</font>
<font color="blue">", nl->name);
+ fortprintf(fd, " else</font>
<font color="blue">");
+ fortprintf(fd, " call MPAS_writeStreamAtt(output_obj %% io_stream, \'%s\', 'F', ierr)</font>
<font color="blue">", nl->name);
+ fortprintf(fd, " end if</font>
<font color="blue">");
+ }
+ else {
+ fortprintf(fd, " call MPAS_writeStreamAtt(output_obj %% io_stream, \'%s\', %s, ierr)</font>
<font color="gray">", nl->name, nl->name);
+ }
+ nl = nl->next;
+ }
+
+ fclose(fd);
+
+
+#ifdef LEGACY_CODE
+ /*
* Generate collect and write code
*/
fd = fopen("io_output_fields.inc", "w");
@@ -2445,5 +2543,6 @@
fclose(fd);
}
+#endif
}
</font>
</pre>