SUBROUTINE RECFIL(KTYP,KORDER,PTAUC,PSTEP,KSTEP,PW,PFW)

!**** *RECFIL* -  Computing recursive DFI weights

!     Purpose :  Computes filtering weights used during digital
!     -------    filter integration : recursive filters

!** Interface :
!   ----------
!              *CALL* *RECFIL(KTYP,KORDER,PTAUC,PSTEP,KSTEP,PW,PFW)*

!              Explicit arguments :
!              -------------------
! KTYP   : type of filter : 1 Quick-Start  2 Flat-Delay  3 Butterworth
! KORDER : order of filter
! PTAUC  : cut-off period
! PSTEP  : time-step
! KSTEP  : number of time-steps
! PW     : basic weights ->  y(n)= f[ x(n),x(n-i),y(n-i) i<=KORDER ]
!    PW(i)= weight of x(n+1-i) i=1,N+1
!    PW(N+1+i)= weight of y(n-i) i=1,N
!    PW(2*N+2)= delay of the corresponding prototype filter (theorical)
!    PW(2*N+3)= delay of the corresponding prototype filter (effective)
! PFW    : final weights ->  y(n)= g[ x(n-i), 0<=i<=KSTEP ]
!    PFW(i)= weight of x(i-1) i=1,KSTEP+1

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

!     Method : see reference
!     ------

!     Externals : None.
!     ---------

!     Reference :     Documentation of ARPEGE/ALADIN
!     ---------       HIRLAM Technical Report nr 10

!     Author :        D. Giard    *CNRM/GMAP*
!     ------

!     Modifications :
!     -------------
!        Original : 93-08-26 , from SUFW (second-order filters)
!        D. Giard : 93-12-08  higher orders
!        D. Giard : 94-10-18  effective delay
!        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)    :: KTYP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KORDER 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAUC 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSTEP 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTEP 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PW(43) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFW(181) 
REAL(KIND=JPRB) :: ZFW(0:KSTEP,0:KORDER),ZW(2*KORDER+1)
REAL(KIND=JPRB) :: ZC(0:KORDER,0:KORDER)
REAL(KIND=JPRB) :: ZN(0:KORDER),ZMU(0:KORDER)
REAL(KIND=JPRB) :: ZS(0:KORDER/2),ZT(0:KORDER/2),ZD(0:KORDER)

INTEGER(KIND=JPIM) :: IORDR, J, JJP, JK, JL, JN

REAL(KIND=JPRB) :: Z1, Z2, Z3, ZDL, ZG, ZGAMMA, ZM, ZMUC, ZP,&
 & ZPI, ZPISUR2N, ZSIGMA, ZTAU, ZZ  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!* 1. Preliminaries

! Weights reset to 0.
IF (LHOOK) CALL DR_HOOK('RECFIL',0,ZHOOK_HANDLE)
DO J=1,42
  PW(J)= 0.0_JPRB
ENDDO
DO J=1,181
  PFW(J)= 0.0_JPRB
ENDDO
DO JN=0,KORDER
  DO J=0,KSTEP
    ZFW(J,JN)= 0.0_JPRB
  ENDDO
ENDDO
! Constants
ZPI=2.0_JPRB*ASIN(1.0_JPRB)
ZTAU= PTAUC/(2.0_JPRB*ZPI)
ZMUC= TAN(0.5_JPRB*PSTEP/ZTAU)
! c(p,n)=n!/p!(n-p)!
DO JN=0,KORDER
  DO J=0,KORDER
    ZC(J,JN)= 0.0_JPRB
  ENDDO
ENDDO
ZC(0,0)= 1.0_JPRB
ZC(0,1)= 1.0_JPRB
ZC(1,1)= 1.0_JPRB
IF (KORDER > 1) THEN
  DO JN=2,KORDER
    DO J=1,JN/2
      ZC(J,JN)= ZC(J-1,JN-1) + ZC(J,JN-1)
      ZC(JN-J,JN)= ZC(J,JN)
    ENDDO
    ZC(0,JN)= 1.0_JPRB
    ZC(JN,JN)= 1.0_JPRB
  ENDDO
ENDIF

!* 2. Second-order Flat-Delay (Bessel) filter

IF (KTYP == 2.AND. KORDER == 2) THEN
! Basic weights
  ZGAMMA= (SQRT(5._JPRB)+1.0_JPRB)/2.0_JPRB
  ZG= SQRT(3._JPRB*ZGAMMA)
  Z1= ZGAMMA*ZMUC*ZMUC
  Z2= ZG*ZMUC
  Z3= Z1/(Z1+Z2+1.0_JPRB)
  PW(1)= Z3
  PW(2)= 2.0_JPRB*Z3
  PW(3)= Z3
  PW(4)= -2.0_JPRB*(Z1-1.0_JPRB)/(Z1+Z2+1.0_JPRB)
  PW(5)= -(Z1-Z2+1.0_JPRB)/(Z1+Z2+1.0_JPRB)
  PW(6)= ZTAU*3._JPRB/ZG
! Final weights (start)
  ZFW(0,2)= 1.0_JPRB
  ZFW(0,1)= 1.0_JPRB
  ZFW(1,1)= 0.0_JPRB
ENDIF

!* 3. Preliminaries for Butterworth filters

IF (KTYP == 3) THEN
! zmu(p)= muc**p
  ZMU(0)= 1.0_JPRB
  DO J=1,KORDER
    ZMU(J)= ZMU(J-1)*ZMUC
  ENDDO
! zs(p)= (-1)**(p+1) *sin(p pi/2) / sin(p pi/2n)  (0 if p even) (n=order)
  DO J=0,KORDER/2,2
    ZS(J)= 0.0_JPRB
  ENDDO
! zn(p)= (-1)**p
  ZN(0)= 1.0_JPRB
  DO J=1,KORDER
    ZN(J)= -ZN(J-1)
  ENDDO
ENDIF

!* 4. Any-order Quick-Start or Butterworth filters

IF (KTYP == 1.OR.KTYP == 3) THEN
! Final weights (start)
  ZFW(0,KORDER)= 1.0_JPRB
  DO JN=1,KORDER
    IORDR= KORDER-JN
    IF (KTYP == 1) THEN
! Basic weights for n<=KORDER : Quick-Start
      ZSIGMA= 1.0_JPRB/SQRT(2.0_JPRB**(1.0_JPRB/REAL(JN,JPRB))-1.0_JPRB)
      Z1= ZMUC*ZSIGMA
      Z2= Z1/(1.0_JPRB+Z1)
      Z3= (1.0_JPRB-Z1)/(1.0_JPRB+Z1)
!C zw(p)= a(p)= c(p,n)*[(sigma*muc)/(1+sigma*muc)]**n
!C zw(p+n+1)= b(p)= -c(p,n)*[-(1-sigma*muc)/(1+sigma*muc)]**p
      ZW(1)= Z2**JN
      ZZ= -1.0_JPRB
      DO J=1,JN
        ZW(J+1)= ZW(1)*ZC(J,JN)
        ZZ= -ZZ*Z3
        ZW(J+JN+1)= ZZ*ZC(J,JN)
      ENDDO
    ELSEIF (KTYP == 3) THEN
! Basic weights for n<=KORDER : Butterworth
      ZPISUR2N= ZPI/(2.0_JPRB*REAL(JN,JPRB))
      ZT(0)= 1.0_JPRB
      IF (JN > 1) THEN
!C zs(p)= (-1)**(p+1) *sin(p pi/2) / sin(p pi/2n)  (p odd)
        DO J=1,JN/2,2
          ZS(J)= ZN(J/2)/SIN(REAL(J,JPRB)*ZPISUR2N)
        ENDDO
!C zt(p) for transfer function h: 1/h(s)=sum{ zt(p)*[s**p + s**(n-p)] ,p=0,n/2}
        DO J=1,JN/2
          ZZ=0.0_JPRB
          DO JJP=1,J,2
            ZZ=ZZ+ZS(JJP)*ZT(J-JJP)
          ENDDO
          ZT(J)= ZZ/REAL(J,JPRB)
        ENDDO
        IF (MOD(JN,2) == 0) ZT(JN/2)= ZT(JN/2)/2.0_JPRB
      ENDIF
!C zd(p) for H(z)= h( (z-1)/(z+1)/muc )
!C  H(z)= [muc*(z+1)]**n / sum{ zd(p)* z**(n-p) , p=0,n}
      DO J=0,JN/2
        ZP= 0.0_JPRB
        IF (JN /= 2*J) ZM= 0.0_JPRB
        DO JJP=0,JN/2
          ZZ= 0.0_JPRB
          IF (MIN(JJP,J/2) >= JJP-(JN-J)/2) THEN
            DO JL=MAX(0,JJP-(JN-J)/2),MIN(JJP,J/2)
              ZZ= ZZ + ZN(JL)*ZC(J-2*JL,JN-2*JJP)*ZC(JJP-JL,JJP)
            ENDDO
          ENDIF
          ZP=ZP+ZT(JJP)*ZZ*(ZN(J)*ZMU(JJP)+ZMU(JN-JJP))
          IF (JN /= 2*J)&
           & ZM=ZM+ZT(JJP)*ZZ*(ZN(J)*ZN(JN-JJP)*ZMU(JJP)+ZN(JJP)*&
           & ZMU(JN-JJP))  
        ENDDO
        ZD(J)= ZP
        IF (JN /= 2*J) ZD(JN-J)= ZM
      ENDDO
!C zw(p)= a(p)= c(p,n)*zmuc**n / zd(0)
!C zw(p+n+1)= b(p)= -zd(p)/zd(0)
      ZW(1)= ZMU(JN)/ZD(0)
      DO J=1,JN
        ZW(J+1)= ZW(1)*ZC(J,JN)
        ZW(J+JN+1)= -ZD(J)/ZD(0)
      ENDDO
    ENDIF
! Final weights (start)
    IF (JN < KORDER) THEN
      ZFW(JN,IORDR)= ZW(1)
      DO J=0,JN-1
        ZFW(J,IORDR)= ZW(JN-J+1)
        DO JK=1,MIN(JN,JN-J)
          ZFW(J,IORDR)=ZFW(J,IORDR)+ZW(JK+JN+1)*ZFW(J,IORDR+JK)
        ENDDO
      ENDDO
    ENDIF
  ENDDO
! Basic weights for n=KORDER (stored)
  DO J=1,2*KORDER+1
    PW(J)= ZW(J)
  ENDDO
! Delay for n=KORDER
  IF (KTYP == 1) PW(2*KORDER+2)= ZTAU*REAL(KORDER,JPRB)/ZSIGMA
  IF (KTYP == 3) PW(2*KORDER+2)= ZTAU/SIN(ZPISUR2N)
ENDIF

!* 5. Final weights

IF (KSTEP >= KORDER) THEN
  DO JN=KORDER,KSTEP
    DO J=0,JN-1
      IF (J >= JN-KORDER) THEN
        ZFW(J,0)= PW(JN-J+1)
      ELSE
        ZFW(J,0)= 0.0_JPRB
      ENDIF
      DO JK=1,MIN(KORDER,JN-J)
        ZFW(J,0)= ZFW(J,0) + PW(JK+KORDER+1)*ZFW(J,JK)
      ENDDO
    ENDDO
    ZFW(JN,0)= PW(1)
    DO JK=KORDER,1,-1
      DO J=0,JN
        ZFW(J,JK)= ZFW(J,JK-1)
      ENDDO
    ENDDO
  ENDDO
ENDIF
ZDL= 0.0_JPRB
DO J=0,KSTEP
  ZDL= ZDL + ZFW(J,0)*REAL(KSTEP-J,JPRB)
  PFW(J+1)= ZFW(J,0)
ENDDO
PW(2*KORDER+3)= ZDL*PSTEP

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

