!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!

       subroutine rdsptotla 3,4
#if defined (DOC)
*
**s/r rdsptotla -Read in balance operator in spectral space.
*     .
* Purpose
*     .  Read in coefficients for P_to_T operator and also turning angle
*        for balanced divergence operator
*
*Author  : L. Fillion *ARMA/EC  23 Apr, 2008 
*Revision:
*
#endif
      IMPLICIT NONE
*implicits
*
*     Global variables
*
#include "taglam4d.cdk"
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comlun.cdk"
#include "comcva.cdk"
#include "comfftla.cdk"
#include "comcorr.cdk"
#include "rpnstd.cdk"
#include "comoba.cdk"
#include "comoahdr.cdk"
#include "comoabdy.cdk"
*
      integer jk1, jk2, ikey, ilen,jlat,jcol,ilat,jj,iflag,idum
      integer jband
      real*8 znknk(nflev,nflev)
      real*8 zptotlir(nflev+1,nflev)
      real*8 zptot(nflev+1,nflev)
!
      integer vfstlir,vfstecr
      external vfstlir,vfstecr
!
!!
      write(nulout,*) 'rdsptotla: Start Reading in P_TO_T from unit:',nulbgst
!
      ini = nflev + 1
      inj = nflev
      ink = 1
      ip1 = -1
      ip2 = -1 
      ip3 = -1
      idateo = -1
      cltypvar = 'X'
      clnomvar = 'ZZ'
      cletiket = 'P_TO_TJB'
!
      write(nulout,*) 'rdsptotla: Reading a total of spectral band nband =',nband
!
      sptot(:,:,:) = 0.0
!
      do jband = 1, nband
        write(nulout,*) 'rdsptotla: Reading band nb. ',jband
        call zero(ini*inj,zptotlir)
        ip1 = jband
        ierr = vfstlir(zptotlir,nulbgst,ini,inj,ink,idateo,
     &                 cletiket,ip1,ip2,ip3,cltypvar,clnomvar)
!
        if(ierr.lt.0) then
          call abort3d(nulout,'rdsptotla: Problem reading P_TO_TJB field')
        endif
!
        iflag=0
        do jk2 = 1,nflev
          do jk1 = 1, nflev + 1
            sptot(jk1,jk2,jband)=zptotlir(jk1,jk2)
            if(sptot(jk1,jk2,jband).ne.0.0) iflag=iflag+1
          enddo
        enddo
        if(iflag.eq.0) then
          write(nulout,*) 'rdsptotla: SP_TO_T Identically zero for that band'
!          call abort3d(nulout,'rdsptotla: SP_TO_T Identically zero for that band')
        endif
      enddo  ! end loop on jband
!
!
      do jk2 = 1,nflev
        do jk1 = 1, nflev + 1
          zptot(jk1,jk2)=sptot(jk1,jk2,1)
          znknk(jk1,jk2)=sptot(jk1,jk2,1)
        enddo
      enddo
!
      call zero(nflev*nflev,znknk)
      do jk2 = 1,nflev
        do jk1 = 1, nflev
          znknk(jk1,jk2)=sptot(jk1,jk2,1)
        enddo
      enddo
!
!      do jband = 1, nband
!        do jk2 = 1, nflev
!          znknk(1,jk2)=sptot(2,jk2,1)
!          do jj = 1, nj
!            ptot(1,jk2,jj)=ptot(2,jk2,jj)   ! ignore LAM model top's Level = 1 behaviour... set as Level 2.
!          enddo
!        enddo
!      enddo
!
!      call outhoriz2d(zptot,'ptot.od     ','PT',1,
!     &                1,nflev+1,1,nflev,nflev+1,nflev,1)
!      call outhoriz2d(znknk,'ptot_nknk.od','PT',1,
!     &                1,nflev,1,nflev,nflev,nflev,1)
!
      write(nulout,*)'DONE in rdsptotla'
!
      return
      end