SUBROUTINE BTLNPSR 1
#if defined (DOC)
*
***s/r BTLNPSR  - Constructs grid-point balanced temperature and ps
*                 from input spectral (VORT,DIV)
*     .
* Purpose
*     .  As part of the transform to build the unbalanced temperature and lnps
*        analysis variables.
*
*Author  : Luc Fillion *ARMA/AES  May 15, 1998
*     .
*Revision:
*          Mark Buehner July, 1998
*               Use linear balance for deriving P_b
*		Use empirical operator (P_to_T) derived from regression
*		for P_b-> [T_b Ps_b]
*               Only used in calculating the stats (called from genincr)
*           Y.J. Rochon *ARQX Nov 2008
*                Comment: Needs additions for new balance components (*BAL_*C)!
#endif
C
      IMPLICIT NONE
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comcst.cdk"
#include "comgem.cdk"
#include "comsp.cdk"
#include "comgd1.cdk"
#include "comcorr.cdk"
#include "comcva.cdk"
C
      INTEGER ILON, JLEV, JLON, JLAT, JLA, JK1, JK2
      INTEGER ILEN, IERR
      REAL*8  DLA2, DL1SA2
      REAL*8 ZFACT
C
C COPY VORTICITY OVER TO SP1: REQUIRED BY LINBAL
      CALL TRANSFER('SP01')
C
C USE THE LINEAR BALANCE: INPUT=SPVOR1 OUTPUT=SPGZ
      CALL LINBAL(+1,.FALSE.)
C
C Obtain PSI and CHI out of VOR and DIV
 110  CONTINUE
      DLA2 = DBLE(RA) * DBLE(RA)
      DL1SA2 = 1.D0 / DLA2
      DO JLEV = 1, NFLEV
         DO JLA = 1, NLA
            SPVOR(JLA,1,JLEV) = SPVOR(JLA,1,JLEV)* DLA2*R1SNP1(JLA)
            SPVOR(JLA,2,JLEV) = SPVOR(JLA,2,JLEV)* DLA2*R1SNP1(JLA)
            SPDIV(JLA,1,JLEV) = SPDIV(JLA,1,JLEV)* DLA2*R1SNP1(JLA)
            SPDIV(JLA,2,JLEV) = SPDIV(JLA,2,JLEV)* DLA2*R1SNP1(JLA)
         END DO
      END DO
C
C     . 1.2 Convert PSI and CHI and P_b (in GZ) to physical space
c           Put into GD1, since original TT,lnPs are in GD0
 120  CONTINUE
      CALL SPEREE(NKSDIM,SP,GD1
     S     ,NLA,NIBEG,NIEND,NJBEG,NJEND,NKSDIM)
c
C     . Move PSI and CHI to GD0
      CALL TRANSFER('GD10')
C
C  USE P_TO_T TO DERIVE T_B AND PS_B FROM P_B
      DO JLAT = 1, NJ
        ILON = NILON(JLAT)
        DO JLON = 1, ILON
C  CALCULATE T_B: (IN TT1)
          DO JK1 = 1, NFLEV
            TT1(JLON,JK1,JLAT) = 0.0
            DO JK2 = 1, NFLEVPTOT
              TT1(JLON,JK1,JLAT) = TT1(JLON,JK1,JLAT) +
     +            PTOT(JK1,JK2,JLAT) * GZ1(JLON,JK2,JLAT)
            ENDDO
          ENDDO
C  Calculate Ps_b: (in PS1)
          GPS1(JLON,1,JLAT) = 0.0
          DO JK2 = 1, NFLEVPTOT
            GPS1(JLON,1,JLAT) = GPS1(JLON,1,JLAT) +
     +            PTOT(NFLEV+1,JK2,JLAT)*GZ1(JLON,JK2,JLAT)
          ENDDO
C  CALCULATE CHI_B: (IN VT1)
          DO JK1 = nlev_bdl, NFLEV
             ZFACT = -TAN(THETA(JK1,JLAT))
             IF (JK1.EQ.NFLEV.AND.JLON.EQ.10)
     +         WRITE(NULOUT,*) 'JLAT,THETA,ZFACT=',
     +                         JLAT,THETA(JK1,JLAT),ZFACT
             VT1(JLON,JK1,JLAT) = ZFACT*UT1(JLON,JK1,JLAT)
          ENDDO
        END DO
      END DO
C
      RETURN
      END