SUBROUTINE SUSPGM(KULOUT,PD,PE)

!**** *SUSPGM*   - Initialisation of coefficients allowing spectral
!                  multiplication by the mapping factor M.

!     Purpose.    Initialisation of coefficients PD,PE allowing spectral
!     --------    multiplication by the mapping factor M.

!     (M*SPX)(m,n)=+PE(m,n-1)*SPX(m,n-1)
!                  +PD(m,n  )*SPX(m,n  )
!                  +PE(m,n  )*SPX(m,n+1)
!     M = 0.5(c+1/c) + 0.5 (c-1/c) mu
!     (mu = sinus of latitude)

!**   Interface.
!     ----------
!        *CALL* *SUSPGM( ... )

!        Explicit arguments :
!        --------------------
!        INPUT:
!         KULOUT:    - Output logical unit.

!        OUTPUT:
!         PD,PE:     - Coefficients to be computed (see above).

!        Implicit arguments :
!        --------------------
!        none.

!     Method.
!     -------
!        See documentation about horizontal diffusion.

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

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

!     Author.
!     -------
!        K. YESSAD: DEC 2003.

!     Modifications.
!     --------------
!      K. Yessad 15-May-2006: memory optimisations for stretched geometry
!     ------------------------------------------------------------------

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

USE YOMGEM   , ONLY : RSTRET
USE YOMDIM   , ONLY : NSMAX    ,NSPEC    ,NUMP
USE YOMLAP   , ONLY : MYMS     ,NSE0L

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PD(NSPEC) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PE(NSPEC) 

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

REAL(KIND=JPRB) :: ZEE(0:NSMAX+2)

INTEGER(KIND=JPIM) :: ISE, ISE0, JMLOC, IM, JN

REAL(KIND=JPRB) :: ZM2, ZN2
REAL(KIND=JPRB) :: ZGMRA0 
REAL(KIND=JPRB) :: ZGMRA1 

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

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

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

!*       1.    COMPUTATION OF PD,PE.
!              ---------------------

WRITE (KULOUT,*)
WRITE (KULOUT,'(A)') ' ROUTINE SUSPGM:'

ZGMRA0=0.5_JPRB*(RSTRET + 1.0_JPRB/RSTRET)
ZGMRA1=0.5_JPRB*(RSTRET - 1.0_JPRB/RSTRET)

DO JMLOC=1,NUMP
  IM=MYMS(JMLOC)
  ZM2=REAL(IM*IM,JPRB)
  DO JN=IM,NSMAX+2
    ZN2=REAL(JN*JN,JPRB)
    ZEE(JN)=SQRT(MAX(0.0_JPRB,(ZN2-ZM2)/(4._JPRB*ZN2-1.0_JPRB)))
  ENDDO
  ISE0=NSE0L(JMLOC)
  DO JN=IM,NSMAX
    ISE=ISE0+JN+1-IM
    PD(ISE)=ZGMRA0
  ENDDO
  DO JN=IM,NSMAX-1
    ISE=ISE0+JN+1-IM
    PE(ISE)=ZGMRA1*ZEE(JN+1)
  ENDDO
  ISE=ISE0+NSMAX+1-IM
  PE(ISE)=0.0_JPRB
ENDDO

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

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

