*IF DEF,A12_1B ARB2F400.3
C ******************************COPYRIGHT****************************** GTS2F400.253
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.254
C GTS2F400.255
C Use, duplication or disclosure of this code is subject to the GTS2F400.256
C restrictions as set forth in the contract. GTS2F400.257
C GTS2F400.258
C Meteorological Office GTS2F400.259
C London Road GTS2F400.260
C BRACKNELL GTS2F400.261
C Berkshire UK GTS2F400.262
C RG12 2SZ GTS2F400.263
C GTS2F400.264
C If no contract has been raised with this copy of the code, the use, GTS2F400.265
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.266
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.267
C Modelling at the above address. GTS2F400.268
C ******************************COPYRIGHT****************************** GTS2F400.269
C GTS2F400.270
CLL SUBROUTINE ADV_U_GD ------------------------------------------- ADVUGD1A.3
CLL ADVUGD1A.4
CLL PURPOSE: CALCULATES ADVECTION INCREMENTS TO A FIELD AT A ADVUGD1A.5
CLL SINGLE MODEL LEVEL USING AN EQUATION OF THE FORM(38). ADVUGD1A.6
CLL NOT SUITABLE FOR SINGLE COLUMN USE. ADVUGD1A.7
CLL ADVUGD1A.8
CLL VERSION FOR CRAY Y-MP ADVUGD1A.9
CLL ADVUGD1A.10
CLL WRITTEN BY M.H MAWSON. ADVUGD1A.11
CLL ADVUGD1A.12
CLL Model Modification history from model version 3.0: ADVUGD1A.13
CLL version Date ADVUGD1A.14
CLL ADVUGD1A.15
CLL AAD2F304.712
CLL 3.4 06/08/94 Micro tasking directives inserted and AAD2F304.713
CLL code restructured AAD2F304.714
CLL to improve parallel efficiency on C90. AAD2F304.715
CLL Authors: A. Dickinson, D. Salmond AAD2F304.716
CLL Reviewer: M. Mawson AAD2F304.717
CLL AAD2F304.718
CLL AAD2F304.719
CLL 3.4 23/06/94 DEF NOWHBR replaced by LOGICAL LWHITBROM GSS1F304.814
CLL S.J.Swarbrick GSS1F304.815
! 3.5 28/03/95 MPP code: Change updateable area and APB0F305.616
! remove explicit wrap around calcs. P.Burton APB0F305.617
! 4.1 29/04/96 Remove MPP code (new ADVUGD1C version for MPP) APB0F401.811
! and add TYPFLDPT arguments APB0F401.812
CLL GSS1F304.816
CLL PROGRAMMING STANDARD: UNIFIED MODEL DOCUMENTATION PAPER NO. 4, ADVUGD1A.16
CLL STANDARD B. VERSION 2, DATED 18/01/90 ADVUGD1A.17
CLL ADVUGD1A.18
CLL LOGICAL COMPONENTS COVERED: P122 ADVUGD1A.19
CLL ADVUGD1A.20
CLL PROJECT TASK: P1 ADVUGD1A.21
CLL ADVUGD1A.22
CLL DOCUMENTATION: THE EQUATION USED IS (37) ADVUGD1A.23
CLL IN UNIFIED MODEL DOCUMENTATION PAPER NO. 10 ADVUGD1A.24
CLL M.J.P. CULLEN,T.DAVIES AND M.H.MAWSON ADVUGD1A.25
CLLEND------------------------------------------------------------- ADVUGD1A.26
CLL ADVUGD1A.27
C*L ARGUMENTS:--------------------------------------------------- ADVUGD1A.28
SUBROUTINE ADV_U_GD 12ADVUGD1A.29
1 (FIELD_LOWER,FIELD,FIELD_UPPER,U,V, AAD2F304.720
1 ETADOT_LOWER,ETADOT_UPPER, AAD2F304.721
2 SEC_U_LATITUDE,FIELD_INC,NUX,NUY,U_FIELD, ADVUGD1A.31
3 ROW_LENGTH, APB0F401.813
*CALL ARGFLDPT 
APB0F401.814
4 ADVECTION_TIMESTEP, ADVUGD1A.33
5 LATITUDE_STEP_INVERSE,LONGITUDE_STEP_INVERSE, ADVUGD1A.34
6 SEC_P_LATITUDE,BRSP, AAD2F304.722
7 L_SECOND,LWHITBROM) AAD2F304.723
ADVUGD1A.37
IMPLICIT NONE ADVUGD1A.38
ADVUGD1A.39
INTEGER ADVUGD1A.40
* U_FIELD !IN DIMENSION OF FIELDS ON VELOCITY GRID ADVUGD1A.41
*, ROW_LENGTH !IN NUMBER OF POINTS PER ROW ADVUGD1A.42
APB0F401.815
! All TYPFLDPT arguments are intent IN APB0F401.816
*CALL TYPFLDPT APB0F401.817
ADVUGD1A.45
REAL ADVUGD1A.46
* U(U_FIELD) !IN ADVECTING U FIELD MASS-WEIGHTED AND ADVUGD1A.47
* ! HELD AT P POINTS. FIRST POINT OF FIELD ADVUGD1A.48
* ! IS FIRST P POINT ON SECOND ROW OF P-GRID. ADVUGD1A.49
*,V(U_FIELD) !IN ADVECTING V FIELD MASS-WEIGHTED AND ADVUGD1A.50
* ! HELD AT P POINTS. FIRST POINT OF FIELD ADVUGD1A.51
* ! IS FIRST P POINT ON SECOND ROW OF P-GRID. ADVUGD1A.52
*,ETADOT_UPPER(U_FIELD)!IN ADVECTING VERTICAL VELOC AT K+1/2, AAD2F304.724
* ! MASS-WEIGHTED. ADVUGD1A.54
*,ETADOT_LOWER(U_FIELD)!IN ADVECTING VERTICAL VELOC AT K-1/2, AAD2F304.725
* ! MASS-WEIGHTED. AAD2F304.726
*,FIELD(U_FIELD) !IN FIELD TO BE ADVECTED. ADVUGD1A.55
*,FIELD_UPPER(U_FIELD) !IN FIELD TO BE ADVECTED AT LEVEL + 1 . ADVUGD1A.56
*,FIELD_LOWER(U_FIELD) !IN FIELD TO BE ADVECTED AT LEVEL - 1 . AAD2F304.727
*,NUX(U_FIELD) !IN HOLDS PARAMETER NU FOR EAST-WEST ADVECTION. ADVUGD1A.57
*,NUY(U_FIELD) !IN HOLDS PARAMETER NU FOR NORTH-SOUTH ADVECTION. ADVUGD1A.58
*,SEC_U_LATITUDE(U_FIELD) !IN HOLDS 1/COS(PHI) AT U POINTS. ADVUGD1A.59
*,SEC_P_LATITUDE(U_FIELD) !IN HOLDS 1/COS(PHI) AT P POINTS. ADVUGD1A.60
*,ADVECTION_TIMESTEP !IN ADVUGD1A.61
*,LATITUDE_STEP_INVERSE !IN 1/(DELTA PHI) ADVUGD1A.62
*,LONGITUDE_STEP_INVERSE !IN 1/(DELTA LAMDA) ADVUGD1A.63
ADVUGD1A.64
REAL ADVUGD1A.65
* BRSP(U_FIELD) !IN BRSP TERM AT LEVEL+1/2 (SEE DOC.PAPER AAD2F304.728
* ! NO 10) ADVUGD1A.69
ADVUGD1A.70
REAL ADVUGD1A.71
* FIELD_INC(U_FIELD) !OUT HOLDS INCREMENT TO FIELD. ADVUGD1A.72
ADVUGD1A.73
REAL ADVUGD1A.74
* VERTICAL_FLUX(U_FIELD) !INOUT HOLDS VERTICAL FLUX OF FIELD ADVUGD1A.75
* ! BETWEEN TWO LEVELS. ADVUGD1A.76
ADVUGD1A.77
C LOGICAL VARIABLE ADVUGD1A.78
LOGICAL ADVUGD1A.79
* L_SECOND ! SET TO TRUE IF NU_BASIC IS ZERO. ADVUGD1A.80
* ,LWHITBROM ! Switch for White & Bromley terms GSS1F304.817
C ADVUGD1A.82
C*--------------------------------------------------------------------- ADVUGD1A.83
ADVUGD1A.84
C*L DEFINE ARRAYS AND VARIABLES USED IN THIS ROUTINE----------------- ADVUGD1A.85
C DEFINE LOCAL ARRAYS: 3 ARE REQUIRED ADVUGD1A.86
ADVUGD1A.87
REAL ADVUGD1A.88
* WORK(U_FIELD) ! GENERAL WORK-SPACE. ADVUGD1A.89
*,U_TERM(U_FIELD) ! HOLDS U ADVECTION TERM FROM EQUATION (37) ADVUGD1A.90
*,V_TERM(U_FIELD) ! HOLDS V ADVECTION TERM FROM EQUATION (37) ADVUGD1A.91
C*--------------------------------------------------------------------- ADVUGD1A.92
C DEFINE LOCAL VARIABLES ADVUGD1A.93
ADVUGD1A.94
C REAL SCALARS ADVUGD1A.95
REAL ADVUGD1A.96
* SCALAR1,SCALAR2 AAD2F304.729
ADVUGD1A.98
C COUNT VARIABLES FOR DO LOOPS ETC. ADVUGD1A.99
INTEGER ADVUGD1A.100
* I,IJ,IK,IL,J ADVUGD1A.101
ADVUGD1A.102
C*L NO EXTERNAL SUBROUTINE CALLS:------------------------------------ ADVUGD1A.103
C*--------------------------------------------------------------------- ADVUGD1A.104
ADVUGD1A.105
CL MAXIMUM VECTOR LENGTH ASSUMED IS END_U_UPDATE-START_U_UPDATE+1 ADVUGD1A.106
CL--------------------------------------------------------------------- ADVUGD1A.107
CL INTERNAL STRUCTURE. ADVUGD1A.108
CL--------------------------------------------------------------------- ADVUGD1A.109
CL ADVUGD1A.110
CL--------------------------------------------------------------------- ADVUGD1A.111
CL SECTION 1. CALCULATE U_TERM IN EQUATION (37). ADVUGD1A.112
CL--------------------------------------------------------------------- ADVUGD1A.113
ADVUGD1A.114
C---------------------------------------------------------------------- ADVUGD1A.115
CL SECTION 1.1 CALCULATE TERM U D(FIELD)/D(LAMDA). ADVUGD1A.116
C---------------------------------------------------------------------- ADVUGD1A.117
ADVUGD1A.118
C CALCULATE TERM AT ALL POINTS EXCEPT LAST AND STORE IN WORK. ADVUGD1A.119
! Loop over field, missing top and bottom rows and last point. APB0F401.818
DO 110 I=START_POINT_NO_HALO,END_U_POINT_NO_HALO-1 APB0F401.819
WORK(I) = .5*(U(I+1)+U(I+1-ROW_LENGTH))*LONGITUDE_STEP_INVERSE* ADVUGD1A.121
* (FIELD(I+1) - FIELD(I)) ADVUGD1A.122
110 CONTINUE ADVUGD1A.123
ADVUGD1A.124
*IF DEF,GLOBAL ADVUGD1A.125
C IF GLOBAL MODEL RECALCULATE END-POINT VALUE. ADVUGD1A.126
! Loop over last point of each row, missing top and bottom rows. APB0F401.820
DO 112 I=START_POINT_NO_HALO+LAST_ROW_PT-1, APB0F401.821
& END_U_POINT_NO_HALO,ROW_LENGTH APB0F401.822
WORK(I) = .5*(U(I+1-ROW_LENGTH)+U(I+1-2*ROW_LENGTH)) ADVUGD1A.128
* *LONGITUDE_STEP_INVERSE* ADVUGD1A.129
* (FIELD(I+1-ROW_LENGTH) - FIELD(I)) ADVUGD1A.130
112 CONTINUE ADVUGD1A.131
*ENDIF ADVUGD1A.132
ADVUGD1A.133
C---------------------------------------------------------------------- ADVUGD1A.134
CL SECTION 1.2 CALCULATE U ADVECTION TERM IN EQUATION (37). ADVUGD1A.135
CL IF L_SECOND=TRUE ONLY DO SECOND ORDER ADVECTION. ADVUGD1A.136
C---------------------------------------------------------------------- ADVUGD1A.137
ADVUGD1A.138
IF(L_SECOND) THEN ADVUGD1A.139
*IF DEF,GLOBAL ADVUGD1A.140
ADVUGD1A.141
! Loop over field, missing top and bottom rows and first point. APB0F401.823
DO J=START_POINT_NO_HALO+1,END_U_POINT_NO_HALO APB0F401.824
U_TERM(J) = .5*(WORK(J)+WORK(J-1)) ADVUGD1A.143
END DO ADVUGD1A.144
ADVUGD1A.145
C CALCULATE VALUES AT FIRST POINTS ON A ROW. ADVUGD1A.146
ADVUGD1A.147
CFPP$ NODEPCHK ADVUGD1A.148
! Fujitsu vectorization directive GRB0F405.589
!OCL NOVREC GRB0F405.590
! Loop over first point of each row, missing top and bottom rows. APB0F401.825
DO I=START_POINT_NO_HALO,END_U_POINT_NO_HALO,ROW_LENGTH APB0F401.826
U_TERM(I) = .5*(WORK(I)+WORK(I+ROW_LENGTH-1)) ADVUGD1A.150
END DO ADVUGD1A.151
ADVUGD1A.152
*ELSE ADVUGD1A.153
C LIMITED AREA MODEL. VALUES NOT CALCULATED AT FIRST,SECOND,NEXT TO LAST ADVUGD1A.154
C AND LAST ON A ROW. ADVUGD1A.155
ADVUGD1A.156
! Loop over field, missing top and bottom rows and first and last APB0F401.827
! points. APB0F401.828
DO J=START_POINT_NO_HALO+1,END_U_POINT_NO_HALO-1 APB0F401.829
U_TERM(J) = .5*(WORK(J)+WORK(J-1)) ADVUGD1A.158
END DO ADVUGD1A.159
ADVUGD1A.160
C CORNER VALUES ADVUGD1A.161
U_TERM(START_POINT_NO_HALO)=0.0 APB0F401.830
U_TERM(END_U_POINT_NO_HALO)=0.0 APB0F401.831
*ENDIF ADVUGD1A.164
ELSE ADVUGD1A.165
*IF DEF,GLOBAL ADVUGD1A.166
C LOOP OVER ALL POINTS BUT DON'T DO FIRST,SECOND AND LAST ON A ROW AS ADVUGD1A.167
C THEY NEED SPECIAL TREATMENT DUE TO FOURTH ORDER SCHEME. ADVUGD1A.168
ADVUGD1A.169
! Loop over field, missing top and bottom rows, first two points APB0F401.832
! and last point. APB0F401.833
DO 120 J=START_POINT_NO_HALO+2,END_U_POINT_NO_HALO-1 APB0F401.834
U_TERM(J) = (1.+NUX(J))*.5*(WORK(J)+WORK(J-1))-NUX(J)*.5* ADVUGD1A.171
* (WORK(J+1)+WORK(J-2)) ADVUGD1A.172
120 CONTINUE ADVUGD1A.173
ADVUGD1A.174
C CALCULATE VALUES AT FIRST,SECOND AND LAST POINTS ON A ROW. ADVUGD1A.175
ADVUGD1A.176
CFPP$ NODEPCHK ADVUGD1A.177
! Fujitsu vectorization directive GRB0F405.591
!OCL NOVREC GRB0F405.592
! Loop over first point of rows, missing top and bottom rows. APB0F401.835
DO 124 I=START_POINT_NO_HALO,END_U_POINT_NO_HALO,ROW_LENGTH APB0F401.836
IJ =I+LAST_ROW_PT-1 ! last point on row APB0F401.837
IK = IJ - 1 ADVUGD1A.180
IL = I + 1 ADVUGD1A.181
C FIRST POINT. ADVUGD1A.182
U_TERM(I) = (1.+NUX(I))*.5*(WORK(I)+WORK(IJ))-NUX(I)*.5* ADVUGD1A.183
* (WORK(IL)+WORK(IK)) ADVUGD1A.184
C SECOND POINT. ADVUGD1A.185
U_TERM(IL) = (1.+NUX(IL))*.5*(WORK(IL)+WORK(I))-NUX(IL)*.5* ADVUGD1A.186
* (WORK(I+2)+WORK(IJ)) ADVUGD1A.187
C LAST POINT. ADVUGD1A.188
U_TERM(IJ) = (1.+NUX(IJ))*.5*(WORK(IJ)+WORK(IK))-NUX(IJ)*.5* ADVUGD1A.189
* (WORK(I)+WORK(IK-1)) ADVUGD1A.190
124 CONTINUE ADVUGD1A.191
ADVUGD1A.192
*ELSE ADVUGD1A.193
C LIMITED AREA MODEL. VALUES NOT CALCULATED AT FIRST,SECOND,NEXT TO LAST ADVUGD1A.194
C AND LAST ON A ROW. ADVUGD1A.195
ADVUGD1A.196
! Loop over field, missing top and bottom rows, first two points APB0F401.838
! and last two points. APB0F401.839
DO 120 J=START_POINT_NO_HALO+2,END_U_POINT_NO_HALO-2 APB0F401.840
U_TERM(J) = (1.+NUX(J))*.5*(WORK(J)+WORK(J-1)) - NUX(J)*.5* ADVUGD1A.198
* (WORK(J+1)+WORK(J-2)) ADVUGD1A.199
120 CONTINUE ADVUGD1A.200
ADVUGD1A.201
C CALCULATE VALUES AT SECOND AND NEXT TO LAST POINTS ON A ROW. ADVUGD1A.202
C THESE VALUES ARE JUST SECOND ORDER. ADVUGD1A.203
ADVUGD1A.204
! Loop over first point of rows, missing top and bottom rows APB0F401.841
DO 124 I=START_POINT_NO_HALO,END_U_POINT_NO_HALO,ROW_LENGTH APB0F401.842
IK = I+LAST_ROW_PT-2 ! penultimate point on row APB0F401.843
IL = I + 1 ADVUGD1A.207
C SECOND POINT. ADVUGD1A.208
U_TERM(IL) = .5*(WORK(IL)+WORK(I)) ADVUGD1A.209
C NEXT TO LAST POINT. ADVUGD1A.210
U_TERM(IK) = .5*(WORK(IK)+WORK(IK-1)) ADVUGD1A.211
124 CONTINUE ADVUGD1A.212
C CORNER VALUES ADVUGD1A.213
C ADVUGD1A.214
U_TERM(START_POINT_NO_HALO)=0.0 APB0F401.844
U_TERM(END_U_POINT_NO_HALO)=0.0 APB0F401.845
C ADVUGD1A.217
ADVUGD1A.218
*ENDIF ADVUGD1A.219
END IF ADVUGD1A.220
ADVUGD1A.221
CL ADVUGD1A.222
CL--------------------------------------------------------------------- ADVUGD1A.223
CL SECTION 2. CALCULATE V_TERM IN EQUATION (37). ADVUGD1A.224
CL--------------------------------------------------------------------- ADVUGD1A.225
ADVUGD1A.226
C---------------------------------------------------------------------- ADVUGD1A.227
CL SECTION 2.1 CALCULATE TERM V D(FIELD)/D(PHI). ADVUGD1A.228
C---------------------------------------------------------------------- ADVUGD1A.229
ADVUGD1A.230
C CALCULATE TERM AT ALL POINTS EXCEPT LAST AND STORE IN WORK. ADVUGD1A.231
! Loop over field, missing bottom row and last point. APB0F401.846
DO 210 I=START_POINT_NO_HALO-ROW_LENGTH,END_U_POINT_NO_HALO-1 APB0F401.847
WORK(I) = .5*(V(I)+V(I+1))*LATITUDE_STEP_INVERSE* ADVUGD1A.233
* (FIELD(I) - FIELD(I+ROW_LENGTH)) ADVUGD1A.234
210 CONTINUE ADVUGD1A.235
ADVUGD1A.236
*IF DEF,GLOBAL ADVUGD1A.237
C IF GLOBAL MODEL RECALCULATE END-POINT VALUE. ADVUGD1A.238
! Loop over last point of rows, missing bottom row. APB0F401.848
DO 212 I=START_POINT_NO_HALO+LAST_ROW_PT-1-ROW_LENGTH, APB0F401.849
& END_U_POINT_NO_HALO,ROW_LENGTH APB0F401.850
WORK(I) = .5*(V(I)+V(I-ROW_LENGTH+1))*LATITUDE_STEP_INVERSE* ADVUGD1A.240
* (FIELD(I) - FIELD(I+ROW_LENGTH)) ADVUGD1A.241
212 CONTINUE ADVUGD1A.242
*ENDIF ADVUGD1A.243
ADVUGD1A.244
C---------------------------------------------------------------------- ADVUGD1A.245
CL SECTION 2.2 CALCULATE V ADVECTION TERM IN EQUATION (37). ADVUGD1A.246
CL IF L_SECOND=TRUE ONLY DO SECOND ORDER ADVECTION. ADVUGD1A.247
C---------------------------------------------------------------------- ADVUGD1A.248
ADVUGD1A.249
IF(L_SECOND) THEN ADVUGD1A.250
*IF DEF,GLOBAL ADVUGD1A.251
C GLOBAL MODEL. ADVUGD1A.252
! Loop over field, missing top and bottomrows. APB0F401.851
DO I=START_POINT_NO_HALO, APB0F401.852
& END_U_POINT_NO_HALO APB0F401.853
V_TERM(I) = .5*(WORK(I-ROW_LENGTH)+WORK(I)) ADVUGD1A.256
END DO ADVUGD1A.257
ADVUGD1A.258
*ELSE ADVUGD1A.271
C LIMITED AREA MODEL. ADVUGD1A.272
C CALCULATE ALL VALUES EXCEPT ON ROWS NEXT TO BOUNDARIES. ADVUGD1A.273
ADVUGD1A.274
! Loop over field, missing top and bottom rows and first and last APB0F401.854
! points. APB0F401.855
DO I=START_POINT_NO_HALO+1,END_U_POINT_NO_HALO-1 APB0F401.856
V_TERM(I) = .5*(WORK(I-ROW_LENGTH)+WORK(I)) ADVUGD1A.276
END DO ADVUGD1A.277
ADVUGD1A.278
C SET LAST POINT OF LOOP TO ZERO. ADVUGD1A.279
V_TERM(END_U_POINT_NO_HALO-ROW_LENGTH)=0.0 APB0F401.857
ADVUGD1A.281
C CORNER VALUES ADVUGD1A.282
ADVUGD1A.283
V_TERM(START_POINT_NO_HALO)=0.0 APB0F401.858
V_TERM(END_U_POINT_NO_HALO)=0.0 APB0F401.859
ADVUGD1A.286
*ENDIF ADVUGD1A.287
ELSE ADVUGD1A.288
*IF DEF,GLOBAL ADVUGD1A.289
C GLOBAL MODEL. ADVUGD1A.290
C CALCULATE ALL VALUES EXCEPT ON ROWS NEXT TO POLES. ADVUGD1A.291
ADVUGD1A.292
! Loop over field, missing top two rows and bottom two rows. APB0F401.860
DO 220 I=START_POINT_NO_HALO+ROW_LENGTH, APB0F401.861
& END_U_POINT_NO_HALO-ROW_LENGTH APB0F401.862
V_TERM(I) = (1.+NUY(I))*.5*(WORK(I-ROW_LENGTH)+WORK(I)) - ADVUGD1A.294
* NUY(I)*.5*(WORK(I+ROW_LENGTH)+WORK(I-2*ROW_LENGTH)) ADVUGD1A.295
220 CONTINUE ADVUGD1A.296
ADVUGD1A.297
C CALCULATE VALUES ON SLICES NEXT TO POLES AND POLAR MERIDIONAL FLUXES. ADVUGD1A.298
C THESE TERMS ARE DIFFERENT TO THE ONES IN LOOP 220 SO AS TO ENSURE ADVUGD1A.299
C CONSERVATION OF FOURTH ORDER SCHEME WITHOUT USING VALUES FROM THE ADVUGD1A.300
C OTHER SIDE OF THE POLE. ADVUGD1A.301
ADVUGD1A.302
CFPP$ NODEPCHK ADVUGD1A.303
! Fujitsu vectorization directive GRB0F405.593
!OCL NOVREC GRB0F405.594
DO 222 I=1,ROW_LENGTH ADVUGD1A.304
IJ = END_U_POINT_NO_HALO - ROW_LENGTH + I APB0F401.863
IK = START_POINT_NO_HALO + I - 1 APB0F401.864
C NEXT TO NORTH POLE SLICE. ADVUGD1A.307
V_TERM(IK) = .5*((1.+NUY(IK))*WORK(IK-ROW_LENGTH) ADVUGD1A.308
* +WORK(IK)) - NUY(IK)*.5*WORK(IK+ROW_LENGTH) ADVUGD1A.309
C NEXT TO SOUTH POLE SLICE. ADVUGD1A.310
V_TERM(IJ) = .5*(WORK(IJ-ROW_LENGTH)+(1.+NUY(IJ))*WORK(IJ)) - ADVUGD1A.311
* NUY(IJ)*.5*WORK(IJ-2*ROW_LENGTH) ADVUGD1A.312
222 CONTINUE ADVUGD1A.313
ADVUGD1A.314
*ELSE ADVUGD1A.315
C LIMITED AREA MODEL. ADVUGD1A.316
C CALCULATE ALL VALUES EXCEPT ON ROWS NEXT TO BOUNDARIES. ADVUGD1A.317
ADVUGD1A.318
! Loop over field, missing top two rows and bottom two rows, and last APB0F401.865
! point. APB0F401.866
DO 220 I=START_POINT_NO_HALO+ROW_LENGTH, APB0F401.867
& END_U_POINT_NO_HALO-ROW_LENGTH-1 APB0F401.868
V_TERM(I) = (1.+NUY(I))*.5*(WORK(I-ROW_LENGTH)+WORK(I)) - ADVUGD1A.320
* NUY(I)*.5*(WORK(I+ROW_LENGTH)+WORK(I-2*ROW_LENGTH)) ADVUGD1A.321
220 CONTINUE ADVUGD1A.322
ADVUGD1A.323
C SET LAST POINT OF LOOP TO ZERO. ADVUGD1A.324
V_TERM(END_U_POINT_NO_HALO-ROW_LENGTH)=0.0 APB0F401.869
C CALCULATE VALUES ON SLICES NEXT TO BOUNDARIES AS SECOND ORDER. ADVUGD1A.326
ADVUGD1A.327
DO 222 I=2,ROW_LENGTH-1 ADVUGD1A.328
IJ = END_U_POINT_NO_HALO-ROW_LENGTH+I APB0F401.870
IK = START_POINT_NO_HALO+I-1 APB0F401.871
C NEXT TO NORTHERN BOUNDARY. ADVUGD1A.331
V_TERM(IK) = .5*(WORK(IK-ROW_LENGTH)+WORK(IK)) ADVUGD1A.332
C NEXT TO SOUTHERN BOUNDARY. ADVUGD1A.333
V_TERM(IJ) = .5*(WORK(IJ-ROW_LENGTH)+WORK(IJ)) ADVUGD1A.334
222 CONTINUE ADVUGD1A.335
C CORNER VALUES ADVUGD1A.336
C ADVUGD1A.337
V_TERM(START_POINT_NO_HALO)=0.0 APB0F401.872
V_TERM(START_POINT_NO_HALO+LAST_ROW_PT-1)=0.0 APB0F401.873
V_TERM(END_U_POINT_NO_HALO-ROW_LENGTH+1)=0.0 APB0F401.874
V_TERM(END_U_POINT_NO_HALO)=0.0 APB0F401.875
ADVUGD1A.342
*ENDIF ADVUGD1A.343
END IF ADVUGD1A.344
ADVUGD1A.345
CL ADVUGD1A.346
CL--------------------------------------------------------------------- ADVUGD1A.347
CL SECTION 3. CALCULATE VERTICAL FLUX AND COMBINE WITH U AND V ADVUGD1A.348
CL TERMS TO FORM INCREMENT. ADVUGD1A.349
CL--------------------------------------------------------------------- ADVUGD1A.350
ADVUGD1A.351
CL VERTICAL FLUX ON INPUT IS .5*TIMESTEP*ETADOT*D(FIELD)/D(ETA) ADVUGD1A.352
CL AT LEVEL K-1/2. AT THE END OF THEIS SECTION IT IS THE SAME ADVUGD1A.353
CL QUANTITY BUT AT LEVEL K+1/2. ADVUGD1A.354
ADVUGD1A.355
! Loop over field, missing top and bottom rows. APB0F401.876
DO 300 I=START_POINT_NO_HALO,END_U_POINT_NO_HALO APB0F401.877
SCALAR1 = .5 * ADVECTION_TIMESTEP * AAD2F304.730
* ETADOT_UPPER(I) * (FIELD_UPPER(I) - FIELD(I)) AAD2F304.731
SCALAR2 = .5 * ADVECTION_TIMESTEP * AAD2F304.732
* ETADOT_LOWER(I) * (FIELD(I) - FIELD_LOWER(I)) AAD2F304.733
FIELD_INC(I) = ADVECTION_TIMESTEP * SEC_U_LATITUDE(I) * ADVUGD1A.359
* (U_TERM(I)+V_TERM(I)) AAD2F304.734
& + SCALAR1+SCALAR2 AAD2F304.735
IF (LWHITBROM) THEN GSS1F304.818
FIELD_INC(I) = FIELD_INC(I) GSS1F304.819
* + FIELD(I)*BRSP(I) AAD2F304.736
END IF GSS1F304.820
300 CONTINUE ADVUGD1A.365
ADVUGD1A.366
*IF -DEF,GLOBAL ADVUGD1A.367
ADVUGD1A.368
CL LIMITED AREA MODEL SET BOUNDARY INCREMENTS TO ZERO. ADVUGD1A.369
ADVUGD1A.370
DO 310 I=START_POINT_NO_HALO,END_U_POINT_NO_HALO,ROW_LENGTH APB0F401.878
FIELD_INC(I) = 0. ADVUGD1A.372
FIELD_INC(I+ROW_LENGTH-1) = 0. ADVUGD1A.373
FIELD_INC(I+ROW_LENGTH-2) = 0. ADVUGD1A.374
AAD2F304.737
AAD2F304.738
310 CONTINUE ADVUGD1A.377
ADVUGD1A.378
*ENDIF ADVUGD1A.379
ADVUGD1A.380
CL END OF ROUTINE ADV_U_GD ADVUGD1A.381
ADVUGD1A.382
RETURN ADVUGD1A.383
END ADVUGD1A.384
*ENDIF ADVUGD1A.385