<p><b>duda</b> 2012-03-28 14:51:22 -0600 (Wed, 28 Mar 2012)</p><p>BRANCH COMMIT<br>
<br>
Update code 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-28 00:23:25 UTC (rev 1728)
+++ branches/omp_blocks/io/src/framework/mpas_io_streams.F 2012-03-28 20:51:22 UTC (rev 1729)
@@ -235,8 +235,17 @@
#include "add_field_indices.inc"
- call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_INT, field % dimNames, field % dimSizes, &
- field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+ if (field % isSuperArray) then
+!MGD This could use some testing, in particular, so see whether dimNames(2:1) will pass a 0-sized array
+ do i=1,size(field % constituentNames)
+ call MPAS_streamAddField_generic(stream, trim(field % constituentNames(i)), MPAS_IO_INT, field % dimNames(2:ndims), &
+ field % dimSizes(2:ndims), field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, &
+ indices, io_err)
+ end do
+ else
+ call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_INT, field % dimNames, field % dimSizes, &
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+ end if
deallocate(indices)
if (io_err /= MPAS_STREAM_NOERR) then
@@ -244,7 +253,13 @@
return
end if
- call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % fieldname), field % attList)
+ if (field % isSuperArray) then
+ do i=1,size(field % constituentNames)
+ call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % constituentNames(i)), field % attList)
+ end do
+ else
+ call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % fieldname), field % attList)
+ end if
!
@@ -306,8 +321,16 @@
#include "add_field_indices.inc"
- call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_INT, field % dimNames, field % dimSizes, &
- field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+ if (field % isSuperArray) then
+ do i=1,size(field % constituentNames)
+ call MPAS_streamAddField_generic(stream, trim(field % constituentNames(i)), MPAS_IO_INT, field % dimNames(2:ndims), &
+ field % dimSizes(2:ndims), field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, &
+ indices, io_err)
+ end do
+ else
+ call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_INT, field % dimNames, field % dimSizes, &
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+ end if
deallocate(indices)
if (io_err /= MPAS_STREAM_NOERR) then
@@ -315,7 +338,13 @@
return
end if
- call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % fieldname), field % attList)
+ if (field % isSuperArray) then
+ do i=1,size(field % constituentNames)
+ call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % constituentNames(i)), field % attList)
+ end do
+ else
+ call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % fieldname), field % attList)
+ end if
!
@@ -376,8 +405,16 @@
!
#include "add_field_indices.inc"
- call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_INT, field % dimNames, field % dimSizes, &
- field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+ if (field % isSuperArray) then
+ do i=1,size(field % constituentNames)
+ call MPAS_streamAddField_generic(stream, trim(field % constituentNames(i)), MPAS_IO_INT, field % dimNames(2:ndims), &
+ field % dimSizes(2:ndims), field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, &
+ indices, io_err)
+ end do
+ else
+ call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_INT, field % dimNames, field % dimSizes, &
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+ end if
deallocate(indices)
if (io_err /= MPAS_STREAM_NOERR) then
@@ -385,7 +422,13 @@
return
end if
- call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % fieldname), field % attList)
+ if (field % isSuperArray) then
+ do i=1,size(field % constituentNames)
+ call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % constituentNames(i)), field % attList)
+ end do
+ else
+ call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % fieldname), field % attList)
+ end if
!
@@ -525,8 +568,17 @@
#include "add_field_indices.inc"
- call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_DOUBLE, field % dimNames, field % dimSizes, &
- field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+ if (field % isSuperArray) then
+!MGD This could use some testing, in particular, so see whether dimNames(2:1) will pass a 0-sized array
+ do i=1,size(field % constituentNames)
+ call MPAS_streamAddField_generic(stream, trim(field % constituentNames(i)), MPAS_IO_DOUBLE, field % dimNames(2:ndims), &
+ field % dimSizes(2:ndims), field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, &
+ indices, io_err)
+ end do
+ else
+ call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_DOUBLE, field % dimNames, field % dimSizes, &
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+ end if
deallocate(indices)
if (io_err /= MPAS_STREAM_NOERR) then
@@ -534,7 +586,13 @@
return
end if
- call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % fieldname), field % attList)
+ if (field % isSuperArray) then
+ do i=1,size(field % constituentNames)
+ call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % constituentNames(i)), field % attList)
+ end do
+ else
+ call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % fieldname), field % attList)
+ end if
!
@@ -596,8 +654,16 @@
#include "add_field_indices.inc"
- call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_DOUBLE, field % dimNames, field % dimSizes, &
- field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+ if (field % isSuperArray) then
+ do i=1,size(field % constituentNames)
+ call MPAS_streamAddField_generic(stream, trim(field % constituentNames(i)), MPAS_IO_DOUBLE, field % dimNames(2:ndims), &
+ field % dimSizes(2:ndims), field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, &
+ indices, io_err)
+ end do
+ else
+ call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_DOUBLE, field % dimNames, field % dimSizes, &
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+ end if
deallocate(indices)
if (io_err /= MPAS_STREAM_NOERR) then
@@ -605,7 +671,13 @@
return
end if
- call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % fieldname), field % attList)
+ if (field % isSuperArray) then
+ do i=1,size(field % constituentNames)
+ call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % constituentNames(i)), field % attList)
+ end do
+ else
+ call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % fieldname), field % attList)
+ end if
!
@@ -667,8 +739,17 @@
#include "add_field_indices.inc"
- call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_DOUBLE, field % dimNames, field % dimSizes, &
- field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+ if (field % isSuperArray) then
+write(0,*) '^^^^^^^^^^^^^^^^^^^^^^^^^^^ we are adding a super-array'
+ do i=1,size(field % constituentNames)
+ call MPAS_streamAddField_generic(stream, trim(field % constituentNames(i)), MPAS_IO_DOUBLE, field % dimNames(2:ndims), &
+ field % dimSizes(2:ndims), field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, &
+ indices, io_err)
+ end do
+ else
+ call MPAS_streamAddField_generic(stream, trim(field % fieldName), MPAS_IO_DOUBLE, field % dimNames, field % dimSizes, &
+ field % hasTimeDimension, isDecomposed, totalDimSize, globalDimSize, indices, io_err)
+ end if
deallocate(indices)
if (io_err /= MPAS_STREAM_NOERR) then
@@ -676,7 +757,13 @@
return
end if
- call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % fieldname), field % attList)
+ if (field % isSuperArray) then
+ do i=1,size(field % constituentNames)
+ call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % constituentNames(i)), field % attList)
+ end do
+ else
+ call put_get_field_atts(stream % fileHandle, stream % ioDirection, trim(field % fieldname), field % attList)
+ end if
!
@@ -872,7 +959,8 @@
integer, intent(out), optional :: ierr
integer :: io_err
- integer :: i
+ integer :: i, j
+ integer :: ncons
integer :: ownedSize
type (field0dInteger), pointer :: field_0dint_ptr
type (field1dInteger), pointer :: field_1dint_ptr
@@ -946,163 +1034,231 @@
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
+ if (field_cursor % int1dField % isSuperArray) then
+ ncons = size(field_cursor % int1dField % constituentNames)
+ else
+ ncons = 1
+ allocate(int1d_temp(field_cursor % totalDimSize))
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
+ do j=1,ncons
+ if (field_cursor % int1dField % isSuperArray) then
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % int1dField % constituentNames(j), int0d_temp, io_err)
else
- ownedSize = field_1dint_ptr % dimSizes(1)
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % int1dField % fieldName, int1d_temp, io_err)
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_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ if (.not. field_cursor % int1dField % isSuperArray) then
+ deallocate(int1d_temp)
+ end if
+ return
+ end if
+
+ if (field_cursor % isDecomposed) then
+ ! Distribute field to multiple blocks
+ field_1dint_ptr => field_cursor % int1dField
+ i = 1
+ 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))
+ if (field_cursor % int1dField % isSuperArray) then
+ field_1dint_ptr % array(j) = int0d_temp
+ else
+ field_1dint_ptr % array(1:ownedSize) = int1d_temp(i:i+ownedSize-1)
+ end if
+ i = i + ownedSize
+ field_1dint_ptr => field_1dint_ptr % next
+ end do
- 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
+ else
+
+ if (field_cursor % int1dField % isSuperArray) then
+ call mpas_dmpar_bcast_int(field_cursor % int1dField % block % domain % dminfo, int0d_temp)
+ field_1dint_ptr => field_cursor % int1dField
+ do while (associated(field_1dint_ptr))
+ field_1dint_ptr % array(j) = int0d_temp
+ field_1dint_ptr => field_1dint_ptr % next
+ end do
+ else
+ 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
+ end if
+ end do
+
+ if (.not. field_cursor % int1dField % isSuperArray) then
+ deallocate(int1d_temp)
end if
- 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
+ if (field_cursor % int2dField % isSuperArray) then
+ ncons = size(field_cursor % int2dField % constituentNames)
+ allocate(int1d_temp(field_cursor % totalDimSize))
+ else
+ ncons = 1
+ allocate(int2d_temp(field_cursor % int2dField % dimSizes(1), &
+ field_cursor % totalDimSize))
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
+ do j=1,ncons
+ if (field_cursor % int2dField % isSuperArray) then
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % int2dField % constituentNames(j), int1d_temp, io_err)
else
- ownedSize = field_2dint_ptr % dimSizes(2)
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % int2dField % fieldName, int2d_temp, io_err)
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
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ if (field_cursor % int2dField % isSuperArray) then
+ deallocate(int1d_temp)
+ else
+ deallocate(int2d_temp)
+ end if
+ return
+ end if
+
+ if (field_cursor % isDecomposed) then
+ ! Distribute field to multiple blocks
+ field_2dint_ptr => field_cursor % int2dField
+ i = 1
+ 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))
+ if (field_cursor % int2dField % isSuperArray) then
+ field_2dint_ptr % array(j,1:ownedSize) = int1d_temp(i:i+ownedSize-1)
+ else
+ field_2dint_ptr % array(:,1:ownedSize) = int2d_temp(:,i:i+ownedSize-1)
+ end if
+ i = i + ownedSize
+ field_2dint_ptr => field_2dint_ptr % next
+ end do
+
+ else
+
+ if (field_cursor % int2dField % isSuperArray) then
+ call mpas_dmpar_bcast_ints(field_cursor % int2dField % block % domain % dminfo, size(int1d_temp), int1d_temp(:))
+ field_2dint_ptr => field_cursor % int2dField
+ do while (associated(field_2dint_ptr))
+ field_2dint_ptr % array(j,:) = int1d_temp(:)
+ field_2dint_ptr => field_2dint_ptr % next
+ end do
+ else
+ 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
+ end if
+ end do
+
+ if (field_cursor % int2dField % isSuperArray) then
+ deallocate(int1d_temp)
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
+ deallocate(int2d_temp)
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
+ if (field_cursor % int3dField % isSuperArray) then
+ ncons = size(field_cursor % int3dField % constituentNames)
+ allocate(int2d_temp(field_cursor % int3dField % dimSizes(2), &
+ field_cursor % totalDimSize))
+ else
+ ncons = 1
+ allocate(int3d_temp(field_cursor % int3dField % dimSizes(1), &
+ field_cursor % int3dField % dimSizes(2), &
+ field_cursor % totalDimSize))
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
+ do j=1,ncons
+ if (field_cursor % int3dField % isSuperArray) then
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % int3dField % constituentNames(j), int2d_temp, io_err)
else
- ownedSize = field_3dint_ptr % dimSizes(3)
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % int3dField % fieldName, int3d_temp, io_err)
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
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ if (field_cursor % int3dField % isSuperArray) then
+ deallocate(int2d_temp)
+ else
+ deallocate(int3d_temp)
+ end if
+ return
+ end if
+
+ if (field_cursor % isDecomposed) then
+ ! Distribute field to multiple blocks
+ field_3dint_ptr => field_cursor % int3dField
+ i = 1
+ 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))
+ if (field_cursor % int3dField % isSuperArray) then
+ field_3dint_ptr % array(j,:,1:ownedSize) = int2d_temp(:,i:i+ownedSize-1)
+ else
+ field_3dint_ptr % array(:,:,1:ownedSize) = int3d_temp(:,:,i:i+ownedSize-1)
+ end if
+ i = i + ownedSize
+ field_3dint_ptr => field_3dint_ptr % next
+ end do
+
+ else
+
+ if (field_cursor % int3dField % isSuperArray) then
+ call mpas_dmpar_bcast_ints(field_cursor % int3dField % block % domain % dminfo, size(int2d_temp), int2d_temp(:,1))
+ field_3dint_ptr => field_cursor % int3dField
+ do while (associated(field_3dint_ptr))
+ field_3dint_ptr % array(j,:,:) = int2d_temp(:,:)
+ field_3dint_ptr => field_3dint_ptr % next
+ end do
+ else
+ 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
+ end if
+ end do
+
+ if (field_cursor % int3dField % isSuperArray) then
+ deallocate(int2d_temp)
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
+ deallocate(int3d_temp)
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)
@@ -1128,163 +1284,231 @@
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
+ if (field_cursor % real1dField % isSuperArray) then
+ ncons = size(field_cursor % real1dField % constituentNames)
+ else
+ ncons = 1
+ allocate(real1d_temp(field_cursor % totalDimSize))
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
+ do j=1,ncons
+ if (field_cursor % real1dField % isSuperArray) then
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % real1dField % constituentNames(j), real0d_temp, io_err)
else
- ownedSize = field_1dreal_ptr % dimSizes(1)
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % real1dField % fieldName, real1d_temp, io_err)
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_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ if (.not. field_cursor % real1dField % isSuperArray) then
+ deallocate(real1d_temp)
+ end if
+ return
+ end if
+
+ if (field_cursor % isDecomposed) then
+ ! Distribute field to multiple blocks
+ field_1dreal_ptr => field_cursor % real1dField
+ i = 1
+ 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))
+ if (field_cursor % real1dField % isSuperArray) then
+ field_1dreal_ptr % array(j) = real0d_temp
+ else
+ field_1dreal_ptr % array(1:ownedSize) = real1d_temp(i:i+ownedSize-1)
+ end if
+ i = i + ownedSize
+ field_1dreal_ptr => field_1dreal_ptr % next
+ end do
- 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
+ else
+
+ if (field_cursor % real1dField % isSuperArray) then
+ call mpas_dmpar_bcast_real(field_cursor % real1dField % block % domain % dminfo, real0d_temp)
+ field_1dreal_ptr => field_cursor % real1dField
+ do while (associated(field_1dreal_ptr))
+ field_1dreal_ptr % array(j) = real0d_temp
+ field_1dreal_ptr => field_1dreal_ptr % next
+ end do
+ else
+ 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
+ end if
+ end do
+
+ if (.not. field_cursor % real1dField % isSuperArray) then
+ deallocate(real1d_temp)
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
+ if (field_cursor % real2dField % isSuperArray) then
+ ncons = size(field_cursor % real2dField % constituentNames)
+ allocate(real1d_temp(field_cursor % totalDimSize))
+ else
+ ncons = 1
+ allocate(real2d_temp(field_cursor % real2dField % dimSizes(1), &
+ field_cursor % totalDimSize))
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
+ do j=1,ncons
+ if (field_cursor % real2dField % isSuperArray) then
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % real2dField % constituentNames(j), real1d_temp, io_err)
else
- ownedSize = field_2dreal_ptr % dimSizes(2)
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % real2dField % fieldName, real2d_temp, io_err)
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
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ if (field_cursor % real2dField % isSuperArray) then
+ deallocate(real1d_temp)
+ else
+ deallocate(real2d_temp)
+ end if
+ return
+ end if
+
+ if (field_cursor % isDecomposed) then
+ ! Distribute field to multiple blocks
+ field_2dreal_ptr => field_cursor % real2dField
+ i = 1
+ 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))
+ if (field_cursor % real2dField % isSuperArray) then
+ field_2dreal_ptr % array(j,1:ownedSize) = real1d_temp(i:i+ownedSize-1)
+ else
+ field_2dreal_ptr % array(:,1:ownedSize) = real2d_temp(:,i:i+ownedSize-1)
+ end if
+ i = i + ownedSize
+ field_2dreal_ptr => field_2dreal_ptr % next
+ end do
+
+ else
+
+ if (field_cursor % real2dField % isSuperArray) then
+ call mpas_dmpar_bcast_reals(field_cursor % real2dField % block % domain % dminfo, size(real1d_temp), real1d_temp(:))
+ field_2dreal_ptr => field_cursor % real2dField
+ do while (associated(field_2dreal_ptr))
+ field_2dreal_ptr % array(j,:) = real1d_temp(:)
+ field_2dreal_ptr => field_2dreal_ptr % next
+ end do
+ else
+ 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
+ end if
+ end do
+
+ if (field_cursor % real2dField % isSuperArray) then
+ deallocate(real1d_temp)
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
+ deallocate(real2d_temp)
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
+ if (field_cursor % real3dField % isSuperArray) then
+ ncons = size(field_cursor % real3dField % constituentNames)
+ allocate(real2d_temp(field_cursor % real3dField % dimSizes(2), &
+ field_cursor % totalDimSize))
+ else
+ ncons = 1
+ allocate(real3d_temp(field_cursor % real3dField % dimSizes(1), &
+ field_cursor % real3dField % dimSizes(2), &
+ field_cursor % totalDimSize))
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
+ do j=1,ncons
+ if (field_cursor % real3dField % isSuperArray) then
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % real3dField % constituentNames(j), real2d_temp, io_err)
else
- ownedSize = field_3dreal_ptr % dimSizes(3)
+ call MPAS_io_get_var(stream % fileHandle, field_cursor % real3dField % fieldName, real3d_temp, io_err)
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
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR) then
+ if (present(ierr)) ierr = MPAS_IO_ERR
+ if (field_cursor % real3dField % isSuperArray) then
+ deallocate(real2d_temp)
+ else
+ deallocate(real3d_temp)
+ end if
+ return
+ end if
+
+ if (field_cursor % isDecomposed) then
+ ! Distribute field to multiple blocks
+ field_3dreal_ptr => field_cursor % real3dField
+ i = 1
+ 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))
+ if (field_cursor % real3dField % isSuperArray) then
+ field_3dreal_ptr % array(j,:,1:ownedSize) = real2d_temp(:,i:i+ownedSize-1)
+ else
+ field_3dreal_ptr % array(:,:,1:ownedSize) = real3d_temp(:,:,i:i+ownedSize-1)
+ end if
+ i = i + ownedSize
+ field_3dreal_ptr => field_3dreal_ptr % next
+ end do
+
+ else
+
+ if (field_cursor % real3dField % isSuperArray) then
+ call mpas_dmpar_bcast_reals(field_cursor % real3dField % block % domain % dminfo, size(real2d_temp), real2d_temp(:,1))
+ field_3dreal_ptr => field_cursor % real3dField
+ do while (associated(field_3dreal_ptr))
+ field_3dreal_ptr % array(j,:,:) = real2d_temp(:,:)
+ field_3dreal_ptr => field_3dreal_ptr % next
+ end do
+ else
+ 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
+ end if
+ end do
+
+ if (field_cursor % real3dField % isSuperArray) then
+ deallocate(real2d_temp)
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
+ deallocate(real3d_temp)
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
@@ -1304,7 +1528,8 @@
integer, intent(out), optional :: ierr
integer :: io_err
- integer :: i
+ integer :: i, j
+ integer :: ncons
integer :: ownedSize
type (field0dInteger), pointer :: field_0dint_ptr
type (field1dInteger), pointer :: field_1dint_ptr
@@ -1351,6 +1576,7 @@
!
field_cursor => stream % fieldList
do while (associated(field_cursor))
+
if (field_cursor % field_type == FIELD_0D_INT) then
write(0,*) 'Writing out field '//trim(field_cursor % int0dField % fieldName)
@@ -1367,129 +1593,177 @@
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
+ if (field_cursor % int1dField % isSuperArray) then
+ ncons = size(field_cursor % int1dField % constituentNames)
+ else
+ ncons = 1
+ allocate(int1d_temp(field_cursor % totalDimSize))
+ end if
- allocate(int1d_temp(field_cursor % totalDimSize))
+ do j=1,ncons
+ if (field_cursor % isDecomposed) then
+ ! Gather field from across multiple blocks
+ field_1dint_ptr => field_cursor % int1dField
+ i = 1
+ do while (associated(field_1dint_ptr))
+ if (trim(field_1dint_ptr % dimNames(2)) == 'nCells') then
+ ownedSize = field_1dint_ptr % block % mesh % nCellsSolve
+ else if (trim(field_1dint_ptr % dimNames(2)) == 'nEdges') then
+ ownedSize = field_1dint_ptr % block % mesh % nEdgesSolve
+ else if (trim(field_1dint_ptr % dimNames(2)) == 'nVertices') then
+ ownedSize = field_1dint_ptr % block % mesh % nVerticesSolve
+ else
+ ownedSize = field_1dint_ptr % dimSizes(2)
+ end if
- if (field_cursor % isDecomposed) then
-write(0,*) 'Gathering field from across all blocks'
- ! Gather field from across multiple blocks
- field_1dint_ptr => field_cursor % int1dField
- i = 1
- do while (associated(field_1dint_ptr))
-! 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
+ if (field_cursor % int1dField % isSuperArray) then
+! I suspect we will never hit this code, as it doesn't make sense, really
+ int0d_temp = field_1dint_ptr % array(j)
+ else
+ int1d_temp(i:i+ownedSize-1) = field_1dint_ptr % array(1:ownedSize)
+ end if
+ i = i + ownedSize
+ field_1dint_ptr => field_1dint_ptr % next
+ end do
+ else
+ if (field_cursor % int1dField % isSuperArray) then
+ int0d_temp = field_cursor % int1dField % array(j)
else
- ownedSize = field_1dint_ptr % dimSizes(1)
+ int1d_temp(:) = field_cursor % int1dField % array(:)
end if
-write(0,*) ' > copying block ', i, i+ownedSize-1
- int1d_temp(i:i+ownedSize-1) = field_1dint_ptr % array(1:ownedSize)
- i = i + ownedSize
- field_1dint_ptr => field_1dint_ptr % next
- end do
- else
-write(0,*) 'Copying field from first block'
- int1d_temp(:) = field_cursor % int1dField % array(:)
- end if
+ end if
-write(0,*) 'MGD calling MPAS_io_put_var now...'
- call MPAS_io_put_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 .and. present(ierr)) ierr = MPAS_IO_ERR
+ if (field_cursor % int1dField % isSuperArray) then
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % int1dField % constituentNames(j), int0d_temp, io_err)
+ else
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % int1dField % fieldName, int1d_temp, io_err)
+ end if
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR
+ end do
- deallocate(int1d_temp)
+ if (.not. field_cursor % int1dField % isSuperArray) then
+ deallocate(int1d_temp)
+ end if
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
+ if (field_cursor % int2dField % isSuperArray) then
+ ncons = size(field_cursor % int2dField % constituentNames)
+ allocate(int1d_temp(field_cursor % totalDimSize))
+ else
+ ncons = 1
+ allocate(int2d_temp(field_cursor % int2dField % dimSizes(1), &
+ field_cursor % totalDimSize))
+ end if
- allocate(int2d_temp(field_cursor % int2dField % dimSizes(1), field_cursor % totalDimSize))
+ do j=1,ncons
+ if (field_cursor % isDecomposed) then
+ ! Gather field from across multiple blocks
+ field_2dint_ptr => field_cursor % int2dField
+ i = 1
+ do while (associated(field_2dint_ptr))
+ 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
- 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
+ if (field_cursor % int2dField % isSuperArray) then
+ int1d_temp(i:i+ownedSize-1) = field_2dint_ptr % array(j,1:ownedSize)
+ else
+ int2d_temp(:,i:i+ownedSize-1) = field_2dint_ptr % array(:,1:ownedSize)
+ end if
+ i = i + ownedSize
+ field_2dint_ptr => field_2dint_ptr % next
+ end do
+ else
+ if (field_cursor % int2dField % isSuperArray) then
+ int1d_temp(:) = field_cursor % int2dField % array(j,:)
else
- ownedSize = field_2dint_ptr % dimSizes(2)
+ int2d_temp(:,:) = field_cursor % int2dField % array(:,:)
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
+ end if
+
+ if (field_cursor % int2dField % isSuperArray) then
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % int2dField % constituentNames(j), int1d_temp, io_err)
+ else
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % int2dField % fieldName, int2d_temp, io_err)
+ end if
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR
+ end do
+
+ if (field_cursor % int2dField % isSuperArray) then
+ deallocate(int1d_temp)
else
-write(0,*) 'Copying field from first block'
- int2d_temp(:,:) = field_cursor % int2dField % array(:,:)
+ deallocate(int2d_temp)
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
+ if (field_cursor % int3dField % isSuperArray) then
+ ncons = size(field_cursor % int3dField % constituentNames)
+ allocate(int2d_temp(field_cursor % int3dField % dimSizes(2), &
+ field_cursor % totalDimSize))
+ else
+ ncons = 1
+ allocate(int3d_temp(field_cursor % int3dField % dimSizes(1), &
+ field_cursor % int3dField % dimSizes(2), &
+ field_cursor % totalDimSize))
+ end if
- allocate(int3d_temp(field_cursor % int3dField % dimSizes(1), &
- field_cursor % int3dField % dimSizes(2), &
- field_cursor % totalDimSize))
+ do j=1,ncons
+ if (field_cursor % isDecomposed) then
+ ! Gather field from across multiple blocks
+ field_3dint_ptr => field_cursor % int3dField
+ i = 1
+ do while (associated(field_3dint_ptr))
+ 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
- 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
+ if (field_cursor % int3dField % isSuperArray) then
+ int2d_temp(:,i:i+ownedSize-1) = field_3dint_ptr % array(j,:,1:ownedSize)
+ else
+ int3d_temp(:,:,i:i+ownedSize-1) = field_3dint_ptr % array(:,:,1:ownedSize)
+ end if
+ i = i + ownedSize
+ field_3dint_ptr => field_3dint_ptr % next
+ end do
+ else
+ if (field_cursor % int3dField % isSuperArray) then
+ int2d_temp(:,:) = field_cursor % int3dField % array(j,:,:)
else
- ownedSize = field_3dint_ptr % dimSizes(3)
+ int3d_temp(:,:,:) = field_cursor % int3dField % array(:,:,:)
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
+ end if
+
+ if (field_cursor % int3dField % isSuperArray) then
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % int3dField % constituentNames(j), int2d_temp, io_err)
+ else
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % int3dField % fieldName, int3d_temp, io_err)
+ end if
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR
+ end do
+
+ if (field_cursor % int3dField % isSuperArray) then
+ deallocate(int2d_temp)
else
-write(0,*) 'Copying field from first block'
- int3d_temp(:,:,:) = field_cursor % int3dField % array(:,:,:)
+ deallocate(int3d_temp)
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)
@@ -1506,129 +1780,177 @@
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
+ if (field_cursor % real1dField % isSuperArray) then
+ ncons = size(field_cursor % real1dField % constituentNames)
+ else
+ ncons = 1
+ allocate(real1d_temp(field_cursor % totalDimSize))
+ end if
- allocate(real1d_temp(field_cursor % totalDimSize))
+ do j=1,ncons
+ if (field_cursor % isDecomposed) then
+ ! Gather field from across multiple blocks
+ field_1dreal_ptr => field_cursor % real1dField
+ i = 1
+ do while (associated(field_1dreal_ptr))
+ if (trim(field_1dreal_ptr % dimNames(2)) == 'nCells') then
+ ownedSize = field_1dreal_ptr % block % mesh % nCellsSolve
+ else if (trim(field_1dreal_ptr % dimNames(2)) == 'nEdges') then
+ ownedSize = field_1dreal_ptr % block % mesh % nEdgesSolve
+ else if (trim(field_1dreal_ptr % dimNames(2)) == 'nVertices') then
+ ownedSize = field_1dreal_ptr % block % mesh % nVerticesSolve
+ else
+ ownedSize = field_1dreal_ptr % dimSizes(2)
+ end if
- 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
+ if (field_cursor % real1dField % isSuperArray) then
+! I suspect we will never hit this code, as it doesn't make sense, really
+ real0d_temp = field_1dreal_ptr % array(j)
+ else
+ real1d_temp(i:i+ownedSize-1) = field_1dreal_ptr % array(1:ownedSize)
+ end if
+ i = i + ownedSize
+ field_1dreal_ptr => field_1dreal_ptr % next
+ end do
+ else
+ if (field_cursor % real1dField % isSuperArray) then
+ real0d_temp = field_cursor % real1dField % array(j)
else
- ownedSize = field_1dreal_ptr % dimSizes(1)
+ real1d_temp(:) = field_cursor % real1dField % array(:)
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
+ 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
+ if (field_cursor % real1dField % isSuperArray) then
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % real1dField % constituentNames(j), real0d_temp, io_err)
+ else
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % real1dField % fieldName, real1d_temp, io_err)
+ end if
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR
+ end do
- deallocate(real1d_temp)
+ if (.not. field_cursor % real1dField % isSuperArray) then
+ deallocate(real1d_temp)
+ end if
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
+ if (field_cursor % real2dField % isSuperArray) then
+ ncons = size(field_cursor % real2dField % constituentNames)
+ allocate(real1d_temp(field_cursor % totalDimSize))
+ else
+ ncons = 1
+ allocate(real2d_temp(field_cursor % real2dField % dimSizes(1), &
+ field_cursor % totalDimSize))
+ end if
- allocate(real2d_temp(field_cursor % real2dField % dimSizes(1), field_cursor % totalDimSize))
+ do j=1,ncons
+ if (field_cursor % isDecomposed) then
+ ! Gather field from across multiple blocks
+ field_2dreal_ptr => field_cursor % real2dField
+ i = 1
+ do while (associated(field_2dreal_ptr))
+ 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
- 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
+ if (field_cursor % real2dField % isSuperArray) then
+ real1d_temp(i:i+ownedSize-1) = field_2dreal_ptr % array(j,1:ownedSize)
+ else
+ real2d_temp(:,i:i+ownedSize-1) = field_2dreal_ptr % array(:,1:ownedSize)
+ end if
+ i = i + ownedSize
+ field_2dreal_ptr => field_2dreal_ptr % next
+ end do
+ else
+ if (field_cursor % real2dField % isSuperArray) then
+ real1d_temp(:) = field_cursor % real2dField % array(j,:)
else
- ownedSize = field_2dreal_ptr % dimSizes(2)
+ real2d_temp(:,:) = field_cursor % real2dField % array(:,:)
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
+ end if
+
+ if (field_cursor % real2dField % isSuperArray) then
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % real2dField % constituentNames(j), real1d_temp, io_err)
+ else
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % real2dField % fieldName, real2d_temp, io_err)
+ end if
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR
+ end do
+
+ if (field_cursor % real2dField % isSuperArray) then
+ deallocate(real1d_temp)
else
-write(0,*) 'Copying field from first block'
- real2d_temp(:,:) = field_cursor % real2dField % array(:,:)
+ deallocate(real2d_temp)
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
+ if (field_cursor % real3dField % isSuperArray) then
+ ncons = size(field_cursor % real3dField % constituentNames)
+ allocate(real2d_temp(field_cursor % real3dField % dimSizes(2), &
+ field_cursor % totalDimSize))
+ else
+ ncons = 1
+ allocate(real3d_temp(field_cursor % real3dField % dimSizes(1), &
+ field_cursor % real3dField % dimSizes(2), &
+ field_cursor % totalDimSize))
+ end if
- allocate(real3d_temp(field_cursor % real3dField % dimSizes(1), &
- field_cursor % real3dField % dimSizes(2), &
- field_cursor % totalDimSize))
+ do j=1,ncons
+ if (field_cursor % isDecomposed) then
+ ! Gather field from across multiple blocks
+ field_3dreal_ptr => field_cursor % real3dField
+ i = 1
+ do while (associated(field_3dreal_ptr))
+ 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
- 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
+ if (field_cursor % real3dField % isSuperArray) then
+ real2d_temp(:,i:i+ownedSize-1) = field_3dreal_ptr % array(j,:,1:ownedSize)
+ else
+ real3d_temp(:,:,i:i+ownedSize-1) = field_3dreal_ptr % array(:,:,1:ownedSize)
+ end if
+ i = i + ownedSize
+ field_3dreal_ptr => field_3dreal_ptr % next
+ end do
+ else
+ if (field_cursor % real3dField % isSuperArray) then
+ real2d_temp(:,:) = field_cursor % real3dField % array(j,:,:)
else
- ownedSize = field_3dreal_ptr % dimSizes(3)
+ real3d_temp(:,:,:) = field_cursor % real3dField % array(:,:,:)
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
+ end if
+
+ if (field_cursor % real3dField % isSuperArray) then
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % real3dField % constituentNames(j), real2d_temp, io_err)
+ else
+ call MPAS_io_put_var(stream % fileHandle, field_cursor % real3dField % fieldName, real3d_temp, io_err)
+ end if
+ call MPAS_io_err_mesg(io_err, .false.)
+ if (io_err /= MPAS_IO_NOERR .and. present(ierr)) ierr = MPAS_IO_ERR
+ end do
+
+ if (field_cursor % real3dField % isSuperArray) then
+ deallocate(real2d_temp)
else
-write(0,*) 'Copying field from first block'
- real3d_temp(:,:,:) = field_cursor % real3dField % array(:,:,:)
+ deallocate(real3d_temp)
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>