!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
    SUBROUTINE DDAMP
!     ******************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .     
! SUBPROGRAM:    DDAMP       DIVERGENCE DAMPING
!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 94-03-08       
!     
! ABSTRACT:
!     DDAMP MODIFIES THE WIND COMPONENTS SO AS TO REDUCE THE
!     HORIZONTAL DIVERGENCE.  A SWITCH PROVIDES THE OPTION OF
!     ALSO MODIFYING THE TEMPERATURE FROM AN ENERGY VIEWPOINT.
!     
! PROGRAM HISTORY LOG:
!   87-08-??  JANJIC     - ORIGINATOR
!   95-03-25  BLACK      - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
!   95-03-28  BLACK      - ADDED EXTERNAL EDGE
!   98-10-30  BLACK      - MODIFIED FOR DISTRIBUTED MEMORY
!     
! USAGE: CALL DDAMP FROM MAIN PROGRAM EBU
!
!   INPUT ARGUMENT LIST:
!       NONE     
!  
!   OUTPUT ARGUMENT LIST: 
!     NONE
!     
!   OUTPUT FILES:
!     NONE
!     
!   SUBPROGRAMS CALLED:
!  
!     UNIQUE: NONE
!  
!     LIBRARY: NONE
!  
!   COMMON BLOCKS: CTLBLK
!                  MASKS
!                  DYNAM
!                  VRBLS
!                  CONTIN
!                  INDX
!   
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM SP
!$$$  
!     ******************************************************************
    PARAMETER &
    (RFCP=.25/1004.6)
!-----------------------------------------------------------------------
    INCLUDE "parmeta.f90"
    INCLUDE "mpp.h"
#include "sp.h"
!-----------------------------------------------------------------------
    PARAMETER  &
    (IMJM=IM*JM-JM/2,JAM=6+2*(JM-10),LP1=LM+1)
!-----------------------------------------------------------------------
    LOGICAL  &
    RUN,FIRST,RESTRT,SIGMA,HEAT
!----------------------------------------------------------------------
    INCLUDE "COMM_CTLBLK.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_MASKS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_DYNAM.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_VRBLS.f90"
    INCLUDE "COMM_PVRBLS.f90"
    INCLUDE "COMM_CLDWTR.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_CONTIN.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_INDX.f90"
!-----------------------------------------------------------------------
    DIMENSION  &
    RDPDX (IDIM1:IDIM2,JDIM1:JDIM2),RDPDY (IDIM1:IDIM2,JDIM1:JDIM2) &
    ,UT    (IDIM1:IDIM2,JDIM1:JDIM2),VT    (IDIM1:IDIM2,JDIM1:JDIM2)
!
    DIMENSION  &
    CKE   (IDIM1:IDIM2,JDIM1:JDIM2),DPDE  (IDIM1:IDIM2,JDIM1:JDIM2)
!-----------------------------------------------------------------------
    HEAT= .FALSE. 
! omp parallel do 
    DO 100 J=MYJS1_P1,MYJE1_P1
        DO 100 I=MYIS_P1,MYIE_P1
            CKE(I,J)=0.
            CONTINUE
    100 END DO
!-----------------------------------------------------------------------
! omp parallel do private(cke,dpde,rdpdx,rdpdy,ut,vt)
    DO 150 L=1,LM
    !-----------------------------------------------------------------------
        CALL ZERO2(CKE)
        CALL ZERO2(DPDE)
    !
        DO 110 J=MYJS_P2,MYJE_P2
            DO 110 I=MYIS_P1,MYIE_P1
                DPDE(I,J)=DETA(L)*PDSL(I,J)
                DIV(I,J,L)=DIV(I,J,L)*HBM2(I,J)
                CONTINUE
        110 END DO
    !
        DO 120 J=MYJS2,MYJE2
            DO 120 I=MYIS_P1,MYIE_P1
                RDPDX(I,J)=VTM(I,J,L)/(DPDE(I+IVW(J),J)+DPDE(I+IVE(J),J))
                RDPDY(I,J)=VTM(I,J,L)/(DPDE(I,J-1)+DPDE(I,J+1))
                CONTINUE
        120 END DO
    !
        DO 130 J=MYJS2,MYJE2
            DO 130 I=MYIS1_P1,MYIE1_P1
                UT(I,J)=U(I,J,L)
                VT(I,J)=V(I,J,L)
                U(I,J,L)=U(I,J,L)+(DIV(I+IVE(J),J,L)-DIV(I+IVW(J),J,L))  &
                *RDPDX(I,J)*DDMPU(I,J)
                V(I,J,L)=V(I,J,L)  &
                +(DIV(I,J+1,L)-DIV(I,J-1,L))*RDPDY(I,J)*DDMPV(I,J)
                CKE(I,J)=0.5*(U(I,J,L)*U(I,J,L)-UT(I,J)*UT(I,J)  &
                +V(I,J,L)*V(I,J,L)-VT(I,J)*VT(I,J))
                CONTINUE
        130 END DO
    !
        IF(HEAT)THEN
            DO 140 J=MYJS2,MYJE2
                DO 140 I=MYIS_P1,MYIE_P1
                    T(I,J,L)=T(I,J,L)-RFCP*(CKE(I+IHE(J),J)+CKE(I,J+1)  &
                    +CKE(I+IHW(J),J)+CKE(I,J-1))*HBM2(I,J)
                    CONTINUE
            140 END DO
        ENDIF
        CONTINUE
    150 END DO
!-----------------------------------------------------------------------
    RETURN
    END
