*IF DEF,A10_1B VERTVE1B.2
C ******************************COPYRIGHT****************************** VERTVE1B.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. VERTVE1B.4
C VERTVE1B.5
C Use, duplication or disclosure of this code is subject to the VERTVE1B.6
C restrictions as set forth in the contract. VERTVE1B.7
C VERTVE1B.8
C Meteorological Office VERTVE1B.9
C London Road VERTVE1B.10
C BRACKNELL VERTVE1B.11
C Berkshire UK VERTVE1B.12
C RG12 2SZ VERTVE1B.13
C VERTVE1B.14
C If no contract has been raised with this copy of the code, the use, VERTVE1B.15
C duplication or disclosure of it is strictly prohibited. Permission VERTVE1B.16
C to do so must first be obtained in writing from the Head of Numerical VERTVE1B.17
C Modelling at the above address. VERTVE1B.18
C ******************************COPYRIGHT****************************** VERTVE1B.19
C VERTVE1B.20
CLL SUBROUTINE VERT_VEL ------------------------------------------- VERTVE1B.21
CLL VERTVE1B.22
CLL PURPOSE: CALCULATES DIVERGENCE FROM MASS-WEIGHTED HORIZONTAL VERTVE1B.23
CLL VELOCITY COMPONENTS USING EQUATION (30). VERTVE1B.24
CLL THEN DERIVES MASS-WEIGHTED VERTICAL VELOCITY VERTVE1B.25
CLL FIELD, EQUATION (29). VERTVE1B.26
CLL NOT SUITABLE FOR SINGLE COLUMN USE. VERTVE1B.27
CLL VERSION FOR CRAY Y-MP VERTVE1B.28
CLL WRITTEN BY M.H MAWSON. VERTVE1B.29
CLL VERTVE1B.30
CLL MODEL MODIFICATION HISTORY: VERTVE1B.31
CLL VERSION DATE VERTVE1B.32
!LL 4.2 28/10/96 New deck for HADCM2-specific section A10_1B, VERTVE1B.33
!LL as VERTVE1A but with inconsistent 'old' type VERTVE1B.34
!LL of polar weights. T.Johns VERTVE1B.35
!LL 4.3 14/04/97 Updated in line with MPP optimisations. T Johns ATJ0F403.67
CLL VERTVE1B.36
CLL PROGRAMMING STANDARD: UNIFIED MODEL DOCUMENTATION PAPER NO. 4, VERTVE1B.37
CLL STANDARD B. VERSION 2, DATED 18/01/90 VERTVE1B.38
CLL VERTVE1B.39
CLL SYSTEM COMPONENTS COVERED: P112 VERTVE1B.40
CLL VERTVE1B.41
CLL SYSTEM TASK: P1 VERTVE1B.42
CLL VERTVE1B.43
CLL DOCUMENTATION: THE EQUATIONS USED ARE (29) AND (30) VERTVE1B.44
CLL IN UNIFIED MODEL DOCUMENTATION PAPER NO. 10 VERTVE1B.45
CLL M.J.P. CULLEN,T.DAVIES AND M.H. MAWSON, VERTVE1B.46
CLL VERSION 17 DATED 11/02/91. VERTVE1B.47
CLLEND------------------------------------------------------------- VERTVE1B.48
VERTVE1B.49
C*L ARGUMENTS:--------------------------------------------------- VERTVE1B.50
VERTVE1B.51
SUBROUTINE VERT_VEL 2,3VERTVE1B.52
1 (U,V,ETADOT_MEAN,SEC_P_LATITUDE,SUM_DIVERGENCE, VERTVE1B.53
2 U_FIELD,P_FIELD,P_LEVELS, VERTVE1B.54
*CALL ARGFLDPT 
VERTVE1B.55
3 ROW_LENGTH,LATITUDE_STEP_INVERSE, VERTVE1B.56
4 LONGITUDE_STEP_INVERSE,ADJUSTMENT_STEPS,AKH, VERTVE1B.57
5 BKH,RS,CALL_NUMBER,RECIP_RS_SQUARED_SURFACE, VERTVE1B.58
6 PSTAR,LLINTS,LWHITBROM) VERTVE1B.59
VERTVE1B.60
IMPLICIT NONE VERTVE1B.61
LOGICAL LLINTS, LWHITBROM VERTVE1B.62
VERTVE1B.63
INTEGER VERTVE1B.64
* ROW_LENGTH !IN NUMBER OF POINTS PER ROW VERTVE1B.65
*, P_LEVELS !IN NUMBER OF PRESSURE LEVELS OF DATA VERTVE1B.66
*, P_FIELD !IN NUMBER OF POINTS IN PRESSURE FIELD. VERTVE1B.67
*, U_FIELD !IN NUMBER OF POINTS IN VELOCITY FIELD. VERTVE1B.68
*, ADJUSTMENT_STEPS !IN HOLDS NUMBER OF ADJUSTMENT STEPS. VERTVE1B.69
*, CALL_NUMBER !IN CURRENT ADJUSTMENT STEP NUMBER VERTVE1B.70
! All TYPFLDPT arguments are intent IN VERTVE1B.71
*CALL TYPFLDPT VERTVE1B.72
VERTVE1B.73
REAL VERTVE1B.74
* U(U_FIELD,P_LEVELS) !IN. MASS WEIGHTED U VELOCITY. VERTVE1B.75
*,V(U_FIELD,P_LEVELS) !IN. MASS WEIGHTED V VELOCITY* VERTVE1B.76
* ! COS(LATITUDE) VERTVE1B.77
*,SEC_P_LATITUDE(P_FIELD)!IN 1/COS(LAT) AT P POINTS VERTVE1B.78
*,LONGITUDE_STEP_INVERSE !IN 1/LONGITUDE INCREMENT VERTVE1B.79
*,LATITUDE_STEP_INVERSE !IN 1/LATITUDE INCREMENT VERTVE1B.80
*,BKH(P_LEVELS+1) !IN. HOLDS COEFFICIENT WHICH VERTVE1B.81
* ! MULTIPLIES PSTAR IN HYBRID CO-ORDS VERTVE1B.82
* ! AT LEVELS K-1/2 VERTVE1B.83
*,AKH(P_LEVELS+1) !IN. HOLDS FIRST COEFFICIENT VERTVE1B.84
* ! IN HYBRID CO-ORDS AT LEVELS K-1/2 VERTVE1B.85
*,RS(P_FIELD,P_LEVELS) !IN. RADIUS OF EARTH AT P POINTS. VERTVE1B.86
*,PSTAR(P_FIELD) !IN. SURFACE PRESSURE AT P POINTS. VERTVE1B.87
VERTVE1B.88
REAL VERTVE1B.89
* SUM_DIVERGENCE(P_FIELD,P_LEVELS) !OUT. HOLDS MASS VERTVE1B.90
* ! WEIGHTED VERTICAL VELOCITY. VERTVE1B.91
VERTVE1B.92
REAL VERTVE1B.93
* ETADOT_MEAN(P_FIELD,P_LEVELS) !INOUT. HOLDS ACCUMULATED MASS- VERTVE1B.94
* ! WEIGHTED VERTICAL VELOCITY DIVIDED VERTVE1B.95
* ! BY NUMBER OF ADJUSTMENT_STEPS. VERTVE1B.96
*,RECIP_RS_SQUARED_SURFACE(P_FIELD) !INOUT. HOLDS 1./(RS*RS) AT VERTVE1B.97
* ! MODEL SURFACE. SET ON FIRST CALL VERTVE1B.98
* ! AND HELD CONSTANT FOR ALL VERTVE1B.99
* ! SUBSEQUENT ONES. VERTVE1B.100
C*--------------------------------------------------------------------- VERTVE1B.101
*IF DEF,MPP VERTVE1B.102
! Parameters for MPP code VERTVE1B.103
*ENDIF VERTVE1B.104
VERTVE1B.105
C*L 3 LOCAL ARRAYS NEEDED. ----------------------------------------- VERTVE1B.106
VERTVE1B.107
REAL VERTVE1B.108
* DU_DLONGITUDE(P_FIELD) VERTVE1B.109
*, DV_DLATITUDE(P_FIELD) VERTVE1B.110
*, DV_DLATITUDE2(U_FIELD) VERTVE1B.111
*IF DEF,MPP,AND,DEF,GLOBAL VERTVE1B.112
REAL VERTVE1B.113
& sum_tmp(ROW_LENGTH-2*EW_Halo,P_LEVELS), VERTVE1B.114
& sums(P_LEVELS) VERTVE1B.115
*ENDIF VERTVE1B.119
C*--------------------------------------------------------------------- VERTVE1B.120
VERTVE1B.121
C DEFINE COUNT VARIABLES FOR DO LOOPS ETC. VERTVE1B.122
INTEGER VERTVE1B.123
* I,J,K VERTVE1B.124
* ,START_POINT,END_POINT VERTVE1B.125
*,LEVEL VERTVE1B.126
&, POINTS VERTVE1B.127
*IF DEF,MPP VERTVE1B.128
INTEGER info VERTVE1B.129
*ENDIF VERTVE1B.130
C DEFINE LOCAL SCALARS VERTVE1B.131
REAL VERTVE1B.132
* RECIP_ADJUSTMENT_STEPS VERTVE1B.133
*, SCALAR VERTVE1B.134
VERTVE1B.135
*IF DEF,GLOBAL VERTVE1B.136
REAL SUM_N,SUM_S VERTVE1B.137
*ENDIF VERTVE1B.138
VERTVE1B.139
C*--------------------------------------------------------------------- VERTVE1B.140
*CALL C_A VERTVE1B.141
C*L EXTERNAL SUBROUTINE CALLS:- ( IF LWHITBROM ) --------------- VERTVE1B.142
EXTERNAL CALC_RS VERTVE1B.143
C*--------------------------------------------------------------------- VERTVE1B.144
VERTVE1B.145
CL MAXIMUM VECTOR LENGTH ASSUMED IS ROWS*ROW_LENGTH. VERTVE1B.146
CL--------------------------------------------------------------------- VERTVE1B.147
CL INTERNAL STRUCTURE. VERTVE1B.148
! All references to poles in the comments, apply equally to the VERTVE1B.149
! Northern and Southern rows when used in LAM configuration. VERTVE1B.150
! References to halos apply only to MPP code. VERTVE1B.151
CL--------------------------------------------------------------------- VERTVE1B.152
CL VERTVE1B.153
CL--------------------------------------------------------------------- VERTVE1B.154
CL SECTION 1. CALCULATE DIVERGENCE AS IN EQUATION (30). VERTVE1B.155
CL--------------------------------------------------------------------- VERTVE1B.156
VERTVE1B.157
POINTS=LAST_P_VALID_PT-FIRST_VALID_PT+1 VERTVE1B.158
! Number of points to be processed by CALC_RS. For non-MPP runs this VERTVE1B.159
! is simply P_FIELD, for MPP, it is all the points, minus any VERTVE1B.160
! unused halo areas (ie. the halo above North pole row, and beneath VERTVE1B.161
! South pole row) VERTVE1B.162
VERTVE1B.163
C LOOP OVER LEVELS VERTVE1B.164
DO 100 K=1,P_LEVELS VERTVE1B.165
VERTVE1B.166
C CALCULATE DU/D(LAMDA) VERTVE1B.167
! Loop over all points except South Pole, missing halos VERTVE1B.168
DO 110 I=START_POINT_NO_HALO - ROW_LENGTH +1, VERTVE1B.169
& END_P_POINT_NO_HALO VERTVE1B.170
DU_DLONGITUDE(I) = LONGITUDE_STEP_INVERSE*(U(I,K)-U(I-1,K)) VERTVE1B.171
110 CONTINUE VERTVE1B.172
VERTVE1B.173
C CALCULATE DV/D(PHI) VERTVE1B.174
! Loop over all non-polar points, missing halos VERTVE1B.175
DO 120 I=START_POINT_NO_HALO , END_P_POINT_NO_HALO VERTVE1B.176
DV_DLATITUDE(I) = LATITUDE_STEP_INVERSE*(V(I-ROW_LENGTH,K) VERTVE1B.177
* -V(I,K)) VERTVE1B.178
120 CONTINUE VERTVE1B.179
VERTVE1B.180
*IF DEF,GLOBAL VERTVE1B.181
C CALCULATE AVERAGE OF DV_DLATITUDE VERTVE1B.182
! Loop over all non-polar points, missing halos and first point VERTVE1B.183
DO 130 I=START_POINT_NO_HALO+1 , END_P_POINT_NO_HALO VERTVE1B.184
DV_DLATITUDE2(I) = DV_DLATITUDE(I) + DV_DLATITUDE(I-1) VERTVE1B.185
130 CONTINUE VERTVE1B.186
VERTVE1B.187
*IF -DEF,MPP VERTVE1B.188
C NOW DO FIRST POINT ON EACH SLICE FOR DU_DLONGITUDE AND DV_DLATITUDE2 VERTVE1B.189
! Set the first point of the Northern row we missed in loop 110 VERTVE1B.190
I=START_POINT_NO_HALO - ROW_LENGTH VERTVE1B.191
DU_DLONGITUDE(I) = LONGITUDE_STEP_INVERSE * (U(I,K) VERTVE1B.192
* - U(I + ROW_LENGTH - 1,K)) VERTVE1B.193
! Loop over all non-polar points, missing halos VERTVE1B.194
DO 140 I=START_POINT_NO_HALO , END_P_POINT_NO_HALO, VERTVE1B.195
& ROW_LENGTH VERTVE1B.196
DU_DLONGITUDE(I) = LONGITUDE_STEP_INVERSE * (U(I,K) VERTVE1B.197
* - U(I + ROW_LENGTH - 1,K)) VERTVE1B.198
DV_DLATITUDE2(I)=DV_DLATITUDE(I)+DV_DLATITUDE(I-1+ROW_LENGTH) VERTVE1B.199
140 CONTINUE VERTVE1B.200
*ELSE VERTVE1B.201
! Set the first element of arrays where loops have skipped: VERTVE1B.202
! Loop 110: VERTVE1B.203
DU_DLONGITUDE(START_POINT_NO_HALO - ROW_LENGTH)= VERTVE1B.204
& DU_DLONGITUDE(START_POINT_NO_HALO - ROW_LENGTH + 1) VERTVE1B.205
! Loop 130: VERTVE1B.206
DV_DLATITUDE2(START_POINT_NO_HALO)= VERTVE1B.207
& DV_DLATITUDE2(START_POINT_NO_HALO+1) VERTVE1B.208
*ENDIF VERTVE1B.209
VERTVE1B.210
C CALCULATE DIVERGENCES. VERTVE1B.211
VERTVE1B.212
! Loop over all non-polar points, missing halos VERTVE1B.213
DO 150 J=START_POINT_NO_HALO , END_P_POINT_NO_HALO VERTVE1B.214
SUM_DIVERGENCE(J,K)= SEC_P_LATITUDE(J)*.5*(DU_DLONGITUDE(J) VERTVE1B.215
* + DU_DLONGITUDE(J-ROW_LENGTH) VERTVE1B.216
* + DV_DLATITUDE2(J)) VERTVE1B.217
150 CONTINUE VERTVE1B.218
*ELSE VERTVE1B.219
! I don't think the following code is required: VERTVE1B.220
! DU_DLONGITUDE(1) = 0. VERTVE1B.221
! MPP: DU_DLONGITUDE(Offy*ROW_LENGTH+1) = 0. VERTVE1B.222
VERTVE1B.223
C CALCULATE DIVERGENCES. VERTVE1B.224
VERTVE1B.225
! Loop over all non-polar points, missing first and last points VERTVE1B.226
DO 130 J=START_POINT_NO_HALO+1 , END_P_POINT_NO_HALO-1 VERTVE1B.227
SUM_DIVERGENCE(J,K)= SEC_P_LATITUDE(J)*.5*(DU_DLONGITUDE(J) VERTVE1B.228
* + DU_DLONGITUDE(J-ROW_LENGTH) VERTVE1B.229
* + DV_DLATITUDE(J) + DV_DLATITUDE(J-1)) VERTVE1B.230
130 CONTINUE VERTVE1B.231
VERTVE1B.232
*IF DEF,MPP VERTVE1B.233
! Put some real numbers at start and end VERTVE1B.234
SUM_DIVERGENCE(START_POINT_NO_HALO,K)=0.0 VERTVE1B.235
SUM_DIVERGENCE(END_P_POINT_NO_HALO,K)=0.0 VERTVE1B.236
*ENDIF VERTVE1B.237
C ZERO DIVERGENCES ON BOUNDARIES. VERTVE1B.238
*IF -DEF,MPP VERTVE1B.239
! Loop over all non-polar points at left edge of grid (ie. first VERTVE1B.240
! point of each row) VERTVE1B.241
DO 140 J=START_POINT_NO_HALO,END_P_POINT_NO_HALO,ROW_LENGTH VERTVE1B.242
SUM_DIVERGENCE(J,K) = 0. VERTVE1B.243
SUM_DIVERGENCE(J+ROW_LENGTH-1,K) = 0. VERTVE1B.244
140 CONTINUE VERTVE1B.245
*ELSE VERTVE1B.246
IF (at_left_of_LPG) THEN VERTVE1B.247
! Loop over first real (ie. not halo) non-polar point of each row VERTVE1B.248
DO J=START_POINT_NO_HALO+FIRST_ROW_PT-1, VERTVE1B.249
& END_P_POINT_NO_HALO,ROW_LENGTH VERTVE1B.250
SUM_DIVERGENCE(J,K) = 0.0 VERTVE1B.251
ENDDO VERTVE1B.252
ENDIF VERTVE1B.253
VERTVE1B.254
IF (at_right_of_LPG) THEN VERTVE1B.255
! Loop over last real (ie. not halo) non-polar point of each row VERTVE1B.256
DO J=START_POINT_NO_HALO+LAST_ROW_PT-1, VERTVE1B.257
& END_P_POINT_NO_HALO,ROW_LENGTH VERTVE1B.258
SUM_DIVERGENCE(J,K) = 0.0 VERTVE1B.259
ENDDO VERTVE1B.260
ENDIF VERTVE1B.261
*ENDIF VERTVE1B.262
*ENDIF VERTVE1B.263
VERTVE1B.264
VERTVE1B.265
C END LOOP OVER LEVELS VERTVE1B.266
100 CONTINUE VERTVE1B.267
*IF DEF,GLOBAL VERTVE1B.268
! Calculate divergence at poles by summing DV/D(LAT) around polar VERTVE1B.269
! circle and averaging. VERTVE1B.270
VERTVE1B.271
! START_POINT=TOP_ROW_START+LAST_ROW_PT-1 ! Last point of NP row ATJ0F403.68
! END_POINT= P_BOT_ROW_START+FIRST_ROW_PT-1 ! First point of SP row ATJ0F403.69
START_POINT=START_POINT_NO_HALO-1 ATJ0F403.70
END_POINT=END_P_POINT_NO_HALO+1 ATJ0F403.71
VERTVE1B.275
VERTVE1B.276
! New start and end points to include one point of each pole VERTVE1B.277
VERTVE1B.278
*IF -DEF,MPP VERTVE1B.279
! Note that factor 8. is incorrect, but consistent with HADCM2 VERTVE1B.280
SCALAR = 8.*LATITUDE_STEP_INVERSE * LATITUDE_STEP_INVERSE / VERTVE1B.281
& GLOBAL_ROW_LENGTH VERTVE1B.282
VERTVE1B.283
DO K=1,P_LEVELS VERTVE1B.284
SUM_N=0.0 VERTVE1B.285
SUM_S=0.0 VERTVE1B.286
DO I=1,ROW_LENGTH VERTVE1B.287
SUM_N = SUM_N - V(I,K)*SCALAR VERTVE1B.288
SUM_S = SUM_S + V(U_BOT_ROW_START-1+I,K)*SCALAR VERTVE1B.289
ENDDO VERTVE1B.290
SUM_DIVERGENCE(START_POINT,K) = SUM_N VERTVE1B.291
SUM_DIVERGENCE(END_POINT,K) = SUM_S VERTVE1B.292
ENDDO VERTVE1B.293
*ELSE VERTVE1B.294
! Do sum across North Pole VERTVE1B.295
IF (at_top_of_LPG) THEN VERTVE1B.296
! Note that factor 8. is incorrect, but consistent with HADCM2 VERTVE1B.297
SCALAR = 8.*LATITUDE_STEP_INVERSE * LATITUDE_STEP_INVERSE / VERTVE1B.298
& GLOBAL_ROW_LENGTH VERTVE1B.299
DO K=1,P_LEVELS VERTVE1B.300
! Copy up the items to be summed into a temporary array VERTVE1B.301
! Loop over all the non-halo points on a row VERTVE1B.302
DO I=FIRST_ROW_PT,LAST_ROW_PT VERTVE1B.303
sum_tmp(I-FIRST_ROW_PT+1,K)= VERTVE1B.304
& -V(TOP_ROW_START+I-1,K)*SCALAR VERTVE1B.305
ENDDO VERTVE1B.306
ENDDO VERTVE1B.307
VERTVE1B.308
! And perform the sum VERTVE1B.309
CALL GCG_RVECSUMR(ROW_LENGTH-2*EW_Halo , ROW_LENGTH-2*EW_Halo, VERTVE1B.310
& 1,P_LEVELS,sum_tmp,GC_ROW_GROUP, VERTVE1B.311
& info,sums) VERTVE1B.312
VERTVE1B.313
! And store the result back VERTVE1B.314
DO K=1,P_LEVELS VERTVE1B.315
SUM_DIVERGENCE(START_POINT,K)=sums(K) VERTVE1B.316
ENDDO VERTVE1B.317
ELSE ! If this processor not at top of LPG VERTVE1B.318
START_POINT=START_POINT_NO_HALO ! no North Pole point here VERTVE1B.319
ENDIF VERTVE1B.320
VERTVE1B.321
! And sum across South Pole VERTVE1B.322
IF (at_base_of_LPG) THEN VERTVE1B.323
! Note that factor 8. is incorrect, but consistent with HADCM2 VERTVE1B.324
SCALAR=8.*LATITUDE_STEP_INVERSE * LATITUDE_STEP_INVERSE / VERTVE1B.325
& GLOBAL_ROW_LENGTH VERTVE1B.326
VERTVE1B.327
DO K=1,P_LEVELS VERTVE1B.328
! Copy up the items to be summed into a temporary array VERTVE1B.329
! Loop over all the non-halo points on a row VERTVE1B.330
DO I=FIRST_ROW_PT,LAST_ROW_PT VERTVE1B.331
sum_tmp(I-FIRST_ROW_PT+1,K)= VERTVE1B.332
& V(U_BOT_ROW_START+I-1,K)*SCALAR VERTVE1B.333
ENDDO VERTVE1B.334
ENDDO VERTVE1B.335
VERTVE1B.336
! And perform the sum VERTVE1B.337
CALL GCG_RVECSUMR(ROW_LENGTH-2*EW_Halo , ROW_LENGTH-2*EW_Halo, VERTVE1B.338
& 1,P_LEVELS,sum_tmp,GC_ROW_GROUP, VERTVE1B.339
& info,sums) VERTVE1B.340
VERTVE1B.341
! And store the result back VERTVE1B.342
DO K=1,P_LEVELS VERTVE1B.343
SUM_DIVERGENCE(END_POINT,K)=sums(K) VERTVE1B.344
ENDDO VERTVE1B.345
ELSE ! If this processor not at the bottom of LPG VERTVE1B.346
END_POINT=END_P_POINT_NO_HALO ! no South Pole point here VERTVE1B.347
ENDIF VERTVE1B.348
*ENDIF VERTVE1B.369
*ELSE VERTVE1B.370
START_POINT=START_POINT_NO_HALO VERTVE1B.371
END_POINT=END_P_POINT_NO_HALO VERTVE1B.372
*ENDIF VERTVE1B.373
VERTVE1B.374
CL VERTVE1B.375
CL--------------------------------------------------------------------- VERTVE1B.376
CL SECTION 2. CALCULATE VERTICAL VELOCITY. EQUATION (29). VERTVE1B.377
CL--------------------------------------------------------------------- VERTVE1B.378
VERTVE1B.379
VERTVE1B.380
C --------------------------------------------------------------------- VERTVE1B.381
CL SECTION 2.1 SUM DIVERGENCES THROUGHOUT ATMOSPHERE. VERTVE1B.382
C --------------------------------------------------------------------- VERTVE1B.383
VERTVE1B.384
C BY CODING THE SUMMATION AS FOLLOWS THE VALUES PUT INTO EACH LEVEL VERTVE1B.385
C OF SUM_DIVERGENCE ARE THE ONES NEEDED FOR THE SECOND SUMMATION TERM VERTVE1B.386
C IN EQUATION 29, WHILE THE TOTAL SUM IS HELD IN SUM_DIVERGENCE( ,1) VERTVE1B.387
VERTVE1B.388
DO 210 K=P_LEVELS-1,1,-1 VERTVE1B.389
DO 212 I=START_POINT,END_POINT VERTVE1B.390
SUM_DIVERGENCE(I,K)= SUM_DIVERGENCE(I,K)+SUM_DIVERGENCE(I,K+1) VERTVE1B.391
212 CONTINUE VERTVE1B.392
210 CONTINUE VERTVE1B.393
VERTVE1B.394
C --------------------------------------------------------------------- VERTVE1B.395
CL SECTION 2.2 CALCULATE MASS-WEIGHTED VERTICAL VELOCITY. VERTVE1B.396
CL CALCULATE 1/(RS*RS) IF THIS IS CALL NUMBER ONE. VERTVE1B.397
C --------------------------------------------------------------------- VERTVE1B.398
VERTVE1B.399
IF(CALL_NUMBER.EQ.1) THEN VERTVE1B.400
CL CALCULATE 1/(RS*RS) AT MODEL SURFACE VERTVE1B.401
VERTVE1B.402
IF (.NOT.LWHITBROM) THEN VERTVE1B.403
VERTVE1B.404
! loop over all points, including valid halos VERTVE1B.405
DO 220 I=FIRST_VALID_PT,LAST_P_VALID_PT VERTVE1B.406
RECIP_RS_SQUARED_SURFACE(I) = 1./(A*A) VERTVE1B.407
220 CONTINUE VERTVE1B.408
VERTVE1B.409
ELSE VERTVE1B.410
VERTVE1B.411
LEVEL=1 VERTVE1B.412
C DV_DLATITUDE,DU_DLONGITUDE ARE DUMMY ARRAYS REQUIRED BY CALC_RS AND VERTVE1B.413
C THE CONTENTS TRANSFERED TO AND RETURNED FROM IT ARE IRRELEVANT. VERTVE1B.414
CALL CALC_RS(PSTAR(FIRST_VALID_PT),AKH,BKH, VERTVE1B.415
& DV_DLATITUDE(FIRST_VALID_PT), VERTVE1B.416
& DU_DLONGITUDE(FIRST_VALID_PT), VERTVE1B.417
* RECIP_RS_SQUARED_SURFACE(FIRST_VALID_PT), VERTVE1B.418
& POINTS,LEVEL,P_LEVELS,LLINTS) VERTVE1B.419
! loop over all points, including valid halos VERTVE1B.453
DO 320 I=FIRST_VALID_PT,LAST_P_VALID_PT VERTVE1B.454
RECIP_RS_SQUARED_SURFACE(I)= 1./(RECIP_RS_SQUARED_SURFACE(I)* VERTVE1B.455
* RECIP_RS_SQUARED_SURFACE(I)) VERTVE1B.456
320 CONTINUE VERTVE1B.457
VERTVE1B.458
END IF ! LWHITBROM VERTVE1B.459
VERTVE1B.460
END IF VERTVE1B.461
VERTVE1B.462
C DP/D(PSTAR) IS NOTHING MORE THAN THE BK COEFFICENT. VERTVE1B.463
*IF -DEF,STRAT VERTVE1B.464
VERTVE1B.465
DO 222 K= P_LEVELS,2,-1 VERTVE1B.466
CFPP$ SELECT(CONCUR) VERTVE1B.467
DO 224 I=START_POINT,END_POINT VERTVE1B.468
SUM_DIVERGENCE(I,K)= SUM_DIVERGENCE(I,K) - BKH(K) VERTVE1B.469
* * SUM_DIVERGENCE(I,1)*RS(I,K)*RS(I,K)* VERTVE1B.470
* RECIP_RS_SQUARED_SURFACE(I) VERTVE1B.471
224 CONTINUE VERTVE1B.472
222 CONTINUE VERTVE1B.473
VERTVE1B.474
*ENDIF VERTVE1B.475
C --------------------------------------------------------------------- VERTVE1B.476
CL SECTION 2.3 ACCUMULATE MASS-WEIGHTED VERTICAL VELOCITY DIVIDED VERTVE1B.477
CL BY NUMBER OF ADJUSTMENT TIMESTEPS. VERTVE1B.478
C --------------------------------------------------------------------- VERTVE1B.479
VERTVE1B.480
RECIP_ADJUSTMENT_STEPS = 1./ ADJUSTMENT_STEPS VERTVE1B.481
VERTVE1B.482
DO 230 K= 1,P_LEVELS VERTVE1B.483
CFPP$ SELECT(CONCUR) VERTVE1B.484
DO 232 I=START_POINT,END_POINT VERTVE1B.485
ETADOT_MEAN(I,K)= ETADOT_MEAN(I,K) + SUM_DIVERGENCE(I,K) VERTVE1B.486
* * RECIP_ADJUSTMENT_STEPS VERTVE1B.487
232 CONTINUE VERTVE1B.488
230 CONTINUE VERTVE1B.489
VERTVE1B.490
*IF DEF,GLOBAL VERTVE1B.491
C IF GLOBAL MODEL SET ALL POINTS AT POLES TO THE UNIQUE VALUE. VERTVE1B.492
DO 240 K=1,P_LEVELS VERTVE1B.493
CDIR$ IVDEP VERTVE1B.494
*IF DEF,MPP VERTVE1B.495
IF (at_top_of_LPG) THEN VERTVE1B.496
*ENDIF VERTVE1B.497
! Loop over North Pole points, missing out the last (START_POINT) VERTVE1B.498
! point. VERTVE1B.499
DO I=TOP_ROW_START+FIRST_ROW_PT-1, VERTVE1B.500
! & TOP_ROW_START+LAST_ROW_PT-2 VERTVE1B.501
& TOP_ROW_START+LAST_ROW_PT-1 VERTVE1B.502
ETADOT_MEAN(I,K)=ETADOT_MEAN(START_POINT,K) VERTVE1B.503
SUM_DIVERGENCE(I,K)=SUM_DIVERGENCE(START_POINT,K) VERTVE1B.504
ENDDO VERTVE1B.505
*IF DEF,MPP VERTVE1B.506
ENDIF ! at North Pole VERTVE1B.507
*ENDIF VERTVE1B.508
VERTVE1B.509
*IF DEF,MPP VERTVE1B.510
IF (at_base_of_LPG) THEN VERTVE1B.511
*ENDIF VERTVE1B.512
! Loop over South Pole points, missing out the first (END_POINT) VERTVE1B.513
! point. VERTVE1B.514
! DO I=P_BOT_ROW_START+FIRST_ROW_PT, VERTVE1B.515
DO I=P_BOT_ROW_START+FIRST_ROW_PT-1, VERTVE1B.516
& P_BOT_ROW_START+LAST_ROW_PT-1 VERTVE1B.517
ETADOT_MEAN(I,K)=ETADOT_MEAN(END_POINT,K) VERTVE1B.518
SUM_DIVERGENCE(I,K)=SUM_DIVERGENCE(END_POINT,K) VERTVE1B.519
ENDDO VERTVE1B.520
*IF DEF,MPP VERTVE1B.521
ENDIF ! at South Pole VERTVE1B.522
*ENDIF VERTVE1B.523
240 CONTINUE VERTVE1B.524
*ENDIF VERTVE1B.525
VERTVE1B.526
CL END OF ROUTINE VERT_VEL VERTVE1B.527
VERTVE1B.528
RETURN VERTVE1B.529
END VERTVE1B.530
*ENDIF VERTVE1B.531