SUBROUTINE SUSC2A

!**** *SUSC2A*  Initialize control of calc in gridpoint space (part 1)

!     Purpose.
!     -------

!     Interface.
!     ---------
!        *CALL*  *SUSC2A*

!        Explicit arguments : None
!        ------------------
!        Implicit arguments :
!        ------------------
!        see above "USE MODULE"

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

!     Externals.
!     ----------
!          None

!     Author.
!     ------
!        Mats Hamrud  * ECMWF *

!     Modifications.
!     -------------
!        Original  : 91-01-15
!        D. Giard  : 92-05-13 correction of NWFADT (acc. of diab. tend.)
!        JM.Piriou : 92-05-13 initialize NDHTSK (horiz. diag. DDH)
!        D. Giard  : 92-05-22 semi-lag. buffers added for NNMI
!        D. Giard  : 92-05-25 accumulation of diabatic tendencies for ps
!        D. Dent   : 92-06-25 NSLB1 buffer size for LSLAG
!        M.H./D.G. : 92-08-04 I/O for diabatic tendencies corrected
!        D. Giard  : 92-11-09 I/O for accumulation of diabatic tendencies
!        J.N. T    : 92-11-26 introduction of a new buffer for observations
!        K. Yessad : 92-12-18 Non interpolating vertical scheme.
!        F.Bouttier: 92-11-27 SL1 buffers for E.K.F., too
!        L.Labbe   : 93-04-15 new configuration 821
!        R.ElKhatib: 93-05-10 Spectral "brake"
!        M.Hamrud  : 93-06-01 Supress some fields from non-interpolating
!                               vertical scheme
!        M.Hamrud  : 93-11-18 Supress Fourier 2 buffer
!        K.Yessad  : 93-12-14 Interpolations at medium point
!                               semi-lagrangian temperature equation
!        C.Temperton:93-12-20 interpolation at mid-point for
!                               semi-Lagrangian moisture equation
!        C.Temperton:94-01-12 compute revised values of VMAX1, VMAX2
!        KY & REK  : 94-02-18 Harmonisation of enhanced diffusions (LFREIN)
!        R.ElKhatib: 94-03-03 Full-POS inplementation
!        M.Hortal  : 94-03-23 interpolation at mid-point for
!                               semi-Lagrangian momentum equations
!        J.N.Thepaut:94-08-23 logic for incremental
!        C.Temperton:94-05-17 spectral RT option
!        M.Hamrud  : 94-04-07 upper air gridpoint fields
!        M.Tolstykh: 94-10-17 setup for CUD-5 interpolation
!        K.Yessad  : 95-01    minor corrections for CUD-5
!                               (remove useless quantities NBFLDO and NBFLDM)
!        D. Giard  : 95-06-06 NFLDOBB1 : +4 for new surface analysis (OI)
!        L.Isaksen : 95-06-06 NSTAPINB changed
!        K.Yessad  : 95-10    optimisation of NSLWIDE for 2TL SL scheme
!        R.ElKhatib: 95-11-20 safe-keeping gridpoint fields before
!                               post-processing
!        K. Yessad : 96-04    NSLWIDE computed according to NDGSUR.
!        JP.Piedelievre:97-03 MPP for LCUMFU and LXFU. Length of buffers
!        F.Taillefer:97-05    NFLDOBB1 +2 for DL and DM (wind interpolation)
!        M.Janiskova:95-12-06 Trajectory at t-dt for TL and AD of simplified
!                             physical parametrizations
!        J.F. Mahfouf: 96-09-23 Trajectory at t-dt for TL and AD of physics
!        Modified SEPT 1996 by K. YESSAD:
!          - Spectral transforms for transmission coefficients.
!        Modified FEB 1997 by K. YESSAD:
!          - removal of NFPSUR.
!          - parallelisation of FULL-POS, environment for variables
!            using NFPWIDE.
!        JPh. Piedelievre (March 1997) : MPP for LCUMFU and LXFU. Length of
!          buffers.
!        K. YESSAD (August 1997): cleaning for CY18, bug correction for
!          computation of NSLBCT(5,.) to NSLBCT(8,.) for DM.
!        F.Taillefer:97-10-08 NFLDOBB1 +2*NFLEVG+1 for sigma guess (CANARI)
!        L. Dragulanescu: 97-05-25 801 ALADIN
!        C.Fischer : 97-10-23 Call SUEFPCSET in Aladin case
!        D. Giard  : 97-08    initialization of XFUBUF, GFUBUF
!        F. Veerse 97-11-18 : Allocate NSLSTA,NSLONL,NSLOFF for conf. 131
!        K. YESSAD (JAN 1998): merge of SLCSET and SUFPCSET into
!         SLCSET + some optimisations of Lars Isaksen.
!        C.Temperton: 98-01-19 2TL SL scheme for SWE model.
!        C. Fischer: 98-06-17 remove calls to ESLCSET and SUEFPCSET (Ald)
!        K. YESSAD: 98-08-05. Cleaning.
!         - SUSLB split into SUSLB and SUSLB2.
!         - removal of the 2TLSL options requiring an anterior point.
!        Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
!          - removal of LRPOLE in YOMCT0.
!          - removal of LLPOLE and code under LRPOLE, LLPOLE.
!        E.Andersson : 98-08-18 TOVS radiance background errors
!        R. El Khatib 98-10-06 LFPOSBUF
!        C.Temperton : 98-12-22 adjoint of 2TL SL scheme for SWE model.
!        C.Temperton : 99-01-21 storage of trajectory for tangent-linear
!           and adjoint of semi-Lagrangian (SWE only so far)
!        R. El Khatib 98-10-06 LFPOSBUF
!        V.Casse     98-11    NFLDOBB1
!        D.Salmond and Bob Carruthers 99-05 NLTSGTB(MYSETA) changed to 
!                                           NLTSGTB(MYSETW)
!        M. Charron  99-02-01 non-hydrostatic trajectories
!        M. Janiskova: 99-02-21 solar and thermal radiation coefficients
!        D.Salmond  99-06  Optimisation of TRMTOL
!        G.Mozdzynski 99-09 call slcset for observation halo 
!        C.Temperton : 99-06-17 TL/AD of 2TL SL scheme for SWE model -
!                      4 more fields stored to allow L2TLFF option
!        R. El Khatib 99-08-13 Move NFPWIDE-related computations to SUFPWIDE
!        D.Salmond  99-08  Removal of NSLBCT for LMESSP=.TRUE.
!        J. Jerman & R. El Khatib 99-11-10 SUSC2 => SUSC2A + SUSC2B
!        Y.Tremolet : 01-02-28 cleaning
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        M.Hamrud      01-Dec-2003 CY28R1 Cleaning
!        S.Ivatek-S.   10-Apr-2007 NEC
!     ------------------------------------------------------------------

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

USE YOMDIM   , ONLY : NDGLL    ,NDGSAL   ,NDGLG    , &
 & NDLUNG   ,NDLUXG     
USE YOMCT0   , ONLY : LELAM    ,NCONF
USE YOMGEM   , ONLY : NLOEN    
USE YOMSC2   , ONLY : NDIST    ,NDIEND   ,NCIST    ,NCIEND
USE YOMVRTL  , ONLY : L801TL
USE YEMCT0   , ONLY : NECOAD   ,NECOTL

IMPLICIT NONE

INTEGER(KIND=JPIM) :: IPROMAG, JL, IGL, IGLSTA, &
 & IGLEND, IEN, ISP, IDWIDE, ISTA, IEND, JGL, &
 & IGLLEN, ISTABUF  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!    -------------------------------------------------------------------
!*     1. INITIALIZE YOMSC2.
!         -----------------

!*     1.1   CONTROL FOR SCAN2, START ADRESSES FOR ROWS IN BUFFERS ETC.

IF (LHOOK) CALL DR_HOOK('SUSC2A',0,ZHOOK_HANDLE)
IPROMAG=0
DO JL=1,NDGLL
  IPROMAG=IPROMAG+NLOEN(JL)+3
ENDDO
IPROMAG=IPROMAG+1-MOD(IPROMAG,2)

IGLSTA = NDGSAL - 1
IGLEND = IGLSTA
IEN = NDGLL
ISP = IGLSTA

!    The definitions set in the following loop refer to fourier-space
!    ----------------------------------------------------------------

IDWIDE=NDGLG/2

ISTA=1
IEND=NDGLL

DO JGL = ISTA,IEND
  IGL = JGL
  ISP = ISP + 1
  ISTABUF = 1
  IF (LELAM .AND. ((NCONF == 401).OR.(NCONF == 501).OR.&
     & (NCONF == 601).OR.&
     & (NCONF == 801.AND..NOT.L801TL))&
     & .AND. (NECOTL == 0.AND.NECOAD == 0)) THEN  
    NDIST  (ISP)=ISTABUF + 1
    NDIEND (ISP)=ISTABUF + NLOEN(ISP)
  ELSE
    NDIST  (ISP)=ISTABUF + MAX(1,NDLUNG)
    NDIEND (ISP)=ISTABUF + MIN(NLOEN(ISP),NDLUXG)
  ENDIF
  NCIST  (ISP)=ISTABUF + 1
  NCIEND (ISP)=ISTABUF + NLOEN(ISP)
  IGLSTA = IGLEND + 1
  IGLEND = IGLSTA
  IGLLEN = NLOEN(IGLSTA) + 3

  DO WHILE (IGLEND+1 <= IEN .AND. &
   & (IGLLEN + NLOEN(IGLEND+1) + 3  <=  IPROMAG))
    IGLEND = IGLEND + 1
    ISP = ISP + 1
    ISTABUF = 1 + IGLLEN
    IF (LELAM .AND. ((NCONF == 401).OR.(NCONF == 501).OR.&
     & (NCONF == 601).OR.&
     & (NCONF == 801.AND..NOT.L801TL))&
     & .AND. (NECOTL == 0.AND.NECOAD == 0)) THEN  
      NDIST  (ISP)=ISTABUF + 1
      NDIEND (ISP)=ISTABUF + NLOEN(ISP)
    ELSE
      NDIST  (ISP)=ISTABUF + MAX(1,NDLUNG)
      NDIEND (ISP)=ISTABUF + MIN(NLOEN(ISP),NDLUXG)
    ENDIF
    NCIST  (ISP)=ISTABUF + 1
    NCIEND (ISP)=ISTABUF + NLOEN(ISP)
    IGLLEN = IGLLEN + NLOEN(IGLEND) + 3
    IF (IGLEND == IEN) EXIT
  ENDDO

  IF (IGLEND == IEN) EXIT
ENDDO
IF (LHOOK) CALL DR_HOOK('SUSC2A',1,ZHOOK_HANDLE)

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

END SUBROUTINE SUSC2A
