SUBROUTINE NNMI2TL(KTYPE)

!**** *NNMI2TL* - Tangent Linear 2D NMI for S.W.M.

!     Purpose.   To perform the tangent linear of NMI
!     --------   for a shallow water model.

!**   Interface.
!     ----------
!        *CALL* *NNMI2TL(KTYPE)

!        Explicit arguments :  KTYPE=1 : a 2D linear NMI is required
!        --------------------           (one step with  only MOPRJ(..,KMO=1,..))
!                              KTYPE=2 : a 2D non-linear NMI is required
!                                       (NITNMI step of NNMI sheme)

!        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 divided by the
!               frequencies. We go back into spectral space and deduct the
!               projected fields from the state variables. The process is
!               repeated NITNMI times.

!     Externals.  STEPO  - compute the tendencies
!     ----------  MOPRJM - project on gravity modes
!                 TRAGEO - transformation between the two spheres
!                          (real to transformed, or reverse path)
!                 SPNORM - compute norms in spectral space (one level)
!                 MVTEND - COPYING TENDENCIES TO ARGUMENTS OF MO3DPRJ
!                 SUALLTT- ALLOCATE SPACE FOR SPECTRAL TENDENCIES
!                 DEALLTT- DESALLOCATE SPACE FOR SPECTRAL TENDENCIES
!                 RDPINMI- READ HELP ARRAYS FOR IMPLICIT NMI

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

!     Author.
!     -------
!        Mats Hamrud and Philippe Courtier  *ECMWF*

!     Modifications.
!     --------------
!        Original : 88-05-25
!        F. Rabier  : 91-08-30 : SCMPRJ --> MOPRJ, and the new option KTYPE.
!        D. Giard   : 93-04-02 : NNMI with stretching (see NNMI2)
!        D. Giard   : 93-04-02 : ISPORTS=NSTTYP-1
!        D. Giard   : 94-11-24 : previous opening of matrixes or not
!        M.Hamrud/L.Isaksen : 94-12-19 : new interface to MOPRJ
!        L.Isaksen  : 94-12-19 : Modified interface to MOPRJ
!        L.Isaksen  : 95-06-06 : Reordering of spectral arrays
!        D. Giard   : 95-09-06 : corrections
!        M.Hamrud   : 95-10-30 : Changed CLCONF def.
!        R. El Khatib : 01-08-07 Pruning options
!        G. Desroziers : 02-09-16 also treat Aladin mean wind trajectory
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!***************************************************************************

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

USE YOMDIM   , ONLY : NSMAX    ,NSPEC2   ,NCMAX    ,NCPEC    ,&
 & NCPEC2   ,NTMAX    ,NTPEC2   ,NUMCP    ,NUMTP  
USE YOMSP    , ONLY : SPVOR    ,SPDIV    ,SPSP, SP5A3, SP5A2
USE YOMLAP   , ONLY : NASM0    ,NACM0    ,NATM0    ,NCVALUE  ,&
 & NTVALUE  ,NSTREL   ,MYMS     ,RCAPDI   ,RCAPIN   ,&
 & RTAPDI   ,RTAPIN  
USE YOMNMIA  , ONLY : NLEX     ,NITNMI   ,NVMOD    ,NVMODPP  ,&
 & LRPIMP   ,LTRANS   ,LSPNDG  
USE YOMLUN   , ONLY : NULOUT   ,NULDILA  ,NULCONT  ,NULROTC
USE YOMGEM   , ONLY : NSTTYP   ,RLOCEN
USE YOMCT0   , ONLY : NSTART
USE YOMCT1   , ONLY : N1SDI
USE YOMCT3   , ONLY : NSTEP
USE YOMMUL   , ONLY : N
USE YOMVAR   , ONLY : LTRREF
USE TRAJECTORY_MOD, ONLY: LTRAJGP, GET_TRAJ_SPEC

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KTYPE 
!     DUMMY REAL
REAL(KIND=JPRB) :: ZDUM(1,1)

!*******************************************************
!**  ARRAYS ON THE T"NSMAX" OF THE TRANSFORMED SPHERE **
!*******************************************************
REAL(KIND=JPRB) :: ZVOR(1,NSPEC2),ZDIV(1,NSPEC2),ZSP(NSPEC2)
!*******************************************************
!**  ARRAYS ON THE T"NTMAX" OF THE TRANSFORMED SPHERE **
!*******************************************************
REAL(KIND=JPRB) :: ZVORDI(1,NTPEC2),ZDIVDI(1,NTPEC2),ZSPDI(NTPEC2)
REAL(KIND=JPRB) :: ZVDTT(NTPEC2,1,3)
!***********************************************************
!**  ARRAYS ON THE T"NCMAX" OF THE REAL GEOGRAPHIC SPHERE **
!***********************************************************
REAL(KIND=JPRB) :: ZVDTR(NCPEC2,1,3)
REAL(KIND=JPRB) :: ZC(NCPEC2),ZDIAG(NCPEC2),ZFP(NCPEC),ZFQ(NCPEC)
REAL(KIND=JPRB) :: ZB(NCPEC2),ZLOW(NCPEC2),ZUP(NCPEC2)
REAL(KIND=JPRB) :: ZENERS(NUMCP)

CHARACTER (LEN = 9) ::  CLCONF,CLCONA

INTEGER(KIND=JPIM) :: I, IDIRTR, IFIELD, IFLAG, IFLDSUR, IK, IMO,&
 & IMODES, ISPACE, ISPORTS, ITERMAX, ITYPFLD, &
 & J, JITER  

LOGICAL :: LLTRAGEO
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "moprjm.intfb.h"
#include "mvtend.intfb.h"
#include "rdpinmi.intfb.h"
#include "spnorm.intfb.h"
#include "stepo.intfb.h"
#include "stepotl.intfb.h"
#include "sualltt.intfb.h"
#include "dealltt.intfb.h"
#include "trageo.intfb.h"

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

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

!*      0.0    SET VERTICAL MODE INDEX
IF (LHOOK) CALL DR_HOOK('NNMI2TL',0,ZHOOK_HANDLE)
IK= 1

!*      0.1    WRITE THE KIND OF JOB REQUESTED

IF (KTYPE == 1) THEN
  WRITE(NULOUT,'(/,'' LINEAR 2D NORMAL MODE INITIALIZATION'')')
ELSEIF (KTYPE == 2) THEN
  WRITE(NULOUT,'(/,'' NONLINEAR 2D NORMAL MODE INITIALIZATION'')')
ELSE
  WRITE(NULOUT,'('' KTYPE MUST BE 1 OR 2.  KTYPE ='',I5)') KTYPE
  CALL ABOR1(' WRONG VALUE FOR KTYPE IN NNMI2 ')
ENDIF
IF (LRPIMP) THEN
  IF (NLEX == 0) THEN
    WRITE(NULOUT,'('' PURE IMPLICIT SCHEME  '')')
  ELSE
    WRITE(NULOUT,'('' MIXED (EXPL.-IMPL.) SCHEME  '')')
  ENDIF
ELSE
  WRITE(NULOUT,'('' PURE EXPLICIT SCHEME  '')')
ENDIF

!*      0.2   SET UP CONFIGURATION FOR STEPO.

IF (KTYPE == 2) THEN
  CLCONA(1:9)='0AAE00A?0'
  IF (NTMAX == NSMAX) THEN
    CLCONA(8:8)='A'
  ELSE
    CLCONA(8:8)='T'
  ENDIF
ENDIF

!*      0.3    SPECTRAL DIAGNOSTICS.

IF ((N1SDI == 1) .AND. LSPNDG) THEN
  IF (KTYPE == 2) THEN
    WRITE(NULOUT,'('' SPECTRUM BEFORE NNMI ITERATION'')')
  ELSEIF (KTYPE == 1) THEN
    WRITE(NULOUT,'('' SPECTRUM BEFORE LINEAR NMI'')')
  ENDIF
  CALL SPNORM(0)
ENDIF

!*      0.4    READ OF HELP ARRAYS FOR IMPLICIT NMI SCHEME

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

!*      0.5    INITIALIZE LOGICAL SWITCHES FOR HORIZONTAL
!              TRANSFORMATIONS BETWEEN THE TWO SPHERES :

! NSTTYP=1 ==> pole of stretching and pole of colloc. grid at the northern 
!              pole of the real sphere. (YOMGEM)
! LTRANS=.TRUE. if NMI required on the transformed sphere.(YOMNMI) 
! The subroutine TRAGEO is likely to be used if LLTRAGEO=TRUE :
! if NSMAX.NE.NCMAX (RSTRET>1.) or if NSTTYP.NE.1

LLTRAGEO = (NSMAX /= NCMAX) .OR. (NSTTYP /= 1)

!*      0.6    INITIALIZE THE REAL NUMBER OF ITERATION : ITERMAX

IF (KTYPE == 1) ITERMAX = 1
IF (KTYPE == 2) ITERMAX = NITNMI

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

!     *******************************
!     ** MAIN LOOP OVER ITERATIONS **
!     **                           **

ITERATION_LOOP: DO JITER=1,ITERMAX

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

!*    1.    GOTO THE CORRECT SPHERE.
!           ------------------------

  IF (KTYPE == 2) THEN

!*      1.1   SAVE STATE VARIABLES. (SPxx --> Zxx)

    SPVOR(IK,NASM0(0))= 0.0_JPRB
    SPDIV(IK,NASM0(0))= 0.0_JPRB
    DO J=1,NSPEC2
      ZVOR(IK,J)= SPVOR(IK,J)
      ZDIV(IK,J)= SPDIV(IK,J)
      ZSP (J)   = SPSP (J)
    ENDDO

!*      1.2   COMPUTE TENDENCIES.

    NSTEP= NSTART-ITERMAX-1+JITER

!*      1.2.1 TRAJECTORY

    IF (.NOT.LTRAJGP) THEN
      IF (LTRREF) THEN
        CLCONF(1:9) = 'BE0000000'
      ELSE
        CALL GSTATS(15,0)
        CALL get_traj_spec(SP5A3,SP5A2,ZDUM,KSTEP=nstep)
        CALL GSTATS(15,1)
        CLCONF(1:9)='0E0000000'
      ENDIF
      CALL STEPO(CLCONF)
    ENDIF

    IF (NTMAX > NSMAX) CALL SUALLTT
    CALL STEPOTL(CLCONA)

!*      1.3   COPY TENDENCIES (non-linear NMI). (SPxx --> ZxxDI)

    IF (NTMAX == NSMAX) THEN
      SPVOR(IK,NASM0(0))= 0.0_JPRB
      SPDIV(IK,NASM0(0))= 0.0_JPRB
      DO J=1,NSPEC2
        ZVORDI(IK,J)= SPVOR(IK,J)
        ZDIVDI(IK,J)= SPDIV(IK,J)
        ZSPDI (J)   = SPSP (J)
      ENDDO
    ELSE
      CALL MVTEND(ZVORDI,ZDIVDI,ZSPDI,ZSPDI)
      CALL DEALLTT
    ENDIF

  ENDIF

!*      1.4   COPY STATE VARIABLES (linear NMI). (SPxx --> ZxxDI)

  IF (KTYPE == 1) THEN
    IF (NTMAX > NSMAX) THEN
      DO J=1,NTPEC2
        ZVORDI(IK,J)= 0.0_JPRB
        ZDIVDI(IK,J)= 0.0_JPRB
        ZSPDI (J)   = 0.0_JPRB
      ENDDO
      DO J=1,NSPEC2
        I= NSTREL(J)
        ZVORDI(IK,I)= SPVOR(IK,J)
        ZDIVDI(IK,I)= SPDIV(IK,J)
        ZSPDI (I)   = SPSP (J)
      ENDDO
    ELSE
      ZVORDI(IK,:)= SPVOR(IK,:)
      ZDIVDI(IK,:)= SPDIV(IK,:)
      ZSPDI (:)   = SPSP (:)
    ENDIF
  ENDIF

!*      1.5   TRANSFORM OF VARIABLES (KTYPE=1) OR TENDENCIES (KTYPE=2).
!*            ON THE CURRENT SPHERE: ZxxDI --> ZVDTR 

  IF (LTRANS .OR. .NOT.LLTRAGEO) THEN

! We are on on the real geographic sphere (NSMAX=NTMAX=NCMAX) or
! we want to remain on the transformed sphere (NTMAX=NCMAX>NSMAX)

    DO J=1,NTPEC2
      ZVDTR(J,IK,1)= ZVORDI(IK,J)
      ZVDTR(J,IK,2)= ZDIVDI(IK,J)
      ZVDTR(J,IK,3)= ZSPDI (J)
    ENDDO

!*      1.6   FROM "TRANSFORMED" TO "GEOGRAPHIC" SPHERE:
!*            ZxxDI --> ZVDTT --> ZVDTR

  ELSE

! Goto the real geographic sphere : ZxxDI --> ZVDTT --> ZVDTR

    WRITE(NULOUT,'('' GOTO THE REAL GEOGRAPHIC SPHERE :'' )')

! Vorticity and divergence (transformed sphere) are first transformed into
! stream function and velocity potential before the call to TRAGEO.
    WRITE(NULOUT,'(''   COMPUTE STREAM FONCTION AND VELOCITY'',&
     & '' POTENTIAL ON THE TRANSFORMED SPHERE'' )')  
    DO J=1,NTPEC2
      ZVDTT(J,IK,1)= RTAPIN(NTVALUE(J))* ZVORDI(IK,J)
      ZVDTT(J,IK,2)= RTAPIN(NTVALUE(J))* ZDIVDI(IK,J)
      ZVDTT(J,IK,3)=                     ZSPDI (J)
    ENDDO

! Goto the real geographic sphere : ZVDTT --> ZVDTR

    IFIELD  = 3
    IFLDSUR = 3
    ISPORTS = NSTTYP-1
    ITYPFLD = 2
    IDIRTR  = 1
    WRITE(NULOUT,'(''   CALL TO TRAGEO, IDIR = +1 '' )')

    CALL TRAGEO(NULROTC,NULDILA,NULOUT,&
     & IFIELD,IFLDSUR,NTMAX,NATM0,NTPEC2,NUMTP,NCMAX,&
     & NACM0,NCPEC2,NUMCP,MYMS,ISPORTS,ITYPFLD,IDIRTR,&
     & RLOCEN,0.0_JPRB,ZVDTT,ZVDTR)  

! Vorticity and divergence on the real sphere are obtained using the
! stream function and the velocity potential : ZVDTR --> ZVDTR

    WRITE(NULOUT,'(''   COMPUTE VORTICITY AND DIVERGENCE'',&
     & '' ON THE REAL SPHERE'' )')  
    DO J=1,NCPEC2
      ZVDTR(J,IK,1)= RCAPDI(NCVALUE(J))* ZVDTR(J,IK,1)
      ZVDTR(J,IK,2)= RCAPDI(NCVALUE(J))* ZVDTR(J,IK,2)
    ENDDO

  ENDIF

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

!*    2.    PROJECT TENDENCIES OR STATE VARIABLES (ZVDTR(..,1 to 3))
!*          ONTO REQUESTED MODES (ACCORDING TO KTYPE).
!*          (we are on the correct sphere with a truncation NCMAX)
!           -------------------------------------------------------

  IF (KTYPE == 2) THEN
    IMO = 3
    WRITE(NULOUT,'('' *****   COMPUTE NNMI INCREMENTS    *****'')')
  ELSEIF (KTYPE == 1) THEN
    IMO = 1
    WRITE(NULOUT,'('' ***** PROJECTION ONTO ROSSBY MODES *****'')')
  ENDIF

  N= -1
  IFLAG = 2
  ISPACE = 1
  CALL MOPRJM(ZVDTR,ZC,ZB,ZUP,ZDIAG,ZLOW,ZFQ,ZFP,ZENERS,&
   & NVMOD,NVMODPP,IMO,ISPACE,IFLAG)  

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

!*    3.    COME BACK TO THE CORRECT SPHERE.
!           --------------------------------

!*      3.1   TRANSFORM OF VARIABLES (KTYPE=1) OR INCREMENTS (KTYPE=2).
!*            ON THE CURRENT SPHERE: ZVDTR --> ZxxDI 

  IF (LTRANS .OR. .NOT.LLTRAGEO) THEN
! We remain on the real geographic or on the transformed sphere
    DO J=1,NTPEC2
      ZVORDI(IK,J)= ZVDTR(J,IK,1)
      ZDIVDI(IK,J)= ZVDTR(J,IK,2)
      ZSPDI (J)   = ZVDTR(J,IK,3)
    ENDDO

!*      3.2   FROM "GEOGRAPHIC" TO "TRANSFORMED" SPHERE:
!*            ZVDTR --> ZVDTT --> ZxxDI

  ELSE
! Goto the transformed sphere : ZVDTR --> ZVDTR --> ZxxDI
    WRITE(NULOUT,'('' COME BACK TO THE TRANSFORMED SPHERE :'' )')

! Vorticity and divergence on the real sphere are transformed into
! stream function and velocity potential : ZVDTR --> ZVDTR
    WRITE(NULOUT,'(''   COMPUTE STREAM FONCTION AND VELOCITY'',&
     & '' POTENTIAL ON THE REAL SPHERE'' )')  
    DO J=1,NCPEC2
      ZVDTR(J,IK,1)= RCAPIN(NCVALUE(J))* ZVDTR(J,IK,1)
      ZVDTR(J,IK,2)= RCAPIN(NCVALUE(J))* ZVDTR(J,IK,2)
    ENDDO

! Goto the transformed sphere : ZVDTR --> ZVDTT
    WRITE(NULOUT,'(''   CALL TO TRAGEO, DIR = -1 '' )')
    IDIRTR = -1
    CALL TRAGEO(NULROTC,NULCONT,NULOUT,&
     & IFIELD,IFLDSUR,NTMAX,NATM0,NTPEC2,NUMTP,NCMAX,&
     & NACM0,NCPEC2,NUMCP,MYMS,ISPORTS,ITYPFLD,IDIRTR,&
     & RLOCEN,0.0_JPRB,ZVDTT,ZVDTR)  

! Vorticity and divergence (transformed sphere) are obtained using the
! stream function and the velocity potential :  ZVDTT --> ZxxDI

    WRITE(NULOUT,'(''   COMPUTE VORTICITY AND DIVERGENCE'',&
     & '' ON THE TRANSFORMED SPHERE'' )')  
    DO J=1,NTPEC2
      ZVORDI(IK,J)= RTAPDI(NTVALUE(J))* ZVDTT(J,IK,1)
      ZDIVDI(IK,J)= RTAPDI(NTVALUE(J))* ZVDTT(J,IK,2)
      ZSPDI (J)   =                     ZVDTT(J,IK,3)
    ENDDO

  ENDIF

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

!*    4.    UPDATE STATE VARIABLES.
!           -----------------------

!*      4.1   STATE VARIABLES ARE UPTATED WITH THE NNMI INCREMENTS:
!*            Zxx - ZxxDI --> SPxx

  IF (KTYPE == 2) THEN
    IF (NSMAX < NTMAX) THEN
      DO J=1,NSPEC2
        I= NSTREL(J)
        SPVOR(IK,J)= ZVOR(IK,J) - ZVORDI(IK,I)
        SPDIV(IK,J)= ZDIV(IK,J) - ZDIVDI(IK,I)
        SPSP (J)   = ZSP (J)    - ZSPDI (I)
      ENDDO
    ELSE
      SPVOR(IK,:)= ZVOR(IK,:) - ZVORDI(IK,:)
      SPDIV(IK,:)= ZDIV(IK,:) - ZDIVDI(IK,:)
      SPSP (:)   = ZSP (:)    - ZSPDI (:)
    ENDIF
  ENDIF

!*      4.2   STATE VARIABLES ARE UPTATED WITH THE LNMI VALUES:
!*            ZxxDI --> SPxx

  IF (KTYPE == 1) THEN
    IF (NSMAX < NTMAX) THEN
      DO J=1,NSPEC2
        I= NSTREL(J)
        SPVOR(IK,J)= ZVORDI(IK,I)
        SPDIV(IK,J)= ZDIVDI(IK,I)
        SPSP (J)   = ZSPDI (I)
      ENDDO
    ELSE
      SPVOR(IK,:)= ZVORDI(IK,:)
      SPDIV(IK,:)= ZDIVDI(IK,:)
      SPSP (:)   = ZSPDI (:)
    ENDIF
  ENDIF

  SPVOR(IK,NASM0(0))=0.0_JPRB
  SPDIV(IK,NASM0(0))=0.0_JPRB

!*      4.3   SPECTRAL DIAGNOSTICS.

  IF ((N1SDI == 1) .AND. LSPNDG) THEN
    IF (KTYPE == 2) THEN
      WRITE(NULOUT,'('' SPECTRUM DIAGNOSTICS AFTER ITERATION'')')
    ELSEIF (KTYPE == 1) THEN
      WRITE(NULOUT,'('' SPECTRUM DIAGNOSTICS AFTER LINEAR NMI'')')
    ENDIF
    CALL SPNORM(0)
  ENDIF

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

ENDDO ITERATION_LOOP

!     **                                  **
!     ** END OF MAIN LOOP OVER ITERATIONS **
!     **************************************

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

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