SUBROUTINE EVJCDFI(KULOUT,LDPRT)

!     Purpose.
!     --------
!**   Interface.
!     ----------
!        *CALL* *EVJCDFI

!        Explicit arguments :
!        --------------------
!        KULOUT:  logical unit used for output
!        LDPRT :  additional prints

!     ----------

!     Reference.
!     ----------
!     Author.
!     -------
!        P. Gauthier   *CNRM/GMAP*

!     Modifications.
!     --------------
!        Original : 98-10-21
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        B.Chapnik:    22-sep-2008 adaptation for lelam case
!        Y.Tremolet    21-Nov-2008 Jc-DFI diagnostics
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM  , ONLY  : NFD2D, NFLEVL,NSPEC2, NS3D, NSMAX, NUMP ,&
 & NFLEVG, NVARMAX  , NFLSUR
USE YOMCT0   , ONLY : LELAM
USE YOMLAP   , ONLY : NASM0, MYMS
USE YOMMP    , ONLY : MYSETV   ,NBSETSP
USE YOMVAR   , ONLY : ALPHAG
USE YOMJCDFI , ONLY : RACCSPA3, RACCSPA2, RACCSPA1, NSUBDFI, DFICHECK, &
                    & QNORM3, QNORM2, QNORM1, RSUMJCDFI, LDIVONLY,RSUMJCDFI1D
USE YOMLUN, ONLY: NULERR
USE YEMLAP   ,ONLY  :NESM0

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT 
LOGICAL, INTENT(IN) :: LDPRT
!     Local variables
REAL(KIND=JPRB) :: ZJCDFI3(NFLEVL,NS3D,NUMP), ZJCDFI2(NFD2D,NUMP)
REAL(KIND=JPRB) :: ZJCDFI3G(NFLEVG,NS3D,0:NVARMAX), ZJCDFI2G(NFD2D,0:NVARMAX), ZJCDFI1G(NFLEVL,2)
REAL(KIND=JPRB) :: ZJC3(NFLEVG,NS3D), ZJC2(NFD2D)
REAL(KIND=JPRB) :: ZSPA3(NFLSUR,NSPEC2,NS3D),ZSPA2(NSPEC2,NFD2D),ZSPA1(NFLEVL,2)
INTEGER(KIND=JPIM) :: JF, JK, JMLOC, IM, JN, INM, JIR, JM, JSTOP, jsub
REAL(KIND=JPRB) :: ZFM, ZTOTALJCDFI
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "gathercost2.intfb.h"

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

!     1. Computing the departure from the filtered state at time NSTDFI
!     .  and store the result in YOMSP

IF (LHOOK) CALL DR_HOOK('EVJCDFI',0,ZHOOK_HANDLE)
WRITE(KULOUT, 9000)NSPEC2,ALPHAG
9000 FORMAT(//,4X,'EVJCDFI2- Evaluation of the Jc cost function when'&
 & ,' the digital filter is used',4x,' NSPEC2 = ',I8 &
 & ,3X,'ALPHAG = ',G12.6)  

RSUMJCDFI(:)=0.0_JPRB
RSUMJCDFI1D=0.0_JPRB

DO jsub=1,NSUBDFI
  WRITE(KULOUT,*)'EVJCDFI: DFI check, sum of coefs=',DFICHECK(jsub)
  IF (ABS(DFICHECK(jsub))>100.0_JPRB*EPSILON(DFICHECK)) THEN
    CALL ABOR1('EVJCDFI: Error in DFI accumulation')
  ENDIF

  CALL GSTATS(1812,0)

  ZSPA3(:,:,:)=0.0_JPRB
  ZSPA2(:,:)  =0.0_JPRB
  ZSPA1(:,:)  =0.0_JPRB

  ZFM = 0.5_JPRB*ALPHAG
  IF (.NOT.LELAM) THEN
    DO JMLOC = 1, NUMP
      IM = MYMS(JMLOC)
      DO JN = IM, NSMAX
        DO JIR = 0, MIN(1,IM)
          INM = NASM0(IM) + (JN-IM)*2 + JIR
          DO JF = 1, NS3D
            DO JK = 1, NFLEVL
              ZSPA3(JK,INM,JF) = ZFM*QNORM3(JK,JN,JF)*RACCSPA3(JK,INM,JF,jsub)
            ENDDO
          ENDDO
          IF (MYSETV==NBSETSP) THEN
            DO JF = 1, NFD2D
              ZSPA2(INM,JF) = ZFM*QNORM2(JN,JF)*RACCSPA2(INM,JF,jsub)
            ENDDO
          ENDIF
        ENDDO
      ENDDO
    ENDDO
  ELSE
   DO JMLOC = 1, NUMP
      IM = MYMS(JMLOC)
      DO JN = IM, NSMAX
        DO JIR = 1, 4
          INM = NESM0(IM)+4*JN+JIR-1
          DO JF = 1, NS3D
            DO JK = 1, NFLEVL
              ZSPA3(JK,INM,JF) = ZFM*QNORM3(JK,JN,JF)*RACCSPA3(JK,INM,JF,jsub)
            ENDDO
          ENDDO
          IF (MYSETV==NBSETSP) THEN
            DO JF = 1, NFD2D
              ZSPA2(INM,JF) = ZFM*QNORM2(JN,JF)*RACCSPA2(INM,JF,jsub)
            ENDDO
          ENDIF
        ENDDO
      ENDDO
    ENDDO
    DO JK=1,NFLEVL
      ZSPA1(JK,1) = ZFM*QNORM1(JK,1)*RACCSPA1(JK,1)
      ZSPA1(JK,2) = ZFM*QNORM1(JK,2)*RACCSPA1(JK,2)
    ENDDO
  ENDIF

!     2. Computing Jc (energy norm)

  ZJCDFI3 = 0.0_JPRB
  ZJCDFI2 = 0.0_JPRB

!     3D/2D contributions
  IF (LELAM) THEN
    DO JMLOC = 1, NUMP
      IM = MYMS(JMLOC)
      ZFM = 1.0_JPRB + REAL(MIN(1,IM),JPRB)
      DO JN = 0, JSTOP
        DO JIR = 1, 4 !!!magic loop for aladin 4coefs/merid wave numb
          INM=NESM0(IM)+4*JN+JIR-1
          DO JF = 1, NS3D
            DO JK = 1, NFLEVL
              ZJCDFI3(JK,JF,JMLOC) = ZJCDFI3(JK,JF,JMLOC)&
                   & + ZFM*RACCSPA3(JK,INM,JF,jsub)*ZSPA3(JK,INM,JF)
            ENDDO
          ENDDO
          IF (MYSETV==NBSETSP) THEN
            DO JF = 1, NFD2D
              ZJCDFI2(JF,JMLOC) = ZJCDFI2(JF,JMLOC)&
                   & + ZFM*RACCSPA2(INM,JF,jsub)*ZSPA2(INM,JF)
            ENDDO
          ENDIF
        ENDDO
      ENDDO
    ENDDO
     
    IF (LDIVONLY) THEN
      RACCSPA2(:,:,jsub)  =0.0_JPRB
      RACCSPA3(:,:,:,jsub)=0.0_JPRB
      RACCSPA3(:,:,2,jsub)=ZSPA3(:,:,2)
    ELSE
      RACCSPA3(:,:,:,jsub)=ZSPA3(:,:,:)
      IF (MYSETV==NBSETSP) RACCSPA2(:,:,jsub)=ZSPA2(:,:)
      ! LELAM case only, is this true ?
      RACCSPA1=ZSPA1
    ENDIF
  ELSE
    DO JMLOC = 1, NUMP
      IM = MYMS(JMLOC)
      ZFM = 1.0_JPRB + REAL(MIN(1,IM),JPRB)
      DO JN = IM, NSMAX
        DO JIR = 0, MIN(1,IM)
          INM = NASM0(IM) + (JN-IM)*2 + JIR
          DO JF = 1, NS3D
            DO JK = 1, NFLEVL
              ZJCDFI3(JK,JF,JMLOC) = ZJCDFI3(JK,JF,JMLOC)&
               & + ZFM*RACCSPA3(JK,INM,JF,jsub)*ZSPA3(JK,INM,JF)
            ENDDO
          ENDDO
          IF (MYSETV==NBSETSP) THEN
            DO JF = 1, NFD2D
              ZJCDFI2(JF,JMLOC) = ZJCDFI2(JF,JMLOC)&
               & + ZFM*RACCSPA2(INM,JF,jsub)*ZSPA2(INM,JF)
            ENDDO
          ENDIF
        ENDDO
      ENDDO
    ENDDO

    IF (LDIVONLY) THEN
      IF (MYSETV==NBSETSP) RACCSPA2(:,:,jsub)  =0.0_JPRB
      RACCSPA3(:,:,:,jsub)=0.0_JPRB
      RACCSPA3(:,:,2,jsub)=ZSPA3(:,:,2)
    ELSE
      RACCSPA3(:,:,:,jsub)=ZSPA3(:,:,:)
      IF (MYSETV==NBSETSP) RACCSPA2(:,:,jsub)=ZSPA2(:,:)
    ENDIF

  ENDIF

!! contributions of 1D mean wind field components
IF (LELAM) THEN
  ZJCDFI1G(:,:)=0.0_JPRB
  DO JK=1, NFLEVL
  ZJCDFI1G(JK,1)=RACCSPA1(JK,1)*ZSPA1(JK,1)
  ZJCDFI1G(JK,2)=RACCSPA1(JK,2)*ZSPA1(JK,2)
  ENDDO
ENDIF

  CALL GSTATS(1812,1)

!     Gather contributions to the Jc-DFI

  ZJCDFI3G = 0.0_JPRB
  ZJCDFI2G = 0.0_JPRB
  CALL GATHERCOST2(ZJCDFI3,ZJCDFI2,ZJCDFI3G,ZJCDFI2G)
  
  CALL GSTATS(1812,0)

  IF (LDIVONLY) THEN
    DO JK = 1, NFLEVG
      RSUMJCDFI(:)=RSUMJCDFI(:)+ZJCDFI3G(JK,2,:)
    ENDDO
    ELSE
    DO JF = 1, NS3D
      DO JK = 1, NFLEVG
        RSUMJCDFI(:)=RSUMJCDFI(:)+ZJCDFI3G(JK,JF,:)
      ENDDO
    ENDDO
    DO JF = 1, NFD2D
      RSUMJCDFI(:)=RSUMJCDFI(:)+ZJCDFI2G(JF,:)
    ENDDO
  ENDIF

  IF (LELAM) THEN
! add 1D contribution for mean wind components
   DO JK=1,NFLEVL
   RSUMJCDFI1D=RSUMJCDFI1D +ZJCDFI1G(JK,1)
   RSUMJCDFI1D=RSUMJCDFI1D +ZJCDFI1G(JK,2)
   ENDDO
  ENDIF
  RSUMJCDFI1D=RSUMJCDFI1D/ALPHAG

  IF (LDPRT) THEN
    ZJC3(:,:)=0.0_JPRB
    DO jm=0,NVARMAX
      DO jf=1,NS3D
        DO jk=1,NFLEVG
          ZJC3(jk,jf)=ZJC3(jk,jf)+ZJCDFI3G(jk,jf,jm)
        ENDDO
      ENDDO
    ENDDO
    ZJC2(:)=0.0_JPRB
    DO jm=0,NVARMAX
      DO jf=1,NFD2D
        ZJC2(jf)=ZJC2(jf)+ZJCDFI2G(jf,jm)
      ENDDO
    ENDDO
  
    IF (NSUBDFI>1) THEN
      write(kulout,*)'Jc-DFI Diagnostic Table ',jsub
    ELSE
      write(kulout,*)'Jc-DFI Diagnostic Table'
    ENDIF
    DO jk=1,NFLEVG
      write(kulout,999)jk,ZJC3(jk,:)
    ENDDO
    write(kulout,888)ZJC2(:)
    write(kulout,*)'Jc-DFI Diagnostic Table End'
    999 FORMAT(I4,9(2X,ES10.3))
    888 FORMAT('Surf',9(2X,ES10.3))
  ENDIF
  CALL GSTATS(1812,1)
ENDDO

ZTOTALJCDFI = SUM(RSUMJCDFI(:))+RSUMJCDFI1D

WRITE(KULOUT,*) '        Global value of the '&
 & ,'Jc-DFI/ALPHAG cost function = ',ZTOTALJCDFI/ALPHAG  

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