!BOI

!  !TITLE: GSI\_Bundle and its Unit Test

!  !AUTHORS: Ricardo Todling

!  !AFFILIATION: Global Modeling and Assimilation Office, NASA/GSFC, Greenbelt,  MD 20771

!  !DATE: 11 May 2010

!  !INTRODUCTION: Overview
#ifdef __PROTEX__

This program provides a serious of illustrations for how to use GSI\_Bundle and
its various functions. The Bundle idea is largely based on a similar ESMF
concept. A Bundle is a collection of fields defined on a given grid. For the time
being, the GSI\_Bundle uses a very simple definition of grid -- a regular grid
-- but it should be relatively simple to generalize it.

See more details about GSI\_Bundle in the DESCRIPTION section of the
main prologue of GSI\_Bundle itself.

#endif
!BOI

#define _BUNDLE_R4_
!-----------------------------------------------------------------------
!BOP
!
! !PROGRAM: ut_gsibunde:  Test driver for GSI_Bundle
!
! !USES:

use kinds, only: i_kind,r_kind
use constants, only: one
use gsi_bundlemod, only : GSI_BundleCreate
use gsi_bundlemod, only : GSI_BundleGetPointer
use gsi_bundlemod, only : GSI_BundlePutVar
use gsi_bundlemod, only : GSI_Bundle
use gsi_bundlemod, only : GSI_BundleMerge
use gsi_bundlemod, only : GSI_BundlePrint
use gsi_bundlemod, only : GSI_BundleDestroy

! these should eventually not belog to the bundle
use gsi_bundlemod, only : GSI_Grid
use gsi_bundlemod, only : GSI_GridCreate

implicit none

! !DESCRIPTION: This is a little test program to illustrate how to
!               use GSI\_Bundle. The following test are implemented:
!  \bn
!        \item Creation and Deletion of Bundle
!        \item Retrieval of varibles from the Bunle
!        \item Write something to the Bundle
!        \item Merge of two Bunldes
!  \en
!
! !REMARKS:
!    1. The definition of grid is so far a very simple regular
!       (im,jm,km)-type grid.
!
!    2. By definition, all fields in a Bundle must be on the same
!       grid.
!
! !REVISION HISTORY:
!
!  23Apr2010  Todling  Initial code.
!  28Apr2011  Todling  Add code to test REAL*4 support (please read
!                      comments in routine Ensemble()
!
!EOP
!-----------------------------------------------------------------------
!BOC

! Lets pretend we have a simple (im,jm,km)-like (regular) grid
integer(i_kind), parameter :: lat2=91
integer(i_kind), parameter :: lon2=144
integer(i_kind), parameter :: lev =72

! And lets pretend we have a simple set of 2dr- and 3d-variables
integer(i_kind), parameter :: n2d = 2
character(len=16), parameter :: names2d(n2d) = (/  &
                                'phis            ',    &
                                'ps              '    /)
integer(i_kind), parameter :: n3d = 3
character(len=16), parameter :: names3d(n3d) = (/  &
                                'u               ',    &
                                'v               ',    &
                                'tv              '    /)

integer(i_kind)  ipnt, ierr

type(GSI_Bundle) :: GSI_bundle_mix
type(GSI_Grid)   :: grid

! First create a grid
call GSI_GridCreate ( grid, lat2, lon2, lev )

!---------------------------------------------------------------
! Lets now create a bundle with both 2d- and 3d-variables above,
! defined on our simple grid
!---------------------------------------------------------------
call GSI_BundleCreate ( GSI_bundle_mix, grid, 'Mix Bundle', ierr, &
                        names2d=names2d, names3d=names3d ) 

!---------------------------------------------------------------
! Suppose we now want to find variable "v" and also that we
! want to write something on it ... 
!---------------------------------------------------------------
call GSI_BundleGetPointer ( GSI_bundle_mix, 'v', ipnt, ierr ) 
  if(ierr/=0) then
     print*, 'Pointer not found '
  else
     print*, 'Found field v at location ', ipnt
     GSI_bundle_mix%r3(ipnt)%q = 2._r_kind 
     call GSI_BundlePrint ( GSI_bundle_mix )
  endif

!---------------------------------------------------------------
! Here is another way to write something in a variable, say,
! write a constant to "ps" ...
!---------------------------------------------------------------
call GSI_BundlePutVar ( GSI_bundle_mix, 'ps' , one, ierr )
  if(ierr/=0) then
     print*, 'Trouble using PutVar'
  else
     print*, 'Found field ps at location ', ipnt
     call GSI_BundlePrint ( GSI_bundle_mix )
  endif

! ------
! TEST 1: merge two bundles
! ------
  call merger ( GSI_bundle_mix )

! ------
! TEST 2: create a multiple bundle
! ----
  call multi ( GSI_bundle_mix )

! ------
! TEST 3: append to bundle another bundle w/ mixed vertical layers/levels
! ----
  call edge ( GSI_bundle_mix )

! ------
! TEST 4: test creating a bundle w/ "mix-grids" as in control vector
! ----
  call ensemble ( )

! ------
! TEST 3: print original bundle to show that none of the above changed it
! ------
print*
print*, 'Original bundle should be kept untouched'
call GSI_BundlePrint ( GSI_bundle_mix )

!---------------
! destroy bundle
!---------------
call GSI_BundleDestroy ( GSI_bundle_mix, ierr )

end
!EOC

!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  Merger --- Test merging two bundles into a new one
!
! !INTERFACE:
!
subroutine Merger ( GSI_bundle_mix )

! !USES:

use kinds, only: i_kind,r_kind
use gsi_bundlemod, only : GSI_BundleCreate
use gsi_bundlemod, only : GSI_BundleGetPointer
use gsi_bundlemod, only : GSI_BundlePutVar
use gsi_bundlemod, only : GSI_Bundle
use gsi_bundlemod, only : GSI_BundleMerge
use gsi_bundlemod, only : GSI_BundlePrint
use gsi_bundlemod, only : GSI_BundleDestroy

! these should eventually not belog to the bundle
use gsi_bundlemod, only : GSI_Grid
use gsi_bundlemod, only : GSI_GridCreate

implicit none

! !INPUT/OUTPUT PARAMETERS:

type(GSI_Bundle) :: GSI_Bundle_mix 

!
! !DESCRIPTION: Test merging two bundles:
!    \bn
!       \item Input known bundle
!       \item Create new bundle w/ 1d-vectors
!       \item Merge known and new bundle into yet another bundle
!       \item Write some fields in the bundle
!       \item Show contents of bundle
!    \en
!
! !REVISION HISTORY:
!
!  22Apr2010 Todling - Initial code
!
!EOP
!-------------------------------------------------------------------------
!BOC

! Pretend we now have 1d-fields
integer(i_kind), parameter :: n1d = 2
character(len=16), parameter :: names1d(n1d) = (/  &
                                'lat             ',    &
                                'lon             '    /)

type(GSI_Bundle) :: GSI_Bundle_new 
type(GSI_Bundle) :: GSI_Bundle_all 
type(GSI_Grid)   :: grid1d
integer(i_kind)  ipnt, lat2, lon2, nlev, ierr
real(r_kind),allocatable,dimension(:)  ::varRank1
real(r_kind),allocatable,dimension(:,:)::varRank2

lat2 = GSI_bundle_mix%grid%im
lon2 = GSI_bundle_mix%grid%jm
nlev = GSI_bundle_mix%grid%km

print*, 'TESTING MERGE ...'
print*, '-----------------'

! create simple grid
call GSI_GridCreate (grid1d, lat2, 0, 0)

!------------------------------------
! create a new 1d bundle and merge it w/ bundle above into yet a 3rd bundle
!------------------------------------
call GSI_BundleCreate ( GSI_bundle_new, grid1d, 'New 1d Bundle', ierr, &
                                    names1d=names1d )
     call GSI_BundleGetPointer ( GSI_bundle_new, 'lon', ipnt, ierr ) 
     call random_number(GSI_bundle_new%r1(ipnt)%q)
     print*, 'this is the new bundle w/ 1d fields'
     call GSI_BundlePrint ( GSI_bundle_new )

!--------------------------------------------
! merge two bundle ... grids must be the same
!--------------------------------------------
call GSI_BundleMerge ( GSI_bundle_all, GSI_bundle_mix, GSI_bundle_new, 'Merged All', ierr )
  if(ierr/=0) then
     print*, 'could not merge bundles '
  else
     call GSI_BundleDestroy ( GSI_bundle_new, ierr ) ! release some mem
     allocate(varRank2(lat2,lon2))
     call random_number(varRank2)
     call GSI_BundlePutVar ( GSI_bundle_all, 'phis', varRank2, ierr ) 
     if (ierr==0) then
        print*
        print*, 'modify phis in new/merged bundle ...'
        call GSI_BundlePrint ( GSI_bundle_all )
     endif
     deallocate(varRank2)

     allocate(varRank1(lat2*lon2*nlev))
     call random_number(varRank1)
     call GSI_BundlePutVar ( GSI_bundle_all, 'u', varRank1, ierr ) 
     if (ierr==0) then
        print*
        print*, 'modify u in new/merged bundle ...'
        call GSI_BundlePrint ( GSI_bundle_all )
     endif
     deallocate(varRank1)
  endif

!-------------------
! destroy all bundle
!-------------------
call GSI_BundleDestroy ( GSI_bundle_all, ierr )

end subroutine merger
!EOC

!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  Multi --- Test for handling multi instances of Bundle
!
! !INTERFACE:

subroutine Multi ( GSI_bundle_mix )

! !USES:

use kinds, only: i_kind,r_kind
use constants, only: zero
use gsi_bundlemod, only : GSI_BundleCreate
use gsi_bundlemod, only : GSI_BundleGetPointer
use gsi_bundlemod, only : GSI_Bundle
use gsi_bundlemod, only : GSI_BundleMerge
use gsi_bundlemod, only : GSI_BundlePrint
use gsi_bundlemod, only : GSI_BundleDestroy
use gsi_bundlemod, only : assignment(=)
use m_rerank, only : rerank

implicit none

! !INPUT/OUTPUT PARAMETERS:

type(GSI_Bundle) :: GSI_Bundle_mix 

!
! !DESCRIPTION: Test handling a multi-instance Bundle (control vector-like).
!    \bn
!       \item Create a new bundle based on pre-existing bundle
!       \item Create new bundle w/ 1d-vectors
!       \item Merge known and new bundle into yet another bundle
!       \item Write some fields in the bundle
!       \item Show contents of bundle
!    \en
!
! !REVISION HISTORY:
!
!  22Apr2010 Todling - Initial code
!
!EOP
!-------------------------------------------------------------------------
!BOC

type(GSI_Bundle),allocatable :: GSI_Bundle_new(:) 
type(GSI_Bundle) :: GSI_Bundle_dup
integer(i_kind) jj, ipnt, ierr
integer(i_kind) nus,nts,nue,nte, ipnts(2), ivals(2)
integer(i_kind),parameter :: nsub=3
character(len=256) :: bname
real(r_kind),dimension(:),pointer :: u
real(r_kind),dimension(:),pointer :: tv

print*, 'TESTING MULTI ...'
print*, '-----------------'

!------------------------------------------------------
! creates new bundle based on pre-existing one
! Notes:
!   a) creation does not fill in contents of bundle
!   b) an explicit copy must be done to copy contents
!   c) for doing (b), notice use of assignment(=) above
!------------------------------------------------------
allocate(GSI_bundle_new(nsub))

call GSI_BundleCreate ( GSI_bundle_dup, GSI_bundle_mix, trim(GSI_bundle_mix%name), ierr )
GSI_bundle_dup = GSI_bundle_mix   ! copies a bundle into another

! Create now multi-instance Bundle
! Notes:
!   a) For GSI purposes, you can think of this as the control vector 
!      in a nsub-long-window 4dvar
do jj=1,nsub
  write(bname,'(a,i2.2)') 'Bundle at ',jj
  call GSI_BundleCreate ( GSI_bundle_new(jj), GSI_bundle_dup, trim(bname), ierr )
  GSI_bundle_new(jj) = GSI_bundle_dup
  call GSI_BundlePrint ( GSI_bundle_new(jj) )
enddo

! Clean up a little
call GSI_BundleDestroy ( GSI_bundle_dup, ierr )

! Now, in each sub-window (instance) do something different ...
do jj=1,nsub
!    ... like ...
     if(jj==1) then
!      ... filling phis with random numbers in 1st window ...
       call GSI_BundleGetPointer ( GSI_bundle_new(jj), 'phis', ipnt, ierr ) 
       if (ierr==0) then
          call random_number(GSI_bundle_new(jj)%r2(ipnt)%q)
       endif
       print*
       print*, 'modify phis in multi-bundle for jj= ',jj
     endif
     if(jj==2) then
!      ... or changing buth u ad tv in 2nd window ...
       call GSI_BundleGetPointer ( GSI_bundle_new(jj), (/'u ','tv'/),  ipnts, ierr, ivals=ivals ) 
       if (ierr==0) then
          nus= ivals(1)
          nts= ivals(2)
          nue= nus+size(GSI_bundle_new(jj)%r3(ipnts(1))%q)
          nte= nts+size(GSI_bundle_new(jj)%r3(ipnts(2))%q)
          u  => GSI_bundle_new(jj)%values(nus:nue)
          tv => GSI_bundle_new(jj)%values(nts:nte)
          call random_number(u (1:size(GSI_bundle_new(jj)%r3(ipnts(1))%q)))
          call random_number(tv(1:size(GSI_bundle_new(jj)%r3(ipnts(2))%q)))
          print*
          print*, 'modify u and tv in multi-bundle for jj= ',jj
       endif
     endif
     if(jj==3) then
!      ... and tv in 3d window ...
       call GSI_BundleGetPointer ( GSI_bundle_new(jj), 'tv', ipnt, ierr ) 
       if (ierr==0) then
          call random_number(GSI_bundle_new(jj)%r3(ipnt)%q)
          print*
          print*, 'modify tv in multi-bundle for jj= ',jj
       endif
     endif
!    Print result of changes for each instance
     call GSI_BundlePrint   ( GSI_bundle_new(jj) )
enddo

!-------------------------------------------------
! enough now ... let's get rid of the multi-bundle
!-------------------------------------------------
do jj=1,nsub
   call GSI_BundleDestroy ( GSI_bundle_new(jj), ierr )
enddo

end subroutine multi
!EOC

!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  Edge --- Test layer/edge bundle
!
! !INTERFACE:
!
subroutine Edge ( GSI_bundle_mix )

! !USES:

use kinds, only: i_kind,r_kind
use gsi_bundlemod, only : GSI_BundleCreate
use gsi_bundlemod, only : GSI_BundleGetPointer
use gsi_bundlemod, only : GSI_BundlePutVar
use gsi_bundlemod, only : GSI_Bundle
use gsi_bundlemod, only : GSI_BundleMerge
use gsi_bundlemod, only : GSI_BundlePrint
use gsi_bundlemod, only : GSI_BundleDestroy

! these should eventually not belog to the bundle
use gsi_bundlemod, only : GSI_Grid
use gsi_bundlemod, only : GSI_GridCreate

implicit none

! !INPUT/OUTPUT PARAMETERS:

type(GSI_Bundle) :: GSI_Bundle_mix 

!
! !DESCRIPTION: Test bundles w/ mix of layer- and edge-defined fields 
!               (state-vector-like).
!    \bn
!       \item Input known bundle
!       \item Create new bundle w/ 3d-vectors mix of layer- and level-defined
!       \item Merge known and new bundle into yet another bundle
!       \item Write some fields in the bundle
!       \item Show contents of bundle
!    \en
!
! !REVISION HISTORY:
!
!  22Apr2010 Todling - Initial code
!
!EOP
!-------------------------------------------------------------------------
!BOC

! Pretend we now have 1d-fields
integer(i_kind), parameter :: n3d = 3
character(len=16), parameter :: names3d(n3d) = (/  &
                                'sf             ',    &
                                'pe             ',    &
                                'vt             '    /)
integer(i_kind) :: levels(n3d)

type(GSI_Bundle) :: GSI_Bundle_new 
type(GSI_Bundle) :: GSI_Bundle_all 
type(GSI_Grid)   :: grid
integer(i_kind) lat2, lon2, nlev, ierr
! integer(i_kind) ival,ipnt
! real(r_kind),pointer::pe(:,:,:)
real(r_kind),pointer::vt(:,:,:)

print*, 'TESTING EDGE  ...'
print*, '-----------------'

lat2 = GSI_bundle_mix%grid%im
lon2 = GSI_bundle_mix%grid%jm
nlev = GSI_bundle_mix%grid%km

levels = (/ nlev, nlev+1, nlev /)

call GSI_GridCreate (grid, lat2, lon2, nlev)
!------------------------------------
! create a new 1d bundle and merge it w/ bundle above into yet a 3rd bundle
!------------------------------------
call GSI_BundleCreate ( GSI_bundle_new, grid, 'New 3d Bundle', ierr, &
                                    names3d=names3d, levels=levels )
     call GSI_BundlePrint ( GSI_bundle_new )
     call GSI_BundleGetPointer ( GSI_bundle_new, 'vt', vt, ierr ) 
!    call random_number(GSI_bundle_new%r3(ipnt)%q)
     call random_number(vt)
     print*, 'this is the new bundle w/ 3d fields'
     call GSI_BundlePrint ( GSI_bundle_new )

!--------------------------------------------
! merge two bundle ... grids must be the same
!--------------------------------------------
call GSI_BundleMerge ( GSI_bundle_all, GSI_bundle_mix, GSI_bundle_new, 'Merged All', ierr )
  if(ierr/=0) then
     print*, 'could not merge bundles '
  else
       call mimic_int_routines ( GSI_bundle_all )
!      call GSI_BundleGetPointer ( GSI_bundle_all, 'pe', pe, ierr ) 
!      if (ierr==0) then
!         call random_number(pe)
!     endif

     call GSI_BundlePutVar ( GSI_bundle_all, 'sf', vt, ierr ) 
     if (ierr==0) then
        print*
        print*, 'placed vt in sf slot in new/merged bundle ...'
        call GSI_BundlePrint ( GSI_bundle_all )
     endif
  endif

!-------------------
! destroy all bundle
!-------------------
call GSI_BundleDestroy ( GSI_bundle_all, ierr )
call GSI_BundleDestroy ( GSI_bundle_new, ierr )

end subroutine edge
!EOC

!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  mimic_int_routines --- mimic GSI int routines
!
! !INTERFACE:
!
subroutine mimic_int_routines(Bundle)
use m_rerank, only: rerank
use kinds, only: i_kind,r_kind
use gsi_bundlemod, only: gsi_bundle
use gsi_bundlemod, only: gsi_bundlegetpointer
! !USES:
implicit none
!
! !DESCRIPTION: Mimic GSI int routines.
!
! !REVISION HISTORY:
!
!  12Oct2010 Todling - Add prologue for PROTEX consistency
!
!EOP
!-------------------------------------------------------------------------
!BOC
type(gsi_bundle),intent(inout) :: bundle
!real(r_kind),pointer,dimension(:,:,:)::pe
real(r_kind),pointer,dimension(:)::r1pe
integer(i_kind) ierr
!integer(i_kind) npe,nsz,ival
!    call GSI_BundleGetPointer ( bundle, 'pe', ipe, ierr, ival=ival ) 
     call GSI_BundleGetPointer ( bundle, 'pe', r1pe, ierr )
     if (ierr==0) then
!       nsz=size(bundle%r3(ipe)%q)
!       r1pe => bundle%values(ival:ival+nsz)
        call random_number(r1pe)
     else 
        print*, 'mimic_int_routines: failed'
        call stop2(9)
     endif
end subroutine mimic_int_routines

module control_test
use kinds, only : r_single,r_kind
use gsi_bundlemod, only : GSI_Grid
use gsi_bundlemod, only : GSI_Bundle
implicit none
private
public control
type control
#ifdef _BUNDLE_R4_
  integer :: mykind = r_single
  real(r_single),pointer :: values(:) => null()
#else /* _BUNDLE_R4_ */
  integer :: mykind = r_kind
  real(r_kind),  pointer :: values(:) => null()
#endif /* _BUNDLE_R4_ */
  type(GSI_Grid)   :: grid_main
  type(GSI_Bundle),pointer :: main(:)
  type(GSI_Grid)   :: grid_ensb
  type(GSI_Bundle),pointer :: ensemble(:,:)
end type control
end module control_test
!EOC

!-------------------------------------------------------------------------
!BOP
!
! !IROUTINE:  Ensemble --- Test control-vector-like bundle w/ ensemble component
!
! !INTERFACE:
!
subroutine Ensemble ( )

! !USES:

use kinds, only: i_kind,r_single,r_kind
use gsi_bundlemod, only : GSI_BundleCreate
use gsi_bundlemod, only : GSI_BundleSet
use gsi_bundlemod, only : GSI_BundleGetPointer
use gsi_bundlemod, only : GSI_BundlePutVar
use gsi_bundlemod, only : GSI_Bundle
use gsi_bundlemod, only : GSI_BundleMerge
use gsi_bundlemod, only : GSI_BundlePrint
use gsi_bundlemod, only : GSI_BundleUnSet
use gsi_bundlemod, only : GSI_BundleDestroy

! these should eventually not belog to the bundle
!use gsi_bundlemod, only : GSI_Grid
use gsi_bundlemod, only : GSI_GridCreate

use control_test, only: control
implicit none

! !INPUT/OUTPUT PARAMETERS:

!
! !DESCRIPTION: Test bundles w/ mix of layer- and edge-defined fields 
!               (state-vector-like).
!    \bn
!       \item Input known bundle
!       \item Create new bundle w/ 3d-vectors mix of layer- and level-defined
!       \item Merge known and new bundle into yet another bundle
!       \item Write some fields in the bundle
!       \item Show contents of bundle
!    \en
!
! !REVISION HISTORY:
!
!  22Apr2010 Todling - Initial code
!  28Apr2011 Todling - Now using ensemble as r_single
!
! !REMARKS:
!
! 1) Notice the cpp directive _BUNDLE_R4_ controls whether to use 
!    and REAL*4 or REAL*8 bundle in this example. The cpp directive 
!    is here only for the purposes of this program: GSI should not
!    need it; this is simply due to how I define the control vector
!    in this example (as a combined entity).
!
!EOP
!-------------------------------------------------------------------------
!BOC

character(len=*), parameter :: myname='ensemble'

! These define the regular control vector
integer(i_kind), parameter :: n3d = 4
character(len=4), parameter :: names3d(n3d) = (/  &
                               'sf  ',    &
                               'vp  ',    &
                               't   ',    &
                               'oz  '/)
integer(i_kind), parameter :: n2d = 2
character(len=4), parameter :: names2d(n2d) = (/  &
                               'ps  ',    &
                               'sst '/)

! Lets pretend we have a simple (im,jm,km)-like (regular) grid
integer(i_kind), parameter :: nsubwin=1
integer(i_kind), parameter :: lat2=91
integer(i_kind), parameter :: lon2=144
integer(i_kind), parameter :: nlev=72

! These define the ensemble components of the control vector
integer(i_kind), parameter :: n3d_ens = 2
character(len=4), parameter :: names3d_ens(n3d_ens) = (/  &
                               'sf  ',    &
                               'vp  '/)
integer(i_kind), parameter :: n2d_ens = 1
character(len=4), parameter :: names2d_ens(n2d_ens) = (/  &
                               'ps  '/)

! Lets pretend the ensembe is set on the following grid
integer(i_kind), parameter :: n_ens=2    ! a 2-member ensemble
integer(i_kind), parameter :: lat2_ens=46
integer(i_kind), parameter :: lon2_ens=72
integer(i_kind), parameter :: nlev_ens=64

integer(i_kind)  ierr
integer(i_kind) nn, nval_reg, nval_ens, nval_len, ii
character(len=80) bname

type(control) :: cv

!---------------------------------------------------
! create control vector with added ensemble component
!---------------------------------------------------

! total dimension of control vector
nval_reg = n3d    *lon2    *lat2    *nlev     + n2d    *lon2    *lat2
nval_ens = n3d_ens*lon2_ens*lat2_ens*nlev_ens + n2d_ens*lon2_ens*lat2_ens
nval_len = nval_reg+nval_ens*n_ens
allocate(cv%values(nval_len))
allocate(cv%main(nsubwin))
allocate(cv%ensemble(nsubwin,n_ens))

print*, 'TESTING ENSM  ...'
print*, '-----------------'

! regular part of the control vector ...
ii=0
#ifdef _BUNDLE_R4_
cv%main(1)%valuesR4 => cv%values(ii+1:ii+nval_reg)
#else /* _BUNDLE_R4_ */
cv%main(1)%values   => cv%values(ii+1:ii+nval_reg)
#endif /* _BUNDLE_R4_ */
call GSI_GridCreate ( cv%grid_main, lat2, lon2, nlev )
call GSI_BundleSet  ( cv%main(1), cv%grid_main, 'Regular Part of Control Vector', ierr, &
                                  names2d=names2d,names3d=names3d, bundle_kind=cv%mykind )
if(ierr<0) then
   print*, trim(myname), ': error, cannot define regular part of CV '
   call exit(7) 
endif

! ensemble part of the control vector ...
call GSI_GridCreate ( cv%grid_ensb, lat2_ens, lon2_ens, nlev_ens )
ii=ii+nval_reg
do nn=1,n_ens
#ifdef _BUNDLE_R4_
   cv%ensemble(1,nn)%valuesR4 => cv%values(ii+1:ii+nval_ens)
#else /* _BUNDLE_R4_ */
   cv%ensemble(1,nn)%values   => cv%values(ii+1:ii+nval_ens)
#endif /* _BUNDLE_R4_ */
   write(bname,'(a,i3.3)') 'Ensemble Part of Control Vector Member-',nn
   call GSI_BundleSet  ( cv%ensemble(1,nn), cv%grid_ensb, trim(bname), ierr, &
                                            names2d=names2d_ens,names3d=names3d_ens, &
                                            bundle_kind=cv%mykind )
   if(ierr<0) then
      print*, trim(myname), ': error, cannot member ', nn
      call exit(7) 
   endif
   ii=ii+nval_ens
enddo
! Fill in ensemble-sf w/ something
call mimic_gsi ( cv%ensemble(1,:), n_ens)

! Echo control contents
!call GSI_BundlePrint ( cv%main(1) )
!do nn=1,n_ens
!   call GSI_BundlePrint ( cv%ensemble(1,nn) )
!enddo

!-------------------
! destroy all bundle
!-------------------
do nn=n_ens,1,-1
   call GSI_BundleUnset ( cv%ensemble(1,nn), ierr )
enddo
call GSI_BundleUnset ( cv%main(1), ierr )
deallocate(cv%ensemble)
deallocate(cv%main)
deallocate(cv%values)

end subroutine ensemble
subroutine mimic_gsi ( bundle, n )
use kinds, only: i_kind,r_kind,r_single
use gsi_bundlemod, only: GSI_Bundle
use gsi_bundlemod, only: GSI_BundleGetPointer
use gsi_bundlemod, only: GSI_BundlePrint
implicit none
integer(i_kind),intent(in) :: n
type(gsi_bundle) :: bundle(n)
character(len=*), parameter :: myname='mimic_gsi'
integer(i_kind) nn,ierr
real(r_single),pointer,dimension(:,:,:)::ptr4
real(r_kind),pointer,dimension(:,:,:)::ptr8
if(bundle(1)%AllKinds==r_kind) then
  call GSI_BundleGetPointer ( bundle(1), 'sf', ptr8, ierr ) 
  if(ierr/=0) then
     print*, trim(myname), ': error, cannot find pointer to sf'
     call exit(7)
  endif
  call random_number(ptr8)
else if(bundle(1)%AllKinds==r_single) then
  call GSI_BundleGetPointer ( bundle(1), 'sf', ptr4, ierr ) 
  if(ierr/=0) then
     print*, trim(myname), ': error, cannot find pointer to sf'
     call exit(7)
  endif
  call random_number(ptr4)
else
  print*, trim(myname), ': error, undef kind for bundle'
  call exit(9)
endif
if (n>1) then
   if(bundle(2)%AllKinds==r_kind) then
      call GSI_BundleGetPointer ( bundle(2), 'vp', ptr8, ierr ) 
      call random_number(ptr8)
      if(ierr/=0) then
         print*, trim(myname), ': error, cannot find pointer to vp'
         call exit(7)
      endif
   else if(bundle(2)%AllKinds==r_single) then
      call GSI_BundleGetPointer ( bundle(2), 'vp', ptr4, ierr ) 
      if(ierr/=0) then
         print*, trim(myname), ': error, cannot find pointer to vp'
         call exit(7)
      endif
      call random_number(ptr4)
   else
      print*, trim(myname), ': error, undef kind for bundle'
      call exit(9)
   endif
endif
do nn=1,n
   call GSI_BundlePrint ( bundle(nn) )
enddo
end subroutine mimic_gsi
!EOC