SUBROUTINE TESTLI

!**** *TESTLI*  - Verify the tangent linear model / direct model

!     PURPOSE.
!     --------
!           Verify the tangent linear model / direct model.

!**   INTERFACE.
!     ----------
!        *CALL* *TESTLI*

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

!        IMPLICIT ARGUMENTS :
!        --------------------
!        NONE

!     METHOD.
!     -------
!        SEE DOCUMENTATION

!     EXTERNALS.   SU2YOM - INITIALIZE LEVEL 2 COMMONS
!     ----------   SUALLT - ALLOCATE SPACE FOR TRAJECTORY
!                  CNT3   - CONTROLS DIRECT INTEGRATION
!                  SUPERT - INITIALIZE PERTURBATION
!                  CAIN   - CANONICAL INJECTION
!                  CNT3TL - CONTROLS TANGENT LINEAR INTEGRATION
!                  CAININ - INVERSE OF THE CANONICAL INJECTION
!                  SCAAS  - SCALAR PRODUCT
!     REFERENCE.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     AUTHOR.
!     -------
!        Patrick Moll  *DMN*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 89-04-01
!        J.N Thepaut:91-09-18 . physically sound perturbations (to takeover
!        the mistakes dawned by Patrick's intrinsic alcoholism.
!        A. Horanyi: 95-07-30 for ALADIN
!        L. Isaksen : 95-06-06 Reordering of spectral arrays
!        L. Isaksen : 96-02-20 Change VATRA to ZVATRA
!        M.Hamrud   : 98-01-10 Minimisation parallelized
!        M.Janiskova: 99-03-02 additional call for CNT3 when simplified
!                              radiation of Meteo-France
!        E.Holm     : 98-04-26 Ozone included
!        C.Temperton: 99-06-18 Code change to avoid compiler problem on SGI
!        C.Fischer  : 00-01-11 Add nonhydrostatic option and correct DM
!        Modified by R. El Khatib  : 01-05-09 reset yomct2 after changing NSTOP
!        Y.Tremolet : 02-08-08 Use control_vectors.
!        C. Soci/C. Fischer:03-05-21 Reorder fields for prints + lam mean wind
!        C. Fischer : 03-09-30 remove call to suellt
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        M.Janiskova:  14-Dec-2005 Set cloud related perturbations to zero
!        M.Janiskova:  12-Mar-2006 Initialize switch for grid-point cloud diag.
!                                  and update for radiation and cloud schemes
!        R. El Khatib  26-Nov-2008  Cleaning
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMLUN   , ONLY : NULOUT
USE YOMDIM   , ONLY : NFLEVG   ,NFLSUR   ,NSPEC2G ,NSEFRE
USE YOMCT0   , ONLY : LELAM    ,NSTOP    ,NCONF   ,N2DINI,&
 & LNHDYN    
USE YOMCT0B  , ONLY : LECMWF
USE YOMCT1   , ONLY : N1HIS    ,N1GDI
USE YOMCVA   , ONLY : YVAZX
USE YOMSP    , ONLY : SPOR
USE YOMSIMPHL, ONLY : LSIMPH   ,LRAYSP   ,LTRAJPS
USE YOMPHY   , ONLY : LMPHYS   ,LCVPP    ,LPROCLD
USE YOMPHY0  , ONLY : ECMNP
USE YOMPHY2  , ONLY : XMULAF
USE YOMRCOEF , ONLY : LRCOEF   ,LTLADDIA
USE YOEPHLI  , ONLY : LPHYLIN
USE YOEPHY   , ONLY : LEPCLD
USE YOPHNC   , ONLY : LERADSW2,LENCLD2
USE YOERAD   , ONLY : NTSW, NSW
USE CONTROL_VECTORS_COMM_MOD
USE CONTROL_VECTORS
USE YOM_YGFL , ONLY : YO3, YA, YL, YI, YR, YS
USE YOMGFL   , ONLY : GFL
USE GFL_SUBS_MOD , ONLY : DEACT_CLOUD_GFL,REACT_CLOUD_GFL
!     ------------------------------------------------------------------

IMPLICIT NONE

! * LOCAL TYPE "control_vector" VARIABLES:
TYPE(control_vector) :: YL_ZVATRA(8)

REAL(KIND=JPRB), ALLOCATABLE :: ZVATRA_ND(:,:)

INTEGER(KIND=JPIM) :: INMAS, IPARA, ISTOP, JJ, JLAMDA, JNME, IPST, IPEND
INTEGER(KIND=JPIM) :: ISW  , I1GDI

REAL(KIND=JPRB) :: ZVALU

LOGICAL :: LLSPOR, LLSHW, LLVEQ, LL2D
LOGICAL :: LLSIMPH, LLPCLD, LLSWR2, LLDIAG
LOGICAL :: LLTRAJPS
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "cain.intfb.h"
#include "cainin.intfb.h"
#include "cnt3.intfb.h"
#include "cnt3tl.intfb.h"
#include "su2yom.intfb.h"
#include "suaersn.intfb.h"
#include "suallt.intfb.h"
#include "suclopn.intfb.h"
#include "sugridf.intfb.h"
#include "supert.intfb.h"
#include "sugridu.intfb.h"
#include "suswn.intfb.h"

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

!*       0.    Set-up LL2D (2D model switch).
!              ------------------------------

IF (LHOOK) CALL DR_HOOK('TESTLI',0,ZHOOK_HANDLE)
LLSHW=NCONF == 201.OR.NCONF == 421.OR.NCONF == 521
LLVEQ=NCONF == 202.OR.NCONF == 422.OR.NCONF == 522
LL2D=LLSHW.OR.LLVEQ

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

!*       1.    INITIALIZATIONS.
!              ----------------

LLPCLD=.FALSE.
LLSWR2=.FALSE.
LLDIAG=.FALSE.
LLSPOR=.FALSE.

IF (LPROCLD) THEN
  CALL DEACT_CLOUD_GFL
ENDIF
                                                                                
DO JJ=1,8
  CALL ALLOCATE_CTLVEC(YL_ZVATRA(JJ))
ENDDO
ALLOCATE(ZVATRA_ND(YVAZX%NSIZEG,8))

!*       1.1   INITIALIZE YOMCT2

CALL SU2YOM

!*       1.2   ALLOCATE EXTRA SPACE FOR TRAJECTORY.

CALL SUALLT

!*       1.3   INITIALIZATION OF THE BASIC PERTURBATION

ZVALU=1.0_JPRB
CALL SUPERT(YVAZX,ZVALU)

!*       1.4   STORAGE OF THE BASIC STATE

CALL CAININ(YL_ZVATRA(5))

!*       1.5   COMPUTATION OF THE TRAJECTORY

CALL CAIN(YL_ZVATRA(5))
N1HIS=1

!*       1.5.1 Computation of the radiation coefficients

IF (LTLADDIA) THEN
  IF (LRCOEF.AND.LRAYSP) THEN
    LLSIMPH=LSIMPH
    LLTRAJPS=LTRAJPS
    LMPHYS=.TRUE.
    LSIMPH=.FALSE.
    LTRAJPS=.FALSE.
    ISTOP=NSTOP
    NSTOP=2
    CALL SU2YOM

    CALL CNT3
    CALL CAIN(YL_ZVATRA(5))

    LTRAJPS=LLTRAJPS
    LSIMPH=LLSIMPH
    NSTOP=ISTOP
    CALL SU2YOM
  ENDIF
ENDIF

! Prescribe parameter values as in configuration 131

IF (.NOT.LECMWF) THEN
  LMPHYS=.FALSE.
  IF (LTRAJPS) THEN
    LSIMPH=.TRUE.
    LCVPP=.FALSE.
    ECMNP=7000._JPRB
    XMULAF=0.0_JPRB
  ENDIF
ENDIF

IF (LEPCLD) THEN
  CALL SUGRIDU(0)
ENDIF

IF (LECMWF .AND. (LEPCLD .OR. LENCLD2)) THEN
  LLDIAG=.TRUE.
  I1GDI = N1GDI
  N1GDI = 1
ENDIF
 
CALL CNT3
CALL CAININ (YL_ZVATRA(1))

IF (LLDIAG) THEN
  N1GDI = I1GDI
  LLDIAG=.FALSE.
ENDIF

!*       1.6   COMPUTATION OF THE PERTURBATION

YL_ZVATRA(2)=YVAZX

!*       1.7   COMPUTATION OF CNT3TL * PERT

! Switch-off prognostic cloud scheme

IF (LEPCLD) THEN
  LEPCLD=.FALSE.
  LLPCLD=.TRUE.
  CALL DEACT_CLOUD_GFL
ENDIF

! Put perturbation of cloud variables to zero

IF (LENCLD2) THEN
  GFL(:,:,YA%MP,:) = 0.0_JPRB
  GFL(:,:,YL%MP,:) = 0.0_JPRB
  GFL(:,:,YI%MP,:) = 0.0_JPRB
  GFL(:,:,YR%MP,:) = 0.0_JPRB
  GFL(:,:,YS%MP,:) = 0.0_JPRB

  N1GDI = 1
ENDIF

! Change to just 2 spectral intervals for shortwave radiation

IF (LERADSW2 .AND. NSW > 2) THEN
  LLSWR2=.TRUE.

  ISW=NSW
  NSW=2
  CALL SUSWN   (NTSW, NSW)
  CALL SUCLOPN (NTSW, NSW,NFLEVG)
  CALL SUAERSN (NTSW, NSW)
ENDIF

CALL CAIN(YL_ZVATRA(2))
N1HIS=0
CALL CNT3TL
N1HIS=1
CALL CAININ(YL_ZVATRA(3))

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

!*       2.    LOOP OVER LAMBDA ( PERT. = LAMBDA * BASIC PERT. )
!              -------------------------------------------------

IF(LNHDYN) THEN
  IPST=11
  IPEND=1
ELSE
  IPST=10
  IPEND=0
ENDIF

! Switch-on prognostic cloud scheme

IF (LLPCLD) THEN
  LEPCLD=.TRUE.
  CALL REACT_CLOUD_GFL
ENDIF

! Change back to original number of spectral intervals for sw

IF (LLSWR2) THEN
  NSW=ISW
  CALL SUSWN   (NTSW, NSW)
  CALL SUCLOPN (NTSW, NSW,NFLEVG)
  CALL SUAERSN (NTSW, NSW)
ENDIF

IF (LEPCLD .OR. LENCLD2) THEN
  N1GDI = 1
  CALL SUGRIDU(0)
ENDIF

DO JLAMDA=IPST,IPEND,-1

!*       2.1   COMPUTATION OF ( STATE + PERT )

  YL_ZVATRA(4)%data = YL_ZVATRA(5)%data + YL_ZVATRA(2)%data * 10._JPRB**(-JLAMDA)

!*       2.2   COMPUTATION OF CNT3 ( STATE + PERT )

  CALL CAIN(YL_ZVATRA(4))
  N1HIS=0

  IF (.NOT.LELAM .AND. LPHYLIN .AND. .NOT.((N2DINI == 1) .AND. LL2D)) THEN
    CALL SUGRIDF(1,SPOR,LLSPOR)
  ENDIF 

  CALL CNT3
  N1HIS=1
  CALL CAININ(YL_ZVATRA(6))

!*     2.3   COMPUTATION OF CNT3(STATE+PERT)-CNT3(STATE) /CNT3TL(PERT)

  YL_ZVATRA(7)%data = YL_ZVATRA(6)%data - YL_ZVATRA(1)%data

  DO JJ=1,YL_ZVATRA(3)%nsizel
    IF (YL_ZVATRA(3)%data(JJ) == 0.0_JPRB) THEN
      YL_ZVATRA(8)%data(JJ)=-5555555555._JPRB
    ELSE
      YL_ZVATRA(8)%data(JJ)=YL_ZVATRA(7)%data(JJ)/&
       & (YL_ZVATRA(3)%data(JJ)*10._JPRB**(-JLAMDA))  
    ENDIF
  ENDDO

!*       2.4   PRINT OF THE RESULTS

  DO JJ=1,8
    CALL ALLGATHER_CTLVEC(YL_ZVATRA(JJ), ZVATRA_ND(:,JJ))
  ENDDO

  WRITE(UNIT=NULOUT,FMT='('' TEST OF THE TANGENT LINEAR '')')
  WRITE(UNIT=NULOUT,FMT='('' LAMBDA =  '',I3)') -JLAMDA
  INMAS=YVAZX%NSIZEG/50
  IPARA=NFLSUR*NSPEC2G
  DO JNME=1,YVAZX%NSIZEG,INMAS
    IF(JNME <= NSEFRE) THEN
      WRITE(UNIT=NULOUT,FMT='('' PRES.  I = '',I7,'' RAT = '',&
       & E22.16,2X,&
       & 7(E11.5,1X))')&
       & JNME,ZVATRA_ND(JNME,8),ZVATRA_ND(JNME,7),&
       & ZVATRA_ND(JNME,6),ZVATRA_ND(JNME,5),&
       & ZVATRA_ND(JNME,4),ZVATRA_ND(JNME,3),&
       & ZVATRA_ND(JNME,2),ZVATRA_ND(JNME,1)  
    ELSEIF(JNME <= (IPARA+NSEFRE)) THEN
      WRITE(UNIT=NULOUT,FMT='('' VORT.  I = '',I7,'' RAT = '',&
       & E22.16,2X,&
       & 7(E11.5,1X))')&
       & JNME,ZVATRA_ND(JNME,8),ZVATRA_ND(JNME,7),&
       & ZVATRA_ND(JNME,6),ZVATRA_ND(JNME,5),&
       & ZVATRA_ND(JNME,4),ZVATRA_ND(JNME,3),&
       & ZVATRA_ND(JNME,2),ZVATRA_ND(JNME,1)  
    ELSEIF(JNME <= (2*IPARA+NSEFRE)) THEN
      WRITE(UNIT=NULOUT,FMT='('' DIVE.  I = '',I7,'' RAT = '',&
       & E22.16,2X,&
       & 7(E11.5,1X))')&
       & JNME,ZVATRA_ND(JNME,8),ZVATRA_ND(JNME,7),&
       & ZVATRA_ND(JNME,6),ZVATRA_ND(JNME,5),&
       & ZVATRA_ND(JNME,4),ZVATRA_ND(JNME,3),&
       & ZVATRA_ND(JNME,2),ZVATRA_ND(JNME,1)  
    ELSEIF(JNME <= (3*IPARA+NSEFRE)) THEN
      WRITE(UNIT=NULOUT,FMT='('' TEMP.  I = '',I7,'' RAT = '',&
       & E22.16,2X,&
       & 7(E11.5,1X))')&
       & JNME,ZVATRA_ND(JNME,8),ZVATRA_ND(JNME,7),&
       & ZVATRA_ND(JNME,6),ZVATRA_ND(JNME,5),&
       & ZVATRA_ND(JNME,4),ZVATRA_ND(JNME,3),&
       & ZVATRA_ND(JNME,2),ZVATRA_ND(JNME,1)  
    ELSEIF(JNME <= (4*IPARA+NSEFRE)) THEN
      WRITE(UNIT=NULOUT,FMT='('' HUMI.  I = '',I7,'' RAT = '',&
       & E22.16,2X,&
       & 7(E11.5,1X))')&
       & JNME,ZVATRA_ND(JNME,8),ZVATRA_ND(JNME,7),&
       & ZVATRA_ND(JNME,6),ZVATRA_ND(JNME,5),&
       & ZVATRA_ND(JNME,4),ZVATRA_ND(JNME,3),&
       & ZVATRA_ND(JNME,2),ZVATRA_ND(JNME,1)  
    ELSEIF(JNME <= 5*IPARA+NSEFRE .AND. YO3%LSP) THEN
      WRITE(UNIT=NULOUT,FMT='('' OZONE  I = '',I7,'' RAT = '',&
       & E22.16,2X,&
       & 7(E11.5,1X))')&
       & JNME,ZVATRA_ND(JNME,8),ZVATRA_ND(JNME,7),&
       & ZVATRA_ND(JNME,6),ZVATRA_ND(JNME,5),&
       & ZVATRA_ND(JNME,4),ZVATRA_ND(JNME,3),&
       & ZVATRA_ND(JNME,2),ZVATRA_ND(JNME,1)  
    ELSEIF(JNME <= (5*IPARA+NSEFRE) .AND. LNHDYN) THEN
      WRITE(UNIT=NULOUT,FMT='('' PRES. DEP.  I = '',I7,'' RAT = '',&
       & E22.16,2X,&
       & 7(E11.5,1X))')&
       & JNME,ZVATRA_ND(JNME,8),ZVATRA_ND(JNME,7),&
       & ZVATRA_ND(JNME,6),ZVATRA_ND(JNME,5),&
       & ZVATRA_ND(JNME,4),ZVATRA_ND(JNME,3),&
       & ZVATRA_ND(JNME,2),ZVATRA_ND(JNME,1)  
    ELSEIF(JNME <= (6*IPARA+NSEFRE) .AND. LNHDYN) THEN
      WRITE(UNIT=NULOUT,FMT='('' VERT. DIV.  I = '',I7,'' RAT = '',&
       & E22.16,2X,&
       & 7(E11.5,1X))')&
       & JNME,ZVATRA_ND(JNME,8),ZVATRA_ND(JNME,7),&
       & ZVATRA_ND(JNME,6),ZVATRA_ND(JNME,5),&
       & ZVATRA_ND(JNME,4),ZVATRA_ND(JNME,3),&
       & ZVATRA_ND(JNME,2),ZVATRA_ND(JNME,1)  
    ENDIF
  ENDDO
  IF (LELAM) THEN
    INMAS=YVAZX%NSIZEG-(2*NFLSUR)+1
    IPARA=NFLSUR/5
    DO JNME=INMAS,YVAZX%NSIZEG,IPARA
      IF(JNME <= INMAS+NFLSUR) THEN
        WRITE(UNIT=NULOUT,FMT='('' MEAN WIND U: I = '',I7,'' RAT = '',&
         & E22.16,2X,&
         & 7(E11.5,1X))')&
         & JNME,ZVATRA_ND(JNME,8),ZVATRA_ND(JNME,7),&
         & ZVATRA_ND(JNME,6),ZVATRA_ND(JNME,5),&
         & ZVATRA_ND(JNME,4),ZVATRA_ND(JNME,3),&
         & ZVATRA_ND(JNME,2),ZVATRA_ND(JNME,1)  
      ELSE
        WRITE(UNIT=NULOUT,FMT='('' MEAN WIND V: I = '',I7,'' RAT = '',&
         & E22.16,2X,&
         & 7(E11.5,1X))')&
         & JNME,ZVATRA_ND(JNME,8),ZVATRA_ND(JNME,7),&
         & ZVATRA_ND(JNME,6),ZVATRA_ND(JNME,5),&
         & ZVATRA_ND(JNME,4),ZVATRA_ND(JNME,3),&
         & ZVATRA_ND(JNME,2),ZVATRA_ND(JNME,1)  
      ENDIF
    ENDDO
  ENDIF

ENDDO

IF (ALLOCATED(ZVATRA_ND)) DEALLOCATE(ZVATRA_ND)
DO JJ=1,8
  CALL DEALLOCATE_CTLVEC(YL_ZVATRA(JJ))
ENDDO

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('TESTLI',1,ZHOOK_HANDLE)
END SUBROUTINE TESTLI
