SUBROUTINE DILATB(KM,KNSMAX,KNSMIN,KULDILA,KULCONT,KULOUT,PALPHA,PBETA)  

!**** *DILATB* - Writes dilatation matrix.

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

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

!      Explicit Arguments :
!      --------------------
!           INPUT:
!            KM      - Zonal wave number
!            KNSMAX  - Larger truncation
!            KNSMIN  - smaller truncation
!            KULDILA - Logical unit for dilatation matrix
!            KULCONT - Logical unit for contraction matrix
!            KULOUT  - Logical unit for prints
!            PALPHA  - Contraction matrix "alpha".
!            PBETA   - Dilatation matrix "beta".

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

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

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

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

!      Author.
!      -------
!         Michel Rochas, DMN (originally in DILAT).

!      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. 
!                              Move code in DILATB.

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

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)    :: KULDILA
INTEGER(KIND=JPIM),INTENT(IN)    :: KULCONT
INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALPHA(KNSMAX-KM+1,KNSMIN-KM+1)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBETA(KNSMAX-KM+1,KNSMIN-KM+1)

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

REAL(KIND=JPRB) :: ZRESUL(KNSMIN-KM+1,KNSMIN-KM+1)
CHARACTER (LEN = 16) :: CLDILA

INTEGER(KIND=JPIM) :: IREP, JN1, JN2

REAL(KIND=JPRB) :: ZMAX
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

INTERFACE
#include "mxmaop.h"
END INTERFACE

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

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

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

!*        1. Test quality of matrix alpha and beta.
!            --------------------------------------

CALL MXMAOP(PBETA,KNSMAX-KM+1,1 ,PALPHA,1,KNSMAX-KM+1,&
 & ZRESUL,1,KNSMIN-KM+1,&
 & KNSMIN-KM+1,KNSMAX-KM+1,KNSMIN-KM+1)  
ZMAX=0.0_JPRB
DO JN1=1,KNSMIN-KM+1
  ZRESUL(JN1,JN1)=ZRESUL(JN1,JN1)-1.0_JPRB
  DO JN2=1,KNSMIN-KM+1
    ZMAX=MAX(ZMAX,ABS(ZRESUL(JN1,JN2)))
  ENDDO
ENDDO
WRITE(KULOUT,'(A,I4,A,E10.3)')&
 & ' ZONAL WAVE NUMBER ',KM,' DEVIATION FROM IDENTITY MATRIX ',ZMAX  

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

!*        2. Writes matrix on LFI files.
!            ---------------------------

WRITE (CLDILA,'(A,I5.4)') 'WNUM',KM
IREP=0
CALL LFIECR(IREP,KULDILA,CLDILA,PBETA,(KNSMIN+1-KM)*(KNSMAX+1-KM))
CALL LFIECR(IREP,KULCONT,CLDILA,PALPHA,(KNSMIN+1-KM)*(KNSMAX+1-KM))

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

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

