SUBROUTINE NNMI3

!**** *NNMI3* - NON-LINEAR NORMAL MODE INITIALIZATION FOR 3-D P.E.M.

!     PURPOSE.   TO PERFORM THE NON-LINEAR NORMAL MODE INITIALIZATION
!     --------   FOR A 3-D P. E. MODEL (EXPLICIT OR IMPLICIT SCHEME)

!**   INTERFACE.
!     ----------
!        *CALL* *NNMI3*

!        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 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
!     ----------  MO3DPRJ- PROJECTION ON MODES
!                 SPNORM - COMPUTE NORMS IN SPECTRAL SPACE FOR ALL LEVELS
!                 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
!                 USER_CLOCK- timing

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

!     AUTHOR.
!     -------
!        CLIVE TEMPERTON  *ECMWF*
!        - BASED ON THE ROUTINE NNMI2 WRITTEN BY
!        MATS HAMRUD AND PHILIPPE COURTIER  *ECMWF*

! Modifications
! -------------
!   ORIGINAL : 90-01-14
!   PASCAL MARQUET : 90-12-15 : INTRODUCTION OF IMPLICIT NMI SCHEME
!   PASCAL MARQUET : 91-02-15 : INTRODUCTION OF MIXED NMI SCHEME ON
!                               THE GEOGRAPHIC SPHERE.
!   PASCAL MARQUET : 91-07-07 : psi AND khi TRANSFORMATION FOR TRAGEO
!   D. GIARD       : 92-05-12 : no test on vertical mode for LTIDEDG
!   D. GIARD       : 92-05-22 : configuration '0' for IOPACK
!                               new call to UPDTIM (time-step = 1.)
!   D. GIARD       : 92-09-03 : calls to REMARK2
!   D. GIARD       : 92-07-15 : additionnal NNMI step to test convergence
!                               EMERAUDE diabatic scheme
!   D. GIARD       : 92-11-26 : LRSPSL to restore Ps, final form
!   ECMWF          : 93-??-?? : NVMOD --> NVMODM ; call to RDPINMI
!   D. GIARD       : 92-12-23 : time-step = RTACUMT, instead of 1., for
!                               total tendencies (EMERAUDE diab. scheme)
!   D. GIARD       : 93-03-19 : in case of stretching, tendencies are
!                               needed up to n=NTMAX, instead of NSMAX
!   D. GIARD       : 93-04-08 : time-step for dynamical tendencies
!   F RABIER       : 93-12-10 : write-up trajectory if LTRAJ
!   C. TEMPERTON   : 93-11-01 : switch (LEULNMI) to use Eulerian
!                               tendencies in the "Machenhauer" step
!   M. Hamrud      : 93-11-09 : memory savings
!   J.N. Thepaut   : 94-02-21 : tidying up of initialization of ps
!   C. Temperton   : 95-02-06 : two-time-level scheme
!   L. Isaksen     : 95-06-06 : Reordering of spectral arrays
!   D. Giard       : 95-06-06 : time-step for semi-lag. tendencies
!   D. Giard       : 95-08-30 : corrections
!   M.Hamrud       : 95-10-30 : Changed CLCONF def.
!   C. Temperton   : 96-01-09 : LASSI (adiabatic NMI at small scales
!                               only)
!   J.N. Thepaut   : 95-12-21 : exclusion of physical tendencies in nmi of
!                               increments.
!   D.Dent         : 97-10-03 : Changed SECOND to USER_CLOCK
!   D.Salmond (15-10-01) FULLIMP mods
!   01-Oct-2003 M. Hamrud  CY28 Cleaning
!   10-Jun-2004 J. Masek   NH cleaning (LFULLIMP)
! End Modifications
!------------------------------------------------------------------------------

USE PARKIND1 , ONLY : JPIM     ,JPRB
USE YOMHOOK  , ONLY : LHOOK    ,DR_HOOK
USE YOMDIM   , ONLY : NFLEVL   ,NSMAX    ,NSPEC2   ,NCPEC    ,NCPEC2   , &
 &                    NTMAX    ,NTPEC2  
USE YOMGEM   , ONLY : RSTRET
USE YOMSP    , ONLY : SPVOR    ,SPDIV    ,SPT      ,SPSP
USE YOMLAP   , ONLY : NASM0    ,NSTREL   ,NSPINDX  ,NSPZERO  ,NSPNSUM
USE YOMDYN   , ONLY : TSTEP    ,TDT
USE YOMNMIA  , ONLY : NLEX     ,NITNMI   ,NVMODM   ,NVMOD    ,NFILTM   , &
 &                    NVMODPP  ,LRPIMP   ,LSPNDG   ,LRSPSL   ,LICONV   , &
 &                    LASSI  
USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : NCONF    ,NSTART   ,NPROC    ,LSLAG    ,LTWOTL   , &
 &                    LFPOS
USE YOMCT1   , ONLY : N1SDI
USE YOMCT3   , ONLY : NSTEP
USE YOMMP    , ONLY : MYPROC   ,MYSETW   ,NPROCM   ,NUMVMO   ,NPSP
USE GMV_SUBS_MOD , ONLY : SETUP_GMV

IMPLICIT NONE

INTEGER(KIND=JPIM) :: I, ICONF, IMODE, IMODES, IOMASTER, ISEFRE,&
 & ISP, ISPACE, ITERMAX, J, JITER, JK, JN  

LOGICAL :: LLPRINT, LLRSPSL, LLSLAGX, LLTWOTLX

REAL(KIND=JPRB) :: ZT1, ZT2

!*******************************************************
!**  ARRAYS ON THE T"NTMAX" OF THE TRANSFORMED SPHERE **
!*******************************************************
REAL(KIND=JPRB) :: ZVORDI(NFLEVL,NTPEC2),ZDIVDI(NFLEVL,NTPEC2)
REAL(KIND=JPRB) :: ZTDI(NFLEVL,NTPEC2),ZSPDI(NTPEC2)
!***********************************************************
!**  ARRAYS ON THE T"NCMAX" OF THE REAL GEOGRAPHIC SPHERE **
!***********************************************************
REAL(KIND=JPRB) :: ZC(NCPEC2,NVMODM),ZDIAG(NCPEC2,NVMODM)
REAL(KIND=JPRB) :: ZFP(NCPEC),ZFQ(NCPEC),ZB(NCPEC2),ZLOW(NCPEC2),ZUP(NCPEC2)

CHARACTER (LEN = 9) ::  CLCONF
CHARACTER (LEN = 40) ::  CLMARK,CLTIME
CHARACTER (LEN = 10) ::  CLTIMEOD
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

INTERFACE
#include "user_clock.h"
END INTERFACE

#include "mo3dprj.intfb.h"
#include "mvtend.intfb.h"
#include "rdpinmi.intfb.h"
#include "rdspec.intfb.h"
#include "spnorm.intfb.h"
#include "stepo.intfb.h"
#include "sualltt.intfb.h"
#include "dealltt.intfb.h"
#include "updtim.intfb.h"
#include "wrspec.intfb.h"

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

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

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

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

!*    0.1   SET UP CONFIGURATIONS FOR STEPO.

! Compute dynamical tendencies with CLCONF(4:4)='E' (see CPG) :
!    - a time step of TSTEP seconds for dynamics (ZDT=TSTEP)
!    - a time step of 0 second for physics  (ZDTPHY=0)
! Compute total tendencies with CLCONF(4:4)='M' (see CPG and CPGLAG) :
!    - a time step of RTACUMT seconds for dynamics and physics
!       (ZDT=ZDTPHY=RTACUMT, to limit diabatic tendencies)
! for the last iteration with the diabatic EMERAUDE scheme.

CLCONF(1:9)='?AAE00A?0'
ICONF=NCONF/100
IF(ICONF == 1.OR.ICONF == 4.OR.&
   & ICONF == 5.OR.ICONF == 6.OR.ICONF == 8) THEN  
  CLCONF(1:1)= 'T'
ELSE
  CLCONF(1:1)= '0'
ENDIF
IF (NTMAX == NSMAX) THEN
  CLCONF(8:8)= 'A'
ELSE
  CLCONF(8:8)= 'T'
ENDIF

!*    0.2    DIAGNOSTICS.

IOMASTER=MIN(NPROC,1)
LLPRINT=MYPROC == IOMASTER

IF (LLPRINT) THEN
  WRITE(NULOUT,'('' NON LINEAR 3-D NORMAL MODE INITIALIZATION'')')
  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
ENDIF
IF (N1SDI == 1.AND.LSPNDG) THEN
  WRITE(NULOUT,'('' SPECTRUM DIAGNOSTICS BEFORE NMI ITERATIONS'')')
  CALL SPNORM(0)
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

!*    0.4    NUMBER OF NNMI ITERATIONS.

! LICONV = .TRUE. :  An additionnal iteration is performed to verify
! convergence ; fields are not updated at the last iteration.

IF (LICONV) THEN
  ITERMAX= NITNMI+1
ELSE
  ITERMAX= NITNMI
ENDIF

!*    0.5    RESET SEMI-LAGRANGIAN SWITCH.

! Convert to Eulerian model for computation of tendencies,
! having first saved the value of the semi-Lagrangian switch.

LLSLAGX  = LSLAG
LSLAG  = .FALSE.
LLTWOTLX = LTWOTL
LTWOTL = .FALSE.
CALL SETUP_GMV

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

ITERATION_LOOP: DO JITER=1,ITERMAX

  CALL USER_CLOCK(PTOTAL_CP=ZT1)

!       If LLRSPSL=.TRUE., Ps is not updated
!       LLRSPSL must be .FALSE. at the last iteration

  LLRSPSL= LRSPSL
  IF (JITER == NITNMI) LLRSPSL= .FALSE.

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

!*       1.    SAVE STATE VARIABLES.
!              ---------------------

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

  CALL WRSPEC

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

!*       2.    COMPUTE TENDENCIES.
!              -------------------

  NSTEP= NSTART-NITNMI-1+JITER
  CALL UPDTIM(0,TSTEP,TSTEP,.FALSE.)

! Allocate space for spectral tendencies

  IF (NTMAX /= NSMAX) CALL SUALLTT
  CALL STEPO(CLCONF)

  IF (NTMAX == NSMAX) THEN
! Spectral tendencies are in SPxxx arrays
    IF (MYSETW == NPROCM(0)) THEN
      SPVOR(1:NFLEVL,NASM0(0))= 0.0_JPRB
      SPDIV(1:NFLEVL,NASM0(0))= 0.0_JPRB
    ENDIF
    ZVORDI(1:NFLEVL,:)= SPVOR(1:NFLEVL,:)
    ZDIVDI(1:NFLEVL,:)= SPDIV(1:NFLEVL,:)
    ZTDI  (1:NFLEVL,:)= SPT  (1:NFLEVL,:)

    IF (NPSP == 1) THEN
      ZSPDI(:)= SPSP(:)
    ELSE
      ZSPDI(:)=-99999._JPRB
    ENDIF

  ELSE

! Spectral tendencies are in SPTxxx arrays

    CALL MVTEND(ZVORDI,ZDIVDI,ZTDI,ZSPDI)
    CALL DEALLTT
  ENDIF

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

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

! IMODE=4: projection on grav. waves and division by freq.
!         (exclusion of diabatic tendencies)
! IMODE=3: projection on grav. waves and division by freq.
! IMODE=2: projection on grav. waves
! ISPACE=1: working space = spectral space

  IF (JITER <= NITNMI) THEN
    IMODE= 3
  ELSE
    IMODE= 2
  ENDIF

!* at the moment the exclusion of diabatic tendencies is done
!* in the hough space only if we are in stretched geometry.

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

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

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

! JITER=1 to NITNMI : NNMI iteration; fields are updated
! JITER=NITNMI+1 : projection of final tendencies on gravity modes,
!                  to verify convergence; fields are restored

  CALL RDSPEC(LFPOS)

  IF (JITER <= NITNMI) THEN
! Modify spectral arrays
    IF (.NOT.LLRSPSL.AND.NPSP == 1.AND.MYSETW == NPROCM(0)) THEN
      DO JN=0,NSMAX
        SPSP(NSPZERO(JN))=0.0_JPRB
      ENDDO
    ENDIF
    IF (NSMAX < NTMAX) THEN
      DO JK=1,NFLEVL
        DO J=1,NSPEC2
          I= NSTREL(J)
          SPVOR(JK,J)= SPVOR(JK,J) - ZVORDI(JK,I)
          SPDIV(JK,J)= SPDIV(JK,J) - ZDIVDI(JK,I)
          SPT  (JK,J)= SPT  (JK,J) - ZTDI  (JK,I)
        ENDDO
      ENDDO
      IF (.NOT.LLRSPSL.AND.NPSP == 1) THEN
        DO J=1,NSPEC2
          I= NSTREL(J)
          SPSP(J)= SPSP(J) - ZSPDI(I)
        ENDDO
      ENDIF
    ELSE
      SPVOR(1:NFLEVL,:)= SPVOR(1:NFLEVL,:) - ZVORDI(1:NFLEVL,:)
      SPDIV(1:NFLEVL,:)= SPDIV(1:NFLEVL,:) - ZDIVDI(1:NFLEVL,:)
      SPT  (1:NFLEVL,:)= SPT  (1:NFLEVL,:) - ZTDI  (1:NFLEVL,:)
      IF (.NOT.LLRSPSL.AND.NPSP == 1) THEN
        SPSP(:)= SPSP(:) - ZSPDI(:)
      ENDIF
    ENDIF
    IF (MYSETW == NPROCM(0)) THEN
      SPVOR(1:NFLEVL,NASM0(0))= 0.0_JPRB
      SPDIV(1:NFLEVL,NASM0(0))= 0.0_JPRB
    ENDIF

! * SPECIAL TREATMENT FOR THE INITIALISATION OF THE INCREMENTS
!   IN THE INCREMENTAL APPROACH
!   WHERE WE DO NOT WANT TO TOUCH WAVE NUMBERS DIABATICALLY INITIALISED
! (caution : should be done in Hough space on geographical sphere)

! -- same code is used to initialize a [3DVAR] analysis after interpolation
!    to lower resolution.

    IF (ABS(RSTRET-1.0_JPRB)  <=  0.01_JPRB) THEN
      IF (((NCONF == 1.OR.NCONF ==302).AND.LASSI)) THEN
        ISEFRE=NSPNSUM(NFILTM)
        DO JK=1,NFLEVL
          DO J=1,ISEFRE
            ISP=NSPINDX(J)
            SPVOR(JK,ISP)=SPVOR(JK,ISP)+ZVORDI(JK,ISP)
            SPDIV(JK,ISP)=SPDIV(JK,ISP)+ZDIVDI(JK,ISP)
            SPT(JK,ISP)=SPT(JK,ISP)+ZTDI(JK,ISP)
          ENDDO
          IF (MYSETW == NPROCM(0)) THEN
            SPVOR(JK,NASM0(0))=0.0_JPRB
            SPDIV(JK,NASM0(0))=0.0_JPRB
          ENDIF
        ENDDO
        IF (.NOT.LLRSPSL.AND.NPSP == 1) THEN
          DO J=1,ISEFRE
            ISP=NSPINDX(J)
            SPSP(ISP)=SPSP(ISP)+ZSPDI(ISP)
          ENDDO
        ENDIF
      ENDIF
    ENDIF

! Diagnostics if required

    IF (LLPRINT) WRITE(NULOUT,'('' NON-LINEAR NMI, ITERATION='',I2)') JITER
    IF (N1SDI == 1.AND.LSPNDG) THEN
      WRITE(NULOUT,FMT='('' SPECTRUM DIAGNOSTICS AFTER'',&
       & I2,'' NMI ITERATION(S)'')') JITER  
      CALL SPNORM(0)
    ENDIF

  ELSE

!         Fields are not modified

    IF (LLPRINT) WRITE(NULOUT,'('' DUMMY NMI ITERATION='',I2)') JITER
  ENDIF

  CALL USER_CLOCK(PTOTAL_CP=ZT2)
  CALL DATE_AND_TIME(TIME=CLTIMEOD)
  WRITE (UNIT=CLTIME,FMT=997)&
   & CLTIMEOD(1:2),CLTIMEOD(3:4),CLTIMEOD(5:6),ZT2-ZT1  
  IF (JITER <= NITNMI) THEN
    WRITE (UNIT=CLMARK,FMT=998) JITER,NITNMI
  ELSE
    WRITE (UNIT=CLMARK,FMT=999)
  ENDIF
  WRITE(NULOUT,*) CLTIME
  WRITE(NULOUT,*) CLMARK

!     ** END OF MAIN LOOP OVER ITERATIONS **

ENDDO ITERATION_LOOP

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

!*       5.    TIDY UP.
!              --------

CALL UPDTIM(0,TDT,TSTEP,.FALSE.)

!*    5.1   RESET SEMI-LAGRANGIAN SWITCH.

LSLAG  = LLSLAGX
LTWOTL = LLTWOTLX
CALL SETUP_GMV

997 FORMAT (1X,A,'':'',A,'':'',A,1X,F11.5,' CPU S IN ITERATION')
998 FORMAT (' INITIAL. , 3D NNMI : ITERATION ',I2,' / ',I2)
999 FORMAT (' INITIAL. , 3D NNMI : ADD. ITERATION ')

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

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