SUBROUTINE DILAT(KM,KNSMAX,KNSMIN,KDGNH,PNM,PMAPP,PRPNM,PALPHA,PBETA)  

!**** *DILAT* - Computes dilatation matrix.

!      Purpose.
!      --------
!               Computes dilatation matrix for schmidt transform.

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

!      Explicit Arguments :
!      --------------------
!           INPUT:
!            KM      - Zonal wave number
!            KNSMAX  - Larger truncation
!            KNSMIN  - smaller truncation
!            KDGNH   - number of points on an hemisphere
!            PNM     - Legendre polynomials small truncation
!            PMAPP   - Mapping factor
!            PRPNM   - Legendre polynomials large truncation

!           OUTPUT:
!            PALPHA  - Contraction matrix "alpha".
!            PBETA   - Dilatation matrix "beta".

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

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

!      Reference.
!      ----------
!         Arpege note 19 (in French).

!      Externals.
!      ----------
!         Calls MXMAOP.
!         Is called by SUDIL.

!      Author.
!      -------
!         Michel Rochas, DMN.

!      Modifications.
!      --------------
!        Original : 91-01-28.
!        =07-08-91= Philippe Courtier. Changes Leg. polynomials mapping
!        K. YESSAD: 93-05-11 : cleaning, comments put into English.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        K. Yessad: Aug 2005 : A-level distribution of conf 911. 

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

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

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KM 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNSMAX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNSMIN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGNH 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNM(2*KDGNH,KNSMIN-KM+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMAPP(2*KDGNH) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRPNM(KDGNH,KNSMAX-KM+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PALPHA(KNSMAX-KM+1,KNSMIN-KM+1)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PBETA(KNSMAX-KM+1,KNSMIN-KM+1)

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

REAL(KIND=JPRB) :: ZP(KNSMAX-KM+1)
REAL(KIND=JPRB) :: ZPNMN(KDGNH,KNSMIN-KM+1)
REAL(KIND=JPRB) :: ZPNMS(KDGNH,KNSMIN-KM+1)
REAL(KIND=JPRB) :: ZNOR(KNSMAX-KM+1,KNSMIN-KM+1)
REAL(KIND=JPRB) :: ZSUD(KNSMAX-KM+1,KNSMIN-KM+1)

INTEGER(KIND=JPIM) :: IGLS, IR, IR2, JGL, JN, JS

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

INTERFACE
#include "mxmaop.h"
END INTERFACE

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

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

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

!*        0. Array ZP.
!            ---------
DO JS=1,KNSMAX-KM+1
  ZP(JS)=REAL(2*MOD(JS+KNSMAX-KM,2)-1,JPRB)
ENDDO

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

!*        1. Matrix BETA.
!            ------------

!*    1.1 Prepare Legendre polynomials small truncation.

DO JN=KM,KNSMIN
  IR=KNSMIN-JN+1
  DO JGL=1,KDGNH
    IGLS=2*KDGNH-JGL+1
    ZPNMN(JGL,IR)=PNM(JGL,IR)
    ZPNMS(JGL,IR)=PNM(IGLS,IR)
  ENDDO
ENDDO

!*    1.2 Computes matrix ZNOR and ZSUD.

CALL MXMAOP(PRPNM,KDGNH,1,ZPNMN,1,KDGNH,ZNOR ,1,KNSMAX-KM+1,&
 & KNSMAX-KM+1,KDGNH,KNSMIN-KM+1)  
CALL MXMAOP(PRPNM,KDGNH,1,ZPNMS,1,KDGNH,ZSUD ,1,KNSMAX-KM+1,&
 & KNSMAX-KM+1,KDGNH,KNSMIN-KM+1)  

!*    1.3 Computes matrix PBETA.

DO JN=KM,KNSMIN
  IR=KNSMIN-JN+1
  IR2=JN+1-KM
  DO JS=1,KNSMAX-KM+1
    PBETA(KNSMAX+2-KM-JS,IR2)=ZNOR(JS,IR)+ZP(JS)*ZSUD(JS,IR)
  ENDDO
ENDDO

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

!*        2. Matrix ALPHA.
!            -------------

!*    2.1 Prepare Legendre polynomials small truncation.

DO JN=KM,KNSMIN
  IR=KNSMIN-JN+1
  DO JGL=1,KDGNH
    IGLS=2*KDGNH-JGL+1
    ZPNMN(JGL,IR)=PNM(JGL,IR)*PMAPP(JGL)
    ZPNMS(JGL,IR)=PNM(IGLS,IR)*PMAPP(IGLS)
  ENDDO
ENDDO

!*    2.2 Computes matrix ZNOR and ZSUD.

CALL MXMAOP(PRPNM,KDGNH,1,ZPNMN,1,KDGNH,ZNOR ,1,KNSMAX-KM+1,&
 & KNSMAX-KM+1,KDGNH,KNSMIN-KM+1)  
CALL MXMAOP(PRPNM,KDGNH,1,ZPNMS,1,KDGNH,ZSUD ,1,KNSMAX-KM+1,&
 & KNSMAX-KM+1,KDGNH,KNSMIN-KM+1)  

!*    2.3 Computes matrix PALPHA.

DO JN=KM,KNSMIN
  IR=KNSMIN-JN+1
  IR2=JN+1-KM
  DO JS=1,KNSMAX-KM+1
    PALPHA(KNSMAX+2-KM-JS,IR2)=ZNOR(JS,IR)+ZP(JS)*ZSUD(JS,IR)
  ENDDO
ENDDO

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

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

