SUBROUTINE SCALJGS

!**** *SCALJGS*  - DEFINE INNER PRODUCT FOR JG IN SPECTRAL SPACE

!     Purpose.
!     --------
!     DEFINE THE INNER PRODUCT FOR THE MINIMIZATION

!**   Interface.
!     ----------
!        *CALL* *SCALJGS

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

!        Implicit arguments :
!        --------------------
!        None

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

!     Externals.
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     Author.
!     -------
!        Bill Heckley           *ECMWF*

!     Modifications.
!     --------------
!        Original : 91-02-01
!        BILL HECKLEY  3/06/91  - VERTICAL CORRELATIONS
!        BILL HECKLEY  21/02/92 - Vertical coupling now done in terms
!                                 of eigenvectors.
!        LARS ISAKSEN  06/06/95 - Reordering of spectral arrays
!        MODIFIED M. Hamrud  95-12-15 remove NCNTVAR=3,NFGM .ne. 1,cleaning
!        LARS ISAKSEN  05/05/96 - Adapted for Message Passing
!        Mike Fisher   01/08/96 - Remove RLAPIN from the inner product
!        Elias Holm    15/12/97 - Ozone included
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVL   ,NSMAX    ,NSPEC2   ,NUMP
USE YOMLUN   , ONLY : NULERR
USE YOMCT0   , ONLY : NCNTVAR
USE YOMSPJB  , ONLY : SPJB
USE YOMLAP   , ONLY : NASM0    ,NVALUE   ,MYMS
USE YOMJG    , ONLY : FGSCNM3D, FGSCNM2D, N_SPJB_VARS ,SPJB_VARS_INFO
USE YOMMP    , ONLY : MYLEVS   ,NPSP

IMPLICIT NONE

REAL(KIND=JPRB) :: ZMFACTA(NSPEC2)

INTEGER(KIND=JPIM) :: ILEVO, IM, IN, JLEV, JMLOC, JSP, JFIELD, IPTJB

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

#include "abor1.intfb.h"

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

!       0. DEFINE HELP ARRAY 
!          -----------------

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

DO JMLOC=1,NUMP
  IM=MYMS(JMLOC)
  IF (IM==0) THEN
    ZMFACT=1.0_JPRB
  ELSE
    ZMFACT=2.0_JPRB
  ENDIF
  ZMFACTA(NASM0(IM):NASM0(IM)+2*(NSMAX+1-IM)-1)=ZMFACT
ENDDO

IF (NCNTVAR == 1) THEN

!*      1.    CONTROL VARIABLES ARE MODEL VARIABLES
!              -------------------------------------


  DO JFIELD=1,N_SPJB_VARS
    IPTJB = SPJB_VARS_INFO(JFIELD)%IPTJB

    IF (SPJB_VARS_INFO(JFIELD)%L_IN_SPA2) THEN
      IF(NPSP == 1)THEN
        DO JSP=1,NSPEC2
          IN=NVALUE(JSP)
          SPJB%SP2D(JSP,IPTJB) = &
           & FGSCNM2D(IN,IPTJB)*SPJB%SP2D(JSP,IPTJB)**2*ZMFACTA(JSP)
        ENDDO
      ENDIF
    ELSE
      DO JSP=1,NSPEC2
        IN=NVALUE(JSP)
        DO JLEV=1,NFLEVL
          ILEVO=MYLEVS(JLEV)
          SPJB%SP3D(JLEV,JSP,IPTJB) = &
           & FGSCNM3D(ILEVO,IN,IPTJB)*SPJB%SP3D(JLEV,JSP,IPTJB)**2*ZMFACTA(JSP)
        ENDDO
      ENDDO
    ENDIF
  ENDDO

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

ELSEIF (NCNTVAR == 2) THEN

!*       2.    CONTROL VARIABLES ARE NORMALIZED DEPARTURES OF MODEL
!              VARIABLES FROM BACKGROUND FIELD
!              ----------------------------------------------------

  DO JSP=1,NSPEC2
    SPJB%SP3D(:,JSP,:) = ZMFACTA(JSP)
  ENDDO

  IF(NPSP == 1)THEN
    DO JSP=1,NSPEC2
      SPJB%SP2D(JSP,:) = ZMFACTA(JSP)
    ENDDO
  ENDIF
  
!    -------------------------------------------------------------

ELSE

  WRITE (NULERR,'('' ERROR IN SCALJGS: ERRONEOUS CHOICE OF'',&
   & '' CONTROL VARIABLE. NCNTVAR ='',I5)') NCNTVAR  
  CALL ABOR1('SCALJGS: ABOR1 CALLED')

ENDIF

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

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