SUBROUTINE CVAR2INAD (YDVAZG)

!     CVAR2INAD : Transformation of model fields, inverse adjoint

!     Purpose: Transform from Jb-normalized departures w.r.t. background
!     --------           to model variables

!     Externals: CVARU2IAD BALVERTAD BALSTATAD CVARU3IAD
!     ----------

!     Author.    W. HECKLEY    *ECMWF*
!     -------

!     Modifications:
!     --------------
!        W. HECKLEY    91:09:30  Change in call to STEPO
!        Bill Heckley  06:02:92 - Provision for use of mass variable P
!        Bill Heckley  21:02:92 - Use of eigenvectors of vertical correlations
!        Bill Heckley  15:06:92 - Remove the 2 delta eta wave in the T feled
!        Bill Heckley  04:03:93 - Horizontal Jg correlation computation now a
!                                 part of the control variable.
!        Bill Heckley, Erik Andersson, Philippe Courtier 07:06:93 - revised
!                                 approach to 2 delta eta noise problem
!        Mike Fisher   95-01-20   LSUBFG and CALL MLTEPSINAD
!        Mike Fisher   95-09-20   LMVCHV switch
!        Mats Hamrud   95-12-15   Remove NFGM .ne.1, cleaning
!        Mike Fisher   96-05-30   Reverse order of CVARU2IAD and MLTEPSINAD
!        F. Bouttier   96-07-17   Clean comments
!        John Derber   96-07-17   No call to MLTEPS if LSTABAL
!        John Derber   96-08-27   No call to CVARU2I if LSTABAL
!        F. Bouttier   96-12-13   Change STABAL scalar product
!        Mike Fisher   97-02-21   Simplified Kalman Filter
!        M. Siroka     98-06-16   LSTABAL & LELAM
!        Mike Fisher 2000-10-26   Jb vertical coordinate
!        Mike Fisher 2001-12-03   Omega-equation balance operator
!        Y.Tremolet  2002-08-05   Use control_vectors.
!        D. Dee      2003-12-12   Variational bias correction
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Fisher      17-Mar-2004 Wavelet Jb
!        Y.Tremolet    18-Mar-2004 Model error change of variable
!        Y.Tremolet    10-Jun-2004 Initial condition optional in control vector
!        Y.Tremolet    27-Jul-2004 Improve model error
!        P.Burton :  29-09-04 LVARBC cleanup
!        C. Fischer    21-May-2005 really loop on lam1d cv component and scale by 
!                      its mean wind std dev
!     ------------------------------------------------------------------

USE PARKIND1 , ONLY : JPIM     ,JPRB
USE YOMHOOK  , ONLY : LHOOK,   DR_HOOK
USE YOMCVA   , ONLY : YSCALPSQRT, YRSCALPSQRT, NVATOVV, NVA1D, NVA2D, NVA3D
USE YOMGEM   , ONLY : NGPTOT
USE YOMJG    , ONLY : TMEANUVER, LSPFCE
USE YOMSKF   , ONLY : LSKF     ,NSKFVECS ,YSKFROT   ,YSKFMAT   ,SKFSUBMAT
USE YOMANCS  , ONLY : RMDI
USE YOMVAR   , ONLY : LTOVSCV, LVARBC, LTSCV
USE YOMTVRAD , ONLY : TOVSCVX  ,TOVSCVER,NVATOVLEN
USE YOMSPJB  , ONLY : SPJB
USE YOMDIM   , ONLY : NFLEVL, NFLEVG, NPROMA
USE VARBC_SETUP, ONLY : YVARBC, NOBGROUP, NOBPARAM
USE YOMMODEL_ERROR, ONLY : NDIM_MODERR, SPMODERR, GPMODERR, SPCTLMODERR, SPGPMODERR
USE YOMJQ    , ONLY : LQEQB, LJQBAL
USE YOMDIMO , ONLY  : NOBNTV
USE CONTROL_VECTORS_COMM_MOD, ONLY : ALLGATHER_CVSECTION, SET_CVSECTION
USE CONTROL_VECTORS
USE SPECTRAL_FIELDS_MOD
USE YOMTS,  ONLY: TSCVX, TSCVER
USE YOMMP,  ONLY: MYLEVS

IMPLICIT NONE

TYPE(CONTROL_VECTOR), INTENT(INOUT) :: YDVAZG 

TYPE(control_vector) :: YLVAZG, YLCV
INTEGER(KIND=JPIM) :: ii,ji,jj,jf,js,il,jg,ibeg,iend,INGPBLKS
REAL(KIND=JPRB) :: ZWORK1(NSKFVECS)
REAL(KIND=JPRB) :: ZPS
REAL(KIND=JPRB), ALLOCATABLE :: ZGP3(:,:,:), ZGP2(:,:,:)
INTEGER(KIND=JPIM) :: ib(NOBGROUP),ie(NOBGROUP)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
LOGICAL  :: LLSPFCE
#include "abor1.intfb.h"
#include "cvarbcinad.intfb.h"
#include "cvar3inad.intfb.h"
#include "spec2gridad.intfb.h"
#include "jbtomodelad.intfb.h"
#include "spec_concat.intfb.h"

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

IF (LHOOK) CALL DR_HOOK('CVAR2INAD',0,ZHOOK_HANDLE)
CALL ALLOCATE_CTLVEC(YLVAZG)
CALL GSTATS(1448,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(jj)
DO JJ=1,SIZE(YLVAZG%data)
  YLVAZG%data(jj) = 0.0_JPRB
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1448,1)

! Parameters to be estimated

IF (LVARBC) THEN ! Obs bias parameters
  CALL CVARBCINAD
  IF (NOBPARAM/=SIZE(YLVAZG%params)) &
   & CALL ABOR1('CVAR2INAD: Parameter section of control variable wrong length')
  ibeg = 1
  DO jg = 1, NOBGROUP
    iend = ibeg + YVARBC(jg)%NPARAM - 1
    ib(jg)=ibeg
    ie(jg)=iend
    ibeg = iend + 1
  ENDDO
  CALL GSTATS(1448,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(jg)
  DO jg = 1, NOBGROUP
    YLVAZG%params(ib(jg):ie(jg)) = YVARBC(jg)%APARAMS
  ENDDO
!$OMP END PARALLEL DO
  CALL GSTATS(1448,1)
ENDIF

! MEAN WIND (LAM)

IF (YDVAZG%lam1d) THEN
  ii=0
  DO jf=1,NVA1D
    DO js=1,NFLEVL
      il=MYLEVS(js)
      ii=ii+1
      YLVAZG%lamcv(ii) = SPJB%SP1D(js,jf) * TMEANUVER(il,jf)
    ENDDO
  ENDDO
ENDIF

! TOVS control variable

IF (YDVAZG%ltovscv) THEN
  DO jf=1,NVATOVV
    CALL GSTATS(1448,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(js,ii)
    DO js=1,NVATOVLEN
      ii=(jf-1)*NVATOVLEN+js
      IF (TOVSCVER(js,jf)/=RMDI) THEN
        YLVAZG%tovscv(ii) = TOVSCVX(js,jf) * TOVSCVER(js,jf)
      ENDIF
    ENDDO
!$OMP END PARALLEL DO
    CALL GSTATS(1448,1)
  ENDDO
ENDIF

! TS control variable


IF (YDVAZG%ltscv) THEN
  ii=0
  DO js=1,NOBNTV
    ii=ii+1
    IF (TSCVER/=RMDI) THEN
      YLVAZG%tscv(ii) = TSCVX(js) * TSCVER
    ENDIF
  ENDDO
ENDIF

! Model Error

INGPBLKS = (NGPTOT+NPROMA-1)/NPROMA

ALLOCATE (ZGP3(NPROMA,NFLEVG*NVA3D,INGPBLKS))
ALLOCATE (ZGP2(NPROMA,NVA2D,INGPBLKS))
CALL GSTATS(1448,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(jf)
DO jf=1,NFLEVG*NVA3D
  ZGP3(:,jf,:)=0.0_JPRB
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1448,1)
ZGP2(:,:,:)=0.0_JPRB

IF (YLVAZG%nmoderr>0) THEN
  IF (LQEQB) THEN
    il=SPCTLMODERR%nspsizel
    CALL ALLOCATE_CTLVEC(YLCV,LDINIT=.true.,KMERR=0)
    IF (SIZE(YLCV%INITCV)/=il) CALL ABOR1('CVAR2INAD: Error LQEQB')
    DO jj=1,NDIM_MODERR
      ii=(jj-1)*il
      SPGPMODERR=0.0_JPRB
      CALL SPEC2GRIDAD(SPGPMODERR,GPMODERR(jj))
      CALL SPEC_CONCAT(SPMODERR(jj),SPGPMODERR,SPCTLMODERR)
      LLSPFCE=LSPFCE
      LSPFCE=.TRUE.
      CALL CVAR3INAD(YLCV,SPCTLMODERR,ZGP3,ZGP2,0)
      LSPFCE=LLSPFCE
      YLVAZG%MODERR(ii+1:ii+il)=YLCV%INITCV(:)
    ENDDO
    CALL DEALLOCATE_CTLVEC(YLCV)
  ELSE
    DO jj=1,NDIM_MODERR
      SPGPMODERR=0.0_JPRB
      CALL SPEC2GRIDAD(SPGPMODERR,GPMODERR(jj))
      CALL SPEC_CONCAT(SPMODERR(jj),SPGPMODERR,SPCTLMODERR)
      CALL CVAR3INAD(YLVAZG,SPCTLMODERR,ZGP3,ZGP2,jj,LJQBAL)
    ENDDO
  ENDIF
ENDIF

! Initial condition
IF (YLVAZG%LINITCV) THEN
  CALL JBTOMODELAD(SPJB,ZGP3,ZGP2)
  CALL CVAR3INAD(YLVAZG,SPJB,ZGP3,ZGP2,0)
ENDIF

DEALLOCATE (ZGP3)
DEALLOCATE (ZGP2)

!     4.    Simplified Kalman Filter
!           ------------------------

IF (LSKF) THEN
  YLVAZG%data = YLVAZG%data * YSCALPSQRT%data

  DO JJ=1,NSKFVECS
    ZPS = DOT_PRODUCT(YLVAZG,YSKFROT(JJ))
    YLVAZG%data = YLVAZG%data - ZPS*YSKFROT(JJ)%data
  ENDDO

  CALL ALLGATHER_CVSECTION(YLVAZG,ZWORK1,1,NSKFVECS)

  DO JJ=1,NSKFVECS
    ZWORK1(JJ) = ZWORK1(JJ) + DOT_PRODUCT(YSKFMAT(JJ),YLVAZG)
  ENDDO

  DO ji=1,NSKFVECS
    ZWORK1(ji) = ZWORK1(ji)/SKFSUBMAT(ji,ji)
    DO jj=ji+1,NSKFVECS
      ZWORK1(jj) = ZWORK1(jj) - ZWORK1(ji)*SKFSUBMAT(ji,jj)
    ENDDO
  ENDDO

  CALL SET_CVSECTION(ZWORK1,YLVAZG,1,NSKFVECS)

  DO JJ=NSKFVECS,1,-1
    ZPS = DOT_PRODUCT(YLVAZG,YSKFROT(JJ))
    YLVAZG%data = YLVAZG%data - ZPS*YSKFROT(JJ)%data
  ENDDO

  YDVAZG%data = YDVAZG%data + YLVAZG%data * YRSCALPSQRT%data
ELSE
  CALL GSTATS(1448,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(jj)
  DO jj=1,SIZE(YDVAZG%data)
    YDVAZG%data(jj) = YDVAZG%data(jj) + YLVAZG%data(jj)
  ENDDO
!$OMP END PARALLEL DO
  CALL GSTATS(1448,1)
ENDIF

CALL DEALLOCATE_CTLVEC(YLVAZG)

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