ESMF_ReconcileDeserialize Subroutine

private subroutine ESMF_ReconcileDeserialize(state, vm, obj_buffer, attreconflag, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_State), intent(inout) :: state
type(ESMF_VM), intent(in) :: vm
character(len=1), pointer :: obj_buffer(:)
type(ESMF_AttReconcileFlag), intent(in) :: attreconflag
integer, intent(out) :: rc

Source Code

  subroutine ESMF_ReconcileDeserialize (state, vm, obj_buffer, attreconflag, rc)
!
! !ARGUMENTS:
    type (ESMF_State), intent(inout):: state
    type (ESMF_VM),    intent(in)   :: vm
    character,         pointer      :: obj_buffer(:)    ! intent(in)
    type(ESMF_AttReconcileFlag),intent(in)   :: attreconflag
    integer,           intent(out)  :: rc
!
! !DESCRIPTION:
!   Builds proxy items for each of the items in the buffer.
!
!   The arguments are:
!   \begin{description}
!   \item[state]
!     {\tt ESMF\_State} to add proxy objects to.
!   \item[vm]
!     {\tt ESMF\_VM} to use.
!   \item[obj_buffer]
!     Buffer of serialized State objects (intent(in))
!   \item[attreconflag]
!     Flag to indicate attribute reconciliation.
!   \item[rc]
!     Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!   \end{description}
!EOPI

    integer :: localrc
    integer :: memstat

    type(ESMF_FieldBundle) :: fieldbundle
    type(ESMF_Field) :: field
    type(ESMF_Array) :: array
    type(ESMF_ArrayBundle) :: arraybundle
    type(ESMF_State) :: substate

    integer :: buffer_offset
    integer :: needs_count
    integer, allocatable :: offset_table(:), type_table(:)

    integer :: i, idx
    integer :: stateitem_type
    character(ESMF_MAXSTR) :: errstring
    logical :: found

    integer :: mypet

    logical, parameter :: debug = .false.
    logical, parameter :: trace = .false.

    ! Sanity checks
    call ESMF_VMGet (vm, localPet=mypet, rc=localrc)
    if (ESMF_LogFoundError (localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return

    if (trace) then
      print *, '    pet', mypet,  &
          ': *** Step 0 - sanity checks'
    end if

    needs_count = transfer (  &
        source=obj_buffer(0:ESMF_SIZEOF_DEFINT-1),  &
        mold  =needs_count)
    if (debug) then
      print *, ESMF_METHOD, ': PET', mypet, ', needs_count =', needs_count
    end if

    ! -------------------------------------------------------------------------

    ! Deserialize offset and type tables
    if (debug) then
      print *, ESMF_METHOD, ': buffer offset/type table:'
    end if
    allocate (offset_table(needs_count), type_table(needs_count), stat=memstat)
    if (ESMF_LogFoundAllocError (memstat, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT,  &
        rcToReturn=rc)) return
    idx = 2 * ESMF_SIZEOF_DEFINT  ! Start after needs_count and pad
    do, i=1, needs_count
#if !defined (__G95__)
      offset_table(i) = transfer (  &
          obj_buffer(idx:idx+ESMF_SIZEOF_DEFINT-1),  &
          mold=needs_count)
      idx = idx + ESMF_SIZEOF_DEFINT
      type_table(i) = transfer (  &
          obj_buffer(idx:idx+ESMF_SIZEOF_DEFINT-1),  &
          mold=needs_count)
      idx = idx + ESMF_SIZEOF_DEFINT
#else
      ! g95 snapshots prior to April 4, 2010 have a bug in TRANSFER.
      ! The following works around it.
      offset_table(i) = ESMF_Reconcile_g95_getint (  &
          obj_buffer(idx:idx*ESMF_SIZEOF_DEFINT-1))
      idx = idx + ESMF_SIZEOF_DEFINT
      type_table(i) = ESMF_Reconcile_g95_getint (  &
          obj_buffer(idx:idx*ESMF_SIZEOF_DEFINT-1))
      idx = idx + ESMF_SIZEOF_DEFINT
#endif
      if (debug) then
        print *, '   ', i, ':', offset_table(i), type_table(i)
      end if
    end do

    ! Deserialize items
    if (trace) then
      print *, '    pet', mypet,  &
          ': *** Step 1 - main deserialization loop'
    end if
    buffer_offset = ESMF_SIZEOF_DEFINT * (2 + 2*needs_count) ! Skip past count, pad, and offset/type tables
    do, i=1, needs_count

      ! Item type
      stateitem_type = type_table(i)
      if (debug) then
        print *, ESMF_METHOD,  &
            ': stateitem_type =', stateitem_type, ', offset =', buffer_offset
      end if

      ! Item itself
      buffer_offset = offset_table(i)
      select case (stateitem_type)
        case (ESMF_STATEITEM_FIELDBUNDLE%ot)
          if (debug) then
            print *, "deserializing FieldBundle, offset =", buffer_offset
          end if
          fieldbundle = ESMF_FieldBundleDeserialize(obj_buffer, buffer_offset, &
              attreconflag=attreconflag, rc=localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return

          call ESMF_StateAdd(state, fieldbundle, &
              addflag=.true., proxyflag=.true.,  &
              rc=localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return

        case (ESMF_STATEITEM_FIELD%ot)
          if (debug) then
            print *, "deserializing Field, offset =", buffer_offset
          end if
          field = ESMF_FieldDeserialize(obj_buffer, buffer_offset, &
              attreconflag=attreconflag, rc=localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return

          if (debug) then
            print *, "created field, ready to add to local state"
          end if

          call ESMF_StateAdd(state, field,      &
              addflag=.true., proxyflag=.true., &
              rc=localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return

        case (ESMF_STATEITEM_ARRAY%ot)
          if (debug) then
            print *, "    PET", mypet,  &
                ": deserializing Array, offset =", buffer_offset
          end if
          call c_ESMC_ArrayDeserialize(array, obj_buffer, buffer_offset, &
              attreconflag, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return

          ! Set init code
          call ESMF_ArraySetInitCreated(array, rc=localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return

          call ESMF_StateAdd(state, array,      &
              addflag=.true., proxyflag=.true., &
              rc=localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return

        case (ESMF_STATEITEM_ARRAYBUNDLE%ot)
          if (debug) then
            print *, "deserializing ArrayBundle, offset =", buffer_offset
          end if
          call c_ESMC_ArrayBundleDeserialize(arraybundle, obj_buffer, &
              buffer_offset, attreconflag, localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return

          ! Set init code
          call ESMF_ArrayBundleSetInitCreated(arraybundle, rc=localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return

          call ESMF_StateAdd(state, arraybundle, &
              addflag=.true., proxyflag=.true.,  &
              rc=localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return

        case (ESMF_STATEITEM_STATE%ot)
          if (debug) then
            print *, "deserializing nested State, offset =", buffer_offset
          end if
          substate = ESMF_StateDeserialize(vm, obj_buffer, buffer_offset, &
              attreconflag=attreconflag, rc=localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return

          call ESMF_StateAdd(state, substate,   &
              addflag=.true., proxyflag=.true., &
              rc=localrc)
          if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return

        case (ESMF_STATEITEM_UNKNOWN%ot)
          write (errstring, '(a,i0)') 'can''t deserialize unknown type: ', stateitem_type
          if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return

        case default
          write (errstring, '(a,i0)') 'can''t deserialize unsupported type: ', stateitem_type
          if (ESMF_LogFoundError(ESMF_RC_INTNRL_INCONS, msg=errstring, &
              ESMF_CONTEXT,  &
              rcToReturn=rc)) return
      end select

#if 0
    ! Use offset from table in case of an early exit from a deserialize method

#if !defined (__G95__)
    buffer_offset = transfer (  &
        source=obj_buffer((i+1)*ESMF_SIZEOF_DEFINT:(i+2)*ESMF_SIZEOF_DEFINT-1),  &
        mold  =i)
#else
      ! g95 snapshots prior to April 4, 2010 have a bug in TRANSFER.
      ! The following works around it.
    buffer_offset = ESMF_Reconcile_g95_getint (  &
        source=obj_buffer((i+1)*ESMF_SIZEOF_DEFINT:(i+2)*ESMF_SIZEOF_DEFINT-1))
#endif

      if (debug) then
        print *, '   buffer offset after item loop =', buffer_offset
      end if
#endif

    end do ! needs_count

    if (trace) then
      print *, '    pet', mypet,  &
          ': *** Deserialization complete'
    end if

    rc = ESMF_SUCCESS

  end subroutine ESMF_ReconcileDeserialize