C&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
SUBROUTINE VTADVF
C ******************************************************************
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C . . .
C SUBPROGRAM: VTADVF VERTICAL ADVECTION
C PRGRMMR: JANJIC ORG: W/NP22 DATE: 93-11-17
C
C ABSTRACT:
C VTADVF CALCULATES THE CONTRIBUTION OF THE VERTICAL ADVECTION
C TO THE TENDENCIES OF TEMPERATURE, WIND COMPONENTS, AND TURBULENT
C KINETIC ENERGY AND THEN UPDATES THOSE VARIABLES. FOR ALL THESE
C VARIABLES A SIMPLE CENTERED DIFFERENCE SCHEME IN SPACE IS USED
C IN CONJUNCTION WITH THE PURE EULER-BACKWARD TIME SCHEME.
C
C PROGRAM HISTORY LOG:
C 87-06-?? JANJIC - ORIGINATOR
C 90-??-?? MESINGER - INSERTED PIECEWISE LINEAR SCHEME FOR
C SPECIFIC HUMIDITY
C 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
C 95-11-20 ABELES - PARALLEL OPTIMIZATION
C 96-03-29 BLACK - ADDED EXTERNAL EDGE; REMOVED SCRCH COMMON
C 98-11-24 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
C
C USAGE: CALL VTADVF FROM MAIN SUBROUTINE DIGFILT
C INPUT ARGUMENT LIST:
C NONE
C
C OUTPUT ARGUMENT LIST:
C NONE
C
C OUTPUT FILES:
C NONE
C
C SUBPROGRAMS CALLED:
C
C UNIQUE: NONE
C
C LIBRARY: NONE
C
C COMMON BLOCKS: CTLBLK
C MASKS
C DYNAM
C VRBLS
C PVRBLS
C INDX
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 90
C MACHINE : IBM SP
C$$$
C***********************************************************************
P A R A M E T E R
& (EDQMX=2.E-5,EDQMN=-2.E-5,EPSQ=1.E-12,KSMUD=0)
C-----------------------------------------------------------------------
INCLUDE "parmeta"
INCLUDE "mpp.h"
#include "sp.h"
C-----------------------------------------------------------------------
P A R A M E T E R
& (IMJM=IM*JM-JM/2,JAM=6+2*(JM-10)
&, LM1=LM-1,LM2=LM-2,LP1=LM+1)
C-----------------------------------------------------------------------
L O G I C A L
& RUN,FIRST,RESTRT,SIGMA,NOSLA
C----------------------------------------------------------------------
INCLUDE "CTLBLK.comm"
C-----------------------------------------------------------------------
INCLUDE "MASKS.comm"
C-----------------------------------------------------------------------
INCLUDE "DYNAM.comm"
C-----------------------------------------------------------------------
INCLUDE "VRBLS.comm"
C-----------------------------------------------------------------------
INCLUDE "CONTIN.comm"
C-----------------------------------------------------------------------
INCLUDE "PVRBLS.comm"
C-----------------------------------------------------------------------
INCLUDE "INDX.comm"
C-----------------------------------------------------------------------
D I M E N S I O N
& WFA ( LM1),WFB ( LM1)
C
D I M E N S I O N
& 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)
C
D I M E N S I O N
& FNE (IDIM1:IDIM2,JDIM1:JDIM2),FSE (IDIM1:IDIM2,JDIM1:JDIM2)
C
D I M E N S I O N
& TSTL (IDIM1:IDIM2,JDIM1:JDIM2,LM)
&,USTL (IDIM1:IDIM2,JDIM1:JDIM2,LM)
&,VSTL (IDIM1:IDIM2,JDIM1:JDIM2,LM)
&,Q2ST (IDIM1:IDIM2,JDIM1:JDIM2,LM)
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C--------------DEFINE ADDED UPSTREAM ADVECTION CONSTANTS----------------
C-----------------------------------------------------------------------
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 CONTINUE
C--------------NO MOISTURE SLOPE ADJUSTMENT IF NOT WANTED---------------
NOSLA=.FALSE.
C IF FALSE, NUMBER OF MOISTURE SLOPE ADJUSTMENT PASSES
NMSAP=3
C--------------SMOOTHING VERTICAL VELOCITY AT H POINTS------------------
IF(KSMUD.GT.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 CONTINUE
C-----------------------------------------------------------------------
NSMUD=KSMUD
C***
C*** THE FNE, FSE, ETADTL, AND ETADT ARRAYS
C*** ARE ON OR ASSOCIATED WITH H POINTS
C***
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))
1 *HTM(I,J,L+1)*HTM(I+IHE(J),J+1,L+1)
80 CONTINUE
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))
1 *HTM(I+IHE(J),J-1,L+1)*HTM(I,J,L+1)
82 CONTINUE
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)
1 +FSE(I,J)-FSE(I+IHW(J),J+1))*HBM2(I,J)
84 CONTINUE
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 CONTINUE
90 CONTINUE
C-----------------------------------------------------------------------
ENDIF
C--------------VERTICAL (MATSUNO) ADVECTION OF T------------------------
!$omp parallel do
DO 100 J=MYJS,MYJE
DO 100 I=MYIS,MYIE
TTB(I,J)=0.
100 CONTINUE
C
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 CONTINUE
C
!$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 CONTINUE
C--------------SECOND (BACKWARD) MATSUNO STEP---------------------------
!$omp parallel do
DO 125 J=MYJS,MYJE
DO 125 I=MYIS,MYIE
TTB(I,J)=0.
125 CONTINUE
C
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 CONTINUE
C
!$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 CONTINUE
C--------------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 CONTINUE
C
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))
1 *F4Q2(L+1)
Q2ST(I,J,L)=TQ2AK+TQ2B(I,J)+Q2(I,J,L)
TQ2B(I,J)=TQ2AK
425 CONTINUE
C
!$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 CONTINUE
C--------------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 CONTINUE
C
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))
1 *(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 CONTINUE
C
!$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 CONTINUE
C--------------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 CONTINUE
C
!$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 CONTINUE
C--------------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 CONTINUE
C
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))
1 *(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))
1 *RPDY(I,J)*(VMK*F4D)
VSTL(I,J,L)=(TVAK+TVB(I,J))*RDETA(L)+V(I,J,L)
TVB(I,J)=TVAK
540 CONTINUE
C
!$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 CONTINUE
C--------------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 CONTINUE
C
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))
1 *(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))
1 *(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 CONTINUE
C
!$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 CONTINUE
C-----------------------------------------------------------------------
RETURN
END