SUBROUTINE SCINIM(KSMAX,KM,PA,PD,PK,PB,PQ,PEPS,PF0,PF1,PFP0,PFP1,PFP2)

!**** *SCINIM* - Set up matrix describing evolution of lin. S.W.M.

!     Purpose.   To compute the matrix decribing the evolution of
!     --------   a shallow water model linearized around a state
!                of rest.

!**   Interface.
!     ----------
!        *CALL* *SCINIM(KSMAX,KM,PA,PD,PK,PB,PQ,PEPS,PF0,PF1,*
!                       PFP0,PFP1,PFP2)                     *

!        Explicit arguments :  KSMAX - triangular truncation (input)
!        --------------------  KM    - zonal wave number (input)
!                              PA    - matrix describing evol. (output)
!                              PD    -|
!                              PK    -|
!                              PB    -| - help arrays (see doc) (input)
!                              PQ    -|
!                              PEPS  -|
!                              PF0   - expansion of CORIOLIS par. (input)
!                              PF1   - expansion of CORIOLIS par. (input)
!                                f = RCOR0 + RCOR1*(RMU*SQRT(3)) = PF0 + PF1*RMU
!                              PFP0  - expansion of map factor (input)
!                              PFP1  - expansion of map factor (input)
!                              PFP2  - expansion of map factor (input)
!                                F' = PFP0 + PFP1*RMU + PFP2*RMU*RMU

!        Implicit arguments :  NONE.
!        --------------------

!     Method.
!     -------

!     Externals.  NONE.
!     ----------

!     Reference.
!     ----------
!        ECMWF Research Department documentation of the IFS
!      P.Courtier and J.F. Geleyn: A global model with varaible
!      resolution. Application to a shallow-water model.
!      Qua.J.Roi.Met.Soc. 1988.

!     Author.
!     -------
!        Mats Hamrud and Philippe Courtier  *ECMWF*

!     Modifications.
!     --------------
!        Original : 88-05-25
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!     ------------------------------------------------------------------

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KSMAX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KM 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PA(3*(KSMAX-KM+1),3*(KSMAX-KM+1)) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PD(-1:KSMAX+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PK(0:KSMAX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PB(0:KSMAX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(0:KSMAX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEPS(0:KSMAX) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PF0 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PF1 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFP0 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFP1 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFP2 
INTEGER(KIND=JPIM) :: IDIV, ILIG, IORDR, IPHI, IVOR, JCH, JN
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

!*       1.    COMPUTE MATRIX.
!              ----------------

IF (LHOOK) CALL DR_HOOK('SCINIM',0,ZHOOK_HANDLE)
IORDR=3*(KSMAX-KM+1)
DO JN=KM,KSMAX
  DO JCH=1,3
    ILIG=JCH+3*(JN-KM)
    IVOR=1+3*(JN-KM)
    IDIV=2+3*(JN-KM)
    IPHI=3+3*(JN-KM)

!*       1.1   VORTICITY IMAGE.

    IF(JCH == 1)THEN
      PA(ILIG,IVOR)=PK(JN)*PF1
      PA(ILIG,IDIV)=PF0
      IF(IDIV+3 <= IORDR) PA(ILIG,IDIV+3)=PQ(JN)*PF1
      IF(IDIV-3 >= 1) PA(ILIG,IDIV-3)=PB(JN)*PF1

!*       1.2   DIVERGENCE IMAGE.

    ELSEIF(JCH == 2)THEN
      PA(ILIG,IDIV)=PK(JN)*PF1
      PA(ILIG,IVOR)=PF0
      PA(ILIG,IPHI)=PEPS(JN)
      IF(IVOR+3 <= IORDR) PA(ILIG,IVOR+3)=PQ(JN)*PF1
      IF(IVOR-3 >= 1) PA(ILIG,IVOR-3)=PB(JN)*PF1

!*       1.3   GEOPOTENTIAL IMAGE.

    ELSEIF(JCH == 3)THEN
      PA(ILIG,IDIV)=PEPS(JN)*(1.0_JPRB+(PD(JN)**2+PD(JN+1)**2)*PFP2/PFP0)
      IF(IDIV+3 <= IORDR) PA(ILIG,IDIV+3)=PEPS(JN)*PFP1/PFP0*PD(JN+1)
      IF(IDIV+6 <= IORDR) PA(ILIG,IDIV+6)=PEPS(JN)*PFP2/PFP0*&
       & PD(JN+1)*PD(JN+2)  
      IF(IDIV-3 >= 1) PA(ILIG,IDIV-3)=PEPS(JN)*PFP1/PFP0*PD(JN)
      IF(IDIV-6 >= 1) PA(ILIG,IDIV-6)=PEPS(JN)*PFP2/PFP0*PD(JN)*PD(JN-1)
    ENDIF

  ENDDO
ENDDO

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

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

