SUBROUTINE OBSCOR_LANCZOS(PEV,PRITZ,KRITZ,KLANMAX,YDSTREAM)

!**** SUBROUTINE OBSCOR_LANCZOS - CALLS LANCZOS ALGORITHM TO COMPUTE THE
!                                 EIGENPAIRS OF OBS ERROR CORR MATRIX

!          GABOR RADNOTI ECMWF 24-Aug-2006

!*    PURPOSE
!     -------

!          COMPUTE EIGENPAIRS OF OBS ERROR CORR MATRIX
!**   INTERFACE
!     ---------

!     ***CALL OBSCOR_LANCZOS(PEV,PRITZ,KRITZ,KLANMAX,YDSTREAM)
!     PEV       -EIGEN-VECTORS
!     PRITZ     -RITZ VALUES
!     KRITZ     -NUMBER OF ACCEPTABLE RITZ VALUES
!     KLANMAX   -MAX NUMBER OF LANCZOS ITERATIONS
!     YDSTREAM  -AN INITIALIZED RANDOM NUMBER STREAM
!*    METHOD
!     ------

!     LANCZOS ALGORITHM


!**   MODIFICATIONS
!      K. Yessad (Sept 2008): adapt to interface of LANDR + cleanings.
!     -----------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE PARCMA    ,ONLY : JP_NUMEV
USE YOMLUN    ,ONLY : NULERR, NULUSR1,NULOUT
USE RANDOM_NUMBERS_MIX
USE YOMLCZ, ONLY : RLANBUF_OBSCOR, NITERL_OBSCOR, NLANTYPE
USE YOMMP    , ONLY : MYPROC
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMCOSJO  ,ONLY : OBS_ARR_GL2 

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

IMPLICIT NONE

INTEGER(KIND=JPIM),  INTENT(IN)  :: KLANMAX
TYPE(randomNumberStream), INTENT(INOUT) :: YDSTREAM
REAL(KIND=JPRB),  INTENT(OUT)    :: PEV(:,:)
REAL(KIND=JPRB),  INTENT(OUT)    :: PRITZ(KLANMAX)
INTEGER(KIND=JPIM),  INTENT(OUT) :: KRITZ

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

LOGICAL :: LLOBSC
INTEGER(KIND=JPIM)  :: INW,IMAXPRS,IEV,IMSGLVL,J,IEIG,IERR,J1,J2,IOMASTER, &
   & ILANTYPE, INUMOBS, INDIC
REAL(KIND=JPRB)     :: ZBND(KLANMAX),Z1(KLANMAX)
REAL(KIND=JPRB), ALLOCATABLE     :: ZW(:)
REAL(KIND=JPRB)     :: ZCONDM, ZENDL, ZENDR, ZKAPPA
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"

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

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

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

IOMASTER=1
ILANTYPE=NLANTYPE
NLANTYPE=99
INUMOBS=UBOUND(OBS_ARR_GL2,1)
INDIC=UBOUND(OBS_ARR_GL2,2)
ALLOCATE(ZW(6*INUMOBS+1+4*KLANMAX+KLANMAX*KLANMAX))
!IF (INDIC /= 7) THEN
!  WRITE(NULERR,*) 'OBSCOR_LANCZOS:ABOR1, INDIC= ',INDIC
!  CALL ABOR1('OBSCOR LANCZOS NOT TESTED FOR OTHER THAN SATOB')
!ENDIF
INW=6*INUMOBS+1+4*KLANMAX+KLANMAX*KLANMAX
IMAXPRS=JP_NUMEV
ZCONDM=1.0_JPRB
ZENDL=-1.E30
ZENDR=0.8
IEV=NULUSR1
IERR=NULERR
ZKAPPA=0.05_JPRB
IMSGLVL=0
ZW(:)=0.0_JPRB
CALL GAUSSIAN_DISTRIBUTION(ZW(1:INUMOBS),YDSTREAM)
NITERL_OBSCOR=KLANMAX
ALLOCATE(RLANBUF_OBSCOR(INUMOBS,NITERL_OBSCOR+2))
LLOBSC=(NLANTYPE>=99)
CALL LANDR(INUMOBS,LLOBSC,KLANMAX,IMAXPRS,ZCONDM,ZENDL,ZENDR,IEV,ZKAPPA, &
& J,IEIG,PRITZ,ZBND,ZW,INW,IERR,IMSGLVL,MYPROC)
DEALLOCATE(RLANBUF_OBSCOR)
WRITE(NULERR,*) 'LANCZOS ALGORITHM INFORMATION AT CURRENT OBSTYPE'
WRITE(NULERR,*) 'DIMENSION OF MATRIX',INUMOBS
WRITE(NULERR,*) 'NUMBER OF TAKEN LANCZOS STEPS',J
WRITE(NULERR,*) 'NUMBER OF RITZ VALUES STABILIZED',IEIG
CALL LOADEV(IEV,INUMOBS,J,KRITZ,PRITZ,ZBND,PEV,IERR,MYPROC,LLOBSC)
DO J1=1,INUMOBS
  DO J2=1,KRITZ
    Z1(KRITZ+1-J2)=PEV(J1,J2)
  ENDDO
  PEV(J1,1:KRITZ)=Z1(1:KRITZ)
ENDDO
DO J2=1,KRITZ
  Z1(KRITZ+1-J2)=PRITZ(J2)
ENDDO
PRITZ(1:KRITZ)=Z1(1:KRITZ)
DO J2=1,KRITZ
  IF (PRITZ(J2) < ZENDR) EXIT
ENDDO
WRITE(NULOUT,*) 'NUMBER OF RITZ VALUES ACCEPTED BY LANCZOS',KRITZ
KRITZ=J2-1
WRITE(NULOUT,*) 'NUMBER OF STABILIZED RITZ VALUES ACCEPTED BY EIGEN-VALUE LIMIT CHECK',KRITZ
DEALLOCATE(ZW)
NLANTYPE=ILANTYPE

!     -----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('OBSCOR_LANCZOS',1,ZHOOK_HANDLE)
END SUBROUTINE OBSCOR_LANCZOS 
