SUBROUTINE damp_speed(DIVE,VORE,TEME,RTE,NDEXEV,
     X                      DIVO,VORO,TEMO,RTO,NDEXOD,
     X                      SL,SPDMAX,DELTIM,
     X                      LS_NODE)
!
      use resol_def
      use layout1
      use physcons, rerth => con_rerth
      IMPLICIT NONE
!
      REAL(KIND=KIND_EVOD)   DIVE(LEN_TRIE_LS,2)
      REAL(KIND=KIND_EVOD)   VORE(LEN_TRIE_LS,2)
      REAL(KIND=KIND_EVOD)   TEME(LEN_TRIE_LS,2)
      REAL(KIND=KIND_EVOD)    RTE(LEN_TRIE_LS,2,LEVS,ntrac)
      INTEGER              NDEXEV(LEN_TRIE_LS)
!
      REAL(KIND=KIND_EVOD)   DIVO(LEN_TRIO_LS,2)
      REAL(KIND=KIND_EVOD)   VORO(LEN_TRIO_LS,2)
      REAL(KIND=KIND_EVOD)   TEMO(LEN_TRIO_LS,2)
      REAL(KIND=KIND_EVOD)    RTO(LEN_TRIO_LS,2,LEVS,ntrac)
      INTEGER              NDEXOD(LEN_TRIO_LS)
!
      REAL(KIND=KIND_EVOD)     SL(LEVS)
      REAL(KIND=KIND_EVOD) SPDMAX
      REAL(KIND=KIND_EVOD) DELTIM
cc
      integer              ls_node(ls_dim,3)
cc
!cmr  ls_node(1,1) ... ls_node(ls_max_node,1) : values of L
!cmr  ls_node(1,2) ... ls_node(ls_max_node,2) : values of jbasev
!cmr  ls_node(1,3) ... ls_node(ls_max_node,3) : values of jbasod
!
      INTEGER              IT,KD,KU,L,LOCL,N,N0
!
      INTEGER              INDEV
      INTEGER              INDOD
      integer              indev1,indev2
      integer              indod1,indod2
      REAL(KIND=KIND_EVOD) ALFA,ALFADT,BETA,COEF,factor,RK,RNCRIT,SF,TK
!
      REAL(KIND=KIND_EVOD) CONS0,CONS1,CONS1P009     !CONSTANT
      REAL(KIND=KIND_EVOD) CONS2,CONS2P5             !CONSTANT
!
      INTEGER              INDLSEV,JBASEV
      INTEGER              INDLSOD,JBASOD
!
      include 'function2'
!
!
      CALL countperf(0,13,0.)
!!
      CONS0     = 0.D0        !CONSTANT
      CONS1     = 1.D0        !CONSTANT
      CONS1P009 = 1.009D0     !CONSTANT
      CONS2     = 2.D0        !CONSTANT
      CONS2P5   = 2.5D0       !CONSTANT
!
!
      ALFA=CONS2P5                    !CONSTANT
      BETA=RERTH*CONS1P009/DELTIM     !CONSTANT
      ALFADT=ALFA*DELTIM/RERTH
!
!
! ......................................................................
!
!
         RNCRIT=BETA/SPDMAX
         IF (RNCRIT.LT.JCAP) THEN
!
            COEF=ALFADT*SPDMAX
!!          KD=MAX(K-1,1)
!!          KU=MIN(K+1,LEVS)
!!!!        SF=SL(K)/(SL(KU)-SL(KD))/SQRT(2.)        !CONSTANT
!!          SF=SL(K)/(SL(KU)-SL(KD))/SQRT(CONS2)     !CONSTANT
!!!!        TK=(TEME(1,1,KU)-TEME(1,1,KD))*SF
!!!!        TK=(TEME1(KU)-TEME1(KD))*SF
!!
!!!!        DO L = 0, JCAP
            DO LOCL=1,LS_MAX_NODE
                    l=ls_node(locl,1)
               jbasev=ls_node(locl,2)
               IF (L.EQ.0) THEN
                                 N0=2
                           ELSE
                                 N0=L
               ENDIF
               indev1 = indlsev(N0,L)
               if (mod(L,2).eq.mod(jcap+1,2)) then
                  indev2 = indlsev(jcap+1,L)
               else
                  indev2 = indlsev(jcap  ,L)
               endif
!!!!           DO N = N0, JCAP+1, 2
               DO INDEV = indev1 , indev2
!
                  IF    (NDEXEV(INDEV).GT.RNCRIT)       THEN
                 factor=cons1/(cons1+((NDEXEV(INDEV) -  RNCRIT)*COEF))
!
                      DIVE(INDEV,1)=DIVE(INDEV,1)*factor
                      DIVE(INDEV,2)=DIVE(INDEV,2)*factor
 
                      VORE(INDEV,1)=VORE(INDEV,1)*factor
                      VORE(INDEV,2)=VORE(INDEV,2)*factor
 
                      TEME(INDEV,1)=TEME(INDEV,1)*factor
                      TEME(INDEV,2)=TEME(INDEV,2)*factor
!
                  ENDIF
               ENDDO
            ENDDO
!
! ......................................................................
!
!!!!        DO L = 0, JCAP
            DO LOCL=1,LS_MAX_NODE
                    l=ls_node(locl,1)
               jbasod=ls_node(locl,3)
               indod1 = indlsod(L+1,L)
               if (mod(L,2).eq.mod(jcap+1,2)) then
                  indod2 = indlsod(jcap  ,L)
               else
                  indod2 = indlsod(jcap+1,L)
               endif
!!!!           DO N = L+1, JCAP+1, 2
               DO INDOD = indod1 , indod2
!
                  IF    (NDEXOD(INDOD).GT.RNCRIT)       THEN
                 factor=cons1/(cons1+((NDEXOD(INDOD) -  RNCRIT)*COEF))
!
                      DIVO(INDOD,1)=DIVO(INDOD,1)*factor
                      DIVO(INDOD,2)=DIVO(INDOD,2)*factor
 
                      VORO(INDOD,1)=VORO(INDOD,1)*factor
                      VORO(INDOD,2)=VORO(INDOD,2)*factor
 
                      TEMO(INDOD,1)=TEMO(INDOD,1)*factor
                      TEMO(INDOD,2)=TEMO(INDOD,2)*factor
!
                  ENDIF
               ENDDO
            ENDDO
!
! ......................................................................
!
            DO IT=1,NTRAC
!!!!           DO L = 0, JCAP
               DO LOCL=1,LS_MAX_NODE
                       l=ls_node(locl,1)
                  jbasev=ls_node(locl,2)
                  IF (L.EQ.0) THEN
                                    N0=2
                              ELSE
                                    N0=L
                  ENDIF
                  indev1 = indlsev(N0,L)
                  if (mod(L,2).eq.mod(jcap+1,2)) then
                     indev2 = indlsev(jcap+1,L)
                  else
                     indev2 = indlsev(jcap  ,L)
                  endif
!!!!              DO N = N0, JCAP+1, 2
                  DO INDEV = indev1 , indev2
!
                     IF   (NDEXEV(INDEV).GT.RNCRIT)       THEN
                 factor=cons1/(cons1+((NDEXEV(INDEV) -  RNCRIT)*COEF))
!
                        RTE(INDEV,1,1,IT)=RTE(INDEV,1,1,IT)*factor
                        RTE(INDEV,2,1,IT)=RTE(INDEV,2,1,IT)*factor
!
                     ENDIF
                  ENDDO
               ENDDO
!
! ......................................................................
!
!!!!           DO L = 0, JCAP
               DO LOCL=1,LS_MAX_NODE
                       l=ls_node(locl,1)
                  jbasod=ls_node(locl,3)
                  indod1 = indlsod(L+1,L)
                  if (mod(L,2).eq.mod(jcap+1,2)) then
                     indod2 = indlsod(jcap  ,L)
                  else
                     indod2 = indlsod(jcap+1,L)
                  endif
!
!!!!              DO N = L+1, JCAP+1, 2
                  DO INDOD = indod1 , indod2
!
                     IF   (NDEXOD(INDOD).GT.RNCRIT)       THEN
                 factor=cons1/(cons1+((NDEXOD(INDOD) -  RNCRIT)*COEF))
!
                        RTO(INDOD,1,1,IT)=RTO(INDOD,1,1,IT)*factor
                        RTO(INDOD,2,1,IT)=RTO(INDOD,2,1,IT)*factor
!
                     ENDIF
                  ENDDO
               ENDDO
!
            ENDDO
         ENDIF
!
!
      CALL countperf(1,13,0.)
!!
      RETURN
      END