subroutine balptot(pttb,ppsb,pgdpsi,pgdchi, 1
     &                  kibeg,kiend,kjbeg,kjend,knk)
#if defined (DOC)
*
***s/r balptot  - Constructs grid-point balanced temperature and lnps
*                 from input grid-point (PSI,CHI) increments during minimization
*                 using linear-regression matrix PtoT
*     .
* Purpose
*     .  Used in DIAG3DVAR to construct Tb, psb.
*
*Author  : Luc Fillion *ARMA/AES  15 feb 1999
*
*Revision:
*         C. Charette *ARMA/AES  17 feb 1999
*          - Initialize pttb ppsb to zero
*
*          C. Charette *ARMA/AES SEP 1999
*          - Operator PTOT as a function of latitude
*
*          Y.J. Rochon *ARQX Nov 2008
*          - Addition of new balance components
*
*Arguments
*
* In
*    pgdpsi : Grid-point del(PSI)
*    pgdchi : Grid-point del(CHI)
* Out
*    pttb   : Grid-point balanced Temperature increment (del Tb)
*    ppsb   : Grid-point balanced surface-pressure increment (del psb)
*     .
*Revision:
#endif
C
      IMPLICIT NONE
#include "comdim.cdk"
#include "comlun.cdk"
#include "comcst.cdk"
#include "comleg.cdk"
#include "comcorr.cdk"
#include "comcva.cdk"
C
      INTEGER ILON, JLEV, JLON, JLAT, JLA
      integer ilen,ierr,jk1,jk2
      INTEGER KIBEG,KIEND,KJBEG,KJEND,KNK
      REAL*8 pgdpsi(KIBEG:KIEND,KNK,KJBEG:KJEND)
      REAL*8 pgdchi(KIBEG:KIEND,KNK,KJBEG:KJEND)
      REAL*8 pttb(KIBEG:KIEND,KNK,KJBEG:KJEND)
      REAL*8 ppsb(KIBEG:KIEND,1,KJBEG:KJEND)
*
      logical llprint
      integer ik
      REAL*8 zcon,zcoriolis,zetapt,zetae1,zpscon
      REAL*8 zp(ni,nflev,nj),zsum
      POINTER (pxzp,zp)
*
*modules
      external hpalloc
*
**
      llprint = .false.
C
C     1. Allocate ZP array
C     ---------------------
C
 100  CONTINUE
      ILEN=ni*nflev*nj
      CALL HPALLOC(pxzp,MAX(1,ILEN),IERR,8)
C
C     2. (del P)b = f del(PSI)
C     ------------------------
C
 200  CONTINUE
      DO JLEV = 1, NFLEV
        DO JLAT = 1, NJ
          ILON = NI
          ZCORIOLIS = 2.*ROMEGA*RMU(JLAT)
          DO JLON = 1, ILON
            zp(JLON,JLEV,JLAT) = ZCORIOLIS*pGDPSI(JLON,JLEV,JLAT)
          END DO
        END DO
      END DO
c
c     3. Derive T_b and Ps_b from P_b
c     -------------------------------
c
 300  continue
      DO JLAT = 1, NJ
        ILON = NI
        DO JLON = 1, ILON
          do jk1=1,NFLEV
             pttb(jlon,jk1,jlat)= 0.0
          enddo
       ENDDO
      ENDDO
      DO JLAT = 1, NJ
        ILON = NI
        DO JLON = 1, ILON
          ppsb(jlon,1,jlat)= 0.0
        enddo
      ENDDO
c
      DO JLAT = 1, NJ
        ILON = NI
        DO JLON = 1, ILON
          do jk1=1,NFLEV
            do jk2=1,NFLEVPTOT
              pttb(jlon,jk1,jlat)=pttb(jlon,jk1,jlat) +
     +          PtoT(jk1,jk2,jlat)*zp(jlon,jk2,jlat)
            enddo
          enddo
          do jk2=1,NFLEVPTOT
            ppsb(jlon,1,jlat)=ppsb(jlon,1,jlat) +
     +          PtoT(NFLEV+1,jk2,jlat)*zp(jlon,jk2,jlat)
          enddo
        END DO
C
        if (ibal_utpp_uc.eq.1.and.ibal_tbpp_cc.eq.1) then
C
C          pGDCHI is the full del_CHI.
C          Must use pGDCHI-del_CHI_b(PP) below
C
           DO JLON = 1, ILON
           do jk1=1,NFLEV
             pttb(jlon,jk1,jlat)=pttb(jlon,jk1,jlat)
     +          +bal_utpp_uc(jk1,jlat)*(pGDCHI(jlon,jk1,jlat)
     +            -bal_tbpp_cc(jk1,jlat)*pttb(jlon,jk1,jlat))
           end do
           END DO
        else if (ibal_utpp_uc.eq.1) then
C
C          Here, it is assumed that del_CHI_b(PP)=0          
C
           DO JLON = 1, ILON
           do jk1=1,NFLEV
              pttb(jlon,jk1,jlat)=pttb(jlon,jk1,jlat)
     +           +bal_utpp_uc(jk1,jlat)*pGDCHI(jlon,jk1,jlat)
           end do
           END DO
        end if
      END DO
C
C     4. Deallocate local array
C     -------------------------
C
 400  CONTINUE
      CALL HPDEALLC(pxzp,IERR,1)
      IF(IERR.NE.0)THEN
        CALL ABORT3D(NULOUT,'BALPTOT: Problem with zp.')
      END IF
C
C
      RETURN
      END