SUBROUTINE SUSMAP(KULOUT,PD,PE,PF)

!**** *SUSMAP*   - Initialisation of coefficients allowing spectral
!                  multiplication by GM**2 (GM is the map factor).

!     Purpose.    Initialisation of coefficients PD,PE,PF allowing spectral
!     --------    multiplication by GM**2 (GM is the map factor).
!                 Caution! Only valid with a triangular truncation.

!    ((GM**2)*SPX)(m,n)= PF(m,n-2)*SPX(m,n-2)
!                       +PE(m,n-1)*SPX(m,n-1)
!                       +PD(m,n  )*SPX(m,n  )
!                       +PE(m,n  )*SPX(m,n+1)
!                       +PF(m,n  )*SPX(m,n+2)
!    where:
!         a=0.5*(c+1/c); b=0.5*(c-1/c); c=RSTRET: stretching coefficient.
!         e(m,n)=sqrt((n**2-m**2)/(4n**2-1))
!         PD(m,n)=(a**2)+(b**2)[(e(m,n)**2)+(e(m,n+1)**2)]
!         PE(m,n)=(2ab)[e(m,n+1)]
!         PF(m,n)=(b**2)[e(m,n+1)][e(m,n+2)]

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

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

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

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

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

!     Externals.
!     ----------
!        None.
!        Called by SUDYN.

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

!     Author.
!     -------
!        K. YESSAD: OCTOBER 1993.

!     Modifications.
!     --------------
!        K. YESSAD (APRIL 1994): Use of new subroutine SUGMRE.
!        K. YESSAD (MARCH 1995): Use array KSE0.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        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 : NSPEC

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

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)   ,INTENT(OUT)   :: PF(NSPEC) 

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

REAL(KIND=JPRB) :: Z2AB, ZA, ZA2, ZB, ZB2
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "sugmre.intfb.h"

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

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

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

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

WRITE (KULOUT,*)
WRITE (KULOUT,'(A,A)') ' SUSMAP: CALL TO SUGMRE TO ',&
 & 'INITIALIZE COEFFICIENTS FOR SPECTRAL MULT. BY GM**2.'  
WRITE (KULOUT,'(A)')'  USED BY SEMI-IMPLICIT SCHEME IF LSIDG=.T.'

ZA=0.5_JPRB*(RSTRET+1.0_JPRB/RSTRET)
ZB=0.5_JPRB*(RSTRET-1.0_JPRB/RSTRET)
ZA2=ZA*ZA
ZB2=ZB*ZB
Z2AB=2.0_JPRB*ZA*ZB
CALL SUGMRE(KULOUT,ZA2,Z2AB,ZB2,PD,PE,PF)

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

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

