SUBROUTINE SPDICOAD(KULDICO,KULOUT,KFIELD,KFLDSUR,&
 & KNSMAX,KSMXSUR,KASM0,KSPEC2,&
 & KNCMAX,KCMXSUR,KACM0,KCPEC2,&
 & KM,KDIR,PSPECS,PSPECC)  

!**** *SPDICOAD* - Dilatations in spectral space, for
!                  the zonal wave number KM: adjoint. Reading of dilatation
!                  matrices is made on a LFI file.

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

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

!        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)
!      KSMXSUR     - Odd number above KNSMAX+1.                       (INPUT)
!      KASM0       - KASM0    : index of the coefficient              (INPUT)
!                    corresponding to the wave number (m=KM,n=KM)
!                    for the smaller truncation.
!      KSPEC2      - Dimension for the spectral array PSPECS.         (INPUT)
!      KNCMAX      - Larger truncation.                               (INPUT)
!      KCMXSUR     - Odd number above KNCMAX+1.                       (INPUT)
!      KACM0       - KACM0    : index of the coefficient              (INPUT)
!                    corresponding to the wave number (m=KM,n=KM)
!                    for the larger truncation.
!      KCPEC2      - Dimension for the spectral array PSPECC.         (INPUT)
!      KM          - Wave number.                                     (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 dilalation.              (OUTPUT)

!      IF KDIR = -1:

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

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

!     Method.
!     -------

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

!     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.
!        Modified : 95-06-06 L.Isaksen   Reordering of spectral arrays
!        Modified : 95-09-06 D. Giard    corrections
!        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)    :: KNCMAX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCPEC2 
INTEGER(KIND=JPIM)               :: KULDICO ! UNDETERMINED INTENT
INTEGER(KIND=JPIM)               :: KULOUT ! Argument NOT used
INTEGER(KIND=JPIM),INTENT(IN)    :: KFIELD 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSMXSUR 
INTEGER(KIND=JPIM),INTENT(IN)    :: KASM0(0:KNSMAX) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCMXSUR 
INTEGER(KIND=JPIM),INTENT(IN)    :: KACM0(0:KNCMAX) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KM 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDIR 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPECS(KFLDSUR,KSPEC2) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSPECC(KFLDSUR,KCPEC2) 

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

REAL(KIND=JPRB) :: ZDICO(KCMXSUR,KSMXSUR)
REAL(KIND=JPRB) :: ZDICOLU((KNSMAX+1)*(KNCMAX+1))
REAL(KIND=JPRB) :: ZSPECS(KSMXSUR,2*KFIELD),ZSPECC(KCMXSUR,2*KFIELD)
CHARACTER (LEN = 16) ::  CLDICO
INTEGER(KIND=JPIM) :: IND, IRP, ISP, JC, JFIELD, JN, JS
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

INTERFACE
#include "mxmaop.h"
END INTERFACE

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

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

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

IRP=0
WRITE (CLDICO,'(A,I5.4)') 'WNUM',KM
CALL LFILEC(IRP,KULDICO,CLDICO,ZDICOLU(1),(KNSMAX+1-KM)*(KNCMAX+1-KM))

IF (KM == 0) THEN

!       CASE KM=0

  IND=-(KNCMAX+1)
  DO JS=1,KNSMAX+1
    IND=IND+KNCMAX+1
    DO JC=1,KNCMAX+1
      ZDICO(JC,JS)=ZDICOLU(IND+JC)
    ENDDO
  ENDDO

  IF (KDIR == 1) THEN

    DO JFIELD=1,KFIELD
      DO JN=0,KNCMAX
        ZSPECC(JN+1,JFIELD)=PSPECC(JFIELD,KACM0(0)+JN*2)
      ENDDO
    ENDDO

    CALL MXMAOP(ZDICO,KCMXSUR,1,&
     & ZSPECC,1,KCMXSUR,&
     & ZSPECS,1,KSMXSUR,&
     & KNSMAX+1,KNCMAX+1,KFIELD)  

    DO JFIELD=1,KFIELD
      DO JN=0,KNSMAX
        PSPECS(JFIELD,KASM0(0)+JN*2)=ZSPECS(JN+1,JFIELD)
      ENDDO
    ENDDO

  ELSEIF (KDIR == -1) THEN

    DO JFIELD=1,KFIELD
      DO JN=0,KNSMAX
        ZSPECS(JN+1,JFIELD)=PSPECS(JFIELD,KASM0(0)+JN*2)
      ENDDO
    ENDDO

    CALL MXMAOP(ZDICO,1,KCMXSUR,&
     & ZSPECS,1,KSMXSUR,&
     & ZSPECC,1,KCMXSUR,&
     & KNCMAX+1,KNSMAX+1,KFIELD)  

    DO JFIELD=1,KFIELD
      DO JN=0,KNCMAX
        PSPECC(JFIELD,KACM0(0)+JN*2)=ZSPECC(JN+1,JFIELD)
      ENDDO
    ENDDO

  ENDIF

ELSEIF (KM > 0) THEN

!       CASE KM=1 TO KNSMAX

  IND=-(KNCMAX+1-KM)
  DO JS=1,KNSMAX+1-KM
    IND=IND+KNCMAX+1-KM
    DO JC=1,KNCMAX+1-KM
      ZDICO(JC,JS)=ZDICOLU(IND+JC)
    ENDDO
  ENDDO

  IF (KDIR == 1) THEN

    DO JFIELD=1,KFIELD
      DO JN=KM,KNCMAX
        ISP=KACM0(KM)+(JN-KM)*2
        ZSPECC(JN+1-KM,2*JFIELD-1)=PSPECC(JFIELD,ISP+1)
        ZSPECC(JN+1-KM,2*JFIELD  )=PSPECC(JFIELD,ISP  )
      ENDDO
    ENDDO

    CALL MXMAOP(ZDICO,KCMXSUR,1,&
     & ZSPECC,1,KCMXSUR,&
     & ZSPECS,1,KSMXSUR,&
     & KNSMAX+1-KM,KNCMAX+1-KM,2*KFIELD)  

    DO JFIELD=1,KFIELD
      DO JN=KM,KNSMAX
        ISP=KASM0(KM)+(JN-KM)*2
        PSPECS(JFIELD,ISP+1)=ZSPECS(JN+1-KM,2*JFIELD-1)
        PSPECS(JFIELD,ISP  )=ZSPECS(JN+1-KM,2*JFIELD  )
      ENDDO
    ENDDO

  ELSEIF (KDIR == -1) THEN

    DO JFIELD=1,KFIELD
      DO JN=KM,KNSMAX
        ISP=KASM0(KM)+(JN-KM)*2
        ZSPECS(JN+1-KM,2*JFIELD-1)=PSPECS(JFIELD,ISP+1)
        ZSPECS(JN+1-KM,2*JFIELD  )=PSPECS(JFIELD,ISP  )
      ENDDO
    ENDDO

    CALL MXMAOP(ZDICO,1,KCMXSUR,&
     & ZSPECS,1,KSMXSUR,&
     & ZSPECC,1,KCMXSUR,&
     & KNCMAX+1-KM,KNSMAX+1-KM,2*KFIELD)  

    DO JFIELD=1,KFIELD
      DO JN=KM,KNCMAX
        ISP=KACM0(KM)+(JN-KM)*2
        PSPECC(JFIELD,ISP+1)=ZSPECC(JN+1-KM,2*JFIELD-1)
        PSPECC(JFIELD,ISP  )=ZSPECC(JN+1-KM,2*JFIELD  )
      ENDDO
    ENDDO

  ENDIF

ENDIF

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

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

