SUBROUTINE SPORTS(KULROT,KULOUT,KFIELD,KFLDSUR,&
 & KNSMIN,KNSMAX,KASM0,KSPEC2,KUMCP,KMYMS,&
 & KTYP2,CDNOM,PSPECI,PSPECF)  

!**** *SPORTS* - Organisation of rotations in spectral space, for
!                each total wave number IJN. Reading of rotation
!                matrices is made on a LFI file.

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

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

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

!      KULROT      - Logical unit number where rotations matrices     (INPUT)
!                    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)
!      KASM0       - KASM0(JM): index of the coefficient              (INPUT)
!                    corresponding to the wave number (m=JM,n=JM)
!      KSPEC2      - Dimension for spectral arrays (PSPECI,PSPECF).   (INPUT)
!      KUMCP       - Number of spectral waves handled by this         (INPUT)
!                    processor for KNSMAX
!      KMYMS       - actual wave numbers handled by this processor    (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.
!      CDNOM       - Name for logical unit KULROT.                    (INPUT)
!      PSPECI      - Fields before rotation.                          (INPUT)

!      PSPECF      - Fields after rotation.                           (OUTPUT)

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

!     Method.
!     -------

!     Externals:
!     ----------
!       Calls LFIOUV, SPROTA, LFIFER.
!       Called by TRAGEO.

!     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.
!        Modification by D. Giard : July 1994
!         (matrix files opened/closed earlier/later or not : LDOPEN)
!        Modified by L. Isaksen 95-06-06 : Reordering of spectral arrays
!        Modified : 01-08-07 by R. El Khatib - Pruning options
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        K.Yessad : Jan 2004  Debug
!     ------------------------------------------------------------------

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),INTENT(IN)    :: KUMCP 
INTEGER(KIND=JPIM)               :: KULROT ! UNDETERMINED INTENT
INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFIELD 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KNSMIN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KASM0(0:KNSMAX) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KMYMS(1:KUMCP) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTYP2 
CHARACTER(LEN=7)  ,INTENT(IN)    :: CDNOM 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSPECI(KFLDSUR,KSPEC2) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSPECF(KFLDSUR,KSPEC2) 

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

INTEGER(KIND=JPIM) :: INAR, INARI, IRP, ISMXSUR, JNLOC, IJN
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "sprota.intfb.h"

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

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

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

!        1.    DUMMY ARGUMENTS CHECKING.
!        -------------------------------

! * KNSMIN,KNSMAX,KTYP2:
IF (KNSMAX < KNSMIN) THEN
  KNSMIN=KNSMAX
  WRITE (KULOUT,'(A)')' WARNING: KNSMIN CHANGED; KNSMIN=KNSMAX.'
ENDIF
IF (IABS(KTYP2) > 1) THEN
  WRITE (KULOUT,'(A)')' FATAL  : KTYP2 MUST BE EQUAL TO -1,0 OR 1.'
  CALL ABOR1('SPORTS: ABOR1 CALLED')
ENDIF
IF (KTYP2 == 0.AND.KNSMAX /= KNSMIN) THEN
  WRITE (KULOUT,'(A)')' FATAL  : IF KTYP2=0, KNSMAX MUST BE EQUAL TO KNSMIN.'
  CALL ABOR1('SPORTS: ABOR1 CALLED')
ENDIF
IF (KTYP2 /= 0.AND.KNSMAX == KNSMIN) THEN
  WRITE (KULOUT,'(A)')' FATAL  : IF KNSMAX=KNSMIN, KTYP2 MUST BE EQUAL TO 0.'
  CALL ABOR1('SPORTS: ABOR1 CALLED')
ENDIF
! * KFLDSUR:
IF (KFLDSUR < KFIELD) THEN
  WRITE (KULOUT,'(A)')&
   & ' FATAL  : KFLDSUR MUST BE GREATER OR EQUAL THAN KFIELD.'  
  CALL ABOR1('SPORTS: ABOR1 CALLED')
ELSEIF (MOD(KFLDSUR,2) == 0) THEN
  WRITE (KULOUT,'(A)')&
   & ' WARNING: KFLDSUR=ODD NUMBER WOULD BE BETTER FOR OPTIMIZATION.'  
ENDIF

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

!        2.    ROTATIONS.
!        ----------------

IRP=0
INARI=0
ISMXSUR=KNSMAX+1+MOD(KNSMAX,2)
INAR=2*KNSMAX

CALL LFIOUV(IRP,KULROT,.TRUE.,CDNOM,'UNKNOWN',.TRUE.,.FALSE.,1,INAR,INARI)

DO JNLOC=1,KUMCP
  IJN=KMYMS(JNLOC)
  CALL SPROTA(KULROT,KULOUT,KFIELD,KFLDSUR,KNSMIN,KNSMAX,&
   & ISMXSUR,KASM0,IJN,KSPEC2,KTYP2,PSPECI,PSPECF)  
ENDDO

CALL LFIFER(IRP,KULROT,'UNKNOWN')

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

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

