!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
    SUBROUTINE VTADVF
!     ******************************************************************
!$$$  SUBPROGRAM DOCUMENTATION BLOCK
!                .      .    .
! SUBPROGRAM:    VTADVF      VERTICAL ADVECTION
!   PRGRMMR: JANJIC          ORG: W/NP22     DATE: 93-11-17

! ABSTRACT:
!     VTADVF CALCULATES THE CONTRIBUTION OF THE VERTICAL ADVECTION
!     TO THE TENDENCIES OF TEMPERATURE, WIND COMPONENTS, AND TURBULENT
!     KINETIC ENERGY AND THEN UPDATES THOSE VARIABLES.  FOR ALL THESE
!     VARIABLES A SIMPLE CENTERED DIFFERENCE SCHEME IN SPACE IS USED
!     IN CONJUNCTION WITH THE PURE EULER-BACKWARD TIME SCHEME.

! PROGRAM HISTORY LOG:
!   87-06-??  JANJIC     - ORIGINATOR
!   90-??-??  MESINGER   - INSERTED PIECEWISE LINEAR SCHEME FOR
!                          SPECIFIC HUMIDITY
!   95-03-25  BLACK      - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
!   95-11-20  ABELES     - PARALLEL OPTIMIZATION
!   96-03-29  BLACK      - ADDED EXTERNAL EDGE; REMOVED SCRCH COMMON
!   98-11-24  BLACK      - MODIFIED FOR DISTRIBUTED MEMORY

! USAGE: CALL VTADVF FROM MAIN SUBROUTINE DIGFILT
!   INPUT ARGUMENT LIST:
!       NONE

!   OUTPUT ARGUMENT LIST:
!     NONE

!   OUTPUT FILES:
!     NONE

!   SUBPROGRAMS CALLED:

!     UNIQUE: NONE

!     LIBRARY: NONE

!   COMMON BLOCKS: CTLBLK
!                  MASKS
!                  DYNAM
!                  VRBLS
!                  PVRBLS
!                  INDX

! ATTRIBUTES:
!   LANGUAGE: FORTRAN 90
!   MACHINE : IBM SP
!$$$
!***********************************************************************
    PARAMETER &
    (EDQMX=2.E-5,EDQMN=-2.E-5,EPSQ=1.E-12,KSMUD=0)
!-----------------------------------------------------------------------
    INCLUDE "parmeta.f90"
    INCLUDE "mpp.h"
#include "sp.h"
!-----------------------------------------------------------------------
    PARAMETER &
    (IMJM=IM*JM-JM/2,JAM=6+2*(JM-10) &
    , LM1=LM-1,LM2=LM-2,LP1=LM+1)
!-----------------------------------------------------------------------
    LOGICAL :: &
    RUN,FIRST,RESTRT,SIGMA,NOSLA
!----------------------------------------------------------------------
    INCLUDE "COMM_CTLBLK.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_MASKS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_DYNAM.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_VRBLS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_CONTIN.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_PVRBLS.f90"
!-----------------------------------------------------------------------
    INCLUDE "COMM_INDX.f90"
!-----------------------------------------------------------------------
    DIMENSION &
    WFA   ( LM1),WFB   ( LM1)

    DIMENSION &
    ETADTL(IDIM1:IDIM2,JDIM1:JDIM2) &
    ,TTA   (IDIM1:IDIM2,JDIM1:JDIM2),TQ2A  (IDIM1:IDIM2,JDIM1:JDIM2) &
    ,TUA   (IDIM1:IDIM2,JDIM1:JDIM2),TVA   (IDIM1:IDIM2,JDIM1:JDIM2) &
    ,TTB   (IDIM1:IDIM2,JDIM1:JDIM2),TQ2B  (IDIM1:IDIM2,JDIM1:JDIM2) &
    ,TUB   (IDIM1:IDIM2,JDIM1:JDIM2),TVB   (IDIM1:IDIM2,JDIM1:JDIM2) &
    ,VM    (IDIM1:IDIM2,JDIM1:JDIM2) &
    ,RPDX  (IDIM1:IDIM2,JDIM1:JDIM2),RPDY  (IDIM1:IDIM2,JDIM1:JDIM2)

    DIMENSION &
    FNE (IDIM1:IDIM2,JDIM1:JDIM2),FSE (IDIM1:IDIM2,JDIM1:JDIM2)

    DIMENSION &
    TSTL  (IDIM1:IDIM2,JDIM1:JDIM2,LM) &
    ,USTL  (IDIM1:IDIM2,JDIM1:JDIM2,LM) &
    ,VSTL  (IDIM1:IDIM2,JDIM1:JDIM2,LM) &
    ,Q2ST  (IDIM1:IDIM2,JDIM1:JDIM2,LM)
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!--------------DEFINE ADDED UPSTREAM ADVECTION CONSTANTS----------------
!-----------------------------------------------------------------------
    DO 25 L=1,LM1
        WFA(L)=DETA(L  )/(DETA(L)+DETA(L+1))
        WFB(L)=DETA(L+1)/(DETA(L)+DETA(L+1))
    25 END DO
!--------------NO MOISTURE SLOPE ADJUSTMENT IF NOT WANTED---------------
    NOSLA= .FALSE. 
!       IF FALSE, NUMBER OF MOISTURE SLOPE ADJUSTMENT PASSES
    NMSAP=3
!--------------SMOOTHING VERTICAL VELOCITY AT H POINTS------------------
    IF(KSMUD > 0)THEN
    ! omp parallel do
        DO 90 L=1,LM1
            DO 50 J=MYJS_P4,MYJE_P4
                DO 50 I=MYIS_P4,MYIE_P4
                    ETADT(I,J,L)=ETADT(I,J,L)*HBM2(I,J)
            50 END DO
        !-----------------------------------------------------------------------
            NSMUD=KSMUD
        !***
        !***  THE FNE, FSE, ETADTL, AND ETADT ARRAYS
        !***  ARE ON OR ASSOCIATED WITH H POINTS
        !***
            DO 90 KS=1,NSMUD
                DO 80 J=MYJS_P3,MYJE1_P3
                    DO 80 I=MYIS_P3,MYIE_P3
                        FNE(I,J)=(ETADT(I+IHE(J),J+1,L)-ETADT(I,J,L)) &
                        *HTM(I,J,L+1)*HTM(I+IHE(J),J+1,L+1)
                80 END DO
                DO 82 J=MYJS1_P3,MYJE_P3
                    DO 82 I=MYIS_P3,MYIE_P3
                        FSE(I,J)=(ETADT(I+IHE(J),J-1,L)-ETADT(I,J,L)) &
                        *HTM(I+IHE(J),J-1,L+1)*HTM(I,J,L+1)
                82 END DO
                DO 84 J=MYJS2_P1,MYJE2_P1
                    DO 84 I=MYIS_P1,MYIE_P1
                        ETADTL(I,J)=(FNE(I,J)-FNE(I+IHW(J),J-1) &
                        +FSE(I,J)-FSE(I+IHW(J),J+1))*HBM2(I,J)
                84 END DO
                DO 86 J=MYJS2_P1,MYJE2_P1
                    DO 86 I=MYIS_P1,MYIE_P1
                        ETADT(I,J,L)=ETADTL(I,J)*0.125+ETADT(I,J,L)
                86 END DO
        90 END DO
    !-----------------------------------------------------------------------
    ENDIF
!--------------VERTICAL (MATSUNO) ADVECTION OF T------------------------
! omp parallel do
    DO 100 J=MYJS,MYJE
        DO 100 I=MYIS,MYIE
            TTB(I,J)=0.
    100 END DO

    DO 110 L=1,LM1
    ! omp parallel do private(ttak)
        DO 110 J=MYJS2,MYJE2
            DO 110 I=MYIS,MYIE
                TTAK  =(T(I,J,L+1)-T(I,J,L))*ETADT(I,J,L)*F4D
                TSTL(I,J,L)=(TTAK  +TTB(I,J))*RDETA(L)+T(I,J,L)
                TTB(I,J)=TTAK
    110 END DO

! omp parallel do
    DO 120 J=MYJS2,MYJE2
        DO 120 I=MYIS,MYIE
            TSTL(I,J,LM)=T(I,J,LM)+TTB(I,J)*RDETA(LM)
    120 END DO
!--------------SECOND (BACKWARD) MATSUNO STEP---------------------------
! omp parallel do
    DO 125 J=MYJS,MYJE
        DO 125 I=MYIS,MYIE
            TTB(I,J)=0.
    125 END DO

    DO 140 L=1,LM1
    ! omp parallel do private(ttak)
        DO 140 J=MYJS2,MYJE2
            DO 140 I=MYIS,MYIE
                TTAK  =(TSTL(I,J,L+1)-TSTL(I,J,L))*ETADT(I,J,L)*F4D
                T(I,J,L)=(TTAK  +TTB(I,J))*RDETA(L)+T(I,J,L)
                TTB(I,J)=TTAK
    140 END DO

! omp parallel do
    DO 150 J=MYJS2,MYJE2
        DO 150 I=MYIS,MYIE
            T(I,J,LM)=T(I,J,LM)+TTB(I,J)*RDETA(LM)
    150 END DO
!--------------VERTICAL (MATSUNO) ADVECTION OF Q2-----------------------
! omp parallel do
    DO 400 J=MYJS2,MYJE2
        DO 400 I=MYIS,MYIE
            TQ2B(I,J)=Q2(I,J,1)*ETADT(I,J,1)*F4Q2(1)
    400 END DO

    DO 425 L=1,LM2
    ! omp parallel do private(tq2ak)
        DO 425 J=MYJS2,MYJE2
            DO 425 I=MYIS,MYIE
                TQ2AK=(Q2(I,J,L+1)-Q2(I,J,L))*(ETADT(I,J,L)+ETADT(I,J,L+1)) &
                *F4Q2(L+1)
                Q2ST(I,J,L)=TQ2AK+TQ2B(I,J)+Q2(I,J,L)
                TQ2B(I,J)=TQ2AK
    425 END DO

! omp parallel do private(tq2ak)
    DO 440 J=MYJS2,MYJE2
        DO 440 I=MYIS,MYIE
            TQ2AK=(Q2(I,J,LM)-Q2(I,J,LM1))*ETADT(I,J,LM1)*F4Q2(LM)
            Q2ST(I,J,LM1)=TQ2AK+TQ2B(I,J)+Q2(I,J,LM1)
            Q2ST(I,J,LM )=Q2(I,J,LM)
    440 END DO
!--------------SECOND (BACKWARD) MATSUNO STEP---------------------------
! omp parallel do
    DO 450 J=MYJS2,MYJE2
        DO 450 I=MYIS,MYIE
            TQ2B(I,J)=Q2ST(I,J,1)*ETADT(I,J,1)*F4Q2(1)
    450 END DO

    DO 470 L=1,LM2
    ! omp parallel do private(tq2ak)
        DO 470 J=MYJS2,MYJE2
            DO 470 I=MYIS,MYIE
                TQ2AK  =(Q2ST(I,J,L+1)-Q2ST(I,J,L)) &
                *(ETADT(I,J,L)+ETADT(I,J,L+1))*F4Q2(L+1)
                Q2(I,J,L)=TQ2AK+TQ2B(I,J)+Q2(I,J,L)
                TQ2B(I,J)=TQ2AK
    470 END DO

! omp parallel do private(tq2ak)
    DO 480 J=MYJS2,MYJE2
        DO 480 I=MYIS,MYIE
            TQ2AK  =(Q2ST(I,J,LM)-Q2ST(I,J,LM1))*ETADT(I,J,LM1)*F4Q2(LM)
            Q2(I,J,LM1)=TQ2AK+TQ2B(I,J)+Q2(I,J,LM1)
    480 END DO
!--------------DEFINITION OF VARIABLES NEEDED AT V POINTS---------------
! omp parallel do
    DO 500 L=1,LM1
        DO 500 J=MYJS_P1,MYJE_P1
            DO 500 I=MYIS_P1,MYIE_P1
                ETADT(I,J,L)=ETADT(I,J,L)*PDSL(I,J)*HBM2(I,J)
    500 END DO

! omp parallel do
    DO 510 J=MYJS2,MYJE2
        DO 510 I=MYIS,MYIE
            RPDX(I,J)=1./(PDSL(I+IVW(J),J)+PDSL(I+IVE(J),J))
            RPDY(I,J)=1./(PDSL(I,J-1)+PDSL(I,J+1))
    510 END DO
!--------------VERTICAL (MATSUNO) ADVECTION OF U & V--------------------
! omp parallel
    DO 520 J=MYJS,MYJE
        DO 520 I=MYIS,MYIE
            TUB(I,J)=0.
            TVB(I,J)=0.
    520 END DO

    DO 540 L=1,LM1
    ! omp parallel do private(tuak,tvak,vmk)
        DO 540 J=MYJS2,MYJE2
            DO 540 I=MYIS,MYIE
                VMK   =VTM(I,J,L+1)*VBM2(I,J)
                TUAK  =(ETADT(I+IVW(J),J,L)+ETADT(I+IVE(J),J,L)) &
                *(U(I,J,L+1)-U(I,J,L))*RPDX(I,J)*(VMK*F4D)
                USTL(I,J,L)=(TUAK+TUB(I,J))*RDETA(L)+U(I,J,L)
                TUB(I,J)=TUAK
                TVAK  =(ETADT(I,J-1,L)+ETADT(I,J+1,L))*(V(I,J,L+1)-V(I,J,L)) &
                *RPDY(I,J)*(VMK*F4D)
                VSTL(I,J,L)=(TVAK+TVB(I,J))*RDETA(L)+V(I,J,L)
                TVB(I,J)=TVAK
    540 END DO

! omp parallel do
    DO 550 J=MYJS2,MYJE2
        DO 550 I=MYIS,MYIE
            USTL(I,J,LM)=U(I,J,LM)+TUB(I,J)*RDETA(LM)
            VSTL(I,J,LM)=V(I,J,LM)+TVB(I,J)*RDETA(LM)
    550 END DO
!--------------SECOND (BACKWARD) MATSUNO STEP---------------------------
! omp parallel do
    DO 560 J=MYJS,MYJE
        DO 560 I=MYIS,MYIE
            TUB(I,J)=0.
            TVB(I,J)=0.
    560 END DO

    DO 580 L=1,LM1
    ! omp parallel do private(tuak,tvak,vmk)
        DO 580 J=MYJS2,MYJE2
            DO 580 I=MYIS,MYIE
                VMK   =VTM(I,J,L+1)*VBM2(I,J)
                TUAK  =(ETADT(I+IVW(J),J,L)+ETADT(I+IVE(J),J,L)) &
                *(USTL(I,J,L+1)-USTL(I,J,L))*RPDX(I,J)*(VMK*F4D)
                U(I,J,L)=(TUAK+TUB(I,J))*RDETA(L)+U(I,J,L)
                TUB(I,J)=TUAK
                TVAK  =(ETADT(I,J-1,L)+ETADT(I,J+1,L)) &
                *(VSTL(I,J,L+1)-VSTL(I,J,L))*RPDY(I,J)*(VMK*F4D)
                V(I,J,L)=(TVAK+TVB(I,J))*RDETA(L)+V(I,J,L)
                TVB(I,J)=TVAK
    580 END DO

! omp parallel do
    DO 590 J=MYJS2,MYJE2
        DO 590 I=MYIS,MYIE
            U(I,J,LM)=U(I,J,LM)+TUB(I,J)*RDETA(LM)
            V(I,J,LM)=V(I,J,LM)+TVB(I,J)*RDETA(LM)
    590 END DO
!-----------------------------------------------------------------------
    RETURN
    END SUBROUTINE VTADVF
