<p><b>duda</b> 2012-03-22 14:55:04 -0600 (Thu, 22 Mar 2012)</p><p>Add functionality for writing streams (currently just for 1d integer fields).<br>
<br>
<br>
M src/framework/mpas_io_streams.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/omp_blocks/io/src/framework/mpas_io_streams.F
===================================================================
--- branches/omp_blocks/io/src/framework/mpas_io_streams.F 2012-03-22 16:52:53 UTC (rev 1695)
+++ branches/omp_blocks/io/src/framework/mpas_io_streams.F 2012-03-22 20:55:04 UTC (rev 1696)
@@ -121,6 +121,7 @@
integer :: ndims
type (field1dInteger), pointer :: field_ptr
character (len=64), dimension(5) :: dimNames
+ character (len=64), dimension(:), pointer :: dimNamesInq
integer, dimension(:), pointer :: indices
type (field_list_type), pointer :: field_list_cursor
type (field_list_type), pointer :: new_field_list_node
@@ -234,6 +235,56 @@
else if (stream % ioDirection == MPAS_IO_READ) then
write(0,*) '... inquiring about'
+ call MPAS_io_inq_var(stream % fileHandle, trim(field % fieldName), dimnames=dimNamesInq, ierr=io_err)
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ return
+ end if
+
+ do i=1,ndims
+write(0,*) 'Comparing '//trim(field % dimNames(i))//' '//trim(dimNamesInq(i))
+ end do
+
+ ! Define outer-most dimension; handle known decomposed dimensions
+ idim = ndims
+ localDimSize = 0
+ field_ptr => field
+ if (trim(field % dimNames(idim)) == 'nCells') then
+write(0,*) '... outer dimension is nCells'
+ do while (associated(field_ptr))
+ localDimSize = localDimSize + field_ptr % block % mesh % nCellsSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, localDimSize, globalDimSize)
+ new_field_list_node % isDecomposed = .true.
+ new_field_list_node % totalDimSize = localDimSize
+ else if (trim(field % dimNames(idim)) == 'nEdges') then
+write(0,*) '... outer dimension is nEdges'
+ do while (associated(field_ptr))
+ localDimSize = localDimSize + field_ptr % block % mesh % nEdgesSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, localDimSize, globalDimSize)
+ new_field_list_node % isDecomposed = .true.
+ new_field_list_node % totalDimSize = localDimSize
+ else if (trim(field % dimNames(idim)) == 'nVertices') then
+write(0,*) '... outer dimension is nVertices'
+ do while (associated(field_ptr))
+ localDimSize = localDimSize + field_ptr % block % mesh % nVerticesSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, localDimSize, globalDimSize)
+ new_field_list_node % isDecomposed = .true.
+ new_field_list_node % totalDimSize = localDimSize
+ else
+ globalDimSize = field % dimSizes(idim)
+ new_field_list_node % isDecomposed = .false.
+ new_field_list_node % totalDimSize = globalDimSize
+ end if
+
+ deallocate(dimNamesInq)
+
end if
@@ -318,6 +369,29 @@
integer, intent(in) :: frame
integer, intent(out), optional :: ierr
+ integer :: io_err
+ integer :: i
+ integer :: ownedSize
+ type (field0dInteger), pointer :: field_0dint_ptr
+ type (field1dInteger), pointer :: field_1dint_ptr
+ type (field2dInteger), pointer :: field_2dint_ptr
+ type (field3dInteger), pointer :: field_3dint_ptr
+ type (field0dReal), pointer :: field_0dreal_ptr
+ type (field1dReal), pointer :: field_1dreal_ptr
+ type (field2dReal), pointer :: field_2dreal_ptr
+ type (field3dReal), pointer :: field_3dreal_ptr
+ type (field0dChar), pointer :: field_0dchar_ptr
+ type (field1dChar), pointer :: field_1dchar_ptr
+ type (field_list_type), pointer :: field_cursor
+ integer :: int0d_temp
+ integer, dimension(:), pointer :: int1d_temp
+ integer, dimension(:,:), pointer :: int2d_temp
+ integer, dimension(:,:,:), pointer :: int3d_temp
+ real (kind=RKIND) :: real0d_temp
+ real (kind=RKIND), dimension(:), pointer :: real1d_temp
+ real (kind=RKIND), dimension(:,:), pointer :: real2d_temp
+ real (kind=RKIND), dimension(:,:,:), pointer :: real3d_temp
+
if (present(ierr)) ierr = MPAS_STREAM_NOERR
!
@@ -328,6 +402,87 @@
return
end if
+
+ !
+ ! Set time frame to real
+ !
+ call MPAS_io_set_frame(stream % fileHandle, frame, io_err)
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ return
+ end if
+
+
+ !
+ ! Loop over fields in the stream
+ !
+ field_cursor => stream % fieldList
+ do while (associated(field_cursor))
+ if (field_cursor % field_type == FIELD_0D_INT) then
+
+ else if (field_cursor % field_type == FIELD_1D_INT) then
+write(0,*) 'Reading in field '//trim(field_cursor % int1dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+ allocate(int1d_temp(field_cursor % totalDimSize))
+
+write(0,*) 'MGD calling MPAS_io_get_var now...'
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % int1dField % fieldName, int1d_temp, io_err)
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ deallocate(int1d_temp)
+ return
+ end if
+
+ if (field_cursor % isDecomposed) then
+write(0,*) 'Gathering field from across all blocks'
+ ! Distribute field to multiple blocks
+ field_1dint_ptr => field_cursor % int1dField
+ i = 1
+! Could this be something we do in streamAddField routines, since we already have such tests?
+ if (trim(field_1dint_ptr % dimNames(1)) == 'nCells') then
+ ownedSize = field_1dint_ptr % block % mesh % nCellsSolve
+ else if (trim(field_1dint_ptr % dimNames(1)) == 'nEdges') then
+ ownedSize = field_1dint_ptr % block % mesh % nEdgesSolve
+ else if (trim(field_1dint_ptr % dimNames(1)) == 'nVertices') then
+ ownedSize = field_1dint_ptr % block % mesh % nVerticesSolve
+ else
+ ownedSize = field_1dint_ptr % dimSizes(1)
+ end if
+ do while (associated(field_1dint_ptr))
+write(0,*) ' > copying block ', i, i+ownedSize-1
+ field_1dint_ptr % array(1:ownedSize) = int1d_temp(i:i+ownedSize-1)
+ i = i + ownedSize
+ field_1dint_ptr => field_1dint_ptr % next
+ end do
+ else
+write(0,*) 'Distributing and Copying field to other blocks'
+
+ call mpas_dmpar_bcast_ints(field_cursor % int1dField % block % domain % dminfo, size(int1d_temp), int1d_temp(:))
+ field_1dint_ptr => field_cursor % int1dField
+ do while (associated(field_1dint_ptr))
+ field_1dint_ptr % array(:) = int1d_temp(:)
+ field_1dint_ptr => field_1dint_ptr % next
+ end do
+ end if
+
+ deallocate(int1d_temp)
+
+ else if (field_cursor % field_type == FIELD_2D_INT) then
+ else if (field_cursor % field_type == FIELD_3D_INT) then
+ else if (field_cursor % field_type == FIELD_0D_REAL) then
+ else if (field_cursor % field_type == FIELD_1D_REAL) then
+ else if (field_cursor % field_type == FIELD_2D_REAL) then
+ else if (field_cursor % field_type == FIELD_3D_REAL) then
+ else if (field_cursor % field_type == FIELD_0D_CHAR) then
+ else if (field_cursor % field_type == FIELD_1D_CHAR) then
+ end if
+ field_cursor => field_cursor % next
+ end do
+
end subroutine MPAS_readStream
@@ -342,7 +497,16 @@
integer :: io_err
integer :: i
integer :: ownedSize
+ type (field0dInteger), pointer :: field_0dint_ptr
type (field1dInteger), pointer :: field_1dint_ptr
+ type (field2dInteger), pointer :: field_2dint_ptr
+ type (field3dInteger), pointer :: field_3dint_ptr
+ type (field0dReal), pointer :: field_0dreal_ptr
+ type (field1dReal), pointer :: field_1dreal_ptr
+ type (field2dReal), pointer :: field_2dreal_ptr
+ type (field3dReal), pointer :: field_3dreal_ptr
+ type (field0dChar), pointer :: field_0dchar_ptr
+ type (field1dChar), pointer :: field_1dchar_ptr
type (field_list_type), pointer :: field_cursor
integer :: int0d_temp
integer, dimension(:), pointer :: int1d_temp
@@ -363,6 +527,9 @@
return
end if
+ !
+ ! Set time frame to write
+ !
call MPAS_io_set_frame(stream % fileHandle, frame, io_err)
call MPAS_io_err_mesg(io_err, .false.)
if (io_err /= MPAS_IO_NOERR) then
@@ -370,6 +537,9 @@
return
end if
+ !
+ ! Loop over fields in the stream
+ !
field_cursor => stream % fieldList
do while (associated(field_cursor))
if (field_cursor % field_type == FIELD_0D_INT) then
</font>
</pre>