subroutine dbfgsl (K_N,YD_D,K_M,K_NYS,K_JMIN,K_JMAX,YD_YBAR,YD_SBAR,P_RHO,P_SIZE)

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE PARKIND2  ,ONLY : JPRH

use CONTROL_VECTORS

IMPLICIT NONE
INTEGER(KIND=JPIM),INTENT(IN)    :: K_M 
INTEGER(KIND=JPIM)               :: K_N ! Argument NOT used
TYPE(CONTROL_VECTOR),INTENT(INOUT) :: YD_D 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_NYS 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_JMIN 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_JMAX 
TYPE(CONTROL_VECTOR),INTENT(IN)    :: YD_YBAR(K_M) 
TYPE(CONTROL_VECTOR),INTENT(IN)    :: YD_SBAR(K_M) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_RHO(K_M) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SIZE 
!----

!     compute the product H u, where
!     . H is the matrix that could be obtained from the m pairs
!       (ybar,sbar) using the inverse BFGS formula from the diagonal
!       matrix (size) * (Identity matrix),
!     . u is a vector of dimension n.

!     The vector d contains

!       u (on entry), H u (on output).

!     rho(m) is a working zone.

!     Input:

!----

! --- local variables

INTEGER(KIND=JPIM) :: j,jfin,jp
REAL(KIND=JPRB) :: Z_R
REAL(KIND=JPRH) :: Z_S
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "dpseuclid.h"

! --- return if there is no pair (y,s) in ybar and sbar

IF (LHOOK) CALL DR_HOOK('DBFGSL',0,ZHOOK_HANDLE)
if (K_NYS == 0 .AND. LHOOK) CALL DR_HOOK('DBFGSL',1,ZHOOK_HANDLE)
if (K_NYS == 0) return

! --- set jfin

jfin=K_JMAX
if (jfin < K_JMIN) jfin=K_JMAX+K_M

! --- backward sweep

do j=jfin,K_JMIN,-1
  jp=j
  if (jp > K_M) jp=jp-K_M
  call dpseuclid (K_N,YD_D,YD_SBAR(jp),Z_S)
  P_RHO(jp)=Z_S
  YD_D%data = YD_D%data - Z_S*YD_YBAR(jp)%data
enddo

! --  preconditioning

Z_R=P_SIZE
YD_D%data = YD_D%data*Z_R

! --- forward sweep

do j=K_JMIN,jfin
  jp=j
  if (jp > K_M) jp=jp-K_M
  call dpseuclid (K_N,YD_D,YD_YBAR(jp),Z_S)
  Z_R=P_RHO(jp)-Z_S
  YD_D%data = YD_D%data + Z_R*YD_SBAR(jp)%data
enddo
IF (LHOOK) CALL DR_HOOK('DBFGSL',1,ZHOOK_HANDLE)
end subroutine dbfgsl
