<p><b>duda</b> 2012-03-27 11:15:51 -0600 (Tue, 27 Mar 2012)</p><p>BRANCH COMMIT<br>
<br>
Add code to handle reading and writing of 0d, 1d, 2d, and 3d real and integer fields.<br>
<br>
* We still need to handle super-arrays.<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-27 16:31:27 UTC (rev 1725)
+++ branches/omp_blocks/io/src/framework/mpas_io_streams.F 2012-03-27 17:15:51 UTC (rev 1726)
@@ -33,7 +33,14 @@
interface MPAS_streamAddField
+ module procedure MPAS_streamAddField_0dInteger
module procedure MPAS_streamAddField_1dInteger
+ module procedure MPAS_streamAddField_2dInteger
+ module procedure MPAS_streamAddField_3dInteger
+ module procedure MPAS_streamAddField_0dReal
+ module procedure MPAS_streamAddField_1dReal
+ module procedure MPAS_streamAddField_2dReal
+ module procedure MPAS_streamAddField_3dReal
end interface MPAS_streamAddField
interface MPAS_readStreamAtt
@@ -106,6 +113,82 @@
end subroutine MPAS_createStream
+ subroutine MPAS_streamAddField_0dInteger(stream, field, ierr)
+
+ implicit none
+
+ type (MPAS_Stream_type), intent(inout) :: stream
+ type (field0DInteger), intent(in), target :: field
+ integer, intent(out), optional :: ierr
+
+ integer :: io_err
+ integer :: i
+ integer :: idim
+ integer :: totalDimSize, globalDimSize
+ logical :: isDecomposed
+ integer :: ndims
+ type (field0dInteger), pointer :: field_ptr
+ character (len=64), dimension(:), pointer :: dimNames
+ integer, dimension(:), pointer :: indices
+ integer, dimension(:), pointer :: dimSizes
+ type (field_list_type), pointer :: field_list_cursor
+ type (field_list_type), pointer :: new_field_list_node
+
+ if (present(ierr)) ierr = MPAS_STREAM_NOERR
+
+ !
+ ! Sanity checks
+ !
+ if (.not. stream % isInitialized) then
+ if (present(ierr)) ierr = MPAS_STREAM_NOT_INITIALIZED
+ return
+ end if
+
+write(0,*) '... Adding field '//trim(field % fieldName)//' to stream'
+
+ ndims = 0
+
+write(0,*) '... field has ', ndims, ' dimensions'
+
+ !
+ ! Determine whether the field is decomposed, the indices that are owned by this task's blocks,
+ ! and the total number of outer-indices owned by this task
+ !
+ idim = ndims
+ allocate(indices(0))
+ allocate(dimSizes(0))
+ allocate(dimNames(0))
+ isDecomposed = .false.
+ globalDimSize = 0
+ totalDimSize = 0
+
+ call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_INT, dimNames, dimSizes, &
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+
+ deallocate(indices)
+ deallocate(dimSizes)
+ deallocate(dimNames)
+ if (io_err /= MPAS_STREAM_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ return
+ end if
+
+
+ !
+ ! Set field pointer and type in fieldList
+ !
+ new_field_list_node => stream % fieldList
+ do while (associated(new_field_list_node % next))
+ new_field_list_node => new_field_list_node % next
+ end do
+ new_field_list_node % field_type = FIELD_0D_INT
+ new_field_list_node % int0dField => field
+
+write(0,*) '... done adding field'
+
+ end subroutine MPAS_streamAddField_0dInteger
+
+
subroutine MPAS_streamAddField_1dInteger(stream, field, ierr)
implicit none
@@ -198,9 +281,13 @@
call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_INT, field % dimNames, field % dimSizes, &
- field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, ierr)
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
deallocate(indices)
+ if (io_err /= MPAS_STREAM_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ return
+ end if
!
@@ -218,6 +305,666 @@
end subroutine MPAS_streamAddField_1dInteger
+ subroutine MPAS_streamAddField_2dInteger(stream, field, ierr)
+
+ implicit none
+
+ type (MPAS_Stream_type), intent(inout) :: stream
+ type (field2DInteger), intent(in), target :: field
+ integer, intent(out), optional :: ierr
+
+ integer :: io_err
+ integer :: i
+ integer :: idim
+ integer :: totalDimSize, globalDimSize
+ logical :: isDecomposed
+ integer :: ndims
+ type (field2dInteger), 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
+
+ if (present(ierr)) ierr = MPAS_STREAM_NOERR
+
+ !
+ ! Sanity checks
+ !
+ if (.not. stream % isInitialized) then
+ if (present(ierr)) ierr = MPAS_STREAM_NOT_INITIALIZED
+ return
+ end if
+
+write(0,*) '... Adding field '//trim(field % fieldName)//' to stream'
+
+ ndims = size(field % dimSizes)
+
+write(0,*) '... field has ', ndims, ' dimensions'
+
+ !
+ ! Determine whether the field is decomposed, the indices that are owned by this task's blocks,
+ ! and the total number of outer-indices owned by this task
+ !
+ idim = ndims
+ totalDimSize = 0
+ field_ptr => field
+ if (trim(field % dimNames(idim)) == 'nCells') then
+write(0,*) '... outer dimension is nCells'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToCellID % array(1:field_ptr % block % mesh % nCellsSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nCellsSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else if (trim(field % dimNames(idim)) == 'nEdges') then
+write(0,*) '... outer dimension is nEdges'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToEdgeID % array(1:field_ptr % block % mesh % nEdgesSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nEdgesSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else if (trim(field % dimNames(idim)) == 'nVertices') then
+write(0,*) '... outer dimension is nVertices'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToVertexID % array(1:field_ptr % block % mesh % nVerticesSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nVerticesSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else
+ isDecomposed = .false.
+ globalDimSize = field % dimSizes(idim)
+ totalDimSize = globalDimSize
+
+ if (field % block % domain % dminfo % my_proc_id == IO_NODE) then
+ ndims = 1
+ allocate(indices(field % dimSizes(ndims)))
+ do i=1,field % dimSizes(ndims)
+ indices(i) = i
+ end do
+ else
+ allocate(indices(0))
+ end if
+ end if
+
+
+ call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_INT, field % dimNames, field % dimSizes, &
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+
+ deallocate(indices)
+ if (io_err /= MPAS_STREAM_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ return
+ end if
+
+
+ !
+ ! Set field pointer and type in fieldList
+ !
+ new_field_list_node => stream % fieldList
+ do while (associated(new_field_list_node % next))
+ new_field_list_node => new_field_list_node % next
+ end do
+ new_field_list_node % field_type = FIELD_2D_INT
+ new_field_list_node % int2dField => field
+
+write(0,*) '... done adding field'
+
+ end subroutine MPAS_streamAddField_2dInteger
+
+
+ subroutine MPAS_streamAddField_3dInteger(stream, field, ierr)
+
+ implicit none
+
+ type (MPAS_Stream_type), intent(inout) :: stream
+ type (field3DInteger), intent(in), target :: field
+ integer, intent(out), optional :: ierr
+
+ integer :: io_err
+ integer :: i
+ integer :: idim
+ integer :: totalDimSize, globalDimSize
+ logical :: isDecomposed
+ integer :: ndims
+ type (field3dInteger), 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
+
+ if (present(ierr)) ierr = MPAS_STREAM_NOERR
+
+ !
+ ! Sanity checks
+ !
+ if (.not. stream % isInitialized) then
+ if (present(ierr)) ierr = MPAS_STREAM_NOT_INITIALIZED
+ return
+ end if
+
+write(0,*) '... Adding field '//trim(field % fieldName)//' to stream'
+
+ ndims = size(field % dimSizes)
+
+write(0,*) '... field has ', ndims, ' dimensions'
+
+ !
+ ! Determine whether the field is decomposed, the indices that are owned by this task's blocks,
+ ! and the total number of outer-indices owned by this task
+ !
+!!!!!!!!!!!!!!!!!!!!!!! Is all of this constant, and could it be put in an include file? !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ idim = ndims
+ totalDimSize = 0
+ field_ptr => field
+ if (trim(field % dimNames(idim)) == 'nCells') then
+write(0,*) '... outer dimension is nCells'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToCellID % array(1:field_ptr % block % mesh % nCellsSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nCellsSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else if (trim(field % dimNames(idim)) == 'nEdges') then
+write(0,*) '... outer dimension is nEdges'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToEdgeID % array(1:field_ptr % block % mesh % nEdgesSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nEdgesSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else if (trim(field % dimNames(idim)) == 'nVertices') then
+write(0,*) '... outer dimension is nVertices'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToVertexID % array(1:field_ptr % block % mesh % nVerticesSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nVerticesSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else
+ isDecomposed = .false.
+ globalDimSize = field % dimSizes(idim)
+ totalDimSize = globalDimSize
+
+ if (field % block % domain % dminfo % my_proc_id == IO_NODE) then
+ ndims = 1
+ allocate(indices(field % dimSizes(ndims)))
+ do i=1,field % dimSizes(ndims)
+ indices(i) = i
+ end do
+ else
+ allocate(indices(0))
+ end if
+ end if
+!!!!!!!!!!!!!!!!!!!!!!! Is all of this constant, and could it be put in an include file? !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+ call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_INT, field % dimNames, field % dimSizes, &
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+
+ deallocate(indices)
+ if (io_err /= MPAS_STREAM_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ return
+ end if
+
+
+ !
+ ! Set field pointer and type in fieldList
+ !
+ new_field_list_node => stream % fieldList
+ do while (associated(new_field_list_node % next))
+ new_field_list_node => new_field_list_node % next
+ end do
+ new_field_list_node % field_type = FIELD_3D_INT
+ new_field_list_node % int3dField => field
+
+write(0,*) '... done adding field'
+
+ end subroutine MPAS_streamAddField_3dInteger
+
+
+ subroutine MPAS_streamAddField_0dReal(stream, field, ierr)
+
+ implicit none
+
+ type (MPAS_Stream_type), intent(inout) :: stream
+ type (field0DReal), intent(in), target :: field
+ integer, intent(out), optional :: ierr
+
+ integer :: io_err
+ integer :: i
+ integer :: idim
+ integer :: totalDimSize, globalDimSize
+ logical :: isDecomposed
+ integer :: ndims
+ type (field0dReal), pointer :: field_ptr
+ character (len=64), dimension(:), pointer :: dimNames
+ integer, dimension(:), pointer :: indices
+ integer, dimension(:), pointer :: dimSizes
+ type (field_list_type), pointer :: field_list_cursor
+ type (field_list_type), pointer :: new_field_list_node
+
+ if (present(ierr)) ierr = MPAS_STREAM_NOERR
+
+ !
+ ! Sanity checks
+ !
+ if (.not. stream % isInitialized) then
+ if (present(ierr)) ierr = MPAS_STREAM_NOT_INITIALIZED
+ return
+ end if
+
+write(0,*) '... Adding field '//trim(field % fieldName)//' to stream'
+
+ ndims = 0
+
+write(0,*) '... field has ', ndims, ' dimensions'
+
+ !
+ ! Determine whether the field is decomposed, the indices that are owned by this task's blocks,
+ ! and the total number of outer-indices owned by this task
+ !
+ idim = ndims
+ allocate(indices(0))
+ allocate(dimSizes(0))
+ allocate(dimNames(0))
+ isDecomposed = .false.
+ globalDimSize = 0
+ totalDimSize = 0
+
+ call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_DOUBLE, dimNames, dimSizes, &
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+ if (io_err /= MPAS_STREAM_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ return
+ end if
+
+ deallocate(indices)
+ deallocate(dimSizes)
+ deallocate(dimNames)
+
+
+ !
+ ! Set field pointer and type in fieldList
+ !
+ new_field_list_node => stream % fieldList
+ do while (associated(new_field_list_node % next))
+ new_field_list_node => new_field_list_node % next
+ end do
+ new_field_list_node % field_type = FIELD_0D_REAL
+ new_field_list_node % real0dField => field
+
+write(0,*) '... done adding field'
+
+ end subroutine MPAS_streamAddField_0dReal
+
+
+ subroutine MPAS_streamAddField_1dReal(stream, field, ierr)
+
+ implicit none
+
+ type (MPAS_Stream_type), intent(inout) :: stream
+ type (field1DReal), intent(in), target :: field
+ integer, intent(out), optional :: ierr
+
+ integer :: io_err
+ integer :: i
+ integer :: idim
+ integer :: totalDimSize, globalDimSize
+ logical :: isDecomposed
+ integer :: ndims
+ type (field1dReal), 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
+
+ if (present(ierr)) ierr = MPAS_STREAM_NOERR
+
+ !
+ ! Sanity checks
+ !
+ if (.not. stream % isInitialized) then
+ if (present(ierr)) ierr = MPAS_STREAM_NOT_INITIALIZED
+ return
+ end if
+
+write(0,*) '... Adding field '//trim(field % fieldName)//' to stream'
+
+ ndims = size(field % dimSizes)
+
+write(0,*) '... field has ', ndims, ' dimensions'
+
+ !
+ ! Determine whether the field is decomposed, the indices that are owned by this task's blocks,
+ ! and the total number of outer-indices owned by this task
+ !
+ idim = ndims
+ totalDimSize = 0
+ field_ptr => field
+ if (trim(field % dimNames(idim)) == 'nCells') then
+write(0,*) '... outer dimension is nCells'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToCellID % array(1:field_ptr % block % mesh % nCellsSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nCellsSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else if (trim(field % dimNames(idim)) == 'nEdges') then
+write(0,*) '... outer dimension is nEdges'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToEdgeID % array(1:field_ptr % block % mesh % nEdgesSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nEdgesSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else if (trim(field % dimNames(idim)) == 'nVertices') then
+write(0,*) '... outer dimension is nVertices'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToVertexID % array(1:field_ptr % block % mesh % nVerticesSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nVerticesSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else
+ isDecomposed = .false.
+ globalDimSize = field % dimSizes(idim)
+ totalDimSize = globalDimSize
+
+ if (field % block % domain % dminfo % my_proc_id == IO_NODE) then
+ ndims = 1
+ allocate(indices(field % dimSizes(ndims)))
+ do i=1,field % dimSizes(ndims)
+ indices(i) = i
+ end do
+ else
+ allocate(indices(0))
+ end if
+ end if
+
+
+ call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_DOUBLE, field % dimNames, field % dimSizes, &
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+
+ deallocate(indices)
+ if (io_err /= MPAS_STREAM_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ return
+ end if
+
+
+ !
+ ! Set field pointer and type in fieldList
+ !
+ new_field_list_node => stream % fieldList
+ do while (associated(new_field_list_node % next))
+ new_field_list_node => new_field_list_node % next
+ end do
+ new_field_list_node % field_type = FIELD_1D_REAL
+ new_field_list_node % real1dField => field
+
+write(0,*) '... done adding field'
+
+ end subroutine MPAS_streamAddField_1dReal
+
+
+ subroutine MPAS_streamAddField_2dReal(stream, field, ierr)
+
+ implicit none
+
+ type (MPAS_Stream_type), intent(inout) :: stream
+ type (field2DReal), intent(in), target :: field
+ integer, intent(out), optional :: ierr
+
+ integer :: io_err
+ integer :: i
+ integer :: idim
+ integer :: totalDimSize, globalDimSize
+ logical :: isDecomposed
+ integer :: ndims
+ type (field2dReal), 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
+
+ if (present(ierr)) ierr = MPAS_STREAM_NOERR
+
+ !
+ ! Sanity checks
+ !
+ if (.not. stream % isInitialized) then
+ if (present(ierr)) ierr = MPAS_STREAM_NOT_INITIALIZED
+ return
+ end if
+
+write(0,*) '... Adding field '//trim(field % fieldName)//' to stream'
+
+ ndims = size(field % dimSizes)
+
+write(0,*) '... field has ', ndims, ' dimensions'
+
+ !
+ ! Determine whether the field is decomposed, the indices that are owned by this task's blocks,
+ ! and the total number of outer-indices owned by this task
+ !
+ idim = ndims
+ totalDimSize = 0
+ field_ptr => field
+ if (trim(field % dimNames(idim)) == 'nCells') then
+write(0,*) '... outer dimension is nCells'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToCellID % array(1:field_ptr % block % mesh % nCellsSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nCellsSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else if (trim(field % dimNames(idim)) == 'nEdges') then
+write(0,*) '... outer dimension is nEdges'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToEdgeID % array(1:field_ptr % block % mesh % nEdgesSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nEdgesSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else if (trim(field % dimNames(idim)) == 'nVertices') then
+write(0,*) '... outer dimension is nVertices'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToVertexID % array(1:field_ptr % block % mesh % nVerticesSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nVerticesSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else
+ isDecomposed = .false.
+ globalDimSize = field % dimSizes(idim)
+ totalDimSize = globalDimSize
+
+ if (field % block % domain % dminfo % my_proc_id == IO_NODE) then
+ ndims = 1
+ allocate(indices(field % dimSizes(ndims)))
+ do i=1,field % dimSizes(ndims)
+ indices(i) = i
+ end do
+ else
+ allocate(indices(0))
+ end if
+ end if
+
+
+ call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_DOUBLE, field % dimNames, field % dimSizes, &
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+
+ deallocate(indices)
+ if (io_err /= MPAS_STREAM_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ return
+ end if
+
+
+ !
+ ! Set field pointer and type in fieldList
+ !
+ new_field_list_node => stream % fieldList
+ do while (associated(new_field_list_node % next))
+ new_field_list_node => new_field_list_node % next
+ end do
+ new_field_list_node % field_type = FIELD_2D_REAL
+ new_field_list_node % real2dField => field
+
+write(0,*) '... done adding field'
+
+ end subroutine MPAS_streamAddField_2dReal
+
+
+ subroutine MPAS_streamAddField_3dReal(stream, field, ierr)
+
+ implicit none
+
+ type (MPAS_Stream_type), intent(inout) :: stream
+ type (field3DReal), intent(in), target :: field
+ integer, intent(out), optional :: ierr
+
+ integer :: io_err
+ integer :: i
+ integer :: idim
+ integer :: totalDimSize, globalDimSize
+ logical :: isDecomposed
+ integer :: ndims
+ type (field3dReal), 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
+
+ if (present(ierr)) ierr = MPAS_STREAM_NOERR
+
+ !
+ ! Sanity checks
+ !
+ if (.not. stream % isInitialized) then
+ if (present(ierr)) ierr = MPAS_STREAM_NOT_INITIALIZED
+ return
+ end if
+
+write(0,*) '... Adding field '//trim(field % fieldName)//' to stream'
+
+ ndims = size(field % dimSizes)
+
+write(0,*) '... field has ', ndims, ' dimensions'
+
+ !
+ ! Determine whether the field is decomposed, the indices that are owned by this task's blocks,
+ ! and the total number of outer-indices owned by this task
+ !
+!!!!!!!!!!!!!!!!!!!!!!! Is all of this constant, and could it be put in an include file? !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ idim = ndims
+ totalDimSize = 0
+ field_ptr => field
+ if (trim(field % dimNames(idim)) == 'nCells') then
+write(0,*) '... outer dimension is nCells'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToCellID % array(1:field_ptr % block % mesh % nCellsSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nCellsSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else if (trim(field % dimNames(idim)) == 'nEdges') then
+write(0,*) '... outer dimension is nEdges'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToEdgeID % array(1:field_ptr % block % mesh % nEdgesSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nEdgesSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else if (trim(field % dimNames(idim)) == 'nVertices') then
+write(0,*) '... outer dimension is nVertices'
+ allocate(indices(0))
+ do while (associated(field_ptr))
+ call mergeArrays(indices, field_ptr % block % mesh % indexToVertexID % array(1:field_ptr % block % mesh % nVerticesSolve))
+ totalDimSize = totalDimSize + field_ptr % block % mesh % nVerticesSolve
+ field_ptr => field_ptr % next
+ end do
+ call mpas_dmpar_sum_int(field % block % domain % dminfo, totalDimSize, globalDimSize)
+ isDecomposed = .true.
+ else
+ isDecomposed = .false.
+ globalDimSize = field % dimSizes(idim)
+ totalDimSize = globalDimSize
+
+ if (field % block % domain % dminfo % my_proc_id == IO_NODE) then
+ ndims = 1
+ allocate(indices(field % dimSizes(ndims)))
+ do i=1,field % dimSizes(ndims)
+ indices(i) = i
+ end do
+ else
+ allocate(indices(0))
+ end if
+ end if
+!!!!!!!!!!!!!!!!!!!!!!! Is all of this constant, and could it be put in an include file? !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+ call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_DOUBLE, field % dimNames, field % dimSizes, &
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+
+ deallocate(indices)
+ if (io_err /= MPAS_STREAM_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ return
+ end if
+
+
+ !
+ ! Set field pointer and type in fieldList
+ !
+ new_field_list_node => stream % fieldList
+ do while (associated(new_field_list_node % next))
+ new_field_list_node => new_field_list_node % next
+ end do
+ new_field_list_node % field_type = FIELD_3D_REAL
+ new_field_list_node % real3dField => field
+
+write(0,*) '... done adding field'
+
+ end subroutine MPAS_streamAddField_3dReal
+
+
subroutine MPAS_streamAddField_generic(stream, fieldName, fieldType, dimNames, dimSizes, hasTimeDimension, isDecomposed, &
totalDimSize, globalDimSize, indices, ierr)
@@ -266,6 +1013,7 @@
call MPAS_io_err_mesg(io_err, .false.)
if (io_err /= MPAS_IO_NOERR) then
if (present(ierr)) ierr = MPAS_IO_ERR
+ deallocate(new_field_list_node)
return
end if
end do
@@ -274,7 +1022,7 @@
! Define outer-most dimension
!
idim = ndims
- write(dimNamesLocal(idim),'(a)') dimNames(idim)
+ if (idim > 0) write(dimNamesLocal(idim),'(a)') dimNames(idim)
if (isDecomposed) then
new_field_list_node % totalDimSize = totalDimSize
@@ -284,12 +1032,15 @@
new_field_list_node % isDecomposed = isDecomposed
+ if (ndims > 0) then
write(0,*) '... defining dimension ', trim(dimNames(idim)), globalDimSize
- call MPAS_io_def_dim(stream % fileHandle, trim(dimNames(idim)), globalDimSize, 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
+ call MPAS_io_def_dim(stream % fileHandle, trim(dimNames(idim)), globalDimSize, 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(new_field_list_node)
+ return
+ end if
end if
!
@@ -301,6 +1052,7 @@
call MPAS_io_err_mesg(io_err, .false.)
if (io_err /= MPAS_IO_NOERR) then
if (present(ierr)) ierr = MPAS_IO_ERR
+ deallocate(new_field_list_node)
return
end if
ndims = ndims + 1
@@ -316,6 +1068,7 @@
call MPAS_io_err_mesg(io_err, .false.)
if (io_err /= MPAS_IO_NOERR) then
if (present(ierr)) ierr = MPAS_IO_ERR
+ deallocate(new_field_list_node)
return
end if
@@ -326,6 +1079,7 @@
call MPAS_io_err_mesg(io_err, .false.)
if (io_err /= MPAS_IO_NOERR) then
if (present(ierr)) ierr = MPAS_IO_ERR
+ deallocate(new_field_list_node)
return
end if
@@ -351,11 +1105,14 @@
!
! Set variable indices
!
- call MPAS_io_set_var_indices(stream % fileHandle, trim(fieldName), indices, 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
+ if (ndims > 0) then
+ call MPAS_io_set_var_indices(stream % fileHandle, trim(fieldName), indices, 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(new_field_list_node)
+ return
+ end if
end if
@@ -437,7 +1194,29 @@
do while (associated(field_cursor))
if (field_cursor % field_type == FIELD_0D_INT) then
+write(0,*) 'Reading in field '//trim(field_cursor % int0dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+write(0,*) 'MGD calling MPAS_io_get_var now...'
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % int0dField % fieldName, int0d_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
+ return
+ end if
+
+write(0,*) 'Distributing and Copying field to other blocks'
+
+ call mpas_dmpar_bcast_int(field_cursor % int0dField % block % domain % dminfo, int0d_temp)
+ field_0dint_ptr => field_cursor % int0dField
+ do while (associated(field_0dint_ptr))
+ field_0dint_ptr % scalar = int0d_temp
+ field_0dint_ptr => field_0dint_ptr % next
+ end do
+
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
@@ -488,16 +1267,301 @@
deallocate(int1d_temp)
else if (field_cursor % field_type == FIELD_2D_INT) then
+
+write(0,*) 'Reading in field '//trim(field_cursor % int2dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+!!!!!!!!!!!!!
+ allocate(int2d_temp(field_cursor % int2dField % dimSizes(1), field_cursor % totalDimSize))
+
+write(0,*) 'MGD calling MPAS_io_get_var now...'
+!!!!!!!!!!!!!
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % int2dField % fieldName, int2d_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(int2d_temp)
+ return
+ end if
+
+ if (field_cursor % isDecomposed) then
+write(0,*) 'Gathering field from across all blocks'
+ ! Distribute field to multiple blocks
+ field_2dint_ptr => field_cursor % int2dField
+ i = 1
+! Could this be something we do in streamAddField routines, since we already have such tests?
+ if (trim(field_2dint_ptr % dimNames(2)) == 'nCells') then
+ ownedSize = field_2dint_ptr % block % mesh % nCellsSolve
+ else if (trim(field_2dint_ptr % dimNames(2)) == 'nEdges') then
+ ownedSize = field_2dint_ptr % block % mesh % nEdgesSolve
+ else if (trim(field_2dint_ptr % dimNames(2)) == 'nVertices') then
+ ownedSize = field_2dint_ptr % block % mesh % nVerticesSolve
+ else
+ ownedSize = field_2dint_ptr % dimSizes(2)
+ end if
+ do while (associated(field_2dint_ptr))
+write(0,*) ' > copying block ', i, i+ownedSize-1
+ field_2dint_ptr % array(:,1:ownedSize) = int2d_temp(:,i:i+ownedSize-1)
+ i = i + ownedSize
+ field_2dint_ptr => field_2dint_ptr % next
+ end do
+ else
+write(0,*) 'Distributing and Copying field to other blocks'
+
+ call mpas_dmpar_bcast_ints(field_cursor % int2dField % block % domain % dminfo, size(int2d_temp), int2d_temp(:,1))
+ field_2dint_ptr => field_cursor % int2dField
+ do while (associated(field_2dint_ptr))
+ field_2dint_ptr % array(:,:) = int2d_temp(:,:)
+ field_2dint_ptr => field_2dint_ptr % next
+ end do
+ end if
+
+ deallocate(int2d_temp)
+
else if (field_cursor % field_type == FIELD_3D_INT) then
+
+write(0,*) 'Reading in field '//trim(field_cursor % int3dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+!!!!!!!!!!!!!
+ allocate(int3d_temp(field_cursor % int3dField % dimSizes(1), &
+ field_cursor % int3dField % dimSizes(2), &
+ field_cursor % totalDimSize))
+
+write(0,*) 'MGD calling MPAS_io_get_var now...'
+!!!!!!!!!!!!!
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % int3dField % fieldName, int3d_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(int3d_temp)
+ return
+ end if
+
+ if (field_cursor % isDecomposed) then
+write(0,*) 'Gathering field from across all blocks'
+ ! Distribute field to multiple blocks
+ field_3dint_ptr => field_cursor % int3dField
+ i = 1
+! Could this be something we do in streamAddField routines, since we already have such tests?
+ if (trim(field_3dint_ptr % dimNames(3)) == 'nCells') then
+ ownedSize = field_3dint_ptr % block % mesh % nCellsSolve
+ else if (trim(field_3dint_ptr % dimNames(3)) == 'nEdges') then
+ ownedSize = field_3dint_ptr % block % mesh % nEdgesSolve
+ else if (trim(field_3dint_ptr % dimNames(3)) == 'nVertices') then
+ ownedSize = field_3dint_ptr % block % mesh % nVerticesSolve
+ else
+ ownedSize = field_3dint_ptr % dimSizes(3)
+ end if
+ do while (associated(field_3dint_ptr))
+write(0,*) ' > copying block ', i, i+ownedSize-1
+ field_3dint_ptr % array(:,:,1:ownedSize) = int3d_temp(:,:,i:i+ownedSize-1)
+ i = i + ownedSize
+ field_3dint_ptr => field_3dint_ptr % next
+ end do
+ else
+write(0,*) 'Distributing and Copying field to other blocks'
+
+ call mpas_dmpar_bcast_ints(field_cursor % int3dField % block % domain % dminfo, size(int3d_temp), int3d_temp(:,1,1))
+ field_3dint_ptr => field_cursor % int3dField
+ do while (associated(field_3dint_ptr))
+ field_3dint_ptr % array(:,:,:) = int3d_temp(:,:,:)
+ field_3dint_ptr => field_3dint_ptr % next
+ end do
+ end if
+
+ deallocate(int3d_temp)
+
else if (field_cursor % field_type == FIELD_0D_REAL) then
+
+write(0,*) 'Reading in field '//trim(field_cursor % real0dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+write(0,*) 'MGD calling MPAS_io_get_var now...'
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % real0dField % fieldName, real0d_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
+ return
+ end if
+
+write(0,*) 'Distributing and Copying field to other blocks'
+
+ call mpas_dmpar_bcast_real(field_cursor % real0dField % block % domain % dminfo, real0d_temp)
+ field_0dreal_ptr => field_cursor % real0dField
+ do while (associated(field_0dreal_ptr))
+ field_0dreal_ptr % scalar = real0d_temp
+ field_0dreal_ptr => field_0dreal_ptr % next
+ end do
+
else if (field_cursor % field_type == FIELD_1D_REAL) then
+
+write(0,*) 'Reading in field '//trim(field_cursor % real1dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+ allocate(real1d_temp(field_cursor % totalDimSize))
+
+write(0,*) 'MGD calling MPAS_io_get_var now...'
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % real1dField % fieldName, real1d_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(real1d_temp)
+ return
+ end if
+
+ if (field_cursor % isDecomposed) then
+write(0,*) 'Gathering field from across all blocks'
+ ! Distribute field to multiple blocks
+ field_1dreal_ptr => field_cursor % real1dField
+ i = 1
+! Could this be something we do in streamAddField routines, since we already have such tests?
+ if (trim(field_1dreal_ptr % dimNames(1)) == 'nCells') then
+ ownedSize = field_1dreal_ptr % block % mesh % nCellsSolve
+ else if (trim(field_1dreal_ptr % dimNames(1)) == 'nEdges') then
+ ownedSize = field_1dreal_ptr % block % mesh % nEdgesSolve
+ else if (trim(field_1dreal_ptr % dimNames(1)) == 'nVertices') then
+ ownedSize = field_1dreal_ptr % block % mesh % nVerticesSolve
+ else
+ ownedSize = field_1dreal_ptr % dimSizes(1)
+ end if
+ do while (associated(field_1dreal_ptr))
+write(0,*) ' > copying block ', i, i+ownedSize-1
+ field_1dreal_ptr % array(1:ownedSize) = real1d_temp(i:i+ownedSize-1)
+ i = i + ownedSize
+ field_1dreal_ptr => field_1dreal_ptr % next
+ end do
+ else
+write(0,*) 'Distributing and Copying field to other blocks'
+
+ call mpas_dmpar_bcast_reals(field_cursor % real1dField % block % domain % dminfo, size(real1d_temp), real1d_temp(:))
+ field_1dreal_ptr => field_cursor % real1dField
+ do while (associated(field_1dreal_ptr))
+ field_1dreal_ptr % array(:) = real1d_temp(:)
+ field_1dreal_ptr => field_1dreal_ptr % next
+ end do
+ end if
+
+ deallocate(real1d_temp)
+
else if (field_cursor % field_type == FIELD_2D_REAL) then
+
+write(0,*) 'Reading in field '//trim(field_cursor % real2dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+!!!!!!!!!!!!!
+ allocate(real2d_temp(field_cursor % real2dField % dimSizes(1), field_cursor % totalDimSize))
+
+write(0,*) 'MGD calling MPAS_io_get_var now...'
+!!!!!!!!!!!!!
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % real2dField % fieldName, real2d_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(real2d_temp)
+ return
+ end if
+
+ if (field_cursor % isDecomposed) then
+write(0,*) 'Gathering field from across all blocks'
+ ! Distribute field to multiple blocks
+ field_2dreal_ptr => field_cursor % real2dField
+ i = 1
+! Could this be something we do in streamAddField routines, since we already have such tests?
+ if (trim(field_2dreal_ptr % dimNames(2)) == 'nCells') then
+ ownedSize = field_2dreal_ptr % block % mesh % nCellsSolve
+ else if (trim(field_2dreal_ptr % dimNames(2)) == 'nEdges') then
+ ownedSize = field_2dreal_ptr % block % mesh % nEdgesSolve
+ else if (trim(field_2dreal_ptr % dimNames(2)) == 'nVertices') then
+ ownedSize = field_2dreal_ptr % block % mesh % nVerticesSolve
+ else
+ ownedSize = field_2dreal_ptr % dimSizes(2)
+ end if
+ do while (associated(field_2dreal_ptr))
+write(0,*) ' > copying block ', i, i+ownedSize-1
+ field_2dreal_ptr % array(:,1:ownedSize) = real2d_temp(:,i:i+ownedSize-1)
+ i = i + ownedSize
+ field_2dreal_ptr => field_2dreal_ptr % next
+ end do
+ else
+write(0,*) 'Distributing and Copying field to other blocks'
+
+ call mpas_dmpar_bcast_reals(field_cursor % real2dField % block % domain % dminfo, size(real2d_temp), real2d_temp(:,1))
+ field_2dreal_ptr => field_cursor % real2dField
+ do while (associated(field_2dreal_ptr))
+ field_2dreal_ptr % array(:,:) = real2d_temp(:,:)
+ field_2dreal_ptr => field_2dreal_ptr % next
+ end do
+ end if
+
+ deallocate(real2d_temp)
+
else if (field_cursor % field_type == FIELD_3D_REAL) then
+
+write(0,*) 'Reading in field '//trim(field_cursor % real3dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+!!!!!!!!!!!!!
+ allocate(real3d_temp(field_cursor % real3dField % dimSizes(1), &
+ field_cursor % real3dField % dimSizes(2), &
+ field_cursor % totalDimSize))
+
+write(0,*) 'MGD calling MPAS_io_get_var now...'
+!!!!!!!!!!!!!
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % real3dField % fieldName, real3d_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(real3d_temp)
+ return
+ end if
+
+ if (field_cursor % isDecomposed) then
+write(0,*) 'Gathering field from across all blocks'
+ ! Distribute field to multiple blocks
+ field_3dreal_ptr => field_cursor % real3dField
+ i = 1
+! Could this be something we do in streamAddField routines, since we already have such tests?
+ if (trim(field_3dreal_ptr % dimNames(3)) == 'nCells') then
+ ownedSize = field_3dreal_ptr % block % mesh % nCellsSolve
+ else if (trim(field_3dreal_ptr % dimNames(3)) == 'nEdges') then
+ ownedSize = field_3dreal_ptr % block % mesh % nEdgesSolve
+ else if (trim(field_3dreal_ptr % dimNames(3)) == 'nVertices') then
+ ownedSize = field_3dreal_ptr % block % mesh % nVerticesSolve
+ else
+ ownedSize = field_3dreal_ptr % dimSizes(3)
+ end if
+ do while (associated(field_3dreal_ptr))
+write(0,*) ' > copying block ', i, i+ownedSize-1
+ field_3dreal_ptr % array(:,:,1:ownedSize) = real3d_temp(:,:,i:i+ownedSize-1)
+ i = i + ownedSize
+ field_3dreal_ptr => field_3dreal_ptr % next
+ end do
+ else
+write(0,*) 'Distributing and Copying field to other blocks'
+
+ call mpas_dmpar_bcast_reals(field_cursor % real3dField % block % domain % dminfo, size(real3d_temp), real3d_temp(:,1,1))
+ field_3dreal_ptr => field_cursor % real3dField
+ do while (associated(field_3dreal_ptr))
+ field_3dreal_ptr % array(:,:,:) = real3d_temp(:,:,:)
+ field_3dreal_ptr => field_3dreal_ptr % next
+ end do
+ end if
+
+ deallocate(real3d_temp)
+
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
+write(0,*) 'Finished fieldlist loop...'
end subroutine MPAS_readStream
@@ -560,7 +1624,20 @@
do while (associated(field_cursor))
if (field_cursor % field_type == FIELD_0D_INT) then
+write(0,*) 'Writing out field '//trim(field_cursor % int0dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+write(0,*) 'Copying field from first block'
+ int0d_temp = field_cursor % int0dField % scalar
+
+write(0,*) 'MGD calling MPAS_io_put_var now...'
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % int0dField % fieldName, int0d_temp, io_err)
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR
+
else if (field_cursor % field_type == FIELD_1D_INT) then
+
write(0,*) 'Writing out field '//trim(field_cursor % int1dField % fieldName)
write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
@@ -601,11 +1678,228 @@
deallocate(int1d_temp)
else if (field_cursor % field_type == FIELD_2D_INT) then
+
+write(0,*) 'Writing out field '//trim(field_cursor % int2dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+ allocate(int2d_temp(field_cursor % int2dField % dimSizes(1), field_cursor % totalDimSize))
+
+ if (field_cursor % isDecomposed) then
+write(0,*) 'Gathering field from across all blocks'
+ ! Gather field from across multiple blocks
+ field_2dint_ptr => field_cursor % int2dField
+ i = 1
+ do while (associated(field_2dint_ptr))
+! Could this be something we do in streamAddField routines, since we already have such tests?
+ if (trim(field_2dint_ptr % dimNames(2)) == 'nCells') then
+ ownedSize = field_2dint_ptr % block % mesh % nCellsSolve
+ else if (trim(field_2dint_ptr % dimNames(2)) == 'nEdges') then
+ ownedSize = field_2dint_ptr % block % mesh % nEdgesSolve
+ else if (trim(field_2dint_ptr % dimNames(2)) == 'nVertices') then
+ ownedSize = field_2dint_ptr % block % mesh % nVerticesSolve
+ else
+ ownedSize = field_2dint_ptr % dimSizes(2)
+ end if
+write(0,*) ' > copying block ', i, i+ownedSize-1
+ int2d_temp(:,i:i+ownedSize-1) = field_2dint_ptr % array(:,1:ownedSize)
+ i = i + ownedSize
+ field_2dint_ptr => field_2dint_ptr % next
+ end do
+ else
+write(0,*) 'Copying field from first block'
+ int2d_temp(:,:) = field_cursor % int2dField % array(:,:)
+ end if
+
+write(0,*) 'MGD calling MPAS_io_put_var now...'
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % int2dField % fieldName, int2d_temp, io_err)
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR
+
+ deallocate(int2d_temp)
+
else if (field_cursor % field_type == FIELD_3D_INT) then
+
+write(0,*) 'Writing out field '//trim(field_cursor % int3dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+ allocate(int3d_temp(field_cursor % int3dField % dimSizes(1), &
+ field_cursor % int3dField % dimSizes(2), &
+ field_cursor % totalDimSize))
+
+ if (field_cursor % isDecomposed) then
+write(0,*) 'Gathering field from across all blocks'
+ ! Gather field from across multiple blocks
+ field_3dint_ptr => field_cursor % int3dField
+ i = 1
+ do while (associated(field_3dint_ptr))
+! Could this be something we do in streamAddField routines, since we already have such tests?
+ if (trim(field_3dint_ptr % dimNames(3)) == 'nCells') then
+ ownedSize = field_3dint_ptr % block % mesh % nCellsSolve
+ else if (trim(field_3dint_ptr % dimNames(3)) == 'nEdges') then
+ ownedSize = field_3dint_ptr % block % mesh % nEdgesSolve
+ else if (trim(field_3dint_ptr % dimNames(3)) == 'nVertices') then
+ ownedSize = field_3dint_ptr % block % mesh % nVerticesSolve
+ else
+ ownedSize = field_3dint_ptr % dimSizes(3)
+ end if
+write(0,*) ' > copying block ', i, i+ownedSize-1
+ int3d_temp(:,:,i:i+ownedSize-1) = field_3dint_ptr % array(:,:,1:ownedSize)
+ i = i + ownedSize
+ field_3dint_ptr => field_3dint_ptr % next
+ end do
+ else
+write(0,*) 'Copying field from first block'
+ int3d_temp(:,:,:) = field_cursor % int3dField % array(:,:,:)
+ end if
+
+write(0,*) 'MGD calling MPAS_io_put_var now...'
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % int3dField % fieldName, int3d_temp, io_err)
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR
+
+ deallocate(int3d_temp)
+
else if (field_cursor % field_type == FIELD_0D_REAL) then
+
+write(0,*) 'Writing out field '//trim(field_cursor % real0dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+write(0,*) 'Copying field from first block'
+ real0d_temp = field_cursor % real0dField % scalar
+
+write(0,*) 'MGD calling MPAS_io_put_var now...'
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % real0dField % fieldName, real0d_temp, io_err)
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR
+
else if (field_cursor % field_type == FIELD_1D_REAL) then
+
+write(0,*) 'Writing out field '//trim(field_cursor % real1dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+ allocate(real1d_temp(field_cursor % totalDimSize))
+
+ if (field_cursor % isDecomposed) then
+write(0,*) 'Gathering field from across all blocks'
+ ! Gather field from across multiple blocks
+ field_1dreal_ptr => field_cursor % real1dField
+ i = 1
+ do while (associated(field_1dreal_ptr))
+! Could this be something we do in streamAddField routines, since we already have such tests?
+ if (trim(field_1dreal_ptr % dimNames(1)) == 'nCells') then
+ ownedSize = field_1dreal_ptr % block % mesh % nCellsSolve
+ else if (trim(field_1dreal_ptr % dimNames(1)) == 'nEdges') then
+ ownedSize = field_1dreal_ptr % block % mesh % nEdgesSolve
+ else if (trim(field_1dreal_ptr % dimNames(1)) == 'nVertices') then
+ ownedSize = field_1dreal_ptr % block % mesh % nVerticesSolve
+ else
+ ownedSize = field_1dreal_ptr % dimSizes(1)
+ end if
+write(0,*) ' > copying block ', i, i+ownedSize-1
+ real1d_temp(i:i+ownedSize-1) = field_1dreal_ptr % array(1:ownedSize)
+ i = i + ownedSize
+ field_1dreal_ptr => field_1dreal_ptr % next
+ end do
+ else
+write(0,*) 'Copying field from first block'
+ real1d_temp(:) = field_cursor % real1dField % array(:)
+ end if
+
+write(0,*) 'MGD calling MPAS_io_put_var now...'
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % real1dField % fieldName, real1d_temp, io_err)
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR
+
+ deallocate(real1d_temp)
+
else if (field_cursor % field_type == FIELD_2D_REAL) then
+
+write(0,*) 'Writing out field '//trim(field_cursor % real2dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+ allocate(real2d_temp(field_cursor % real2dField % dimSizes(1), field_cursor % totalDimSize))
+
+ if (field_cursor % isDecomposed) then
+write(0,*) 'Gathering field from across all blocks'
+ ! Gather field from across multiple blocks
+ field_2dreal_ptr => field_cursor % real2dField
+ i = 1
+ do while (associated(field_2dreal_ptr))
+! Could this be something we do in streamAddField routines, since we already have such tests?
+ if (trim(field_2dreal_ptr % dimNames(2)) == 'nCells') then
+ ownedSize = field_2dreal_ptr % block % mesh % nCellsSolve
+ else if (trim(field_2dreal_ptr % dimNames(2)) == 'nEdges') then
+ ownedSize = field_2dreal_ptr % block % mesh % nEdgesSolve
+ else if (trim(field_2dreal_ptr % dimNames(2)) == 'nVertices') then
+ ownedSize = field_2dreal_ptr % block % mesh % nVerticesSolve
+ else
+ ownedSize = field_2dreal_ptr % dimSizes(2)
+ end if
+write(0,*) ' > copying block ', i, i+ownedSize-1
+ real2d_temp(:,i:i+ownedSize-1) = field_2dreal_ptr % array(:,1:ownedSize)
+ i = i + ownedSize
+ field_2dreal_ptr => field_2dreal_ptr % next
+ end do
+ else
+write(0,*) 'Copying field from first block'
+ real2d_temp(:,:) = field_cursor % real2dField % array(:,:)
+ end if
+
+write(0,*) 'MGD calling MPAS_io_put_var now...'
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % real2dField % fieldName, real2d_temp, io_err)
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR
+
+ deallocate(real2d_temp)
+
else if (field_cursor % field_type == FIELD_3D_REAL) then
+
+write(0,*) 'Writing out field '//trim(field_cursor % real3dField % fieldName)
+write(0,*) ' > is the field decomposed? ', field_cursor % isDecomposed
+write(0,*) ' > outer dimension size ', field_cursor % totalDimSize
+
+ allocate(real3d_temp(field_cursor % real3dField % dimSizes(1), &
+ field_cursor % real3dField % dimSizes(2), &
+ field_cursor % totalDimSize))
+
+ if (field_cursor % isDecomposed) then
+write(0,*) 'Gathering field from across all blocks'
+ ! Gather field from across multiple blocks
+ field_3dreal_ptr => field_cursor % real3dField
+ i = 1
+ do while (associated(field_3dreal_ptr))
+! Could this be something we do in streamAddField routines, since we already have such tests?
+ if (trim(field_3dreal_ptr % dimNames(3)) == 'nCells') then
+ ownedSize = field_3dreal_ptr % block % mesh % nCellsSolve
+ else if (trim(field_3dreal_ptr % dimNames(3)) == 'nEdges') then
+ ownedSize = field_3dreal_ptr % block % mesh % nEdgesSolve
+ else if (trim(field_3dreal_ptr % dimNames(3)) == 'nVertices') then
+ ownedSize = field_3dreal_ptr % block % mesh % nVerticesSolve
+ else
+ ownedSize = field_3dreal_ptr % dimSizes(3)
+ end if
+write(0,*) ' > copying block ', i, i+ownedSize-1
+ real3d_temp(:,:,i:i+ownedSize-1) = field_3dreal_ptr % array(:,:,1:ownedSize)
+ i = i + ownedSize
+ field_3dreal_ptr => field_3dreal_ptr % next
+ end do
+ else
+write(0,*) 'Copying field from first block'
+ real3d_temp(:,:,:) = field_cursor % real3dField % array(:,:,:)
+ end if
+
+write(0,*) 'MGD calling MPAS_io_put_var now...'
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % real3dField % fieldName, real3d_temp, io_err)
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR
+
+ deallocate(real3d_temp)
+
else if (field_cursor % field_type == FIELD_0D_CHAR) then
else if (field_cursor % field_type == FIELD_1D_CHAR) then
end if
</font>
</pre>