SUBROUTINE SUALSPA

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMCT0   , ONLY : LNHDYN   ,NPRINTLEV,LALLOPR  ,LELAM
USE YOMDIM   , ONLY : NFTHER   ,NFLSUR   ,NSPEC2   ,&
 & NS3D     ,LSPT    ,NFLEVL  
USE YOMSP    , ONLY : SPA3     ,SPVOR    ,SPDIV    ,SPHV     ,&
 & SPT      ,SPQ      ,SPO3     ,SPL      ,SPI      ,&
 & SPA1     ,SPUB     ,SPVB     ,&
 & SPSPD    ,SPSVD    ,SPNHX    ,SPGFL  
USE YOMLUN   , ONLY : NULOUT
USE YOMDYNA  , ONLY : LNHX
USE YOM_YGFL , ONLY : YGFL, YQ, YL, YI, YO3
USE YOMGRB, ONLY: NGRBVO, NGRBD, NGRBT, NGRBQ, NGRBO3, &
                & NGRBCLWC, NGRBCIWC, NGRB118, NGRB119, NGRBSP3
USE YOMSP_PTRS, ONLY : MSPTR_VOR, MSPTR_DIV, MSPTR_T, MSPTR_SPD,&
 & MSPTR_SVD ,MSPTR_GFL, MSPTR_UB, MSPTR_VB

!**** *SUALSPA * - Routine to allocate space for SPA3

!     Purpose.
!     --------
!           Allocate space for SPA3

!**   Interface.
!     ----------
!        *CALL* *SUALSPA*

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

!     Implicit arguments :
!     --------------------

!     Method.
!     -------
!     Externals.
!     ----------

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

!     Author.
!     -------
!        Mats Hamrud and Philippe Courtier  *ECMWF*

!     Modifications.
!     --------------
!        Original : 87-10-26
!        Ryad El Khatib- 94/11/10 Non-hydrostatic variables
!        L.Isaksen  95-06-06 Reordering of spectral arrays
!        L.Isaksen  96-02-20 Adapted for Message Passing
!     R. El Khatib  98-04-23 make the pointers point somewhere in any case for safety
!        E.Holm     97-11-18 Ozone included
!     R. El Khatib  01-08-20 make Ozone pointer point somewhere in any case for safety
!        P.Smolikova 02-09-30 SPA3AUX allocation for d4 in NH
!        M.Hamrud   03-08-01 GFL introduction
!        C.Fischer  03-09-30 Aladin mean wind profiles spa1
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        G.Radnoti  04-03-19 nflevg becomes nflevl for Aladin B-level
!        R.Brozkova 05-07-17 "X" part of div.: SPNHX to NFTHER (prev. SPVDAUX)
!     ------------------------------------------------------------------

IMPLICIT NONE

INTEGER(KIND=JPIM) :: IPT, JF,JN,JV,IOFF

LOGICAL :: LLP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

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

LLP = NPRINTLEV >= 1.OR. LALLOPR

! * SPA3:
IF (.NOT.ALLOCATED(SPA3)) ALLOCATE(SPA3(NFLSUR,NSPEC2,NS3D))
CALL GSTATS(1217,0)
!$OMP PARALLEL DO SCHEDULE(STATIC) PRIVATE(JF,JN,JV)
DO JN=1,NSPEC2
  DO JV=1,NS3D
    DO JF=1,NFLSUR
      SPA3(JF,JN,JV)=0.0_JPRB
    ENDDO
  ENDDO
ENDDO
!$OMP END PARALLEL DO
CALL GSTATS(1217,1)
IF(LLP) THEN
  WRITE(NULOUT,9990) 'SPA3     ',SIZE(SPA3     ),SHAPE(SPA3     )
ENDIF

! * Individual GMV SP(X), and SPHV:
IF (.NOT.ALLOCATED(NGRBSP3)) ALLOCATE(NGRBSP3(NS3D))
IF (NS3D >= 1) THEN
  MSPTR_VOR = 1
  SPVOR => SPA3(1:NFLSUR,1:NSPEC2,MSPTR_VOR)
  NGRBSP3(MSPTR_VOR)=NGRBVO
ENDIF
IF (NS3D >= 2) THEN
  MSPTR_DIV = 2
  SPDIV => SPA3(1:NFLSUR,1:NSPEC2,MSPTR_DIV)
  NGRBSP3(MSPTR_DIV)=NGRBD
ENDIF
IF(NFTHER > 0) THEN
  SPHV => SPA3(1:NFLSUR,1:NSPEC2,3:2+NFTHER)
ELSE
  SPHV => SPA3(1:1,1:1,1:1)
ENDIF
IPT = 3
IF(LSPT) THEN
  SPT => SPA3(1:NFLSUR,1:NSPEC2,IPT)
  MSPTR_T = IPT
  NGRBSP3(IPT)=NGRBT
  IPT = IPT+1
ELSE
  SPT => SPA3(1:1,1:1,1)
  MSPTR_T = 1
ENDIF
IF(LNHDYN) THEN
  SPSPD => SPA3(1:NFLSUR,1:NSPEC2,IPT)
  MSPTR_SPD = IPT
  NGRBSP3(IPT)=NGRB118 ! Temporary until proper grib code assigned
  IPT=IPT+1
  SPSVD => SPA3(1:NFLSUR,1:NSPEC2,IPT)
  MSPTR_SVD = IPT
  NGRBSP3(IPT)=NGRB119 ! Temporary until proper grib code assigned
  IPT=IPT+1
  IF(LNHX) THEN
    SPNHX => SPA3(1:NFLSUR,1:NSPEC2,IPT)
    NGRBSP3(IPT)=-99 ! There is no grib code.
    IPT=IPT+1
  ELSE
    SPNHX => SPA3(1:1,1:1,1)
  ENDIF
ELSE
  SPSPD => SPA3(1:1,1:1,1)
  SPSVD => SPA3(1:1,1:1,1)
  MSPTR_SPD = 1
  MSPTR_SVD = 1
  SPNHX => SPA3(1:1,1:1,1)
ENDIF

! * SPGFL and individual GFL SP(X).
IOFF=2+NFTHER
IF(YGFL%NUMSPFLDS > 0) THEN
  SPGFL => SPA3(1:NFLSUR,1:NSPEC2,IOFF+1:IOFF+YGFL%NUMSPFLDS)
  MSPTR_GFL = IOFF+1
ELSE
  SPGFL => SPA3(1:1,1:1,1:1)
  MSPTR_GFL = 1
ENDIF
IF(YQ%LSP) THEN
  SPQ => SPA3(1:NFLSUR,1:NSPEC2,IOFF+YQ%MPSP)
  NGRBSP3(IOFF+YQ%MPSP)=NGRBQ
ELSE
  SPQ => SPA3(1:1,1:1,1)
ENDIF
IF(YO3%LSP) THEN
  SPO3 => SPA3(1:NFLSUR,1:NSPEC2,IOFF+YO3%MPSP)
  NGRBSP3(IOFF+YO3%MPSP)=NGRBO3
ELSE
  SPO3 => SPA3(1:1,1:1,1)
ENDIF
IF(YL%LSP) THEN
  SPL => SPA3(1:NFLSUR,1:NSPEC2,IOFF+YL%MPSP)
  NGRBSP3(IOFF+YL%MPSP)=NGRBCLWC
ELSE
  SPL => SPA3(1:1,1:1,1)
ENDIF
IF(YI%LSP) THEN
  SPI => SPA3(1:NFLSUR,1:NSPEC2,IOFF+YI%MPSP)
  NGRBSP3(IOFF+YI%MPSP)=NGRBCIWC
ELSE
  SPI => SPA3(1:1,1:1,1)
ENDIF

! * SPA1, SPUB, SPVB: 
IF(.NOT.ALLOCATED(SPA1)) THEN
  IF(LELAM) THEN
    ALLOCATE(SPA1(NFLEVL,2))
  ELSE
    ALLOCATE(SPA1(NFLEVL,2))
  ENDIF
ENDIF
SPA1(:,1)=0.0_JPRB
SPA1(:,2)=0.0_JPRB
IF(LLP) THEN
  WRITE(NULOUT,9990) 'SPA1     ',SIZE(SPA1     ),SHAPE(SPA1     )
ENDIF
!IF(LELAM) THEN
  SPUB => SPA1(1:NFLEVL,1)
  SPVB => SPA1(1:NFLEVL,2)
  MSPTR_UB = 1
  MSPTR_VB = 2
!ELSE
!  IF(ASSOCIATED(SPUB)) NULLIFY(SPUB)
!  IF(ASSOCIATED(SPVB)) NULLIFY(SPVB)
!ENDIF

9990 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)

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

