<p><b>duda</b> 2012-03-15 17:29:21 -0600 (Thu, 15 Mar 2012)</p><p>BRANCH COMMIT<br>
<br>
Update the field derived types as in section 3.1.3 of the I/O design document.<br>
Also, add a new module, mpas_attlist, for adding and removing attributes to and from fields.<br>
<br>
To do: decide on how to handle super-arrays in the field types so that all necessary information<br>
for reading and writing individual constituents is described in these types.<br>
<br>
<br>
M registry/gen_inc.c<br>
A framework/mpas_attlist.F<br>
M framework/mpas_dmpar.F<br>
M framework/mpas_grid_types.F<br>
M framework/Makefile<br>
</p><hr noshade><pre><font color="gray">Modified: branches/omp_blocks/io/src/framework/Makefile
===================================================================
--- branches/omp_blocks/io/src/framework/Makefile 2012-03-15 22:53:37 UTC (rev 1654)
+++ branches/omp_blocks/io/src/framework/Makefile 2012-03-15 23:29:21 UTC (rev 1655)
@@ -11,6 +11,7 @@
mpas_configure.o \
mpas_constants.o \
mpas_dmpar_types.o \
+ mpas_attlist.o \
mpas_grid_types.o \
mpas_hash.o \
mpas_sort.o \
@@ -35,8 +36,10 @@
mpas_dmpar_types.o : mpas_kind_types.o
-mpas_grid_types.o: mpas_kind_types.o mpas_dmpar_types.o
+mpas_attlist.o: mpas_kind_types.o
+mpas_grid_types.o: mpas_kind_types.o mpas_dmpar_types.o mpas_attlist.o
+
mpas_dmpar.o: mpas_sort.o streams.o mpas_kind_types.o mpas_grid_types.o
mpas_sort.o: mpas_kind_types.o
Added: branches/omp_blocks/io/src/framework/mpas_attlist.F
===================================================================
--- branches/omp_blocks/io/src/framework/mpas_attlist.F (rev 0)
+++ branches/omp_blocks/io/src/framework/mpas_attlist.F 2012-03-15 23:29:21 UTC (rev 1655)
@@ -0,0 +1,489 @@
+module mpas_attlist
+
+ use mpas_kind_types
+
+ ! Derived type for holding field attributes
+ type att_list_type
+ character (len=64) :: attName
+ integer :: attType
+ integer :: attValueInt
+ integer, dimension(:), pointer :: attValueIntA => null()
+ real (kind=RKIND) :: attValueReal
+ real (kind=RKIND), dimension(:), pointer :: attValueRealA => null()
+ character (len=1024) :: attValueText
+ type (att_list_type), pointer :: next => null()
+ end type att_list_type
+
+ interface mpas_add_att
+ module procedure mpas_add_att_int0d
+ module procedure mpas_add_att_int1d
+ module procedure mpas_add_att_real0d
+ module procedure mpas_add_att_real1d
+ module procedure mpas_add_att_text
+ end interface mpas_add_att
+
+ interface mpas_get_att
+ module procedure mpas_get_att_int0d
+ module procedure mpas_get_att_int1d
+ module procedure mpas_get_att_real0d
+ module procedure mpas_get_att_real1d
+ module procedure mpas_get_att_text
+ end interface mpas_get_att
+
+
+ !!!!! PRIVATE !!!!!
+
+ integer, parameter, private :: ATT_INT = 1
+ integer, parameter, private :: ATT_INTA = 2
+ integer, parameter, private :: ATT_REAL = 3
+ integer, parameter, private :: ATT_REALA = 4
+ integer, parameter, private :: ATT_TEXT = 5
+
+
+contains
+
+
+ subroutine mpas_add_att_int0d(attList, attName, attValue, ierr)
+
+ implicit none
+
+ type (att_list_type), pointer :: attList
+ character (len=*), intent(in) :: attName
+ integer, intent(in) :: attValue
+ integer, intent(out), optional :: ierr
+
+ type (att_list_type), pointer :: cursor
+
+ if (present(ierr)) ierr = 0
+
+ if (.not. associated(attList)) then
+ allocate(attList)
+write(0,*) 'Adding at the head of the list'
+ cursor => attList
+ else
+ cursor => attList
+ do while (associated(cursor % next))
+ cursor => cursor % next
+ end do
+ allocate(cursor % next)
+write(0,*) 'Adding at the end of the list'
+ cursor => cursor % next
+ end if
+
+ cursor % attType = ATT_INT
+ write(cursor % attName,'(a)') trim(attName)
+ cursor % attValueInt = attValue
+
+ end subroutine mpas_add_att_int0d
+
+
+ subroutine mpas_add_att_int1d(attList, attName, attValue, ierr)
+
+ implicit none
+
+ type (att_list_type), pointer :: attList
+ character (len=*), intent(in) :: attName
+ integer, dimension(:), intent(in) :: attValue
+ integer, intent(out), optional :: ierr
+
+ type (att_list_type), pointer :: cursor
+
+ if (present(ierr)) ierr = 0
+
+ if (.not. associated(attList)) then
+ allocate(attList)
+write(0,*) 'Adding at the head of the list'
+ cursor => attList
+ else
+ cursor => attList
+ do while (associated(cursor % next))
+ cursor => cursor % next
+ end do
+ allocate(cursor % next)
+write(0,*) 'Adding at the end of the list'
+ cursor => cursor % next
+ end if
+
+!!!
+ cursor % attType = ATT_INTA
+ allocate(cursor % attValueIntA(size(attValue)))
+ write(cursor % attName,'(a)') trim(attName)
+ cursor % attValueIntA(:) = attValue(:)
+!!!
+
+ end subroutine mpas_add_att_int1d
+
+
+ subroutine mpas_add_att_real0d(attList, attName, attValue, ierr)
+
+ implicit none
+
+ type (att_list_type), pointer :: attList
+ character (len=*), intent(in) :: attName
+ real (kind=RKIND), intent(in) :: attValue
+ integer, intent(out), optional :: ierr
+
+ type (att_list_type), pointer :: cursor
+
+ if (present(ierr)) ierr = 0
+
+ if (.not. associated(attList)) then
+ allocate(attList)
+write(0,*) 'Adding at the head of the list'
+ cursor => attList
+ else
+ cursor => attList
+ do while (associated(cursor % next))
+ cursor => cursor % next
+ end do
+ allocate(cursor % next)
+write(0,*) 'Adding at the end of the list'
+ cursor => cursor % next
+ end if
+
+ cursor % attType = ATT_REAL
+ write(cursor % attName,'(a)') trim(attName)
+ cursor % attValueReal = attValue
+
+ end subroutine mpas_add_att_real0d
+
+
+ subroutine mpas_add_att_real1d(attList, attName, attValue, ierr)
+
+ implicit none
+
+ type (att_list_type), pointer :: attList
+ character (len=*), intent(in) :: attName
+ real (kind=RKIND), dimension(:), intent(in) :: attValue
+ integer, intent(out), optional :: ierr
+
+ type (att_list_type), pointer :: cursor
+
+ if (present(ierr)) ierr = 0
+
+ if (.not. associated(attList)) then
+ allocate(attList)
+write(0,*) 'Adding at the head of the list'
+ cursor => attList
+ else
+ cursor => attList
+ do while (associated(cursor % next))
+ cursor => cursor % next
+ end do
+ allocate(cursor % next)
+write(0,*) 'Adding at the end of the list'
+ cursor => cursor % next
+ end if
+
+!!!
+ cursor % attType = ATT_REALA
+ allocate(cursor % attValueRealA(size(attValue)))
+ write(cursor % attName,'(a)') trim(attName)
+ cursor % attValueRealA(:) = attValue(:)
+!!!
+
+ end subroutine mpas_add_att_real1d
+
+
+ subroutine mpas_add_att_text(attList, attName, attValue, ierr)
+
+ implicit none
+
+ type (att_list_type), pointer :: attList
+ character (len=*), intent(in) :: attName
+ character (len=*), intent(in) :: attValue
+ integer, intent(out), optional :: ierr
+
+ type (att_list_type), pointer :: cursor
+
+ if (present(ierr)) ierr = 0
+
+ if (.not. associated(attList)) then
+ allocate(attList)
+write(0,*) 'Adding at the head of the list'
+ cursor => attList
+ else
+ cursor => attList
+ do while (associated(cursor % next))
+ cursor => cursor % next
+ end do
+ allocate(cursor % next)
+write(0,*) 'Adding at the end of the list'
+ cursor => cursor % next
+ end if
+
+!!!
+ cursor % attType = ATT_TEXT
+ write(cursor % attName,'(a)') trim(attName)
+ write(cursor % attValueText,'(a)') trim(attValue)
+!!!
+
+ end subroutine mpas_add_att_text
+
+
+ subroutine mpas_get_att_int0d(attList, attName, attValue, ierr)
+
+ implicit none
+
+ type (att_list_type), pointer :: attList
+ character (len=*), intent(in) :: attName
+ integer, intent(out) :: attValue
+ integer, intent(out), optional :: ierr
+
+ type (att_list_type), pointer :: cursor
+
+ if (present(ierr)) ierr = 0
+
+ cursor => attList
+write(0,*) 'Starting at the head of the list...'
+ do while (associated(cursor))
+write(0,*) 'Comparing '//trim(attName)//' and '//trim(cursor % attName)
+ if (trim(attName) == trim(cursor % attName)) then
+ if (cursor % attType /= ATT_INT) then
+write(0,*) 'Wrong type for attribute'
+ if (present(ierr)) ierr = 1 ! Wrong type
+ else
+ attValue = cursor % attValueInt
+write(0,*) 'Assigning output value ', cursor % attValueInt
+ end if
+ return
+ end if
+ cursor => cursor % next
+ end do
+write(0,*) 'Finished searching unsuccessfully'
+
+ if (present(ierr)) ierr = 1 ! Not found
+
+ end subroutine mpas_get_att_int0d
+
+
+ subroutine mpas_get_att_int1d(attList, attName, attValue, ierr)
+
+ implicit none
+
+ type (att_list_type), pointer :: attList
+ character (len=*), intent(in) :: attName
+ integer, dimension(:), pointer :: attValue
+ integer, intent(out), optional :: ierr
+
+ type (att_list_type), pointer :: cursor
+
+ if (present(ierr)) ierr = 0
+
+ cursor => attList
+write(0,*) 'Starting at the head of the list...'
+ do while (associated(cursor))
+write(0,*) 'Comparing '//trim(attName)//' and '//trim(cursor % attName)
+ if (trim(attName) == trim(cursor % attName)) then
+ if (cursor % attType /= ATT_INTA) then
+write(0,*) 'Wrong type for attribute'
+ if (present(ierr)) ierr = 1 ! Wrong type
+ else
+ allocate(attValue(size(cursor % attValueIntA)))
+ attValue(:) = cursor % attValueIntA(:)
+write(0,*) 'Assigning output value ', cursor % attValueIntA
+ end if
+ return
+ end if
+ cursor => cursor % next
+ end do
+write(0,*) 'Finished searching unsuccessfully'
+
+ if (present(ierr)) ierr = 1 ! Not found
+
+ end subroutine mpas_get_att_int1d
+
+
+ subroutine mpas_get_att_real0d(attList, attName, attValue, ierr)
+
+ implicit none
+
+ type (att_list_type), pointer :: attList
+ character (len=*), intent(in) :: attName
+ real (kind=RKIND), intent(out) :: attValue
+ integer, intent(out), optional :: ierr
+
+ type (att_list_type), pointer :: cursor
+
+ if (present(ierr)) ierr = 0
+
+ cursor => attList
+write(0,*) 'Starting at the head of the list...'
+ do while (associated(cursor))
+write(0,*) 'Comparing '//trim(attName)//' and '//trim(cursor % attName)
+ if (trim(attName) == trim(cursor % attName)) then
+ if (cursor % attType /= ATT_REAL) then
+write(0,*) 'Wrong type for attribute'
+ if (present(ierr)) ierr = 1 ! Wrong type
+ else
+ attValue = cursor % attValueReal
+write(0,*) 'Assigning output value ', cursor % attValueReal
+ end if
+ return
+ end if
+ cursor => cursor % next
+ end do
+write(0,*) 'Finished searching unsuccessfully'
+
+ if (present(ierr)) ierr = 1 ! Not found
+
+ end subroutine mpas_get_att_real0d
+
+
+ subroutine mpas_get_att_real1d(attList, attName, attValue, ierr)
+
+ implicit none
+
+ type (att_list_type), pointer :: attList
+ character (len=*), intent(in) :: attName
+ real (kind=RKIND), dimension(:), pointer :: attValue
+ integer, intent(out), optional :: ierr
+
+ type (att_list_type), pointer :: cursor
+
+ if (present(ierr)) ierr = 0
+
+ cursor => attList
+write(0,*) 'Starting at the head of the list...'
+ do while (associated(cursor))
+write(0,*) 'Comparing '//trim(attName)//' and '//trim(cursor % attName)
+ if (trim(attName) == trim(cursor % attName)) then
+ if (cursor % attType /= ATT_REALA) then
+write(0,*) 'Wrong type for attribute'
+ if (present(ierr)) ierr = 1 ! Wrong type
+ else
+ allocate(attValue(size(cursor % attValueRealA)))
+ attValue(:) = cursor % attValueRealA(:)
+write(0,*) 'Assigning output value ', cursor % attValueRealA
+ end if
+ return
+ end if
+ cursor => cursor % next
+ end do
+write(0,*) 'Finished searching unsuccessfully'
+
+ if (present(ierr)) ierr = 1 ! Not found
+
+ end subroutine mpas_get_att_real1d
+
+
+ subroutine mpas_get_att_text(attList, attName, attValue, ierr)
+
+ implicit none
+
+ type (att_list_type), pointer :: attList
+ character (len=*), intent(in) :: attName
+ character (len=*), intent(out) :: attValue
+ integer, intent(out), optional :: ierr
+
+ type (att_list_type), pointer :: cursor
+
+ if (present(ierr)) ierr = 0
+
+ cursor => attList
+write(0,*) 'Starting at the head of the list...'
+ do while (associated(cursor))
+write(0,*) 'Comparing '//trim(attName)//' and '//trim(cursor % attName)
+ if (trim(attName) == trim(cursor % attName)) then
+ if (cursor % attType /= ATT_TEXT) then
+write(0,*) 'Wrong type for attribute'
+ if (present(ierr)) ierr = 1 ! Wrong type
+ else
+ write(attValue,'(a)') trim(cursor % attValueText)
+write(0,*) 'Assigning output value ', trim(cursor % attValueText)
+ end if
+ return
+ end if
+ cursor => cursor % next
+ end do
+write(0,*) 'Finished searching unsuccessfully'
+
+ if (present(ierr)) ierr = 1 ! Not found
+
+ end subroutine mpas_get_att_text
+
+
+ subroutine mpas_remove_att(attList, attName, ierr)
+
+ implicit none
+
+ type (att_list_type), pointer :: attList
+ character (len=*), intent(in) :: attName
+ integer, intent(out), optional :: ierr
+
+ type (att_list_type), pointer :: cursor, cursor_prev
+
+ if (present(ierr)) ierr = 0
+
+ cursor => attList
+
+ ! Item is at the head of the list
+ if (trim(attName) == trim(cursor % attName)) then
+ attList => cursor % next
+ if (cursor % attType == ATT_REALA) then
+ deallocate(cursor % attValueRealA)
+ else if (cursor % attType == ATT_INTA) then
+ deallocate(cursor % attValueIntA)
+ end if
+ deallocate(cursor)
+write(0,*) 'Found item at head and deleting'
+ return
+ end if
+
+ cursor_prev => cursor
+ cursor => cursor % next
+ do while (associated(cursor))
+ if (trim(attName) == trim(cursor % attName)) then
+ cursor_prev % next => cursor % next
+
+ if (cursor % attType == ATT_REALA) then
+ deallocate(cursor % attValueRealA)
+ else if (cursor % attType == ATT_INTA) then
+ deallocate(cursor % attValueIntA)
+ end if
+ deallocate(cursor)
+
+write(0,*) 'Found item in middle and deleting'
+ return
+ end if
+
+ cursor_prev => cursor
+ cursor => cursor % next
+ end do
+
+ if (present(ierr)) ierr = 1 ! Not found
+
+ end subroutine mpas_remove_att
+
+
+ subroutine mpas_deallocate_attlist(attList, ierr)
+
+ implicit none
+
+ type (att_list_type), pointer :: attList
+ integer, intent(out), optional :: ierr
+
+ type (att_list_type), pointer :: cursor
+
+ if (present(ierr)) ierr = 0
+
+write(0,*) 'Going to deallocate att list'
+
+ cursor => attList
+ do while (associated(cursor))
+ attList => attList % next
+ if (cursor % attType == ATT_REALA) then
+ deallocate(cursor % attValueRealA)
+ else if (cursor % attType == ATT_INTA) then
+ deallocate(cursor % attValueIntA)
+ end if
+write(0,*) 'Deallocating ', cursor % attValueInt
+ deallocate(cursor)
+ cursor => attList
+ end do
+
+write(0,*) 'Done deallocating att list'
+
+ end subroutine mpas_deallocate_attlist
+
+end module mpas_attlist
Modified: branches/omp_blocks/io/src/framework/mpas_dmpar.F
===================================================================
--- branches/omp_blocks/io/src/framework/mpas_dmpar.F 2012-03-15 22:53:37 UTC (rev 1654)
+++ branches/omp_blocks/io/src/framework/mpas_dmpar.F 2012-03-15 23:29:21 UTC (rev 1655)
@@ -1497,12 +1497,12 @@
type (exchange_list), pointer :: sendListPtr, recvListPtr
integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
integer :: mpi_ierr
- integer, dimension(size(field % dims)) :: dims
+ integer, dimension(size(field % dimSizes)) :: dims
#ifdef _MPI
dminfo = field % block % domain % dminfo
- dims = field % dims
+ dims = field % dimSizes
call AggregateExchangeLists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
@@ -1567,12 +1567,12 @@
integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
integer :: mpi_ierr
integer :: d2
- integer, dimension(size(field % dims)) :: dims
+ integer, dimension(size(field % dimSizes)) :: dims
#ifdef _MPI
dminfo = field % block % domain % dminfo
- dims = field % dims
+ dims = field % dimSizes
call AggregateExchangeLists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
@@ -1640,12 +1640,12 @@
integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
integer :: mpi_ierr
integer :: d3
- integer, dimension(size(field % dims)) :: dims
+ integer, dimension(size(field % dimSizes)) :: dims
#ifdef _MPI
dminfo = field % block % domain % dminfo
- dims = field % dims
+ dims = field % dimSizes
call AggregateExchangeLists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
@@ -1804,12 +1804,12 @@
type (exchange_list), pointer :: sendListPtr, recvListPtr
integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
integer :: mpi_ierr
- integer, dimension(size(field % dims)) :: dims
+ integer, dimension(size(field % dimSizes)) :: dims
#ifdef _MPI
dminfo = field % block % domain % dminfo
- dims = field % dims
+ dims = field % dimSizes
call AggregateExchangeLists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
@@ -1874,13 +1874,13 @@
integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
integer :: mpi_ierr
integer :: d2
- integer, dimension(size(field % dims)) :: dims
+ integer, dimension(size(field % dimSizes)) :: dims
#ifdef _MPI
dminfo = field % block % domain % dminfo
- dims = field % dims
+ dims = field % dimSizes
call AggregateExchangeLists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
@@ -1948,12 +1948,12 @@
integer :: lastPackedIdx, lastUnpackedIdx, nPacked, nUnpacked
integer :: mpi_ierr
integer :: d3
- integer, dimension(size(field % dims)) :: dims
+ integer, dimension(size(field % dimSizes)) :: dims
#ifdef _MPI
dminfo = field % block % domain % dminfo
- dims = field % dims
+ dims = field % dimSizes
call AggregateExchangeLists(dminfo % my_proc_id, haloLayers, field % sendList, field % recvList, sendList, recvList)
Modified: branches/omp_blocks/io/src/framework/mpas_grid_types.F
===================================================================
--- branches/omp_blocks/io/src/framework/mpas_grid_types.F 2012-03-15 22:53:37 UTC (rev 1654)
+++ branches/omp_blocks/io/src/framework/mpas_grid_types.F 2012-03-15 23:29:21 UTC (rev 1655)
@@ -2,6 +2,7 @@
use mpas_kind_types
use mpas_dmpar_types
+ use mpas_attlist
integer, parameter :: nTimeLevs = 2
@@ -22,12 +23,25 @@
! Derived type for storing fields
type field3DReal
+
+ ! Back-pointer to the containing block
type (block_type), pointer :: block
+
+ ! Raw array holding field data on this block
real (kind=RKIND), dimension(:,:,:), pointer :: array
- type (io_info), pointer :: ioinfo
- integer, dimension(3) :: dims
- logical :: timeDimension
+
+ ! Information used by the I/O layer
+ type (io_info), pointer :: ioinfo ! to be removed later
+ character (len=64) :: fieldName
+ character (len=64), dimension(3) :: dimNames
+ integer, dimension(3) :: dimSizes
+ logical :: hasTimeDimension
+ type (att_list_type), pointer :: attList => null()
+
+ ! Pointers to the prev and next blocks for this field on this task
type (field3DReal), pointer :: prev, next
+
+ ! Halo communication lists
type (exchange_list), dimension(:), pointer :: sendList
type (exchange_list), dimension(:), pointer :: recvList
type (exchange_list), dimension(:), pointer :: copyList
@@ -36,12 +50,25 @@
! Derived type for storing fields
type field2DReal
+
+ ! Back-pointer to the containing block
type (block_type), pointer :: block
+
+ ! Raw array holding field data on this block
real (kind=RKIND), dimension(:,:), pointer :: array
- type (io_info), pointer :: ioinfo
- integer, dimension(2) :: dims
- logical :: timeDimension
+
+ ! Information used by the I/O layer
+ type (io_info), pointer :: ioinfo ! to be removed later
+ character (len=64) :: fieldName
+ character (len=64), dimension(2) :: dimNames
+ integer, dimension(2) :: dimSizes
+ logical :: hasTimeDimension
+ type (att_list_type), pointer :: attList => null()
+
+ ! Pointers to the prev and next blocks for this field on this task
type (field2DReal), pointer :: prev, next
+
+ ! Halo communication lists
type (exchange_list), dimension(:), pointer :: sendList
type (exchange_list), dimension(:), pointer :: recvList
type (exchange_list), dimension(:), pointer :: copyList
@@ -50,12 +77,25 @@
! Derived type for storing fields
type field1DReal
+
+ ! Back-pointer to the containing block
type (block_type), pointer :: block
+
+ ! Raw array holding field data on this block
real (kind=RKIND), dimension(:), pointer :: array
- type (io_info), pointer :: ioinfo
- integer, dimension(1) :: dims
- logical :: timeDimension
+
+ ! Information used by the I/O layer
+ type (io_info), pointer :: ioinfo ! to be removed later
+ character (len=64) :: fieldName
+ character (len=64), dimension(1) :: dimNames
+ integer, dimension(1) :: dimSizes
+ logical :: hasTimeDimension
+ type (att_list_type), pointer :: attList => null()
+
+ ! Pointers to the prev and next blocks for this field on this task
type (field1DReal), pointer :: prev, next
+
+ ! Halo communication lists
type (exchange_list), dimension(:), pointer :: sendList
type (exchange_list), dimension(:), pointer :: recvList
type (exchange_list), dimension(:), pointer :: copyList
@@ -64,11 +104,23 @@
! Derived type for storing fields
type field0DReal
+
+ ! Back-pointer to the containing block
type (block_type), pointer :: block
+
+ ! Raw array holding field data on this block
real (kind=RKIND) :: scalar
- type (io_info), pointer :: ioinfo
- logical :: timeDimension
+
+ ! Information used by the I/O layer
+ type (io_info), pointer :: ioinfo ! to be removed later
+ character (len=64) :: fieldName
+ logical :: hasTimeDimension
+ type (att_list_type), pointer :: attList => null()
+
+ ! Pointers to the prev and next blocks for this field on this task
type (field0DReal), pointer :: prev, next
+
+ ! Halo communication lists
type (exchange_list), dimension(:), pointer :: sendList
type (exchange_list), dimension(:), pointer :: recvList
type (exchange_list), dimension(:), pointer :: copyList
@@ -77,12 +129,25 @@
! Derived type for storing fields
type field3DInteger
+
+ ! Back-pointer to the containing block
type (block_type), pointer :: block
+
+ ! Raw array holding field data on this block
integer, dimension(:,:,:), pointer :: array
- type (io_info), pointer :: ioinfo
- integer, dimension(3) :: dims
- logical :: timeDimension
+
+ ! Information used by the I/O layer
+ type (io_info), pointer :: ioinfo ! to be removed later
+ character (len=64) :: fieldName
+ character (len=64), dimension(3) :: dimNames
+ integer, dimension(3) :: dimSizes
+ logical :: hasTimeDimension
+ type (att_list_type), pointer :: attList => null()
+
+ ! Pointers to the prev and next blocks for this field on this task
type (field3DInteger), pointer :: prev, next
+
+ ! Halo communication lists
type (exchange_list), dimension(:), pointer :: sendList
type (exchange_list), dimension(:), pointer :: recvList
type (exchange_list), dimension(:), pointer :: copyList
@@ -91,12 +156,25 @@
! Derived type for storing fields
type field2DInteger
+
+ ! Back-pointer to the containing block
type (block_type), pointer :: block
+
+ ! Raw array holding field data on this block
integer, dimension(:,:), pointer :: array
- type (io_info), pointer :: ioinfo
- integer, dimension(2) :: dims
- logical :: timeDimension
+
+ ! Information used by the I/O layer
+ type (io_info), pointer :: ioinfo ! to be removed later
+ character (len=64) :: fieldName
+ character (len=64), dimension(2) :: dimNames
+ integer, dimension(2) :: dimSizes
+ logical :: hasTimeDimension
+ type (att_list_type), pointer :: attList => null()
+
+ ! Pointers to the prev and next blocks for this field on this task
type (field2DInteger), pointer :: prev, next
+
+ ! Halo communication lists
type (exchange_list), dimension(:), pointer :: sendList
type (exchange_list), dimension(:), pointer :: recvList
type (exchange_list), dimension(:), pointer :: copyList
@@ -105,12 +183,25 @@
! Derived type for storing fields
type field1DInteger
+
+ ! Back-pointer to the containing block
type (block_type), pointer :: block
+
+ ! Raw array holding field data on this block
integer, dimension(:), pointer :: array
- type (io_info), pointer :: ioinfo
- integer, dimension(1) :: dims
- logical :: timeDimension
+
+ ! Information used by the I/O layer
+ type (io_info), pointer :: ioinfo ! to be removed later
+ character (len=64) :: fieldName
+ character (len=64), dimension(1) :: dimNames
+ integer, dimension(1) :: dimSizes
+ logical :: hasTimeDimension
+ type (att_list_type), pointer :: attList => null()
+
+ ! Pointers to the prev and next blocks for this field on this task
type (field1DInteger), pointer :: prev, next
+
+ ! Halo communication lists
type (exchange_list), dimension(:), pointer :: sendList
type (exchange_list), dimension(:), pointer :: recvList
type (exchange_list), dimension(:), pointer :: copyList
@@ -118,13 +209,51 @@
! Derived type for storing fields
+ type field0DInteger
+
+ ! Back-pointer to the containing block
+ type (block_type), pointer :: block
+
+ ! Raw array holding field data on this block
+ integer :: scalar
+
+ ! Information used by the I/O layer
+ type (io_info), pointer :: ioinfo ! to be removed later
+ character (len=64) :: fieldName
+ logical :: hasTimeDimension
+ type (att_list_type), pointer :: attList => null()
+
+ ! Pointers to the prev and next blocks for this field on this task
+ type (field0DInteger), pointer :: prev, next
+
+ ! Halo communication lists
+ type (exchange_list), dimension(:), pointer :: sendList
+ type (exchange_list), dimension(:), pointer :: recvList
+ type (exchange_list), dimension(:), pointer :: copyList
+ end type field0DInteger
+
+
+ ! Derived type for storing fields
type field1DChar
+
+ ! Back-pointer to the containing block
type (block_type), pointer :: block
+
+ ! Raw array holding field data on this block
character (len=64), dimension(:), pointer :: array
- type (io_info), pointer :: ioinfo
- integer, dimension(1) :: dims
- logical :: timeDimension
+
+ ! Information used by the I/O layer
+ type (io_info), pointer :: ioinfo ! to be removed later
+ character (len=64) :: fieldName
+ character (len=64), dimension(1) :: dimNames
+ integer, dimension(1) :: dimSizes
+ logical :: hasTimeDimension
+ type (att_list_type), pointer :: attList => null()
+
+ ! Pointers to the prev and next blocks for this field on this task
type (field1DChar), pointer :: prev, next
+
+ ! Halo communication lists
type (exchange_list), dimension(:), pointer :: sendList
type (exchange_list), dimension(:), pointer :: recvList
type (exchange_list), dimension(:), pointer :: copyList
@@ -133,11 +262,23 @@
! Derived type for storing fields
type field0DChar
+
+ ! Back-pointer to the containing block
type (block_type), pointer :: block
+
+ ! Raw array holding field data on this block
character (len=64) :: scalar
- type (io_info), pointer :: ioinfo
- logical :: timeDimension
+
+ ! Information used by the I/O layer
+ type (io_info), pointer :: ioinfo ! to be removed later
+ character (len=64) :: fieldName
+ logical :: hasTimeDimension
+ type (att_list_type), pointer :: attList => null()
+
+ ! Pointers to the prev and next blocks for this field on this task
type (field0DChar), pointer :: prev, next
+
+ ! Halo communication lists
type (exchange_list), dimension(:), pointer :: sendList
type (exchange_list), dimension(:), pointer :: recvList
type (exchange_list), dimension(:), pointer :: copyList
Modified: branches/omp_blocks/io/src/registry/gen_inc.c
===================================================================
--- branches/omp_blocks/io/src/registry/gen_inc.c 2012-03-15 22:53:37 UTC (rev 1654)
+++ branches/omp_blocks/io/src/registry/gen_inc.c 2012-03-15 23:29:21 UTC (rev 1655)
@@ -575,6 +575,7 @@
var_ptr2 = var_list_ptr2->var;
fortprintf(fd, " allocate(%s %% %s)</font>
<font color="black">", group_ptr->name, var_ptr2->super_array);
fortprintf(fd, " allocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+ fortprintf(fd, " %s %% %s %% fieldName = \'%s\'</font>
<font color="gray">", group_ptr->name, var_ptr2->super_array, var_ptr2->super_array);
fortprintf(fd, " allocate(%s %% %s %% array(%i, ", group_ptr->name, var_ptr2->super_array, i);
dimlist_ptr = var_ptr2->dimlist;
if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
@@ -605,23 +606,36 @@
else if (var_ptr->vtype == CHARACTER)
fortprintf(fd, " %s %% %s %% array = \'\'</font>
<font color="red">", group_ptr->name, var_ptr2->super_array ); /* initialize field to zero */
- fortprintf(fd, " %s %% %s %% dims(1) = %i</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array, i);
+ fortprintf(fd, " %s %% %s %% dimSizes(1) = %i</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array, i);
+ fortprintf(fd, " %s %% %s %% dimNames(1) = \'num_%s\'</font>
<font color="red">", group_ptr->name, var_ptr2->super_array, var_ptr2->super_array);
dimlist_ptr = var_ptr2->dimlist;
i = 2;
while (dimlist_ptr) {
if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s %% %s %% dims(%i) = %s</font>
<font color="red">", group_ptr->name, var_ptr2->super_array, i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " %s %% %s %% dims(%i) = %s</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array, i, dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) {
+ fortprintf(fd, " %s %% %s %% dimSizes(%i) = %s</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array, i, dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, " %s %% %s %% dimNames(%i) = \'%s\'</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array, i, dimlist_ptr->dim->name_in_file);
+ }
+ else {
+ fortprintf(fd, " %s %% %s %% dimSizes(%i) = %s</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array, i, dimlist_ptr->dim->name_in_file);
+ fortprintf(fd, " %s %% %s %% dimNames(%i) = \'%s\'</font>
<font color="red">", group_ptr->name, var_ptr2->super_array, i, dimlist_ptr->dim->name_in_file);
+ }
else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s %% %s %% dims(%i) = %s</font>
<font color="red">", group_ptr->name, var_ptr2->super_array, i, dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, " %s %% %s %% dims(%i) = %s</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array, i, dimlist_ptr->dim->name_in_code);
+ if (dimlist_ptr->dim->namelist_defined) {
+ fortprintf(fd, " %s %% %s %% dimSizes(%i) = %s</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array, i, dimlist_ptr->dim->name_in_file);
+ fortprintf(fd, " %s %% %s %% dimNames(%i) = \'%s\'</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array, i, dimlist_ptr->dim->name_in_file);
+ }
+ else {
+ fortprintf(fd, " %s %% %s %% dimSizes(%i) = %s</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array, i, dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, " %s %% %s %% dimNames(%i) = \'%s\'</font>
<font color="red">", group_ptr->name, var_ptr2->super_array, i, dimlist_ptr->dim->name_in_file);
+ }
i++;
dimlist_ptr = dimlist_ptr->next;
}
- if (var_ptr2->timedim) fortprintf(fd, " %s %% %s %% timeDimension = .true.</font>
<font color="red">", group_ptr->name, var_ptr2->super_array);
- else fortprintf(fd, " %s %% %s %% timeDimension = .false.</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+ if (var_ptr2->timedim) fortprintf(fd, " %s %% %s %% hasTimeDimension = .true.</font>
<font color="blue">", group_ptr->name, var_ptr2->super_array);
+ else fortprintf(fd, " %s %% %s %% hasTimeDimension = .false.</font>
<font color="black">", group_ptr->name, var_ptr2->super_array);
fortprintf(fd, " nullify(%s %% %s %% prev)</font>
<font color="black">", group_ptr->name, var_ptr2->super_array);
fortprintf(fd, " nullify(%s %% %s %% next)</font>
<font color="black">", group_ptr->name, var_ptr2->super_array);
fortprintf(fd, " nullify(%s %% %s %% sendList)</font>
<font color="gray">", group_ptr->name, var_ptr2->super_array);
@@ -654,6 +668,7 @@
else {
fortprintf(fd, " allocate(%s %% %s)</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, " allocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " %s %% %s %% fieldName = \'%s\'</font>
<font color="gray">", group_ptr->name, var_ptr->name_in_code, var_ptr->name_in_file);
if (var_ptr->ndims > 0) {
fortprintf(fd, " allocate(%s %% %s %% array(", group_ptr->name, var_ptr->name_in_code);
dimlist_ptr = var_ptr->dimlist;
@@ -691,18 +706,30 @@
if (!strncmp(dimlist_ptr->dim->name_in_file, "nCells", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nEdges", 1024) ||
!strncmp(dimlist_ptr->dim->name_in_file, "nVertices", 1024))
- if (!dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s %% %s %% dims(%i) = %s</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code, i, dimlist_ptr->dim->name_in_code);
- else fortprintf(fd, " %s %% %s %% dims(%i) = %s</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code, i, dimlist_ptr->dim->name_in_file);
+ if (!dimlist_ptr->dim->namelist_defined) {
+ fortprintf(fd, " %s %% %s %% dimSizes(%i) = %s</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code, i, dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, " %s %% %s %% dimNames(%i) = \'%s\'</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code, i, dimlist_ptr->dim->name_in_file);
+ }
+ else {
+ fortprintf(fd, " %s %% %s %% dimSizes(%i) = %s</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code, i, dimlist_ptr->dim->name_in_file);
+ fortprintf(fd, " %s %% %s %% dimNames(%i) = \'%s\'</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code, i, dimlist_ptr->dim->name_in_file);
+ }
else
- if (dimlist_ptr->dim->namelist_defined) fortprintf(fd, " %s %% %s %% dims(%i) = %s</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code, i, dimlist_ptr->dim->name_in_file);
- else fortprintf(fd, " %s %% %s %% dims(%i) = %s</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code, i, dimlist_ptr->dim->name_in_code);
+ if (dimlist_ptr->dim->namelist_defined) {
+ fortprintf(fd, " %s %% %s %% dimSizes(%i) = %s</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code, i, dimlist_ptr->dim->name_in_file);
+ fortprintf(fd, " %s %% %s %% dimNames(%i) = \'%s\'</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code, i, dimlist_ptr->dim->name_in_file);
+ }
+ else {
+ fortprintf(fd, " %s %% %s %% dimSizes(%i) = %s</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code, i, dimlist_ptr->dim->name_in_code);
+ fortprintf(fd, " %s %% %s %% dimNames(%i) = \'%s\'</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code, i, dimlist_ptr->dim->name_in_file);
+ }
i++;
dimlist_ptr = dimlist_ptr->next;
}
}
- if (var_ptr->timedim) fortprintf(fd, " %s %% %s %% timeDimension = .true.</font>
<font color="red">", group_ptr->name, var_ptr->name_in_code);
- else fortprintf(fd, " %s %% %s %% timeDimension = .false.</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ if (var_ptr->timedim) fortprintf(fd, " %s %% %s %% hasTimeDimension = .true.</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ else fortprintf(fd, " %s %% %s %% hasTimeDimension = .false.</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, " nullify(%s %% %s %% prev)</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, " nullify(%s %% %s %% next)</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, " nullify(%s %% %s %% sendList)</font>
<font color="gray">", group_ptr->name, var_ptr->name_in_code);
@@ -766,16 +793,19 @@
}
fortprintf(fd, " deallocate(%s %% %s %% array)</font>
<font color="black">", group_ptr->name, var_list_ptr2->var->super_array);
fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_list_ptr2->var->super_array);
+ fortprintf(fd, " call mpas_deallocate_attlist(%s %% %s %% attList)</font>
<font color="black">", group_ptr->name, var_list_ptr2->var->super_array);
fortprintf(fd, " deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="black">", group_ptr->name, var_list_ptr2->var->super_array);
}
else {
if (var_ptr->ndims > 0) {
fortprintf(fd, " deallocate(%s %% %s %% array)</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " call mpas_deallocate_attlist(%s %% %s %% attList)</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, " deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
}
else {
fortprintf(fd, " deallocate(%s %% %s %% ioinfo)</font>
<font color="blue">", group_ptr->name, var_ptr->name_in_code);
+ fortprintf(fd, " call mpas_deallocate_attlist(%s %% %s %% attList)</font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
fortprintf(fd, " deallocate(%s %% %s)</font>
<font color="black"></font>
<font color="black">", group_ptr->name, var_ptr->name_in_code);
}
var_list_ptr = var_list_ptr->next;
</font>
</pre>