!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
    SUBROUTINE HADZ
!     ******************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:    HADZ        HORIZONTAL ADVECTION OF HEIGHT
!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 96-05-??

! ABSTRACT:
!     HADZ CALCULATES DIAGNOSTICALLY THE CONTRIBUTION OF
!     THE HORIZONTAL ADVECTION OF HEIGHT

! PROGRAM HISTORY LOG:
!   96-05-??  JANJIC     - ORIGINATOR
!   00-01-04  BLACK      - DISTRIBUTED MEMORY AND THREADS

! USAGE: CALL HADZ FROM MAIN PROGRAM
!   INPUT ARGUMENT LIST:
!       NONE

!   OUTPUT ARGUMENT LIST:
!     NONE

!   OUTPUT FILES:
!     NONE

!   SUBPROGRAMS CALLED:

!     UNIQUE: NONE

!     LIBRARY: NONE

!   COMMON BLOCKS: CTLBLK
!                  LOOPS
!                  MASKS
!                  DYNAM
!                  VRBLS
!                  CONTIN
!                  NHYDRO
!                  INDX
! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM SP
!$$$
!***********************************************************************
!-----------------------------------------------------------------------
    INCLUDE "parmeta.f90"
    INCLUDE "mpp.h"
!-----------------------------------------------------------------------
    PARAMETER &
    (JAM=6+2*(JM-10) &
    ,IMJM=IM*JM-JM/2,LM1=LM-1,LP1=LM+1)
    PARAMETER &
    (G=9.8,NTSHY=2)
!-----------------------------------------------------------------------
    LOGICAL :: &
    RUN,FIRST,RESTRT,SIGMA
!----------------------------------------------------------------------
    INCLUDE "COMM_CTLBLK.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_LOOPS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_MASKS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_DYNAM.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_VRBLS.f90"
!-----------------------------------------------------------------------
    include "COMM_CONTIN.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_NHYDRO.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_INDX.f90"
!-----------------------------------------------------------------------
    REAL :: &
    HBMS  (IDIM1:IDIM2,JDIM1:JDIM2),DPDE  (IDIM1:IDIM2,JDIM1:JDIM2) &
    ,UDY   (IDIM1:IDIM2,JDIM1:JDIM2),VDX   (IDIM1:IDIM2,JDIM1:JDIM2) &
    ,UNED  (IDIM1:IDIM2,JDIM1:JDIM2),USED  (IDIM1:IDIM2,JDIM1:JDIM2) &
    ,ZEW   (IDIM1:IDIM2,JDIM1:JDIM2),ZNS   (IDIM1:IDIM2,JDIM1:JDIM2) &
    ,ZNE   (IDIM1:IDIM2,JDIM1:JDIM2),ZSE   (IDIM1:IDIM2,JDIM1:JDIM2)
!-----------------------------------------------------------------------

    IF(NTSD <= NTSHY .OR. HYDRO)THEN
    ! omp parallel do
        DO L=1,LM
            DO J=MYJS,MYJE
                DO I=MYIS,MYIE
                    W(I,J,L)=0.
                ENDDO
            ENDDO
        ENDDO
    !***
        RETURN
    !***
    ENDIF
!***********************************************************************
!-----------------------------------------------------------------------
! omp parallel do
! omp& private (dpde,ihh,ihl,ivh,ivl,ix,jx,udy,uned,used,
! omp&          vdx,zew,zne,zns,zse)
    DO 200 L=1,LM
    !-----------------------------------------------------------------------
        DO J=MYJS_P3,MYJE_P3
            DO I=MYIS_P3,MYIE_P3
                DPDE(I,J)=PDSL(I,J)*DETA(L)
            ENDDO
        ENDDO
    !-----------------------------------------------------------------------
    !--------------MASS FLUXES AND MASS POINTS ADVECTION COMPONENTS---------
    !-----------------------------------------------------------------------
        DO 125 J=2,JM-1
            IF(J >= MY_JS_GLB-JBPAD2 .AND. J <= MY_JE_GLB+JTPAD2)THEN
                JX=J-MY_JS_GLB+1
                IVL=2-MOD(J,2)
                IVH=IM-1
            
                DO 120 I=IVL,IVH
                    IF(I >= MY_IS_GLB-ILPAD2 .AND. I <= MY_IE_GLB+IRPAD2)THEN
                        IX=I-MY_IS_GLB+1
                        UDY(IX,JX)=U(IX,JX,L)*DY
                        ZEW(IX,JX)=UDY(IX,JX) &
                        *(DPDE(IX+IVW(JX),JX  )+DPDE(IX+IVE(JX),JX  )) &
                        *(Z   (IX+IVE(JX),JX,L)-Z   (IX+IVW(JX),JX,L))
                        VDX(IX,JX)=V(IX,JX,L)*DX(IX,JX)
                        ZNS(IX,JX)=VDX(IX,JX) &
                        *(DPDE(IX      ,JX-1  )+DPDE(IX      ,JX+1  )) &
                        *(Z   (IX      ,JX+1,L)-Z   (IX      ,JX-1,L))
                        UNED(IX,JX)=UDY(IX,JX)+VDX(IX,JX)
                        USED(IX,JX)=UDY(IX,JX)-VDX(IX,JX)
                    ENDIF
                120 END DO
            ENDIF
        125 END DO
    !-----------------------------------------------------------------------
    !--------------DIAGONAL FLUXES AND DIAGONALLY AVERAGED WIND-------------
    !-----------------------------------------------------------------------
        DO 145 J=2,JM-2
            IF(J >= MY_JS_GLB-JBPAD1 .AND. J <= MY_JE_GLB+JTPAD1)THEN
                JX=J-MY_JS_GLB+1
                IHL=2-MOD(J+1,2)
                IHH=IM-2+MOD(J,2)
            
                DO 140 I=IHL,IHH
                    IF(I >= MY_IS_GLB-ILPAD1 .AND. I <= MY_IE_GLB+IRPAD1)THEN
                        IX=I-MY_IS_GLB+1
                        ZNE(IX,JX)=(UNED(IX+IHE(JX),JX)   +UNED(IX        ,JX+1)) &
                        *(DPDE(IX        ,JX)   +DPDE(IX+IHE(JX),JX+1)) &
                        *(Z   (IX+IHE(JX),JX+1,L)-Z  (IX      ,JX ,L))
                    ENDIF
                140 END DO
            ENDIF
        145 END DO
    
        DO 165 J=3,JM-1
            IF(J >= MY_JS_GLB-JBPAD1 .AND. J <= MY_JE_GLB+JTPAD1)THEN
                JX=J-MY_JS_GLB+1
                IHL=2-MOD(J+1,2)
                IHH=IM-2+MOD(J,2)
            
                DO 160 I=IHL,IHH
                    IF(I >= MY_IS_GLB-ILPAD1 .AND. I <= MY_IE_GLB+IRPAD1)THEN
                        IX=I-MY_IS_GLB+1
                        ZSE(IX,JX)=(USED(IX+IHE(JX),JX   ) +USED(IX        ,JX-1  )) &
                        *(DPDE(IX        ,JX   ) +DPDE(IX+IHE(JX),JX-1  )) &
                        *(Z   (IX+IHE(JX),JX-1,L)-Z   (IX        ,JX ,L))
                    ENDIF
                160 END DO
            ENDIF
        165 END DO
    !-----------------------------------------------------------------------
    !--------------ADVECTION OF Z-------------------------------------------
    !-----------------------------------------------------------------------
    !      DO 170 J=4,JM-3
    !      IF(J.GE.MY_JS_GLB.AND.J.LE.MY_JE_GLB)THEN
    !        IHL=2+MOD(J,2)
    !        IHH=IM-2
    !        DO 171 I=IHL,IHH
    
        DO 175 J=3,JM-2
            IF(J >= MY_JS_GLB .AND. J <= MY_JE_GLB)THEN
                JX=J-MY_JS_GLB+1
                IHL=2
                IHH=IM-2+MOD(J,2)
            
                DO 170 I=IHL,IHH
                    IF(I >= MY_IS_GLB .AND. I <= MY_IE_GLB)THEN
                        IX=I-MY_IS_GLB+1
                        W(IX,JX,L)= &
                        -(ZEW(IX+IHW(JX),JX  )+ZEW(IX+IHE(JX),JX  ) &
                        +ZNS(IX        ,JX-1)+ZNS(IX        ,JX+1) &
                        +ZNE(IX+IHW(JX),JX-1)+ZNE(IX        ,JX  ) &
                        +ZSE(IX        ,JX  )+ZSE(IX+IHW(JX),JX+1)) &
                        *FAD(IX,JX)*HTM(IX,JX,L)*HBM2(IX,JX)/(DPDE(IX,JX)*DT) &
                        +W(IX,JX,L)
                    ENDIF
                170 END DO
            ENDIF
        175 END DO
    !-----------------------------------------------------------------------
    200 END DO
!-----------------------------------------------------------------------
!***********************************************************************
!      NSMUD=7
!      DO J=MYJS,MYJE
!      DO I=MYIS,MYIE
!        HBMS(I,J)=HBM2(I,J)
!      ENDDO
!      ENDDO
!C
!C    JHL MUST BE ODD!!!
!      JHL=9
!      JHH=JM-JHL+1
!C
!      DO 225 J=JHL,JHH
!      IF(J.GE.MY_JS_GLB.AND.J.LE.MY_JE_GLB)THEN
!        JX=J-MY_JS_GLB+1
!        IHL=JHL/2+1
!        IHH=IM-IHL+MOD(J,2)
!        DO I=IHL,IHH
!        IF(I.GE.MY_IS_GLB.AND.I.LE.MY_IE_GLB)THEN
!          IX=I-MY_IS_GLB+1
!          HBMS(IX,JX)=0.
!        ENDDO
!      ENDIF
!  225 CONTINUE
!C-----------------------------------------------------------------------
!!#omp paralle do private (ihh,ihl,ix,jx,zne,zse)
!      DO 300 L=1,LM
!C-----------------------------------------------------------------------
!      DO KS=1,NSMUD
!C
!        DO J=MYJS,MYJE1
!        DO I=MYIS,MYIE1
!          ZNE(I,J)=(W(I+IHE(J),J+1,L)-W(I,J,L))
!     &             *HTM(I,J,L)*HTM(I+IHE(J),J+1,L)
!        ENDDO
!        ENDDO
!C
!        DO J=MYJS1,MYJE
!        DO I=MYIS,MYIE1
!          ZSE(I,J)=(W(I+IHE(J),J-1,L)-W(I,J,L))
!     &             *HTM(I+IHE(J),J-1,L)*HTM(I,J,L)
!        ENDDO
!        ENDDO
!C
!        DO 250 J=3,JM-2
!        IF(J.GE.MY_JS_GLB.AND.J.LE.MY_JE_GLB)THEN
!          JX=J-MY_JS_GLB+1
!          IHL=2
!          IHH=IM-2+MOD(J,2)
!C
!          DO 245 I=2,IM-2
!          IF(I.GE.MY_IS_GLB.AND.I.LE.MY_IE_GLB)THEN
!            IX=I-MY_IS_GLB+1
!            W(IX,JX,L)=(ZNE(IX,JX)-ZNE(IX+IHW(JX),JX-1)
!     &           +ZSE(IX,JX)-ZSE(IX+IHW(JX),JX+1))
!     &          *HBMS(IX,JX)*0.125+W(IX,JX,L)
!          ENDIF
!  245     CONTINUE
!        ENDIF
!  250   CONTINUE
!      ENDDO
!C----------------------------------------------------------------------
!  300 CONTINUE
!C----------------------------------------------------------------------
    RETURN
    END SUBROUTINE HADZ
