SUBROUTINE SUALGES

!      SUALGES - Allocate arrays used in computation of first guess constraint.

!     Purpose: Allocate background-related arrays for Jb and for Canari OI.
!     -------

!     Interface: called from SU0YOMB
!     ---------

!     Author: BILL HECKLEY 90-07-04
!     ------

!     Modifications:
!     -------------
!     PATRICK MOLL  LE 28/01/91
!     BILL HECKLEY      3/06/91  - VERTICAL CORRELATIONS
!     BILL HECKLEY     19/02/92  - Introduce mass field P and
!                                  eigenvectors of vertical correlations
!     BILL HECKLEY     17/03/93  - Arrays for defining error correlations
!     Erik Andersson   06/07/93  - Non-separable structure functions
!     L Isaksen        05/05/96  - Adapted for Message Passing
!     John Derber      96/07/05  - implement statistical balance arrays
!     John Derber      96/08/27  - implement (T,ps) covariances
!     Elias Holm       97/10/29  - include ozone
!     F. Taillefer     97/10/09  - add 1D-hor array for sigma guess in CANARI
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      01-Dec-2003 CY28R1 Cleaning
!        M.Fisher      17-Mar-2004 Wavelet Jb
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPRB, JPIM
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMGEM   , ONLY : NGPTOT
USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : NCONF    ,LCANARI  ,LSIMOB   ,LSPBSBAL
USE YOMDIM   , ONLY : NFLEVG   ,NSMAX    ,NSPEC2   ,NCMAX
USE YOMJG    , ONLY :   L_JBVCOORD ,FGSCNM3D ,FGSCNM2D , VCORS, &
 & FCEMN3D, FCEMN2D, FCEMN_DERIVED    ,FCEIMN   ,FGMWNE   ,STPS     ,&
 & SDIV     ,SO3      ,BFACT1   ,BFACT2   ,NOFCEF  ,SPJB_VARS_INFO, &
 & N_SPJB_VARS
USE YOMFCEB  , ONLY : FCEBUF   ,GPBUF_JBVCOORD  
USE QASSET   , ONLY : ESIG
USE GRIDPOINT_BUFFERS_MIX , ONLY : ALLOCATE_GRIDPOINT_BUFFER
USE YOMWAVELET, ONLY: LJBWAVELET
USE YOMGRB , ONLY : NGRBLNSP, NGRBT, NGRBO3
USE YOMCVA   , ONLY : NVA3D, NVA2D

IMPLICIT NONE

REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER(KIND=JPIM) :: JFIELD
!     ------------------------------------------------------------------
!     1. Allocate arrays for variational background constraint Jb
!        --------------------------------------------------------

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

IF( (ABS(NCONF)/100 == 1.AND..NOT.LSIMOB).OR.NCONF/100 == 6&
   & .OR.NCONF/100 == 8 )  THEN  

!         1.1 Inverse of diagonal horizontal correlation spectrum

  ALLOCATE (FGSCNM3D(NFLEVG,0:NCMAX,NVA3D))
  WRITE(NULOUT,9990) 'FGSCNM%VOR',SIZE(FGSCNM3D),SHAPE(FGSCNM3D)

  ALLOCATE (FGSCNM2D(0:NCMAX,NVA2D))
  WRITE(NULOUT,9990) 'FGSCNM%VOR',SIZE(FGSCNM2D),SHAPE(FGSCNM2D)

!         1.2 Inverse square root of non-separable vertical error correls
!             Vorticity, unbalanced mass, divergence, specific humidity.

  IF (.NOT.LJBWAVELET) THEN
    ALLOCATE(VCORS(N_SPJB_VARS))

    DO JFIELD=1,N_SPJB_VARS
      IF (SPJB_VARS_INFO(JFIELD)%L_IN_SPA2) THEN
        IF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE==NGRBLNSP) THEN
!--- (T,ps) are a special case
          ALLOCATE (VCORS(JFIELD)%EVALS(0,0:NSMAX))
          ALLOCATE (VCORS(JFIELD)%EVECS(0,0,0:NSMAX))
        ELSE
          ALLOCATE (VCORS(JFIELD)%EVALS(1,0:NSMAX))
          ALLOCATE (VCORS(JFIELD)%EVECS(1,1,0:NSMAX))
        ENDIF
      ELSE
        IF (SPJB_VARS_INFO(JFIELD)%IGRIBCODE==NGRBT) THEN
!--- (T,ps) are a special case
          ALLOCATE (VCORS(JFIELD)%EVALS(NFLEVG+1,0:NSMAX))
          ALLOCATE (VCORS(JFIELD)%EVECS(NFLEVG+1,NFLEVG+1,0:NSMAX))
        ELSE
          ALLOCATE (VCORS(JFIELD)%EVALS(NFLEVG,0:NSMAX))
          ALLOCATE (VCORS(JFIELD)%EVECS(NFLEVG,NFLEVG,0:NSMAX))
        ENDIF
      ENDIF

      WRITE(NULOUT,9991) 'VCORS(JFIELD)%EVALS',JFIELD, &
                        & SIZE(VCORS(JFIELD)%EVALS),SHAPE(VCORS(JFIELD)%EVALS)
      WRITE(NULOUT,9991) 'VCORS(JFIELD)%EVECS',JFIELD, &
                        & SIZE(VCORS(JFIELD)%EVECS),SHAPE(VCORS(JFIELD)%EVECS)
    ENDDO
  ENDIF

!         1.3 Definition of the standard errors

  ALLOCATE(FCEMN3D(NFLEVG,NVA3D))
  WRITE(NULOUT,9990) 'FCEMN3D  ',SIZE(FCEMN3D),SHAPE(FCEMN3D)

  ALLOCATE(FCEMN2D(NVA2D))
  WRITE(NULOUT,9990) 'FCEMN2D  ',SIZE(FCEMN2D),SHAPE(FCEMN2D)

  ALLOCATE(FCEMN_DERIVED%U(NFLEVG))
  ALLOCATE(FCEMN_DERIVED%Z(NFLEVG))
  ALLOCATE(FCEMN_DERIVED%T(NFLEVG))

  ALLOCATE(FCEIMN(NOFCEF))
  WRITE(NULOUT,9990) 'FCEIMN   ',SIZE(FCEIMN),SHAPE(FCEIMN)

  CALL ALLOCATE_GRIDPOINT_BUFFER ('FCEBUF',FCEBUF,NOFCEF,1)

!         Jb vertical levels

  IF (L_JBVCOORD) THEN
    CALL ALLOCATE_GRIDPOINT_BUFFER ('GPBUF_JBVCOORD',GPBUF_JBVCOORD,2*NFLEVG,1)
  ENDIF

  ALLOCATE(FGMWNE(NGPTOT))
  WRITE(NULOUT,9990) 'FGMWNE   ',SIZE(FGMWNE),SHAPE(FGMWNE)
ENDIF

IF( (ABS(NCONF)/100 == 1.AND..NOT.LSIMOB).OR.NCONF/100 == 6&
   & .OR.NCONF/100 == 8 .OR. LSPBSBAL)  THEN  

!         1.4 Definition of the balance constraint

  ALLOCATE(STPS(NFLEVG+1,2*NFLEVG,0:NSMAX))
  ALLOCATE(SDIV(NFLEVG,NFLEVG,0:NSMAX))
  WRITE(NULOUT,9990) 'STPS     ',SIZE(STPS)  ,SHAPE(STPS)
  WRITE(NULOUT,9990) 'SDIV     ',SIZE(SDIV)  ,SHAPE(SDIV)
  IF (ANY(SPJB_VARS_INFO(:)%IGRIBCODE==NGRBO3)) THEN
    ALLOCATE(SO3(NFLEVG,NFLEVG,0:NSMAX))
    WRITE(NULOUT,9990) 'SO3      ',SIZE(SO3)   ,SHAPE(SO3)
  ENDIF
  ALLOCATE(BFACT1(NSPEC2))
  ALLOCATE(BFACT2(NSPEC2))
  WRITE(NULOUT,9990) 'BFACT1   ',SIZE(BFACT1),SHAPE(BFACT1)
  WRITE(NULOUT,9990) 'BFACT2   ',SIZE(BFACT2),SHAPE(BFACT2)

ELSE

  NULLIFY(FCEBUF%GPBUF)
  NULLIFY(GPBUF_JBVCOORD%GPBUF)
  NULLIFY(FCEMN_DERIVED%U)
  NULLIFY(FCEMN_DERIVED%Z)
  NULLIFY(FCEMN_DERIVED%T)
  NULLIFY(FCEMN_DERIVED%O3)

ENDIF

!     ------------------------------------------------------------------
!     2. Allocate arrays for background in French OI Canari
!        --------------------------------------------------

IF ( LCANARI ) THEN
  ALLOCATE(ESIG (NFLEVG*2+5,NGPTOT))
  WRITE(NULOUT,9990) 'ESIG     ',SIZE(ESIG),SHAPE(ESIG)
ELSE
  ALLOCATE(ESIG(1,NGPTOT))
  WRITE(NULOUT,9990) 'ESIG     ',SIZE(ESIG),SHAPE(ESIG)
ENDIF

!     ------------------------------------------------------------------
9990 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
9991 FORMAT(1X,'ARRAY ',A19,' JFIELD=',I3,' ALLOCATED ',8I8)
!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('SUALGES',1,ZHOOK_HANDLE)
END SUBROUTINE SUALGES
