SUBROUTINE ADTEST

!     Purpose:
!     --------
!       Test of adjoint model inside 4D-Var configuration.

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

!     Modifications.
!     --------------
!       Original 31-Oct-2003
!       A. Geer  01-Oct-2008  Clean unneeded rainy 4D-Var code
! ------------------------------------------------------------------

USE PARKIND1, ONLY: JPIM, JPRB
USE YOMHOOK , ONLY: LHOOK, DR_HOOK
USE YOMJG   , ONLY: LSUBBG
USE YOMLUN  , ONLY: NULOUT
USE YOMVAR  , ONLY: LJCDFI, NSIM4D, NITER4D, LMODERR
USE YOMVRTL , ONLY: LTLINT
USE YOMCVA  , ONLY: YSCALP, NVA3D, NVA2D, NGRBVAR
USE YOMDIM  , ONLY: NSMAX, NMSMAX
USE TESTVAR_MIX , ONLY: LTESTADJM
USE YOMMODEL_ERROR, ONLY: NTYPE_MODERR,SPMODERR, GPMODERR,SPGPMODERR,NDIM_MODERR, &
& NSERR, NVE2D, NVE3D, NGRBMERRCTL, NVE3SP, NVE2SP, NVE3GP, NVE2GP, &
& NGRBMERRSP, NGRBMERRGP 
USE YOMJQ, ONLY: SPJQMODERR
USE YOMWAVELET, ONLY: LJBWAVELET
USE GRIDPOINT_FIELDS_MIX
USE SPECTRAL_FIELDS_MOD
USE CONTROL_VECTORS

IMPLICIT NONE

TYPE(control_vector) :: YLCV_A, YLCV_B, YLCV_X, YLCV_Y
TYPE(spectral_field) :: YLSP_B, YLSP_X,YLSP_JQ
TYPE(SPECTRAL_FIELD) :: YLSPEC
TYPE(GRIDPOINT_FIELD) :: YLGRID
REAL(KIND=JPRB) :: zz1, zz2, zz3
LOGICAL :: LLDFI,LLSUB,LL1,LL0
INTEGER(KIND=JPIM) :: iter4d,isim4d,ISEED,jj
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "chavarin.intfb.h"
#include "chavarinad.intfb.h"
#include "cnt3ad.intfb.h"
#include "cnt3tl.intfb.h"
#include "su2yom.intfb.h"
#include "sucos.intfb.h"
#include "cdsta.intfb.h"
#include "spec_imzero.intfb.h"
#include "random_ctlvec.intfb.h"
#include "state2spec.intfb.h"
#include "state2specad.intfb.h"
#include "caininad.intfb.h"
#include "cainin.intfb.h"
#include "spec_split.intfb.h"
#include "spec_concat.intfb.h"
#include "spec2grid.intfb.h"
#include "spec2gridad.intfb.h"
! ------------------------------------------------------------------

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

WRITE(NULOUT,'(A)')' ADTEST -------------------------------'
WRITE(NULOUT,'(A)')' ADTEST Starting Adjoint Test'

IF (LMODERR.AND.LJBWAVELET) THEN
  WRITE(NULOUT,'(A)')' ADTEST ---------------------------------------'
  WRITE(NULOUT,'(A)')' ADTEST CANNOT TEST WITH LMODERR AND LJBWAVELET'
  WRITE(NULOUT,'(A)')' ADTEST ---------------------------------------'
ELSE

! Bias term only has an effect in observation space, not
! in model space. It would require test in the space of
! departures from observations
IF (LMODERR.AND.NTYPE_MODERR==3) THEN
  WRITE(NULOUT,'(A)')' ADTEST ---------------------------------------'
  WRITE(NULOUT,'(A)')' ADTEST ADJOINT TEST MEANINGLESS WITH BIAS TERM'
  WRITE(NULOUT,'(A)')' ADTEST ---------------------------------------'
ENDIF

! Initialize
! -----------
LL1=.true.
LL0=.false.
LLDFI=LJCDFI
LLSUB=LSUBBG
iter4d=NITER4D
isim4d=NSIM4D
NITER4D=1
NSIM4D =1
LJCDFI=.false.
LSUBBG=.false.

CALL ALLOCATE_CTLVEC(YLCV_A)
CALL ALLOCATE_CTLVEC(YLCV_Y)
IF (LMODERR) THEN
  CALL ALLOCATE_CTLVEC(YLCV_B)
  CALL ALLOCATE_CTLVEC(YLCV_X)
ELSE
  CALL ALLOCATE_SPEC(YLSP_B,NSMAX,NMSMAX,NVA3D,NVA2D,0,NGRBVAR)
  CALL ALLOCATE_SPEC(YLSP_X ,NSMAX,NMSMAX,NVA3D,NVA2D,0,NGRBVAR)
ENDIF

! ------------------------------------------------------------------
! TEST CHAVARIN+CNT3TL/CNT3AD+CHAVARINAD
! ------------------------------------------------------------------
! For a true full adjoint test, ZB should be in the space of
! departures from observations (like ZHOFX in HOPTL).
ISEED=1000000
CALL RANDOM_CTLVEC(YLCV_A,LL1,LL1,LL0,LL0,LL0,LL0,ISEED)
ISEED=2000000
IF (LMODERR) THEN
  CALL RANDOM_CTLVEC(YLCV_B,LL1,LL1,LL0,LL0,LL0,LL0,ISEED)
ELSE
  CALL RANDOM_SPECTRAL_FIELD(YLSP_B,ISEED)
  CALL SPEC_IMZERO(YLSP_B)
ENDIF

CALL SU2YOM
CALL SUCOS

! ------------------------------------------------------------------
! Direct integration: Calculation of <CNT3TL.ZA,ZB>.
! ----------------------------------------------------

YLCV_Y=YLCV_A
CALL CHAVARIN(YLCV_Y)

LTLINT=.TRUE.
CALL CNT3TL
LTLINT=.FALSE.

IF (LMODERR) THEN
  IF (NTYPE_MODERR == 1) THEN
    CALL ALLOCATE_GRID(YLGRID,NVE3GP,NVE2GP,NGRBMERRGP)
    CALL ALLOCATE_SPEC(YLSPEC,NSERR,0,NVE3SP,NVE2SP,0,NGRBMERRSP)
    DO jj=1,NDIM_MODERR
      CALL SPEC_SPLIT(SPJQMODERR(jj),YLSPEC,SPGPMODERR)
      CALL SPEC2GRID(SPGPMODERR,YLGRID)
      CALL SELF_SUB(SPMODERR(jj),YLSPEC)
      CALL SELF_SUB(GPMODERR(jj),YLGRID)
    ENDDO
    CALL DEALLOCATE_GRID(YLGRID)
    CALL DEALLOCATE_SPEC(YLSPEC)
  ENDIF
  YLCV_X = 0.0_JPRB
  CALL CAININ(YLCV_X)
  zz1 = DOT_PRODUCT(YLCV_X,YLCV_B,YSCALP)
ELSE
  YLSP_X=0.0_JPRB
  CALL STATE2SPEC(YLSP_X)
  zz1 = DOT_PRODUCT(YLSP_X,YLSP_B,.TRUE.)
ENDIF

! ------------------------------------------------------------------
! Adjoint integration: Calculation of <ZA,CNT3AD.ZB>.
! -----------------------------------------------------

CALL CDSTA

IF (LMODERR) THEN
  YLCV_X=YLCV_B
  CALL CAININAD(YLCV_X)
  IF (NTYPE_MODERR == 1) THEN
    CALL ALLOCATE_SPEC(YLSP_JQ,NSERR,0,NVE3D,NVE2D,0,NGRBMERRCTL)
    DO jj=1,NDIM_MODERR
      CALL SPEC2GRIDAD(SPGPMODERR,GPMODERR(jj))
      CALL SPEC_CONCAT(SPMODERR(jj),SPGPMODERR,YLSP_JQ)
      SPJQMODERR(jj)=YLSP_JQ
      CALL SELF_MUL(SPJQMODERR(jj),-1._JPRB)
    ENDDO
    CALL DEALLOCATE_SPEC(YLSP_JQ)
  ENDIF
ELSE
  YLSP_X=YLSP_B
  CALL STATE2SPECAD(YLSP_X)
ENDIF

LTESTADJM=.true.
CALL CNT3AD
LTESTADJM=.false.

YLCV_Y=0.0_JPRB
CALL CHAVARINAD(YLCV_Y)
zz2 = DOT_PRODUCT(YLCV_A,YLCV_Y,YSCALP)

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

IF (zz1==0.0_JPRB) THEN
  zz3 = ABS(zz1-zz2) / EPSILON(zz3)
ELSE
  zz3 = ABS((zz1-zz2)/zz1) / EPSILON(zz3)
ENDIF

WRITE(NULOUT,'(A)')' ADTEST -------------------------------'
WRITE(NULOUT,'(A)')' ADTEST TEST OF ADJOINT CHAVARIN+CNT3TL'
WRITE(NULOUT,'(A)')' ADTEST -------------------------------'
WRITE(NULOUT,'(A)')' ADTEST             1234567890123456'
WRITE(NULOUT,'(A,E22.16)')' ADTEST <Y,F .X>= ',zz1
WRITE(NULOUT,'(A,E22.16)')' ADTEST <F*.Y,X>= ',zz2
WRITE(NULOUT,'(A,F8.1,A)')' ADTEST The difference is ',zz3, &
 & ' times machine precision.'  
WRITE(NULOUT,'(A)')' ADTEST -------------------------------'

! ------------------------------------------------------------------
CALL DEALLOCATE_CTLVEC(YLCV_A)
CALL DEALLOCATE_CTLVEC(YLCV_Y)
IF (LMODERR) THEN
  CALL DEALLOCATE_CTLVEC(YLCV_X)
  CALL DEALLOCATE_CTLVEC(YLCV_B)
ELSE
  CALL DEALLOCATE_SPEC(YLSP_X)
  CALL DEALLOCATE_SPEC(YLSP_B)
ENDIF
LJCDFI=LLDFI
LSUBBG=LLSUB
NITER4D=iter4d
NSIM4D =isim4d

IF (LMODERR.AND.NTYPE_MODERR==3) THEN
  WRITE(NULOUT,'(A)')' ADTEST ---------------------------------------'
  WRITE(NULOUT,'(A)')' ADTEST ADJOINT TEST MEANINGLESS WITH BIAS TERM'
  WRITE(NULOUT,'(A)')' ADTEST ---------------------------------------'
ENDIF

ENDIF

WRITE(NULOUT,'(A)')' ADTEST End Adjoint Test'
WRITE(NULOUT,'(A)')' ADTEST -------------------------------'

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