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

!**** *MEANUV_WEIGHTSTL*   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_WEIGHTSTL
!     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
!           PPRESF  = Pressure on model or RTTOV levels (perturbation)
!           PSIGMA = Sigma used for Gaussian
!           PW     = Weights, perturbation (output)
!           PW5     = Weights (output)

!     MEANUV_WEIGHTSTL is called from HOPTL

!**   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 : NULOUT, 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(IN)    :: PPRESF(KDLEN,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSIGMA ! Sigma of Gaussian [Pa]
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PW5(KDLEN,KLEV) ! Weights
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PW(KDLEN,KLEV) ! Weights
! Local parameters 
REAL(KIND=JPRB)       :: ZMXNSIGMA = 3._JPRB

! Local variables
REAL(KIND=JPRB)       :: ZPDELTA5, ZPDELTA
REAL(KIND=JPRB)       :: ZSIGMA
REAL(KIND=JPRB)       :: ZPAMVTOP, ZPAMVBOT
INTEGER(KIND=JPIM)    :: JOBS
INTEGER(KIND=JPIM)    :: ILEV
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

PW5 = 0.0_JPRB
PW = 0.0_JPRB

SELECT CASE (TRIM(CD_COBS_OPER))

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

CASE ('Gauss average')

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

  PW = 0.0_JPRB

  DO JOBS=1, KLEN
      ! Adjust sigma (for lower levels)
    ZSIGMA = MAX(MIN(PSIGMA,(PPRESF5(JOBS,KLEV)-PVPOBS(JOBS,1))/ZMXNSIGMA), &
     & 1000._JPRB)  
      ! Calculate Gaussian
    PW5(JOBS,:) = EXP(-0.5_JPRB * ((PPRESF5(JOBS,:)-PVPOBS(JOBS,1))/ZSIGMA)**2)
      ! Reduce weights to 0 above 200 hPa
    PW5(JOBS,:) = PW5(JOBS,:)                    &
     & * MAX(0._JPRB,MIN(1._JPRB,0.0001_JPRB*(PPRESF5(JOBS,:)-10000._JPRB)))  
      ! Set weights to 0 for pressure levels outside ZMXNSIGMA ZSIGMAs 
      ! around p
    IF(ANY(ABS(PPRESF5(JOBS,:)-PVPOBS(JOBS,1)) <= ZMXNSIGMA*ZSIGMA))THEN
      WHERE(ABS(PPRESF5(JOBS,:)-PVPOBS(JOBS,1)) > ZMXNSIGMA*ZSIGMA) &
       & PW5(JOBS,:) = 0.0_JPRB  
    ENDIF
      ! Calculate integral over dp
    PW5(JOBS,2:KLEV-1) = PW5(JOBS,2:KLEV-1)     &
     & * ( PPRESF5(JOBS,3:KLEV) - PPRESF5(JOBS,1:KLEV-2) )  
    PW5(JOBS,1)    = PW5(JOBS,1) * ( PPRESF5(JOBS,2) - PPRESF5(JOBS,1) )
    PW5(JOBS,KLEV) = PW5(JOBS,KLEV) * ( PPRESF5(JOBS,KLEV) - PPRESF5(JOBS,KLEV-1) )
      ! Normalise weight
    IF(SUM(PW5(JOBS,:))> 0.0_JPRB)THEN
      PW5(JOBS,:) = PW5(JOBS,:) / SUM(PW5(JOBS,:))
    ELSE
      WRITE(nulout,*) 'WARNING meanuv_weigthstl: Detected zero weights.'
      WRITE(nulout,*) PW5(JOBS,:)
    ENDIF   
  ENDDO

!    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.

  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 

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

      ! ZPAMVTOP below lowest pressure level; just use value of lowest level

      PW5(JOBS,KLEV) = 1.0_JPRB
      PW(JOBS,KLEV) = 0.0_JPRB

    ELSE

      ! Assign weights. To evaluate the integral, the wind is assumed to 
      ! vary linearly in pressure.

      ! First: Layer between ZPAMVTOP and model pressure just below:
      PW5(JOBS,ILEV-1) = (PPRESF5(JOBS,ILEV) - ZPAMVTOP)**2   &
       &                /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))
      PW(JOBS,ILEV-1) = 2.0_JPRB*(PPRESF5(JOBS,ILEV) - ZPAMVTOP)&
       &                 *PPRESF(JOBS,ILEV)  &
       &                 /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))    &
       &            - (PPRESF5(JOBS,ILEV) - ZPAMVTOP)**2&
       &              /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))**2      &
       &              * (PPRESF(JOBS,ILEV) - PPRESF(JOBS,ILEV-1))

      PW5(JOBS,ILEV) = (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))
      PW(JOBS,ILEV)  = (2.0_JPRB*PPRESF5(JOBS,ILEV)*PPRESF(JOBS,ILEV)       &
       &               - 2.0_JPRB*PPRESF(JOBS,ILEV)*PPRESF5(JOBS,ILEV-1)    &
       &               - 2.0_JPRB*PPRESF5(JOBS,ILEV)*PPRESF(JOBS,ILEV-1)    &
       &               + 2.0_JPRB*ZPAMVTOP*PPRESF(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 &
       &              *(PPRESF(JOBS,ILEV) - PPRESF(JOBS,ILEV-1))

      ILEV = ILEV + 1

      IF( ILEV <= KLEV )THEN
        DO ILEV = ILEV, KLEV
          IF ( PPRESF5(JOBS,ILEV-1) < ZPAMVBOT ) THEN
            ! Layers between model levels
            PW5(JOBS,ILEV-1) = PW5(JOBS,ILEV-1) + PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1)
            PW(JOBS,ILEV-1)  = PW(JOBS,ILEV-1) + PPRESF(JOBS,ILEV) - PPRESF(JOBS,ILEV-1)
            PW5(JOBS,ILEV)   = PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1)
            PW(JOBS,ILEV)    = PPRESF(JOBS,ILEV) - PPRESF(JOBS,ILEV-1)
          ELSE
            EXIT
          ENDIF
        ENDDO
      ENDIF

      ILEV = ILEV - 1

      IF ( PPRESF5(JOBS,ILEV) > ZPAMVBOT ) THEN
        ! Last: Subtract layer between ZPAMVBOT and model level just below
        PW5(JOBS,ILEV-1) = PW5(JOBS,ILEV-1)                    &
         &      -  (PPRESF5(JOBS,ILEV) - ZPAMVBOT)**2        &
         &        /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))
        PW(JOBS,ILEV-1) = PW(JOBS,ILEV-1)                      &
         &      -  2.0_JPRB*(PPRESF5(JOBS,ILEV) - ZPAMVBOT)  &
         &          *PPRESF(JOBS,ILEV)  &
         &          /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))   &
         &      +  (PPRESF5(JOBS,ILEV) - ZPAMVBOT)**2        &
         &        /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1))**2 &
         &        * (PPRESF(JOBS,ILEV) - PPRESF(JOBS,ILEV-1))
! IGBG :: I.Genkova and N.Bormann
!        PW5(JOBS,ILEV) = PW5(JOBS,ILEV)                      &
!         &      -  (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))
        PW5(JOBS,ILEV) = PW5(JOBS,ILEV)                                &
         &      -  (   PPRESF5(JOBS,ILEV) -  PPRESF5(JOBS,ILEV-1)      &
         &           - ( PPRESF5(JOBS,ILEV-1) - ZPAMVBOT )**2          &
         &             /(PPRESF5(JOBS,ILEV) - PPRESF5(JOBS,ILEV-1)) )
! end of changes required to avoid negative AMV weights 
        PW(JOBS,ILEV) = PW(JOBS,ILEV)                      &
         &      -  (2.0_JPRB*PPRESF5(JOBS,ILEV)* PPRESF(JOBS,ILEV)    &
         &          - 2.0_JPRB*PPRESF(JOBS,ILEV)*PPRESF5(JOBS,ILEV-1)  &
         &          - 2.0_JPRB*PPRESF5(JOBS,ILEV)*PPRESF(JOBS,ILEV-1)  &
         &          + 2.0_JPRB*ZPAMVBOT*PPRESF(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 &
         &         * (PPRESF(JOBS,ILEV) - PPRESF(JOBS,ILEV-1))

        ZPDELTA5 = PSIGMA
        ZPDELTA  = 0.0_JPRB

      ELSE

        ZPDELTA5 = PPRESF5(JOBS,ILEV)-ZPAMVTOP
        ZPDELTA  = PPRESF(JOBS,ILEV)

      ENDIF

      IF(ZPDELTA5 > 0.0_JPRB)THEN
        PW(JOBS,:) = PW(JOBS,:) / (2.0_JPRB * ZPDELTA5)              &
         &           - PW5(JOBS,:) / (2.0_JPRB*ZPDELTA5)**2 * 2.0_JPRB*ZPDELTA
        PW5(JOBS,:) = PW5(JOBS,:) / (2.0_JPRB*ZPDELTA5)
      ELSE
        WRITE(nulout,*) 'WARNING meanuv_weigthstl: Detected zero weights for box average.'
        WRITE(nulout,*) PW5(JOBS,:)
      ENDIF   
    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_WEIGHTSTL: Surface p effects not implemented for RT average')

  PW = 0.0_JPRB

  DO JOBS = 1,KLEN
    PW5(JOBS,2:KLEV-1) = PTAU(JOBS,1,1:KLEV-2) - PTAU(JOBS,1,3:KLEV)
    PW5(JOBS,1)    = PTAU(JOBS,1,1) - PTAU(JOBS,1,2)
    PW5(JOBS,KLEV) = PTAU(JOBS,1,KLEV-1) - PTAU(JOBS,1,KLEV)
    PW5(JOBS,:) = PW5(JOBS,:) / SUM(PW5(JOBS,:))
  ENDDO

END SELECT

IF(ANY(PW5 < 0.0_JPRB))THEN
  WRITE(NULERR,*) 'MEANUV_WEIGHTSTL: Negative weight:'
  DO JOBS = 1,KLEN
    IF(ANY(PW5(JOBS,:) < 0.0_JPRB))THEN
      WRITE(NULERR,*) ' P_AMV:',PVPOBS(JOBS,1)
      WRITE(NULERR,*) ' Weights:',PW5(JOBS,:)
    ENDIF
  ENDDO
  CALL ABOR1('MEANUV_WEIGHTSTL: Negative weight for some AMVs')
ENDIF

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