SUBROUTINE SPODTSAD(KULDICO,KULOUT,KFIELD,KFLDSUR,&
 & KNSMAX,KASM0,KSPEC2,KUMTP,KNCMAX,KACM0,KCPEC2,&
 & KMYMS,KDIR,PSPECS,PSPECC)  

!**** *SPODTSAD* - Organisation of dilatations in spectral space, for
!                  each zonal wave number IJM: adjoint. Reading of dilatation
!                  matrices is made on a LFI file.

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

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

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

!      KULDICO     - Logical unit number where dilatation 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)
!      KNSMAX      - Smaller truncation.                              (INPUT)
!      KASM0       - KASM0(JM): index of the coefficient              (INPUT)
!                    corresponding to the wave number (m=JM,n=JM)
!                    for the smaller truncation.
!      KSPEC2      - Dimension for the spectral array PSPECS.         (INPUT)
!      KUMTP       - Number of spectral waves handled by this         (INPUT)
!                    processor for KNSMAX
!      KNCMAX      - Larger truncation.                               (INPUT)
!      KACM0       - KACM0(JM): index of the coefficient              (INPUT)
!                    corresponding to the wave number (m=JM,n=JM)
!                    for the larger truncation.
!      KCPEC2      - Dimension for the spectral array PSPECC.         (INPUT)
!      KMYMS       - actual wave numbers handled by this processor    (INPUT)
!      KDIR        - KDIR=1:  Adjoint of dilatation.                  (INPUT)
!                    KDIR=-1: Adjoint of contraction.

!      IF KDIR = 1:

!      PSPECC      - Fields before adjoint of dilatation.             (INPUT)
!      PSPECS      - Fields after adjoint of dilatation.              (OUTPUT)

!      IF KDIR = -1:

!      PSPECS      - Fields before adjoint of contraction.            (INPUT)
!      PSPECC      - Fields after adjoint of contraction.             (OUTPUT)

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

!     Method.
!     -------

!     Externals:
!     ----------
!       Calls LFIOUV, SPDICOAD, LFIFER.
!       Called by TRAGEOAD.

!     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 : 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
!        R. El Khatib : 01-08-07 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)    :: KUMTP
INTEGER(KIND=JPIM),INTENT(IN)    :: KNCMAX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCPEC2 
INTEGER(KIND=JPIM)               :: KULDICO ! UNDETERMINED INTENT
INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFIELD 
INTEGER(KIND=JPIM),INTENT(IN)    :: KASM0(0:KNSMAX) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KACM0(0:KNCMAX) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KMYMS(1:KUMTP)
INTEGER(KIND=JPIM),INTENT(IN)    :: KDIR 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPECS(KFLDSUR,KSPEC2) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPECC(KFLDSUR,KCPEC2) 

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

INTEGER(KIND=JPIM) :: ICMXSUR, INAR, INARI, IRP, ISMXSUR, IJM, JMLOC
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "spdicoad.intfb.h"

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

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

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

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

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

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

!        2.    DILATATIONS OR CONTRACTIONS.
!        ----------------------------------

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

IF (KDIR == 1) THEN
  CALL LFIOUV(IRP,KULDICO,.TRUE.,'MATDILA','UNKNOWN',.TRUE.,&
   & .FALSE.,1,INAR,INARI)  
ELSEIF (KDIR == -1) THEN
  CALL LFIOUV(IRP,KULDICO,.TRUE.,'MATCONT','UNKNOWN',.TRUE.,&
   & .FALSE.,1,INAR,INARI)  
ENDIF

DO JMLOC=1,KUMTP
  IJM=KMYMS(JMLOC)

  CALL SPDICOAD(KULDICO,KULOUT,KFIELD,KFLDSUR,&
   & KNSMAX,ISMXSUR,KASM0,KSPEC2,&
   & KNCMAX,ICMXSUR,KACM0,KCPEC2,&
   & IJM,KDIR,PSPECS,PSPECC)  

ENDDO

CALL LFIFER(IRP,KULDICO,'UNKNOWN')

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

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

