SUBROUTINE CVA2

!     *CVA2*  - Controls variational assimilation job at level 2.

!     Purpose.
!     --------
!           Controls variational assimilation job at level 2.

!     Interface.
!     ----------
!        *CALL* *CVA2

!     Externals.   SIM4D  - simulator (for X computes J and grad(J) )
!     ----------   PROSCA - scalar product computation (for M1QN3 only)
!                  CTONB  - change of base (for M1QN3 only)
!                  CTCAB  - change of base inverse (for M1QN3 only)
!                  M1QN3  - minimization algorithm (X = 2 or 3)
!                  N1CG1  - minimization algorithm
!                  CONGRAD - minimization algorithm

!     Reference.
!     ----------

!     Author.
!     -------
!        Y. Tremolet

!     Modifications.
!     --------------
!        Original : 00-06-16
!          Split from CVA1.
!        2001-10-17 M. Fisher: added CONGRAD minimization algorithm
!        2002-08-07 Y.Tremolet: use control_vectors
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        Y.Tremolet    18-Mar-2004 Tests of 4D-Var components
!        D. Dee        19-Mar-2004 Variational bias correction
!        G. Radnoti    03-Dec-2004 Backward tl propagation + tltest enabling
!        Y.Tremolet    04-Nov-2004 Save eigenvectors and diags if bad conv.
!        Y.Tremolet    17-Feb-2009 Added ADJOTEST
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMVAR   , ONLY : NITER    ,NSIMU    ,NITER_MIN ,NINFRA   ,NMIMP    ,&
 & NSIM4D   ,NDIAG    ,NSIM4DL  ,NUPTRA   ,RDX      ,&
 & RXMIN    ,RCVGE    ,R_NORM_REDUCTION_ABORT_LEVEL ,&
 & L_CHECK_CONVERGENCE,LCONGRAD ,NPCVECS  ,&
 & L3DFGAT  ,ZEPSNEG  ,LN1CG1   ,N1IMP    ,NSELECT  ,&
 & NPRECO   ,NBFGSB   ,LWRIEVEC ,LSKIPMIN           ,&
 & L_INFO_CONTENT     ,N_INFO_CONTENT_METHOD        ,&
 & N_INFO_CONTENT_SEED          ,LTOVSCV  ,EVBCGL   ,&
 & LVARBC, N_DIAGS_CONVERGENCE, N_DIAGS_EIGENVECS   ,&
 & LPROPTL, RTOL_CHECK_GRADIENT, L_ABS_CONVERGENCE  ,&
 & L_INFO_CONVERGENCE, LTSCV, LMODERR, LJBIMPACT, LJCIMPACT
USE YOMCVA   , ONLY : YVAZX, YVAZG, YVAZ0, YSCALPSQRT, YRSCALPSQRT
USE YOMCT0   , ONLY : NCONF    ,LOBS     ,NSTOP ,LELAM  
USE YOMCT1   , ONLY : N1POS    ,N1GDI    ,N1SDI
USE YOMLUN   , ONLY : NULOUT   ,NULERR
USE YOMIOMI  , ONLY : NMUPD    ,LWARM_RD ,LWARM_WR
USE YOMCOSJO , ONLY : LVARQC   ,NITERQC
USE YOMMP    , ONLY : MYPROC   ,NPSP
USE YOMTNEWT , ONLY : LIDMODEL
USE YOMCMA   , ONLY : NRESUPD
USE YOMDIM   , ONLY : NFD2D,NFLSUR,NSPEC2,NS3D,NS2D,NFLEVG
USE YOMSP    , ONLY : SPA3     ,SPA2     ,SPA1, &
 & SPA3INI, SPA2INI, SPA1INI
USE YOMSPJB  , ONLY : SP7A3    ,SP7A2, SP7A1
USE YOMTVRAD , ONLY : TOVSCVX  ,TOVSCVBG
USE YOMANCS  , ONLY : RMDI
USE YOMVCGL  , ONLY : YVCGLEV, RCGLEV, NVCGLEV
USE TESTVAR_MIX, ONLY: NTESTVAR, LCVTEST, LINTEST, LTLTEST, LADTEST, LGRTEST
USE YOMJG    , ONLY : LSUBBG, LCTLFG
USE CONTROL_VECTORS
USE RANDOM_NUMBERS_MIX
USE YOMTS    , ONLY : TSCVX    ,TSCVBG

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

IMPLICIT NONE

! * LOCAL EXTERNAL FUNCTIONS:
EXTERNAL CTONB,CTCAB
! * LOCAL TYPE "control_vector" VARIABLES:
TYPE(control_vector) :: YL_ZYBAR0(NMUPD),YL_ZSBAR0(NMUPD)
TYPE(control_vector) :: YL_ZYBAR1(NMUPD),YL_ZSBAR1(NMUPD)
TYPE(control_vector) :: YL_ZYBAR(NMUPD),YL_ZSBAR(NMUPD)
TYPE(control_vector) :: YL_ZDIAG, YL_ZLANCZOS, YL_ZVAZXAN, YL_ZVAZGAN, YLX
TYPE(control_vector) :: YLCGLWK(niter+1)

TYPE(randomNumberStream) :: YL_RANDOM_STREAM_INFO

INTEGER(KIND=JPIM) :: IMP, INDIC, INFO, INMUPD, IIO, ISIM, ITER, JUPD, &
 & IDUM, IVADIM  
INTEGER(KIND=JPIM) ::  ISTORE0,ISTORE1,IILM0,IILM1,INEVECS,J, jj

INTEGER(KIND=JPIM) :: ITBMIN(5),ILM0(NMUPD+3),ILM1(NMUPD+3)

REAL(KIND=JPRB) :: ZDF1, ZDX, ZEPS, ZF, ZFE, ZFI, ZGE, ZGI, ZVAZGNO, ZGOLUBL_INV, ZGOLUBU_INV, &
 & ZGOLUBL_LOG, ZGOLUBU_LOG  
REAL(KIND=JPRB) :: ZSIZE0,ZSIZE1,zwork(niter+1,4)

REAL(KIND=JPRB), ALLOCATABLE :: ZRAND(:)

LOGICAL :: LLGOLUB, LLSUBBG, LLFAIL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "chavarin.intfb.h"
#include "congrad.intfb.h"
#include "grtest.intfb.h"
#include "n1cg1.h"
#include "prosca.intfb.h"
#include "savhess.intfb.h"
#include "savmini.intfb.h"
#include "prt_ctlvec_norms.intfb.h"
#include "setran.intfb.h"
#include "sim4d.intfb.h"
#include "suhess.intfb.h"
#include "svvarbc.intfb.h"
#include "writeoba.intfb.h"
#include "xformev.intfb.h"
#include "tltest.intfb.h"
#include "adtest.intfb.h"
#include "cvtest.intfb.h"
#include "litest.intfb.h"
#include "prt_conv_diags.intfb.h"
#include "save_evecs.intfb.h"
#include "tlprop.intfb.h"
#include "write_ctlvec_grib.intfb.h"
#include "adjotest.intfb.h"
#include "djbdy.intfb.h"
#include "djcdy.intfb.h"
!     ------------------------------------------------------------------

!        1.  Compute initial cost-function and gradient.
!            -------------------------------------------

IF (LHOOK) CALL DR_HOOK('CVA2',0,ZHOOK_HANDLE)
WRITE(NULOUT,*) '--- Variational job : initial call to ',&
 & 'simulator ----------------------------'  

IF (L3DFGAT) THEN
  LIDMODEL=.TRUE.
ENDIF

IDUM=-999
ZF=0.0_JPRB
NSIM4D=0
N1POS=1
N1SDI=1
N1GDI=1
IF (LPROPTL) THEN
  CALL ALLOCATE_CTLVEC(YLX)
  YLX=YVAZX
  LLSUBBG=LSUBBG
  LSUBBG=.FALSE.
  CALL CHAVARIN(YLX)
  IF (.NOT. ALLOCATED(SPA3INI)) ALLOCATE(SPA3INI(NFLSUR,NSPEC2,NS3D))
  IF (.NOT. ALLOCATED(SPA2INI)) ALLOCATE(SPA2INI(NSPEC2,NS2D))
  IF (LELAM .AND. .NOT. ALLOCATED(SPA1INI)) ALLOCATE(SPA1INI(NFLEVG,2))
  SPA3INI=SPA3
  SPA2INI=SPA2
  IF (LELAM) SPA1INI=SPA1
  LSUBBG=LLSUBBG
  CALL DEALLOCATE_CTLVEC(YLX)
ENDIF

CALL SIM4D(4,IDUM,YVAZX,ZF,YVAZG,NSIM4D)
ZVAZGNO=0.0_JPRB
ZFI=ZF
CALL PROSCA(IDUM,YVAZG,YVAZG,ZVAZGNO)
ZGI=ZVAZGNO
WRITE(UNIT=NULOUT,FMT='('' INITIAL GRADIENT NORM SQUARED : ''&
 & ,E14.7,'' COST FUNCTION : '',E14.7)')&
 & ZGI,ZFI  

!        1.2   CHECK GRADIENT.

IF (NTESTVAR==1 .OR. NTESTVAR==3) THEN
  NDIAG=0
  N1POS=0
  N1SDI=1
  N1GDI=0
  IF (LCVTEST) CALL CVTEST
  IF (LINTEST) CALL LITEST(YVAZX)
  IF (LADTEST) CALL ADTEST
  IF (LADTEST) CALL ADJOTEST
! TL test cannot be run before the minimisation without changing the
! result. This is in particular due to the switches and values which
! are changed in CVA1 after the call to CNT2. These changes cannot
! be switched on and off easily for the test and then back again. If
! you don't mind this, uncomment the following line.
! Otherwise, just dream of a future where the IFS would be modular...
! GR: Problem seems to be solved...==> next line uncommented
! IF (LTLTEST) CALL TLTEST(YVAZX)
  IF (LGRTEST) CALL GRTEST(SIM4D,PROSCA,YVAZX,RDX,8,NULOUT)
  NDIAG=1
ENDIF

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

!        2.    Minimization.
!              -------------

!        2.1   Initialize.

ZDX = RXMIN
ZDF1=ZF/NINFRA
IF (L_ABS_CONVERGENCE) THEN
  ZEPS=SQRT(RCVGE/ZGI)
ELSE
  ZEPS=RCVGE
ENDIF
IMP=NMIMP
IIO=NULOUT
ITER=NITER
ISIM=NSIMU
N1POS=0
N1GDI=0
INFO=0
IF ( LWARM_RD .AND. NCONF==131 )INFO=2
IVADIM=YVAZX%NSIZEG

!        2.2   Initialization for N1CG1

ISTORE0=NMUPD
ISTORE1=NMUPD
IILM0=ISTORE0+3
IILM1=ISTORE1+3

!        2.3   Minimize.

WRITE(NULOUT,*) ' '
IF (ZFI < SQRT(TINY(ZFI))) THEN
  WRITE(NULOUT,*) '--- Initial cost is tiny: Skipping the minimization ---'
ELSEIF (LSKIPMIN) THEN
  WRITE(NULOUT,*) '--- Force skipping the minimization ---'
ELSEIF (LN1CG1) THEN
  WRITE(NULOUT,*) '--- Variational job : minimization ',&
   & '(Preconditioned  CG  method)-----------'  
  IF (NPRECO == 2) THEN
    DO JUPD = 1,ISTORE0
      CALL ALLOCATE_CTLVEC(YL_ZYBAR0(JUPD))
      CALL ALLOCATE_CTLVEC(YL_ZSBAR0(JUPD))
    ENDDO

!---- Read the BFGS approximation to the Hessian (for N1CG1 warm start)

    CALL SUHESS (ISTORE0,YL_ZDIAG,YL_ZYBAR0,YL_ZSBAR0,&
     & ITBMIN,ILM0,IILM0,ZSIZE0,LWARM_RD)  
  ENDIF

  IF (NBFGSB == 2) THEN
    DO JUPD = 1,ISTORE1
      CALL ALLOCATE_CTLVEC(YL_ZYBAR1(JUPD))
      CALL ALLOCATE_CTLVEC(YL_ZSBAR1(JUPD))
    ENDDO
  ENDIF

  CALL N1CG1 (SIM4D,IVADIM,YVAZX,ZEPSNEG,ZEPS,ITER,N1IMP,IIO,INFO,&
   & NPRECO,ISTORE0,ILM0,IILM0,YL_ZYBAR0,YL_ZSBAR0,ZSIZE0,&
   & NBFGSB,ISTORE1,ILM1,IILM1,YL_ZYBAR1,YL_ZSBAR1,ZSIZE1,&
   & NSELECT,NUPTRA,ZF,YVAZG,YSCALPSQRT,YRSCALPSQRT)  

  IF (NPRECO == 2) THEN
    DO JUPD = 1,ISTORE0
      CALL DEALLOCATE_CTLVEC(YL_ZYBAR0(JUPD))
      CALL DEALLOCATE_CTLVEC(YL_ZSBAR0(JUPD))
    ENDDO
  ENDIF

!---- Save the BFGS approximation to the Hessian (for N1CG1 warm start)

  IF (NBFGSB == 2) THEN
    IF( LWARM_WR )THEN
      CALL SAVHESS(ITBMIN,YL_ZDIAG,YL_ZYBAR1,YL_ZSBAR1,ISTORE1,&
       & ILM1,IILM1,ZSIZE1)  
    ENDIF
    DO JUPD = 1,ISTORE1
      CALL DEALLOCATE_CTLVEC(YL_ZYBAR1(JUPD))
      CALL DEALLOCATE_CTLVEC(YL_ZSBAR1(JUPD))
    ENDDO
  ENDIF
ELSEIF (LCONGRAD) THEN
  CALL ALLOCATE_CTLVEC(YL_ZLANCZOS)
  DO jj=1,niter+1
    CALL allocate_ctlvec(YLCGLWK(jj))
  ENDDO

  IF (L_INFO_CONTENT) THEN

!== For the analysis-difference method, compute and save the unperturbed analysis

    IF (N_INFO_CONTENT_METHOD==2) THEN
      ITER=NITER/2
      INEVECS=ITER+1
      CALL CONGRAD (YVAZX,YVAZG,YL_ZLANCZOS,ZEPS,EVBCGL,ITER,INEVECS, &
       & NITER_MIN, &
       & ZGOLUBU_INV, ZGOLUBL_INV, ZGOLUBU_LOG, ZGOLUBL_LOG, &
       & YLCGLWK,zwork, &
       & LDEVECS=.FALSE., LDSOLVE=.TRUE., LD_LGOLUB=.FALSE., &
       & LD_INFO_CONVERGENCE=L_INFO_CONVERGENCE)  
      CALL ALLOCATE_CTLVEC(YL_ZVAZXAN)
      YL_ZVAZXAN=YVAZX
    ENDIF

!== generate a random vector in the Euclidean inner-prouct space

    ALLOCATE (ZRAND(YL_ZLANCZOS%nsizeg))
    CALL SETRAN (N_INFO_CONTENT_SEED,YL_RANDOM_STREAM_INFO)
    CALL UNIFORM_DISTRIBUTION (ZRAND,YL_RANDOM_STREAM_INFO)
    WHERE (ZRAND(:)>0.5_JPRB)
      ZRAND(:)=1.0_JPRB
    ELSEWHERE
      ZRAND(:)=-1.0_JPRB
    ENDWHERE
    YL_ZLANCZOS = ZRAND(:)
    DEALLOCATE (ZRAND)
    YL_ZLANCZOS%data = YL_ZLANCZOS%data * YRSCALPSQRT%data

    IF (N_INFO_CONTENT_METHOD==1) THEN
      LLGOLUB = .TRUE.
    ELSEIF (N_INFO_CONTENT_METHOD==2) THEN
      ITER = NITER/2

!== save the perturbation
      CALL ALLOCATE_CTLVEC(YL_ZVAZGAN)
      YL_ZVAZGAN=YL_ZLANCZOS

!== take the perturbation to model space and perturb the background
      YL_ZLANCZOS%data = -YL_ZLANCZOS%data * YRSCALPSQRT%data
      CALL CHAVARIN (YL_ZLANCZOS)
      SP7A3(:,:,:) = SPA3(:,:,:)
      IF(NPSP == 1) SP7A2(:,1:NFD2D) = SPA2(:,1:NFD2D)
      IF (LELAM) SP7A1(:,:) = SPA1(:,:)
      IF(LTOVSCV) THEN
        WHERE(TOVSCVBG(:,:) /= RMDI) TOVSCVBG(:,:) = TOVSCVX(:,:)
      ENDIF
      IF (LTSCV) THEN
        WHERE(TSCVBG(:)/=RMDI) TSCVBG(:)=TSCVX(:)
      ENDIF


!== calculate starting gradient for the perturbed analysis
      YVAZX=0.0_JPRB
      CALL SIM4D(4,IDUM,YVAZX,ZF,YVAZG,NSIM4D)
      YL_ZLANCZOS = YVAZG
      LLGOLUB = .FALSE.
    ENDIF
  ELSE
    YL_ZLANCZOS = YVAZG
    YL_ZLANCZOS%data = -YVAZG%data
    LLGOLUB = .FALSE.
  ENDIF

  WRITE(NULOUT,*) '--- Variational job : minimization ',&
   & '(Lanczos method)------------------'  

  INEVECS=ITER+1
  CALL CONGRAD (YVAZX,YVAZG,YL_ZLANCZOS,ZEPS,EVBCGL,ITER,INEVECS, &
   & NITER_MIN, &
   & ZGOLUBU_INV,ZGOLUBL_INV, ZGOLUBU_LOG, ZGOLUBL_LOG, &
   & YLCGLWK,zwork, &
   & LDEVECS=LWRIEVEC, LDSOLVE=.TRUE., LD_LGOLUB=LLGOLUB, &
   & LD_INFO_CONVERGENCE=L_INFO_CONVERGENCE)
  CALL DEALLOCATE_CTLVEC(YL_ZLANCZOS)

  IF (L_INFO_CONTENT) THEN
    IF (N_INFO_CONTENT_METHOD==1) THEN
      WRITE (NULOUT,*) 'Entropy reduction (upper bound) =',ZGOLUBU_LOG
      WRITE (NULOUT,*) 'Entropy reduction (lower bound) =',ZGOLUBL_LOG
      WRITE (NULOUT,*) 'Degrees of freedom for signal (upper bound) =',ZGOLUBU_INV
      WRITE (NULOUT,*) 'Degrees of freedom for signal (lower bound) =',ZGOLUBL_INV
    ELSE
      YVAZX%data=(YVAZX%data-YL_ZVAZXAN%data) * YSCALPSQRT%data
      ZVAZGNO = -DOT_PRODUCT (YL_ZVAZGAN,YVAZX)
      WRITE (NULOUT,*) 'Degrees of freedom for signal = ',ZVAZGNO
      CALL DEALLOCATE_CTLVEC(YL_ZVAZXAN)
      CALL DEALLOCATE_CTLVEC(YL_ZVAZGAN)
    ENDIF
  ENDIF

  IF (LJBIMPACT) CALL DJBDY(iter,niter,YLCGLWK,zwork,YVAZX,YVAZ0)
  IF (LJCIMPACT) CALL DJCDY(iter,niter,YLCGLWK,zwork,YVAZX,YVAZ0)

  DO jj=1,niter+1
    CALL deallocate_ctlvec(YLCGLWK(jj))
  ENDDO

!--- calculate and write out preconditioner vectors

  IF (LWRIEVEC) THEN
    INEVECS = NPCVECS + NVCGLEV
    IF (INEVECS>0) CALL XFORMEV (INEVECS,.FALSE.)
  ENDIF
ELSE

  WRITE(NULOUT,*) '--- Variational job : minimization ',&
   & '(quasi-Newton method)------------------'  
  CALL ALLOCATE_CTLVEC(YL_ZDIAG)
  INMUPD=NMUPD
  DO JUPD=1,INMUPD
    CALL ALLOCATE_CTLVEC(YL_ZYBAR(JUPD))
    CALL ALLOCATE_CTLVEC(YL_ZSBAR(JUPD))
  ENDDO

!---- Read the BFGS approximation to the Hessian (for m1qn3 warm start)

  CALL SUHESS (NMUPD,YL_ZDIAG,YL_ZYBAR,YL_ZSBAR,ITBMIN,&
   & ILM0,IILM0,ZSIZE0,LWARM_RD)  

  CALL M1QN3(SIM4D,PROSCA,CTONB,CTCAB,IVADIM,YVAZX,ZF,YVAZG,ZDX,&
   & ZDF1,ZEPS,IMP,IIO,INFO,&
   & ITER,ISIM,ITBMIN,NMUPD,INMUPD,YL_ZDIAG,YL_ZYBAR,YL_ZSBAR)  

  WRITE(NULOUT,*) 'Output mode of m1qn3=',INFO,' which means :'
  IF(INFO<0)  WRITE(NULOUT,*) ' simulator returned indic<0'
  IF(INFO==0) WRITE(NULOUT,*) ' simulator returned indic=0'
  IF(INFO==1) WRITE(NULOUT,*) ' gradient test is satisfied'
  IF(INFO==2) WRITE(NULOUT,*) ' error in m1qn3 input arguments'
  IF(INFO==3) WRITE(NULOUT,*) ' line-search blocked on tmax'
  IF(INFO==4) WRITE(NULOUT,*) ' max number of iterations reached'
  IF(INFO==5) WRITE(NULOUT,*) ' max number of simulations reached'
  IF(INFO==6) WRITE(NULOUT,*) ' line-search blocked on dxmin'
  IF(INFO==7) WRITE(NULOUT,*) ' bad gradient, line-search failed'
  IF(INFO>7)  WRITE(NULOUT,*) '   (unknown output mode ???)'

  IF (MYPROC == 1) THEN
    IF (INFO<0.OR. INFO==2.OR. INFO==3.OR. INFO>6) THEN

      WRITE (NULERR,*) 'CONVERGENCE CHECK FAILS: '//&
       & 'OUTPUT MODE OF M1QN3 UNACCEPTABLE ',INFO  
      LLFAIL=.TRUE.
      IF (INFO==2) L_CHECK_CONVERGENCE=.TRUE.
    ENDIF
  ENDIF

!--- Save the BFGS approximation to the Hessian (for m1qn3 warm start)

  IF( LWARM_WR )THEN
    CALL SAVHESS(ITBMIN,YL_ZDIAG,YL_ZYBAR,YL_ZSBAR,INMUPD,&
     & ILM0,IILM0,ZSIZE0)  
  ENDIF

ENDIF

!     Variational quality control is disabled after a short minimization
!     On output m1qn3 returns the number of iterations done in ITER
IF (ITER<NITERQC) THEN
  LVARQC(:,:)=.FALSE.
  WRITE(NULOUT,*) 'ITER<NITERQC, FORCING LVARQC=.FALSE.'
ENDIF
WRITE(NULOUT,*) ' '
!     ------------------------------------------------------------------

!        3.    Test of the quality of the minimization.
!              ----------------------------------------

!        3.1   Diagnose decrease of cost-function and gradient norm.

IF (LCONGRAD) THEN
  CALL ALLOCATE_CTLVEC(YL_ZLANCZOS)
  YL_ZLANCZOS%data(:) = YVAZG%data(:)
ENDIF

WRITE(NULOUT,*) '--- Variational job : final call to simulator ',&
 & '-----------------------------'  
N1SDI=1
N1GDI=1
N1POS=1
INDIC=4
ZF=0.0_JPRB
NSIM4D=NSIM4DL
CALL SIM4D(INDIC,IDUM,YVAZX,ZF,YVAZG,NSIM4D)
ZVAZGNO=0.0_JPRB
CALL PROSCA(IDUM,YVAZG,YVAZG,ZVAZGNO)
ZFE=ZF
ZGE=ZVAZGNO
WRITE(UNIT=NULOUT,FMT='(''   FINAL GRADIENT NORM SQUARED : ''&
 & ,E14.7,'' COST FUNCTION : '',E14.7)')&
 & ZGE,ZFE  
WRITE(NULOUT,*) '--- Variational job : diagnose quality of the ',&
 & 'minimization ----------------'  
IF(ZFI <= 0.0_JPRB) ZFI=1.0_JPRB
IF(ZGI <= 0.0_JPRB) ZGI=1.0_JPRB

WRITE(UNIT=NULOUT,FMT='('' RATIO FINAL/INITIAL GRADIENT SQUARED : ''&
 & ,E14.7,'' COST FUNCTION : '',E14.7)')&
 & ZGE/ZGI,ZFE/ZFI

WRITE(NULOUT,'(A,ES10.3)')'Ratio final/initial gradient norm = ',sqrt(ZGE/ZGI)
WRITE(NULOUT,'(A,ES10.3)')'Ratio final/initial cost function = ',ZFE/ZFI

! Check CONGRAD's idea of the gradient against SIM4D's.

LLFAIL=.FALSE.

IF (LCONGRAD) THEN
  YL_ZLANCZOS%data(:) = YL_ZLANCZOS%data(:) - YVAZG%data(:)
  CALL PROSCA(IDUM,YL_ZLANCZOS,YL_ZLANCZOS,ZVAZGNO)
  ZVAZGNO=SQRT(ZVAZGNO/MAX(ZGE,1E-20_JPRB))
  WRITE(NULOUT,*) 'Relative Error of CONGRAD''s gradient = ',ZVAZGNO
  IF (ZVAZGNO>RTOL_CHECK_GRADIENT) THEN
    WRITE (NULERR,*) 'ACCURACY-OF-GRADIENT CHECK FAILS:'
    LLFAIL=.TRUE.
    CALL WRITE_CTLVEC_GRIB ('gradient_error',YL_ZLANCZOS)
  ENDIF
  CALL DEALLOCATE_CTLVEC(YL_ZLANCZOS)
ENDIF

! Before checking convergence because it is when the minimisation
! does not converge that these tests are needed the most.
IF (NTESTVAR==2 .OR. NTESTVAR==3) THEN
  NDIAG=0
  N1POS=0
  IF (LCVTEST) CALL CVTEST
  IF (LINTEST) CALL LITEST(YVAZX)
  IF (LADTEST) CALL ADTEST
  IF (LADTEST) CALL ADJOTEST
  IF (LTLTEST) CALL TLTEST(YVAZX)
  IF (LGRTEST) CALL GRTEST(SIM4D,PROSCA,YVAZX,RDX,8,NULOUT)
ENDIF
IF (LPROPTL) THEN
  N1SDI=1
  N1POS=1
  CALL TLPROP(YVAZX)
ENDIF

IF (ZGE/ZGI  >  R_NORM_REDUCTION_ABORT_LEVEL .AND. &
   & .NOT. LSKIPMIN .AND. &
   & .NOT.(L_INFO_CONTENT .AND. N_INFO_CONTENT_METHOD==1)) THEN  
  WRITE (NULERR,*) 'CONVERGENCE CHECK FAILS:'
  WRITE (NULERR,*) 'REDUCTION IN GRADIENT NORM SQUARED EXCEEDS',&
   & R_NORM_REDUCTION_ABORT_LEVEL  
  LLFAIL=.TRUE.
ENDIF

IF (LLFAIL) THEN
  IF (N_DIAGS_CONVERGENCE>=1) CALL PRT_CONV_DIAGS
  IF (L_CHECK_CONVERGENCE) THEN
    IF (N_DIAGS_EIGENVECS>=1) CALL SAVE_EVECS
    CALL ABOR1 ('CVA2: CONVERGENCE CHECK FAILS')
  ELSE
    WRITE (NULOUT,*)'ABORT DISABLED BECAUSE L_CHECK_CONVERGENCE==.FALSE.'
  ENDIF
ELSE
  IF (N_DIAGS_CONVERGENCE>=2) CALL PRT_CONV_DIAGS
  IF (N_DIAGS_EIGENVECS  >=2) CALL SAVE_EVECS
ENDIF

!--- deallocate the eigenvector arrays
IF (LCONGRAD) THEN
  IF (ALLOCATED(YVCGLEV)) THEN
    DO J=1,SIZE(YVCGLEV)
      CALL deallocate_ctlvec(YVCGLEV(J))
    ENDDO
    DEALLOCATE (YVCGLEV)
  ENDIF
  IF (ALLOCATED(RCGLEV)) DEALLOCATE (RCGLEV)
ENDIF
IF (ALLOCATED(SPA3INI)) DEALLOCATE(SPA3INI)
IF (ALLOCATED(SPA2INI)) DEALLOCATE(SPA2INI)
IF (ALLOCATED(SPA1INI)) DEALLOCATE(SPA1INI)
!     ------------------------------------------------------------------

!      4.  Save results of variational job.
!          --------------------------------

!      4.1   Write the control vector

!              SAVMINFP performs internal FullPos - Not Yet!
!              Instead, use normal MX-files, produced by STEPO elsewhere.
!              SAVMINI not needed for 3d-var.

IF (NCONF==131) THEN
  IF(NSTOP > 0.AND.NUPTRA /= NRESUPD-1) THEN
    WRITE(NULOUT,*) '--- Variational job : write the control',&
     & ' vector ----------------------------'  
    IF (LCTLFG) THEN
      YVAZX%data(:)=YVAZX%data(:)+YVAZ0%data(:)
    ELSEIF (LMODERR) THEN
      YVAZX%moderr(:)=YVAZX%moderr(:)+YVAZ0%moderr(:)
    ENDIF
    CALL SAVMINI (YVAZX)
  ENDIF
  IF (LVARBC) CALL SVVARBC(YVAZX%PARAMS,YVAZX%NPARA)
  IF (N_DIAGS_CONVERGENCE<=1) CALL PRT_CTLVEC_NORMS(YVAZX,'YVAZX')
ENDIF

!      4.2 Save observation files with feed-back diagnostics.

IF (LOBS ) THEN
  CALL GSTATS(47,0)
  WRITE(NULOUT,*) '--- Variational job : write final obs ',&
   & 'files -------------------------------'  
  WRITE(NULOUT,'('' ** WRITE-OUT OBS.  '')')
  CALL WRITEOBA
  CALL GSTATS(47,1)
ENDIF

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

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