ESMF_LocStreamCreateFromNewDG Function

private function ESMF_LocStreamCreateFromNewDG(locstream, distgrid, keywordEnforcer, name, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_LocStream), intent(in) :: locstream
type(ESMF_DistGrid), intent(in) :: distgrid
type(ESMF_KeywordEnforcer), optional :: keywordEnforcer
character(len=*), intent(in), optional :: name
integer, intent(out), optional :: rc

Return Value type(ESMF_LocStream)


Source Code

      function ESMF_LocStreamCreateFromNewDG(locstream, distgrid, keywordEnforcer, &
           name, rc)

!
! !RETURN VALUE:
      type(ESMF_LocStream) :: ESMF_LocStreamCreateFromNewDG

!
! !ARGUMENTS:
      type(ESMF_LocStream), intent(in)                :: locstream
      type(ESMF_DistGrid),  intent(in)                :: distgrid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
      character (len=*),    intent(in), optional      :: name
      integer,              intent(out), optional     :: rc
!
! !DESCRIPTION:
!
!     Create a new location stream that is a copy of an old one, but with a new
!     distribution. The new distribution is given by a distgrid passed into the call.
!     Key and other class information is copied from the old locstream to the new one. 
!     Information contained in Fields build on the location streams can be copied over
!     by using the Field redistribution calls (e.g. {\tt ESMF\_FieldRedistStore()} 
!     and {\tt ESMF\_FieldRedist()}).   
!
!     The arguments are:
!     \begin{description}
!      \item[locstream]
!          Location stream from which the new location stream is to be created
!      \item[distgrid]
!          Distgrid for new distgrid
!      \item[{[name]}]
!          Name of the resulting location stream
!      \item[{[rc]}]
!          Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
!     \end{description}
!
!EOP
      type(ESMF_LocStreamType), pointer :: oldLStypep, newLStypep
      type(ESMF_LocStream):: newLocStream
      type(ESMF_ArrayBundle) :: oldAB, newAB
      type(ESMF_RouteHandle) :: routehandle
      type(ESMF_TypeKind_Flag) ::keyTypeKind
      type(ESMF_CoordSys_Flag) :: coordSysLocal
      character(len=ESMF_MAXSTR)    :: keytemp, string
      integer :: keyCount,i
      integer :: localrc


! Initialize return code; assume failure until success is certain
      if (present(rc)) rc = ESMF_RC_NOT_IMPL

      ! Check Variables
      ESMF_INIT_CHECK_DEEP(ESMF_LocStreamGetInit,locstream,rc)
      ESMF_INIT_CHECK_DEEP(ESMF_DistGridGetInit,distgrid,rc)

      ! Get old locstream internal pointer
      oldLStypep=>locstream%lstypep     

      call ESMF_LocStreamGet(locstream, coordSys=coordSysLocal, rc=localrc)
      if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return     

      ! Create new locStream
      newLocStream=ESMF_LocStreamCreateFromDG(name=name, distgrid=distgrid, &
                indexflag=oldLSTypep%indexFlag, &
                coordSys=coordSysLocal,rc=localrc) 
      if (ESMF_LogFoundError(localrc, &
          ESMF_ERR_PASSTHRU, &
          ESMF_CONTEXT, rcToReturn=rc)) return     


      ! Add keys to new Locstream
      ! NOTE: We need a subroutine to add a list of keys. This is inefficient because of the allocations 
      !       and searching for already in
      keyCount=oldLStypep%keyCount
      do i=1,keyCount

         ! get key typeKind
         call ESMF_ArrayGet(oldLStypep%keys(i), typekind=keyTypeKind, rc=localrc)
         if (ESMF_LogFoundError(localrc, &
             ESMF_ERR_PASSTHRU, &
             ESMF_CONTEXT, rcToReturn=rc)) return     

         call ESMF_LocStreamAddKey(newLocStream, &
              keyName=oldLstypep%keyNames(i), &
              keyTypekind=keyTypeKind, &
              keyUnits=oldLstypep%keyUnits(i), &
              keyLongName=oldLstypep%keyLongNames(i), &
              rc=localrc)
         if (ESMF_LogFoundError(localrc, &
             ESMF_ERR_PASSTHRU, &
             ESMF_CONTEXT, rcToReturn=rc)) return     
      enddo


      ! Get new locstream internal pointer
      newLStypep=>newLocStream%lstypep

      ! NOTE THAT THIS ONLY WORKS BECAUSE THE LocStreamAddKey SUBROUTINE
      ! ADDS KEYS AT THE END. IF THIS CHANGES THIS'LL STOP WORKING. 
      ! FOR EFFICENCY REASONS I'LL LEAVE IT FOR NOW. IF IT CHANGES
      ! REWRITE TO NOT DEPEND ON ORDER


      ! Redistribute data from one locstream to another 

      ! Create ArrayBundles for redistribution
      oldAB=ESMF_ArrayBundleCreate(arrayList=oldLStypep%keys, rc=localrc)      
       if (ESMF_LogFoundError(localrc, &
             ESMF_ERR_PASSTHRU, &
             ESMF_CONTEXT, rcToReturn=rc)) return     

      newAB=ESMF_ArrayBundleCreate(arrayList=newLStypep%keys, rc=localrc)      
       if (ESMF_LogFoundError(localrc, &
             ESMF_ERR_PASSTHRU, &
             ESMF_CONTEXT, rcToReturn=rc)) return     


      ! Setup for redist
      call ESMF_ArrayBundleRedistStore(srcArrayBundle=oldAB, dstArrayBundle=newAB, &
             routehandle=routeHandle, rc=localrc)
       if (ESMF_LogFoundError(localrc, &
             ESMF_ERR_PASSTHRU, &
             ESMF_CONTEXT, rcToReturn=rc)) return     

      ! Do redist
      call ESMF_ArrayBundleRedist(srcArrayBundle=oldAB, dstArrayBundle=newAB, &
            routehandle=routeHandle, rc=localrc)
       if (ESMF_LogFoundError(localrc, &
             ESMF_ERR_PASSTHRU, &
             ESMF_CONTEXT, rcToReturn=rc)) return     

      ! Get rid of routehandle
      call  ESMF_ArrayBundleRedistRelease(routehandle=routehandle, rc=localrc)
       if (ESMF_LogFoundError(localrc, &
             ESMF_ERR_PASSTHRU, &
             ESMF_CONTEXT, rcToReturn=rc)) return     

      ! Get rid of ArrayBundles
      call ESMF_ArrayBundleDestroy(oldAB, rc=localrc)
       if (ESMF_LogFoundError(localrc, &
             ESMF_ERR_PASSTHRU, &
             ESMF_CONTEXT, rcToReturn=rc)) return     

      call ESMF_ArrayBundleDestroy(newAB, rc=localrc)
       if (ESMF_LogFoundError(localrc, &
             ESMF_ERR_PASSTHRU, &
             ESMF_CONTEXT, rcToReturn=rc)) return     

     ! Output new locstream
     ESMF_LocStreamCreateFromNewDG=newLocStream

      if (present(rc)) rc = ESMF_SUCCESS

      end function ESMF_LocStreamCreateFromNewDG