SUBROUTINE CAININAD(YDVAZG)

!     Purpose.
!     --------
!       Inverse adjoint canonical injection.

!     Explicit arguments :
!     --------------------
!       YDVAZG  : CONTROL VARIABLE (INPUT)

!     Author.
!     -------
!       Y.Tremolet (from CAININAD_SCALE_HELPER)

!     Modifications.
!     --------------
!        Original : 2002-08-05
!     C.Fischer   03-04-02 Aladin spectral treatment added.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Fisher      17-Mar-2004 Abort if wavelet Jb
!        Y.Tremolet    18-Mar-2004 Fix 2D arrays
!        D.Dee         19-Mar-2003  Variational bias correction
!        Y.Tremolet    10-Jun-2004 Initial condition optional in control vector
!        Y.Tremolet    27-Jul-2004 Improve model error
!        C.Soci        07-Oct-2004 set Im coef for n=0 to 0 moved in SPECIMZERO
!        P.Burton :  29-09-04 LVARBC cleanup
!        L.Isaksen     05-Sep-2005 Adapt for grid point q
!        A.Dethof      23-Jan-2007 Add GEMS GRG fields
!     ------------------------------------------------------------------

USE PARKIND1, ONLY: JPIM, JPRB
USE YOMHOOK , ONLY: LHOOK, DR_HOOK
USE YOMDIM  , ONLY: NSMAX, NSPEC2, NS3D, NS2D, NFLEVL, NPROMA
USE YOMCT0  , ONLY: NCONF, LELAM
USE YOMMP   , ONLY: MYSETW, NPROCM, NPSP, NBSETLEV
USE YOMLAP  , ONLY: NASM0
USE YOMSP   , ONLY: SPA3, SPA2, SPA1
USE YOMGFL  , ONLY: GFL
USE YOM_YGFL, ONLY: YQ, YO3, YGHG, NGHG, YGRG, NGRG
USE YOMTVRAD, ONLY: TOVSCVX,NVATOVLEN
USE YOMDIMO , ONLY: NOBNTV
USE YOMCVA  , ONLY: NVA3D, NVA2D, NVA1D, NVATOVV, YSCALP
USE YOMVAR  , ONLY: LVARBC
USE VARBC_SETUP, ONLY: YVARBC, NOBGROUP, NOBPARAM
USE YOMMODEL_ERROR, ONLY: NDIM_MODERR, SPMODERR, GPMODERR, SPCTLMODERR, SPGPMODERR
USE YOMWAVELET, ONLY: LJBWAVELET
USE CONTROL_VECTORS
USE SPECTRAL_FIELDS_MOD
USE GRIDPOINT_FIELDS_MIX
USE YOMTS,  ONLY: TSCVX


IMPLICIT NONE

TYPE(CONTROL_VECTOR),INTENT(IN)    :: YDVAZG 
REAL(KIND=JPRB) :: ZMULM(NSPEC2)
REAL(KIND=JPRB), ALLOCATABLE :: ZSP(:,:)
INTEGER(KIND=JPIM) ::  jn, js, jl, jf, ii, jg, ibeg, iend, il, jj, jghg, jgrg
REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTERFACE
#include "dir_transad.h"
END INTERFACE

#include "abor1.intfb.h"
#include "grid2specad.intfb.h"
#include "specimzero.intfb.h"
#include "spec_split.intfb.h"

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CAININAD',0,ZHOOK_HANDLE)

IF (LJBWAVELET) CALL ABOR1 ('CAININAD CANNOT BE USED WITH WAVELET JB')

!     1.2   PARTICULAR CASE FOR 2D MODELS
!           -----------------------------


IF (LELAM) THEN
! LAM case - no filtering of coefficients
  zmulm(:) = 1.0_JPRB
ELSE
  zmulm(:) = 0.5_JPRB
  IF (MYSETW == NPROCM(0)) THEN
    DO jn=0,NSMAX
      zmulm(NASM0(0)+2*jn  ) = 1.0_JPRB  ! Real part
      zmulm(NASM0(0)+2*jn+1) = 0.0_JPRB  ! Imaginary part
    ENDDO
  ENDIF
ENDIF

! Initial condition
! -----------------
IF (YDVAZG%linitcv) THEN
  ii=0
  IF (NPSP==1) THEN
    DO jf=1,NVA2D
      DO js=1,NSPEC2
        ii=ii+1
        SPA2(js,jf) = YDVAZG%initcv(ii) * zmulm(js) * YSCALP%initcv(ii)  
      ENDDO
    ENDDO
  ENDIF
  IF (NS3D > NVA3D) THEN
    CALL ABOR1('CAININ: UNEXPECTED INCONSITENCY NS3D > NVA3D ')
  ENDIF
  DO jf=1,NS3D
    DO js=1,NSPEC2
      DO jl=1,NFLEVL
        ii=ii+1
        SPA3(jl,js,jf) = YDVAZG%initcv(ii) * zmulm(js) * YSCALP%initcv(ii)  
      ENDDO
    ENDDO
  ENDDO
! Transform grid point model state fields to spectral control vector fields where required
  IF (NS3D < NVA3D) THEN
    ALLOCATE(ZSP(NFLEVL,NSPEC2))
    IF (YQ%LGP) THEN
      DO js=1,NSPEC2
        DO jl=1,NFLEVL
          ii=ii+1
          ZSP(jl,js) = YDVAZG%initcv(ii) * zmulm(js) * YSCALP%initcv(ii)
        ENDDO
      ENDDO
      CALL DIR_TRANSAD(PSPSCALAR=ZSP,KVSETSC=NBSETLEV,KPROMA=NPROMA,&
       & PGP=GFL(:,:,YQ%MP,:))
    ENDIF
    IF (YO3%LGP) THEN
      DO js=1,NSPEC2
        DO jl=1,NFLEVL
          ii=ii+1
          ZSP(jl,js) = YDVAZG%initcv(ii) * zmulm(js) * YSCALP%initcv(ii)
        ENDDO
      ENDDO
      CALL DIR_TRANSAD(PSPSCALAR=ZSP,KVSETSC=NBSETLEV,KPROMA=NPROMA,&
       & PGP=GFL(:,:,YO3%MP,:))
    ENDIF
    DO JGHG=1,NGHG
      IF (YGHG(JGHG)%LGP) THEN
        DO js=1,NSPEC2
          DO jl=1,NFLEVL
            ii=ii+1
            ZSP(jl,js) = YDVAZG%initcv(ii) * zmulm(js) * YSCALP%initcv(ii)
          ENDDO
        ENDDO
        CALL DIR_TRANSAD(PSPSCALAR=ZSP,KVSETSC=NBSETLEV,KPROMA=NPROMA,&
         & PGP=GFL(:,:,YGHG(JGHG)%MP,:))
      ENDIF
    ENDDO
    DO JGRG=1,NGRG
      IF (YGRG(JGRG)%LGP) THEN
        DO js=1,NSPEC2
          DO jl=1,NFLEVL
            ii=ii+1
            ZSP(jl,js) = YDVAZG%initcv(ii) * zmulm(js) * YSCALP%initcv(ii)
          ENDDO
        ENDDO
        CALL DIR_TRANSAD(PSPSCALAR=ZSP,KVSETSC=NBSETLEV,KPROMA=NPROMA,&
         & PGP=GFL(:,:,YGRG(JGRG)%MP,:))
      ENDIF
    ENDDO
    DEALLOCATE(ZSP)
  ENDIF
  IF (SIZE(YDVAZG%initcv)/=ii) CALL ABOR1('CAININAD: initcv wrong length')
ELSE
  SPA2(:,:)  =0.0_JPRB
  SPA3(:,:,:)=0.0_JPRB
ENDIF

! Model error
! -----------
IF (YDVAZG%nmoderr>0) THEN
  ii=0
  il=SPCTLMODERR%nspsizel
  DO jj=1,NDIM_MODERR
    SPCTLMODERR=YDVAZG%MODERR(ii+1:ii+il)
    GPMODERR(jj)=0.0_JPRB
    CALL SPEC_SPLIT(SPCTLMODERR,SPMODERR(jj),SPGPMODERR)
    CALL GRID2SPECAD(GPMODERR(jj),SPGPMODERR)
    ii=ii+il
  ENDDO
  IF (ii/=SIZE(YDVAZG%MODERR)) CALL ABOR1('CAININAD: moderr wrong length')
ENDIF

! TOVS control variable
! ---------------------
IF (YDVAZG%ltovscv) THEN
  ii=0
  DO jf=1,NVATOVV
    DO js=1,NVATOVLEN
      ii=ii+1
      TOVSCVX(js,jf)=YDVAZG%tovscv(ii)
    ENDDO
  ENDDO
  IF (ii/=SIZE(YDVAZG%tovscv)) &
   & CALL ABOR1('CAININAD: TOVS control variable wrong length')  
ENDIF

 ! TS control variable
 ! ---------------------
 IF (YDVAZG%ltscv) THEN
   ii=0
     DO js=1,NOBNTV
       ii=ii+1
       TSCVX(js)=YDVAZG%tscv(ii)
     ENDDO
   IF (ii/=SIZE(YDVAZG%tscv)) &
    & CALL ABOR1('CAININAD: TS control variable wrong length')
 ENDIF


! MEAN WIND (LAM)
! ---------------
IF (YDVAZG%lam1d) THEN
  ii=0
  DO jf=1,NVA1D
    DO jl=1,NFLEVL
      ii=ii+1
      SPA1(jl,jf) = YDVAZG%lamcv(ii) * YSCALP%lamcv(ii)
    ENDDO
  ENDDO
  IF (ii/=SIZE(YDVAZG%lamcv)) &
   & CALL ABOR1('CAININAD: LAM control variable wrong length')  
ENDIF

! Obs bias parameter estimation
! -----------------------------
IF (LVARBC) THEN
  IF (NOBPARAM/=SIZE(YDVAZG%params)) &
   & CALL ABOR1('CAININAD: Parameter section of control variable wrong length')  
  ibeg = 1
  DO jg = 1, NOBGROUP
    iend = ibeg + YVARBC(jg)%NPARAM - 1
    YVARBC(jg)%APARAMS = YDVAZG%params(ibeg:iend)
    ibeg = iend + 1
  ENDDO
ENDIF

! Set imaginary coef for m=0 to zero (+ for n=0 to 0 when LAM).
CALL SPECIMZERO

!     1.2   PARTICULAR CASE FOR 2D MODELS
!           -----------------------------
IF(NCONF/100 == 2.OR.NCONF/10 == 42.OR.NCONF/10 == 52)THEN
  IF (NPSP==1) THEN
    DO jf=NVA2D+1,NS2D
      SPA2(:,jf) = 0.0_JPRB
    ENDDO
  ENDIF
  DO jf=NVA3D+1,NS3D
    SPA3(:,:,jf) = 0.0_JPRB
  ENDDO
  IF (LELAM) THEN
    SPA1(:,:) = 0.0_JPRB
  ENDIF
ENDIF

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