SUBROUTINE SQRTQAD(YDSPERR)

!     Purpose:
!     --------
!        Apply adjoint of SQRT(Q) matrix to model error control variable.
!        This subroutine is going from control space to physical space.

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

!     Modifications.
!     --------------
!        Original 06-Oct-2003
!        Y.Tremolet    23-Jul-2004 Change interface
!     ------------------------------------------------------------------

USE PARKIND1, ONLY: JPIM, JPRB
USE YOMHOOK , ONLY: LHOOK, DR_HOOK
USE YOMJQ   , ONLY: LJQHCOR, LJQVCOR, ERRMODMN, ERRVCOR
USE SPECTRAL_FIELDS_MOD

IMPLICIT NONE
TYPE(SPECTRAL_FIELD), INTENT(INOUT) :: YDSPERR

INTEGER(KIND=JPIM) :: jf,js,jl
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "jqhcor.intfb.h"
#include "jqvcor.intfb.h"
#include "spec_imzero.intfb.h"

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

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

! Restrict vertical extent of model error
DO jf=1,YDSPERR%ns2d
  DO js=1,YDSPERR%nspec2
    YDSPERR%SP2D(js,jf) = ERRMODMN%VSURF * YDSPERR%SP2D(js,jf)
  ENDDO
ENDDO

DO jf=1,YDSPERR%ns3d
  DO js=1,YDSPERR%nspec2
    DO jl=1,YDSPERR%nflevl
      YDSPERR%SP3D(jl,js,jf) = ERRMODMN%VALPHA(jl) * YDSPERR%SP3D(jl,js,jf)
    ENDDO
  ENDDO
ENDDO

! Multiply by vertical correlations
IF (LJQVCOR) CALL JQVCOR(YDSPERR, ERRVCOR)

! Multiply by horizontal correlations
IF (LJQHCOR) CALL JQHCOR(YDSPERR)

! Normalisation of model errors (see jgnrsi)
DO jf=1,YDSPERR%ns2d
  DO js=1,YDSPERR%nspec2
    YDSPERR%SP2D(js,jf) = YDSPERR%SP2D(js,jf) * ERRMODMN%V2DINV(jf)
  ENDDO
ENDDO

DO jf=1,YDSPERR%ns3d
  DO js=1,YDSPERR%nspec2
    DO jl=1,YDSPERR%nflevl
      YDSPERR%SP3D(jl,js,jf) = YDSPERR%SP3D(jl,js,jf) * ERRMODMN%V3DINV(jl,jf)
    ENDDO
  ENDDO
ENDDO

CALL SPEC_IMZERO(YDSPERR)

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