SUBROUTINE NMIJC

!**** *NMIJC* - COMPUTE GRAVITY TENDENCIES FOR JC (VARIATIONAL JOB).

!     PURPOSE.   TO COMPUTE AND STORE THE GRAVITY TENDENCIES IN ORDER TO
!     --------   ADD A WEAK CONSTRAINT IN JC.

!**   INTERFACE.
!     ----------
!        *CALL* *NMIJC

!        EXPLICIT ARGUMENTS :  NONE
!        --------------------

!        IMPLICIT ARGUMENTS :  THE SPECTRAL ARRAYS OF THE MODEL
!        --------------------

!     METHOD.   THE TENDENCIES ARE COMPUTED BY AN APPROPIATE CALL TO STEPO.
!     -------   THE TENDENCIES ARE THEN CHANGED INTO NORMAL MODE SPACE
!               AND PROJECTED ONTO THE GRAVITY MODES.
!               WE GO BACK INTO SPECTRAL SPACE AND STORE THE
!               PROJECTED FIELDS.

!     EXTERNALS.    STEPO     - COMPUTE THE TENDENCIES
!     ----------    MO3DPRJ   - PROJECTION ON MODES
!                   STEPOAD   - COMPUTE THE TENDENCIES (adjoint)
!                   MO3DPRJAD - PROJECTION ON MODES (adjoint)

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

!     AUTHOR.
!     -------
!        JEAN-NOEL THEPAUT  *ECMWF*
!        - LARGELY INSPIRED FROM NNMI3 WRITTEN BY
!        CLIVE TEMPERTON *ECMWF* AND MODIFIED WITH PASSION AND NONETHELESS
!        CLEVERNESS BY FLORENCE RABIER (EERM/CRMD).

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 91-02-15
!        Jean-Noel Thepaut : 91-09-05 (updating to match the new formulation
!                                      of NMI)
!        Lars Isaksen :      95-06-06  (Reordering of spectral arrays)
!        Mats Hamrud  :      95-10-30  (removed CLCONF)
!        Fabrice Veerse :    95-10-13  (NFLEV/NFLSUR bug correction)
!        Lars Isaksen :      96-02-20  (Adapted for Message Passing)
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NFLEVL   ,NSPEC2   ,NCPEC    ,NCPEC2
USE YOMSP    , ONLY : SPVOR    ,SPDIV    ,SPT      ,SPSP
USE YOMLAP   , ONLY : NASM0
USE YOMDYN   , ONLY : TSTEP    ,TDT
USE YOMNMIA  , ONLY : NLEX     ,NITNMI   ,NVMODM   ,NVMOD    ,&
 & NVMODPP  ,LNMIRQ   ,LRPIMP   ,LCONMO   ,LCOIMP  
USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : NSTART
USE YOMCT3   , ONLY : NSTEP
USE YOMMP    , ONLY : MYSETW   ,NPROCM   ,NUMVMO   ,NPSP

IMPLICIT NONE

REAL(KIND=JPRB) :: ZVORDI(NFLEVL,NSPEC2),ZDIVDI(NFLEVL,NSPEC2),&
 & ZTDI(NFLEVL,NSPEC2),ZSPDI(NSPEC2)  
REAL(KIND=JPRB) :: ZC(NCPEC2,NVMODM),ZDIAG(NCPEC2,NVMODM),ZFP(NCPEC)
REAL(KIND=JPRB) :: ZFQ(NCPEC),ZB(NCPEC2),ZLOW(NCPEC2),ZUP(NCPEC2)
REAL(KIND=JPRB) :: ZSPVOR(NFLEVL,NSPEC2),ZSPDIV(NFLEVL,NSPEC2),ZSPT(NFLEVL,NSPEC2)

INTEGER(KIND=JPIM) :: IMODE, IMODES, ISPACE
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "mo3dprj.intfb.h"
#include "mo3dprjad.intfb.h"
#include "nmicost.intfb.h"
#include "rdpinmi.intfb.h"
#include "stepo.intfb.h"
#include "stepoad.intfb.h"
#include "suspe0.intfb.h"
#include "updtim.intfb.h"

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

!*       0.    PREAMBLE.
!              ---------

!*    0.2    DIAGNOSTICS.
IF (LHOOK) CALL DR_HOOK('NMIJC',0,ZHOOK_HANDLE)
IF (LRPIMP) THEN
  IF (NLEX == 0) THEN
    WRITE(NULOUT,'('' START JC : PURE IMPLICIT SCHEME  '')')
  ELSE
    WRITE(NULOUT,'('' START JC : MIXED (EXP.-IMP.) SCHEME  '')')
  ENDIF
ELSE
  WRITE(NULOUT,'('' START JC : PURE EXPLICIT SCHEME  '')')
ENDIF
IF(.NOT.LCONMO.AND..NOT.LCOIMP) THEN
  WRITE(NULOUT,'('' NORMAL MODES NOT COMPUTED'')')
  WRITE(NULOUT,'('' GRAVITY TENDENCY COMPUTATION IMPOSSIBLE'')')
  CALL ABOR1('NMIJC: ABOR1 CALLED')
ENDIF

!*    0.3    READ OF HELP ARRAYS FOR IMPLICIT NMI SCHEME

IF(LRPIMP) THEN
  IMODES = NVMOD
  CALL RDPINMI(IMODES,ZFP,ZFQ,ZB,ZLOW,ZUP,ZC,ZDIAG)
ENDIF

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

!*       1.    COMPUTE TENDENCIES.
!              -------------------

IF (MYSETW == NPROCM(0)) THEN
  SPVOR(:,NASM0(0))=0.0_JPRB
  SPDIV(:,NASM0(0))=0.0_JPRB
ENDIF
IF(LNMIRQ) THEN
  NSTEP=NSTART-NITNMI
ELSE
  NSTEP=NSTART
ENDIF
CALL UPDTIM(0,TDT,TSTEP,.FALSE.)
CALL STEPO('0AAF00AAB')

!*       2.   COPY TENDENCIES

IF (MYSETW == NPROCM(0)) THEN
  SPVOR(:,NASM0(0))=0.0_JPRB
  SPDIV(:,NASM0(0))=0.0_JPRB
ENDIF

ZVORDI(:,:)=SPVOR(:,:)
ZDIVDI(:,:)=SPDIV(:,:)
ZTDI(:,:)=SPT(:,:)
IF (NPSP == 1) ZSPDI(:)=SPSP(:)

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

!*       3.    PROJECT TENDENCIES ON GRAVITY MODES.
!              -------------------------------------

!   IMODE=2: projection on grav. waves
!   ISPACE=1: working space = spectral space

IMODE=2
ISPACE=1
CALL MO3DPRJ(IMODE,ISPACE,NVMOD,NVMODPP,NUMVMO,ZVORDI,ZDIVDI,ZTDI,&
 & ZSPDI,ZC,ZB,ZUP,ZDIAG,ZLOW,ZFQ,ZFP)  

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

!*       4.    COMPUTE JC(NMI CONTR.) COST FUNCTION AND ITS GRADIENT.
!              ------------------------------------------------------

IF (MYSETW == NPROCM(0)) THEN
  ZVORDI(:,NASM0(0))=0.0_JPRB
  ZDIVDI(:,NASM0(0))=0.0_JPRB
ENDIF
CALL SUSPE0
CALL NMICOST(ZVORDI,ZDIVDI,ZTDI,ZSPDI)

!    ---------------------------------------------------------------
!*        5. ADJOINT COMPUTATION (GRADIENT OF |dG/dt|2 WITH RESPECT
!            TO INITIAL CONDITIONS.
!         ----------------------------------------------------------

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

!*       7.    COMPUTE TRAJECTORY TIME.
!              ------------------------

IF(LNMIRQ) THEN
  NSTEP=NSTART-NITNMI
ELSE
  NSTEP=NSTART
ENDIF
CALL UPDTIM(0,TDT,TSTEP,.FALSE.)

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

!*       8.    PROJECT TENDENCIES ON GRAVITY MODES (ADJOINT).
!              -------------------------------------

IF (MYSETW == NPROCM(0)) THEN
  SPVOR(:,NASM0(0))=0.0_JPRB
  SPDIV(:,NASM0(0))=0.0_JPRB
ENDIF

!*       8.2   PROJECT TENDENCY (ADJOINT).

!   IMODE=2: projection on grav. waves
!   ISPACE=1: working space = spectral space

IMODE=2
ISPACE=1

! local arrays ZSP* are used to avoid NFLEV/NFLSUR bug (F.V.)

ZSPVOR(:,:)=SPVOR(:,:)
ZSPDIV(:,:)=SPDIV(:,:)
ZSPT(:,:)=SPT(:,:)
CALL MO3DPRJAD(IMODE,ISPACE,NVMOD,NVMODPP,NUMVMO,ZSPVOR,ZSPDIV,&
 & ZSPT,SPSP,ZC,ZB,ZUP,ZDIAG,ZLOW,ZFQ,ZFP)  

!*       8.3   BACK TO THE FIELD.

! local arrays ZSP* are used to avoid NFLEV/NFLSUR bug (F.V.)

SPVOR(:,:)=ZSPVOR(:,:)
SPDIV(:,:)=ZSPDIV(:,:)
SPT(:,:)=ZSPT(:,:)
IF (MYSETW == NPROCM(0)) THEN
  SPVOR(:,NASM0(0))=0.0_JPRB
  SPDIV(:,NASM0(0))=0.0_JPRB
ENDIF

CALL STEPOAD('0AAF00AAB')

IF (MYSETW == NPROCM(0)) THEN
  SPVOR(:,NASM0(0))=0.0_JPRB
  SPDIV(:,NASM0(0))=0.0_JPRB
ENDIF

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

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