SUBROUTINE INTERP_OBSAD(KMASK,PGRID,PLAT,PLON,PSLOT,POBS,KNOBS,KNLEVS,KNVARS,PPRES)
!**** *INTERP_OBSAD*  -Adjoint of Interpolator to obs space (for obs error correlations)
!     Purpose.
!     --------
!Adjoint of  Interpolator in space and time from PGRID(NGPTOT,NACTIM*KNLEVS,KNVARS) to POBS
!     Author.
!     -------
!        Gabor Radnoti  *ECMWF*
!     Modifications.
!     --------------
!        Original   : 2006-August-16
USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMDIM   , ONLY : NDGLG
USE YOMDYN   , ONLY : TSTEP
USE YOMCST   , ONLY : RPI
USE YOMCT0   , ONLY : NSTART, NSTOP
USE YOMDIMO  , ONLY : NACTIM
USE YOMCOSJO , ONLY : OBSCOR_P_UPPER, OBSCOR_P_LOWER, OBSCOR_AUTO_COR, &
              & OBSCOR_GRID_DEF, NACTIM_START, NACTIM_END
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
IMPLICIT NONE
INTEGER(KIND=JPIM),INTENT(IN) :: KMASK
INTEGER(KIND=JPIM),INTENT(IN) :: KNOBS
INTEGER(KIND=JPIM),INTENT(IN) :: KNLEVS
INTEGER(KIND=JPIM),INTENT(IN) :: KNVARS
REAL(KIND=JPRB)   ,INTENT(OUT)    :: PGRID(:,:,:)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLAT(KNOBS)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLON(KNOBS)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSLOT(KNOBS)
REAL(KIND=JPRB)   ,OPTIONAL,INTENT(IN)    :: PPRES(KNOBS)
REAL(KIND=JPRB)   ,INTENT(IN)   :: POBS(KNVARS*KNOBS)

REAL(KIND=JPRB) :: Z_TSLOT_LEN, ZALPHA,  ZNORM
REAL(KIND=JPRB) :: ZLON0E(OBSCOR_GRID_DEF%NDGLG), ZDLONE(OBSCOR_GRID_DEF%NDGLG), ZLATE(OBSCOR_GRID_DEF%NDGLG)
REAL(KIND=JPRB) :: ZGRIDG(OBSCOR_GRID_DEF%NGPTOTG,KNLEVS,2)  ! indices are: (point,level,var)
REAL(KIND=JPRB) :: ZIGRID(KNOBS,2*KNLEVS), ZDELTA
REAL(KIND=JPRB) :: ZHOOK_HANDLE
INTEGER(KIND=JPIM) :: JOBS, JLAT, IU, IV, INDV, INDV1, INDV2, JLEV
INTEGER(KIND=JPIM) :: JSLOT, IACTIM
INTEGER(KIND=JPIM) ::  ILOENG(OBSCOR_GRID_DEF%NDGLG)
INTEGER(KIND=JPIM) :: IMYOBS(KNOBS)
LOGICAL            :: LLPRES
#include "suhifcead.intfb.h"
IF (LHOOK) CALL DR_HOOK('INTERP_OBSAD',0,ZHOOK_HANDLE)
call gstats(301,0)
IACTIM=NACTIM_END(KMASK)-NACTIM_START(KMASK)+1
LLPRES=PRESENT(PPRES)
ZLON0E(:) = 0.0_JPRB
ZDLONE(1:OBSCOR_GRID_DEF%NDGLG) = 2.0_JPRB*RPI/REAL(OBSCOR_GRID_DEF%NLOENG(1:OBSCOR_GRID_DEF%NDGLG),JPRB)
ILOENG(1:OBSCOR_GRID_DEF%NDGLG)=OBSCOR_GRID_DEF%NLOENG(1:OBSCOR_GRID_DEF%NDGLG)
!  This is not correct, but good enough. (To do it properly, message-pass GELAT)
DO JLAT=1,OBSCOR_GRID_DEF%NDGLG
  ZLATE(JLAT)  = 0.5*RPI - (REAL(JLAT,JPRB)-0.5_JPRB)*RPI/REAL(OBSCOR_GRID_DEF%NDGLG,JPRB)
ENDDO
ZGRIDG(:,:,:)=0._JPRB
DO JSLOT = IACTIM,1,-1
      ZIGRID(:,:)=0._JPRB
      DO JOBS=1,KNOBS
        IF ( NACTIM_START(KMASK) + JSLOT - 1 == NINT(PSLOT(JOBS)) ) THEN
!     search for the vertical layer which PPRES(JOBS) belongs to, and compute interpolation weights
          IF (LLPRES) THEN
            ZDELTA=(OBSCOR_P_LOWER(KMASK)-OBSCOR_P_UPPER(KMASK))/REAL(KNLEVS-1,JPRB)
            IF ( PPRES(JOBS) < OBSCOR_P_UPPER(KMASK)) INDV=0
            DO JLEV=1,KNLEVS
              IF (PPRES(JOBS) >= OBSCOR_P_UPPER(KMASK) + REAL((JLEV-1),JPRB)*ZDELTA) THEN
                INDV=JLEV
              ENDIF
            ENDDO
            IF (INDV == 0) THEN
              INDV1=1
              INDV2=1
              ZALPHA=1._JPRB
            ELSEIF (INDV==KNLEVS) THEN
              INDV1=KNLEVS
              INDV2=KNLEVS
              ZALPHA=1._JPRB
            ELSE
              INDV1=INDV
              INDV2=INDV+1
              ZALPHA=(PPRES(JOBS)-(OBSCOR_P_UPPER(KMASK) + REAL((INDV-1),JPRB)*ZDELTA))/ZDELTA
            ENDIF
          ELSE
            INDV1=1
            INDV2=1
            ZALPHA=1._JPRB
          ENDIF
          ZNORM = 1.0_JPRB/SQRT(ZALPHA**2 + (1.0_JPRB-ZALPHA)**2)
          ZIGRID(JOBS,INDV2)=ZIGRID(JOBS,INDV2)+ZALPHA*ZNORM*POBS(JOBS)
          ZIGRID(JOBS,INDV1)=ZIGRID(JOBS,INDV1)+(1._JPRB-ZALPHA)*ZNORM*POBS(JOBS)
          IF (KNVARS == 2) THEN
            ZIGRID(JOBS,KNLEVS+INDV2)=ZIGRID(JOBS,KNLEVS+INDV2)+ZALPHA*ZNORM*POBS(KNOBS+JOBS)
            ZIGRID(JOBS,KNLEVS+INDV1)=ZIGRID(JOBS,KNLEVS+INDV1)+(1._JPRB-ZALPHA)*ZNORM*POBS(KNOBS+JOBS)
          ENDIF
        ENDIF
      ENDDO ! JOBS
      IMYOBS(:)=0
      DO JOBS=1,KNOBS
        IF ( NACTIM_START(KMASK) + JSLOT - 1 == NINT(PSLOT(JOBS)) ) IMYOBS(JOBS)=1
      ENDDO 
      call gstats(302,0)
      CALL SUHIFCEAD(ZLON0E(1),ZDLONE(1),ZLATE(1),OBSCOR_GRID_DEF%NDGLG, &
      & ILOENG(1),PLON,PLAT,KNOBS,&
      & OBSCOR_GRID_DEF%NGPTOTG,KNLEVS,ZGRIDG(1,1,1),ZIGRID(1:KNOBS,1:KNLEVS),LDNG=.FALSE.,KMASK=IMYOBS)
      IF (KNVARS == 2) THEN
        CALL SUHIFCEAD(ZLON0E(1),ZDLONE(1),ZLATE(1),OBSCOR_GRID_DEF%NDGLG, &
        & ILOENG(1),PLON,PLAT,KNOBS,&
        & OBSCOR_GRID_DEF%NGPTOTG,KNLEVS,ZGRIDG(1,1,2),ZIGRID(1:KNOBS,KNLEVS+1:2*KNLEVS),LDNG=.FALSE.,KMASK=IMYOBS)
      ENDIF
      call gstats(302,1)
!   Account for time correlation using a lag-one Markov process.
      Z_TSLOT_LEN = REAL(NSTOP-NSTART,JPRB)*TSTEP/REAL(NACTIM-1,JPRB)
      IF (JSLOT == 1) THEN
        ZALPHA=0._JPRB
      ELSE
        ZALPHA = EXP(-Z_TSLOT_LEN/OBSCOR_AUTO_COR(KMASK))
      ENDIF
      ZNORM = 1.0_JPRB/SQRT(ZALPHA**2 + (1.0_JPRB-ZALPHA)**2)    
      DO JLEV=1,KNLEVS
        IU = (JSLOT-1)*KNLEVS+JLEV 
        IV = IACTIM*KNLEVS+(JSLOT-1)*KNLEVS+JLEV
        PGRID(1:OBSCOR_GRID_DEF%NGPTOTG,IU,1)=(1.0_JPRB-ZALPHA)*ZNORM*ZGRIDG(1:OBSCOR_GRID_DEF%NGPTOTG,JLEV,1)
        ZGRIDG(1:OBSCOR_GRID_DEF%NGPTOTG,JLEV,1)=ZALPHA*ZNORM*ZGRIDG(1:OBSCOR_GRID_DEF%NGPTOTG,JLEV,1)
        IF (KNVARS == 2) THEN
          PGRID(1:OBSCOR_GRID_DEF%NGPTOTG,IV,1)=(1.0_JPRB-ZALPHA)*ZNORM*ZGRIDG(1:OBSCOR_GRID_DEF%NGPTOTG,JLEV,2)
          ZGRIDG(1:OBSCOR_GRID_DEF%NGPTOTG,JLEV,2)=ZALPHA*ZNORM*ZGRIDG(1:OBSCOR_GRID_DEF%NGPTOTG,JLEV,2)
        ENDIF
      ENDDO
ENDDO ! JSLOT  
call gstats(301,1)
IF (LHOOK) CALL DR_HOOK('INTERP_OBSAD',1,ZHOOK_HANDLE)
END SUBROUTINE INTERP_OBSAD 
