SUBROUTINE fjvarbc ( pfjpcost, pcvparam, pcvgrad, kncvparam )
!-----------------------------------------------------------------------
!   FJVARBC - Cost associated with variational bias parameters

!   Purpose.
!   --------
!   Calculates contribution to the cost function and gradient of the
!   control vector parameters associated with variational bias correction

!   Interface.
!   ----------
!   CALL fjvarbc ( pfjpcost, pcvparam, pcvgrad, kncvparam )

!   Input arguments:
!      pcvparam  = parameter segment of the control vector
!      kncvparam = length of pcvparam

!   Output arguments:
!      pfjpcost  = cost associated with the background term
!      pcvgrad   = gradient of pfjpcost wrt the control parameters

!   Implicit input:
!      YVARBC

!   Author.
!   -------
!   Dick Dee (ECMWF)

!   Modifications.
!   --------------
!   Original    2004/03/19
!        P.Burton :  29-09-04 LVARBC cleanup
!        D. Dee   :  28-11-07 Use LLBKGCON flag
!-----------------------------------------------------------------------

USE parkind1, ONLY : JPIM, JPRB
USE yomhook , ONLY : lhook, dr_hook
USE varbc_setup, ONLY : YVARBC, NOBGROUP, NOBPARAM, JPMXNPARAM

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: kncvparam 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: pfjpcost 
REAL(KIND=JPRB)   ,INTENT(IN)    :: pcvparam(kncvparam) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: pcvgrad(kncvparam) 

INTEGER(KIND=JPIM) :: jg, jp, ibeg, iend, inparam
REAL(KIND=JPRB)    :: zdb(JPMXNPARAM), zfjpgrad(JPMXNPARAM)
REAL(KIND=JPRB)    :: zhook_handle

#include "abor1.intfb.h"

! For now, only obs bias parameters are allowed
! ---------------------------------------------
IF (lhook) CALL dr_hook('FJVARBC',0,zhook_handle)
IF (kncvparam/=NOBPARAM) CALL ABOR1('FJVARBC: kncvparam/=NOBPARAM')

pfjpcost = 0.0_JPRB
pcvgrad  = 0.0_JPRB

ibeg = 1
DO jg = 1, NOBGROUP

  inparam = YVARBC(jg)%NPARAM
  iend = ibeg + inparam - 1

  IF (YVARBC(jg)%LLBKGCON) THEN  ! Apply background constraint for this group

!   Compute zdb = B^-1/2 * L^-1 * cvparam
!   -------------------------------------
    DO jp = 1, inparam
      zdb(jp) = SUM(YVARBC(jg)%ACVARIN(jp,:)*pcvparam(ibeg:iend)) / &
                                & YVARBC(jg)%BKGERR(jp)
    ENDDO

!   Cost contribution for this group is 1/2 * zdb^T * zdb 
!   ---------------------------------------------------
    pfjpcost = pfjpcost + 0.5_JPRB*SUM(zdb(1:inparam)*zdb(1:inparam))

!   Gradient contribution for this group is  (B^-1/2 * L^-1)^T * zdb
!   -------------------------------------------------------------------
    DO jp = 1, inparam
      zdb(jp) = zdb(jp)/YVARBC(jg)%BKGERR(jp)
    ENDDO
    DO jp = 1, inparam
      zfjpgrad(jp) = SUM(YVARBC(jg)%ACVARIN(jp,:)*zdb(1:inparam))
    ENDDO

    pcvgrad(ibeg:iend) = zfjpgrad(1:inparam)
        
  ENDIF

  ibeg = iend + 1

ENDDO
IF (lhook) CALL dr_hook('FJVARBC',1,zhook_handle)

END SUBROUTINE fjvarbc
