SUBROUTINE CHSYMEIG(YD_PVEIG,PRITZ,KLENP,KJEIG,KNEIG)

!**** *CHSYMEIG* - 

!     Purpose.
!     --------
!        Check symmetry of OPK/OPM and whether SVs is solution of
!        the system   OPK x = lamda OPM x

!**   Interface.
!     ----------
!        *CALL* *CHSYMEIG(PVEIG,PRITZ,KLENP,KJEIG,KNEIG)

!        Explicit arguments:
!        -------------------
!        - PVEIG   : selected sv
!        - PRITZ   : singular value
!        - KLENP   : dimension of PRITZ
!        - KJEIG   : index of selected sv
!        - KNEIG   : number of converged sv 
!     Externals:
!     ----------
!        -

!     Author
!     ------
!        JAN BARKMEIJER *ECMWF*

!     Remarks
!     ------------

!     Modifications
!     -------------
!      Original : 97-02-04
!      02-08-08 Y.Tremolet   Use control_vectors.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

USE YOMCVA   , ONLY : YSCALP ,YRSCALPSQRT
USE YOMJG    , ONLY : LSUBBG
USE YOMLCZ   , ONLY : NLANTYPE
USE YOMLUN   , ONLY : NULOUT   ,NULUSR4
USE CONTROL_VECTORS_COMM_MOD
USE CONTROL_VECTORS

IMPLICIT NONE

INTEGER(KIND=JPIM)  ,INTENT(IN)    :: KLENP 
TYPE(CONTROL_VECTOR),INTENT(IN)    :: YD_PVEIG
REAL(KIND=JPRB)     ,INTENT(IN)    :: PRITZ(KLENP) 
INTEGER(KIND=JPIM)  ,INTENT(IN)    :: KJEIG 
INTEGER(KIND=JPIM)  ,INTENT(IN)    :: KNEIG 
!     -----------------------------------------------------------------

TYPE(control_vector) :: YL_ZDV1,YL_ZDV2
TYPE(control_vector) :: YL_ZVAZX,YL_ZVAZY
TYPE(control_vector) :: YL_ZVEC1,YL_ZVEC2,YL_ZVEC3
REAL(KIND=JPRB), ALLOCATABLE :: ZWRK1(:), ZWRK2(:), ZWRK3(:), ZWRK4(:)

INTEGER(KIND=JPIM) :: IUIT, J, JLIN, ivadim

REAL(KIND=JPRB) ::  ZFACTOR, ZNORM1, ZNORM2, ZNORM3, ZNORM4
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "cain.intfb.h"
#include "cainad.intfb.h"
#include "cainin.intfb.h"
#include "chavarin.intfb.h"
#include "chavarinad.intfb.h"
#include "opk.intfb.h"
#include "opm.intfb.h"

IF (LHOOK) CALL DR_HOOK('CHSYMEIG',0,ZHOOK_HANDLE)
CALL ALLOCATE_CTLVEC(YL_ZDV1)
CALL ALLOCATE_CTLVEC(YL_ZDV2)
CALL ALLOCATE_CTLVEC(YL_ZVAZX)
CALL ALLOCATE_CTLVEC(YL_ZVAZY)
CALL ALLOCATE_CTLVEC(YL_ZVEC1)
CALL ALLOCATE_CTLVEC(YL_ZVEC2)
CALL ALLOCATE_CTLVEC(YL_ZVEC3)

ivadim=YD_PVEIG%nsizeg
ALLOCATE(ZWRK1(ivadim))
ALLOCATE(ZWRK2(ivadim))
ALLOCATE(ZWRK3(ivadim))
ALLOCATE(ZWRK4(ivadim))

IF(KJEIG == 1) THEN

  CALL ALLGATHER_CTLVEC(YSCALP,ZWRK3)

  DO J=1,ivadim
    ZWRK1(J)=(1.0_JPRB+SIN(1.0_JPRB+J))*1.E-2_JPRB
    ZWRK2(J)=(1.0_JPRB+SIN(2.0_JPRB+J))*1.E-2_JPRB
    IF (ZWRK3(J) == 0.0_JPRB) THEN
      ZWRK1(J)=0.0_JPRB
      ZWRK2(J)=0.0_JPRB
    ENDIF
  ENDDO

  YL_ZVEC1=ZWRK1
  YL_ZVEC2=ZWRK2

  WRITE(NULOUT,*) 'SYMMCHAVARIN'
  LSUBBG=.FALSE.

  YL_ZDV1 = YL_ZVEC1
  CALL CHAVARIN (YL_ZDV1)
  CALL CAININ (YL_ZVAZX)
  ZNORM1=DOT_PRODUCT(YL_ZVEC2,YL_ZVAZX)

  CALL CAIN (YL_ZVEC2)
  YL_ZDV2 = 0.0_JPRB
  CALL CHAVARINAD (YL_ZDV2)
  YL_ZVAZY = YL_ZDV2
  ZNORM2=DOT_PRODUCT(YL_ZVEC1,YL_ZVAZY)
  WRITE(NULOUT,*) 'SYMMETRIC1 CHAVARIN ',ZNORM1,ZNORM2

  ZNORM1=DOT_PRODUCT(YL_ZVAZX,YL_ZVEC2,YSCALP)
  ZNORM2=DOT_PRODUCT(YL_ZVEC1,YL_ZVAZY,YSCALP)
  WRITE(NULOUT,*) 'SYMMETRIC2 CHAVARIN ',ZNORM1,ZNORM2

  WRITE(NULOUT,*) 'EXTRA CHECK'
  YL_ZDV1 = YL_ZVEC1
  CALL CHAVARIN (YL_ZDV1)
  YL_ZVAZX=0.0_JPRB
  CALL CAINAD (YL_ZVAZX)
  ZNORM1=DOT_PRODUCT(YL_ZVAZX,YL_ZVEC2,YSCALP)

  CALL CAIN (YL_ZVEC2)
  YL_ZDV2 = 0.0_JPRB
  CALL CHAVARINAD (YL_ZDV2)
  YL_ZVAZY=YL_ZDV2
  ZNORM2=DOT_PRODUCT(YL_ZVEC1,YL_ZVAZY,YSCALP)

  WRITE(NULOUT,*) 'EXTRA',ZNORM1,ZNORM2

  LSUBBG=.TRUE.

!*************  check OPK

  CALL OPK(YL_ZVEC1,YL_ZVAZX)

  ZNORM1=DOT_PRODUCT(YL_ZVEC2,YL_ZVAZX)

  CALL OPK(YL_ZVEC2,YL_ZVAZY)

  ZNORM2=DOT_PRODUCT(YL_ZVEC1,YL_ZVAZY)

  WRITE(NULOUT,*) 'SYMMETRIC OPK ',ZNORM1,ZNORM2
  WRITE(NULUSR4,'('' SYMMETRIC OPK       = '',E26.20,1X,E26.20)')&
   & ZNORM1,ZNORM2  

!************* CHECK OPM

! loop for testing linearity

  ZFACTOR=1.E-3_JPRB

  YL_ZVEC3=YL_ZVEC1

  DO JLIN=3,3

    IF(JLIN == 3) ZFACTOR=1.0_JPRB
    YL_ZVEC1%data = YL_ZVEC3%data * ZFACTOR

    YL_ZDV1 = YL_ZVEC1
    CALL OPM(YL_ZDV1,YL_ZDV2)
    YL_ZVAZX = YL_ZDV2

    IUIT=ivadim/50
    WRITE(NULOUT,*) 'YL_ZVEC1,  OPM(YL_ZVEC1)'
    WRITE(NULUSR4,'('' YL_ZVEC1,  OPM(YL_ZVEC1)'')')

    CALL ALLGATHER_CTLVEC(YL_ZVEC1,ZWRK1)
    CALL ALLGATHER_CTLVEC(YL_ZVAZX,ZWRK2)
    DO J=1,ivadim,IUIT
      WRITE(NULOUT,*) J,ZWRK1(J),ZWRK2(J)
      WRITE(NULUSR4,200) J,ZWRK1(J),ZWRK2(J)
    ENDDO
    200 FORMAT(I7,2(E12.5,1X))

    ZNORM1=DOT_PRODUCT(YL_ZVEC2,YL_ZVAZX)

    YL_ZDV1 = YL_ZVEC2
    CALL OPM(YL_ZDV1,YL_ZDV2)
    YL_ZVAZY = YL_ZDV2

    ZNORM2=DOT_PRODUCT(YL_ZVEC1,YL_ZVAZY)

    WRITE(NULOUT,*) 'VERM FACTOR=',ZFACTOR
    WRITE(NULOUT,*) 'SYMMETRIC OPM ',ZNORM1,ZNORM2
    WRITE(NULUSR4,'('' SYMMETRIC OPM       = '',E26.20,1X,&
     & E26.20)') &
     & ZNORM1,ZNORM2  

  ENDDO

ENDIF

!************* check eigenvectors

IF((KJEIG <= 3).OR.(KJEIG == KNEIG)) THEN
  WRITE(NULOUT,*) 'CHECK EIGENVECTOR ',KJEIG

  YL_ZDV1 = YD_PVEIG
  CALL OPM(YL_ZDV1,YL_ZDV2)
  YL_ZVEC2 = YL_ZDV2
  CALL OPK(YD_PVEIG,YL_ZVEC1)

  ZNORM1=DOT_PRODUCT(YL_ZVEC1,YD_PVEIG)
  ZNORM2=DOT_PRODUCT(YD_PVEIG,YD_PVEIG)
  ZNORM3=DOT_PRODUCT(YL_ZVEC2,YD_PVEIG)

  WRITE(NULOUT,*)
  WRITE(NULOUT,*) 'CHECK EIGENVECTOR', KJEIG
  WRITE(NULUSR4,'('' CHECK EIGENVECTOR  '',I4)') KJEIG
  WRITE(NULOUT,*) 'EIGENVECTOR, AX, LAMBA BX, MODEL'
  WRITE(NULOUT,*) ZNORM1,ZNORM2,ZNORM3,PRITZ(KJEIG)

  YL_ZVEC2%data = YL_ZVEC2%data * PRITZ(KJEIG)
!* 
! to model space

  LSUBBG=.FALSE.
  YL_ZDV1 = YD_PVEIG
  CALL CHAVARIN (YL_ZDV1)
  CALL CAININ (YL_ZVAZX)
  LSUBBG=.TRUE.

  IF(NLANTYPE == 4) THEN
    YL_ZVAZX%data = YD_PVEIG%data * YRSCALPSQRT%data
  ENDIF

  ZNORM4=DOT_PRODUCT(YL_ZVAZX,YL_ZVAZX,YSCALP)
  ZNORM4=SQRT(ZNORM4)
  YL_ZVAZX%data = YL_ZVAZX%data / ZNORM4

  CALL ALLGATHER_CTLVEC(YD_PVEIG,ZWRK1)
  CALL ALLGATHER_CTLVEC(YL_ZVEC1,ZWRK2)
  CALL ALLGATHER_CTLVEC(YL_ZVEC2,ZWRK3)
  CALL ALLGATHER_CTLVEC(YL_ZVAZX,ZWRK4)

  IUIT=ivadim/50
  DO J=1,ivadim,IUIT
    WRITE(NULOUT,188) J,ZWRK1(J),ZWRK2(J),ZWRK3(J),ZWRK4(J)
    WRITE(NULUSR4,188) J,ZWRK1(J),ZWRK2(J),ZWRK3(J),ZWRK4(J)
  ENDDO
  188 FORMAT(I7,4(E12.5,1X))
ENDIF

CALL DEALLOCATE_CTLVEC(YL_ZDV1)
CALL DEALLOCATE_CTLVEC(YL_ZDV2)
CALL DEALLOCATE_CTLVEC(YL_ZVAZX)
CALL DEALLOCATE_CTLVEC(YL_ZVAZY)
CALL DEALLOCATE_CTLVEC(YL_ZVEC1)
CALL DEALLOCATE_CTLVEC(YL_ZVEC2)
CALL DEALLOCATE_CTLVEC(YL_ZVEC3)
DEALLOCATE(ZWRK1)
DEALLOCATE(ZWRK2)
DEALLOCATE(ZWRK3)
DEALLOCATE(ZWRK4)

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

