SUBROUTINE ADJOTEST

!     Purpose.
!     --------
!        Adjoint test accounting for observation operators.

!     Author.
!     -------
!        Yannick Tremolet

!     Modifications.
!     --------------
!        Original : 12-Feb-2009
! ------------------------------------------------------------------

USE PARKIND1 , ONLY: JPIM     ,JPRB
USE YOMHOOK  , ONLY: LHOOK,   DR_HOOK
USE YOMVAR   , ONLY: LJCDFI
USE YOMCOSJO , ONLY: FJOADJ
USE YOMCVA   , ONLY: YSCALP
USE YOMLUN   , ONLY: NULOUT
USE YOMJG    , ONLY: LSUBBG
USE YOMCT0   , ONLY: LGUESS
USE YOMDIMO  , ONLY: NOBTOT
USE TESTVAR_MIX, ONLY: LTESTADJH
USE MPL_MODULE, ONLY: MPL_ALLREDUCE
USE CONTROL_VECTORS

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

IMPLICIT NONE

TYPE(control_vector) :: YLVAZX, YLVAZY
INTEGER(KIND=JPIM) :: idum,isim4d,iseed
LOGICAL :: LLA,LLB,LLC,LL1
REAL(KIND=JPRB) :: zx,zy,zz,zf,zp
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "sim4d.intfb.h"
#include "setran.intfb.h"
#include "random_ctlvec.intfb.h"

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

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

CALL allocate_ctlvec(YLVAZX)
CALL allocate_ctlvec(YLVAZY)
ALLOCATE(FJOADJ(NOBTOT))

LLA=LSUBBG
LLB=LGUESS
LLC=LJCDFI
LSUBBG=.false.
LGUESS=.false.
LJCDFI=.false.

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

LL1=.true.
CALL SETRAN(97531,KOUTSEED=ISEED)
CALL RANDOM_CTLVEC(YLVAZX,LL1,LL1,LL1,LL1,LL1,LL1,ISEED)

! Apply H and H^T
! ---------------
isim4d=2 ! to keep sim4d quiet
zf=0.0_JPRB
LTESTADJH=.TRUE.
FJOADJ(:)=0.0_JPRB

CALL SIM4D(idum,idum,YLVAZX,zf,YLVAZY,isim4d)

LTESTADJH=.FALSE.

! Scalar product in control space
! -------------------------------
zx=DOT_PRODUCT(YLVAZX,YLVAZY,YSCALP)

! Scalar product in obs space
! ---------------------------
IF (SIZE(FJOADJ)>0) THEN  ! For single obs case
  zy = SUM(FJOADJ)
ELSE
  zy = 0.0_JPRB
ENDIF
CALL MPL_ALLREDUCE(zy,'SUM',LDREPROD=.TRUE.,CDSTRING='ADJOTEST:')

! Print results
! -------------
write(NULOUT,'(A)')'Adjoint test obs. operator    1.234567890123456789'
write(NULOUT,'(A,ES25.18)')'Adjoint test H: <H.dx,dy>  = ',zy
write(NULOUT,'(A,ES25.18)')'Adjoint test H: <dx,H^T.dy>= ',zx
if ( abs(zx) > sqrt(tiny(zz)) ) then
  zz=abs((zy-zx)/zx)
  write(NULOUT,'(A,ES25.18)')'Adjoint test H: rel. error = ',zz
else
  zz=abs(zy-zx)
  write(NULOUT,'(A,ES25.18)')'Adjoint test H: abs. error = ',zz
endif
zp=zz/epsilon(zz)
WRITE(NULOUT,'(A,F8.1,A)')'Adjoint test H: the difference is ', &
 & zp,' times machine precision.'

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

LSUBBG=LLA
LGUESS=LLB
LJCDFI=LLC

DEALLOCATE(FJOADJ)
CALL deallocate_ctlvec(YLVAZX)
CALL deallocate_ctlvec(YLVAZY)

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