!-------------------------------------- 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 DCANONB(KDIM,PX,PY,KZS,PZS,PDZS)
#if defined (DOC)
*
***s/r DCANONB  - Change of variable associated with the canonical
*     .          inner product
*
*
*Author    JM Belanger CMDA/SMC  May 2001
*     .    Double precision version based on single precision CANONB.
*          Refered to as dummy argument DTONB by N1QN3 minimization
*          package.
*    -------------------
**    Purpose: to compute PY = L * PX with L related to the inner product
*     .        <PX,PY> = PX^t  L^t  L PY
*     .        (see the modulopt documentation about DTONB)
*     .

*Arguments
*    -NONE-
#endif
      IMPLICIT NONE
*implicits
#include "comdim.cdk"
#include "comcva.cdk"
#include "comanl.cdk"
*
      INTEGER KDIM, KZS(1)
      REAL PZS(1)
      REAL*8 PX(KDIM), PY(KDIM)
      REAL*8 PDZS(1)
C
      INTEGER JDIM,RR
      REAL*8 TEMPO
C
 100  CONTINUE
      IF(NPRECON.ge.1) THEN
c SCALP NOT INCLUDED WITH PRECON!!! (assumed equal to identity)
c CALCULATE PY =(I + R1*lamsi*R1^T)*PX
        DO JDIM = 1, KDIM
          PY(JDIM)= PX(JDIM)
        ENDDO
        DO RR = 1, NPRECON
          TEMPO=0.0
          DO JDIM = 1, KDIM
            TEMPO = TEMPO + RRNK1(JDIM,RR)*PX(JDIM)
          ENDDO
          TEMPO=TEMPO*(sqrt(HesEval(RR)+1.0d0) - 1.0d0) /
     +                HesEval(RR)
          DO JDIM = 1, KDIM
            PY(JDIM)= PY(JDIM) + RRNK1(JDIM,RR)*TEMPO
          ENDDO
        ENDDO
      ELSE
        DO 101 JDIM = 1, KDIM
           PY(JDIM) = PX(JDIM)*DSQRT(SCALP(JDIM))
 101    CONTINUE
      ENDIF
C
      RETURN
      END