!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!

      SUBROUTINE TESTCVA(KULOUT,PX,PY,KDIM) 1,21
#if defined (DOC)
*
***s/r TESTCVA - Test of the exactness of the canonical transform
*
*
*Author  : P. Gauthier *ARMA/AES  June 9, 1992
*Revision:
*     . P. Gauthier *ARMA/AES May 25,1993: -Treatment of specific humidity
*     .                                     and  surface pressure
*Revision: S. Pellerin *ARMA/AES Sept 97.
*             - Control of the different model state of the 3Dvar
*               through COMSTATE, COMSTATEC and COMSTNUM common
*               blocks variables (comstate.cdk).
*     .    P. Gauthier *ARMA/MSC August 2002
*     .        - Corrections for the reformulation of the background term
*
*    -------------------
**    Purpose: verification of the canonical transforms and their
*     .        adjoints
*
*Arguments
*     KULOUT: logical unit for printing
*     PX(KDIM): canonical model state used as work area
*     PY(KDIM): canonical model state used as work area
*
#endif
      IMPLICIT NONE
*implicits
#include "comlun.cdk"
#include "com2ini.cdk"
*
C
      INTEGER KULOUT, KDIM, j
      REAL*8 PX(KDIM), PY(KDIM)
      REAL*8 DLSC
C
      WRITE(NULOUT,FMT=9000)
 9000 FORMAT(//,40(' -'),/,10x,'TEST-CVA'
     S     ,' -Testing the transforms and their adjoints')
C
      SINVOR = 1.
      SINDIV = 1.
      SINGZ  = 1.
      SINTT  = 1.
      SINQ   = 1.
      SINPS  = 1.
C ------
      GINUU  = 1.
      GINGZ  = 1.
      GINTT  = 1.
      GINQ   = 1.
      GINPS  = 1.
C
C*    1. Complete test of the transform
C     .  ------------------------------
C
 500  CONTINUE
      WRITE(NULOUT,FMT=9500)
 9500 FORMAT(/,6X,'1.  [Z, HX] = < H*Z, X >'
     S     ,4x,'(Complete test of the adjoints)')
      SINVOR = 1.
      SINDIV = 1.
      SINGZ  = 1.
      SINTT  = 1.
      SINPS  = 1.
      SINQ   = 1.
C
      CALL INITRND('S')
      CALL CAININ (KDIM,PY)
C
      CALL CAIN(KDIM,PY)
C
      call spa2sp
      CALL TRANSFER('SP01')
      CALL SPGD
      CALL TRANSFER('GD01')
C
      CALL NEWBILIN
      CALL TRANSFER('OB01')
C
      GINUU  = 1.
      GINGZ  = 1.
      GINTT  = 1.
      GINQ   =  1.
      GINPS  =  1.
      CALL INITRND('M')
      CALL DOTEUCL('M',KULOUT)
C
      CALL TRANSFER('ZGD0')
      CALL NEWBILINAD
      CALL DOTEUCL('G',KULOUT)
C
      call transfer('ZSP0')
      CALL SPGDA
      CALL DOTEUCL('S',KULOUT)
C
      call spa2spad
      CALL ZERO(KDIM,PX)
      CALL CAINAD(KDIM,PX)
      CALL PRSCAL(KDIM,PX,PY,DLSC)
*
      WRITE(KULOUT,FMT='(8X,"CANONICAL INNER PRODUCT =",G16.8)')DLSC
C
      RETURN
      END