SUBROUTINE SPCM(CDCONF)

!------------------------------------------------------------------------------
! SPCM* - Multi tasking interface to SPC

! Purpose
! -------
!   Multi tasking interface (also calls SPC single-tasked if
!   multi-tasking not requested).

! Interface
! ---------
!   CDCONF - configuration of work (see doc.)

! Externals
! ---------
!   Called by SPCH.

! Method
! ------

! Reference
! ---------
!   ECMWF Research Department documentation of the IFS
!   Documentation about FULL-POS.

! Author
! ------
!   24-Nov-1987 Mats Hamrud and Philippe Courtier (ECMWF)

! Modifications
! -------------
!      Jan-1994 K. YESSAD     multitasking on zonal wave number.
!   06-Apr-1994 R. El Khatib  Full-POS implementation
!   01-Oct-1995 MPP Group     Support for Distributed Memory version
!   12-Dec-1996 L. Isaksen    Merge Message Passing and SH-memory
!   09-Jun-1997 K. YESSAD     A-level parallelisation of FULL-POS spectral fit
!                             (plug SPOS if DM).
!   20-Aug-1997 E. Holm       Call to trmtos/trstom includes ozone
!   18-Apr-2000 M. Szczech    Add horizontal diffusion for thermodynamic ozon
!   15-Oct-2001 D. Salmond    FULLIMP mods
!   01-Oct-2003 M. Hamrud     CY28 Cleaning
!   10-Jan-2004 M. Hamrud     CY28R1 Cleaning
!   10-Jun-2004 J. Masek      NH cleaning (LFULLIMP)
!   15-Nov-2004 K. Yessad     Update the enhanced diffusion
!   08-Feb-2005 K. Yessad     SI scheme for ARPEGE NH model
!   08-Feb-2005 K. Yessad     Mass correction moved in SPCMASCOR
!   17-Jul-2005 R. Brozkova   Move old VDAUX to SPNHX structure ("X" term) 
!   K. Yessad 15-May-2006: memory optimisations for stretched geometry
!   08-Feb-2008 N.Wedi        call to SPCMASCOR changed
!   N. Wedi and K. Yessad (Jan 2008): different dev for NH model and PC scheme
!   T.Wilhelmsson 09-09-25: Remove LFULLM requirement for LIMPF
!------------------------------------------------------------------------------

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

USE YOMCT0   , ONLY : LNHDYN
USE YOMDIM   , ONLY : NFLEVG   ,NFLSUR   ,NSMAX    ,NSPEC2   ,NUMP   
USE YOMDYNA  , ONLY : LNH_PDVD ,LNH_GEOGW
USE YOMDYN   , ONLY : LIMPF    ,LSIDG
USE YOMLAP   , ONLY : MYMS     ,NASM0
USE YOMMP    , ONLY : MYSETN   ,NPTRMF   ,NSPSTAF  ,NPSP     ,NSPEC2V  , &
 &                    NSPEC2VF  
USE YOMSP    , ONLY : SPVOR    ,SPDIV    ,SPT      ,SPSPD    ,SPSVD    , &
 &                    SPNHX    ,SPSP     ,SPGFL  
USE YOMMASS  , ONLY : LMASCOR 

IMPLICIT NONE

CHARACTER(LEN=1)  ,INTENT(IN)    :: CDCONF 

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

INTEGER(KIND=JPIM) :: IEND, IM, IMLOC, ISTA, JMLOC

LOGICAL :: LLONEM

REAL(KIND=JPRB),ALLOCATABLE ::  ZSPVORG(:,:)
REAL(KIND=JPRB),ALLOCATABLE ::  ZSPDIVG(:,:)
REAL(KIND=JPRB),ALLOCATABLE ::  ZSPTG  (:,:)
REAL(KIND=JPRB),ALLOCATABLE ::  ZSPSPDG(:,:)
REAL(KIND=JPRB),ALLOCATABLE ::  ZSPSVDG(:,:)
REAL(KIND=JPRB),ALLOCATABLE ::  ZSPSPG (:)
REAL(KIND=JPRB),ALLOCATABLE ::  ZSPAUX (:,:)
REAL(KIND=JPRB),ALLOCATABLE ::  ZSPAUXG(:,:)

REAL(KIND=JPRB) ::  Z, ZHOOK_HANDLE

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

#include "spcimpfinit.intfb.h"
#include "spcsi.intfb.h"
#include "spcimpfpost.intfb.h"
#include "spchor.intfb.h"
#include "spcmascor.intfb.h"
#include "spnhsi.intfb.h"
#include "spnhsi_geogw.intfb.h"
#include "spos.intfb.h"
#include "trmtos.intfb.h"
#include "trstom.intfb.h"

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

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

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

IF (LSIDG.OR.(LNHDYN.AND.LIMPF)) THEN
  LLONEM=.TRUE.
ELSE
  LLONEM=.FALSE.
ENDIF

IF(CDCONF == 'A'.OR.CDCONF == 'F'.OR.CDCONF == 'I' &
 & .OR.CDCONF == 'P'.OR.CDCONF == 'S'.OR.CDCONF == 'T') THEN

  IF (CDCONF == 'P') THEN

!   * FILTERING OF FULL-POS SPECTRAL FIELDS.

    CALL SPOS

  ELSE

    IF( LMASCOR ) THEN
      CALL SPCMASCOR(CDCONF)
    ENDIF

!   * SEMI-IMPLICIT SCMEME AND TRANSPOSITIONS.


    IF (CDCONF /= 'F') THEN

      ALLOCATE(ZSPVORG(NFLEVG,MAX(NSPEC2V,NSPEC2VF)))
      ALLOCATE(ZSPDIVG(NFLEVG,MAX(NSPEC2V,NSPEC2VF)))
      ALLOCATE(ZSPTG  (NFLEVG,MAX(NSPEC2V,NSPEC2VF)))
      ALLOCATE(ZSPSPDG(NFLEVG,MAX(NSPEC2V,NSPEC2VF)))
      ALLOCATE(ZSPSVDG(NFLEVG,MAX(NSPEC2V,NSPEC2VF)))
      ALLOCATE(ZSPSPG (MAX(NSPEC2V,NSPEC2VF)))
      
      IF (LIMPF.AND..NOT.LNHDYN) THEN
        ALLOCATE(ZSPAUX(NFLSUR,NSPEC2))
        ALLOCATE(ZSPAUXG(NFLEVG,MAX(NSPEC2V,NSPEC2VF)))
      ENDIF

      CALL GSTATS(9,0)
      IF (LIMPF.AND..NOT.LNHDYN) THEN
        CALL GSTATS(1022,0)
!$OMP PARALLEL DO SCHEDULE(STATIC,1) PRIVATE(JMLOC,IM,ISTA,IEND)
        DO JMLOC=1,NUMP
          IM=MYMS(JMLOC)
          ISTA=NASM0(IM)
          IEND=ISTA+2*(NSMAX+1-IM)-1
          CALL SPCIMPFINIT(CDCONF,IM,ISTA,IEND,SPVOR,ZSPAUX)  
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1022,1)
      ENDIF

!     * Transpose spectral data to vertical columns

      CALL GSTATS(9,2)
      CALL GSTATS(54,0)
! Could be optimized by transposing spvor only if (limpf and lnhdyn)
      IF (LIMPF.AND..NOT.LNHDYN) THEN
        CALL TRMTOS(PSPVOR=SPVOR,PSPDIV=SPDIV,PSPT=SPT,PSPSPD=SPSPD,&
          & PSPSVD=SPSVD,PSPSP=SPSP,PSPAUX=ZSPAUX,&
          & PSPVORG=ZSPVORG,PSPDIVG=ZSPDIVG,PSPTG=ZSPTG,PSPSPDG=ZSPSPDG,&
          & PSPSVDG=ZSPSVDG,PSPSPG=ZSPSPG,PSPAUXG=ZSPAUXG,&
          & LDFULLM=LLONEM)  
      ELSE
        CALL TRMTOS(PSPVOR=SPVOR,PSPDIV=SPDIV,PSPT=SPT,PSPSPD=SPSPD,&
          & PSPSVD=SPSVD,PSPSP=SPSP,&
          & PSPVORG=ZSPVORG,PSPDIVG=ZSPDIVG,PSPTG=ZSPTG,PSPSPDG=ZSPSPDG,&
          & PSPSVDG=ZSPSVDG,PSPSPG=ZSPSPG,&
          & LDFULLM=LLONEM)
      ENDIF
      CALL GSTATS(54,2)
      CALL GSTATS(9,3)

      IF (LLONEM) THEN

!       * Each zonal wave number has to be treated separately

        CALL GSTATS(1023,0)
!$OMP PARALLEL DO SCHEDULE(STATIC,1) PRIVATE(JMLOC,IM,ISTA,IEND)
        DO JMLOC=NPTRMF(MYSETN),NPTRMF(MYSETN+1)-1
          IM=MYMS(JMLOC)
          ISTA=NSPSTAF(IM)
          IEND=ISTA+2*(NSMAX+1-IM)-1
          IF (LNHDYN) THEN
            IF (LNH_PDVD) THEN
              CALL SPNHSI(CDCONF,IM,JMLOC,ISTA,IEND,LLONEM,&
               & ZSPVORG,ZSPDIVG,ZSPTG,ZSPSPG,ZSPSPDG,ZSPSVDG)  
            ELSEIF (LNH_GEOGW) THEN
              CALL SPNHSI_GEOGW(CDCONF,IM,JMLOC,ISTA,IEND,LLONEM,&
               & ZSPVORG,ZSPDIVG,ZSPTG,ZSPSPG,ZSPSPDG,ZSPSVDG)  
            ENDIF
          ELSE
            CALL SPCSI(CDCONF,IM,JMLOC,ISTA,IEND,LLONEM,&
             & ZSPAUXG,ZSPVORG,ZSPDIVG,ZSPTG,ZSPSPG)  
          ENDIF
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1023,1)

      ELSE

!       * All spectral colunms can be done in one go

        IF (NSPEC2V > 0) THEN
          IM=-999
          IMLOC=-999
          IF (LNHDYN) THEN
            IF (LNH_PDVD) THEN
              CALL SPNHSI(CDCONF,IM,IMLOC,1,NSPEC2V,LLONEM,&
               & ZSPVORG,ZSPDIVG,ZSPTG,ZSPSPG,ZSPSPDG,ZSPSVDG)  
            ELSEIF (LNH_GEOGW) THEN
              CALL SPNHSI_GEOGW(CDCONF,IM,IMLOC,1,NSPEC2V,LLONEM,&
               & ZSPVORG,ZSPDIVG,ZSPTG,ZSPSPG,ZSPSPDG,ZSPSVDG)  
            ENDIF
          ELSE
            CALL SPCSI(CDCONF,IM,IMLOC,1,NSPEC2V,LLONEM,&
             & ZSPAUXG,ZSPVORG,ZSPDIVG,ZSPTG,ZSPSPG)  
          ENDIF
        ENDIF

      ENDIF

!     * Transpose spectral data back to level structure

      CALL GSTATS(9,2)
      CALL GSTATS(54,3)
! Could be optimized by transposing zspvorg only if (limpf and lnhdyn)
      CALL TRSTOM(&
       & PSPVORG=ZSPVORG,PSPDIVG=ZSPDIVG,PSPTG=ZSPTG,PSPSPDG=ZSPSPDG,&
       & PSPSVDG=ZSPSVDG,PSPSPG=ZSPSPG,&
       & PSPVOR=SPVOR,PSPDIV=SPDIV,PSPT=SPT,PSPSPD=SPSPD,&
       & PSPSVD=SPSVD,PSPSP=SPSP,&
       & LDFULLM=LLONEM,LDNEEDPS=.TRUE.)  
    
      CALL GSTATS(54,1)
      CALL GSTATS(9,3)


      IF (LIMPF.AND..NOT.LNHDYN) THEN
        CALL GSTATS(1024,0)
!$OMP PARALLEL DO SCHEDULE(STATIC,1) PRIVATE(JMLOC,IM,ISTA,IEND)
        DO JMLOC=1,NUMP
          IM=MYMS(JMLOC)
          ISTA=NASM0(IM)
          IEND=ISTA+2*(NSMAX+1-IM)-1
          CALL SPCIMPFPOST(CDCONF,IM,ISTA,IEND,SPDIV,SPVOR)  
        ENDDO
!$OMP END PARALLEL DO
        CALL GSTATS(1024,1)
      ENDIF


      DEALLOCATE(ZSPVORG)
      DEALLOCATE(ZSPDIVG)
      DEALLOCATE(ZSPTG)
      DEALLOCATE(ZSPSPDG)
      DEALLOCATE(ZSPSVDG)
      DEALLOCATE(ZSPSPG)

      IF (LIMPF.AND..NOT.LNHDYN) THEN
        DEALLOCATE(ZSPAUX)
        DEALLOCATE(ZSPAUXG)
      ENDIF
    ELSE
      CALL GSTATS(9,0)
    ENDIF

!   * HORIZONTAL DIFFUSION, FILTERING ECPOS FIELDS, NUDGING.

    IF (NSPEC2 > 0) THEN

      CALL SPCHOR(CDCONF,1,NSPEC2,SPVOR,SPDIV,SPT,SPSPD,SPSVD,SPNHX, &
       & SPGFL,SPSP)
    
!     * To make sure SPSP(:) is not used inadvertently if NPSP.NE.1
      IF (NPSP /= 1) SPSP(:)=HUGE(Z)

    ENDIF
    CALL GSTATS(9,1)

  ENDIF

ENDIF

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

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