SUBROUTINE DJCDY(kiter,kmaxit,YDCGLWK,pwork,YDVAZX,YDVAZ0)

!     Purpose.
!     --------
!        Compute Jc sensitivity to obs using the adjoint of the approx
!        Kalman gain matrix provided by CONGRAD (i.e. dJc/dy).

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

!     Modifications.
!     --------------
!        Original : 04-Sep-2009
! ------------------------------------------------------------------

USE PARKIND1, ONLY: JPIM, JPRB
USE YOMHOOK , ONLY: LHOOK, DR_HOOK
USE YOMCOSJO, ONLY: FJOADJ, LADJOBS, MOBSENS
USE YOMDIMO , ONLY: NOBTOT
USE YOMLUN  , ONLY: NULOUT
USE YOMJG   , ONLY: LSUBBG
USE YOMCVA  , ONLY: YSCALP
USE YOMCT0  , ONLY: LGUESS, LOBS
USE YOMVAR  , ONLY: LJCDFI, NSIM4D, NUPTRA
USE MPL_MODULE, ONLY: MPL_ALLREDUCE
USE CONTROL_VECTORS

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

IMPLICIT NONE

INTEGER(KIND=JPIM) , INTENT(IN) :: kiter,kmaxit
TYPE(CONTROL_VECTOR),INTENT(IN) :: YDCGLWK(kmaxit+1)
REAL(KIND=JPRB)     ,INTENT(IN) :: PWORK(kmaxit+1,4)
TYPE(CONTROL_VECTOR),INTENT(IN) :: YDVAZX
TYPE(CONTROL_VECTOR),INTENT(IN) :: YDVAZ0

TYPE(control_vector) :: YLVAZX, YLWORK
INTEGER(KIND=JPIM) :: idum
LOGICAL :: LLA,LLB
REAL(KIND=JPRB) :: zx,zy,zb,zz,zp
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "sim4d.intfb.h"
#include "congrad_ad.intfb.h"

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

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

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

LLA=LSUBBG; LLB=LGUESS; LGUESS=.false.

IF (.NOT.LJCDFI) CALL ABOR1('DJCDY: Jc-DFI not being used.')

! Compute dJc/dx
! --------------
zx=0.0_JPRB
LOBS=.false.
nsim4d=990

YLWORK=YDVAZX
CALL SIM4D(idum,idum,YLWORK,zx,YLVAZX,nsim4d)

LOBS=.true.

! Apply adjoint of minimisation matrix
! ------------------------------------
CALL CONGRAD_AD(YLVAZX,kmaxit,kiter,pwork,YDCGLWK)

! Correction due to previous outer loops
! --------------------------------------
zb=0.0_JPRB
IF (NUPTRA>0) zb=DOT_PRODUCT(YLVAZX,YDVAZ0,YSCALP)

! Apply R^{-1}.H
! --------------
zz=0.0_JPRB
LADJOBS=.TRUE.
MOBSENS=MOBSENS+1
IF (MOBSENS>2) CALL ABOR1('DJCDY: MOBSENS max hardcoded in ODB')
FJOADJ(:)=0.0_JPRB
nsim4d=990
LSUBBG=.false.

CALL SIM4D(idum,idum,YLVAZX,zz,YLWORK,nsim4d)

LADJOBS=.FALSE.

! Prints
! ------
zy=0.0_JPRB
IF (SIZE(FJOADJ)>0) zy=SUM(FJOADJ)
CALL MPL_ALLREDUCE(zy,'SUM',LDREPROD=.TRUE.,CDSTRING='DJCDY:')

write(NULOUT,'(A)')'Jc obs. impact'
write(NULOUT,'(A,ES25.18)')'Jc impact: <dJc/dy,d>= ',zy
write(NULOUT,'(A,ES25.18)')'Jc impact:     <dx,b>= ',zb
write(NULOUT,'(A,ES25.18)')'Jc impact:   diff    = ',zy-zb
write(NULOUT,'(A,ES25.18)')'Jc impact:     Jc-DFI= ',zx
IF ( abs(zx)>sqrt(tiny(zx)) ) THEN
  zz=abs((zy-zb-zx)/zx)
  write(NULOUT,'(A,ES25.18)')'dJc/dy rel. error= ',zz
ELSE
  zz=abs(zy-zb-zx)
  write(NULOUT,'(A,ES25.18)')'dJc/dy abs. error= ',zz
ENDIF
zp=zz/epsilon(zz)
WRITE(NULOUT,'(A,F8.1,A)')'Jc impact: the difference is ', &
 & zp,' times machine precision.'

! Clean up
! --------
LSUBBG=LLA; LGUESS=LLB
DEALLOCATE(FJOADJ)
CALL deallocate_ctlvec(YLVAZX)
CALL deallocate_ctlvec(YLWORK)

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