SUBROUTINE NALAN2(KDIM,KITER,KINNER,KWEIG,PKAPA,PVATRA)

!**** *NALAN2* - Level 1 control for unstable modes computation

!     Purpose.
!     --------
!        Make a Jacobi-Davidson call to compute the eigensystem

!**   Interface.
!     ----------
!        *CALL* *NALAN2 (KDIM,KITER,KINNER,KWEIG,PKAPA,PVATRA)

!        Explicit arguments:
!        -------------------
!        - KDIM    : problem dimension
!        - KITER   : maximum number of JD iterations
!        - KINNER  : inner iterations
!        - KWEIG   : maximum number of wanted eigenvalues
!        - PKAPA   : acceptable precision for the eigenvalues
!     Externals:
!     ----------
!        - JACDAV

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

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

!        J. Barkmeijer  : adapted from NALAN1 by R. Buizza
!        Mike Fisher    : 97-11-26 - Distributed memory version
!        Y.Tremolet     : 02-08-08 - Use control_vectors.
!        M.Hamrud      01-May-2006 Generalized IO scheme
!     -----------------------------------------------------------------

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

USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : NCONF
USE YOMCVA   , ONLY : YRSCALPSQRT
USE YOMLCZ   , ONLY : NLANTYPE ,LNEWNORMT0, LRENORMALIZE, &
 & NRITZREAD, NRITZNUMB, NRITZGBH1, NRITZGBH2
USE YOMJG    , ONLY : LSUBBG
USE CONTROL_VECTORS_COMM_MOD
USE CONTROL_VECTORS
USE IOSTREAM_MIX , ONLY : SETUP_IOSTREAM,TYPE_IOSTREAM,CLOSE_IOSTREAM

IMPLICIT NONE

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

!  EXTRA ARRAYS

INTEGER(KIND=JPIM),INTENT(IN)    :: KDIM 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KITER
INTEGER(KIND=JPIM),INTENT(IN)    :: KINNER 
INTEGER(KIND=JPIM),INTENT(IN)    :: KWEIG 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PKAPA 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVATRA(KDIM) 
INTEGER(KIND=JPIM) ::          INEIG, INNER, ISTART
REAL(KIND=JPRB) ::             ZEPS
REAL(KIND=JPRB) ::             ZRITZ(KITER)

TYPE (control_vector), DIMENSION(KITER) :: YL_ZV,YL_ZAV,YL_ZBV

!     -----------------------------------------------------------------
TYPE (control_vector) :: YL_ZVEIG, YL_ZWORK
TYPE(TYPE_IOSTREAM)  ::  YL_IOSTR_SVIFS

INTEGER(KIND=JPIM) :: i, IBND, IEIGOK, IERR,  IMSGLVL, IOMASTER,&
 & IRITZ, IRITZREAD, ITER, ITYPE, J, JEIG, &
 & JN, idum  

REAL(KIND=JPRB) ::  ZNORM, ZPREC
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "cainin.intfb.h"
#include "chavarin.intfb.h"
#include "chnorm.intfb.h"
#include "chsymeig.intfb.h"
#include "cvaru2i.intfb.h"
#include "jacdav.intfb.h"
#include "lcztoifs.intfb.h"
#include "scaas.intfb.h"
#include "suscal.intfb.h"
#include "wrtllcz.intfb.h"

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

!*    1. Memory check
!     ---------------

IF (LHOOK) CALL DR_HOOK('NALAN2',0,ZHOOK_HANDLE)
WRITE(NULOUT,*) 'KDIM= ',KDIM
!     -----------------------------------------------------------------

!*    2. Compute pointers
!     -------------------

!     Compute pointer for ZRITZ

IRITZ=1

!     Compute pointer for ZEps

IBND=KITER+1

!*    2.5 Allocate distributed vectors
!     --------------------------------

DO i=1,KITER
  call ALLOCATE_CTLVEC(YL_ZV(i))
  call ALLOCATE_CTLVEC(YL_ZAV(i))
  call ALLOCATE_CTLVEC(YL_ZBV(i))
ENDDO

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

!*    3. Specify constants for Lanczos algorith (routine LANSO)
!     ---------------------------------------------------------
!        ZCONDM : estimate condition number for M
!        ZENDL  : left end of the interval containing the wanted eigenvalues
!        ZENDR  : right end of the interval containing the wanted eigenvalues
!        IEV    : eigensystem output unit of the Lanczos code (pseudo-variables)
!                 - if IEV.GT.0 both the eigenvalues and the eigenvectors are
!                   wanted, and IEV is the output unit
!                 - if IEV.LE.0 only eigenvalues
!        IMSGLVL:

IMSGLVL=5

!c      IEV96=NULUSR2
!c      IEV99=NULUSR5
!     -----------------------------------------------------------------

!*    4. Make a jacobi-davidson run;
!     -----------------------------------------------------------

ISTART = 1
INNER=KINNER

!*  create starting vector

YL_ZV(1)=PVATRA(1:KDIM)

! Solve generalized eigensystem with the Jacobi-Davidson method
! of Sleijpen and van der Vorst

! input parameters: istart - number of vectors in start-space
!                   kdim    - NVADIM, dimension of problem
!                   ineig   - number of wanted eigenpairs
!                   zeps    - tolerance, relative residual norm
!                               |Ax - eBx|/|Ax0 - e0 Bx0|
!                   inner  - Number of inner iterations to solve 
!                               Jacobian system
!                   kiter  - maximum number of outer iterations

! On input the first istart columns of ZV must be filled with 
! basis-vectors for an initial space
! On output, the largest ineig eigenvectors are written to disk in 
! descending order, the corresponding eigenvalues are stored in 
! the array zritz
! On output the parameter ineig contains the number of converged 
! eigenpairs

DO J=1,KITER
  ZRITZ(J)=11111._JPRB
ENDDO

ZEPS  = PKAPA
INEIG = KWEIG
ITER  = KITER
IEIGOK =0
IERR =0
CALL JACDAV( ZRITZ, YL_ZV, INEIG, ISTART, KDIM, INNER,ITER, ZEPS, YL_ZAV, YL_ZBV)

WRITE(NULOUT,*) 'EIGENVALUES FOUND BY JD, INEIG= ',INEIG
WRITE(NULOUT,*)
DO J=1,ITER
  WRITE(NULOUT,*) J,ZRITZ(J)
ENDDO

WRITE(NULOUT,'('' >> Sub NALAN2 <<'')')
WRITE(NULOUT,'('' JD parameters after call JACDAV'')')
WRITE(NULOUT,'('' - problem dim          = '',I10)') KDIM
WRITE(NULOUT,'('' - max num of iter      = '',I10)') KITER
WRITE(NULOUT,'('' - num of iter performed= '',I10)') ITER
WRITE(NULOUT,'('' - max num of wanted eig= '',I10)') KWEIG
WRITE(NULOUT,'('' - number of eigs found = '',I10)') INEIG
WRITE(NULOUT,'('' - JD steps taken      = '',I10)')  ITER
WRITE(NULOUT,'('' - JD inner iterations = '',I10)')  INNER
WRITE(NULOUT,'('' - OK pairs for machine = '',I10)') IEIGOK
WRITE(NULOUT,'('' - accept accuracy      = '',E10.5)') PKAPA
WRITE(NULOUT,'('' - Error status         = '',I10)') IERR
!     -----------------------------------------------------------------

!     Write in the job output all the eigenvalues

DO JN=1,ITER
  PVATRA(IRITZ-1+JN)=ZRITZ(JN)
  PVATRA(IBND-1+JN)=ZEPS
ENDDO

WRITE (NULOUT,'('' J ** RITZ ** EIG=SQRT(ABS(RITZ)) ** BND'')')
DO JN=1,ITER
  ZPREC=0.0_JPRB
  IF(JN <= INEIG) THEN
    WRITE(NULOUT,'(2X,I3,3(1X,E20.12),'' ** OK **'',1X,E9.4)')&
     & JN, PVATRA(IRITZ-1+JN),&
     & SQRT(ABS(PVATRA(IRITZ-1+JN))), PVATRA(IBND-1+JN), ZPREC  
  ELSE
    WRITE(NULOUT,'(2X,I3,3(1X,E20.12),''         '',1X,E9.4)')&
     & JN, PVATRA(IRITZ-1+JN),&
     & SQRT(ABS(PVATRA(IRITZ-1+JN))), PVATRA(IBND-1+JN), ZPREC  
  ENDIF
ENDDO

WRITE(NULOUT,'('' >> Sub NALAN2 <<'')')

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

!     Open svifs file svifs where SVs(t=0) are going to be written

IOMASTER=1
CALL SETUP_IOSTREAM(YL_IOSTR_SVIFS,'CIO','svifs',CDMODE='w',KIOMASTER=IOMASTER)

!     Define the number of SVs computed and set sector parameter

!     NSEC1(44) = number of SVs computed (to be set later in NALAN2
!                 after call to LANCZOS code)

! INEIG contains the number of converged eigenvectors after jacdav

IRITZREAD=INEIG

NRITZREAD=IRITZREAD

! From Euclidean space to spectral space

IF ((NLANTYPE == 5).OR.(NLANTYPE == 6).OR.&
   & (NLANTYPE == 8).OR.(NLANTYPE == 9)) THEN  
  DO JEIG =1,INEIG
    ITYPE=1
    CALL LCZTOIFS(ITYPE,YL_ZAV(JEIG),YL_ZBV(JEIG))
  ENDDO
ENDIF

CALL ALLOCATE_CTLVEC(YL_ZVEIG)

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

DO JEIG =1,INEIG
!     -----------------------------------------------------------------
!     -----------------------------------------------------------------

!     - output IEV99 (MONTECARLO) from the fastest to the slowest

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

!** check symmetry and some eigenpairs

  IF (NCONF /= 131) THEN
    NCONF=131
    CALL SUSCAL
  ENDIF

  YL_ZVEIG=YL_ZAV(JEIG)
  CALL CHSYMEIG(YL_ZVEIG,ZRITZ,KITER,JEIG,INEIG)

!     5.1 Coordinate transformation

  IF(NLANTYPE == 1) THEN

!     - from pseudo-variables to IFS-variables

    NCONF=601
    CALL SUSCAL

    YL_ZVEIG%data=YL_ZVEIG%data*YRSCALPSQRT%data

!     - redefinition of norm at t0

    IF (LNEWNORMT0) THEN
      CALL ALLOCATE_CTLVEC(YL_ZWORK)
      YL_ZWORK=YL_ZVEIG
      CALL CHNORM(YL_ZWORK,YL_ZVEIG)
      CALL DEALLOCATE_CTLVEC(YL_ZWORK)
    ENDIF

  ELSEIF(NLANTYPE == 2.OR.NLANTYPE == 3) THEN

!     - coord transf from real to complex [ R(-1/2) ]

    CALL ALLOCATE_CTLVEC(YL_ZWORK)

    ITYPE=1
    CALL LCZTOIFS (ITYPE,YL_ZVEIG,YL_ZWORK)

!     - coordinate transformation from the sub-space where the pdf is
!       isotropic to model variables [ V ]

    CALL ABOR1('NALAN2:CALL TO CVARU3I BROKEN/MH')
!    CALL CVARU3I(ZWORK)
    CALL DEALLOCATE_CTLVEC(YL_ZWORK)

!     - from P to T,lnps variables

    CALL CVARU2I

    CALL CAININ (YL_ZVEIG)

  ELSEIF(NLANTYPE == 4) THEN

    NCONF=601
    CALL SUSCAL

    YL_ZVEIG%data=YL_ZVEIG%data*YRSCALPSQRT%data

  ELSEIF((NLANTYPE == 5).OR.(NLANTYPE == 6).OR.&
     & (NLANTYPE == 8).OR.(NLANTYPE == 9)) THEN  

    LSUBBG=.FALSE.

    CALL CHAVARIN (YL_ZBV(JEIG))
    CALL CAININ (YL_ZVEIG)

    LSUBBG=.TRUE.

  ENDIF

  IF(NLANTYPE > 1 .AND. LRENORMALIZE) THEN

!     - renormalize vectors so that to have unitary energy norm

    IF (NCONF /= 601) THEN
      NCONF=601
      CALL SUSCAL
    ENDIF

    idum=-999
    CALL SCAAS(idum,YL_ZVEIG,YL_ZVEIG,ZNORM)
    ZNORM=SQRT(ZNORM)
    WRITE(NULOUT,*) 'NCONF= ',NCONF
    WRITE(NULOUT,'('' >> Sub NALAN2 - Normalization'')')
    WRITE(NULOUT,'('' JEIG, SQRT(<V;E*V>)= '',I4,1X,E12.5)')JEIG,ZNORM
    YL_ZVEIG%data=YL_ZVEIG%data/ZNORM
  ENDIF

!     Define the SVs ordering number and the eigenvalue 
!     Set sector parameter

!     NSEC1(42) = singular vector number 
!     NSEC1(54-55) = they are used to store the ritz numbers (set in
!                    NALAN2). Given RITZ, then:
!                    NSEC1(54)=NINT( LOG10(RITZ)-5 )
!                    NSEC1(55)=NINT( RITZ/( EXP(LOG(10.)*NSEC1(54) )
!                    Thus: RITZ=NSEC1(55)*EXP( LOG(10.)*NSEC1(54) )

  NRITZNUMB=JEIG
  NRITZGBH1=NINT( LOG10(ZRITZ(JEIG))-5 )
  NRITZGBH2=NINT( ZRITZ(JEIG)/(EXP(LOG(10._JPRB)*NRITZGBH1)) )

!     Define the SVs number and the 

!     5.2 Write the results in the output file IEV99 changing the output
!         format (from IFS format to mars format)

  CALL WRTLLCZ(YL_IOSTR_SVIFS,YL_ZVEIG)

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

ENDDO
!     ------------------------------------------------------------------
!     ------------------------------------------------------------------

CALL DEALLOCATE_CTLVEC(YL_ZVEIG)

!     Close svifs file

CALL CLOSE_IOSTREAM(YL_IOSTR_SVIFS)

!*    6. Dellocate distributed vectors
!     --------------------------------

DO i=1,KITER
  call DEALLOCATE_CTLVEC(YL_ZV(i))
  call DEALLOCATE_CTLVEC(YL_ZAV(i))
  call DEALLOCATE_CTLVEC(YL_ZBV(i))
ENDDO

WRITE(*,*) 'EXIT NALAN2'
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('NALAN2',1,ZHOOK_HANDLE)
END SUBROUTINE NALAN2
!     -----------------------------------------------------------------

