subroutine abmass(pgdpsi,pgdchi) 1
#if defined (DOC)
*
***s/r abmass  - Adjoint of bmass:
*                Constructs Adjoint grid-point balanced (PSI,CHI)
*                from input grid-point adjoint balanced temperature and lnps vrbls.
*                N.B.: Values of adjoint vrbls (PSI,CHI) on entry assumed in (arguments) resp.
*     .
* Purpose
*     .  As part of the transform to build the adjoint of unbalanced temperature and lnps
*        analysis variables.
*
*Author  : Luc Fillion/Mark Buehner *ARMA/AES  Jul 20, 1998
*
*Revision: L. Fillion - *ARMA/AES- 4 mar 1999
*           . Add adjoint of temperature filter
*
*          C. Charette *ARMA/AES SEP 1999
*          - Operator PTOT as a function of latitude
*          P. Koclas JP Toviessi Apr 2003
*            -add openmp for ibm conversion
*          Y.J. Rochon *ARQX Nov 2008
*            - Addition of new balance components
*
*Arguments:
*
*Out
*    pgdpsi : Grid-point values of adjoint variable PSI*
*    pgdchi : Grid-point values of adjoint variable CHI*
*     .
*Revision:
#endif
C
      IMPLICIT NONE
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comcst.cdk"
#include "comleg.cdk"
#include "comgem.cdk"
#include "comgd0.cdk"
#include "comcorr.cdk"
#include "comcva.cdk"
C
      real*8 pgdpsi(NIBEG:NIEND,nflev,NJBEG:NJEND)
      real*8 pgdchi(NIBEG:NIEND,nflev,NJBEG:NJEND)
*
      INTEGER ILON, JLEV, JLON, JLAT, jk1, jk2, ilen, ierr
      REAL*8    zcon,ZCORIOLIS
      REAL*8    zp(NIBEG:NIEND,nflev,NJBEG:NJEND)
      POINTER (pxzp,zp)
*
*modules
      external hpalloc
C
C     1. Allocate ZP array
C     ---------------------
C
 100  CONTINUE
      ILEN=(NJEND-NJBEG+1)*NFLEV*(NIEND-NIBEG+1)
      CALL HPALLOC(pxzp,MAX(1,ILEN),IERR,8)
C
C     2. (PSI)* = (PSI)* + Ht Nt (T,lnps)*
C     ------------------------------------
C
 200  CONTINUE
C
C     2.1 Compute adjoint of T filering
C
cluc        call attflt(zp(1,1,1))
C
C     2.2 Compute Nt (T,lnps)*, Result in zp
C
!$OMP PARALLEL DO PRIVATE(ILON,JLAT,JLON,jk1,jk2)
!$OMP+ PRIVATE(jlev,zcoriolis)
        DO JLAT = 1, NJ
          ILON = NILON(JLAT)
C
          zp(1:ILON,1:NFLEV,jlat) = 0.0

          if (ibal_utpp_uc.eq.1.and.ibal_tbpp_cc.eq.1) then
             DO JLON = 1, ILON
             do jk1=1,NFLEVPTOT
               zp(jlon,jk1,jlat)=zp(jlon,jk1,jlat)
     +          +sum(PtoT(1:nflev,jk1,jlat)
     +          *bal_tbpp_cc(1:nflev,jlat)*pGDCHI(jlon,1:nflev,jlat))
             end do
C
             do jk1=1,NFLEVPTOT
               pGDCHI(jlon,jk1,jlat)=pGDCHI(jlon,jk1,jlat)
     +          +bal_utpp_uc(jk1,jlat)*tt0(jlon,jk1,jlat)
             end do
C
             END DO
          else if (ibal_utpp_uc.eq.1) then
             DO JLON = 1, ILON
             do jk1=1,NFLEVPTOT
                pgDCHI(jlon,jk1,jlat)=pGDCHI(jlon,jk1,jlat)
     +             +bal_utpp_uc(jk1,jlat)*tt0(jlon,jk1,jlat)
             end do
             END DO
          end if
C
          DO JLON = 1, ILON
            do jk1=1,NFLEVPTOT
              zp(jlon,jk1,jlat) = 0.0	    
              do jk2=1,NFLEV
                zp(jlon,jk1,jlat) = zp(jlon,jk1,jlat)+
     +            PtoT(jk2,jk1,jlat)*tt0(jlon,jk2,jlat)
              enddo
            enddo
            do jk1=1,NFLEVPTOT
              zp(jlon,jk1,jlat) = zp(jlon,jk1,jlat)+
     +          PtoT(NFLEV+1,jk1,jlat)*gps0(jlon,1,jlat)
            enddo
          END DO
C
C     2.3 Compute (PSI)* = (PSI)* + Ht Nt (T,lnps)*

C
          ZCORIOLIS = 2.*ROMEGA*RMU(JLAT)
          DO JLEV = 1, NFLEVPTOT
            DO JLON = 1, ILON
              pGDPSI(JLON,JLEV,JLAT) = ZCORIOLIS*zp(JLON,JLEV,JLAT)
     S             + pGDPSI(JLON,JLEV,JLAT)
c              pGDCHI(JLON,JLEV,JLAT) = pGDCHI(JLON,JLEV,JLAT)
            END DO
          END DO

        END DO  ! Loop over JLAT
!$OMP END PARALLEL DO
C
C      3. Deallocate local array
C     -------------------------
C
 300  CONTINUE
       CALL HPDEALLC(pxzp,IERR,1)
       IF(IERR.NE.0)THEN
         CALL ABORT3D(NULOUT,'BMASS: Problem with zp.')
       END IF
C
C
      RETURN
      END