SUBROUTINE NMICOST(PVORDI,PDIVDI,PTDI,PSPDI)

!**** *NMICOST*  - NMI-JC contribution of the cost function in spectral space

!     Purpose.
!     --------
!     EVALUATE THE TERM :dG/dt:2  AND ITS GRADIENT.

!**   Interface.
!     ----------
!        *CALL* *NMICOST(....)

!        Explicit arguments :
!        --------------------
!        PVORDI - vorticity
!        PDIVDI - divergence
!        PTDI   - temperature
!        PSPDI  - surface pressure variable

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

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

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

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

!     Author.
!     -------
!        Jean-Noel Thepaut  *ECMWF*

!     Modifications.
!     --------------
!        Original : 91-02-15
!        Modified : 95-06-06 L.Isaksen   Reordering of spectral arrays
!        Modified : 96-02-20 L.Isaksen   Adapted for Message Passing
!        Modified : 96-07-25 E.Andersson Fujitsu vectorisation
!        Modified : 99-09-28 G.Mozdzynski Correct surface field(s) contribution
!                                         to cost function when NPRTRV > 1
!        R. El Khatib : 01-08-07 Pruning options
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVL   ,NFLEVG   ,NF3D     ,NSMAX    ,NSPEC2   ,NUMP
USE YOMDYN   , ONLY : SIPR     ,SITR
USE YOMCOSJC , ONLY : FJCCOST  ,RINCLJC
USE YOMCST   , ONLY : RD       ,RCPD
USE YOMGEM   , ONLY : VAH      ,VDELB
USE YOMSP    , ONLY : SPVOR    ,SPDIV    ,SPT      ,SPSP
USE YOMLAP   , ONLY : NASM0    ,MYMS     ,RLAPIN
USE YOMVAR   , ONLY : ALPHAG
USE YOMMP    , ONLY : NPSP     ,MYLEVS

IMPLICIT NONE

REAL(KIND=JPRB)   ,INTENT(IN)    :: PVORDI(NFLEVL,NSPEC2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDIVDI(NFLEVL,NSPEC2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTDI(NFLEVL,NSPEC2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSPDI(NSPEC2) 
REAL(KIND=JPRB) :: ZSIPR(NFLEVL)
REAL(KIND=JPRB) :: ZWKL(NFLEVL,NUMP,3)
REAL(KIND=JPRB) :: ZWKG(NFLEVG,NUMP,3)
REAL(KIND=JPRB) :: ZWKS(1,NUMP)

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

REAL(KIND=JPRB) :: ZCO, ZFACT1, ZFACT2, ZFACT3, ZMET, ZSIC
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "gatherjcvert.intfb.h"

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

!*       1.    CONSTRAINT |dG/dt|2 IN JC.
!              --------------------------

!*       1.1   DEFINE CONSTANTS.
!              -----------------
IF (LHOOK) CALL DR_HOOK('NMICOST',0,ZHOOK_HANDLE)
IGRAV0 = -1
IGRAV1 = IGRAV0+1
IGRAV2 = IGRAV0+2

!*       1.2   COMPUTATION OF |dG/dt|2.
!              ------------------------

DO JLEV=1,NFLEVL
  ILEV=MYLEVS(JLEV)
  ZSIPR(JLEV)=VAH(ILEV)-VAH(ILEV-1) + SIPR*VDELB(ILEV)
ENDDO

ZSIC=SIPR

ZWKL(:,:,:)=0.0_JPRB
ZWKS(:,:)=0.0_JPRB

! -----  VORTICITY, DIVERGENCE, TEMPERATURE, and SURFACE PRESSURE 

DO JMLOC=1,NUMP
  IM=MYMS(JMLOC)
  ZMET=1.0_JPRB+REAL(MIN(1,IM),JPRB)
  DO JIR=0,MIN(1,IM)
    DO JN=IM,NSMAX
      IF ((IM == 0.AND.JN <= IGRAV0) .OR.&
         & (IM == 1.AND.JN <= IGRAV1) .OR.&
         & (IM == 2.AND.JN <= IGRAV2)) THEN  
        ZCO=0.0_JPRB
      ELSE
        ZCO=1.0_JPRB
      ENDIF

      INM = NASM0(IM)+(JN-IM)*2+JIR
!OCL NOALIAS
      DO JLEV=1,NFLEVL
        ZFACT1=RLAPIN(JN)*ZSIPR(JLEV)/2.0_JPRB*ALPHAG*ZCO
        ZWKL(JLEV,JMLOC,1)=ZWKL(JLEV,JMLOC,1)-ZMET*ZFACT1*PVORDI(JLEV,INM)**2
        SPVOR(JLEV,INM) =SPVOR(JLEV,INM)-RINCLJC(1)*ZFACT1*PVORDI(JLEV,INM)*2

        ZWKL(JLEV,JMLOC,2)=ZWKL(JLEV,JMLOC,2)-ZMET*ZFACT1*PDIVDI(JLEV,INM)**2
        SPDIV(JLEV,INM) =SPDIV(JLEV,INM)-RINCLJC(2)*ZFACT1*PDIVDI(JLEV,INM)*2

        ZFACT2=RCPD*ZSIPR(JLEV)/SITR/2.0_JPRB*ALPHAG*ZCO
        ZWKL(JLEV,JMLOC,3)=ZWKL(JLEV,JMLOC,3)+ZMET*ZFACT2*PTDI(JLEV,INM)**2
        SPT(JLEV,INM)   =SPT(JLEV,INM)+RINCLJC(3)*ZFACT2*PTDI(JLEV,INM)*2
      ENDDO

      IF (NPSP == 1) THEN
        ZFACT3=RD*SITR*ZSIC/2.0_JPRB*ALPHAG*ZCO
        FJCCOST(NF3D+1,JMLOC)=FJCCOST(NF3D+1,JMLOC)+ZMET*ZFACT3*PSPDI(INM)**2
        ZWKS(1,JMLOC)=FJCCOST(NF3D+1,JMLOC)
        SPSP(INM)  =SPSP(INM)+RINCLJC(NF3D+1)*ZFACT3*PSPDI(INM)*2.0_JPRB
      ENDIF
    ENDDO
  ENDDO
ENDDO

CALL GATHERJCVERT(ZWKL,ZWKG,3,ZWKS,1)

FJCCOST(1:3,:)=FJCCOST(1:3,:)+TRANSPOSE(SUM(ZWKG(:,:,:),DIM=1))
FJCCOST(NF3D+1,:)=ZWKS(1,:)

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

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