!-------------------------------------- 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 p2tpsb(ptb,ppsb,ppb,cdtype,ldhydro,ldpsb) 4,4
#if defined (DOC)
*
***s/r p2tpsb  - For LAM4D: Constructs grid-point balanced temperature and ps from Mass variable PPB.
*     .
* Purpose
*     .  As part of the transform to build the unbalanced temperature and lnps
*        analysis variables.
*
*Author  : Luc Fillion *ARMA/MSC - 29 Sep 2005.
*     .
*Revision:
*   Luc Fillion *ARMA/EC - 23 Apr 2008 - Implement spectral Ptot method.
#endif
C
      IMPLICIT NONE
#include "taglam4d.cdk"
#include "comlun.cdk"
#include "comdim.cdk"
#include "comcst.cdk"
#include "comcva.cdk"
#include "comcorr.cdk"
#include "comfftla.cdk"
#include "comode.cdk"
#include "compdg.cdk"
!
      logical ldhydro,ldpsb
      character*2 cdtype
      real*8 ptb(ni,nflev,nj)
      real*8 ppsb(ni,nj)
      real*8 ppb(ni,nflev,nj)
!
      integer ji,jj,jk,jk1,jk2,jm,jband,ila
      integer ILEN, IERR
      real*8  DLA2, DL1SA2
      real*8 ZFACT,zcon
      real*8 zsppb(nla,2,nflev)
      real*8 zsptb(nla,2,nflev)
      real*8 zspsb(nla,2)
      real*8 zpsg(ni,nj)
!
!!
      write(nulout,*) 'p2tpsb: CPTOT specified in namcva and read by sudim = ',CPTOT
      zcon = -1./rd
      ptb(:,:,:) = 0.0
      ppsb(:,:) = 0.0
!
      if(cdtype.eq.'GD') then
!
! TB
        if(ldhydro) then
          do jj = 1, nj
            do ji = 1, ni
!              zpsg(ji,jj) = 1.e5
              zpsg(ji,jj) = gpsg(ji,1,jj)
            enddo
          enddo
          do jk = 1,nflev
            write(nulout,*) 'p2tpsb: jk,ppb(1,jk,1)=',jk,ppb(1,jk,1)
          enddo
          call lphi2ttgd(ptb,ppb,zpsg)
        else
          do jj = 1, nj
            do ji = 1, ni
              do jk1 = 1, nflev
                ptb(ji,jk1,jj) = 0.0
                do jk2 = 1, nflev
                  ptb(ji,jk1,jj) = ptb(ji,jk1,jj) +
     &                ptot(jk1,jk2,jj) * ppb(ji,jk2,jj)
                enddo
              enddo
            enddo
          enddo
        endif
!
! PSB
        if(ldpsb) then
          do jj = 1, nj
            do ji = 1, ni
              ppsb(ji,jj) = 0.0
              do jk2 = 1, nflev
                ppsb(ji,jj) = ppsb(ji,jj) +
     &              ptot(nflev+1,jk2,jj)*ppb(ji,jk2,jj)
              enddo
            enddo
          enddo
        endif
!
      else if(cdtype.eq.'SP') then
!
        call re2spla(zsppb,ppb,nflev)  ! Build spectral Pb
!
        zsptb(:,:,:) = 0.0
!
        do jband = 2, nband  ! Band 1 is excluded since zero wvnb is undetermined in Pb from PSI info ...
          do jm = 1, mbandsp(jband)
            ila=mila(jm,jband)
            do jk1 = 1, nflev
              do jk2 = 1, nflev
                zsptb(ila,1,jk1) = zsptb(ila,1,jk1) +
     &              sptot(jk1,jk2,jband) * zsppb(ila,1,jk2)
              enddo
            enddo
            zspsb(ila,1) = 0.0
            zspsb(ila,2) = 0.0
            do jk2 = 1, nflev
              zspsb(ila,1) = zspsb(ila,1) +
     &              sptot(nflev+1,jk2,jband)*zsppb(ila,1,jk2)
            enddo
          enddo ! end loop on jm
        enddo ! end loop on jband
!
        call sp2rela(ptb,zsptb,nflev)
        call sp2rela(ppsb,zspsb,1)
      endif
!
      return
      end