SUBROUTINE BALVERTIAD(PSPZZP,YDSPEC)

!      BALVERTIAD - Recombine balanced and unbalanced fields, adjoint of inverse

!     Purpose. Transform from full fields to unbal div, unbal (T,ps) and
!              unbal O3, adjoint
!     --------

!     Arguments.
!     ----------
!       Output : PSPZZP(NFLEVG,NSPEC2) - balanced P values for BALSTAT

!     Externals. TRMTOS MXMAOP TRSTOM
!     ----------

!     Method. (The inversion relies on block matrix algebra)
!     -------
!       Solve statistical balance equation in spectral space
!       to convert vorticity into geopotential(P) and divergence.
!            (total = balanced + unbalanced )
!         The balance leads from correlation space :
!            (total Vor, unbal Div, unbal T/ps, unbal O3)
!         To model space :
!            (total Vor, total Div, total T/ps, total O3)
!         In 2 steps :

!       (1)     [P]tot = [A].[Vor]tot  (A=tridiag matrix for each m)
!                                      (Pt=total mass)

!       (2)  [T,ps]tot = [T,ps]unbal + [B].[P]tot + [C].[Div]unbal
!            [Div]tot  = [Div]unbal  + [D].[P]tot
!            [O3]tot   = [O3]unbal   + [E].[P]tot

!               (B,C,D,E=full vertical matrices for each n)

!        This routine is adjoint of step 2. Step 1 is adjointed in BALSTAT.

!     Author. Francois Bouttier *ECMWF*
!     -------

!     Modifications.
!     --------------
!        F. Bouttier   96-12-13 write original
!        E. Holm       97-10-01 include ozone balance
!        M.Hamrud      03-08-01 GFL introduction
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        M.Fisher      08-Jun-2005 Generalize Jb for GEMS
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVG   ,NFLSUR   ,NSPEC2
USE YOMLAP   , ONLY : NVALUE
USE YOMJG    , ONLY : STPS     ,SDIV     ,SO3 ,SPJB_VARS_INFO, &
                    & N_SPJB_VARS
USE YOMMP    , ONLY : MYSETN   ,NPTRSV   ,NSPEC2V, NPSP
USE YOMGRB   , ONLY : NGRBO3
USE YOMCVA   , ONLY : NVA3D
USE SPECTRAL_FIELDS_MOD

!     ------------------------------------------------------------------

IMPLICIT NONE

REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSPZZP(NFLSUR,NSPEC2) 
TYPE(SPECTRAL_FIELD), INTENT(INOUT) :: YDSPEC

!     ------------------------------------------------------------------

INTEGER(KIND=JPIM) :: IN, JSP

REAL(KIND=JPRB) :: ZIN(2*NFLEVG),ZBUF(NFLEVG)
REAL(KIND=JPRB) :: ZTPS(NFLEVG+1),ZDIV(NFLEVG),ZO3(NFLEVG)
REAL(KIND=JPRB) :: ZSZPG(NFLEVG,NSPEC2V), ZSDIVG(NFLEVG,NSPEC2V)
REAL(KIND=JPRB) :: ZSPTG(NFLEVG,NSPEC2V)
REAL(KIND=JPRB), ALLOCATABLE :: ZSO3G(:,:,:)
REAL(KIND=JPRB) :: ZSP(NSPEC2)
REAL(KIND=JPRB) :: ZSPSPG(NSPEC2V)
LOGICAL         :: LLSELECT3D(NVA3D)
INTEGER(KIND=JPIM) :: JFIELD

REAL(KIND=JPRB) :: ZHOOK_HANDLE

!     ------------------------------------------------------------------

INTERFACE
#include "mxmaop.h"
END INTERFACE

#include "trmtos.intfb.h"
#include "trstom.intfb.h"

!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('BALVERTIAD',0,ZHOOK_HANDLE)

!     ------------------------------------------------------------------

!     1.    Transpose data to vertical columns
!           ----------------------------------


LLSELECT3D(:)=.FALSE.
DO JFIELD=1,N_SPJB_VARS
  IF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE==NGRBO3) THEN
    LLSELECT3D(SPJB_VARS_INFO(JFIELD)%IPTJB)=.TRUE.
  ENDIF
ENDDO

ALLOCATE (ZSO3G(NFLEVG,NSPEC2V,COUNT(LLSELECT3D)))
IF (NPSP==1) ZSP=YDSPEC%SPR

CALL TRMTOS (PSPDIV=YDSPEC%DIV,PSPT=YDSPEC%TEM,PSPSEL3D=YDSPEC%SP3D, &
           & PSPSP=ZSP,PSPDIVG=ZSDIVG,PSPTG=ZSPTG,PSPSEL3DG=ZSO3G, &
           & PSPSPG=ZSPSPG, LDSELECT3D=LLSELECT3D)
ZSZPG(:,:)=0.0_JPRB

!     2.    Convert from full fields to P and unbalanced fields
!           ---------------------------------------------------

!           2.3 Ozone

IF (ANY(SPJB_VARS_INFO(:)%IGRIBCODE==NGRBO3)) THEN
  DO JSP=1,NSPEC2V
    IN=NVALUE(JSP+NPTRSV(MYSETN)-1)
    ZO3(1:NFLEVG) = -ZSO3G(1:NFLEVG,JSP,1)
    CALL MXMAOP(SO3(1,1,IN),NFLEVG,1,&
     & ZO3,1,NFLEVG,ZBUF,1,NFLEVG,&
     & NFLEVG,NFLEVG,1)  
    ZSZPG(1:NFLEVG,JSP) = ZSZPG(1:NFLEVG,JSP)+ZBUF(1:NFLEVG)
  ENDDO
ENDIF

DO JSP=1,NSPEC2V
  IN=NVALUE(JSP+NPTRSV(MYSETN)-1)

!           2.2 (T,ps)

  ZTPS(1:NFLEVG) = -ZSPTG(1:NFLEVG,JSP)
  ZTPS(NFLEVG+1) = -ZSPSPG(JSP)
  CALL MXMAOP(STPS(1,1,IN),NFLEVG+1,1,&
   & ZTPS,1,NFLEVG+1,ZIN,1,2*NFLEVG,&
   & 2*NFLEVG,NFLEVG+1,1)  
  ZSZPG(1:NFLEVG,JSP)  = ZSZPG(1:NFLEVG,JSP) + ZIN(1:NFLEVG)
  ZSDIVG(1:NFLEVG,JSP) = ZSDIVG(1:NFLEVG,JSP)+ZIN(NFLEVG+1:2*NFLEVG)

!           2.1 Divergence

  ZDIV(1:NFLEVG) = -ZSDIVG(1:NFLEVG,JSP)
  CALL MXMAOP(SDIV(1,1,IN),NFLEVG,1,&
   & ZDIV,1,NFLEVG,ZBUF,1,NFLEVG,&
   & NFLEVG,NFLEVG,1)  
  ZSZPG(1:NFLEVG,JSP) = ZSZPG(1:NFLEVG,JSP)+ZBUF(1:NFLEVG)

ENDDO

!     3.    Transpose data from vertical columns back to level structure
!           ------------------------------------------------------------

CALL TRSTOM (PSPVORG=ZSZPG,PSPDIVG=ZSDIVG,PSPTG=ZSPTG,PSPSEL3DG=ZSO3G, &
           & PSPSPG=ZSPSPG, PSPVOR=PSPZZP,PSPDIV=YDSPEC%DIV,PSPT=YDSPEC%TEM, &
           & PSPSEL3D=YDSPEC%SP3D, PSPSP=ZSP, LDSELECT3D=LLSELECT3D)

!     ------------------------------------------------------------------

IF (NPSP==1) YDSPEC%SPR=ZSP
DEALLOCATE (ZSO3G)

IF (LHOOK) CALL DR_HOOK('BALVERTIAD',1,ZHOOK_HANDLE)
END SUBROUTINE BALVERTIAD
