!-------------------------------------- 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 DCANAB(KDIM,PY,PX,KZS,PZS,PDZS)
#if defined (DOC)
*
***s/r DCANAB  - Change of variable associated with the canonical
*     .         inner product
*
*Author    JM Belanger CMDA/SMC   May 2001
*     .    Double precision version based on single precision CTCAB.
*          Refered to  as dummy argument DTCAB by N1QN3 minimization
*          package.
*    -------------------
**    Purpose: to compute PX = L^-1 * Py with L related to the inner product
*     .        <PX,PY> = PX^t  L^t  L PY
*     .        (see the modulopt documentation aboutn DTCAB)
*
*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 PX =(I + R1*lams*R1^T)*PY
        DO JDIM = 1, KDIM
          PX(JDIM)= PY(JDIM)
        ENDDO
        DO RR = 1, NPRECON
          TEMPO=0.0
          DO JDIM = 1, KDIM
            TEMPO = TEMPO + RRNK1(JDIM,RR)*PY(JDIM)
          ENDDO
          TEMPO=TEMPO*(1.0d0 - sqrt(HesEval(RR)+1.0d0)) /
     +                (HesEval(RR)*sqrt(HesEval(RR)+1.0d0))
          DO JDIM = 1, KDIM
            PX(JDIM)= PX(JDIM) + RRNK1(JDIM,RR)*TEMPO
          ENDDO
        ENDDO
      ELSE
        DO 101 JDIM = 1, KDIM
           IF(SCALP(JDIM).NE.0.)THEN
              PX(JDIM) = PY(JDIM)/DSQRT(SCALP(JDIM))
           ELSE
              PX(JDIM) = 0.
           END IF
 101    CONTINUE
      ENDIF
C
      RETURN
      END