SUBROUTINE CH_DOPWIND(KFLAG1,KFLAG2,PINDEX,KNUM,KNLEV, 4
     &                     PRESS,PRESSA,PIN,PIN2,PANG,
     &                     POUT,POUT2,KMOD,KDIM)
C
      IMPLICIT NONE
      INTEGER KNUM,KNLEV,KFLAG1(KNUM),KFLAG2(KNUM),KMOD,KDIM
      REAL*8 PRESS(KNUM),PIN(KDIM),PIN2(KDIM)
      REAL*8 POUT(KDIM),POUT2(KDIM)
      REAL PINDEX(KNUM),PANG(KNLEV)
      REAL*8 PRESSA(KNLEV)
C
#if defined (DOC)
*
*
**s/r CH_DOPWIND - Apply forward/TLM model or its adjoint for profile of point 
*                  values of Doppler wind speed.
*
*                  Forward model: piecewise linear vertical interpolation.
*
*
*     AUTHOR:    Y. Rochon *ARQX/EC June 2008
*                (based on ch_vprof)
*
*     REVISIONS: 
*
*     PURPOSE:  - Apply forward/TLM model or its adjoint for profile of point values.
*                 Forward model: piecewise linear vertical interpolation.
*
*     ARGUMENTS
*
*        INPUT:
*
*            KFLAG1.......Flags (1 for valid obs data)
*            KFLAG2.......Flags (0 for data in vertical range)
*            PINDEX.......Array of indices of analysis upper levels closest
*                         obs levels.
*            KNLEV........Number of analyis levels
*            KNUM.........Number of obs levels
*            PRESS........Obs levels
*            PRESSA.......Analysis levels (in increasing size)
*            PIN..........UU input background/increment values at analysis 
*                         levels when KMOD=0; Relative Doppler wind 
*                         increment otherwise.
*            PIN2.........VV input background/increment values at analysis 
*                         levels when KMOD=0. Not used otherwise
*            PANG.........Observing direction clockwise relative to North (rad)
*            POUT.........Initial GOMOBS segment when KMOD=1
*            kmod........ Flag indicating purpose of call:
*                         0: Use as forward or TLM  model
*                         1: Use as adjoint of TLM model.
*            kdim.........dimensions; >=max(knlev,knum)
*
*        OUTPUT:
*
*            POUT.........Output background/increment values at obs levels
*                         when KMOD=0.
*                         UU updated GOMOBS segment when KMOD=1.
*            POUT2........VV updated GOMOBS segment when KMOD=1
*            KFLAG2.......Flags modified to 1 or 2 if point above or below
*                         analysis region.
*
*
*COMMENT
*
*   1) ZDAPPS contribution when obs is T or wind for both 'BG' and 'HR'
*      is not included in this version.
*            
************************************************************************
#endif
C
C*    Global variables
C
#include "pardim.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comgem.cdk"
C
      INTEGER J,IK1
      REAL*8 ZWB,ZWT,ZUU,ZVV
C
      DO J=1,KNUM
C
C        Check for levels which extend above the top analysis level
C        or are entirely below surface.
C
         if (abs(PANG(J)).GT.7.0) then
            write(NULOUT,*) 'CH_DOPWIND: J,PANG(J)=',J,PANG(J)
            CALL ABORT3D(NULOUT,'CH_DOPWIND look direction problem.')
         end if
         if (KFLAG1(J).EQ.1.AND.KFLAG2(J).EQ.0) then
            if (PRESS(J).lt.PRESSA(1)) then
               kflag2(j)=1
            else if (PRESS(J).gt.PRESSA(KNLEV)) then
               kflag2(j)=2
            end if
         end if
C
         IF (KFLAG1(J).EQ.1.AND.KFLAG2(J).EQ.0) THEN
C
C           Apply vertical linear interpolation to obs location
C
            IK1  = PINDEX(J)
C
C           Make sure obs level is in between analysis
C           levels IK1 and IK1+1.
C
C           This is to account for any inconsistency in
C           vertical coordinate transformation which
C           might occur in processing when input
C           obs vertical coordinate is not pressure.
C
            if (PRESS(J).LT.PRESSA(ik1)) then
               IK1 = IK1 - 1
               IF (IK1.LT.1) IK1=1
            endif
            if (PRESS(J).GT.PRESSA(ik1+1)) then
               IK1 = IK1 + 1
               IF (IK1.GT.KNLEV-1) IK1=KNLEV-1
            endif
            ZWB  = LOG(press(j)/pressa(ik1))
     &                          /LOG(pressa(ik1+1)/pressa(ik1))
            ZWT  = 1.0D0 - ZWB
c
c           zpresbpt = ((vhybinc(ik1) - rptopinc/rprefinc)
c     &                  /(1.0-rptopinc/rprefinc))**rcoefinc
c           zpresbpb = ((vhybinc(ik1+1) - rptopinc/rprefinc)
c     &                  /(1.0-rptopinc/rprefinc))**rcoefinc
c           ZDADPS   = ( (ZPRESBPT/pressa(ik1))*LOG(ZLEV/pressa(ik1+1))
c     +                  -(ZPRESBPB/pressa(ik1+1))*LOG(ZLEV/pressa(ik1)) )
c     +                  /LOG(ZPB/ZPT)**2
C
            IF (KMOD.EQ.0) THEN
C
C              Forward model calc.
C
               ZUU=ZWB*PIN(IK1+1) + ZWT*PIN(IK1)
               ZVV=ZWB*PIN2(IK1+1) + ZWT*PIN2(IK1)
               POUT(J) = -(ZUU*SIN(PANG(J))+ZVV*COS(PANG(J)))
C
            ELSE IF (KMOD.EQ.1) THEN
C
C              Adjoint of forward/TLM model calc.
C
               ZUU=-SIN(PANG(J))
               ZVV=-COS(PANG(J))
               POUT(IK1)=POUT(IK1)+ZWT*PIN(J)*ZUU
               POUT(IK1+1)=POUT(IK1+1)+ZWB*PIN(J)*ZUU
               POUT2(IK1)=POUT2(IK1)+ZWT*PIN(J)*ZVV
               POUT2(IK1+1)=POUT2(IK1+1)+ZWB*PIN(J)*ZVV
C
            END IF
         END IF
      END DO
C
      RETURN
      END