SUBROUTINE SUFW

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

! HWREC,NORDFI,TAUP for RECFIL only
USE YOMDFI   , ONLY : HWOPF    ,HWOPFA   ,NTPDFI   ,&
 & NEDFI    ,NSTDFI   ,NSTDFIA  ,TAUS     ,&
 & TAUC     ,RTDFI    ,RTDFIA   ,LRECURS  ,HWF0     ,HWFA0

USE YOMCT0   , ONLY : LALLOPR
USE YOMDIM   , ONLY : NSPEC2
USE YOMLUN   , ONLY : NULOUT
USE YOMVAR   , ONLY : LJCDFI


!**** *SUFW* -  Initialization of DFI weights

!     Purpose :  Computes filtering weights used during
!     -------       digital filter initialization

!** Interface :
!   ----------
!              *CALL* *SUFW*

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

!              Implicit arguments :  Common YEMDFI
!              -------------------

!     Method.
!     ------
! recursive filter : y(n)= f[ x(n),x(n-i),y(n-i)  i<=NORDFI ]
!                        = g[ x(i)  0<=i<=2*NSTDFI ]         
! HWREC(i)         = weight of x(n-i) in f  i=1,NORDFI+1     
! HWREC(NORDFI+1+i)= weight of y(n-i) in f  i=1,NORDFI       
! HWREC(2*NORDFI+2)= delay (theor.)                          
! HWREC(2*NORDFI+3)= delay (effec.)                          
! HWOPF(NSPEC2,i)= weight of x(i-1) in g  i=1,2*NSTDFI+1            
! --> RECFIL (Quick-Start, Flat-Delay, Butterworth)          

! non-recursive filter : y(n)= f[ x(n+i) -N<=i<=N ]          
! HWOPF(NSPEC2,N+1+i)= weight of x(n-i) -N<=i<=N                    
! HWF0(N+1+i)= weight of x(n-i) -N<=i<=N
! --> SMPFIL (Ideal low-pass, with or without Lanczos window)
! --> OPTFIL (Optimal)                                       
! --> DOLFIL (Dolph-Chebyshev, as a filter or a window)                               

!     Externals : DOLFIL, OPTFIL, SMPFIL, RECFIL
!     ---------

!     Reference :     Documentation of ARPEGE/ALADIN
!     ---------

!     Author :        G. Radnoti    *GMAP/MICECO*
!     ------

!     Modifications :
!     -------------
!        Original : 92-12-24
!        D. Giard : 93-07-28 NSTDFI,NSTDFICL checked in SUDFI now
!                            RTDFI instead of TSTEP
!        D. Giard : 93-08-26 call to SIMPFIL ; second-order recursive filters
!        D. Giard : 93-10-26 higher order recursive filters
!        D. Giard : 95-02-20 adiabatic timestep and weights
!        D. Giard : 95-04-10 doctor form for OPTFIL
!        D. Giard : 96-01-18 Dolph-Chebyshev filters (DOLFIL)
!                            SIMPFIL-> SMPFIL; call to OPTFIL changed
!                            filter type now defined by NTPDFI
!                            no more filtering of boundary fields
!        P.Gauthier:99-10-07 Dolph-Chebyshev window added (NTPDFI = 5) 
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        P. Termonia : 08-Dec-2008 modifs for SSDFI
!----------------------------------------------------------------------

IMPLICIT NONE

!! REAL(KIND=JPRB) :: ZWA(43) ! (for RECFIL only)

INTEGER(KIND=JPIM) :: J, JI

LOGICAL :: LLADFIL, LLPRINT

REAL(KIND=JPRB) :: ZS
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"
#include "dolfil.intfb.h"
!! #include "optfil.intfb.h"
!! #include "recfil.intfb.h"
#include "smpfil.intfb.h"

!----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('SUFW',0,ZHOOK_HANDLE)
!----------------------------------------------------------------------

! More details about filters ...
LLPRINT = NEDFI == 0

! ALLOCATE THE ARRAYS OF THE WEIGHTS

IF (ALLOCATED(HWOPF)) THEN
  WRITE(NULOUT,*) ' SUFW: HWOPF deallocated then reallocated '
  DEALLOCATE(HWOPF)
ENDIF
ALLOCATE(HWOPF(NSPEC2,2*NSTDFI+1))
IF (LALLOPR) WRITE(NULOUT,9990) 'HWOPF    ',SIZE(HWOPF),SHAPE(HWOPF)

IF (ALLOCATED(HWOPFA)) THEN
  WRITE(NULOUT,*) ' SUFW: HWOPFA deallocated then reallocated '
  DEALLOCATE(HWOPFA)
ENDIF
ALLOCATE(HWOPFA(NSPEC2,2*NSTDFIA+1))
IF (LALLOPR) WRITE(NULOUT,9990) 'HWOPFA   ',SIZE(HWOPFA),SHAPE(HWOPFA)

IF (ALLOCATED(HWF0)) THEN
  WRITE(NULOUT,*) ' SUFW: HWF0 deallocated then reallocated '
  DEALLOCATE(HWF0)
ENDIF
ALLOCATE(HWF0(2*NSTDFI+1))
IF (LALLOPR) WRITE(NULOUT,9990) 'HWF0     ',SIZE(HWF0),SHAPE(HWF0)

IF (ALLOCATED(HWFA0)) THEN
  WRITE(NULOUT,*) ' SUFW: HWFA0 deallocated then reallocated '
  DEALLOCATE(HWFA0)
ENDIF
ALLOCATE(HWFA0(2*NSTDFIA+1))
IF (LALLOPR) WRITE(NULOUT,9990) 'HWFA0    ',SIZE(HWFA0),SHAPE(HWFA0)

! Diabatic steps
IF (LRECURS) THEN
  CALL ABOR1(' SUFW: RECFIL NOT IMPLEMENTED')
  ! CALL RECFIL(NTPDFI,NORDFI,TAUC,RTDFI,2*NSTDFI,HWREC,HWOPF(1,:))
ELSEIF (NTPDFI == 5) THEN
  CALL DOLFIL(TAUC,RTDFI,NSTDFI,.TRUE.,HWOPF,HWF0)
ELSEIF (NTPDFI == 4) THEN
  CALL DOLFIL(TAUS,RTDFI,NSTDFI,.FALSE.,HWOPF,HWF0)
ELSEIF (NTPDFI == 3) THEN
  CALL ABOR1(' SUFW: OPTFIL NOT IMPLEMENTED')
  ! CALL OPTFIL(TAUP,TAUS,RTDFI,NSTDFI,LLPRINT,HWOPF(1,:))
ELSEIF (NTPDFI == 2) THEN
  CALL SMPFIL(RTDFI,NSTDFI,.TRUE.,HWOPF,HWF0)
ELSE
  CALL SMPFIL(RTDFI,NSTDFI,.FALSE.,HWOPF,HWF0)
ENDIF

ZS= 0._JPRB
DO J=1,2*NSTDFI+1
  ZS= ZS + HWF0(J)
ENDDO
IF (ABS(ZS-1.0_JPRB) > 1.E-10_JPRB)&
 & CALL ABOR1(' SUFW : SUM OF WEIGHTS IS NOT 1 !')  
DO JI=1,NSPEC2
  ZS= 0._JPRB
  DO J=1,2*NSTDFI+1
    ZS= ZS + HWOPF(JI,J)
  ENDDO
  IF (ABS(ZS-1.0_JPRB) > 1.E-10_JPRB)&
   & CALL ABOR1(' SUFW : SUM OF WEIGHTS IS NOT 1 !')
ENDDO

! Adiabatic steps
LLADFIL= (NSTDFIA /= NSTDFI) .AND.&
 & (NEDFI == 0.OR.NEDFI == 4.OR.NEDFI == 5.OR.NEDFI == 7)  
IF (LLADFIL) THEN
  IF (LRECURS) THEN
    CALL ABOR1(' SUFW: RECFIL NOT IMPLEMENTED')
    ! CALL RECFIL(NTPDFI,NORDFI,TAUC,RTDFIA,2*NSTDFIA,ZWA,HWOPFA(1,:))
  ELSEIF (NTPDFI == 5) THEN
    CALL DOLFIL(TAUC,RTDFIA,NSTDFIA,.TRUE.,HWOPFA,HWFA0)
  ELSEIF (NTPDFI == 4) THEN
    CALL DOLFIL(TAUS,RTDFIA,NSTDFIA,.FALSE.,HWOPFA,HWFA0)
  ELSEIF (NTPDFI == 3) THEN
    CALL ABOR1(' SUFW: OPTFIL NOT IMPLEMENTED')
    ! CALL OPTFIL(TAUP,TAUS,RTDFIA,NSTDFIA,LLPRINT,HWOPFA(1,:))
  ELSEIF (NTPDFI == 2) THEN
    CALL SMPFIL(RTDFI,NSTDFIA,.TRUE.,HWOPFA,HWFA0)
  ELSE
    CALL SMPFIL(RTDFI,NSTDFIA,.FALSE.,HWOPFA,HWFA0)
  ENDIF

  ZS= 0._JPRB
  DO J=1,2*NSTDFIA+1
    ZS= ZS + HWFA0(J)
  ENDDO
  IF (ABS(ZS-1.0_JPRB) > 1.E-10_JPRB)&
   & CALL ABOR1(' SUFW : SUM OF ADIAB. WEIGHTS IS NOT 1 !')  
  DO JI=1,NSPEC2
    ZS= 0._JPRB
    DO J=1,2*NSTDFIA+1
      ZS= ZS + HWOPFA(JI,J)
    ENDDO
    IF (ABS(ZS-1.0_JPRB) > 1.E-10_JPRB)&
     & CALL ABOR1(' SUFW : SUM OF ADIAB. WEIGHTS IS NOT 1 !')
  ENDDO

ELSE
  HWOPFA(1:NSPEC2,1:2*NSTDFIA+1)=HWOPF(1:NSPEC2,1:2*NSTDFIA+1)
  HWFA0(1:2*NSTDFIA+1)=HWF0(1:2*NSTDFIA+1)
ENDIF

! PRINTINGS:

IF (LJCDFI .OR. NEDFI == 0)&
 & WRITE(NULOUT,'('' DFI WEIGHTS (HWF0):'',/,(10E11.3E2))')&
 & (HWF0(J),J=1,2*NSTDFI+1)
IF (NEDFI == 0.AND. NSTDFIA /= NSTDFI)&
 & WRITE(NULOUT,'('' ADIAB. WEIGHTS (HWFA0):'',/,(10E11.3E2))')&
 & (HWFA0(J),J=1,2*NSTDFIA+1)

!----------------------------------------------------------------------
9990 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
!----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('SUFW',1,ZHOOK_HANDLE)
END SUBROUTINE SUFW
