SUBROUTINE SUALCTV

!**** *SUALCTV* - ROUTINE TO ALLOCATE SPACE FOR CONTROL VARIABLE
!                 AND INITIALISE IT.

!     Purpose.
!     --------
!           Initialize what is the control variable and allocate
!        space for arrays depending on the size of the control variable.

!**   Interface.
!     ----------
!        *CALL* *SUALCTV

!        Explicit arguments : None
!        --------------------

!        Implicit arguments :
!        --------------------
!        COMMON YOMCVA

!     Method.
!     -------
!        See documentation

!     Externals.    ALLOCA of the Memory Manager
!     ----------

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

!     Author.
!     -------
!        D. VASILJEVIC AND J. PAILLEUX  *ECMWF*

!     Modifications.
!     --------------
!        Original  90-06-20
!     D.Vasiljevic 90-11-20
!     P.Gauthier   91-01-25 : Allocation for Kalman filter
!     W.Heckley    91-02-20
!     W.Heckley    91-10-10
!     F.Bouttier   92-09-29 : Kalman cleanup
!     L.Labbe      93-04-13 : Orography as control variable
!     R.EL Khatib  93-04-02 : Set-up defaults controled by LECMWF
!     L.Isaksen    95-06-06 : Reordering of spectral arrays
!     F.Bouttier   96-01-15 : Remove VATRA from variational jobs
!     L.Isaksen    96-02-20 : Message Passing option added
!     E.Andersson  96-08-01 : Precalculated SQRT(SCALP)
!     M.Hamrud     97-10-12 : Changed NVA3D to not depend on level
!     M.Siroka     97-11-02 : Folloving PLM - mods for LELAM
!     M.Hamrud     98-01-10 : YVAZX etc. distributed vectors
!     E.Andersson  98-07-03 : TOVS control variable
!     M.Siroka     98-12-09 : mean wind is not a control variable in LELAM 131
!     R. El Khatib 01-08-07 : Pruning options
!     F.Taillefer  02-11-01 : return if CANARI
!     Y.Tremolet   02-08-14 : Use control_vectors.
!     C. Fischer   03-04-01 : Update Setup_ctlvec for aladin
!     M.Hamrud     01-Oct-2003 CY28 Cleaning
!     M.Hamrud     01-Dec-2003 CY28R1 Cleaning
!     M.Fisher     17-Mar-2004 Wavelet Jb
!     Y.Tremolet   27-Jul-2004 Control vector changes
!     L.Auger      01-Nov-2004 Ts control vector slice
!     C. Fischer   21-May-2005 nva1d=2 in Aladin 3dvar (the tiny start of a huge revolution)
!     A. Deckmyn   01-Oct-2008 LAM-wavelet-Jb
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMDIM   , ONLY : NFLEVL, NFLEVG, NSMAX  ,NMSMAX, NPROMA
USE YOMCT0   , ONLY : NPRINTLEV,LCANARI  ,LALLOPR  ,LELAM    , &
 & NPROC ,N_REGIONS ,N_REGIONS_NS ,N_REGIONS_EW,NPRTRW
USE YOMDIMO  , ONLY : NOBTOTG  ,NOBTOT, NOBNTV, NOBNTVG, NOBNTVBP
USE YOMGLOBS , ONLY : NOBTOTP
USE YOMLUN   , ONLY : NULOUT
USE YOMCVA   , ONLY : NVATOV   ,NVATOVV, NVAPARAM, &
 & NVA3D   ,NVA2D    ,NVA1D    ,YVAZX    ,YVAZG, YVAZ0, &
 & YSCALP, YRSCALP, YSCALPSQRT, YRSCALPSQRT, NGRBVAR
USE YOMWAVELET,ONLY : LJBWAVELET, N_WAVELET_SCALES, GRID_DEFINITION
USE YOMVAR   , ONLY : LTOVSCV, LINITCV, LCO2, LCLDSINK, LTSCV,LREPRO4DVAR
USE YOMTVRAD , ONLY : TOVSCVBG ,TOVSCVER ,TOVSCVX  ,TOVSCVX5 ,&
 & NVATOVOFF,NVATOVLENP,NVATOVLEN,NVATOVLENG
USE YOMANCS  , ONLY : RMDI
USE YOMMP    , ONLY : MYPROC, MYLEVS, MY_REGION_NS, MY_REGION_EW,MYSETW
USE YOMGEM   , ONLY : NGPTOTL
USE YOMMODEL_ERROR, ONLY: NSERR, NDIM_MODERR, NVE3D, NVE2D, NGRBMERRCTL
USE CONTROL_VECTORS, ONLY : SETUP_CTLVEC, ALLOCATE_CTLVEC
USE YOMTS    , ONLY : TSCVX    ,TSCVX5, NVATSOFF, TSCVBG, TSCVER
USE YEMWAVELET, ONLY: NWAVDIMX ,NWAVDIMY ,NWAVLATS
IMPLICIT NONE

LOGICAL :: LLP
INTEGER(KIND=JPIM) :: J,JSCALE,insp1,ivatsoff
INTEGER(KIND=JPIM), ALLOCATABLE :: IGPTOTL(:,:,:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

IF (LHOOK) CALL DR_HOOK('SUALCTV',0,ZHOOK_HANDLE)
LLP = NPRINTLEV >= 1.OR. LALLOPR
IF (LLP) WRITE(NULOUT,'('' SUALCTV PRINTOUTS '')')

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

!*       2.    Set default values.
!              -------------------

!        2.1 Set implicit default values

!     TOVS control variable.
IF(LTOVSCV) THEN
  NVATOVV=1
  IF(LCO2) NVATOVV=3
  IF(LCLDSINK) NVATOVV=3
  NVATOVLEN=NOBTOT
  NVATOVLENG=NOBTOTG
ELSE
  NVATOVV=0
  NVATOVLEN=0
  NVATOVLENG=0
ENDIF

NVATOV=NVATOVV*NVATOVLENG

NOT_CANARI : IF (.NOT. LCANARI) THEN

  IF(LTOVSCV) THEN
    ALLOCATE(TOVSCVBG(NVATOVLEN,NVATOVV))
    ALLOCATE(TOVSCVER(NVATOVLEN,NVATOVV))
    ALLOCATE(TOVSCVX(NVATOVLEN,NVATOVV))
    ALLOCATE(TOVSCVX5(NVATOVLEN,NVATOVV))
    ALLOCATE(NVATOVOFF(NPROC))
    ALLOCATE(NVATOVLENP(NPROC))

    NVATOVOFF(1)=0
    DO J=2,NPROC
      NVATOVOFF(J)=NVATOVOFF(J-1)+NOBTOTP(J-1)
    ENDDO
    NVATOVLENP(:)=NOBTOTP(:)
    TOVSCVBG(:,:)=RMDI
    TOVSCVER(:,:)=RMDI

    IF(LLP)WRITE(NULOUT,999) 'TOVSCVBG',SIZE(TOVSCVBG),SHAPE(TOVSCVBG)
    IF(LLP)WRITE(NULOUT,999) 'TOVSCVER',SIZE(TOVSCVER),SHAPE(TOVSCVER)
    IF(LLP)WRITE(NULOUT,999) 'TOVSCVX ',SIZE(TOVSCVX) ,SHAPE(TOVSCVX)
    IF(LLP)WRITE(NULOUT,999) 'TOVSCVX5',SIZE(TOVSCVX5),SHAPE(TOVSCVX5)
    IF(LLP)WRITE(NULOUT,999) 'NVATOVOFF',SIZE(NVATOVOFF),SHAPE(NVATOVOFF)
  ELSE
    ALLOCATE(NVATOVLENP(1))
    ALLOCATE(NVATOVOFF(1))
  ENDIF

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

! TS Control variable

  IF (LTSCV) THEN
    CALL FLUSH(NULOUT)
    ALLOCATE(TSCVBG(NOBNTVG))
    ALLOCATE(TSCVX(NOBNTVG))
    ALLOCATE(TSCVX5(NOBNTVG))
    ALLOCATE(NVATSOFF(NPROC))
    IF(LLP)WRITE(NULOUT,999) 'TSCVX',SIZE(TSCVX) ,SHAPE(TSCVX)
    IF(LLP)WRITE(NULOUT,999) 'TSCVX5',SIZE(TSCVX5) ,SHAPE(TSCVX5)
    IF(LLP)WRITE(NULOUT,999) 'NVATSOFF',SIZE(NVATSOFF),SHAPE(NVATSOFF)
    NVATSOFF(1)=0
    DO J=2,NPROC
      NVATSOFF(J)=NVATSOFF(J-1)+NOBNTVBP(J-1)
    ENDDO
    TSCVBG(:)=RMDI
    TSCVER=RMDI
  ENDIF

!  Setup defaults for control vector type

  IF (LTSCV) THEN
   ivatsoff=nvatsoff(myproc)
  ELSE
   ivatsoff=0
  ENDIF

  
  IF (LJBWAVELET) THEN
    IF (LELAM) THEN
! in LAM wavelets, we don't actually use GRID_DEFINITION
! but we use it to pass some data to setup_ctlvec
      insp1=2
      ALLOCATE (IGPTOTL(insp1,N_REGIONS_NS,N_REGIONS_EW))
      IGPTOTL(1,:,:) = NGPTOTL(:,:)
      IGPTOTL(2,:,:) = NGPTOTL(:,:)
      ALLOCATE (GRID_DEFINITION(insp1))
      GRID_DEFINITION(:)%NBLOCKSL=(/ NWAVLATS,NWAVDIMY /)
      GRID_DEFINITION(:)%NBLOCKSG=(/ NWAVDIMX,NWAVDIMY /)
      GRID_DEFINITION(:)%NGPTOTG =(/ 1,2 /)
    ELSE
      insp1 = N_WAVELET_SCALES+1
      ALLOCATE (IGPTOTL(N_WAVELET_SCALES+1,N_REGIONS_NS,N_REGIONS_EW))

      DO JSCALE=1,N_WAVELET_SCALES+1
        IGPTOTL(JSCALE,:,:) = GRID_DEFINITION(JSCALE)%NGPTOTL(:,:)
      ENDDO
    ENDIF
  ELSE
    insp1 = 1
    ALLOCATE (IGPTOTL(1,N_REGIONS_NS,N_REGIONS_EW))
    IGPTOTL(1,:,:) = NGPTOTL(:,:)

!   Allocate GRID_DEFINITION anyhow, because some compilers don't like dummy
!   arguments which are entities without any adress - Ryad El Khatib.
    ALLOCATE (GRID_DEFINITION(insp1))
  ENDIF

  CALL SETUP_CTLVEC(NVA3D,NVA2D,NVA1D,NGRBVAR,LINITCV,nsmax,nmsmax, &
   & NDIM_MODERR,nve3d,nve2d,nserr,NGRBMERRCTL,nvaparam,lelam,&
   & LJBWAVELET,ltovscv,nvatovlen,nvatovleng,&
   & nvatovlenp,nvatovv,nvatovoff, &
   & NPROMA,nflevl,nflevg,mylevs, insp1, &
   & GRID_DEFINITION(:)%NBLOCKSL,GRID_DEFINITION(:)%NBLOCKSG, &
   & IGPTOTL,GRID_DEFINITION%NGPTOTG, &
   & N_REGIONS,N_REGIONS_NS,N_REGIONS_EW,&
   & MY_REGION_NS,MY_REGION_EW,NPROC,MYPROC, &
   & NOBNTV,NOBNTVG,LTSCV,ivatsoff,LREPRO4DVAR,MYSETW,NPRTRW)

  DEALLOCATE (IGPTOTL)

  IF (LELAM .OR. .NOT.LJBWAVELET) THEN
    DEALLOCATE(GRID_DEFINITION)
  ENDIF

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

!*       3.    Allocate space.
!              ---------------

  CALL ALLOCATE_CTLVEC(YVAZX)
  WRITE(NULOUT,999)'YVAZX      ',YVAZX%nsizel

  CALL ALLOCATE_CTLVEC(YVAZG)
  WRITE(NULOUT,999)'YVAZG      ',YVAZG%nsizel

  CALL ALLOCATE_CTLVEC(YVAZ0)
  WRITE(NULOUT,999)'YVAZ0      ',YVAZ0%nsizel

  CALL ALLOCATE_CTLVEC(YSCALP)
  WRITE(NULOUT,999)'YSCALP  ',YSCALP%nsizel

  CALL ALLOCATE_CTLVEC(YRSCALP)
  WRITE(NULOUT,999)'YRSCALP ',YRSCALP%nsizel

  CALL ALLOCATE_CTLVEC(YSCALPSQRT)
  WRITE(NULOUT,999)'SCALPSQRT_',YSCALPSQRT%nsizel

  CALL ALLOCATE_CTLVEC(YRSCALPSQRT)
  WRITE(NULOUT,999)'RSCALPSQRT',YRSCALPSQRT%nsizel

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

!*       4.    PRINTS.
!              -------

  WRITE(UNIT=NULOUT,FMT='('' DEFINITION OF THE CONTROL VARIABLE'')')
  IF (LELAM) THEN
    WRITE(UNIT=NULOUT,FMT='('' LAM 1D, NVA1D= '',I3)') NVA1D
  ENDIF
  WRITE(UNIT=NULOUT,FMT='('' LTOVSCV='',L2,'' NVATOVV='',I6,'' NVATOV='',I6)')&
   & LTOVSCV,NVATOVV,NVATOV  
  WRITE(NULOUT,*)'TOTAL SIZE OF CONTROL VARIABLE=',YVAZX%NSIZEG

ENDIF NOT_CANARI

!      -----------------------------------------------------------------
999 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)

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