*IF DEF,A10_1A VERTVE1A.2
C ******************************COPYRIGHT****************************** GTS2F400.11611
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.11612
C GTS2F400.11613
C Use, duplication or disclosure of this code is subject to the GTS2F400.11614
C restrictions as set forth in the contract. GTS2F400.11615
C GTS2F400.11616
C Meteorological Office GTS2F400.11617
C London Road GTS2F400.11618
C BRACKNELL GTS2F400.11619
C Berkshire UK GTS2F400.11620
C RG12 2SZ GTS2F400.11621
C GTS2F400.11622
C If no contract has been raised with this copy of the code, the use, GTS2F400.11623
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.11624
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.11625
C Modelling at the above address. GTS2F400.11626
C ******************************COPYRIGHT****************************** GTS2F400.11627
C GTS2F400.11628
CLL SUBROUTINE VERT_VEL ------------------------------------------- VERTVE1A.3
CLL VERTVE1A.4
CLL PURPOSE: CALCULATES DIVERGENCE FROM MASS-WEIGHTED HORIZONTAL VERTVE1A.5
CLL VELOCITY COMPONENTS USING EQUATION (30). VERTVE1A.6
CLL THEN DERIVES MASS-WEIGHTED VERTICAL VELOCITY VERTVE1A.7
CLL FIELD, EQUATION (29). VERTVE1A.8
CLL NOT SUITABLE FOR SINGLE COLUMN USE. VERTVE1A.9
CLL VERSION FOR CRAY Y-MP VERTVE1A.10
CLL WRITTEN BY M.H MAWSON. VERTVE1A.11
CLL VERTVE1A.12
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: VERTVE1A.13
CLL VERSION DATE VERTVE1A.14
CLL 3.1 24/02/93 Tidy code to remove QA Fortran messages. MM240293.15
CLL 3.4 23/06/94 Argument LLINTS added and passed to CALC_TS GSS1F304.963
CLL DEF NOWHBR replaced by LOGICAL LWHITBROM GSS1F304.964
CLL S.J.Swarbrick GSS1F304.965
CLL 4.0 1/02/95 Polar weighting defined by polar values of ACH1F400.10
CLL SEC_P_LATITUDE made consistent with other parts ACH1F400.11
CLL of dynamics. C.D.Hall ACH1F400.12
! 3.5 28/03/95 MPP code addition. P.Burton APB0F305.351
! 4.1 02/04/96 Added TYPFLDPT arguments to dynamics routines APB0F401.500
! which allows many of the differences between APB0F401.501
! MPP and "normal" code to be at top level. APB0F401.502
! Rewrite of summations. APB0F401.503
! P.Burton APB0F401.504
! 4.4 17/07/97 SCALAR calculated using SEC_P_LATITUDE at both AIE0F404.1
! poles for non MPP code to enable bit comparison AIE0F404.2
! with MPP code. I Edmond AIE0F404.3
CLL VERTVE1A.15
CLL PROGRAMMING STANDARD: UNIFIED MODEL DOCUMENTATION PAPER NO. 4, VERTVE1A.16
CLL STANDARD B. VERSION 2, DATED 18/01/90 VERTVE1A.17
CLL VERTVE1A.18
CLL SYSTEM COMPONENTS COVERED: P112 VERTVE1A.19
CLL VERTVE1A.20
CLL SYSTEM TASK: P1 VERTVE1A.21
CLL VERTVE1A.22
CLL DOCUMENTATION: THE EQUATIONS USED ARE (29) AND (30) VERTVE1A.23
CLL IN UNIFIED MODEL DOCUMENTATION PAPER NO. 10 VERTVE1A.24
CLL M.J.P. CULLEN,T.DAVIES AND M.H. MAWSON, VERTVE1A.25
CLL VERSION 17 DATED 11/02/91. VERTVE1A.26
CLLEND------------------------------------------------------------- VERTVE1A.27
VERTVE1A.28
C*L ARGUMENTS:--------------------------------------------------- VERTVE1A.29
VERTVE1A.30
SUBROUTINE VERT_VEL 2,3VERTVE1A.31
1 (U,V,ETADOT_MEAN,SEC_P_LATITUDE,SUM_DIVERGENCE, VERTVE1A.32
2 U_FIELD,P_FIELD,P_LEVELS, APB0F401.505
*CALL ARGFLDPT 
APB0F401.506
3 ROW_LENGTH,LATITUDE_STEP_INVERSE, VERTVE1A.34
4 LONGITUDE_STEP_INVERSE,ADJUSTMENT_STEPS,AKH, VERTVE1A.35
5 BKH,RS,CALL_NUMBER,RECIP_RS_SQUARED_SURFACE, VERTVE1A.36
6 PSTAR,LLINTS,LWHITBROM) GSS1F304.966
VERTVE1A.38
IMPLICIT NONE VERTVE1A.39
LOGICAL LLINTS, LWHITBROM GSS1F304.967
VERTVE1A.40
INTEGER VERTVE1A.41
* ROW_LENGTH !IN NUMBER OF POINTS PER ROW VERTVE1A.42
*, P_LEVELS !IN NUMBER OF PRESSURE LEVELS OF DATA VERTVE1A.43
*, P_FIELD !IN NUMBER OF POINTS IN PRESSURE FIELD. VERTVE1A.44
*, U_FIELD !IN NUMBER OF POINTS IN VELOCITY FIELD. VERTVE1A.45
*, ADJUSTMENT_STEPS !IN HOLDS NUMBER OF ADJUSTMENT STEPS. VERTVE1A.48
*, CALL_NUMBER !IN CURRENT ADJUSTMENT STEP NUMBER VERTVE1A.49
! All TYPFLDPT arguments are intent IN APB0F401.507
*CALL TYPFLDPT APB0F401.508
VERTVE1A.50
REAL VERTVE1A.51
* U(U_FIELD,P_LEVELS) !IN. MASS WEIGHTED U VELOCITY. VERTVE1A.52
*,V(U_FIELD,P_LEVELS) !IN. MASS WEIGHTED V VELOCITY* VERTVE1A.53
* ! COS(LATITUDE) VERTVE1A.54
*,SEC_P_LATITUDE(P_FIELD)!IN 1/COS(LAT) AT P POINTS VERTVE1A.55
*,LONGITUDE_STEP_INVERSE !IN 1/LONGITUDE INCREMENT VERTVE1A.56
*,LATITUDE_STEP_INVERSE !IN 1/LATITUDE INCREMENT VERTVE1A.57
*,BKH(P_LEVELS+1) !IN. HOLDS COEFFICIENT WHICH VERTVE1A.58
* ! MULTIPLIES PSTAR IN HYBRID CO-ORDS VERTVE1A.59
* ! AT LEVELS K-1/2 VERTVE1A.60
*,AKH(P_LEVELS+1) !IN. HOLDS FIRST COEFFICIENT VERTVE1A.61
* ! IN HYBRID CO-ORDS AT LEVELS K-1/2 VERTVE1A.62
*,RS(P_FIELD,P_LEVELS) !IN. RADIUS OF EARTH AT P POINTS. VERTVE1A.63
*,PSTAR(P_FIELD) !IN. SURFACE PRESSURE AT P POINTS. VERTVE1A.64
VERTVE1A.65
REAL VERTVE1A.66
* SUM_DIVERGENCE(P_FIELD,P_LEVELS) !OUT. HOLDS MASS VERTVE1A.67
* ! WEIGHTED VERTICAL VELOCITY. VERTVE1A.68
VERTVE1A.69
REAL VERTVE1A.70
* ETADOT_MEAN(P_FIELD,P_LEVELS) !INOUT. HOLDS ACCUMULATED MASS- VERTVE1A.71
* ! WEIGHTED VERTICAL VELOCITY DIVIDED VERTVE1A.72
* ! BY NUMBER OF ADJUSTMENT_STEPS. VERTVE1A.73
*,RECIP_RS_SQUARED_SURFACE(P_FIELD) !INOUT. HOLDS 1./(RS*RS) AT VERTVE1A.74
* ! MODEL SURFACE. SET ON FIRST CALL VERTVE1A.75
* ! AND HELD CONSTANT FOR ALL VERTVE1A.76
* ! SUBSEQUENT ONES. VERTVE1A.77
C*--------------------------------------------------------------------- VERTVE1A.78
*IF DEF,MPP APB0F305.352
! Parameters for MPP code APB0F401.509
*ENDIF APB0F305.355
VERTVE1A.79
C*L 3 LOCAL ARRAYS NEEDED. ----------------------------------------- VERTVE1A.80
VERTVE1A.81
REAL VERTVE1A.82
* DU_DLONGITUDE(P_FIELD) VERTVE1A.83
*, DV_DLATITUDE(P_FIELD) VERTVE1A.84
*, DV_DLATITUDE2(U_FIELD) VERTVE1A.85
*IF DEF,MPP,AND,DEF,GLOBAL APB0F305.356
REAL APB0F401.510
& sum_tmp(ROW_LENGTH-2*EW_Halo,P_LEVELS), APB0F401.511
& sums(P_LEVELS) APB0F401.512
*ENDIF APB0F305.359
C*--------------------------------------------------------------------- VERTVE1A.86
VERTVE1A.87
C DEFINE COUNT VARIABLES FOR DO LOOPS ETC. VERTVE1A.88
INTEGER VERTVE1A.89
* I,J,K VERTVE1A.90
* ,START_POINT,END_POINT MM240293.16
*,LEVEL VERTVE1A.92
&, POINTS APB0F401.513
*IF DEF,MPP APB0F305.360
INTEGER info APB0F305.361
*ENDIF APB0F305.362
C DEFINE LOCAL SCALARS VERTVE1A.93
REAL VERTVE1A.94
* RECIP_ADJUSTMENT_STEPS VERTVE1A.95
*IF -DEF,MPP AIE0F404.4
REAL AIE0F404.5
* SCALAR1 AIE0F404.6
*, SCALAR2 AIE0F404.7
*ELSE AIE0F404.8
REAL AIE0F404.9
* SCALAR AIE0F404.10
*ENDIF AIE0F404.11
VERTVE1A.97
*IF DEF,GLOBAL VERTVE1A.98
REAL SUM_N,SUM_S VERTVE1A.99
*ENDIF VERTVE1A.100
VERTVE1A.101
C*--------------------------------------------------------------------- VERTVE1A.104
*CALL C_A VERTVE1A.105
C*L EXTERNAL SUBROUTINE CALLS:- ( IF LWHITBROM ) --------------- GSS1F304.968
EXTERNAL CALC_RS VERTVE1A.108
C*--------------------------------------------------------------------- VERTVE1A.109
VERTVE1A.111
CL MAXIMUM VECTOR LENGTH ASSUMED IS ROWS*ROW_LENGTH. VERTVE1A.112
CL--------------------------------------------------------------------- VERTVE1A.113
CL INTERNAL STRUCTURE. VERTVE1A.114
! All references to poles in the comments, apply equally to the APB0F401.514
! Northern and Southern rows when used in LAM configuration. APB0F401.515
! References to halos apply only to MPP code. APB0F401.516
CL--------------------------------------------------------------------- VERTVE1A.115
CL VERTVE1A.116
CL--------------------------------------------------------------------- VERTVE1A.117
CL SECTION 1. CALCULATE DIVERGENCE AS IN EQUATION (30). VERTVE1A.118
CL--------------------------------------------------------------------- VERTVE1A.119
VERTVE1A.120
POINTS=LAST_P_VALID_PT-FIRST_VALID_PT+1 APB0F401.517
! Number of points to be processed by CALC_RS. For non-MPP runs this APB0F401.518
! is simply P_FIELD, for MPP, it is all the points, minus any APB0F401.519
! unused halo areas (ie. the halo above North pole row, and beneath APB0F401.520
! South pole row) APB0F401.521
APB0F401.522
C LOOP OVER LEVELS VERTVE1A.121
DO 100 K=1,P_LEVELS VERTVE1A.122
VERTVE1A.123
C CALCULATE DU/D(LAMDA) VERTVE1A.124
! Loop over all points except South Pole, missing halos APB0F401.523
DO 110 I=START_POINT_NO_HALO - ROW_LENGTH +1, APB0F401.524
& END_P_POINT_NO_HALO APB0F401.525
DU_DLONGITUDE(I) = LONGITUDE_STEP_INVERSE*(U(I,K)-U(I-1,K)) VERTVE1A.126
110 CONTINUE VERTVE1A.127
VERTVE1A.128
C CALCULATE DV/D(PHI) VERTVE1A.129
! Loop over all non-polar points, missing halos APB0F401.526
DO 120 I=START_POINT_NO_HALO , END_P_POINT_NO_HALO APB0F401.527
DV_DLATITUDE(I) = LATITUDE_STEP_INVERSE*(V(I-ROW_LENGTH,K) VERTVE1A.131
* -V(I,K)) VERTVE1A.132
120 CONTINUE VERTVE1A.133
VERTVE1A.134
*IF DEF,GLOBAL VERTVE1A.135
C CALCULATE AVERAGE OF DV_DLATITUDE VERTVE1A.136
! Loop over all non-polar points, missing halos and first point APB0F401.528
DO 130 I=START_POINT_NO_HALO+1 , END_P_POINT_NO_HALO APB0F401.529
DV_DLATITUDE2(I) = DV_DLATITUDE(I) + DV_DLATITUDE(I-1) VERTVE1A.138
130 CONTINUE VERTVE1A.139
VERTVE1A.140
*IF -DEF,MPP APB0F305.363
C NOW DO FIRST POINT ON EACH SLICE FOR DU_DLONGITUDE AND DV_DLATITUDE2 VERTVE1A.141
! Set the first point of the Northern row we missed in loop 110 APB0F401.530
I=START_POINT_NO_HALO - ROW_LENGTH APB0F401.531
DU_DLONGITUDE(I) = LONGITUDE_STEP_INVERSE * (U(I,K) VERTVE1A.143
* - U(I + ROW_LENGTH - 1,K)) VERTVE1A.144
! Loop over all non-polar points, missing halos APB0F401.532
DO 140 I=START_POINT_NO_HALO , END_P_POINT_NO_HALO, APB0F401.533
& ROW_LENGTH APB0F401.534
DU_DLONGITUDE(I) = LONGITUDE_STEP_INVERSE * (U(I,K) VERTVE1A.146
* - U(I + ROW_LENGTH - 1,K)) VERTVE1A.147
DV_DLATITUDE2(I)=DV_DLATITUDE(I)+DV_DLATITUDE(I-1+ROW_LENGTH) VERTVE1A.148
140 CONTINUE VERTVE1A.149
*ELSE APB0F305.364
! Set the first element of arrays where loops have skipped: APB0F401.535
! Loop 110: APB0F401.536
DU_DLONGITUDE(START_POINT_NO_HALO - ROW_LENGTH)= APB0F401.537
& DU_DLONGITUDE(START_POINT_NO_HALO - ROW_LENGTH + 1) APB0F401.538
! Loop 130: APB0F401.539
DV_DLATITUDE2(START_POINT_NO_HALO)= APB0F401.540
& DV_DLATITUDE2(START_POINT_NO_HALO+1) APB0F401.541
*ENDIF APB0F305.370
VERTVE1A.150
C CALCULATE DIVERGENCES. VERTVE1A.151
VERTVE1A.152
! Loop over all non-polar points, missing halos APB0F401.542
DO 150 J=START_POINT_NO_HALO , END_P_POINT_NO_HALO APB0F401.543
SUM_DIVERGENCE(J,K)= SEC_P_LATITUDE(J)*.5*(DU_DLONGITUDE(J) VERTVE1A.154
* + DU_DLONGITUDE(J-ROW_LENGTH) VERTVE1A.155
* + DV_DLATITUDE2(J)) VERTVE1A.156
150 CONTINUE VERTVE1A.157
*ELSE VERTVE1A.158
! I don't think the following code is required: APB0F401.544
! DU_DLONGITUDE(1) = 0. APB0F401.545
! MPP: DU_DLONGITUDE(Offy*ROW_LENGTH+1) = 0. APB0F401.546
VERTVE1A.160
C CALCULATE DIVERGENCES. VERTVE1A.161
VERTVE1A.162
! Loop over all non-polar points, missing first and last points APB0F401.547
DO 130 J=START_POINT_NO_HALO+1 , END_P_POINT_NO_HALO-1 APB0F401.548
SUM_DIVERGENCE(J,K)= SEC_P_LATITUDE(J)*.5*(DU_DLONGITUDE(J) VERTVE1A.164
* + DU_DLONGITUDE(J-ROW_LENGTH) VERTVE1A.165
* + DV_DLATITUDE(J) + DV_DLATITUDE(J-1)) VERTVE1A.166
130 CONTINUE VERTVE1A.167
VERTVE1A.168
*IF DEF,MPP APB0F305.375
! Put some real numbers at start and end APB0F305.376
SUM_DIVERGENCE(START_POINT_NO_HALO,K)=0.0 APB0F401.549
SUM_DIVERGENCE(END_P_POINT_NO_HALO,K)=0.0 APB0F401.550
*ENDIF APB0F305.379
C ZERO DIVERGENCES ON BOUNDARIES. VERTVE1A.169
*IF -DEF,MPP APB0F305.380
! Loop over all non-polar points at left edge of grid (ie. first APB0F401.551
! point of each row) APB0F401.552
DO 140 J=START_POINT_NO_HALO,END_P_POINT_NO_HALO,ROW_LENGTH APB0F401.553
SUM_DIVERGENCE(J,K) = 0. VERTVE1A.171
SUM_DIVERGENCE(J+ROW_LENGTH-1,K) = 0. VERTVE1A.172
140 CONTINUE VERTVE1A.173
*ELSE APB0F305.381
IF (at_left_of_LPG) THEN APB0F401.554
! Loop over first real (ie. not halo) non-polar point of each row APB0F401.555
DO J=START_POINT_NO_HALO+FIRST_ROW_PT-1, APB0F401.556
& END_P_POINT_NO_HALO,ROW_LENGTH APB0F401.557
SUM_DIVERGENCE(J,K) = 0.0 APB0F401.558
ENDDO APB0F401.559
ENDIF APB0F401.560
APB0F401.561
IF (at_right_of_LPG) THEN APB0F401.562
! Loop over last real (ie. not halo) non-polar point of each row APB0F401.563
DO J=START_POINT_NO_HALO+LAST_ROW_PT-1, APB0F401.564
& END_P_POINT_NO_HALO,ROW_LENGTH APB0F401.565
SUM_DIVERGENCE(J,K) = 0.0 APB0F401.566
ENDDO APB0F401.567
ENDIF APB0F401.568
*ENDIF APB0F305.392
*ENDIF VERTVE1A.174
VERTVE1A.175
VERTVE1A.176
C END LOOP OVER LEVELS VERTVE1A.191
100 CONTINUE VERTVE1A.192
*IF DEF,GLOBAL APB0F401.569
! Calculate divergence at poles by summing DV/D(LAT) around polar APB0F401.570
! circle and averaging. APB0F401.571
APB0F401.572
! START_POINT=TOP_ROW_START+LAST_ROW_PT-1 ! Last point of NP row APB0F401.573
! END_POINT= P_BOT_ROW_START+FIRST_ROW_PT-1 ! First point of SP row APB0F401.574
START_POINT=START_POINT_NO_HALO-1 APB0F401.575
END_POINT=END_P_POINT_NO_HALO+1 APB0F401.576
APB0F401.577
APB0F401.578
! New start and end points to include one point of each pole APB0F401.579
APB0F401.580
*IF -DEF,MPP APB0F401.581
SCALAR1= SEC_P_LATITUDE(TOP_ROW_START)*LATITUDE_STEP_INVERSE / AIE0F404.12
& GLOBAL_ROW_LENGTH APB0F401.583
SCALAR2= SEC_P_LATITUDE(P_BOT_ROW_START) AIE0F404.13
& *LATITUDE_STEP_INVERSE / GLOBAL_ROW_LENGTH AIE0F404.14
APB0F401.584
DO K=1,P_LEVELS APB0F401.585
SUM_N=0.0 APB0F401.586
SUM_S=0.0 APB0F401.587
DO I=1,ROW_LENGTH APB0F401.588
SUM_N = SUM_N - V(I,K)*SCALAR1 AIE0F404.15
SUM_S = SUM_S + V(U_BOT_ROW_START-1+I,K)*SCALAR2 AIE0F404.16
ENDDO APB0F401.591
SUM_DIVERGENCE(START_POINT,K) = SUM_N APB0F401.592
SUM_DIVERGENCE(END_POINT,K) = SUM_S APB0F401.593
ENDDO APB0F401.594
*ELSE APB0F401.595
! Do sum across North Pole APB0F401.596
IF (at_top_of_LPG) THEN APB0F401.597
SCALAR = SEC_P_LATITUDE(TOP_ROW_START)*LATITUDE_STEP_INVERSE / APB0F401.598
& GLOBAL_ROW_LENGTH APB0F401.599
DO K=1,P_LEVELS APB0F401.600
! Copy up the items to be summed into a temporary array APB0F401.601
! Loop over all the non-halo points on a row APB0F401.602
DO I=FIRST_ROW_PT,LAST_ROW_PT APB0F401.603
sum_tmp(I-FIRST_ROW_PT+1,K)= APB0F401.604
& -V(TOP_ROW_START+I-1,K)*SCALAR APB0F401.605
ENDDO APB0F401.606
ENDDO APB0F401.607
APB0F401.608
! And perform the sum APB0F401.609
CALL GCG_RVECSUMR(ROW_LENGTH-2*EW_Halo , ROW_LENGTH-2*EW_Halo, APB0F401.610
& 1,P_LEVELS,sum_tmp,GC_ROW_GROUP, APB0F401.611
& info,sums) APB0F401.612
APB0F401.613
! And store the result back APB0F401.614
DO K=1,P_LEVELS APB0F401.615
SUM_DIVERGENCE(START_POINT,K)=sums(K) APB0F401.616
ENDDO APB0F401.617
ELSE ! If this processor not at top of LPG APB0F401.618
START_POINT=START_POINT_NO_HALO ! no North Pole point here APB0F401.619
ENDIF APB0F401.620
APB0F401.621
! And sum across South Pole APB0F401.622
IF (at_base_of_LPG) THEN APB0F401.623
SCALAR=SEC_P_LATITUDE(P_BOT_ROW_START)*LATITUDE_STEP_INVERSE/ APB0F401.624
& GLOBAL_ROW_LENGTH APB0F401.625
APB0F401.626
DO K=1,P_LEVELS APB0F401.627
! Copy up the items to be summed into a temporary array APB0F401.628
! Loop over all the non-halo points on a row APB0F401.629
DO I=FIRST_ROW_PT,LAST_ROW_PT APB0F401.630
sum_tmp(I-FIRST_ROW_PT+1,K)= APB0F401.631
& V(U_BOT_ROW_START+I-1,K)*SCALAR APB0F401.632
ENDDO APB0F401.633
ENDDO APB0F401.634
APB0F401.635
! And perform the sum APB0F401.636
CALL GCG_RVECSUMR(ROW_LENGTH-2*EW_Halo , ROW_LENGTH-2*EW_Halo, APB0F401.637
& 1,P_LEVELS,sum_tmp,GC_ROW_GROUP, APB0F401.638
& info,sums) APB0F401.639
APB0F401.640
! And store the result back APB0F401.641
DO K=1,P_LEVELS APB0F401.642
SUM_DIVERGENCE(END_POINT,K)=sums(K) APB0F401.643
ENDDO APB0F401.644
ELSE ! If this processor not at the bottom of LPG APB0F401.645
END_POINT=END_P_POINT_NO_HALO ! no South Pole point here APB0F401.646
ENDIF APB0F401.647
*ENDIF APB0F401.648
*ELSE APB0F401.649
START_POINT=START_POINT_NO_HALO APB0F401.650
END_POINT=END_P_POINT_NO_HALO APB0F401.651
*ENDIF APB0F401.652
VERTVE1A.193
CL VERTVE1A.194
CL--------------------------------------------------------------------- VERTVE1A.195
CL SECTION 2. CALCULATE VERTICAL VELOCITY. EQUATION (29). VERTVE1A.196
CL--------------------------------------------------------------------- VERTVE1A.197
VERTVE1A.198
VERTVE1A.207
C --------------------------------------------------------------------- VERTVE1A.208
CL SECTION 2.1 SUM DIVERGENCES THROUGHOUT ATMOSPHERE. VERTVE1A.209
C --------------------------------------------------------------------- VERTVE1A.210
VERTVE1A.211
C BY CODING THE SUMMATION AS FOLLOWS THE VALUES PUT INTO EACH LEVEL VERTVE1A.212
C OF SUM_DIVERGENCE ARE THE ONES NEEDED FOR THE SECOND SUMMATION TERM VERTVE1A.213
C IN EQUATION 29, WHILE THE TOTAL SUM IS HELD IN SUM_DIVERGENCE( ,1) VERTVE1A.214
VERTVE1A.215
DO 210 K=P_LEVELS-1,1,-1 VERTVE1A.216
DO 212 I=START_POINT,END_POINT MM240293.21
SUM_DIVERGENCE(I,K)= SUM_DIVERGENCE(I,K)+SUM_DIVERGENCE(I,K+1) VERTVE1A.218
212 CONTINUE VERTVE1A.219
210 CONTINUE VERTVE1A.220
VERTVE1A.221
C --------------------------------------------------------------------- VERTVE1A.222
CL SECTION 2.2 CALCULATE MASS-WEIGHTED VERTICAL VELOCITY. VERTVE1A.223
CL CALCULATE 1/(RS*RS) IF THIS IS CALL NUMBER ONE. VERTVE1A.224
C --------------------------------------------------------------------- VERTVE1A.225
VERTVE1A.226
IF(CALL_NUMBER.EQ.1) THEN VERTVE1A.227
CL CALCULATE 1/(RS*RS) AT MODEL SURFACE VERTVE1A.228
GSS1F304.969
IF (.NOT.LWHITBROM) THEN GSS1F304.970
GSS1F304.971
! loop over all points, including valid halos APB0F401.653
DO 220 I=FIRST_VALID_PT,LAST_P_VALID_PT APB0F401.654
RECIP_RS_SQUARED_SURFACE(I) = 1./(A*A) VERTVE1A.231
220 CONTINUE VERTVE1A.232
GSS1F304.972
ELSE GSS1F304.973
GSS1F304.974
LEVEL=1 VERTVE1A.234
C DV_DLATITUDE,DU_DLONGITUDE ARE DUMMY ARRAYS REQUIRED BY CALC_RS AND VERTVE1A.235
C THE CONTENTS TRANSFERED TO AND RETURNED FROM IT ARE IRRELEVANT. VERTVE1A.236
CALL CALC_RS(PSTAR(FIRST_VALID_PT),AKH,BKH, APB0F401.655
& DV_DLATITUDE(FIRST_VALID_PT), APB0F401.656
& DU_DLONGITUDE(FIRST_VALID_PT), APB0F401.657
* RECIP_RS_SQUARED_SURFACE(FIRST_VALID_PT), APB0F401.658
& POINTS,LEVEL,P_LEVELS,LLINTS) APB0F401.659
! loop over all points, including valid halos APB0F401.660
DO 320 I=FIRST_VALID_PT,LAST_P_VALID_PT APB0F401.661
RECIP_RS_SQUARED_SURFACE(I)= 1./(RECIP_RS_SQUARED_SURFACE(I)* VERTVE1A.240
* RECIP_RS_SQUARED_SURFACE(I)) VERTVE1A.241
320 CONTINUE GSS1F304.978
GSS1F304.979
END IF ! LWHITBROM GSS1F304.980
GSS1F304.981
END IF VERTVE1A.244
VERTVE1A.245
C DP/D(PSTAR) IS NOTHING MORE THAN THE BK COEFFICENT. VERTVE1A.246
*IF -DEF,STRAT VERTVE1A.247
VERTVE1A.248
DO 222 K= P_LEVELS,2,-1 VERTVE1A.249
CFPP$ SELECT(CONCUR) VERTVE1A.250
DO 224 I=START_POINT,END_POINT MM240293.22
SUM_DIVERGENCE(I,K)= SUM_DIVERGENCE(I,K) - BKH(K) VERTVE1A.252
* * SUM_DIVERGENCE(I,1)*RS(I,K)*RS(I,K)* VERTVE1A.253
* RECIP_RS_SQUARED_SURFACE(I) VERTVE1A.254
224 CONTINUE VERTVE1A.255
222 CONTINUE VERTVE1A.256
VERTVE1A.257
*ENDIF VERTVE1A.258
C --------------------------------------------------------------------- VERTVE1A.259
CL SECTION 2.3 ACCUMULATE MASS-WEIGHTED VERTICAL VELOCITY DIVIDED VERTVE1A.260
CL BY NUMBER OF ADJUSTMENT TIMESTEPS. VERTVE1A.261
C --------------------------------------------------------------------- VERTVE1A.262
VERTVE1A.263
RECIP_ADJUSTMENT_STEPS = 1./ ADJUSTMENT_STEPS VERTVE1A.264
VERTVE1A.265
DO 230 K= 1,P_LEVELS VERTVE1A.266
CFPP$ SELECT(CONCUR) VERTVE1A.267
DO 232 I=START_POINT,END_POINT MM240293.23
ETADOT_MEAN(I,K)= ETADOT_MEAN(I,K) + SUM_DIVERGENCE(I,K) VERTVE1A.269
* * RECIP_ADJUSTMENT_STEPS VERTVE1A.270
232 CONTINUE VERTVE1A.271
230 CONTINUE VERTVE1A.272
VERTVE1A.273
*IF DEF,GLOBAL VERTVE1A.274
C IF GLOBAL MODEL SET ALL POINTS AT POLES TO THE UNIQUE VALUE. VERTVE1A.275
DO 240 K=1,P_LEVELS VERTVE1A.276
CDIR$ IVDEP VERTVE1A.277
! Fujitsu vectorization directive GRB0F405.553
!OCL NOVREC GRB0F405.554
*IF DEF,MPP APB0F401.662
IF (at_top_of_LPG) THEN APB0F401.663
*ENDIF APB0F401.664
! Loop over North Pole points, missing out the last (START_POINT) APB0F401.665
! point. APB0F401.666
DO I=TOP_ROW_START+FIRST_ROW_PT-1, APB0F401.667
! & TOP_ROW_START+LAST_ROW_PT-2 APB0F401.668
& TOP_ROW_START+LAST_ROW_PT-1 APB0F401.669
ETADOT_MEAN(I,K)=ETADOT_MEAN(START_POINT,K) APB0F401.670
SUM_DIVERGENCE(I,K)=SUM_DIVERGENCE(START_POINT,K) APB0F401.671
ENDDO APB0F401.672
*IF DEF,MPP APB0F401.673
ENDIF ! at North Pole APB0F401.674
*ENDIF APB0F401.675
APB0F401.676
*IF DEF,MPP APB0F401.677
IF (at_base_of_LPG) THEN APB0F401.678
*ENDIF APB0F401.679
! Loop over South Pole points, missing out the first (END_POINT) APB0F401.680
! point. APB0F401.681
! DO I=P_BOT_ROW_START+FIRST_ROW_PT, APB0F401.682
DO I=P_BOT_ROW_START+FIRST_ROW_PT-1, APB0F401.683
& P_BOT_ROW_START+LAST_ROW_PT-1 APB0F401.684
ETADOT_MEAN(I,K)=ETADOT_MEAN(END_POINT,K) APB0F401.685
SUM_DIVERGENCE(I,K)=SUM_DIVERGENCE(END_POINT,K) APB0F401.686
ENDDO APB0F401.687
*IF DEF,MPP APB0F401.688
ENDIF ! at South Pole APB0F401.689
*ENDIF APB0F401.690
240 CONTINUE VERTVE1A.284
*ENDIF VERTVE1A.285
VERTVE1A.286
CL END OF ROUTINE VERT_VEL VERTVE1A.287
VERTVE1A.288
RETURN VERTVE1A.289
END VERTVE1A.290
*ENDIF VERTVE1A.291