SUBROUTINE SPROTA(KULROT,KULOUT,KFIELD,KFLDSUR,KNSMIN,&
 & KNSMAX,KSMXSUR,KASM0,KN,KSPEC2,KTYP2,PSPECI,&
 & PSPECF)  
#ifdef DOC

!**** *SPROTA* - Rotations in spectral space, for the
!                total wave number KN. Reading of rotation
!                matrices is made on a LFI file.

!     Purpose.
!     --------

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

!        Explicit arguments :
!        --------------------

!      KULROT      - Logical unit number where rotations matrices     (INPUT)
!                    (ZRC,ZRIC) are stored.
!      KULOUT      - Output logical unit.                             (INPUT)
!      KFIELD      - Number of spectral fields to be transformed.     (INPUT)
!      KFLDSUR     - Odd number above KFIELD for dimensioning.        (INPUT)
!      KNSMIN      - Integer between 0 and KNSMAX.                    (INPUT)
!      KNSMAX      - Troncature.                                      (INPUT)
!      KSMXSUR     - Odd number above KNSMAX+1.                       (INPUT)
!      KASM0       - KACM0(JM): index of the coefficient              (INPUT)
!                    corresponding to the wave number (m=JM,n=JM)
!                    for the larger truncation.
!      KN          - Wave number.                                     (INPUT)
!      KSPEC2      - Dimension for spectral array PSPECS.             (INPUT)
!      KTYP2       - KTYP2=0: All coefficients computed.              (INPUT)
!                             KNSMIN must be equal to KNSMAX.
!                  - KTYP2=1: For JN>KNSMIN and JM>KNSMIN
!                             PSPECI contains ZEROS.
!                  - KTYP2=-1: For JN>KNSMIN and JM>KNSMIN
!                              PSPECF contains ZEROS.
!      PSPECI      - Fields before rotation.                          (INPUT)

!      PSPECF      - Fields after rotation.                           (OUTPUT)

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

!     Method.
!     -------

!     Externals:
!     ----------
!       Calls LFILEC, MXMAOP.
!       Called by SPORTS.

!     Reference.
!     ----------
!        ARPEGE/IFS note number 19 (in French).
!        ARPEGE/IFS documentation about conf 911, 912, TRAGEO.

!     Author.
!     -------
!        K. YESSAD. (METEO-FRANCE/CNRM/GMAP)

!     Modifications.
!     --------------
!        Original : FEBRUARY 1991
!        Modification (english comments, cleaning) by K. YESSAD: APRIL 1993.
!        Modified by L. Isaksen 95-06-06 : Reordering of spectral arrays
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        K.Yessad : Jan 2004  Debug
!     ------------------------------------------------------------------
#endif

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

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDSUR 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNSMAX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSPEC2 
INTEGER(KIND=JPIM)               :: KULROT ! UNDETERMINED INTENT
INTEGER(KIND=JPIM)               :: KULOUT ! Argument NOT used
INTEGER(KIND=JPIM),INTENT(IN)    :: KFIELD 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNSMIN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSMXSUR 
INTEGER(KIND=JPIM),INTENT(IN)    :: KASM0(0:KNSMAX) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTYP2 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSPECI(KFLDSUR,KSPEC2) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSPECF(KFLDSUR,KSPEC2) 

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

REAL(KIND=JPRB) :: ZSPECI(KFLDSUR,-KN:KN), ZSPECF(KFLDSUR,-KN:KN)
REAL(KIND=JPRB) :: ZRC   (KSMXSUR,KSMXSUR)
REAL(KIND=JPRB) :: ZRIC  (KSMXSUR,KSMXSUR)
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) :: IN1, IN2, INDR, INDRI, INVALI, INVALR, IRP, ISP, JFIELD, JM, JS
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

INTERFACE
#include "mxmaop.h"
END INTERFACE

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

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

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

IRP=0

IF (KN == 0) THEN

!       CASE KN=0.

  DO JFIELD=1,KFIELD
    PSPECF(JFIELD,KASM0(0))=PSPECI(JFIELD,KASM0(0))
  ENDDO

ELSEIF (KN > 0) THEN

!       CASE FROM KN=1 TO KNSMAX

  IN1=KN
  IN2=KN
  IF (KTYP2 ==  1) IN2=MIN(KN,KNSMIN)
  IF (KTYP2 == -1) IN1=MIN(KN,KNSMIN)

  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 LFILEC(IRP,KULROT,CLC ,ZRCLU(1) ,INVALR)
  CALL LFILEC(IRP,KULROT,CLIC,ZRICLU(1),INVALI)

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

  DO JS=2,KN+1
    ZRC(JS,1)=0.5_JPRB*ZRC(JS,1)
  ENDDO

  INDRI=-MAX(0,KN-KNSMIN)
  DO JM=1+MAX(0,KN-KNSMIN),KN
    INDRI=INDRI+JM-1
    DO JS=1,JM
      ZRIC(JS,JM)=ZRICLU(INDRI+JS)
    ENDDO
    DO JS=1,JM-1
      ZRIC(JM,JS)=ZRICLU(INDRI+JS)
    ENDDO
  ENDDO

! Make a local spectral copy for the values (m,n=JN), and do the MXMAOP
! Reorder the data back again to the proper spectral form after the 
! MXMAOP

  DO JM=0,KN
    DO JFIELD=1,KFIELD
      ISP=KASM0(JM)+(KN-JM)*2
      ZSPECI(JFIELD,JM)=PSPECI(JFIELD,ISP)
    ENDDO
  ENDDO
  DO JM=-KN,-1
    DO JFIELD=1,KFIELD
      ISP=KASM0(ABS(JM))+(KN-ABS(JM))*2+1
      ZSPECI(JFIELD,JM)=PSPECI(JFIELD,ISP)
    ENDDO
  ENDDO

  CALL MXMAOP(ZRC,1,KSMXSUR,&
   & ZSPECI(1,0),KFLDSUR,1,&
   & ZSPECF(1,0),KFLDSUR,1,&
   & IN1+1,IN2+1,KFIELD)  
  CALL MXMAOP(ZRIC(1+KN-IN1,1+KN-IN2),1,KSMXSUR,&
   & ZSPECI(1,-IN2),KFLDSUR,1,&
   & ZSPECF(1,-IN1),KFLDSUR,1,&
   & IN1,IN2,KFIELD)  

  DO JM=0,KN
    DO JFIELD=1,KFIELD
      ISP=KASM0(JM)+(KN-JM)*2
      PSPECF(JFIELD,ISP)=ZSPECF(JFIELD,JM)
    ENDDO
  ENDDO
  DO JM=-KN,-1
    DO JFIELD=1,KFIELD
      ISP=KASM0(ABS(JM))+(KN-ABS(JM))*2+1
      PSPECF(JFIELD,ISP)=ZSPECF(JFIELD,JM)
    ENDDO
  ENDDO

ENDIF

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

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

