ecearth3/sources/oasis3-mct/lib/mct/mpeu/m_Permuter.F90

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-----------------------------------------------------------------------
! CVS m_Permuter.F90,v 1.4 2004-04-21 22:54:45 jacob Exp
! CVS MCT_2_8_0  
!BOP -------------------------------------------------------------------
!
! !MODULE: m_Permuter - permute/unpermute
!
! !DESCRIPTION:
!
! !INTERFACE:

    module m_Permuter
      implicit none
      private	! except

      public :: permute	
      public :: unpermute

    interface permute; module procedure	&
	permutei_,	&	! integer in place
	permuteio_,	&	! integer with an output
	permutei1_,	&	! integer in place
	permuteio1_,	&	! integer with an output
	permuter_,	&	! real in place
	permutero_,	&	! real with an output
	permuter1_,	&	! real in place
	permutero1_,	&	! real with an output
	permuted_,	&	! dble in place
	permutedo_,	&	! dble with an output
	permuted1_,	&	! dble in place
	permutedo1_,	&	! dble with an output
	permutel_,	&	! logical in place
	permutelo_,	&	! logical with an output
	permutel1_,	&	! logical in place
	permutelo1_		! logical with an output
    end interface

    interface unpermute; module procedure	&
	unpermutei_,	&	! integer in place
	unpermuteio_,	&	! integer with an output
	unpermutei1_,	&	! integer in place
	unpermuteio1_,	&	! integer with an output
	unpermuter_,	&	! real in place
	unpermutero_,	&	! real with an output
	unpermuter1_,	&	! real in place
	unpermutero1_,	&	! real with an output
	unpermuted_,	&	! dble in place
	unpermutedo_,	&	! dble with an output
	unpermuted1_,	&	! dble in place
	unpermutedo1_,	&	! dble with an output
	unpermutel_,	&	! logical in place
	unpermutelo_,	&	! logical with an output
	unpermutel1_,	&	! logical in place
	unpermutelo1_		! logical with an output
    end interface

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname='MCT(MPEU)::m_Permuter'

contains

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permutei_ - permute an integer array according to indx[]
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permutei_(ary,indx,n)
      use m_die
      implicit none
      integer,dimension(:),intent(inout) :: ary
      integer,dimension(:),intent(in)    :: indx
      integer,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permutei_'

  integer,allocatable,dimension(:) :: wk
  integer :: i,ier

  allocate(wk(n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call permuteio_(wk,ary,indx,n)

  do i=1,n
    ary(i)=wk(i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine permutei_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permuteio_ - permute an integer array according to indx[]
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permuteio_(aout,ary,indx,n)
      implicit none
      integer,dimension(:),intent(inout) :: aout
      integer,dimension(:),intent(in ) :: ary
      integer,dimension(:),intent(in)  :: indx
      integer,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permuteio_'

  integer :: i,l

  do i=1,n
    l=indx(i)
    aout(i)=ary(l)
  end do

end subroutine permuteio_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermutei_ - unpermute a _permuted_ integer array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermutei_(ary,indx,n)
      use m_die
      implicit none
      integer,dimension(:),intent(inout) :: ary
      integer,dimension(:),intent(in)    :: indx
      integer,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermutei_'

  integer,allocatable,dimension(:) :: wk
  integer :: i,ier

  allocate(wk(n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call unpermuteio_(wk,ary,indx,n)

  do i=1,n
    ary(i)=wk(i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine unpermutei_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermuteio_ - unpermute a _permuted_ integer array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermuteio_(aout,ary,indx,n)
      implicit none
      integer,dimension(:),intent(inout) :: aout
      integer,dimension(:),intent(in)  :: ary
      integer,dimension(:),intent(in)  :: indx
      integer,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermuteio_'

  integer :: i,l

  do i=1,n
    l=indx(i)
    aout(l)=ary(i)
  end do

end subroutine unpermuteio_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permuter_ - permute a real array according to indx[]
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permuter_(ary,indx,n)
      use m_die
      use m_realkinds,only : SP
      implicit none
      real(SP),dimension(:),intent(inout) :: ary
      integer ,dimension(:),intent(in)    :: indx
      integer ,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permuter_'

  real(kind(ary)),allocatable,dimension(:) :: wk
  integer :: i,ier

  allocate(wk(n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call permutero_(wk,ary,indx,n)

  do i=1,n
    ary(i)=wk(i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine permuter_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permutero_ - permute a real array according to indx[]
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permutero_(aout,ary,indx,n)
      use m_realkinds,only : SP
      implicit none
      real(SP),dimension(:),intent(inout) :: aout
      real(SP),dimension(:),intent(in)  :: ary
      integer ,dimension(:),intent(in)  :: indx
      integer ,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permutero_'

  integer :: i,l

  do i=1,n
    l=indx(i)
    aout(i)=ary(l)
  end do

end subroutine permutero_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermuter_ - unpermute a _permuted_ real array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermuter_(ary,indx,n)
      use m_die
      use m_realkinds,only : SP
      implicit none
      real(SP),dimension(:),intent(inout) :: ary
      integer ,dimension(:),intent(in)    :: indx
      integer ,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermuter_'

  real(kind(ary)),allocatable,dimension(:) :: wk
  integer :: i,ier

  allocate(wk(n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call unpermutero_(wk,ary,indx,n)

  do i=1,n
    ary(i)=wk(i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine unpermuter_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermutero_ - unpermute a _permuted_ real array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermutero_(aout,ary,indx,n)
      use m_realkinds,only : SP
      implicit none
      real(SP),dimension(:),intent(inout) :: aout
      real(SP),dimension(:),intent(in)  :: ary
      integer ,dimension(:),intent(in)  :: indx
      integer ,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermutero_'

  integer :: i,l

  do i=1,n
    l=indx(i)
    aout(l)=ary(i)
  end do

end subroutine unpermutero_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permuted_ - permute a double precision array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permuted_(ary,indx,n)
      use m_die
      use m_realkinds,only : DP
      implicit none
      real(DP),dimension(:),intent(inout) :: ary
      integer ,dimension(:),intent(in)    :: indx
      integer ,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permuted_'

  real(kind(ary)),allocatable,dimension(:) :: wk
  integer :: i,ier

  allocate(wk(n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call permutedo_(wk,ary,indx,n)

  do i=1,n
    ary(i)=wk(i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine permuted_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permutedo_ - permute a double precision array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permutedo_(aout,ary,indx,n)
      use m_realkinds,only : DP
      implicit none
      real(DP),dimension(:),intent(inout) :: aout
      real(DP),dimension(:),intent(in)  :: ary
      integer ,dimension(:),intent(in)  :: indx
      integer ,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permutedo_'

  integer :: i,l

  do i=1,n
    l=indx(i)
    aout(i)=ary(l)
  end do

end subroutine permutedo_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermuted_ - unpermute a double precision array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermuted_(ary,indx,n)
      use m_die
      use m_realkinds,only : DP
      implicit none
      real(DP),dimension(:),intent(inout) :: ary
      integer ,dimension(:),intent(in)    :: indx
      integer ,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermuted_'

  real(kind(ary)),allocatable,dimension(:) :: wk
  integer :: i,ier

  allocate(wk(n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call unpermutedo_(wk,ary,indx,n)

  do i=1,n
    ary(i)=wk(i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine unpermuted_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermutedo_ - unpermute a double precision array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermutedo_(aout,ary,indx,n)
      use m_realkinds,only : DP
      implicit none
      real(DP),dimension(:),intent(inout) :: aout
      real(DP),dimension(:),intent(in)  :: ary
      integer ,dimension(:),intent(in)  :: indx
      integer ,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermutedo_'

  integer :: i,l

  do i=1,n
    l=indx(i)
    aout(l)=ary(i)
  end do

end subroutine unpermutedo_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permutel_ - permute a real array according to indx[]
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permutel_(ary,indx,n)
      use m_die
      implicit none
      logical,dimension(:),intent(inout) :: ary
      integer,dimension(:),intent(in)    :: indx
      integer,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permutel_'

  logical,allocatable,dimension(:) :: wk
  integer :: i,ier

  allocate(wk(n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call permutelo_(wk,ary,indx,n)

  do i=1,n
    ary(i)=wk(i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine permutel_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permutelo_ - permute a real array according to indx[]
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permutelo_(aout,ary,indx,n)
      implicit none
      logical,dimension(:),intent(inout) :: aout
      logical,dimension(:),intent(in)  :: ary
      integer,dimension(:),intent(in)  :: indx
      integer,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permutelo_'

  integer :: i,l

  do i=1,n
    l=indx(i)
    aout(i)=ary(l)
  end do

end subroutine permutelo_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermutel_ - unpermute a _permuted_ logical array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermutel_(ary,indx,n)
      use m_die
      implicit none
      logical,dimension(:),intent(inout) :: ary
      integer,dimension(:),intent(in)    :: indx
      integer,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermutel_'

  logical,allocatable,dimension(:) :: wk
  integer :: i,ier

  allocate(wk(n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call unpermutelo_(wk,ary,indx,n)

  do i=1,n
    ary(i)=wk(i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine unpermutel_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermutelo_ - unpermute a _permuted_ logical array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermutelo_(aout,ary,indx,n)
      implicit none
      logical,dimension(:),intent(inout) :: aout
      logical,dimension(:),intent(in)  :: ary
      integer,dimension(:),intent(in)  :: indx
      integer,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermutelo_'

  integer :: i,l

  do i=1,n
    l=indx(i)
    aout(l)=ary(i)
  end do

end subroutine unpermutelo_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permutei1_ - permute an integer array according to indx[]
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permutei1_(ary,indx,n)
      use m_die
      implicit none
      integer,dimension(:,:),intent(inout) :: ary
      integer,dimension(:),intent(in)    :: indx
      integer,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permutei1_'

  integer,allocatable,dimension(:,:) :: wk
  integer :: i,l,ier

  l=size(ary,1)
  allocate(wk(l,n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call permuteio1_(wk,ary,indx,n)

  do i=1,n
    ary(:,i)=wk(:,i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine permutei1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permuteio1_ - permute an integer array according to indx[]
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permuteio1_(aout,ary,indx,n)
      implicit none
      integer,dimension(:,:),intent(inout) :: aout
      integer,dimension(:,:),intent(in ) :: ary
      integer,dimension(:),intent(in)  :: indx
      integer,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permuteio1_'

  integer :: i,l,m

  m=min(size(aout,1),size(ary,1))
  do i=1,n
    l=indx(i)
    aout(1:m,i)=ary(1:m,l)
  end do

end subroutine permuteio1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermutei1_ - unpermute a _permuted_ integer array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermutei1_(ary,indx,n)
      use m_die
      implicit none
      integer,dimension(:,:),intent(inout) :: ary
      integer,dimension(:),intent(in)    :: indx
      integer,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermutei1_'

  integer,allocatable,dimension(:,:) :: wk
  integer :: i,l,ier

  l=size(ary,1)
  allocate(wk(l,n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call unpermuteio1_(wk,ary,indx,n)

  do i=1,n
    ary(:,i)=wk(:,i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine unpermutei1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermuteio1_ - unpermute a _permuted_ integer array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermuteio1_(aout,ary,indx,n)
      implicit none
      integer,dimension(:,:),intent(inout) :: aout
      integer,dimension(:,:),intent(in)  :: ary
      integer,dimension(:),intent(in)  :: indx
      integer,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermuteio1_'

  integer :: i,l,m

  m=min(size(aout,1),size(ary,1))
  do i=1,n
    l=indx(i)
    aout(1:m,l)=ary(1:m,i)
  end do

end subroutine unpermuteio1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permuter1_ - permute a real array according to indx[]
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permuter1_(ary,indx,n)
      use m_die
      use m_realkinds,only : SP
      implicit none
      real(SP),dimension(:,:),intent(inout) :: ary
      integer ,dimension(:),intent(in)    :: indx
      integer ,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permuter1_'

  real(kind(ary)),allocatable,dimension(:,:) :: wk
  integer :: i,l,ier

  l=size(ary,1)
  allocate(wk(l,n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call permutero1_(wk,ary,indx,n)

  do i=1,n
    ary(:,i)=wk(:,i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine permuter1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permutero1_ - permute a real array according to indx[]
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permutero1_(aout,ary,indx,n)
      use m_realkinds,only : SP
      implicit none
      real(SP),dimension(:,:),intent(inout) :: aout
      real(SP),dimension(:,:),intent(in)  :: ary
      integer ,dimension(:),intent(in)  :: indx
      integer ,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permutero1_'

  integer :: i,l,m

  m=min(size(aout,1),size(ary,1))
  do i=1,n
    l=indx(i)
    aout(1:m,i)=ary(1:m,l)
  end do

end subroutine permutero1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermuter1_ - unpermute a _permuted_ real array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermuter1_(ary,indx,n)
      use m_die
      use m_realkinds,only : SP
      implicit none
      real(SP),dimension(:,:),intent(inout) :: ary
      integer ,dimension(:),intent(in)    :: indx
      integer ,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermuter1_'

  real(kind(ary)),allocatable,dimension(:,:) :: wk
  integer :: i,l,ier

  l=size(ary,1)
  allocate(wk(l,n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call unpermutero1_(wk,ary,indx,n)

  do i=1,n
    ary(:,i)=wk(:,i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine unpermuter1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermutero1_ - unpermute a _permuted_ real array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermutero1_(aout,ary,indx,n)
      use m_realkinds,only : SP
      implicit none
      real(SP),dimension(:,:),intent(inout) :: aout
      real(SP),dimension(:,:),intent(in)  :: ary
      integer ,dimension(:),intent(in)  :: indx
      integer ,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermutero1_'

  integer :: i,l,m

  m=min(size(aout,1),size(ary,1))
  do i=1,n
    l=indx(i)
    aout(1:m,l)=ary(1:m,i)
  end do

end subroutine unpermutero1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permuted1_ - permute a double precision array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permuted1_(ary,indx,n)
      use m_die
      use m_realkinds,only : DP
      implicit none
      real(DP),dimension(:,:),intent(inout) :: ary
      integer ,dimension(:),intent(in)    :: indx
      integer ,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permuted1_'

  real(kind(ary)),allocatable,dimension(:,:) :: wk
  integer :: i,l,ier

  l=size(ary,1)
  allocate(wk(l,n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call permutedo1_(wk,ary,indx,n)

  do i=1,n
    ary(:,i)=wk(:,i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine permuted1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permutedo1_ - permute a double precision array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permutedo1_(aout,ary,indx,n)
      use m_realkinds,only : DP
      implicit none
      real(DP),dimension(:,:),intent(inout) :: aout
      real(DP),dimension(:,:),intent(in)  :: ary
      integer ,dimension(:),intent(in)  :: indx
      integer ,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permutedo1_'

  integer :: i,l,m

  m=min(size(aout,1),size(ary,1))
  do i=1,n
    l=indx(i)
    aout(1:m,i)=ary(1:m,l)
  end do

end subroutine permutedo1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermuted1_ - unpermute a double precision array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermuted1_(ary,indx,n)
      use m_die
      use m_realkinds,only : DP
      implicit none
      real(DP),dimension(:,:),intent(inout) :: ary
      integer ,dimension(:),intent(in)    :: indx
      integer ,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermuted1_'

  real(kind(ary)),allocatable,dimension(:,:) :: wk
  integer :: i,l,ier

  l=size(ary,1)
  allocate(wk(l,n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call unpermutedo1_(wk,ary,indx,n)

  do i=1,n
    ary(:,i)=wk(:,i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine unpermuted1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermutedo1_ - unpermute a double precision array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermutedo1_(aout,ary,indx,n)
      use m_realkinds,only : DP
      implicit none
      real(DP),dimension(:,:),intent(inout) :: aout
      real(DP),dimension(:,:),intent(in)  :: ary
      integer ,dimension(:),intent(in)  :: indx
      integer ,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermutedo1_'

  integer :: i,l,m

  m=min(size(aout,1),size(ary,1))
  do i=1,n
    l=indx(i)
    aout(1:m,l)=ary(1:m,i)
  end do

end subroutine unpermutedo1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permutel1_ - permute a real array according to indx[]
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permutel1_(ary,indx,n)
      use m_die
      implicit none
      logical,dimension(:,:),intent(inout) :: ary
      integer,dimension(:),intent(in)    :: indx
      integer,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permutel1_'

  logical,allocatable,dimension(:,:) :: wk
  integer :: i,l,ier

  l=size(ary,1)
  allocate(wk(l,n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call permutelo1_(wk,ary,indx,n)

  do i=1,n
    ary(:,i)=wk(:,i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine permutel1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: permutelo1_ - permute a real array according to indx[]
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine permutelo1_(aout,ary,indx,n)
      implicit none
      logical,dimension(:,:),intent(inout) :: aout
      logical,dimension(:,:),intent(in)  :: ary
      integer,dimension(:),intent(in)  :: indx
      integer,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::permutelo1_'

  integer :: i,l,m

  m=min(size(aout,1),size(ary,1))
  do i=1,n
    l=indx(i)
    aout(1:m,i)=ary(1:m,l)
  end do

end subroutine permutelo1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermutel1_ - unpermute a _permuted_ logical array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermutel1_(ary,indx,n)
      use m_die
      implicit none
      logical,dimension(:,:),intent(inout) :: ary
      integer,dimension(:),intent(in)    :: indx
      integer,             intent(in)    :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermutel1_'

  logical,allocatable,dimension(:,:) :: wk
  integer :: i,l,ier

  l=size(ary,1)
  allocate(wk(l,n),stat=ier)
	if(ier/=0) call perr_die(myname_,'allocate()',ier)

  call unpermutelo1_(wk,ary,indx,n)

  do i=1,n
    ary(:,i)=wk(:,i)
  end do

  deallocate(wk,stat=ier)
	if(ier/=0) call perr_die(myname_,'deallocate()',ier)

end subroutine unpermutel1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: unpermutelo1_ - unpermute a _permuted_ logical array
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine unpermutelo1_(aout,ary,indx,n)
      implicit none
      logical,dimension(:,:),intent(inout) :: aout
      logical,dimension(:,:),intent(in)  :: ary
      integer,dimension(:),intent(in)  :: indx
      integer,             intent(in)  :: n

! !REVISION HISTORY:
! 	25Aug99	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::unpermutelo1_'

  integer :: i,l,m

  m=min(size(aout,1),size(ary,1))
  do i=1,n
    l=indx(i)
    aout(1:m,l)=ary(1:m,i)
  end do

end subroutine unpermutelo1_

end module m_Permuter