SUBROUTINE SUMCUF

! Purpose:
! --------
!   *SUMCUF*  - Setup of the parameters for the monitoring of 
!               update frequency of the coupling files for ALADIN

! Interface:
! ----------
!   *CALL* *SUMCUF*

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

! Method:
! -------
!   See documentation.

! Reference:
! ----------
!   Mon. Wea. Rev., 132, 2130-2141

! Author:
! -------
!   31-Aug-2004 Piet Termonia                    *RMI Belgium*

! Modicifations:
! --------------
!  Rachida El Ouaraini & Ryad El Khatib: 05-07-27 Add LREACUF to read CUF fields. 
!  Ryad El Khatib 27-Feb-2008 Bugfix
! End Modifications
!------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE PARMCUF   ,ONLY : JPMFNR   ,JPMFOR
USE YOMHOOK   ,ONLY : LHOOK    ,DR_HOOK
USE YOMDIM    ,ONLY : NSPEC2
USE YOMDYN    ,ONLY : TSTEP
USE YOMMCUF   ,ONLY : NCUFNR   ,NCUFOR   ,RMCUFA   ,RMCUFB   ,RMCUFSP  ,&
                     & RMCUFFP  ,LMCUF  ,LREACUF  ,RMCUFI
USE YOMLUN    ,ONLY : NULOUT   ,NULNAM
USE YOMCST    ,ONLY : RPI

IMPLICIT NONE

INTEGER(KIND=JPIM)              :: JOR      ,JNR      ,JA
INTEGER(KIND=JPIM)              :: IN       ,ICI      ,ICII
INTEGER(KIND=JPIM), ALLOCATABLE :: ICFC(:)  ,IBI(:)
REAL(KIND=JPRB)                 :: ZHOOK_HANDLE
REAL(KIND=JPRB)                 :: ZAMAX    ,ZF       ,ZOMC     ,ZARG     , &
                                &  ZD       ,ZTR      ,ZTI      ,ZTTR     , &
                                &  ZQ
REAL(KIND=JPRB),    ALLOCATABLE :: ZPOLER(:),ZPOLEI(:),ZPOLEN(:),ZFAC(:)  , &
                                &  ZBR(:)   ,ZBI(:)
LOGICAL                         :: LLCONT   ,LLJ

#include "abor1.intfb.h"
#include "posnam.intfb.h"
#include "nammcuf.h"
#include "sufpcuf.intfb.h"
!------------------------------------------------------------------

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

! 1. Defaults and namelist:
! -------------------------

LMCUF=.FALSE.
LREACUF=.FALSE.
NCUFNR=1
NCUFOR=2
RMCUFI=10800._JPRB

ZAMAX=99999._JPRB
DO JNR=1,JPMFNR
  RMCUFA(0,JNR)=2._JPRB*ZAMAX
  RMCUFA(1:JPMFOR,JNR)=0._JPRB
  RMCUFB(1:JPMFOR,JNR)=0._JPRB
ENDDO
CALL POSNAM(NULNAM,'NAMMCUF')
READ(NULNAM,NAMMCUF)

IF (.NOT.LMCUF) THEN
! Reset number of filters to zero -REK-
  NCUFNR=0
ENDIF

CALL SUFPCUF

WRITE(UNIT=NULOUT,FMT=*) 'NCUFNR=',NCUFNR,'NCUFOR=',NCUFOR,'LMCUF=',LMCUF,'LREACUF=',LREACUF
WRITE(UNIT=NULOUT,FMT=*) 'LMCUF =',LMCUF,'LREACUF=',LREACUF
WRITE(UNIT=NULOUT,FMT=*) 'RMCUFI=',RMCUFI

IF (NCUFOR>JPMFOR) CALL ABOR1('SUMCUF: maximum order of filter exceeded!')
IF (NCUFNR>JPMFNR) CALL ABOR1('SUMCUF: maximum nummer of filters exceeded!')
IF (LMCUF .AND. NCUFNR <= 0) CALL ABOR1('SUMCUF:LMCUF=T BUT NO FILTERS !')

! 2. Compute coefficients:
! ------------------------

ALLOCATE(ZPOLER(1:NCUFOR),ZPOLEI(1:NCUFOR),ZPOLEN(1:NCUFOR))
ALLOCATE(ZFAC(0:NCUFOR),ICFC(1:NCUFOR),IBI(0:NCUFOR))
ALLOCATE(ZBR(1:NCUFOR),ZBI(1:NCUFOR))
ZFAC(0)=1.0_JPRB
DO JOR=1,NCUFOR
  ZFAC(JOR)=REAL(JOR,JPRB)*ZFAC(JOR-1)
ENDDO
DO JNR=1,NCUFNR
  IF (RMCUFA(0,JNR) > ZAMAX) THEN
    WRITE(NULOUT,*) 'FILTER COEFFICIENTS COMPUTED FOR FILTER',JNR
    ZOMC=0.9_JPRB*RPI/RMCUFI(JNR)
    IN=1
    ZF=TAN(ZOMC*TSTEP*0.5_JPRB)
    DO JA=-NCUFOR+1,NCUFOR
      ZARG=RPI*REAL(2*JA-1,JPRB)/REAL(2*NCUFOR,JPRB)
      ZD=1._JPRB+ZF*ZF-2._JPRB*ZF*SIN(ZARG)
      ZPOLER(IN)=1._JPRB-ZF*ZF
      ZPOLER(IN)=ZPOLER(IN)/ZD
      ZPOLEI(IN)=2._JPRB*ZF*COS(ZARG)
      ZPOLEI(IN)=ZPOLEI(IN)/ZD
      ZPOLEN(IN)=ZPOLER(IN)**2+ZPOLEI(IN)**2 
      IF (ZPOLEN(IN) > 1._JPRB) IN=IN+1
    ENDDO
    DO JOR=1,NCUFOR
      ZBR(JOR)=0.0_JPRB
      ZBI(JOR)=0.0_JPRB
      ICFC(JOR)=0
      IBI(0)=NCUFOR
      DO ICI=1,JOR
        IBI(ICI)=ICI
      ENDDO
      LLCONT=.TRUE.
      DO WHILE(LLCONT)
        ZTR=1.0_JPRB
        ZTI=0.0_JPRB
        DO ICI=1,JOR
          ZTTR=-ZTR*ZPOLER(IBI(ICI))-ZTI*ZPOLEI(IBI(ICI))
          ZTTR=ZTTR/ZPOLEN(IBI(ICI))
          ZTI=-ZTI*ZPOLER(IBI(ICI))+ZTR*ZPOLEI(IBI(ICI))
          ZTI=ZTI/ZPOLEN(IBI(ICI))
          ZTR=ZTTR
        ENDDO
        ZBR(JOR)=ZBR(JOR)+ZTR
        ZBI(JOR)=ZBI(JOR)+ZTI
        ICFC(JOR)=ICFC(JOR)+1
        LLJ=.FALSE.
        DO ICI=1,JOR
          IF (IBI(ICI-1) < IBI(ICI)-1) THEN
            IBI(ICI-1)=IBI(ICI-1)+1
            DO ICII=1,ICI-2
              IBI(ICII)=ICII
            ENDDO
            LLJ=.TRUE.
            EXIT
          ENDIF
        ENDDO
        IF (.NOT.LLJ) THEN
          IF (IBI(JOR) < NCUFOR) THEN
            IBI(JOR)=IBI(JOR)+1
            DO ICI=1,JOR-1
              IBI(ICI)=ICI
            ENDDO
          ELSE
            LLCONT=.FALSE.
          ENDIF
       ENDIF
      ENDDO
    ENDDO
    DO JOR=1,NCUFOR
      RMCUFB(JOR,JNR)=ZBR(JOR)
    ENDDO
    ZQ=1._JPRB
    DO JOR=1,NCUFOR
      ZQ=ZQ+(-1._JPRB)**JOR*ZBR(JOR)
    ENDDO
    ZQ=-ZQ/REAL(2**NCUFOR,JPRB)
    DO JOR=0,NCUFOR
      RMCUFA(JOR,JNR)=ZQ*(-1._JPRB)**JOR*ZFAC(NCUFOR)
      RMCUFA(JOR,JNR)=RMCUFA(JOR,JNR)/ZFAC(JOR)
      RMCUFA(JOR,JNR)=RMCUFA(JOR,JNR)/ZFAC(NCUFOR-JOR)
    ENDDO
  ENDIF
ENDDO
DEALLOCATE(ZPOLER,ZPOLEI,ZPOLEN)
DEALLOCATE(ZFAC,ICFC,IBI)
DEALLOCATE(ZBR,ZBI)

! 3. Initialisation:
! ------------------

IF (LMCUF) THEN
  DO JNR=1,NCUFNR
    WRITE(UNIT=NULOUT,FMT=*) 'RMCUFA(',JNR,')=',RMCUFA(0:NCUFOR,JNR)
    WRITE(UNIT=NULOUT,FMT=*) 'RMCUFB(',JNR,')=',RMCUFB(1:NCUFOR,JNR)
  ENDDO
  ALLOCATE(RMCUFSP(1:NSPEC2,0:NCUFOR))
  ALLOCATE(RMCUFFP(1:NSPEC2,0:NCUFOR,1:NCUFNR))
  RMCUFSP(:,:)=0._JPRB
  RMCUFFP(:,:,:)=0._JPRB
ENDIF

IF (LHOOK) CALL DR_HOOK('SUMCUF',1,ZHOOK_HANDLE)

END SUBROUTINE SUMCUF
