subroutine ch_rdbalop(cfile,cnomvar,cetiket, 1,1
     &                      kn1,kn2,pbalop,kndim1,kndim2)
C
      IMPLICIT NONE
C
      character*(*) cnomvar,cfile,cetiket
      integer kn1,kn2,kndim1,kndim2
      real*8 pbalop(kndim2,kndim2,kndim1)
C
#if defined (DOC)
*---------------------------------------------------------
*
***s/r ch_rdbalop - Read and set balance/transformation operator.
*
*Author  : Y.J. Rochon, ARQX/MSC, June 2006
*
*Revision:
*
*    -------------------
*
* PURPOSE: Read and set balance/transformation operator.
*
*Arguments:
*
*   INPUT
*
*          cetiket   :    Etiket
*          cfile     :    File name
*          cnomvar   :    Variable name
*          kndim1    :    Max third dimension of pbalop
*          kndim2    :    Max first & second dimension of pbalop 
*    
*   OUTPUT
*
*          pbalop(kn1,kn2,nj)
*                    :    Balance/transformation operator
*          kn1       :    First dimension of pbalop (must be equal to
*                         1 or nflev)
*          kn2       :    Second dimension of pbalop (must be equal to
*                         nflev)
*
*Comments:
*
*     1) No vertical interpolation performed!
*
*-----------------------------------------------------------
#endif
C
C     Global variables
C
#include "comdim.cdk"  
#include "comlun.cdk" 
#include "comleg.cdk"   
C
C*    Local variables
C
      integer j,j1,idim1,idim2,inum,iun,imaxkeys,ilen,ini,inj,ink,ier
      parameter (idim1=300, idim2=10000, imaxkeys=300)
      integer ikeys(imaxkeys)
      real*4 zbuf(1)
      real*8 zwork(0:idim1,idim2),zwork2(nj,idim2)
      real*8 zleg(0:idim1,nj)
      pointer (ptzbuf, zbuf)
C
C     Externals
C
      integer fstfrm,fstouv,vfstlir,fstinf,fstluk,fclos,fnom,fstinl
      external fstfrm,fstouv,vfstlir,fstinf,fstluk,fclos,fnom,fstinl
C
C*    Check dimensions
C
      if (kndim2*kndim2.gt.idim2.or.kndim1.gt.idim1) 
     &   CALL ABORT3D(NULOUT,'CH_RBBALOP: Dimension too small!')
C
C*    Open operator file and extract required records.
C
      iun=0
      ier = fnom(iun,cfile,'RND',0)
      if (ier.lt.0)
     &   CALL ABORT3D(NULOUT,'CH_RBBALOP: Operator file not found!')
      ier = fstouv(iun,'RND')
      if (ier.lt.0) 
     &   CALL ABORT3D(NULOUT,'CH_RBBALOP: Operator file could not be opened!')
C
      ier = FSTINL(iun,INI,INJ,INK,-1,cetiket,
     &        -1,-1,-1,' ',cnomvar,ikeys,inum,imaxkeys)
      if(inum.le.0.or.ier.lt.0)
     &   CALL ABORT3D(NULOUT,'CH_RBBALOP: Operator not found!')
C
C****
      inum=109
C****
      ilen = ini*inj*ink
      if (ilen.gt.kndim2) 
     &   CALL ABORT3D(NULOUT,'CH_RBBALOP: ILEN>KNDIM2!')
      if (ilen.gt.idim2) 
     &   CALL ABORT3D(NULOUT,'CH_RBBALOP: ILEN>IDIM2!')
      if (inum.gt.idim1) 
     &   CALL ABORT3D(NULOUT,'CH_RBBALOP: inum>idim1!') 
C
      call hpalloc(ptzbuf,max(1,ilen),ier,8)
      do j=1,inum
         ier=fstluk(zbuf,ikeys(j),INI,INJ,INK)
         zwork(j-1,1:ilen) = zbuf(1:ilen)
      end do
      call hpdeallc(ptzbuf,ier,1)
      ier=fstfrm(iun)
      ier=fclos(iun)
C
C*    Evaluate Legendre poly expansions at Gaussian latitude points.
C     (Convert to physical space.)
C
      inum=inum-1
      call zlegpol(zleg,rmu,nj,inum,idim1,nj)
      call zleginv2(zwork2,zwork,zleg,inum,nj,ilen,nj,ilen
     &       ,idim1)
C
C*    Set dimensions
C
      if (INI.gt.1.and.INJ.eq.1.and.INK.eq.1) then
         kn1=1
         kn2=INI
      else if (INI.eq.1.and.INJ.gt.1.and.INK.eq.1) then
         kn1=1  
         kn2=INJ
      else if (INI.eq.1.and.INJ.eq.1.and.INK.gt.1) then
         kn1=1
         kn2=INK
      else if (INI.gt.1.and.INJ.gt.1.and.INK.eq.1) then
         kn1=INI
         kn2=INJ
      else if (INI.eq.1.and.INJ.gt.1.and.INK.gt.1) then
         kn1=INJ
         kn2=INK
      else if (INI.gt.1.and.INJ.eq.1.and.INK.gt.1) then
         kn1=INI
         kn2=INK 
      else
         CALL ABORT3D(NULOUT,'CH_RBBALOP: Case not taken into account!')
      end if
C   
C*    Store in output argument array.
C
      do j=1,nj
      do j1=1,kn2
          pbalop(1:kn1,j1,j)=zwork2(j,(j1-1)*kn1+1:j1*kn1)
      end do
      end do
C
      RETURN
      END