SUBROUTINE CUN3

!**** *CUN3*  - Level 2 control for unstable mode computation

!     Purpose.
!     --------
!           Compute reference trajectory and call the Jacobi-Davidson solver

!**   Interface.
!     ----------
!        *CALL* *CUN3*

!        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
!                  CAININAD - adjoint of inverse Canonical injection
!                  CNT3AD - controls adjoint integration
!                  SULCZ  - Set up the Lanczos variables
!                  NALAN2 - Connection to Jacobi-Davidson algorithm
!                  SIM4D  - gradient of costfunction
!     Reference.
!     ----------
!        ECMWF research department documentation of the
!     "in core model"

!     Author.
!     -------
!        Jan Barkmeijer :  adapted from CUN2 by Roberto Buizza

!     Modifications.
!     --------------
!        Original       : 96-09-23
!        Mike Fisher    : 97-01-31 write vectors for SKF
!        Mike Fisher    : 97-12-03 spectral SCALP for NLANTYPE=5,6,8,9
!        Mike Fisher    : 97-12-05 call cun3 directly from CNT0
!        P.Smolikova    : 02-09-30 interface to SUSPEC for d4 in NH
!        C.Fischer      : 03-10-01 remove call to suellt7
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      10-Jan-2004 CY28R1 Cleaning
!        JJMorcrette    : 04-04-2005 SRTM
!        M.Janiskova   04-Jan-2006 Set cloud related perturbations to zero
!        M.Hamrud      01-May-2006 Generalized IO scheme
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVG
USE YOMSP    , ONLY : SPA3,SPA2,SPA1,SPQ
USE YOMVAR   , ONLY : NSIM4D   ,NDIAG    ,NUPTRA   ,&
 & RDX      ,LTEST    ,LTRREF  
USE YOMCVA   , ONLY : YVAZX     ,YVAZG     ,YSCALP ,YRSCALP
USE YOMCT0   , ONLY : NCONF    ,NSTART   ,NSTOP    ,&
 & LOBS     ,LOBSREF  ,LSIMOB   ,NHISTS   ,&
 & NFRHIS   ,LOBSC1   ,NPROC  
USE YOMCT1   , ONLY : N1POS    ,N1GDI    ,N1SDI    ,LRFILAF  ,N1HIS
USE YOMCT2   , ONLY : NSTAR2   ,NSTOP2   ,NSTP
USE YOMLUN   , ONLY : NULOUT   ,NULUSR4
USE YOMECTAB , ONLY : NTSLOTNO
USE YOEPHY   , ONLY : LEPHYS   ,LECOND   ,LECUMF   ,&
 & LEDCLD   ,LEEVAP   ,LEGWDG   ,LEOZOC  ,LEQNGT   ,&
 & LERADI   ,LERADS   ,LESICE   ,&
 & LESURF   ,LEVDIF   ,LAGPHY  
USE YOPHNC   , ONLY : LETRAJP  ,LERADSW2 ,LENCLD2
USE YOPHLC   , ONLY : LSPHLC
USE YOERAD   , ONLY : NTSW, NSW
USE YOMVRTL  , ONLY : L131TL   ,LOBSTL
USE YOMCOSJO , ONLY : LVARQC
USE YOMLCZ   , ONLY : NITERL   ,NLANTYPE ,NEIGEVO  ,NINNER   ,&
 & NJDSTOP  ,XKAPA    ,LEVOLC   ,LOCNORM ,NOPMSTOP ,YVAZX0    ,YVAZG0,&
 & NRITZREAD, NRITZNUMB, NRITZGBH1, NRITZGBH2
USE YOMJG    , ONLY : LSUBBG
USE YOMCT3   , ONLY : NSTEP
USE YOMSKF   , ONLY : LWRISKF  ,NWRISKF  ,MSKFVEC  ,LTWSKFY  ,LTWSKFZ  ,LSKF&
 & ,YSKFROT  
USE CONTROL_VECTORS_COMM_MOD
USE CONTROL_VECTORS
USE IOSTREAM_MIX , ONLY : SETUP_IOSTREAM,TYPE_IOSTREAM,CLOSE_IOSTREAM
USE GFL_SUBS_MOD ,ONLY  : DEACT_CLOUD_GFL,REACT_CLOUD_GFL
USE YOMGFL   , ONLY : GFL
USE YOM_YGFL , ONLY : YA, YL, YI, YR, YS

IMPLICIT NONE

TYPE(TYPE_IOSTREAM)  :: YL_IOSTR_SVEVO, YL_IOSTR_SVIFS
INTEGER(KIND=JPIM) ::  IOMASTER, IRITZREAD, ISTOP, IWEIG, J, &
 & JEIG, IDUM, IVADIM  

LOGICAL :: LLSKF, &
 & LLEPHYS, LLEVDIF, LLESURF, LLECOND, LLECUMF, LLEEVAP, LLEGWDG, &
 & LLEOZOC, LLEQNGT,  LLERADI, LLERADS, LLESICE,  &
 & LLEDCLD, LLAGPHY  

REAL(KIND=JPRB) :: ZDUMMY, ZF, ZFI, ZGI, ZKAPA, ZPS01, ZPS03, ZRITZ, ZVAZGNO

#include "cain.intfb.h"
#include "cainin.intfb.h"
#include "caininad.intfb.h"
#include "chavar.intfb.h"
#include "chavarad.intfb.h"
#include "chavarin.intfb.h"
#include "cnt2.intfb.h"
#include "cnt3.intfb.h"
#include "cnt3ad.intfb.h"
#include "cnt3tl.intfb.h"
#include "grtest.intfb.h"
#include "lcnorad.intfb.h"
#include "lcnortl.intfb.h"
#include "nalan2.intfb.h"
#include "rdtllcz.intfb.h"
#include "scaas.intfb.h"
#include "sim4d.intfb.h"
#include "su1yom.intfb.h"
#include "su2yom.intfb.h"
#include "suaersn.intfb.h"
#include "suallt.intfb.h"
#include "suallt7.intfb.h"
#include "suclopn.intfb.h"
#include "suobs.intfb.h"
#include "suscal.intfb.h"
#include "suspec.intfb.h"
#include "suswn.intfb.h"
#include "deallt.intfb.h"
#include "wrtllcz.intfb.h"

TYPE(control_vector) :: YL_ZWEIGHTS, YL_ZVEIG
REAL(KIND=JPRB), ALLOCATABLE :: ZVATRA(:), ZSCALP(:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

!*    1. Initializations.
!     -------------------
IF (LHOOK) CALL DR_HOOK('CUN3',0,ZHOOK_HANDLE)
WRITE(NULOUT,*) 'ROUTINE CUN3'
IDUM=-999

!        2.    SIMULATED OBSERVATIONS.
!              -----------------------

IF(LSIMOB)THEN
  WRITE(NULOUT,*) '--- Setup simulated ',&
   & 'spectral observations ------------'  
  CALL SUALLT7
  CALL SUSPEC(SPA3,SPA2,SPA1,KFILE=2)
  LTRREF=.TRUE.
  CALL CNT2
  LTRREF=.FALSE.
ENDIF
!     ------------------------------------------------------------------

!        3.       REAL OBSERVATIONS
!                 -----------------

IF(.NOT.LSIMOB)THEN
  WRITE(NULOUT,*) '--- Setup observations ',&
   & '----------------------------------'  

!       Define time slot
  IF(NCONF == 131.AND.NSTOP == 0)    THEN
    NTSLOTNO=1
  ENDIF
!        Initialise observation processing for Jo cost-function
  IF (LOBS) CALL SUOBS
ENDIF
!     ------------------------------------------------------------------

!        1.1   Initialize level 1 commons.
!              ---------------------------

CALL SU1YOM     ! Calls SUVAZX

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

!        4.       TRAJECTORY FOR LINEARIZATION
!                 ----------------------------

IF(NCONF == 131.AND..NOT.LSIMOB) THEN
  WRITE(NULOUT,*) '--- Setup initial state',&
   & ' ----------------------------------'  
  WRITE(NULOUT,*) '--- for update no.',NUPTRA

  IF (LOBS) THEN
    LOBSREF=.TRUE.
  ELSE
    LOBSREF=.FALSE.
  ENDIF

  LRFILAF=.FALSE.
  N1POS=0
  CALL CNT2
  N1POS=1
  LOBSREF=.FALSE.
ENDIF

CALL PHYSICS_OFF

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

!        6.1 Compute initial cost-function and gradient.

WRITE(NULOUT,*) '--- Initial call to ',&
 & 'simulator ----------------------------'  

!     Variational quality control is not allowed
LVARQC(:,:)=.FALSE.

ZF=0.0_JPRB
NSIM4D=0
N1POS=1
N1SDI=1
N1GDI=1
CALL SIM4D(4,IDUM,YVAZX,ZF,YVAZG,NSIM4D)
ZVAZGNO=0.0_JPRB
ZFI=ZF
CALL SCAAS(IDUM,YVAZG,YVAZG,ZVAZGNO)
ZGI=ZVAZGNO
WRITE(UNIT=NULOUT,FMT='('' INITIAL GRADIENT NORM SQUARED : ''&
 & ,E14.7,'' COST FUNCTION : '',E14.7)')&
 & ZGI,ZFI  

!        6.2   CHECK GRADIENT.

IF(LTEST) THEN
  WRITE(NULOUT,*) '--- Test gradient ','minimization ----------------------'
  NDIAG=0
  N1POS=0
  N1SDI=0
  N1GDI=0
  NSIM4D=0
  CALL GRTEST(SIM4D,SCAAS,YVAZX,RDX,28,NULOUT)
  NSIM4D=1
  NDIAG=1
ENDIF

!     7.1 Setting logicals as used in configuration 601

WRITE(NULOUT,*) 'VARIATIONAL LOGICALS BEFORE CUN3'

WRITE(NULOUT,'('' L131TL='',L1)') L131TL
WRITE(NULOUT,'('' LOBSTL='',L1)') LOBSTL
WRITE(NULOUT,'('' LSIMOB='',L1)') LSIMOB
WRITE(NULOUT,'('' LOBSREF='',L1)') LOBSREF
WRITE(NULOUT,'('' LOBSC1='',L1)') LOBSC1
WRITE(NULOUT,'('' LOBS='',L1)') LOBS

!     setting in 601

L131TL=.FALSE.
LOBSTL=.FALSE.
LSIMOB=.TRUE.
LOBS=.FALSE.

!     7.2 Relevant parameter settings

NCONF=601

NOPMSTOP=NSTOP
NSTOP=NJDSTOP
!j      NITERL=2
!j      NINNER=2 
IWEIG=NEIGEVO
ZKAPA=XKAPA

!     7.3 Initialize YOMCT2

CALL SU2YOM

!     1.2 Allocate extra space for SPA3T/SPA2T and compute 601 SCALP
!         first deallocate SP5A3/SP5A2 and SPA3T/SPA2T

CALL DEALLT
CALL SUALLT

WRITE(NULOUT,*) 'NSTOP,NSTART,NSTP,NSTEP,NSTAR2,NSTOP2 =',&
 & NSTOP,NSTART,NSTP,NSTEP,NSTAR2,NSTOP2  

!      7.4 Trajectory computation

CALL CHAVARIN (YVAZX)

N1HIS=1
CALL PHYSICS_ON

CALL CNT3

CALL PHYSICS_OFF

!     modify switches for healthy TL/AD configuration

IF (LETRAJP.AND.LSPHLC) THEN
  WRITE(NULOUT,*)&
       & ' LINEAR PHYSICS ACTIVATED ',&
       & ' ==> SIMPLIFIED VERTICAL DIFFUSION SET TO FALSE '  
ENDIF

IF (LETRAJP) THEN
  LEPHYS=.TRUE.
  LAGPHY=.TRUE.
  LSPHLC=.FALSE.
        
  IF (LERADSW2 .AND. NSW > 2) THEN
    !       use only 2 spectral intervals for linearized sw
    WRITE(NULOUT,*) 'USING 2 SPEC.INTERVALS FOR LINEARIZED SW'
    NSW=2
    CALL SUSWN   (NTSW, NSW)
    CALL SUCLOPN (NTSW, NSW, NFLEVG)
    CALL SUAERSN (NTSW, NSW)
  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
  ENDIF
ENDIF


!     7.5 resetting logicals to configuration 131

L131TL=.TRUE.
LOBSTL=.TRUE.
LSIMOB=.FALSE.
LOBS=.TRUE.
!     -----------------------------------------------------------------

!*    8. Calculation of the modes that maximize the ratio between the  
!      the SUSCAL (nconf=601) norm and the Hessian norm. 
!     --------------------------------------------------------------------

!*    8.3 Jacobi-Davidson computation of the eigensystem:
!         - define the parameters
!           - IDIM    : problem dimension
!           - NITERL   : maximum number of JD outer iterations
!           - NINNER   : number of JD inner iterations
!           - IWEIG   :  maximum number of wanted eigenvalues
!           - ZKAPA   : accetable precision for an eigenvalue
!           - call routine at level 1 NALAN2

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

REWIND(NULUSR4)
WRITE(NULUSR4,*) 'MITER= ',NITERL,' ','INNER= ',NINNER
WRITE(NULUSR4,*) ZKAPA,NSTOP
WRITE(NULUSR4,*) 'NLANTYPE= ',NLANTYPE

!    create starting vector
!    scalp is related to 601 inner product 

IVADIM=YVAZX%NSIZEG

ALLOCATE(ZVATRA(IVADIM))
IF (LSKF) THEN
  CALL ALLGATHER_CTLVEC(YSKFROT(1), ZVATRA)
ELSE
  DO J=1,SIZE(ZVATRA)
    ZVATRA(J)=(1.0_JPRB+SIN(1.0_JPRB+J))*1.E-2_JPRB
  ENDDO
ENDIF

NCONF=601
CALL SUSCAL

ALLOCATE(ZSCALP(IVADIM))
CALL ALLGATHER_CTLVEC(YSCALP, ZSCALP)
WHERE (ZSCALP(:)== 0.0_JPRB) ZVATRA(:) = 0.
DEALLOCATE(ZSCALP)

! compute gradient YVAZG0 at background YVAZX0
! used in OPM

CALL ALLOCATE_CTLVEC(YVAZX0)
CALL ALLOCATE_CTLVEC(YVAZG0)

NSIM4D=1
NCONF=131
CALL SUSCAL
ISTOP=NSTOP
NSTOP=NOPMSTOP

YVAZX0 = YVAZX
CALL SIM4D(4,IDUM,YVAZX0,ZF,YVAZG0,NSIM4D)

NSTOP=ISTOP
CALL SCAAS(IDUM,YVAZG0,YVAZG0,ZDUMMY)
WRITE(NULOUT,*) 'NORM YVAZG0 IN CUN3=',ZDUMMY

CALL NALAN2 (IVADIM,NITERL,NINNER,IWEIG,ZKAPA,ZVATRA)

DEALLOCATE(ZVATRA)

!* 9.  Test eigenvector and growth rate 
!  ------------------------------------

IF(LEVOLC) THEN
  NCONF=601
  CALL SUSCAL
  CALL ALLOCATE_CTLVEC(YL_ZWEIGHTS)
  YL_ZWEIGHTS = YSCALP
  NCONF=131
  CALL SUSCAL

!     Open files: input svifs where SVs(t=0) have been written by NALAN2
!                 output svevo where to write SVs(t=tend)

  IOMASTER=MIN(1,NPROC)
  CALL SETUP_IOSTREAM(YL_IOSTR_SVIFS,'CIO','svifs',CDMODE='r',KIOMASTER=IOMASTER,LDNOHELP=.TRUE.)
  CALL SETUP_IOSTREAM(YL_IOSTR_SVEVO,'CIO','svevo',CDMODE='w',KIOMASTER=IOMASTER)

  L131TL=.FALSE.
  LOBSTL=.FALSE.
  LOBS  =.FALSE.
  LSIMOB=.TRUE.

! needed for nstar2 & nstop2 & nstp
! and to allocate sp5 again (deallt in sim4d)

  CALL SU2YOM
  WRITE(NULOUT,*) 'NSTOP,NSTART,NSTP,NSTEP,NSTAR2,NSTOP2 =',&
   & NSTOP,NSTART,NSTP,NSTEP,NSTAR2,NSTOP2  

  IRITZREAD=1
  MSKFVEC=1
  CALL ALLOCATE_CTLVEC(YL_ZVEIG)

!    IRITZREAD is reset to NSEC1(44) later

!       ---------------------------------------------------------------
  DO JEIG=1,NEIGEVO
!       ---------------------------------------------------------------
    IF(JEIG <= IRITZREAD) THEN

!     9.2 Read a perturbation

      CALL RDTLLCZ(YL_IOSTR_SVIFS,YL_ZVEIG)

!     - control

!     NSEC1(42) = singular vector number
!     NSEC1(54-55) = they are used to store the ritz numbers (set in
!                    NALAN1). Given RITZ, then:
!                    NSEC1(54)=NINT( LOG10(RITZ)-5 )
!                    NSEC1(55)=NINT( RITZ/( EXP(LOG(10.)*NSEC1(54) )
!                    Thus: RITZ=NSEC1(55)*EXP( LOG(10.)*NSEC1(54) )

      WRITE(NULOUT,'('' >> CVA1: JEIG='',I5)') JEIG
      WRITE(NULOUT,'('' SV number -  NSEC1(42)='',I5)')NRITZNUMB
      WRITE(NULOUT,'('' NSEC1(54)='',I10)') NRITZGBH1
      WRITE(NULOUT,'('' NSEC1(55)='',I10)') NRITZGBH2
      ZRITZ=NRITZGBH2*EXP( LOG(10._JPRB)*NRITZGBH1 )
      WRITE(NULOUT,'('' RITZ     ='',E12.5)') ZRITZ

      IRITZREAD=NRITZREAD

!     3.3 Linear model integration

      ZPS01 = DOT_PRODUCT(YL_ZVEIG,YL_ZVEIG,YL_ZWEIGHTS)

      CALL CAIN (YL_ZVEIG)
!JAN            NSIM4D=NSIM4DL

!     9.3.1 TL integration

      IF (LWRISKF) THEN
        N1HIS=1
        NFRHIS = 1
        NHISTS(0) = 1
        NHISTS(1) = NWRISKF
      ELSE
        N1HIS=0
      ENDIF

      LTWSKFY=.TRUE.
      NCONF=601
      CALL CNT3TL
      NCONF=131
      LTWSKFY=.FALSE.

!     9.3.2 Output the final state in unit IEV98

      CALL CAININ  (YVAZG)

      CALL WRTLLCZ(YL_IOSTR_SVEVO,YVAZG)

      ZPS03 = DOT_PRODUCT(YVAZG,YVAZG,YL_ZWEIGHTS)

      WRITE(NULOUT,'('' Growth rate test '')')
      WRITE(NULOUT,'('' <x;M*x>       = '',E26.20)') ZPS01
      WRITE(NULOUT,'('' <TL*x;M*TL*x> = '',E26.20)') ZPS03
      WRITE(NULUSR4,'('' Growth rate test '')')
      WRITE(NULUSR4,'('' <x;M*x>       = '',E26.20)') ZPS01
      WRITE(NULUSR4,'('' <TL*x;M*TL*x> = '',E26.20)') ZPS03

!      9.3.4 Adjoint integration for Simplified Kalman Filter vectors

      IF (LWRISKF) THEN
        IF(LOCNORM) CALL LCNORTL

        IF(NLANTYPE == 8.OR. NLANTYPE == 9) THEN
          LSUBBG=.FALSE.
          LLSKF=LSKF
          LSKF=.FALSE.
          SPQ(:,:) = 0.0_JPRB
          CALL CHAVAR   (YVAZG)
          CALL CHAVARAD (YVAZG)
          SPQ(:,:) = 0.0_JPRB
          LSUBBG=.TRUE.
          LSKF=LLSKF
        ELSE
          CALL CAININ (YVAZX)
          YVAZG%data = YVAZX%data * YL_ZWEIGHTS%data * YRSCALP%data 
          CALL CAININAD (YVAZG)
        ENDIF

        IF (LOCNORM) CALL LCNORAD
        N1HIS=1
        NFRHIS = 1
        NHISTS(0) = 1
        NHISTS(1) = NWRISKF
        LTWSKFZ=.TRUE.
        NCONF=601
        CALL CNT3AD
        NCONF=131
        LTWSKFZ=.FALSE.
      ENDIF

      MSKFVEC=MSKFVEC+1
    ENDIF
!       --------------------------------------------------------------
  ENDDO
!       --------------------------------------------------------------
  CALL DEALLOCATE_CTLVEC(YL_ZWEIGHTS)
  CALL DEALLOCATE_CTLVEC(YL_ZVEIG)
ENDIF
!     -----------------------------------------------------------------

!     Close files svifs and svevo

CALL CLOSE_IOSTREAM(YL_IOSTR_SVIFS)
CALL CLOSE_IOSTREAM(YL_IOSTR_SVEVO)

CALL DEALLOCATE_CTLVEC(YVAZX0)
CALL DEALLOCATE_CTLVEC(YVAZG0)
!     -----------------------------------------------------------------

WRITE(NULOUT,*) 'END OF JACOBI-DAVIDSON'
IF (LHOOK) CALL DR_HOOK('CUN3',1,ZHOOK_HANDLE)

CONTAINS
SUBROUTINE PHYSICS_OFF
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('CUN3:PHYSICS_OFF',0,ZHOOK_HANDLE)
LLEPHYS=LEPHYS ; LEPHYS=.FALSE.
LLEVDIF=LEVDIF ; LEVDIF=.FALSE.
LLESURF=LESURF ; LESURF=.FALSE.
LLECOND=LECOND ; LECOND=.FALSE.
LLECUMF=LECUMF ; LECUMF=.FALSE.
LLEEVAP=LEEVAP ; LEEVAP=.FALSE.
LLEGWDG=LEGWDG ; LEGWDG=.FALSE.
LLEOZOC=LEOZOC ; LEOZOC=.FALSE.
LLEQNGT=LEQNGT ; LEQNGT=.FALSE.
LLERADI=LERADI ; LERADI=.FALSE.
LLERADS=LERADS ; LERADS=.FALSE.
LLESICE=LESICE ; LESICE=.FALSE.
LLEDCLD=LEDCLD ; LEDCLD=.FALSE.
LLAGPHY=LAGPHY ; LAGPHY=.FALSE.
CALL DEACT_CLOUD_GFL
IF (LHOOK) CALL DR_HOOK('CUN3:PHYSICS_OFF',1,ZHOOK_HANDLE)
END SUBROUTINE PHYSICS_OFF

SUBROUTINE PHYSICS_ON
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK('CUN3:PHYSICS_ON',0,ZHOOK_HANDLE)
LEPHYS=LLEPHYS
LEVDIF=LLEVDIF
LESURF=LLESURF
LECOND=LLECOND
LECUMF=LLECUMF
LEEVAP=LLEEVAP
LEGWDG=LLEGWDG
LEOZOC=LLEOZOC
LEQNGT=LLEQNGT
LERADI=LLERADI
LERADS=LLERADS
LESICE=LLESICE
LEDCLD=LLEDCLD
LAGPHY=LLAGPHY
CALL REACT_CLOUD_GFL
IF (LHOOK) CALL DR_HOOK('CUN3:PHYSICS_ON',1,ZHOOK_HANDLE)
END SUBROUTINE PHYSICS_ON
END SUBROUTINE CUN3
!     -----------------------------------------------------------------

