SUBROUTINE CVAR3IN(YDCV,YDSPEC,PGP3,PGP2,KCOMP,LDJBBAL)

!     Purpose:
!     --------
!       Apply SQRT(B) matrix to control vector.
!       Result is returned in SPA3JB, SPA2JB, SPA1JB, TOVSCVX, ESTPARAM, etc.
!       Remark: content of this routine was in sqrtbin.F90 until CY31.


!     Author.
!     -------
!         Y. Tremolet

!     Modifications.
!     --------------
!       05-03-03: Original
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Fisher      17-Mar-2004 Pass a control vector rather than an array
!        R.El Ouaraini 18-Feb-2004 Beta-plane balance for Aladin
!        R. el Khatib  04-08-05   simplified interface to ebalbeta
!        G. Faure      20-Jan-2006 Non linear and omega balances for LELAM
!        Elias Holm    08-10-20   Add jbchvari call for variable 
!                                 transform (normalized humidity etc). 
!                                 Move Jb coordinate transform besides
!                                 fc-error denormalization in cvargptl.
!        Y.Tremolet    27-Nov-2008 Option for no balance in stratosphere 
!        David Tan     07-Dec-2009 Correct zu for balance in stratosphere 
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMJG    , ONLY : LJBENER , &
 & RAMENER  ,BFACT1   ,BFACT2   ,BFACT, &
 & LJB_NONLINEAR_BALANCE, LJB_OMEGA_BALANCE, &
 & LJBBALBETA, LJB_UNIVARIATE, LBALSTRATO, NLEVBAL0, NLEVBAL1, LJB_NONLINEAR_CVHUM, LJB_NONLINEAR_CVO3
USE YOMSPJB  , ONLY : SP7VOR, SP7T
USE YOMCT0   , ONLY : LELAM
USE YEMLAP   , ONLY : NESM0
USE YOMLAP   , ONLY : NASM0
USE YOMDIM   , ONLY : NFLEVL   ,NFLSUR   ,NSMAX    ,NMSMAX   ,NSPEC2, NFLEVG
USE YOMMP    , ONLY : MYLEVS
USE CONTROL_VECTORS
USE SPECTRAL_FIELDS_MOD

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

IMPLICIT NONE

TYPE(CONTROL_VECTOR), INTENT(IN)    :: YDCV 
TYPE(SPECTRAL_FIELD), INTENT(INOUT) :: YDSPEC
REAL(KIND=JPRB), INTENT(INOUT) :: PGP3(:,:,:),PGP2(:,:,:)
INTEGER(KIND=JPIM), INTENT(IN) :: KCOMP
LOGICAL, OPTIONAL, INTENT(IN) :: LDJBBAL

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

LOGICAL :: LLJBBAL
TYPE(SPECTRAL_FIELD) :: YLUNBAL
INTEGER(KIND=JPIM) :: ii, il, jl
REAL(KIND=JPRB) :: zb,zu
REAL(KIND=JPRB) :: ZZP(NFLSUR,NSPEC2), ZDIV(NFLEVL,NSPEC2)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "balnonlintl.intfb.h"
#include "balomegatl.intfb.h"
#include "balstat.intfb.h"
#include "balvert.intfb.h"
#include "sqrtbin.intfb.h"
#include "sqrtqin.intfb.h"
#include "ebalbeta.intfb.h"
#include "ebalstat.intfb.h"
#include "ebalvert.intfb.h"
#include "ebalnonlintl.intfb.h"
#include "ebalomegatl.intfb.h"
#include "jbchvari.intfb.h"
#include "sualspajb.intfb.h"
!     ------------------------------------------------------------------

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

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

!     3.    Square root of correlation operator
!           -----------------------------------

IF (kcomp==0) THEN
  CALL SQRTBIN(YDCV,YDSPEC,PGP3,PGP2)
ELSE
  il=YDSPEC%nspsizel
  ii=(kcomp-1)*il
  YDSPEC=YDCV%MODERR(ii+1:ii+il)
  CALL SQRTQIN(YDSPEC)
ENDIF

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

!     2.    P to (T,ps) and balance transforms
!           ----------------------------------

LLJBBAL=.true.
IF (PRESENT(LDJBBAL)) LLJBBAL=LDJBBAL
IF (LLJBBAL) THEN
! Switch off balance in stratosphere
  IF (.NOT.LBALSTRATO) THEN
    CALL SUALSPAJB(YLUNBAL)

    DO jl=1,NFLEVL
      il=MYLEVS(jl)
      IF (il<=NLEVBAL1) THEN
        YLUNBAL%SP3D(jl,:,:) = YDSPEC%SP3D(jl,:,:)
      ENDIF
    ENDDO

    DO jl=1,NFLEVL
      il=MYLEVS(jl)
      IF (il<=NLEVBAL0) THEN
        YDSPEC%SP3D(jl,:,:) = 0.0_JPRB
      ELSEIF (il<NLEVBAL1) THEN
        zb=SQRT(REAL(il-NLEVBAL0)/REAL(NLEVBAL1-NLEVBAL0))
        YDSPEC%SP3D(jl,:,:) = zb*YDSPEC%SP3D(jl,:,:)
      ENDIF
    ENDDO
  ENDIF


!     2.    P to (T,ps) and balance transforms
!           ----------------------------------

  IF (.NOT.LJB_UNIVARIATE .AND. .NOT.(LJBENER.OR.(RAMENER >= 0))) THEN
!         Integrated statistical balance option :
!         Infer balanced part of (T,ps) and divergence from vorticity
    IF (LELAM) THEN
      IF (LJB_NONLINEAR_BALANCE) THEN
        CALL EBALNONLINTL (YDSPEC%VOR,SP7VOR,ZZP)
      ELSEIF (LJBBALBETA) THEN
        CALL EBALBETA(YDSPEC%VOR,ZZP)
      ELSE
        CALL EBALSTAT(NMSMAX,NESM0,NSPEC2,YDSPEC%VOR,ZZP,BFACT)
      ENDIF
      CALL EBALVERT(ZZP,YDSPEC=YDSPEC)
      IF (LJB_OMEGA_BALANCE) THEN
        CALL EBALOMEGATL (YDSPEC%VOR,YDSPEC%TEM,SP7VOR,SP7T,ZDIV)
        YDSPEC%DIV(:,:) = YDSPEC%DIV(:,:) + ZDIV(:,:)
      ENDIF
    ELSE
      IF (LJB_NONLINEAR_BALANCE) THEN
        CALL BALNONLINTL (YDSPEC%VOR,SP7VOR,ZZP)
      ELSE
        CALL BALSTAT (NFLEVL,NSMAX,NASM0,NSPEC2,YDSPEC%VOR,YDSPEC%DIV,&
                    & ZZP,BFACT1,BFACT2)
      ENDIF
      CALL BALVERT(ZZP,YDSPEC=YDSPEC)
      IF (LJB_OMEGA_BALANCE) THEN
        CALL BALOMEGATL (YDSPEC%VOR,YDSPEC%TEM,SP7VOR,SP7T,ZDIV)
        YDSPEC%DIV(:,:) = YDSPEC%DIV(:,:) + ZDIV(:,:)
      ENDIF
    ENDIF
  ENDIF

! Switch off balance in stratosphere
  IF (.NOT.LBALSTRATO) THEN
    DO jl=1,NFLEVL
      il=MYLEVS(jl)
      IF (il<=NLEVBAL0) THEN
        YDSPEC%SP3D(jl,:,:) = YLUNBAL%SP3D(jl,:,:)
      ELSEIF (il<NLEVBAL1) THEN
        zb=SQRT(REAL(il-NLEVBAL0)/REAL(NLEVBAL1-NLEVBAL0))
        zu=1.0_JPRB-zb*zb
        YDSPEC%SP3D(jl,:,:) = zb*YDSPEC%SP3D(jl,:,:) + zu*YLUNBAL%SP3D(jl,:,:)
      ENDIF
    ENDDO

    CALL DEALLOCATE_SPEC(YLUNBAL)
  ENDIF

ENDIF

!     1.    Gridpoint variable 'balance' transform and normalization
!           --------------------------------------------------------

IF (LJB_NONLINEAR_CVHUM .OR. LJB_NONLINEAR_CVO3) THEN
  CALL JBCHVARI(YDSPEC%TEM,PGP3)
ENDIF

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

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