SUBROUTINE CVTEST

!     Purpose:
!     --------
!       Test inverse and adjoint change of variable

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

!     Modifications.
!     --------------
!       Original 20-Nov-2003
!       Y.Tremolet    28-Sep-2004 Print test for each component
!       C.Fischer  30-May-2005 Add Ts control variable
!       G. Radnoti 30-Jan-2007 Add CHAVARAD/CHAVAR test for model-error
!     ------------------------------------------------------------------

USE PARKIND1, ONLY: JPIM, JPRB
USE YOMHOOK , ONLY: LHOOK, DR_HOOK
USE YOMLUN  , ONLY: NULOUT
USE YOMJG   , ONLY: LSUBBG
USE YOMCVA  , ONLY: NVA3D, NVA2D, YSCALP, NGRBVAR
USE YOMDIM  , ONLY: NSMAX, NMSMAX
USE YOMVAR  , ONLY: LMODERR
USE YOMWAVELET, ONLY: LJBWAVELET
USE CONTROL_VECTORS
USE SPECTRAL_FIELDS_MOD
USE YOMSPJB,     ONLY: SPJB
! ----------------------------------------------------------------------

IMPLICIT NONE

TYPE(control_vector) :: YLCV_Y, YLCV_A, YLCV_X, YLCV_B
TYPE(control_vector) :: YLCV_A_TMP, YLCV_B_TMP
TYPE(spectral_field) :: YLSP_X, YLSP_B

REAL(KIND=JPRB) :: zz1, zz2, zz3, znorm(6,5),zz1_ini,zz1_moderr, zz2_ini, zz2_moderr
LOGICAL :: llsub, ll1, ll0
INTEGER(KIND=JPIM) :: jj, ISEED
REAL(KIND=JPRB) :: ZHOOK_HANDLE
CHARACTER(LEN=30) :: clfmt

#include "chavar.intfb.h"
#include "chavarin.intfb.h"
#include "chavarinad.intfb.h"
#include "chavarad.intfb.h"
#include "state2spec.intfb.h"
#include "state2specad.intfb.h"
#include "caininad.intfb.h"
#include "cain.intfb.h"
#include "cainad.intfb.h"
#include "cainin.intfb.h"
#include "random_ctlvec.intfb.h"
#include "cdsta.intfb.h"
#include "spec_imzero.intfb.h"
#include "modeltojb.intfb.h"
#include "modeltojbad.intfb.h"
! ------------------------------------------------------------------

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

WRITE(NULOUT,'(A)')' CVTEST ------------------------'
WRITE(NULOUT,'(A)')' CVTEST Start CHAVAR Test'
llsub =LSUBBG
LSUBBG =.false.
LL1=.true.
LL0=.false.

znorm(:,:)=0.0_JPRB
clfmt='(A,4(ES12.6,2X),F8.1)'

CALL ALLOCATE_CTLVEC(YLCV_Y)
CALL ALLOCATE_CTLVEC(YLCV_A)
IF (LMODERR) THEN
  CALL ALLOCATE_CTLVEC(YLCV_X)
  CALL ALLOCATE_CTLVEC(YLCV_B)
ELSE
  CALL ALLOCATE_SPEC(YLSP_X,NSMAX,NMSMAX,NVA3D,NVA2D,0,NGRBVAR)
  CALL ALLOCATE_SPEC(YLSP_B,NSMAX,NMSMAX,NVA3D,NVA2D,0,NGRBVAR)
ENDIF

! ------------------------------------------------------------------
! TEST CHAVARIN/CHAVAR
! ------------------------------------------------------------------

! Random vector and remove the component that projects onto the null space
ISEED=31415
CALL RANDOM_CTLVEC(YLCV_A,LL1,LL1,LL1,LL0,LL0,LL0,ISEED)
CALL CHAVARIN(YLCV_A)
YLCV_A=0.0_JPRB  ! Should not need this
CALL CHAVAR(YLCV_A)

! Test of inverse
CALL CHAVARIN(YLCV_A)
YLCV_Y=0.0_JPRB  ! Should not need this
CALL CHAVAR(YLCV_Y)

CALL CTLVEC_SQNORM(YLCV_A,znorm(1,1),znorm(2,1),znorm(3,1),znorm(4,1), &
                        & znorm(5,1),znorm(6,1))
CALL CTLVEC_SQNORM(YLCV_Y,znorm(1,2),znorm(2,2),znorm(3,2),znorm(4,2), &
                        & znorm(5,2),znorm(6,2))

YLCV_Y%data(:)=YLCV_Y%data(:)-YLCV_A%data(:)
CALL CTLVEC_SQNORM(YLCV_Y,znorm(1,3),znorm(2,3),znorm(3,3),znorm(4,3), &
                        & znorm(5,3),znorm(6,3))

zz1=SQRT(SUM(znorm(:,1)))
zz2=SQRT(SUM(znorm(:,2)))
zz3=SQRT(SUM(znorm(:,3)))
znorm(:,:)=SQRT(znorm(:,:))

DO jj=1,6
  IF (znorm(jj,1)>TINY(zz1)) THEN
    znorm(jj,4)=znorm(jj,3)/znorm(jj,1)
  ELSE
    znorm(jj,4)=-1.0_JPRB
  ENDIF
  IF (znorm(jj,4)>0.0_JPRB) znorm(jj,5)=znorm(jj,4)/EPSILON(zz1)
ENDDO

WRITE(NULOUT,'(A)') ' CVTEST ------------------------'
WRITE(NULOUT,'(A)') ' CVTEST Test of CHAVARIN inverse'
WRITE(NULOUT,'(A)') ' CVTEST ------------------------'
WRITE(NULOUT,'(2A)')' CVTEST           Input         Output',&
                           & '        Error        Rel. Err    /EPSILON'
IF (YLCV_A%linitcv)   WRITE(NULOUT,clfmt)' CVTEST INITCV ',znorm(1,:)
IF (YLCV_A%nmoderr>0) WRITE(NULOUT,clfmt)' CVTEST MODERR ',znorm(2,:)
IF (YLCV_A%ltovscv)   WRITE(NULOUT,clfmt)' CVTEST TOVSCV ',znorm(3,:)
IF (YLCV_A%lam1d)     WRITE(NULOUT,clfmt)' CVTEST LAMCV  ',znorm(4,:)
IF (YLCV_A%npara>0)   WRITE(NULOUT,clfmt)' CVTEST PARACV ',znorm(5,:)
IF (YLCV_A%ltscv)     WRITE(NULOUT,clfmt)' CVTEST TSCV   ',znorm(6,:)

WRITE(NULOUT,'(A)')' CVTEST ------------------------'
WRITE(NULOUT,'(A)')' CVTEST Test of CHAVARIN inverse'
WRITE(NULOUT,'(A)')' CVTEST ------------------------'
WRITE(NULOUT,'(A,ES22.16)')' CVTEST norm ZX   =',zz1
WRITE(NULOUT,'(A,ES22.16)')' CVTEST norm ZY   =',zz2
WRITE(NULOUT,'(A,ES22.16)')' CVTEST norm error=',zz3
IF (zz1>TINY(zz1)) THEN
  zz2=zz3/zz1*100.0_JPRB
  WRITE(NULOUT,'(A,F9.1,A)')' CVTEST Relative Error=',zz2,'%'
ENDIF

! ------------------------------------------------------------------
! TEST CHAVARIN/CHAVARINAD
! ------------------------------------------------------------------
IF (LJBWAVELET.AND.LMODERR) THEN
  WRITE(NULOUT,'(A)')' CVTEST ----------------------------------'
  WRITE(NULOUT,'(A)')' CVTEST Cannot test LMODERR and LJBWAVELET'
  WRITE(NULOUT,'(A)')' CVTEST ----------------------------------'
ELSE

  ISEED=1
  CALL RANDOM_CTLVEC(YLCV_A,LL1,LL1,LL0,LL0,LL0,LL0,ISEED)
  ISEED=101
  IF (LMODERR) THEN
    CALL RANDOM_CTLVEC(YLCV_B,LL1,LL1,LL0,LL0,LL0,LL0,ISEED)
  ELSE
    CALL RANDOM_SPECTRAL_FIELD(YLSP_B,ISEED)
    CALL SPEC_IMZERO(YLSP_B)
  ENDIF

! ------------------------------------------------------------------
! Direct integration: Calculation of <CHAVARIN.ZA,ZB>.
! ------------------------------------------------------

  YLCV_Y=YLCV_A

  CALL CHAVARIN(YLCV_Y)

  IF (LMODERR) THEN
    YLCV_X = 0.0_JPRB
    CALL CAININ(YLCV_X)
    zz1 = DOT_PRODUCT(YLCV_X,YLCV_B,YSCALP)
  ELSE
    YLSP_X=0.0_JPRB 
    CALL STATE2SPEC(YLSP_X)
    zz1 = DOT_PRODUCT(YLSP_X,YLSP_B,.TRUE.)
  ENDIF

! ------------------------------------------------------------------
! Adjoint integration: Calculation of <ZA,CHAVARINAD.ZB>.
! ---------------------------------------------------------

  CALL CDSTA

  IF (LMODERR) THEN
    YLCV_X=YLCV_B
    CALL CAININAD(YLCV_X)
  ELSE
    YLSP_X=YLSP_B
    CALL STATE2SPECAD(YLSP_X)
  ENDIF

  YLCV_Y=0.0_JPRB
  CALL CHAVARINAD(YLCV_Y)

  zz2 = DOT_PRODUCT(YLCV_A,YLCV_Y,YSCALP)

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

  IF (zz1==0.0_JPRB) THEN
    zz3 = ABS(zz1-zz2) / EPSILON(zz3)
  ELSE
    zz3 = ABS((zz1-zz2)/zz1) / EPSILON(zz3)
  ENDIF

  WRITE(NULOUT,'(A)')' CVTEST ------------------------'
  WRITE(NULOUT,'(A)')' CVTEST Test of CHAVARIN adjoint'
  WRITE(NULOUT,'(A)')' CVTEST ------------------------'
  WRITE(NULOUT,'(A)')' CVTEST             1234567890123456'
  WRITE(NULOUT,'(A,E22.16)')' CVTEST <Y,F .X>= ',zz1
  WRITE(NULOUT,'(A,E22.16)')' CVTEST <F*.Y,X>= ',zz2
  WRITE(NULOUT,'(A,F8.1,A)')' CVTEST The difference is ',zz3, &
   & ' times machine precision.'  
  WRITE(NULOUT,'(A)')' CVTEST ------------------------'
ENDIF

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


! ------------------------------------------------------------------
! TEST CHAVARAD/CHAVAR for LMODERR
! ------------------------------------------------------------------
IF (LJBWAVELET.AND.LMODERR) THEN
  WRITE(NULOUT,'(A)')' CVTEST ----------------------------------'
  WRITE(NULOUT,'(A)')' CVTEST Cannot test LMODERR and LJBWAVELET'
  WRITE(NULOUT,'(A)')' CVTEST ----------------------------------'
ELSEIF (LMODERR) THEN
  CALL ALLOCATE_CTLVEC(YLCV_A_TMP)
  CALL ALLOCATE_CTLVEC(YLCV_B_TMP) 
  ISEED=201
  CALL RANDOM_CTLVEC(YLCV_A,LL1,LL1,LL0,LL0,LL0,LL0,ISEED)
  ISEED=301
  CALL RANDOM_CTLVEC(YLCV_B,LL1,LL1,LL0,LL0,LL0,LL0,ISEED)

! ------------------------------------------------------------------
! Adjoint integration: Calculation of <CHAVARAD.ZA,ZB>.
! ------------------------------------------------------

  CALL CDSTA
  YLCV_Y=YLCV_A
  CALL CHAVARAD(YLCV_Y)
  CALL MODELTOJBAD(SPJB) 
  YLCV_X = 0.0_JPRB
  CALL CAINAD(YLCV_X)
  zz1 = DOT_PRODUCT(YLCV_X,YLCV_B,YSCALP)

  YLCV_A_TMP=0.0_JPRB
  YLCV_B_TMP=0.0_JPRB
  YLCV_A_TMP%INITCV(:)=YLCV_X%INITCV(:)
  YLCV_B_TMP%INITCV(:)=YLCV_B%INITCV(:)
  zz1_ini=DOT_PRODUCT(YLCV_A_TMP,YLCV_B_TMP,YSCALP)

  YLCV_A_TMP=0.0_JPRB
  YLCV_B_TMP=0.0_JPRB
  YLCV_A_TMP%MODERR(:)=YLCV_X%MODERR(:)
  YLCV_B_TMP%MODERR(:)=YLCV_B%MODERR(:)
  zz1_moderr=DOT_PRODUCT(YLCV_A_TMP,YLCV_B_TMP,YSCALP)

! ------------------------------------------------------------------
! Direct integration: Calculation of <ZA,CHAVAR.ZB>.
! ---------------------------------------------------------

  YLCV_X=YLCV_B
  CALL CAIN(YLCV_X)
  CALL MODELTOJB(SPJB)
  YLCV_Y=0.0_JPRB
  CALL CHAVAR(YLCV_Y)
  zz2 = DOT_PRODUCT(YLCV_A,YLCV_Y,YSCALP)

  YLCV_A_TMP=0.0_JPRB
  YLCV_B_TMP=0.0_JPRB
  YLCV_A_TMP%INITCV(:)=YLCV_A%INITCV(:)
  YLCV_B_TMP%INITCV(:)=YLCV_Y%INITCV(:)
  zz2_ini=DOT_PRODUCT(YLCV_A_TMP,YLCV_B_TMP,YSCALP)

  YLCV_A_TMP=0.0_JPRB
  YLCV_B_TMP=0.0_JPRB
  YLCV_A_TMP%MODERR(:)=YLCV_A%MODERR(:)
  YLCV_B_TMP%MODERR(:)=YLCV_Y%MODERR(:)
  zz2_moderr=DOT_PRODUCT(YLCV_A_TMP,YLCV_B_TMP,YSCALP)

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

  IF (zz1==0.0_JPRB) THEN
    zz3 = ABS(zz1-zz2) / EPSILON(zz3)
  ELSE
    zz3 = ABS((zz1-zz2)/zz1) / EPSILON(zz3)
  ENDIF

  WRITE(NULOUT,'(A)')' CVTEST ------------------------'
  WRITE(NULOUT,'(A)')' CVTEST Test of CHAVAR adjoint'
  WRITE(NULOUT,'(A)')' CVTEST ------------------------'
  WRITE(NULOUT,'(A)')' CVTEST             1234567890123456'
  WRITE(NULOUT,'(A,3(E22.16,1x))')' CVTEST <Y,F .X>= ',zz1,zz1_ini,zz1_moderr
  WRITE(NULOUT,'(A,3(E22.16,1x))')' CVTEST <F*.Y,X>= ',zz2,zz2_ini,zz2_moderr
  WRITE(NULOUT,'(A,F8.1,A)')' CVTEST The difference is ',zz3, &
   & ' times machine precision.'
  WRITE(NULOUT,'(A)')' CVTEST ------------------------'
  CALL DEALLOCATE_CTLVEC(YLCV_A_TMP)
  CALL DEALLOCATE_CTLVEC(YLCV_B_TMP) 
ENDIF

CALL DEALLOCATE_CTLVEC(YLCV_Y)
CALL DEALLOCATE_CTLVEC(YLCV_A)
IF (LMODERR) THEN
  CALL DEALLOCATE_CTLVEC(YLCV_X)
  CALL DEALLOCATE_CTLVEC(YLCV_B)
ELSE
  CALL DEALLOCATE_SPEC(YLSP_X)
  CALL DEALLOCATE_SPEC(YLSP_B)
ENDIF
LSUBBG =llsub
WRITE(NULOUT,'(A)')' CVTEST End CHAVAR Test'
WRITE(NULOUT,'(A)')' CVTEST ------------------------'

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