SUBROUTINE WEAK_CONSTRAINT_AD

!     Purpose.
!     --------
!       Apply weak constraint adjoint.

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

!     Modifications.
!     --------------
!        Original : 19-Aug-2005
!     ------------------------------------------------------------------

USE PARKIND1, ONLY: JPIM, JPRB
USE YOMHOOK , ONLY: LHOOK, DR_HOOK
USE YOMCT3  , ONLY: NSTEP
USE YOMLUN  , ONLY: NULOUT
USE YOMJQ   , ONLY: SPJQMODERR
USE YOMMODEL_ERROR, ONLY: NTYPE_MODERR, MSTEPERR, SPMODERR, GPMODERR, &
                     & NSERR, NVE3SP, NVE2SP, NVE3GP, NVE2GP, &
                     & NGRBMERRSP, NGRBMERRGP, SPGPMODERR, NPRTMODERR
USE GRIDPOINT_FIELDS_MIX
USE SPECTRAL_FIELDS_MOD

IMPLICIT NONE

TYPE(GRIDPOINT_FIELD) :: YLGRID
TYPE(SPECTRAL_FIELD) :: YLSPEC
INTEGER(KIND=JPIM) :: ic
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "grid2specad.intfb.h"
#include "spec_split.intfb.h"
#include "abor1.intfb.h"
#include "model2moderr.intfb.h"
!     ------------------------------------------------------------------

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

IF (NTYPE_MODERR/=1) CALL ABOR1('WEAK_CONSTRAINT_AD: Error NTYPE_MODERR')

ic=MSTEPERR(NSTEP)

! TL1  SPJQMODERR=SPA3-SPMODERR
! TL2  SPA3=SPMODERR

! AD2  SPMODERR=SPMODERR+SPA3
! AD2  SPA3=0

! AD1 SPMODERR=SPMODERR-SPJQMODERR
! AD1 SPA3=SPA3+SPJQMODERR
! AD1 SPJQMODERR=0

!AD reduced  SPMODERR=SPMODERR+SPA3-SPJQMODERR
!AD reduced  SPA3=SPJQMODERR


IF (ic>0) THEN
!rg  CALL ABOR1('WEAK_CONSTRAINT_AD: Not ready for SPMODERR')
  CALL ALLOCATE_GRID(YLGRID,NVE3GP,NVE2GP,NGRBMERRGP)
  CALL ALLOCATE_SPEC(YLSPEC,NSERR,0,NVE3SP,NVE2SP,0,NGRBMERRSP)

  CALL MODEL2MODERR(1,YLSPEC,YLGRID)
  CALL SELF_ADD(SPMODERR(ic),YLSPEC)
  CALL SELF_ADD(GPMODERR(ic),YLGRID)
  CALL SPEC_SPLIT(SPJQMODERR(ic),YLSPEC,SPGPMODERR)
  CALL GRID2SPECAD(YLGRID,SPGPMODERR)
  CALL SELF_SUB(SPMODERR(ic),YLSPEC)
  CALL SELF_SUB(GPMODERR(ic),YLGRID)
  CALL MODEL2MODERR(-1,YLSPEC,YLGRID)
  CALL HUGIFY_ENDGRID(GPMODERR(ic))

  CALL DEALLOCATE_SPEC(YLSPEC)
  CALL DEALLOCATE_GRID(YLGRID)

  IF (NPRTMODERR>=1) &
    & WRITE(NULOUT,*)'WEAK_CONSTRAINT_AD applied, NSTEP, ic=',NSTEP,ic
ENDIF

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