SUBROUTINE ROTAT(KNSMIN,KNSMAX,KULROT,KULOUT,KN,&
 & PDDPNM,PDDA,PDDI,PDDUCOST,PDDSINTA)  

!**** *ROTAT* - Rotation matrice computation for the total wave number KN.

!      Purpose.
!      --------
!               Rotation matrice computation for the total wave number KN.

!**    Interface.
!      ----------
!         *CALL *ROTAT*

!      Explicit arguments:
!      -------------------
!            KNSMIN   - Lower wave number.                          (input)
!            KNSMAX   - Upper wave number.                          (input)
!            KULROT   - Logical unit for rotation matrices.         (input)
!            KULOUT   - Output logical unit.                        (input)
!            KN       - Total wave number.                          (input)
!            PDDPNM   - Contains PNM (for truncation KNSMAX).       (input)
!            PDDA     - DDA(n)=SQRT(2n+1).                          (input)
!            PDDI     - DDI(n)=n.                                   (input)
!            PDDUCOST - 1./cos(high resolution pole latitude).      (input)
!            PDDSINTA - sin(high resolution pole latitude).         (input)

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

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

!      References.
!      -----------
!        Note de travail ARPEGE/IFS nr 19 (in French).

!      External.
!      ---------
!         Called by SUROT.

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

!      Modifications.
!      --------------
!       Original : 91-02-18.
!       K. YESSAD: 93-05-11. Cleaning, comments put into English.
!       M.Hamrud      01-Oct-2003 CY28 Cleaning
!       K.Yessad (Nov 2008): cleanings
!     ------------------------------------------------------------------

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

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KNSMAX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNSMIN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KULROT
INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KN 
REAL(KIND=JPRH)   ,INTENT(IN)    :: PDDPNM(0:KNSMAX,0:KNSMAX) 
REAL(KIND=JPRH)   ,INTENT(IN)    :: PDDA(0:KNSMAX) 
REAL(KIND=JPRH)   ,INTENT(IN)    :: PDDI(0:KNSMAX) 
REAL(KIND=JPRH)   ,INTENT(IN)    :: PDDUCOST 
REAL(KIND=JPRH)   ,INTENT(IN)    :: PDDSINTA 

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

REAL(KIND=JPRH) :: Z_DLC(0:KNSMAX,0:KNSMAX)
REAL(KIND=JPRH) :: Z_DLD(0:KNSMAX,0:KNSMAX)
REAL(KIND=JPRH) :: Z_DLTEMP1,Z_DLTEMP2,Z_DLFACT1,Z_DLFACT2
REAL(KIND=JPRB) :: ZRC(0:KNSMAX,0:KNSMAX),ZRIC(-KNSMAX:-1,-KNSMAX:-1)
REAL(KIND=JPRB) :: ZRR(0:KNSMAX,0:KNSMAX),ZRIR(-KNSMAX:-1,-KNSMAX:-1)
REAL(KIND=JPRB) :: ZRCLU((KNSMAX+1)*(KNSMAX+2)/2-(KNSMAX-KNSMIN)*(KNSMAX-KNSMIN+1)/2)
REAL(KIND=JPRB) :: ZRICLU((KNSMAX  )*(KNSMAX+1)/2-(KNSMAX-KNSMIN)*(KNSMAX-KNSMIN+1)/2)
CHARACTER (LEN = 16) ::  CLC,CLIC

INTEGER(KIND=JPIM), PARAMETER :: JPKS=KIND(ZRC)
INTEGER(KIND=JPIM), PARAMETER :: JPKD=KIND(Z_DLC)

INTEGER(KIND=JPIM) :: INDR, INDRI, INVALI, INVALR, IREP, JM, JN1, JN2, JS

REAL(KIND=JPRB) :: ZMAXI, ZMAXR
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

INTERFACE
#include "mxmaop.h"
END INTERFACE

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

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

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

!*       1. Zonal wave number m=0.
!           ----------------------

IREP=0
DO JS=0,KN
  Z_DLTEMP1=PDDPNM(JS,KN)/PDDA(KN)
  Z_DLC(JS,0)=Z_DLTEMP1
  Z_DLD(JS,0)=Z_DLTEMP1
ENDDO

!*       2. Case s=n and s=n-1.
!           -------------------

DO JM=1,KN
  Z_DLTEMP1=SQRT(REAL(KN-JM+1,JPKD)/REAL(KN+JM,JPKD)) &
   & *PDDUCOST*(1.0_JPRB+PDDSINTA)
  Z_DLTEMP2=SQRT(REAL(KN-JM+1,JPKD)/REAL(KN+JM,JPKD)) &
   & *PDDUCOST*(1.0_JPRB-PDDSINTA)
  Z_DLFACT1=(PDDI(JM)-PDDSINTA*PDDI(KN))*PDDUCOST*SQRT(2.0_JPRB/PDDI(KN))
  Z_DLFACT2=(PDDI(JM)+PDDSINTA*PDDI(KN))*PDDUCOST*SQRT(2.0_JPRB/PDDI(KN))
  Z_DLC(KN,JM)=  -Z_DLTEMP1*Z_DLC(KN,JM-1)
  Z_DLD(KN,JM)=   Z_DLTEMP2*Z_DLD(KN,JM-1)
  Z_DLC(KN-1,JM)=-Z_DLFACT1*Z_DLC(KN,JM)
  Z_DLD(KN-1,JM)= Z_DLFACT2*Z_DLD(KN,JM)
ENDDO

!*       3. General recurrence.
!           -------------------

IF (KN > 2) THEN

  DO JS=KN-1,2,-1
    DO JM=1,JS-1
      Z_DLTEMP1=SQRT(REAL((KN-JS)*(KN+JS+1),JPKD)/REAL((KN+JS)*(KN-JS+1),JPKD))
      Z_DLFACT1=2.0_JPRB*(PDDI(JS)*PDDSINTA-PDDI(JM))*&
       & PDDUCOST/SQRT(REAL((KN+JS)*(KN-JS+1),JPKD))  
      Z_DLFACT2= 2.0_JPRB*(PDDI(JS)*PDDSINTA+PDDI(JM))*&
       & PDDUCOST/SQRT(REAL((KN+JS)*(KN-JS+1),JPKD))  
      Z_DLC(JS-1,JM)=Z_DLFACT1*Z_DLC(JS,JM)-Z_DLTEMP1*Z_DLC(JS+1,JM)
      Z_DLD(JS-1,JM)=Z_DLFACT2*Z_DLD(JS,JM)-Z_DLTEMP1*Z_DLD(JS+1,JM)
    ENDDO
  ENDDO

ENDIF

DO JM=1,KN
  DO JS=0,JM-1
    Z_DLC(JS,JM)=Z_DLC(JM,JS)
    Z_DLD(JS,JM)=Z_DLD(JM,JS)
  ENDDO
ENDDO

!*       4. Final matrices building.
!           ------------------------

DO JS=0,KN
  ZRC(JS,0)=REAL(Z_DLC(JS,0),JPKS)
  DO JM=1,KN
    ZRC(JS,JM)=REAL(Z_DLC(JS,JM)+Z_DLD(JS,JM),JPKS)
  ENDDO
ENDDO
DO JS=1,KN
  DO JM=1,KN
    ZRIC(-JS,-JM)=REAL(Z_DLC(JS,JM)-Z_DLD(JS,JM),JPKS)
  ENDDO
ENDDO

!*        5.  Test of matrices quality.
!             -------------------------

IF (KN == KNSMAX) THEN

  CALL MXMAOP(ZRC(0,0),1,KNSMAX+1,ZRC(0,0),1,KNSMAX+1,&
   & ZRR(0,0),1,KNSMAX+1,KN+1,KN+1,KN+1)  
  ZMAXR=0.0_JPRB
  DO JN1=0,KN
    ZRR(JN1,JN1)=ZRR(JN1,JN1)-1.0_JPRB
    DO JN2=0,KN
      ZMAXR=MAX(ZMAXR,ABS(ZRR(JN1,JN2)))
    ENDDO
  ENDDO

  CALL MXMAOP(ZRIC(-KN,-KN),1,KNSMAX,&
   & ZRIC(-KN,-KN),1,KNSMAX,ZRIR(-KN,-KN),1,KNSMAX,KN,KN,KN)  
  ZMAXI=0.0_JPRB
  DO JN1=-KN,-1
    ZRIR(JN1,JN1)=ZRIR(JN1,JN1)-1.0_JPRB
    DO JN2=-KN,-1
      ZMAXI=MAX(ZMAXI,ABS(ZRIR(JN1,JN2)))
    ENDDO
  ENDDO
  WRITE(KULOUT,'(A,I4,A,E10.3,1X,E10.3)')&
   & ' TOTAL WAVE NUMBER KN=',KN,'; DIFFERENCE FROM UNIT:',&
   & ZMAXR,ZMAXI  

ENDIF

!*       6. Matrices writing.
!           -----------------

INDR=0
DO JM=1,KN+1
  INDR=INDR+MIN(JM-1,KNSMIN+1)
  DO JS=1,MIN(JM,KNSMIN+1)
    ZRCLU(INDR+JS)=ZRC(JS-1,JM-1)
  ENDDO
ENDDO

INDRI=-MAX(0,KN-KNSMIN)
DO JM=1+MAX(0,KN-KNSMIN),KN
  INDRI=INDRI+JM-1
  DO JS=1,JM
    ZRICLU(INDRI+JS)=ZRIC(JS-KN-1,JM-KN-1)
  ENDDO
ENDDO
WRITE (CLC,'(A,I5.4)') 'WNUM REAL',KN
WRITE (CLIC,'(A,I5.4)') 'WNUM IMAG',KN
INVALR=(KN+1)*(KN+2)/2-MAX(0,KN-KNSMIN)*MAX(0,KN-KNSMIN+1)/2
INVALI= KN   *(KN+1)/2-MAX(0,KN-KNSMIN)*MAX(0,KN-KNSMIN+1)/2
CALL LFIECR(IREP,KULROT,CLC,ZRCLU(1),INVALR)
CALL LFIECR(IREP,KULROT,CLIC,ZRICLU(1),INVALI)

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

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

