SUBROUTINE CHNORM(YD_PVIN,YD_PVOUT)

!**** *CHNORM*  - CHange-NORM Tangent (linear operator) for conf 601 (SVs)

!     Purpose.
!     --------
!           Re-define the norm at initial time when computing SVs
!**   Interface.
!     ----------
!        *CALL* *CHNORM

!        Explicit arguments :
!        --------------------
!        None

!        Implicit arguments :
!        --------------------
!        Array SCALP in YOMCVA

!     Method.
!     -------
!        See documentation

!     Externals.    CAININ - inverse of the Canonical injection
!     ----------
!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Roberto Buizza                     *ECMWF*

!     Modifications.
!     --------------
!        Original : 96-03-07
!        L. Isaksen 96-05-05  Adapted for Message Passing
!        Y.Tremolet 02-08-09  Use control_vectors.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMDIM   , ONLY : NFLEVL   ,NSMAX    ,NUMP
USE YOMDYN   , ONLY : SIDELP   ,SITR     ,SIRPRG   ,SIRPRN
USE YOMLUN   , ONLY : NULOUT
USE YOMCST   , ONLY : RCPD     ,RLVTT
USE YOMLAP   , ONLY : NASM0    ,MYMS     ,RLAPIN
USE YOMSP    , ONLY : SPA3     ,SPA2     ,SPVOR    ,SPDIV    ,&
 & SPT      ,SPQ      ,SPSP  
USE YOMCVA   , ONLY : YSCALP
USE YOMLCZ   , ONLY : NEWNORMT0,COENEWQTERM
USE YOMMP    , ONLY : MYLEVS
USE CONTROL_VECTORS

IMPLICIT NONE

!     ------------------------------------------------------------
TYPE(CONTROL_VECTOR),INTENT(IN)    :: YD_PVIN 
TYPE(CONTROL_VECTOR),INTENT(OUT)   :: YD_PVOUT 
TYPE(control_vector) :: YL_ZNEWSCALP

INTEGER(KIND=JPIM) :: ILEV, IM, INM, JIR, JLEV, JMLOC, JN

REAL(KIND=JPRB) :: ZMFACT
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "cainin.intfb.h"

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

!*    1. Initialize spectral array (used as work space).
!     --------------------------------------------------

!*    1.0  Default values.

IF (LHOOK) CALL DR_HOOK('CHNORM',0,ZHOOK_HANDLE)
SPA3(:,:,:) = 1.0_JPRB
SPA2(:,:)   = 1.0_JPRB

!     - if NEWNORMT0=1 norm=total energy with q-term
!     - if NEWNORMT0=2 norm=kinetic energy
!     - if NEWNORMT0=3 norm=squared vorticity
!     - if NEWNORMT0=4 norm=squared stream-function
!     - if NEWNORMT0=5 norm=rotational kinetic energy
!     - if NEWNORMT0=6 norm=analytical function (to be coded)

!*    1.1  Define new weights

DO JMLOC=1,NUMP
  IM=MYMS(JMLOC)
  ZMFACT=1.0_JPRB+REAL(MIN(1,IM),JPRB)
  DO JIR=0,MIN(1,IM)
    DO JN=IM,NSMAX
      INM=NASM0(IM)+(JN-IM)*2+JIR
      DO JLEV=1,NFLEVL
        ILEV=MYLEVS(JLEV)
        IF(NEWNORMT0 == 1) THEN
          SPVOR(JLEV,INM)=-ZMFACT*RLAPIN(JN)*SIDELP(ILEV)/2.0_JPRB
          SPDIV(JLEV,INM)=-ZMFACT*RLAPIN(JN)*SIDELP(ILEV)/2.0_JPRB
          SPT(JLEV,INM)=ZMFACT*RCPD*SIDELP(ILEV)/SITR/2.0_JPRB
          SPQ(JLEV,INM)=COENEWQTERM*ZMFACT &
           & *( (RLVTT**2)/(RCPD*SITR) )&
           & *SIDELP(ILEV)/2.0_JPRB  
        ELSEIF(NEWNORMT0 == 2) THEN
          SPVOR(JLEV,INM)=-ZMFACT*RLAPIN(JN)*SIDELP(ILEV)/2.0_JPRB
          SPDIV(JLEV,INM)=-ZMFACT*RLAPIN(JN)*SIDELP(ILEV)/2.0_JPRB
          SPT(JLEV,INM)=0.0_JPRB
          SPQ(JLEV,INM)=0.0_JPRB
        ELSEIF(NEWNORMT0 == 3) THEN
          SPVOR(JLEV,INM)=-ZMFACT*SIDELP(ILEV)/2.0_JPRB
          SPDIV(JLEV,INM)=0.0_JPRB
          SPT(JLEV,INM)=0.0_JPRB
          SPQ(JLEV,INM)=0.0_JPRB
        ELSEIF(NEWNORMT0 == 4) THEN
          SPVOR(JLEV,INM)=+ZMFACT*(RLAPIN(JN)**2)*SIDELP(ILEV)/2.0_JPRB
          SPDIV(JLEV,INM)=0.0_JPRB
          SPT(JLEV,INM)=0.0_JPRB
          SPQ(JLEV,INM)=0.0_JPRB
        ELSEIF(NEWNORMT0 == 5) THEN
          SPVOR(JLEV,INM)=-ZMFACT*RLAPIN(JN)*SIDELP(ILEV)/2.0_JPRB
          SPDIV(JLEV,INM)=0.0_JPRB
          SPT(JLEV,INM)=0.0_JPRB
          SPQ(JLEV,INM)=0.0_JPRB
        ELSEIF(NEWNORMT0 == 6) THEN
          SPVOR(JLEV,INM)=1.0_JPRB
          SPDIV(JLEV,INM)=1.0_JPRB
          SPT(JLEV,INM)=1.0_JPRB
          SPQ(JLEV,INM)=1.0_JPRB
        ENDIF
      ENDDO
    ENDDO
  ENDDO
ENDDO

DO JMLOC=1,NUMP
  IM=MYMS(JMLOC)
  ZMFACT=1.0_JPRB+REAL(MIN(1,IM),JPRB)
  DO JIR=0,MIN(1,IM)
    DO JN=IM,NSMAX
      INM=NASM0(IM)+(JN-IM)*2+JIR
      IF(NEWNORMT0 == 1) THEN
        SPSP(INM)=ZMFACT*SIRPRG/SIRPRN/2.0_JPRB
      ELSEIF(NEWNORMT0 > 1.AND.NEWNORMT0 <= 5) THEN
        SPSP(INM)=0.0_JPRB
      ELSEIF(NEWNORMT0 == 6) THEN
        SPSP(INM)=1.0_JPRB
      ENDIF
    ENDDO
  ENDDO
ENDDO
!     ------------------------------------------------------------

!*    2. Initialize scalar product array.
!     -----------------------------------

CALL ALLOCATE_CTLVEC(YL_ZNEWSCALP)
CALL CAININ(YL_ZNEWSCALP)

!*    2.1 Check positivness.

IF (MINVAL(YSCALP%data)<0.0_JPRB) THEN
  WRITE(UNIT=NULOUT,FMT='('' YSCALP NEGATIVE '')')
  CALL ABOR1('CHNORM')
ENDIF
!     ------------------------------------------------------------

!*    3. Apply the operator to the input vector:
!            PVOUT=E_NEW(-1/2)*E(1/2)*PVIN
!        where E represents the SCALP weights.

YL_ZNEWSCALP%data = SQRT(ABS(YL_ZNEWSCALP%data))
CALL INVERSE(YL_ZNEWSCALP)

YD_PVOUT%data = SQRT(YSCALP%data) * YL_ZNEWSCALP%data *YD_PVIN%data

CALL DEALLOCATE_CTLVEC(YL_ZNEWSCALP)
!     ------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('CHNORM',1,ZHOOK_HANDLE)
END SUBROUTINE CHNORM
