SUBROUTINE MEANUV_WEIGHTSAD(KDLEN,KLEN,KDCOUNT,KLEV,CD_COBS_OPER,PTAU,&
 & PVPOBS,PPRESF5,PPRESF,PSIGMA,PW5,PW)  

!**** *MEANUV_WEIGHTSAD*   Calculate weights for SATOB/AMV obs operator

!  N. Bormann     09/10/2009    ECMWF

!     PURPOSE
!     -------

!     Calculates the weights used in the layer-mean observation 
!     operator H for SATOB/AMVs. The observation operator calculates the
!     integral of f * v, with v the wind profile, and f a suitable weighting
!     function. The weights PW are calculated so that H can be written
!     as H(V) = DOT_PRODUCT(PW*V) in discretised form. 

!**   INTERFACE
!     ---------
!     *CALL* *MEANUV_WEIGHTSAD
!     WHERE KDLEN  = First dimension: Max number of members in set
!           KLEN   = Actual number of members
!           KDCOUNT = Second dimension (Data per observations)
!           KLEV   = Number of pressure levels
!           COBS_OPER= Method used for weight calculation
!           PTAU   = Transmittances on RTTOV levels
!           PVPOBS = SATOB/AMV pressure
!           PPRESF5  = Pressure on model or RTTOV levels (output)
!           PPRESF  = Pressure on model or RTTOV levels (output)
!           PSIGMA = Sigma used for Gaussian
!           PW     = Weights, perturbation
!           PW5     = Weights

!     MEANUV_WEIGHTSAD is called from HOPAD

!**   METHOD
!     ------
!     Gauss average:
!     Use a Gaussian function to calculate weights. Reduce weight
!     linearly to zero between 200 and 100 hPa, as there won't be
!     contribution above 100 hPa in SATOB/AMVs.
!
!     Boxcar average:
!     Uses a boxcar weighting function that is a constant between 
!     ZPAMVTOP and ZPAMVBOT, and zero elsewhere.
!
!     RT average:
!     Calculate weights corresponding to numerical approximation of
!     radiance integral (integral( B(T(tau)) * dtau )), from 
!     transmittances tau.

!**   EXTERNALS
!     --------- 

!**   MODIFICATIONS
!     -------------
!     N. Bormann      2009/10/09: Original
!----------------------------------------------------------

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

USE yomlun   , ONLY : NULERR

IMPLICIT none

! Arguments
INTEGER(KIND=JPIM),INTENT(IN)    :: KDLEN ! 1st dimension, Max number of members in set
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEN ! 1st dimension, number of obs
INTEGER(KIND=JPIM),INTENT(IN)    :: KDCOUNT ! Data per observations
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV ! Number of pressure levels
CHARACTER(LEN=*)  ,INTENT(IN)    :: CD_COBS_OPER ! Method used for weight calculation
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAU(KDLEN,KDCOUNT,KLEV) ! Transmittances
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVPOBS(KDLEN,KDCOUNT) ! Pressure of obs
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPRESF5(KDLEN,KLEV) ! Pres. of model/RTTOV levels
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PPRESF(KDLEN,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSIGMA ! Sigma of Gaussian [Pa]
REAL(KIND=JPRB)   ,INTENT(IN)    :: PW5(KDLEN,KLEV) ! Weights
REAL(KIND=JPRB)   ,INTENT(IN)    :: PW(KDLEN,KLEV) ! Weights
! Local parameters 
REAL(KIND=JPRB)       :: ZMXNSIGMA = 3._JPRB

! Local variables
REAL(KIND=JPRB)       :: ZPDELTA5, ZPDELTA
REAL(KIND=JPRB)       :: ZW5(KDLEN,KLEV) ! Weights before normalisation
REAL(KIND=JPRB)       :: ZW(KDLEN,KLEV) ! Weights before normalisation
REAL(KIND=JPRB)       :: ZPAMVTOP, ZPAMVBOT
INTEGER(KIND=JPIM)    :: JOBS
INTEGER(KIND=JPIM)    :: ILEV
INTEGER(KIND=JPIM)    :: ILEV1, ILEV2
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
!==================================================================
IF (LHOOK) CALL DR_HOOK('MEANUV_WEIGHTSAD',0,ZHOOK_HANDLE)
IF(KDCOUNT > 1)&
 & CALL ABOR1('MEANUV_WEIGHTSAD: MULTISPECTRAL WINDS NOT YET IMPLEMENTED')  

SELECT CASE (TRIM(CD_COBS_OPER))

!    1      Calculate weights for simple Gauss averaging
!           ============================================

CASE ('Gauss average')

  CALL ABOR1('MEANUV_WEIGHTSAD: Surface p effects not implemented for Gauss average')

!    2      Calculate weights for box averaging
!           ===================================

CASE ('Boxcar average')

  ! Uses a boxcar weighting function that is a constant between 
  ! ZPAMVTOP and ZPAMVBOT, and zero elsewhere.

  ! Direct part

  DO JOBS=1, KLEN

    ZPAMVTOP = PVPOBS(JOBS,1)
    ZPAMVBOT = PVPOBS(JOBS,1) + PSIGMA

    ! Search for pressure level just below ZPAMVTOP
    DO ILEV = 2, KLEV
      IF ( PPRESF5(JOBS,ILEV) > ZPAMVTOP )EXIT
    ENDDO 

    ILEV1 = ILEV

    IF ( ILEV <= KLEV .OR. PPRESF5(JOBS,KLEV) >= ZPAMVTOP ) THEN

      ILEV = ILEV + 1

      IF( ILEV <= KLEV )THEN
        DO ILEV = ILEV, KLEV
          IF ( PPRESF5(JOBS,ILEV-1) >= ZPAMVBOT ) THEN
            EXIT
          ENDIF
        ENDDO
      ENDIF

      ILEV = ILEV - 1
      ILEV2 = ILEV

      IF ( PPRESF5(JOBS,ILEV) > ZPAMVBOT ) THEN
        ZPDELTA5 = PSIGMA
      ELSE
        ZPDELTA5 = PPRESF5(JOBS,ILEV)-ZPAMVTOP
      ENDIF

      ! Adjoint part

      IF(ZPDELTA5 > 0.0_JPRB)THEN
       
        ! Calculate pre-normalisation weigts

        ZW5(JOBS,:) = PW5(JOBS,:) * (2.0_JPRB*ZPDELTA5)

        ! Then

        ZW(JOBS,:) = PW(JOBS,:) / (2.0_JPRB*ZPDELTA5)

        ZPDELTA = 2.0_JPRB * &
         &        SUM(- ZW5(JOBS,:) / (2.0_JPRB*ZPDELTA5)**2 * PW(JOBS,:))

      ELSE
        WRITE(nulerr,*) 'WARNING meanuv_weigthsad: Detected zero weights for box average.'
        WRITE(nulerr,*) PW5(JOBS,:)
      ENDIF   

      IF ( PPRESF5(JOBS,ILEV) > ZPAMVBOT ) THEN

        ! Last: Subtract layer between ZPAMVBOT and model level just below

        PPRESF(JOBS,ILEV) = PPRESF(JOBS,ILEV) - &
         &      (  (  2.0_JPRB*PPRESF5(JOBS,ILEV) &
         &          - 2.0_JPRB*PPRESF5(JOBS,ILEV-1))&
         &         /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))  &
         &       - ( PPRESF5(JOBS,ILEV)**2                      &
         &          - 2.0_JPRB*PPRESF5(JOBS,ILEV)*PPRESF5(JOBS,ILEV-1)  &
         &          + 2.0_JPRB*ZPAMVBOT*PPRESF5(JOBS,ILEV-1)            &
         &          - ZPAMVBOT**2)                             &
         &         /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))**2 ) &
         &       * ZW(JOBS,ILEV)

        PPRESF(JOBS,ILEV-1) = PPRESF(JOBS,ILEV-1) +      &
         &      (   (  2.0_JPRB*PPRESF5(JOBS,ILEV)    &
         &           - 2.0_JPRB*ZPAMVBOT)               &
         &          /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))   &
         &       - ( PPRESF5(JOBS,ILEV)**2                      &
         &          - 2.0_JPRB*PPRESF5(JOBS,ILEV)*PPRESF5(JOBS,ILEV-1)  &
         &          + 2.0_JPRB*ZPAMVBOT*PPRESF5(JOBS,ILEV-1)            &
         &          - ZPAMVBOT**2)                             &
         &         /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))**2 ) &
         &       * ZW(JOBS,ILEV)

        
        PPRESF(JOBS,ILEV) = PPRESF(JOBS,ILEV) - &
         &     (    2.0_JPRB*(PPRESF5(JOBS,ILEV) - ZPAMVBOT)  &
         &        /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))   &
         &      -  (PPRESF5(JOBS,ILEV) - ZPAMVBOT)**2        &
         &        /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))**2 ) &
         &     * ZW(JOBS,ILEV-1)

        PPRESF(JOBS,ILEV-1) = PPRESF(JOBS,ILEV-1) -      &
         &         (PPRESF5(JOBS,ILEV) - ZPAMVBOT)**2        &
         &        /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))**2 &
         &     * ZW(JOBS,ILEV-1)

        ZPDELTA = 0.0_JPRB

      ELSE

        PPRESF(JOBS,ILEV) = PPRESF(JOBS,ILEV) + ZPDELTA
        ZPDELTA = 0.0_JPRB

      ENDIF

      IF( ILEV1 + 1 <= KLEV )THEN
        DO ILEV = ILEV2, ILEV1 + 1, -1
          IF ( PPRESF5(JOBS,ILEV-1) < ZPAMVBOT ) THEN

            ! Layers between model levels
            PPRESF(JOBS,ILEV) = PPRESF(JOBS,ILEV) + ZW(JOBS,ILEV) 
            PPRESF(JOBS,ILEV-1) = PPRESF(JOBS,ILEV-1) - ZW(JOBS,ILEV) 

            ZW(JOBS,ILEV) = 0.0_JPRB

            PPRESF(JOBS,ILEV) = PPRESF(JOBS,ILEV) + ZW(JOBS,ILEV-1)
            PPRESF(JOBS,ILEV-1) = PPRESF(JOBS,ILEV-1) - ZW(JOBS,ILEV-1)

          ENDIF
        ENDDO
      ENDIF

      ! First: Layer between ZPAMVTOP and model pressure just below:

      PPRESF(JOBS,ILEV) = PPRESF(JOBS,ILEV)  + &
       &     (  (   2.0_JPRB*PPRESF5(JOBS,ILEV)              &
       &          - 2.0_JPRB*PPRESF5(JOBS,ILEV-1) )          &
       &        /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1)) &
       &      - (   PPRESF5(JOBS,ILEV)**2                       &
       &          - 2.0_JPRB*PPRESF5(JOBS,ILEV)*PPRESF5(JOBS,ILEV-1) &
       &          + 2.0_JPRB*ZPAMVTOP*PPRESF5(JOBS,ILEV-1)           &
       &          - ZPAMVTOP**2)                                     & 
       &        /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))**2 ) &
       &     * ZW(JOBS,ILEV) 

      PPRESF(JOBS,ILEV-1) = PPRESF(JOBS,ILEV-1)   +    &
       &     (  (   2.0_JPRB*ZPAMVTOP                  &
       &          - 2.0_JPRB*PPRESF5(JOBS,ILEV) )      &
       &        /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))          &
       &      + (   PPRESF5(JOBS,ILEV)**2                       &
       &          - 2.0_JPRB*PPRESF5(JOBS,ILEV)*PPRESF5(JOBS,ILEV-1)   &
       &          + 2.0_JPRB*ZPAMVTOP*PPRESF5(JOBS,ILEV-1)           &
       &          - ZPAMVTOP**2)                                  & 
       &        /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))**2 ) &
       &     * ZW(JOBS,ILEV) 

      ZW(JOBS,ILEV) = 0.0_JPRB

      PPRESF(JOBS,ILEV) = PPRESF(JOBS,ILEV)  + &
       &     (  ( 2.0_JPRB*(PPRESF5(JOBS,ILEV) - ZPAMVTOP) ) &
       &        /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))    &
       &      - ( PPRESF5(JOBS,ILEV) - ZPAMVTOP)**2&
       &        /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))**2 )  &
       &     * ZW(JOBS,ILEV-1)

      PPRESF(JOBS,ILEV-1) = PPRESF(JOBS,ILEV-1)   +    &
       &         ( PPRESF5(JOBS,ILEV) - ZPAMVTOP)**2   &
       &         /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))**2 &
       &     * ZW(JOBS,ILEV-1)

      ZW(JOBS,ILEV-1) = 0.0_JPRB

    ENDIF
  ENDDO

!    3      Calculate weights from transmittances
!           (Note: PW are calculated so that we can write
!                  H(v-profile) = < PW , v-profile >)
!           ===================================================

CASE ('RT average','RT median','RT max','RT median RT average',&
     &'RT max RT average','RT median Gauss average','RT max Gauss average')

  CALL ABOR1('MEANUV_WEIGHTSAD: Surface p effects not implemented for RT average')

END SELECT

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