module store
!*******************************************************************************
!--- Define data structures and methods to handle temporary internal storage
!--- of field data sent between the coupler and other component models
!*******************************************************************************

  use com_cpl

  implicit none

  private

  public :: store_record_t
  public :: store_InitStorage
  public :: store_AddStorage
  public :: store_ListStorage
  public :: store_GetIndex
  public :: store_GetSize
  public :: store_DestroyRecord
  public :: store_ListRecord
  public :: store_PrintRecord
  public :: store_AppendRecord
  public :: store_ReadRecord
  public :: store_ShiftRecord
  public :: store_PopRecord
  public :: store_DiskWrite

  !--- Define a generic interface for store_AppendRecord
  interface store_AppendRecord
    module procedure store_AppendRecord_data_and_ibuf
    module procedure store_AppendRecord_data
    module procedure store_AppendRecord_data_i4
    module procedure store_AppendRecord_data_i8
    module procedure store_AppendRecord_data_r4
    module procedure store_AppendRecord_data_i4_2d
    module procedure store_AppendRecord_data_i8_2d
    module procedure store_AppendRecord_data_r4_2d
    module procedure store_AppendRecord_data_r8_2d
  end interface

  type store_record_t
    character(64)   :: name = " "
    integer(kind=4) :: gid  = 0
    integer(kind=8) :: time = 0
    integer(kind=4) :: nx   = 0
    integer(kind=4) :: ny   = 0
    integer(kind=4) :: nz   = 0
    integer(kind=4) :: olap = 0
    integer(kind=4) :: size = 0
    integer(kind=4) :: date(6)
    integer(kind=4) :: unit = -1
    character(256)  :: file = " "
    integer(kind=8), dimension(:),  pointer :: ibuf => null()
    real(kind=8), dimension(:),     pointer :: data1d => null()
    real(kind=8), dimension(:,:),   pointer :: data2d => null()
    real(kind=8), dimension(:,:,:), pointer :: data3d => null()
    !--- pointer to the next node in list
    type(store_record_t), pointer :: next => null()
  end type store_record_t

  !--- A structure to use as the anchor for each named list
  type store_list_anchor_t
    character(64)   :: name = " "
    integer(kind=4) :: gid  = 0
    type(store_record_t), pointer :: rp => null()
  end type store_list_anchor_t

  !--- A list of pointers to store_record_t objects
  type(store_list_anchor_t), pointer, dimension(:), save :: storage => null()

  !--- If records are accessed using anygid as the group ID then the first record
  !--- with the requested name is used regardless of the group ID
  integer, parameter, public :: anygid=0

  contains

    !***************************************************************************
    !--- Allocate space and assign names and group IDs to the storage array
    !***************************************************************************
    subroutine store_InitStorage(names, gids, nvars)

      !--- The list of names used to initialize storage
      character(*), intent(in) :: names(:)

      !--- The list of group IDs used to initialize storage
      integer, intent(in) :: gids(:)

      !--- The number of names used from the names list
      integer, intent(in) :: nvars

      !--- Local
      integer :: idx1
      type(cpl_vinfo_t) :: curr_vinfo
      integer :: verbose=1    !--- local verbosity flag

      !--- Ensure nvars is > 0
      if ( nvars <= 0 ) then
        write(6,*)"store_InitStorage: No names were supplied (nvars=0)"
        call xit("store_InitStorage",-1)
      endif

      !--- Ensure input arrays are of sufficient size
      if ( size(names) < nvars ) then
        write(6,*)"store_InitStorage: The input names list is smaller than nvars=",nvars
        call xit("store_InitStorage",-2)
      endif
      if ( size(gids) < nvars ) then
        write(6,*)"store_InitStorage: The input gids list is smaller than nvars=",nvars
        call xit("store_InitStorage",-3)
      endif

      !--- Allocate storage for all variables in the list of names
      if ( associated(storage) ) then
        write(6,*)"store_InitStorage: Storage is currently in use."
        call xit("store_InitStorage",-4)
      endif
      allocate( storage(nvars) )

      !--- Define the name and gid components for each element of storage
      !--- Other components will be allocated and assigned elsewhere, as requied
      do idx1=1,nvars
        !--- This name must be known to the coupler
        !--- find_cpl_vinfo will abort if the name is not known
        curr_vinfo = find_cpl_vinfo( name=trim(adjustl(names(idx1))) )
        storage(idx1)%name = trim(names(idx1))
        storage(idx1)%gid  = gids(idx1)
      enddo

      if ( verbose > 0 ) then
        write(6,'(a,i3,a)')'store_InitStorage: Storage initialized for ',nvars,' variables.'
        call store_ListStorage()
        write(6,'(a)')'-------------------------------------------------------'
        call flush(6)
      endif

    end subroutine store_InitStorage

    !***************************************************************************
    !--- Add a name to the storage array
    !***************************************************************************
    function store_AddStorage(name, gid) result(idx_new)

      !--- The name to add to storage
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- Return the index of the new storage location for name
      integer :: idx_new

      !--- Local
      !--- A temporary list of pointers to store_record_t objects
      type(store_list_anchor_t), pointer, dimension(:) :: tmp_storage
      type(cpl_vinfo_t) :: curr_vinfo
      integer :: idx1
      integer :: verbose=0    !--- local verbosity flag

      !--- This name must be known to the coupler
      !--- find_cpl_vinfo will abort if the name is not known
      curr_vinfo = find_cpl_vinfo( name=trim(adjustl(name)) )

      if ( .not. associated(storage) ) then

        !--- Storage will be initialzed with size 1 if not already initialized
        idx_new = 1
        allocate( storage(1) )
        storage(1)%name = trim(name)
        storage(1)%gid  = gid

      else

        !--- Append to the existing storage
        idx_new = size(storage) + 1
        allocate( tmp_storage(idx_new) )
        tmp_storage(1:idx_new-1) = storage(1:idx_new-1)
        tmp_storage(idx_new)%name = trim(name)
        tmp_storage(idx_new)%gid  = gid

        deallocate( storage )
        allocate( storage(idx_new) )
        storage(1:idx_new) = tmp_storage(1:idx_new)
        deallocate( tmp_storage )

      endif

      if ( verbose > 0 ) then
        write(6,'(a,i3,a)')'store_AddStorage: New list of ',idx_new,' variables.'
        write(6,'(8(2x,a12," gid=",i2))') &
             (storage(idx1)%name,storage(idx1)%gid,idx1=1,idx_new)
        write(6,'(a)')'-------------------------------------------------------'
        call flush(6)
      endif

    end function store_AddStorage

    !***************************************************************************
    !--- List all elements of the storage array
    !***************************************************************************
    subroutine store_ListStorage()

      !--- Local
      type(store_record_t), pointer :: rec_ptr
      integer :: idx1, nrec
      integer :: verbose=0

      if ( size(storage) < 1 ) then
        write(6,*)"store_ListStorage: There are no stored fields."
        call flush(6)
        return
      endif

      do idx1=1,size(storage)
        !--- Count the number of records associated with this field
        nrec = 0
        if ( associated(storage(idx1)%rp) ) then
          rec_ptr => storage(idx1)%rp
          nrec = 1
          do
            if ( associated(rec_ptr%next) ) then
              rec_ptr => rec_ptr%next
              nrec = nrec + 1
            else
              !--- End of list
              exit
            endif
          enddo
        endif
        write(6,'(i4,1x,a16,"  gid=",i2,"  nrec=",i4)') &
             idx1, storage(idx1)%name, storage(idx1)%gid, nrec
      enddo
      call flush(6)

    end subroutine store_ListStorage

    !***************************************************************************
    !--- Determine the index in the storage array for a given name
    !--- A zero index value is returned if the name does not exist in storage
    !--- or if storage is not initialized
    !***************************************************************************
    function store_GetIndex(name, gid) result(store_idx)

      !--- The name of a field in storage
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- The storage index associated with this name
      integer :: store_idx

      !--- Local
      integer :: idx1
      integer :: verbose=0

      store_idx = 0

      if ( .not. associated(storage) ) then
        if ( verbose > 0 ) then
          write(6,*)"store_GetIndex: Storage is not initialized."
        endif
        return
      endif

      if ( gid == anygid ) then
        !--- Ignore the group ID, return the first record by this name
        do idx1=1,size(storage)
          if ( trim(adjustl(name)) .eq. trim(adjustl(storage(idx1)%name)) ) then
            store_idx = idx1
            exit
          endif
        enddo
      else
        do idx1=1,size(storage)
          if ( trim(adjustl(name)) .eq. trim(adjustl(storage(idx1)%name)) .and. &
               storage(idx1)%gid == gid ) then
            store_idx = idx1
            exit
          endif
        enddo
      endif

    end function store_GetIndex

    !***************************************************************************
    !--- Given the name, determine the size of associated records in storage
    !--- A zero size is returned if the name does not exist in storage or if
    !--- storage has not been initialized
    !***************************************************************************
    function store_GetSize(name, gid) result(rec_size)

      !--- The name of a field in storage
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- The size of a record associated with this name
      integer :: rec_size

      !--- Local
      integer :: store_idx

      store_idx = store_GetIndex(name, gid)
      if ( store_idx > 0 ) then
        !--- This name exists in storage
        if ( associated(storage(store_idx)%rp) ) then
          !--- At least one record exists
          rec_size = storage(store_idx)%rp%size
        else
          !--- No records are associated with this name
          rec_size = 0
        endif
      else
        !--- This name does not exist in storage, always return zero
        rec_size = 0
      endif

    end function store_GetSize

    !***************************************************************************
    !--- Deallocate and nullify a given storage record
    !***************************************************************************
    subroutine store_DestroyRecord(rec_ptr)

      type(store_record_t), pointer :: rec_ptr

      if ( associated(rec_ptr%ibuf) )   deallocate(rec_ptr%ibuf)
      if ( associated(rec_ptr%data1d) ) deallocate(rec_ptr%data1d)
      if ( associated(rec_ptr%data2d) ) deallocate(rec_ptr%data2d)
      if ( associated(rec_ptr%data3d) ) deallocate(rec_ptr%data3d)
      if ( associated(rec_ptr%next) ) nullify( rec_ptr%next )
      if ( associated(rec_ptr) ) deallocate(rec_ptr)
      nullify( rec_ptr )

    end subroutine store_DestroyRecord

    !***************************************************************************
    !--- Copy a given storage record
    !***************************************************************************
    subroutine store_CopyRecord(rec_ptr_in, rec_ptr_out)

      type(store_record_t), pointer :: rec_ptr_in, rec_ptr_out

      if ( associated(rec_ptr_out) ) call store_DestroyRecord(rec_ptr_out)

      rec_ptr_out%name = rec_ptr_in%name
      rec_ptr_out%gid  = rec_ptr_in%gid
      rec_ptr_out%time = rec_ptr_in%time
      rec_ptr_out%nx   = rec_ptr_in%nx
      rec_ptr_out%ny   = rec_ptr_in%ny
      rec_ptr_out%nz   = rec_ptr_in%nz
      rec_ptr_out%olap = rec_ptr_in%olap
      rec_ptr_out%size = rec_ptr_in%size
      rec_ptr_out%date = rec_ptr_in%date
      rec_ptr_out%unit = rec_ptr_in%unit
      rec_ptr_out%file = rec_ptr_in%file

      if ( associated(rec_ptr_in%ibuf) ) then
        allocate( rec_ptr_out%ibuf(size(rec_ptr_in%ibuf)) )
        rec_ptr_out%ibuf = rec_ptr_in%ibuf
      endif
      if ( associated(rec_ptr_in%data1d) ) then
        allocate( rec_ptr_out%data1d(size(rec_ptr_in%data1d)) )
        rec_ptr_out%data1d = rec_ptr_in%data1d
      endif
      if ( associated(rec_ptr_in%data2d) ) then
        allocate( rec_ptr_out%data2d(size(rec_ptr_in%data2d,1), &
                                     size(rec_ptr_in%data2d,2)) )
        rec_ptr_out%data2d = rec_ptr_in%data2d
      endif
      if ( associated(rec_ptr_in%data3d) ) then
        allocate( rec_ptr_out%data3d(size(rec_ptr_in%data3d,1), &
                                     size(rec_ptr_in%data3d,2), &
                                     size(rec_ptr_in%data3d,3)) )
        rec_ptr_out%data3d = rec_ptr_in%data3d
      endif
      if ( associated(rec_ptr_in%next) ) then
        rec_ptr_out%next => rec_ptr_in%next
      else
        rec_ptr_out%next => null()
      endif

    end subroutine store_CopyRecord

    !***************************************************************************
    !--- Count records associated with the given name
    !***************************************************************************
    function store_CountRecord(name, gid) result(nrec)

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- nrec is the total number of records in the list
      integer :: nrec

      !--- Local
      integer :: store_idx
      character(128) :: strng
      type(store_record_t), pointer :: rec_ptr

      nrec = 0

      store_idx = store_GetIndex(name, gid)
      if ( store_idx == 0 ) then
        !--- A field by this name does not exist in storage
        write(6,'(3a,i2,a)')"store_CountRecord: ",trim(name)," group=",gid, &
                            " does not exist in storage."
        call xit("store_CountRecord",-1)
      endif

      if ( .not. associated(storage(store_idx)%rp) ) then
        !--- The record list is empty
        nrec = 0
        return
      endif

      !--- Count the number of records in this list
      rec_ptr => storage(store_idx)%rp
      nrec = 1
      do
        if ( associated(rec_ptr%next) ) then
          rec_ptr => rec_ptr%next
          nrec = nrec + 1
        else
          !--- End of list
          exit
        endif
      enddo

    end function store_CountRecord

    !***************************************************************************
    !--- List records associated with the given name
    !***************************************************************************
    subroutine store_ListRecord(name, gid, style, pfx)

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- style determines the form of the output
      integer, intent(in), optional :: style

      !--- A string to prefix all output lines
      character(*), intent(in), optional :: pfx

      !--- Local
      integer :: store_idx, nwrds, local_style
      character(128) :: strng
      type(store_record_t), pointer :: curr_ptr

      if ( present(style) ) then
        local_style = style
      else
        local_style = 1
      endif

      store_idx = store_GetIndex(name, gid)
      if ( store_idx == 0 ) then
        !--- A field by this name does not exist in storage
        write(6,'(3a,i2,a)')"store_ListRecord: ",trim(name)," group=",gid, &
                            " does not exist in storage."
        call xit("store_ListRecord",-1)
      endif

      curr_ptr => storage(store_idx)%rp
      do while ( associated(curr_ptr) )
        if ( present(pfx) ) then
          call store_PrintRecord(curr_ptr, style=local_style, pfx=pfx)
        else
          call store_PrintRecord(curr_ptr, style=local_style)
        endif
        curr_ptr => curr_ptr%next
      enddo

    end subroutine store_ListRecord

    !***************************************************************************
    !--- Print data associated with a single record
    !***************************************************************************
    subroutine store_PrintRecord(rec_ptr, style, pfx)

      !--- A pointer to the record to be printed
      type(store_record_t), pointer, intent(in) :: rec_ptr

      !--- style determines the form of the output
      integer, intent(in), optional :: style

      !--- A string to prefix all output lines
      character(*), intent(in), optional :: pfx

      !--- Local
      integer :: nwrds, zero_count, spval_count, nan_count, local_style, ic
      character(128) :: about_ibuf, local_pfx
      character(512) :: strng
      character(20) :: zero_str, nan_str, spval_str
      real(kind=8) :: vavg, vmin, vmax

      if ( present(style) ) then
        local_style = style
      else
        local_style = 1
      endif

      if ( present(pfx) ) then
        local_pfx = trim(pfx)
        ic = max( len_trim(pfx), 45)
      else
        local_pfx = " store: "
        ic = 8
      endif

      if ( .not. associated(rec_ptr) ) then
        write(6,'(2a)')local_pfx(1:ic)," store_PrintRecord: Disassociated input record pointer."
        return
      endif

      !--- Determine the size of the record data and its average
      if ( associated(rec_ptr%data1d) ) then
        nwrds = size(rec_ptr%data1d)
      else
        nwrds = 0
      endif

      !--- Define a string containing ibuf information
      about_ibuf = " "
      if ( associated(rec_ptr%ibuf) ) then
        write(about_ibuf,'(2a)')"ibuf= ",format_ibuf(rec_ptr%ibuf)
      else
        write(about_ibuf,'(a)')"ibuf= Not allocated"
      endif

      select case (local_style)
        case (1,2)
        case default
          !--- Do not abort when style is out of range, instead choose a default
          local_style = 1
      end select

      !--- Put min,max,avg... data in strng
      strng = " "
      if ( nwrds > 0 ) then
        strng = sprint_var_stats(rec_ptr%data1d, nwrds, name=rec_ptr%name)
      else
        strng = "nwrds=0"
      endif

      select case (local_style)
        case (1)
          write(6,'(a,2x,a14,a,i3,a,i10,3(a,i4),a)') &
            local_pfx(1:ic),trim(rec_ptr%name)," group=",rec_ptr%gid,"  Time=",rec_ptr%time, &
            "  olapx=",rec_ptr%olap,"  nx=",rec_ptr%nx,"  ny=",rec_ptr%ny, trim(strng)
        case (2)
          write(6,'(a,2x,a14,a,i3,a,i10,3(a,i4),a)') &
            local_pfx(1:ic),trim(rec_ptr%name)," group=",rec_ptr%gid,"  Time=",rec_ptr%time, &
            "  olapx=",rec_ptr%olap,"  nx=",rec_ptr%nx,"  ny=",rec_ptr%ny, trim(strng)
          write(6,'(a,2x,a14,2x,a)') &
            local_pfx(1:ic),trim(rec_ptr%name),trim(about_ibuf)
      end select
      call flush(6)

    end subroutine store_PrintRecord

    !***************************************************************************
    !--- Append integer*4 data to a particular field in storage
    !***************************************************************************
    subroutine store_AppendRecord_data_i4(name, gid, data_i4, time, create)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- Field data array for this record
      integer(kind=4), target, intent(in) :: data_i4(:)

      !--- Optionally pass the time associated with this record
      integer(kind=8), intent(in), optional :: time

      !--- If create = T then storage for name will be created if it does not exist
      logical, intent(in), optional :: create

      !--- Local
      real(kind=8), pointer :: fdata_r8(:)

      allocate( fdata_r8(size(data_i4)) )
      fdata_r8(:) = data_i4

      if ( present(time) .and. present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time, create=create)
      else if ( present(time) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time)
      else if ( present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, create=create)
      else
        call store_AppendRecord_data(name, gid, fdata_r8)
      endif

      deallocate( fdata_r8 )

    end subroutine store_AppendRecord_data_i4

    !***************************************************************************
    !--- Append integer*4 data to a particular field in storage
    !***************************************************************************
    subroutine store_AppendRecord_data_i4_2d(name, gid, data_i4, time, create)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- Field data array for this record
      integer(kind=4), target, intent(in) :: data_i4(:,:)

      !--- Optionally pass the time associated with this record
      integer(kind=8), intent(in), optional :: time

      !--- If create = T then storage for name will be created if it does not exist
      logical, intent(in), optional :: create

      !--- Local
      real(kind=8), pointer :: fdata_r8(:)
      integer :: nwrds

      nwrds = size(data_i4)
      allocate( fdata_r8(nwrds) )
      fdata_r8(:) = reshape( data_i4(:,:), (/nwrds/) )

      if ( present(time) .and. present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time, create=create)
      else if ( present(time) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time)
      else if ( present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, create=create)
      else
        call store_AppendRecord_data(name, gid, fdata_r8)
      endif

      deallocate( fdata_r8 )

    end subroutine store_AppendRecord_data_i4_2d

    !***************************************************************************
    !--- Append integer*8 data to a particular field in storage
    !***************************************************************************
    subroutine store_AppendRecord_data_i8(name, gid, data_i8, time, create)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- Field data array for this record
      integer(kind=8), target, intent(in) :: data_i8(:)

      !--- Optionally pass the time associated with this record
      integer(kind=8), intent(in), optional :: time

      !--- If create = T then storage for name will be created if it does not exist
      logical, intent(in), optional :: create

      !--- Local
      real(kind=8), pointer :: fdata_r8(:)

      allocate( fdata_r8(size(data_i8)) )
      fdata_r8(:) = data_i8

      if ( present(time) .and. present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time, create=create)
      else if ( present(time) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time)
      else if ( present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, create=create)
      else
        call store_AppendRecord_data(name, gid, fdata_r8)
      endif

      deallocate( fdata_r8 )

    end subroutine store_AppendRecord_data_i8

    !***************************************************************************
    !--- Append integer*8 data to a particular field in storage
    !***************************************************************************
    subroutine store_AppendRecord_data_i8_2d(name, gid, data_i8, time, create)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- Field data array for this record
      integer(kind=8), target, intent(in) :: data_i8(:,:)

      !--- Optionally pass the time associated with this record
      integer(kind=8), intent(in), optional :: time

      !--- If create = T then storage for name will be created if it does not exist
      logical, intent(in), optional :: create

      !--- Local
      real(kind=8), pointer :: fdata_r8(:)
      integer :: nwrds

      nwrds = size(data_i8)
      allocate( fdata_r8(nwrds) )
      fdata_r8(:) = reshape( data_i8(:,:), (/nwrds/) )

      if ( present(time) .and. present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time, create=create)
      else if ( present(time) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time)
      else if ( present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, create=create)
      else
        call store_AppendRecord_data(name, gid, fdata_r8)
      endif

      deallocate( fdata_r8 )

    end subroutine store_AppendRecord_data_i8_2d

    !***************************************************************************
    !--- Append real*4 data to a particular field in storage
    !***************************************************************************
    subroutine store_AppendRecord_data_r4(name, gid, data_r4, time, create)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- Field data array for this record
      real(kind=4), target, intent(in) :: data_r4(:)

      !--- Optionally pass the time associated with this record
      integer(kind=8), intent(in), optional :: time

      !--- If create = T then storage for name will be created if it does not exist
      logical, intent(in), optional :: create

      !--- Local
      real(kind=8), pointer :: fdata_r8(:)

      allocate( fdata_r8(size(data_r4)) )
      fdata_r8(:) = data_r4

      if ( present(time) .and. present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time, create=create)
      else if ( present(time) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time)
      else if ( present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, create=create)
      else
        call store_AppendRecord_data(name, gid, fdata_r8)
      endif

      deallocate( fdata_r8 )

    end subroutine store_AppendRecord_data_r4

    !***************************************************************************
    !--- Append real*4 data to a particular field in storage
    !***************************************************************************
    subroutine store_AppendRecord_data_r4_2d(name, gid, data_r4, time, create)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- Field data array for this record
      real(kind=4), target, intent(in) :: data_r4(:,:)

      !--- Optionally pass the time associated with this record
      integer(kind=8), intent(in), optional :: time

      !--- If create = T then storage for name will be created if it does not exist
      logical, intent(in), optional :: create

      !--- Local
      real(kind=8), pointer :: fdata_r8(:)
      integer :: nwrds

      nwrds = size(data_r4)
      allocate( fdata_r8(nwrds) )
      fdata_r8(:) = reshape( data_r4(:,:), (/nwrds/) )

      if ( present(time) .and. present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time, create=create)
      else if ( present(time) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time)
      else if ( present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, create=create)
      else
        call store_AppendRecord_data(name, gid, fdata_r8)
      endif

      deallocate( fdata_r8 )

    end subroutine store_AppendRecord_data_r4_2d

    !***************************************************************************
    !--- Append real*8 data to a particular field in storage
    !***************************************************************************
    subroutine store_AppendRecord_data_r8_2d(name, gid, data_r8, time, create)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- Field data array for this record
      real(kind=8), target, intent(in) :: data_r8(:,:)

      !--- Optionally pass the time associated with this record
      integer(kind=8), intent(in), optional :: time

      !--- If create = T then storage for name will be created if it does not exist
      logical, intent(in), optional :: create

      !--- Local
      real(kind=8), pointer :: fdata_r8(:)
      integer :: nwrds

      nwrds = size(data_r8)
      allocate( fdata_r8(nwrds) )
      fdata_r8(:) = reshape( data_r8(:,:), (/nwrds/) )

      if ( present(time) .and. present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time, create=create)
      else if ( present(time) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, time=time)
      else if ( present(create) ) then
        call store_AppendRecord_data(name, gid, fdata_r8, create=create)
      else
        call store_AppendRecord_data(name, gid, fdata_r8)
      endif

      deallocate( fdata_r8 )

    end subroutine store_AppendRecord_data_r8_2d

    !***************************************************************************
    !--- Append data to a particular field in storage
    !---     ...fdata is a real*8 array
    !--- The user has not supplied ibuf
    !--- Define ibuf and call store_AppendRecord_data_and_ibuf
    !***************************************************************************
    subroutine store_AppendRecord_data(name, gid, fdata, time, create)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- Field data and ibuf arrays for this record
      real(kind=8), target, intent(in) :: fdata(:)

      !--- Optionally pass the time associated with this record
      integer(kind=8), intent(in), optional :: time

      !--- If create = T then storage for name will be created if it does not exist
      logical, intent(in), optional :: create

      !--- Local
      integer(kind=8) :: ibuf(8)
      type(cpl_vinfo_t) :: curr_vinfo
      integer :: verbose=0

      !--- Access information about this field
      curr_vinfo = find_cpl_vinfo( name=trim(adjustl(name)) )

      !--- Define ibuf on the fly
      !--- This routine may be used when the user does not care what ibuf contains
      ibuf(1) = transfer("GRID", 1_8)
      if ( present(time) ) then
        ibuf(2) = time
      else
        ibuf(2) = 0
      endif
      ibuf(3) = transfer(name(1:4), 1_8)
      ibuf(4) = 1
      ibuf(5) = curr_vinfo%nlon + curr_vinfo%olap
      ibuf(6) = curr_vinfo%nlat
      ibuf(7) = 0
      ibuf(8) = 1

      if ( verbose > 0 ) then
        write(6,'(2a)')"store_AppendRecord_data: ibuf = ",format_ibuf(ibuf)
      endif

      if ( present(time) .and. present(create) ) then
        call store_AppendRecord_data_and_ibuf(name, gid, fdata, ibuf, time=time, create=create)
      else if ( present(time) ) then
        call store_AppendRecord_data_and_ibuf(name, gid, fdata, ibuf, time=time)
      else if ( present(create) ) then
        call store_AppendRecord_data_and_ibuf(name, gid, fdata, ibuf, create=create)
      else
        call store_AppendRecord_data_and_ibuf(name, gid, fdata, ibuf)
      endif

    end subroutine store_AppendRecord_data

    !***************************************************************************
    !--- Append data to a particular field in storage
    !--- A new list entry is created at the end of the associated field list
    !***************************************************************************
    subroutine store_AppendRecord_data_and_ibuf(name, gid, fdata, ibuf, time, create)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- Field data and ibuf arrays for this record
      real(kind=8),    intent(in) :: fdata(:)
      integer(kind=8), intent(in) :: ibuf(:)

      !--- Optionally pass the time associated with this record
      integer(kind=8), intent(in), optional :: time

      !--- If create = T then storage for name will be created if it does not exist
      logical, intent(in), optional :: create

      !--- Local
      type(store_record_t), pointer :: curr_ptr, prev_ptr, next_ptr, last_ptr
      integer :: store_idx, nbuf, nrec
      type(cpl_vinfo_t) :: curr_vinfo
      integer :: verbose=0
      character(128) :: strng
      logical :: add_missing

      if ( present(create) ) then
        add_missing = create
      else
        add_missing = .true.
      endif

      store_idx = store_GetIndex(name, gid)
      if ( store_idx == 0 ) then
        !--- A field by this name does not exist in storage
        if ( add_missing ) then
          !--- Add the current name to fields allowed in storage
          store_idx = store_AddStorage(name, gid)
          if ( verbose > -1 ) then
            write(6,'(3a,i3)')"store_AppendRecord: Added new storage field for ", &
                                trim(name)," group=",gid
          endif
        else
          !--- Otherwise abort when the requested field is not in storage
          write(6,'(3a,i3,a)')"store_AppendRecord: ",trim(name), &
                              " group=",gid," does not exist in storage."
          call xit("store_AppendRecord",-1)
        endif
      endif

      !--- nrec is used to keep track of the number of records
      nrec = 0

      !--- Get pointers to the last and penultimate records associated with this name
      curr_ptr => storage(store_idx)%rp
      prev_ptr => null()
      last_ptr => null()
      do while ( associated(curr_ptr) )
        if ( associated(last_ptr) ) prev_ptr => last_ptr
        last_ptr => curr_ptr
        curr_ptr => curr_ptr%next
        nrec = nrec + 1
      enddo

      if ( .not. associated(last_ptr) ) then
        !--- This means that storage(store_idx)%rp is not associated
        !--- Allocate it and assign its name and group ID
        allocate( storage(store_idx)%rp )
        storage(store_idx)%rp%name = trim(adjustl(name))
        storage(store_idx)%rp%gid  = gid
        !--- Associate last_ptr with this new record
        last_ptr => storage(store_idx)%rp
        nrec = 1
      endif

      if ( associated(last_ptr%data1d) .or. associated(last_ptr%ibuf) ) then
        !--- Assume this node is in use
        !--- Allocate another record at last_ptr%next and move pointers accordingly
        allocate( last_ptr%next )
        prev_ptr => last_ptr
        last_ptr => last_ptr%next
        last_ptr%name = trim(adjustl(name))
        nrec = nrec + 1
      endif

      if ( associated(last_ptr%data1d) .or. associated(last_ptr%ibuf) ) then
        !--- If either data1d or ibuf are allocated we have a problem
        write(6,*)"store_AppendRecord: Unexpected data association for ",trim(name), &
                  " group=",gid
        call xit("store_AppendRecord",-3)
      endif

      !--- Access information about this field
      curr_vinfo = find_cpl_vinfo( name=trim(adjustl(name)) )

      !--- Assign record level name and group ID
      last_ptr%name = trim(adjustl(name))
      last_ptr%gid  = gid

      !--- Assign a time for this record
      if ( present(time) ) then
        !--- Set the time to whatever the user has supplied
        last_ptr%time = time
      else
        if ( .true. ) then
          !--- Use the coupler elasped time found in com_cpl
          last_ptr%time = cpl_elapsed_time_secs
        else
          !--- Use an index for each time value
          if ( associated(prev_ptr) ) then
            !--- Set the time relative to the previous time
            last_ptr%time = prev_ptr%time + 1
          else
            !--- Set the time to zero
            last_ptr%time = 0
          endif
        endif
      endif

      last_ptr%nx   = curr_vinfo%nlon
      last_ptr%ny   = curr_vinfo%nlat
      last_ptr%size = curr_vinfo%size
      last_ptr%olap = curr_vinfo%olap

      !--- Allocate and assign data1d for this record
      if ( size(fdata) < last_ptr%size ) then
        !--- Input data array is too small
        write(6,'(3a,i6)')"store_AppendRecord: Input data array is too small for ",trim(name), &
                  " group=",gid
        write(6,'(2(a,i8))')"    Input size=",size(fdata)," expected at least ",last_ptr%size
        call xit("store_AppendRecord",-4)
      endif
      allocate( last_ptr%data1d(last_ptr%size) )
      last_ptr%data1d(1:last_ptr%size) = fdata(1:last_ptr%size)

      !--- Allocate and assign ibuf for this record
      nbuf = 8
      if ( size(ibuf) < nbuf ) then
        !--- Input data array is too small
        write(6,'(3a,i6)')"store_AppendRecord: Input ibuf array is too small for ",trim(name), &
                  " group=",gid
        write(6,'(2(a,i8))')"    Input size=",size(ibuf)," expected at least ",nbuf
        call xit("store_AppendRecord",-5)
      endif
      allocate( last_ptr%ibuf(nbuf) )
      last_ptr%ibuf(1:nbuf) = ibuf(1:nbuf)

      if ( verbose > 0 ) then
        strng = " "
        write(strng,'(a,i3)')"  store_AppendRecord: count=",nrec
        call store_PrintRecord(last_ptr, style=1, pfx=trim(strng))
        if ( verbose > 2 ) then
          write(6,*)"store_AppendRecord: data= ",last_ptr%data1d(1:10)
        endif
        call flush(6)
      endif

    end subroutine store_AppendRecord_data_and_ibuf

    !***************************************************************************
    !--- Read a single record from the list associated with the input name
    !--- and return the data in that record
    !***************************************************************************
    function store_ReadRecord(name, gid, fdata, ibuf, idx, time, time_out, pfx, nx, ny, nz) result(nwrds)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- User supplied space for field data array
      real(kind=8), dimension(:), pointer, intent(out) :: fdata

      !--- Optional user supplied space for the ibuf array
      integer(kind=8), dimension(:), pointer, intent(out), optional :: ibuf

      !--- Optionally request the record at a particular index in the list
      !--- If idx is negative then count backwards from the end of the list
      !--- idx = -1 means read the last record in the list
      integer, intent(in), optional :: idx

      !--- The time associated with this record
      integer(kind=8), intent(in), optional :: time

      !--- The time associated with this record
      integer(kind=8), intent(out), optional :: time_out

      !--- A prefix that is passed to store_PrintRecord below
      character(*), intent(in), optional :: pfx

      !--- Dimension sizes associated with this record
      integer, intent(out), optional :: nx, ny, nz

      !--- The return value is the number of words in the field data array
      integer :: nwrds

      !--- Local
      type(store_record_t), pointer :: rec_ptr
      integer :: store_idx, sz, idx_found
      integer :: verbose=0
      character(128) :: strng

      !--- nwrds < 0 on return indicates an error
      nwrds = -1

      !--- Get a pointer to the requested record
      nullify(rec_ptr)
      idx_found = 0
      if ( present(idx) .and. present(time) ) then
        write(6,*)"store_ReadRecord: Both idx and time are present. name=", &
                  trim(name)," group=",gid
        call xit("store_ReadRecord",-1)

      else if ( present(idx) ) then
        !--- Get a record pointer from the list associated with this name
        idx_found = store_LocateRecord(name, gid, rec_ptr, idx=idx)

      else if ( present(time) ) then
        idx_found = store_LocateRecord(name, gid, rec_ptr, time=time)

      else
        write(6,*)"store_ReadRecord: One of idx or time must be present. name=", &
                  trim(name)," group=",gid
        call xit("store_ReadRecord",-2)
      endif

      if ( .not. associated(rec_ptr) .or. idx_found == 0 ) then
        !--- There was a problem locating the requested record
        if ( present(idx) ) then
          write(6,'(3a,i2,a,i8)')"** WW ** store_ReadRecord: ",trim(name), &
                            " group=",gid," ...unable to locate record ",idx
        else
          !--- time must be present if idx is not present
          write(6,'(3a,i2,a,i8)')"** WW ** store_ReadRecord: ",trim(name), &
                   " group=",gid," ...unable to locate record at time ",time
        endif
        call flush(6)
        nwrds = -1
        return
      endif

      !--- Assign input parameters as required
      if ( present(time_out)) time_out = rec_ptr%time
      if ( present(nx) ) nx = rec_ptr%nx
      if ( present(ny) ) ny = rec_ptr%ny
      if ( present(nz) ) nz = rec_ptr%nz

      if ( associated(rec_ptr%data1d) ) then
        nwrds = size(rec_ptr%data1d)
        if ( associated(fdata) ) deallocate(fdata)
        allocate( fdata(nwrds) )
        fdata(1:nwrds) = rec_ptr%data1d(1:nwrds)
      else
        write(6,'(3a,i2,a)')"** EE ** store_ReadRecord: ",trim(name), &
                            " group=",gid," does not contain any data."
        call flush(6)
        nwrds = -1
        return
      endif

      if ( present(ibuf) ) then
        if ( associated(rec_ptr%ibuf) ) then
          sz = size(rec_ptr%ibuf)
          if ( associated(ibuf) ) deallocate(ibuf)
          allocate( ibuf(sz) )
          ibuf(1:sz) = rec_ptr%ibuf(1:sz)
        else
          write(6,'(3a,i2,a)')"** EE ** store_ReadRecord: ",trim(name), &
                              " group=",gid," does not contain ibuf."
          call flush(6)
          nwrds = -1
          return
        endif
      endif

      if ( verbose > 0 .or. present(pfx) ) then
        strng = " "
        if ( present(pfx) ) then
          if ( len_trim(pfx) > 0 ) then
            strng = trim(pfx)
          else
            write(strng,'(a,i3,a,i2,2a)') &
                "  store_ReadRecord: index=",idx_found," group=",gid," name=",trim(name)
          endif
        else
          write(strng,'(a,i3,a,i2)') &
              "  store_ReadRecord: index=",idx_found," group=",gid
        endif
        call store_PrintRecord(rec_ptr, style=1, pfx=trim(strng))
      endif

    end function store_ReadRecord

    !***************************************************************************
    !--- Locate a record associated with a named field given either the list
    !--- index or the time associated with that record (but not both)
    !--- A pointer to the desired record is returned
    !***************************************************************************
    function store_LocateRecord(name, gid, rec_ptr, idx, time) result(idx_found)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- Return a pointer to this record
      type(store_record_t), pointer :: rec_ptr

      !--- An index used to determine which record is requested
      !--- If idx is positive then it is the index to locate
      !--- If idx is negative then count backwards from the end of the list
      !--- idx = 0 is an error
      !--- idx = -1 means return the last record in the list
      !--- idx = -2 means return the penultimate record in the list, etc
      integer, intent(in), optional :: idx

      !--- The time associated with the record to be retrieved
      integer(kind=8), intent(in), optional :: time

      !--- The index of the record that was found
      integer :: idx_found

      if ( present(idx) .and. present(time) ) then
        write(6,*)"store_LocateRecord: Both idx and time are present. name=", &
                  trim(name)," group=",gid
        call xit("store_LocateRecord",-1)
      else if ( present(idx) ) then
        idx_found = store_LocateRecordByIndex(name, gid, rec_ptr, idx)
      else if ( present(time) ) then
        idx_found = store_LocateRecordByTime(name, gid, rec_ptr, time)
      else
        write(6,*)"store_LocateRecord: One of idx or time must be present. name=", &
                  trim(name)," group=",gid
        call xit("store_LocateRecord",-2)
      endif

    end function store_LocateRecord

    !***************************************************************************
    !--- Locate a record associated with a named field given the list index
    !--- A pointer to the desired record is returned
    !***************************************************************************
    function store_LocateRecordByIndex(name, gid, rec_ptr, idx) result(idx_found)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- An index used to determine which record is requested
      !--- If idx is positive then it is the index to locate
      !--- If idx is negative then count backwards from the end of the list
      !--- idx = 0 is an error
      !--- idx = -1 means return the last record in the list
      !--- idx = -2 means return the penultimate record in the list, etc
      integer, intent(in) :: idx

      !--- The index of the record that was found
      integer :: idx_found

      !--- Return a pointer to this record
      type(store_record_t), pointer :: rec_ptr

      !--- Local
      integer :: store_idx, idx1, nrec
      integer :: verbose = 0

      nullify(rec_ptr)
      idx_found = 0

      store_idx = store_GetIndex(name, gid)
      if ( store_idx == 0 ) then
        !--- A field by this name does not exist in storage
        write(6,'(3a,i3,a)')"store_LocateRecordByIndex: ",trim(name), &
                            " group=",gid," does not exist in storage."
        call store_ListStorage()
        call xit("store_LocateRecordByIndex",-1)
      endif

      if ( .not. associated( storage(store_idx)%rp ) ) then
        !--- There are no records associated with this field
        write(6,'(3a,i3,a,i8,a,i3,a)')"** WW ** store_LocateRecordByIndex: ",trim(name), &
             " index=",store_idx," of ",size(storage)," group=",gid," has no associated records."
        call flush(6)
        nullify(rec_ptr)
        idx_found = 0
        return
      endif

      if ( idx > 0 ) then
        !--- Select record idx from the list
        rec_ptr => storage(store_idx)%rp
        idx_found = 1
        do
          if ( idx_found == idx ) then
            !--- Found the requested index
            exit
          endif
          if ( associated(rec_ptr%next) ) then
            rec_ptr => rec_ptr%next
            idx_found = idx_found + 1
          else
            !--- No more records after this one
            !--- Unable to find the requested record
            write(6,'(3a,i3,a,i8)')"** EE ** store_LocateRecordByIndex: ",trim(name), &
                           " group=",gid," ...unable to find requested index = ",idx
            call flush(6)
            nullify(rec_ptr)
            idx_found = 0
            return
          endif
        enddo

      else if ( idx < 0 ) then
        !--- nrec is the total number of records in the list
        !--- Select the (nrec + 1 + idx) record in the list
        !--- Count the number of records in this list
        nrec = store_CountRecord(name, gid)
        !--- reassign nrec as the index of the record to find
        nrec = nrec + 1 + idx
        if ( nrec > 0 ) then
          !--- Select record idx from the list
          rec_ptr => storage(store_idx)%rp
          idx_found = 1
          do
            if ( idx_found == nrec ) then
              !--- Found the requested index
              exit
            endif
            if ( associated(rec_ptr%next) ) then
              rec_ptr => rec_ptr%next
              idx_found = idx_found + 1
            else
              !--- No more records after this one
              !--- Unable to find the requested record
              write(6,'(3a,i3,a,i8)')"** EE ** store_LocateRecordByIndex: ",trim(name), &
                             " group=",gid," ...unable to find requested index = ",idx
              call flush(6)
              nullify(rec_ptr)
              idx_found = 0
              return
            endif
          enddo
        else
          !--- Absolute value of index is greater than the number of records
          write(6,'(3a,i3,a,i8)')"** EE ** store_LocateRecordByIndex: ",trim(name), &
                         " group=",gid," ...absolute value of index is too large. index = ",idx
          call flush(6)
          nullify(rec_ptr)
          idx_found = 0
          return
        endif

      else
        !--- Any other value for idx is currently invalid
        write(6,'(3a,i3,a,i8)')"** EE ** store_LocateRecordByIndex: ",trim(name), &
                       " group=",gid," ...invalid index requested. index = ",idx
        call flush(6)
        nullify(rec_ptr)
        idx_found = 0
        return
      endif

      if ( verbose > 0 ) then
        nrec = store_CountRecord(name, gid)
        write(6,'(3a,i3,a,i3,a,i3)')"store_LocateRecordByIndex: Found ",trim(name), &
                               " group=",gid,"  record ",idx_found," of ",nrec
        call flush(6)
      endif

    end function store_LocateRecordByIndex

    !***************************************************************************
    !--- Locate a record associated with a named field given the time
    !--- A pointer to the desired record is returned
    !***************************************************************************
    function store_LocateRecordByTime(name, gid, rec_ptr, time) result(idx_found)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- The time associated with the record to be retrieved
      integer(kind=8), intent(in) :: time

      !--- The index of the record that was found
      integer :: idx_found

      !--- Return a pointer to this record
      type(store_record_t), pointer :: rec_ptr

      !--- Local
      type(store_record_t), pointer :: curr_ptr
      integer :: store_idx, curr_idx, nrec
      integer :: verbose = 1

      nullify(rec_ptr)
      idx_found = 0

      store_idx = store_GetIndex(name, gid)
      if ( store_idx == 0 ) then
        !--- A field by this name does not exist in storage
        write(6,'(3a,i2,a)')"store_LocateRecordByTime: ",trim(name), &
                            " group=",gid," does not exist in storage."
        call store_ListStorage()
        call xit("store_LocateRecordByTime",-1)
      endif

      if ( .not. associated( storage(store_idx)%rp ) ) then
        !--- There are no records associated with this field
        write(6,'(3a,i2,a)')"** WW ** store_LocateRecordByTime: ",trim(name), &
                            " group=",gid," has no associated records."
        call flush(6)
        nullify(rec_ptr)
        idx_found = 0
        return
      endif

      !--- Find the record with the time requested
      !--- If the requested time is not found then rec_ptr and idx_found will not be assigned
      !--- in the following loop and this function will return rec_ptr as a null pointer
      !--- and idx_found == 0
      curr_ptr => storage(store_idx)%rp
      curr_idx = 1
      do while ( associated(curr_ptr) )
        if ( curr_ptr%time == time ) then
          !--- Accept the last record found with this time
          rec_ptr   => curr_ptr
          idx_found =  curr_idx
        endif
        curr_ptr => curr_ptr%next
        curr_idx =  curr_idx + 1
      enddo

      if ( verbose > 0 ) then
        if ( idx_found > 0 .and. verbose > 1 ) then
          nrec = store_CountRecord(name, gid)
          write(6,'(3a,i2,a,i3,a,i3)')"store_LocateRecordByTime: Found ",trim(name), &
                                      " group=",gid,"  record ",idx_found," of ",nrec
        else if ( idx_found == 0 ) then
          write(6,'(a,i10,3a,i2)')"store_LocateRecordByTime: No time=",time, &
                 " found in records associated with ",trim(name)," group=",gid
        endif
        call flush(6)
      endif

    end function store_LocateRecordByTime

    !***************************************************************************
    !--- Remove the first record in the list and return any requested data
    !--- The record is then destroyed
    !***************************************************************************
    subroutine store_ShiftRecord(name, gid, rec_ptr, fdata, ibuf, &
                                 time, nx, ny, nz, nwrds, ignore_missing, max_size)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- Return a pointer to this record
      type(store_record_t), pointer, intent(out), optional :: rec_ptr

      !--- Pointers to field data and ibuf arrays
      !--- If either fdata or ibuf are associated, they will be deallocated
      !--- then reallocated and reassigned below
      real(kind=8),    pointer, dimension(:), intent(out), optional :: fdata
      integer(kind=8), pointer, dimension(:), intent(out), optional :: ibuf

      !--- The time associated with this record
      integer(kind=8), intent(out), optional :: time

      !--- Other optional output parameters
      integer, intent(out), optional :: nx, ny, nz, nwrds

      !--- If the field name does not exist in storage then normally this routine
      !--- will abort. If ignore_missing is used then the user has control over
      !--- whether or not this is a fatal error
      logical, intent(in), optional :: ignore_missing

      !--- Allow the user to specify a maximum number of records to be left in
      !--- storage. If the record count is > max_size then the first record is
      !--- removed, otherwise the list remains at its current size.
      integer, intent(in), optional :: max_size

      !--- Local
      integer :: store_idx, sz, nrec, ic, local_max_size
      logical :: shrink_list
      character(64) :: strng
      type(store_record_t), pointer :: local_rec_ptr
      integer :: verbose = 0

      store_idx = store_GetIndex(name, gid)
      if ( store_idx == 0 ) then
        !--- A field by this name does not exist in storage
        if ( present(ignore_missing) ) then
          if ( ignore_missing ) then
            !--- Treat this like an empty list
            if ( present(time)    ) time  = 0
            if ( present(nx)      ) nx    = 0
            if ( present(ny)      ) ny    = 0
            if ( present(nz)      ) nz    = 0
            if ( present(nwrds)   ) nwrds = 0
            !??? if ( present(rec_ptr) ) call store_DestroyRecord(rec_ptr)
            write(6,'(3a,i2,a)')"store_ShiftRecord: ",trim(name)," group=",gid, &
                                " does not exist in storage. Ignored."
            return
          else
            !--- Otherwise issue an error message and abort
            write(6,'(3a,i2,a)')"store_ShiftRecord: ",trim(name)," group=",gid, &
                                " does not exist in storage."
            call xit("store_ShiftRecord",-1)
          endif
        else
          write(6,'(3a,i2,a)')"store_ShiftRecord: ",trim(name)," group=",gid, &
                              " does not exist in storage."
          call xit("store_ShiftRecord",-1)
        endif
      endif

      if ( .not. associated( storage(store_idx)%rp ) ) then
        !--- The list associated with this name is empty
        !--- Return zeros for integer output
        !??? Destroy the user supplied pointer, if any
        !--- Leave the fdata and ibuf array pointers unmodified
        if ( present(time)    ) time  = 0
        if ( present(nx)      ) nx    = 0
        if ( present(ny)      ) ny    = 0
        if ( present(nz)      ) nz    = 0
        if ( present(nwrds)   ) nwrds = 0
        !??? if ( present(rec_ptr) ) call store_DestroyRecord(rec_ptr)
        return
      endif

      if ( present(max_size) ) then
        local_max_size = max_size
      else
        local_max_size = 0
      endif

      if ( store_CountRecord(name,gid) > local_max_size ) then
        shrink_list = .true.
      else
        shrink_list = .false.
      endif

      !--- Get a local pointer to the first record in the list
      local_rec_ptr => storage(store_idx)%rp

      if ( shrink_list ) then
        !--- Detatch the first record in the list and associate it with local_rec_ptr
        storage(store_idx)%rp => storage(store_idx)%rp%next
        local_rec_ptr%next => null()
      endif

      !--- Assign input parameters as required
      if ( present(time)  ) time  = local_rec_ptr%time
      if ( present(nx)    ) nx    = local_rec_ptr%nx
      if ( present(ny)    ) ny    = local_rec_ptr%ny
      if ( present(nwrds) ) nwrds = local_rec_ptr%size
      if ( present(fdata) ) then
        if ( associated(local_rec_ptr%data1d) ) then
          sz = size(local_rec_ptr%data1d)
          if ( associated(fdata) ) deallocate(fdata)
          allocate( fdata(sz) )
          fdata(1:sz) = local_rec_ptr%data1d(1:sz)
        endif
      endif
      if ( present(ibuf)  ) then
        if ( associated(local_rec_ptr%ibuf) ) then
          sz = size(local_rec_ptr%ibuf)
          if ( associated(ibuf) ) deallocate(ibuf)
          allocate( ibuf(sz) )
          ibuf(1:sz) = local_rec_ptr%ibuf(1:sz)
        endif
      endif

      if ( verbose > 1 ) then
        call store_PrintRecord(local_rec_ptr, style=1, pfx="  store_ShiftRecord:")
        call flush(6)
      endif

      if ( present(rec_ptr) ) then
        !--- Return a pointer to the detached record
        !--- Note that this is a copy with its own memory allocation and it is up to
        !--- the calling program to manage this space
        call store_CopyRecord(local_rec_ptr, rec_ptr)
      endif

      if ( shrink_list ) then
        !--- Destroy the detached record
        call store_DestroyRecord(local_rec_ptr)
      endif

      if ( verbose > 1 ) then
        nrec = store_CountRecord(name, gid)
        strng = " "
        write(strng,'(2a,i2)')trim(adjustl(name))," group=",gid
        ic = max( len_trim(adjustl(strng)), 16)
        if ( shrink_list ) then
          write(6,'(3a,i4)')"  store_ShiftRecord: Discard first record from ",strng(1:ic), &
                            " ...list size is now ",nrec
        else
          write(6,'(3a,i4)')"  store_ShiftRecord: Did not discard first record from ",strng(1:ic), &
                            " ...list size is now ",nrec
        endif
        call flush(6)
      endif

    end subroutine store_ShiftRecord

    !****************************************************************************
    !--- Remove the last record in the list associated with the given name
    !---
    !--- If the user supplies an optional record pointer as a parameter then that
    !--- pointer is associated with the record after it is detached from the list.
    !--- If no record pointer was supplied then the detached record is destroyed.
    !****************************************************************************
    subroutine store_PopRecord(name, gid, rec_ptr)

      implicit none

      !--- The name of a storage field
      character(*), intent(in) :: name

      !--- The group ID for this variable
      integer, intent(in) :: gid

      !--- Return a pointer to this record
      type(store_record_t), pointer, intent(out), optional :: rec_ptr

      !--- Local
      integer :: store_idx, last_idx, prev_idx, nrec, ic
      type(store_record_t), pointer :: last_rec_ptr, prev_rec_ptr
      character(128) :: strng
      integer :: verbose = 0

      store_idx = store_GetIndex(name, gid)
      if ( store_idx == 0 ) then
        !--- A field by this name does not exist in storage
        write(6,'(3a,i2,a)')"store_PopRecord: ",trim(name)," group=",gid, &
                            " does not exist in storage."
        call xit("store_PopRecord",-1)
      endif

      if ( .not. associated( storage(store_idx)%rp ) ) then
        !--- The list associated with this name is empty
        !??? if ( present(rec_ptr) ) call store_DestroyRecord(rec_ptr)
        return
      endif

      !--- Get a pointer to the last record in the list associated with this name
      !--- last_idx will be the total number of records in the list
      last_idx = store_LocateRecord(name, gid, last_rec_ptr, idx=-1)

      if ( last_idx == 1 ) then
        !--- There is only 1 record in this list
        !--- Create an empty list
        nullify( storage(store_idx)%rp )

      else
        !--- There are at least 2 records in the list
        !--- Use info from the previous invocation of store_LocateRecord to get
        !--- a pointer to the penultimate record in the list
        prev_idx = store_LocateRecord(name, gid, prev_rec_ptr, idx=last_idx-1)

        !--- Detach the last record from the list
        prev_rec_ptr%next => null()

      endif

      if ( verbose > 0 ) then
        nrec = store_CountRecord(name, gid)
        strng = " "
        write(strng,'(2a,i2)')trim(adjustl(name))," group=",gid
        ic = max( len_trim(adjustl(strng)), 16)
        write(6,'(3a,i4)')"  store_PopRecord: Discard last record from ",strng(1:ic), &
                          " ...list size is now ",nrec
        call flush(6)

        if ( verbose > 1 ) then
          strng = " "
          write(strng,'(a,i4,3a,i2,a,i4)')"  store_PopRecord: Discard record ",last_idx, &
              " from ",trim(name)," group=",gid," ...list size is now ",nrec 
          call store_PrintRecord( last_rec_ptr, style=1, pfx=trim(strng) )
        endif
      endif

      if ( present(rec_ptr) ) then
        !--- Return the pointer without destroying the record
        rec_ptr => last_rec_ptr
      else
        !--- Simply destroy the detached record
        call store_DestroyRecord(last_rec_ptr)
      endif

    end subroutine store_PopRecord

    !***************************************************************************
    !--- Write a single record from the named variable to a file
    !***************************************************************************
    subroutine store_DiskWrite(name, fpart, file, unit, idx)

      use ccc_io

      !--- The name of a variable found in storage
      character(*), intent(in) :: name

      !--- A user supplied file name (use variable name by default)
      character(*), intent(in), optional :: file

      !--- A user supplied string that will form part of the file name
      character(*), intent(in), optional :: fpart

      !--- A user supplied unit number (use next available by default)
      integer,      intent(in), optional :: unit

      !--- A user supplied record index (use last record by default)
      integer,      intent(in), optional :: idx

      !--- Local
      integer :: store_idx, record_idx, l_idx, l_unit, nwrds, nrec
      logical :: exists
      integer(8) :: ibuf(8)
      type(store_record_t), pointer :: rec_ptr => null()
      character(256) :: l_file, strnga, strngb

      if ( present(idx) ) then
        l_idx = idx
      else
        !--- Use the last (most recent) record on the stack by default
        l_idx = -1
      endif
      if ( l_idx == 0 ) then
        write(6,*)"store_DiskWrite: ",trim(name)," record index ",l_idx," is out of range."
        call xit("store_DiskWrite",-1)
      endif

      store_idx = store_GetIndex(name, anygid)
      if ( store_idx < 1 ) then
        !--- This name does not exist in storage
        write(6,*)"store_DiskWrite: ",trim(name)," does not exist in storage"
        call xit("store_DiskWrite",-2)
      endif

      if ( .not. associated( storage(store_idx)%rp ) ) then
        !--- There are no records associated with this variable
        write(6,*)"store_DiskWrite: No associated records for ",trim(name)
        write(6,*)"store_DiskWrite: The current storage list is:"
        call store_ListStorage()
        call xit("store_DiskWrite",-3)
      endif

      !--- Determine the index of the record to write
      if ( l_idx > 1 ) then
        nrec = l_idx
      else
        !--- l_idx is negative ...determine the index relative to the end of the list
        !--- Count the number of records in this list
        nrec = store_CountRecord(name, anygid)
        !--- reassign nrec as the index of the record to find
        nrec = nrec + 1 + l_idx
        if ( nrec < 1 ) then
          write(6,*)"store_DiskWrite: ",trim(name)," record index ",nrec," is out of range."
          call xit("store_DiskWrite",-4)
        endif
      endif
      !--- Select the desired record from the list
      rec_ptr => storage(store_idx)%rp
      record_idx = 1
      do
        if ( record_idx == nrec ) then
          !--- Found the requested index
          exit
        endif
        if ( associated(rec_ptr%next) ) then
          rec_ptr => rec_ptr%next
          record_idx = record_idx + 1
        else
          !--- No more records after this one
          !--- Unable to find the requested record
          write(6,*)"store_DiskWrite: ",trim(name)," record index ",nrec," is out of range."
          call xit("store_DiskWrite",-5)
        endif
      enddo

      !--- Ensure there is data allocated for this record
      if ( .not. associated(rec_ptr%data1d) ) then
        write(6,*)"store_DiskWrite: ",trim(name)," record ",record_idx," contains no data"
        call xit("store_DiskWrite",-6)
      endif

      !--- Open the file for writing
      if ( present(file) ) then
        l_file = trim(file)
      else
        l_file = " "
        strngb = " "
        if ( present(fpart) ) then
          write(strngb,'(a,"_",i8.8)')trim(fpart),cpl_elapsed_time_secs
        else
          write(strngb,'(i8.8)')cpl_elapsed_time_secs
        endif
        if ( len_trim(env_runid) > 0 ) then
          l_file = trim(name)//"_"//trim(strngb)//"_"//trim(env_runid)
        else
          l_file = trim(name)//"_"//trim(strngb)
        endif
      endif
      if ( present(unit) ) then
        l_unit = unit
      else
        l_unit = cc_newunit(257)
      endif
      inquire(file=trim(l_file), exist=exists)
      if ( .not. exists ) then
        !--- Open and position at the beginning of the file
        open(l_unit, file=trim(l_file), form="unformatted")
        !xxx write(6,*)"store_DiskWrite: Opened ",trim(l_file)," on unit ",l_unit," as new."
      else
        !--- Open and position at the end of the file
        open(l_unit, file=trim(l_file), form="unformatted", position="append")
        !xxx write(6,*)"store_DiskWrite: Opened ",trim(l_file)," on unit ",l_unit," to append."
      endif

      !--- Define ibuf on the fly
      ibuf(1) = transfer("GRID", 1_8)
      ibuf(2) = cpl_elapsed_time_secs
      ibuf(3) = transfer(name(1:4), 1_8)
      ibuf(4) = 1
      ibuf(5) = rec_ptr%nx + rec_ptr%olap
      ibuf(6) = rec_ptr%ny
      ibuf(7) = 0
      ibuf(8) = 1

      !--- Write the data from this record to a file
!DBG      write(l_unit)ibuf
      write(l_unit)rec_ptr%data1d
      nwrds = size(rec_ptr%data1d)
      write(6,*)"store_DiskWrite: wrote ",nwrds," words to ",trim(l_file)," on unit ",l_unit
      call flush(6)

      !--- Close the file after every write to force the data to disk
      close(l_unit)
      !xxx write(6,*)"store_DiskWrite: Closed file ",trim(l_file)," on unit ",l_unit

    end subroutine store_DiskWrite

end module store

