*IF DEF,A12_1C,OR,DEF,A12_1D ATJ0F402.20
*IF DEF,MPP ATJ0F402.21
C *****************************COPYRIGHT****************************** ADVUGD1C.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. ADVUGD1C.4
C ADVUGD1C.5
C Use, duplication or disclosure of this code is subject to the ADVUGD1C.6
C restrictions as set forth in the contract. ADVUGD1C.7
C ADVUGD1C.8
C Meteorological Office ADVUGD1C.9
C London Road ADVUGD1C.10
C BRACKNELL ADVUGD1C.11
C Berkshire UK ADVUGD1C.12
C RG12 2SZ ADVUGD1C.13
C ADVUGD1C.14
C If no contract has been raised with this copy of the code, the use, ADVUGD1C.15
C duplication or disclosure of it is strictly prohibited. Permission ADVUGD1C.16
C to do so must first be obtained in writing from the Head of Numerical ADVUGD1C.17
C Modelling at the above address. ADVUGD1C.18
C ******************************COPYRIGHT****************************** ADVUGD1C.19
CLL SUBROUTINE ADV_U_GD ------------------------------------------- ADVUGD1C.20
CLL ADVUGD1C.21
CLL PURPOSE: CALCULATES ADVECTION INCREMENTS TO A FIELD AT A ADVUGD1C.22
CLL SINGLE MODEL LEVEL USING AN EQUATION OF THE FORM(38). ADVUGD1C.23
CLL NOT SUITABLE FOR SINGLE COLUMN USE. ADVUGD1C.24
CLL ADVUGD1C.25
CLL VERSION FOR CRAY Y-MP ADVUGD1C.26
CLL ADVUGD1C.27
CLL WRITTEN BY M.H MAWSON. ADVUGD1C.28
CLL MPP CODE ADDED BY P.BURTON ADVUGD1C.29
CLL ADVUGD1C.30
CLL Model Modification history from model version 3.0: ADVUGD1C.31
CLL version Date ADVUGD1C.32
CLL 4.1 29/11/95 New version of routine specifically for MPP ADVUGD1C.33
CLL Fourth order MPP code by Roar Skalin ADVUGD1C.34
CLL P.Burton ADVUGD1C.35
!LL 4.2 10/01/97 Amend calculation to prevent different answers ADR2F402.38
!LL with different compiler options. D. Robinson. ADR2F402.39
!LL 4.4 24/04/97 Removed QAN fix. P.Burton GPB5F403.1
C vn4.3 Mar. 97 T3E migration : optimisation changes GSS1F403.739
C D.Salmond GSS1F403.740
CLL ADVUGD1C.36
CLL PROGRAMMING STANDARD: UNIFIED MODEL DOCUMENTATION PAPER NO. 4, ADVUGD1C.37
CLL STANDARD B. VERSION 2, DATED 18/01/90 ADVUGD1C.38
CLL ADVUGD1C.39
CLL LOGICAL COMPONENTS COVERED: P122 ADVUGD1C.40
CLL ADVUGD1C.41
CLL PROJECT TASK: P1 ADVUGD1C.42
CLL ADVUGD1C.43
CLL DOCUMENTATION: THE EQUATION USED IS (37) ADVUGD1C.44
CLL IN UNIFIED MODEL DOCUMENTATION PAPER NO. 10 ADVUGD1C.45
CLL M.J.P. CULLEN,T.DAVIES AND M.H.MAWSON ADVUGD1C.46
CLLEND------------------------------------------------------------- ADVUGD1C.47
CLL ADVUGD1C.48
C*L ARGUMENTS:--------------------------------------------------- ADVUGD1C.49
SUBROUTINE ADV_U_GD 12ADVUGD1C.50
1 (FIELD_LOWER,FIELD,FIELD_UPPER,U,V, ADVUGD1C.51
1 ETADOT_LOWER,ETADOT_UPPER, ADVUGD1C.52
2 SEC_U_LATITUDE,FIELD_INC,NUX,NUY,U_FIELD, ADVUGD1C.53
3 ROW_LENGTH, ADVUGD1C.54
*CALL ARGFLDPT 
ADVUGD1C.55
4 ADVECTION_TIMESTEP, ADVUGD1C.56
5 LATITUDE_STEP_INVERSE,LONGITUDE_STEP_INVERSE, ADVUGD1C.57
6 SEC_P_LATITUDE,BRSP, ADVUGD1C.58
7 L_SECOND,LWHITBROM, ADVUGD1C.59
& extended_FIELD,extended_U_FIELD, GSS1F403.741
& extended_address) GSS1F403.742
ADVUGD1C.61
IMPLICIT NONE ADVUGD1C.62
ADVUGD1C.63
INTEGER ADVUGD1C.64
* U_FIELD !IN DIMENSION OF FIELDS ON VELOCITY GRID ADVUGD1C.65
&, extended_U_FIELD !IN DIMENSION of U fields with extra halo ADVUGD1C.66
*, ROW_LENGTH !IN NUMBER OF POINTS PER ROW ADVUGD1C.67
ADVUGD1C.68
! All TYPFLDPT arguments are intent IN ADVUGD1C.69
*CALL TYPFLDPT ADVUGD1C.70
ADVUGD1C.71
REAL ADVUGD1C.72
* U(extended_U_FIELD) !IN ADVECTING U FIELD MASS-WEIGHTED AND ADVUGD1C.73
* ! HELD AT P POINTS. FIRST POINT OF FIELD ADVUGD1C.74
* ! IS FIRST P POINT ON SECOND ROW OF P-GRID. ADVUGD1C.75
*,V(extended_U_FIELD) !IN ADVECTING V FIELD MASS-WEIGHTED AND ADVUGD1C.76
* ! HELD AT P POINTS. FIRST POINT OF FIELD ADVUGD1C.77
* ! IS FIRST P POINT ON SECOND ROW OF P-GRID. ADVUGD1C.78
*,ETADOT_UPPER(U_FIELD)!IN ADVECTING VERTICAL VELOC AT K+1/2, ADVUGD1C.79
* ! MASS-WEIGHTED. ADVUGD1C.80
*,ETADOT_LOWER(U_FIELD)!IN ADVECTING VERTICAL VELOC AT K-1/2, ADVUGD1C.81
* ! MASS-WEIGHTED. ADVUGD1C.82
*,FIELD(U_FIELD) !IN FIELD TO BE ADVECTED. ADVUGD1C.83
*,FIELD_UPPER(U_FIELD) !IN FIELD TO BE ADVECTED AT LEVEL + 1 . ADVUGD1C.84
*,FIELD_LOWER(U_FIELD) !IN FIELD TO BE ADVECTED AT LEVEL - 1 . ADVUGD1C.85
*,NUX(U_FIELD) !IN HOLDS PARAMETER NU FOR EAST-WEST ADVECTION. ADVUGD1C.86
*,NUY(U_FIELD) !IN HOLDS PARAMETER NU FOR NORTH-SOUTH ADVECTION. ADVUGD1C.87
*,SEC_U_LATITUDE(U_FIELD) !IN HOLDS 1/COS(PHI) AT U POINTS. ADVUGD1C.88
*,SEC_P_LATITUDE(U_FIELD) !IN HOLDS 1/COS(PHI) AT P POINTS. ADVUGD1C.89
*,ADVECTION_TIMESTEP !IN ADVUGD1C.90
*,LATITUDE_STEP_INVERSE !IN 1/(DELTA PHI) ADVUGD1C.91
*,LONGITUDE_STEP_INVERSE !IN 1/(DELTA LAMDA) ADVUGD1C.92
ADVUGD1C.93
REAL ADVUGD1C.94
* BRSP(U_FIELD) !IN BRSP TERM AT LEVEL+1/2 (SEE DOC.PAPER ADVUGD1C.95
* ! NO 10) ADVUGD1C.96
ADVUGD1C.97
REAL ADVUGD1C.98
* FIELD_INC(U_FIELD) !OUT HOLDS INCREMENT TO FIELD. ADVUGD1C.99
ADVUGD1C.100
REAL ADVUGD1C.101
* VERTICAL_FLUX(U_FIELD) !INOUT HOLDS VERTICAL FLUX OF FIELD ADVUGD1C.102
* ! BETWEEN TWO LEVELS. ADVUGD1C.103
ADVUGD1C.104
REAL ADVUGD1C.105
& extended_FIELD(extended_U_FIELD) ! IN field to be advected with ADVUGD1C.106
! ! extra halos for 4th order ADVUGD1C.107
INTEGER extended_address(U_FIELD) GSS1F403.743
ADVUGD1C.108
C LOGICAL VARIABLE ADVUGD1C.109
LOGICAL ADVUGD1C.110
* L_SECOND ! SET TO TRUE IF NU_BASIC IS ZERO. ADVUGD1C.111
* ,LWHITBROM ! Switch for White & Bromley terms ADVUGD1C.112
C ADVUGD1C.113
ADVUGD1C.114
C*L DEFINE ARRAYS AND VARIABLES USED IN THIS ROUTINE----------------- ADVUGD1C.115
C DEFINE LOCAL ARRAYS: 3 ARE REQUIRED ADVUGD1C.116
ADVUGD1C.117
REAL ADVUGD1C.118
* WORK(U_FIELD) ! GENERAL WORK-SPACE. ADVUGD1C.119
*,U_TERM(U_FIELD) ! HOLDS U ADVECTION TERM FROM EQUATION (37) ADVUGD1C.120
*,V_TERM(U_FIELD) ! HOLDS V ADVECTION TERM FROM EQUATION (37) ADVUGD1C.121
C*--------------------------------------------------------------------- ADVUGD1C.122
C DEFINE LOCAL VARIABLES ADVUGD1C.123
ADVUGD1C.124
C REAL SCALARS ADVUGD1C.125
REAL ADVUGD1C.126
* SCALAR1,SCALAR2 ADVUGD1C.127
ADVUGD1C.128
C COUNT VARIABLES FOR DO LOOPS ETC. ADVUGD1C.129
INTEGER ADVUGD1C.130
* I,J ADVUGD1C.131
ADVUGD1C.132
! Work space and scalars for the MPP Fourth Order Advection ADVUGD1C.133
INTEGER extended_index, ! index for position in extended array ADVUGD1C.134
& extended_START_POINT_NO_HALO, ADVUGD1C.135
! ! start pos in extended array ADVUGD1C.136
& extended_END_U_POINT_NO_HALO, ADVUGD1C.137
! ! end pos in extended array ADVUGD1C.138
& extended_ROW_LENGTH,! row length of extended array ADVUGD1C.139
& I_start,I_end ! loop bounds for 4th order advection ADVUGD1C.140
ADVUGD1C.141
REAL ADR2F402.40
& extended_WORK(extended_U_FIELD) ! extended work space ADVUGD1C.143
ADVUGD1C.144
ADVUGD1C.148
C*L NO EXTERNAL SUBROUTINE CALLS:------------------------------------ ADVUGD1C.149
C*--------------------------------------------------------------------- ADVUGD1C.150
ADVUGD1C.151
CL MAXIMUM VECTOR LENGTH ASSUMED IS ADVUGD1C.152
CL END_U_POINT_NO_HALO-START_U_UPDATE+1 ADVUGD1C.153
CL--------------------------------------------------------------------- ADVUGD1C.154
ADVUGD1C.155
IF (.NOT. L_SECOND) THEN ADVUGD1C.156
! Calculate indexes in extended_arrays ADVUGD1C.157
ADVUGD1C.158
extended_ROW_LENGTH=ROW_LENGTH+2*extra_EW_Halo ADVUGD1C.160
ADVUGD1C.176
extended_START_POINT_NO_HALO= ADVUGD1C.177
& extended_address(START_POINT_NO_HALO) ADVUGD1C.178
ADVUGD1C.179
extended_END_U_POINT_NO_HALO= ADVUGD1C.180
& extended_address(END_U_POINT_NO_HALO) ADVUGD1C.181
ADVUGD1C.182
ENDIF ADVUGD1C.183
ADVUGD1C.184
CL--------------------------------------------------------------------- ADVUGD1C.185
CL SECTION 1. CALCULATE U_TERM IN EQUATION (37). ADVUGD1C.186
CL--------------------------------------------------------------------- ADVUGD1C.187
ADVUGD1C.188
C---------------------------------------------------------------------- ADVUGD1C.189
CL SECTION 1.1 CALCULATE TERM U D(FIELD)/D(LAMDA). ADVUGD1C.190
C---------------------------------------------------------------------- ADVUGD1C.191
ADVUGD1C.192
C CALCULATE TERM AT ALL POINTS EXCEPT LAST AND STORE IN WORK. ADVUGD1C.193
ADVUGD1C.194
IF (L_SECOND) THEN ADVUGD1C.195
! Loop over field, missing top and bottom rows, halos and last point ADVUGD1C.196
DO 110 I=START_POINT_NO_HALO,END_U_POINT_NO_HALO-1 ADVUGD1C.197
WORK(I) = .5*(U(I+1)+U(I+1-ROW_LENGTH))* ADVUGD1C.198
& LONGITUDE_STEP_INVERSE*(FIELD(I+1) - FIELD(I)) ADVUGD1C.199
110 CONTINUE ADVUGD1C.200
ADVUGD1C.201
*IF DEF,GLOBAL ADVUGD1C.202
WORK(END_U_POINT_NO_HALO)=WORK(END_U_POINT_NO_HALO-1) ADVUGD1C.203
*ENDIF ADVUGD1C.204
ADVUGD1C.205
ELSE ! fourth order ADVUGD1C.206
! Loop over extended field, missing top and bottom rows and halos rows ADVUGD1C.207
DO I=extended_START_POINT_NO_HALO-1, ADVUGD1C.208
& extended_END_U_POINT_NO_HALO+1 ADVUGD1C.209
extended_WORK(I) = 0.5*(U(I+1)+U(I+1-extended_ROW_LENGTH))* ADVUGD1C.210
& LONGITUDE_STEP_INVERSE* ADVUGD1C.211
& (extended_FIELD(I+1)-extended_FIELD(I)) ADVUGD1C.212
ENDDO ADVUGD1C.213
ADVUGD1C.214
ENDIF ! IF (L_SECOND) ADVUGD1C.215
ADVUGD1C.216
ADVUGD1C.217
C---------------------------------------------------------------------- ADVUGD1C.218
CL SECTION 1.2 CALCULATE U ADVECTION TERM IN EQUATION (37). ADVUGD1C.219
CL IF L_SECOND=TRUE ONLY DO SECOND ORDER ADVECTION. ADVUGD1C.220
C---------------------------------------------------------------------- ADVUGD1C.221
ADVUGD1C.222
IF(L_SECOND) THEN ADVUGD1C.223
*IF DEF,GLOBAL ADVUGD1C.224
! Loop over field, missing top and bottom rows and halos, and ADVUGD1C.225
! first point. ADVUGD1C.226
DO J=START_POINT_NO_HALO+1,END_U_POINT_NO_HALO ADVUGD1C.227
U_TERM(J) = .5*(WORK(J)+WORK(J-1)) ADVUGD1C.228
END DO ADVUGD1C.229
ADVUGD1C.230
C CALCULATE VALUES AT FIRST POINTS ON A ROW. ADVUGD1C.231
U_TERM(START_POINT_NO_HALO)=U_TERM(START_POINT_NO_HALO+1) ADVUGD1C.232
! MPP Code : No need to do recalculations of end points because cyclic ADVUGD1C.233
! boundary conditions means that halos do this for us automatically ADVUGD1C.234
ADVUGD1C.235
*ELSE ADVUGD1C.236
C LIMITED AREA MODEL. VALUES NOT CALCULATED AT FIRST,SECOND,NEXT TO LAST ADVUGD1C.237
C AND LAST ON A ROW. ADVUGD1C.238
ADVUGD1C.239
! Loop over field, missing top and bottom rows and halos, and ADVUGD1C.240
! first and last points. ADVUGD1C.241
DO J=START_POINT_NO_HALO+1,END_U_POINT_NO_HALO-1 ADVUGD1C.242
U_TERM(J) = .5*(WORK(J)+WORK(J-1)) ADVUGD1C.243
END DO ADVUGD1C.244
ADVUGD1C.245
C CORNER VALUES ADVUGD1C.246
U_TERM(START_POINT_NO_HALO)=0.0 ADVUGD1C.247
U_TERM(END_U_POINT_NO_HALO)=0.0 ADVUGD1C.248
*ENDIF ADVUGD1C.249
ELSE ! Fourth order ADVUGD1C.250
ADVUGD1C.251
C LOOP OVER ALL POINTS BUT DON'T DO FIRST,SECOND AND LAST ON A ROW AS ADVUGD1C.252
C THEY NEED SPECIAL TREATMENT DUE TO FOURTH ORDER SCHEME. ADVUGD1C.253
ADVUGD1C.254
! Loop over field, missing top and bottom rows and halos, and ADVUGD1C.255
! first point. ADVUGD1C.256
DO 120 J=START_POINT_NO_HALO+1,END_U_POINT_NO_HALO ADVUGD1C.257
! DO 120 J=START_POINT_NO_HALO+2,END_U_POINT_NO_HALO-1 ADVUGD1C.258
extended_index=extended_address(J) ADVUGD1C.259
ADVUGD1C.260
U_TERM(J) = (1.+NUX(J))*.5*(extended_WORK(extended_index)+ ADVUGD1C.261
& extended_WORK(extended_index-1)) ADVUGD1C.262
& -NUX(J) *.5*(extended_WORK(extended_index+1)+ ADVUGD1C.263
& extended_WORK(extended_index-2)) ADVUGD1C.264
120 CONTINUE ADVUGD1C.265
ADVUGD1C.266
*IF DEF,GLOBAL ADVUGD1C.267
U_TERM(START_POINT_NO_HALO)= U_TERM(START_POINT_NO_HALO+2) ADVUGD1C.268
! U_TERM(START_POINT_NO_HALO+1)= U_TERM(START_POINT_NO_HALO+2) ADVUGD1C.269
! U_TERM(END_U_POINT_NO_HALO)= U_TERM(END_U_POINT_NO_HALO-1) ADVUGD1C.270
ADVUGD1C.271
*ELSE ADVUGD1C.272
C LIMITED AREA MODEL. ADVUGD1C.273
C CALCULATE VALUES AT SECOND AND NEXT TO LAST POINTS ON A ROW. ADVUGD1C.274
C THESE VALUES ARE JUST SECOND ORDER. ADVUGD1C.275
ADVUGD1C.276
IF (at_left_of_LPG) THEN ADVUGD1C.277
! Do second point along each row ADVUGD1C.278
DO I=START_POINT_NO_HALO+FIRST_ROW_PT,END_U_POINT_NO_HALO, ADVUGD1C.279
& ROW_LENGTH ADVUGD1C.280
extended_index=extended_address(I) ADVUGD1C.281
ADVUGD1C.282
U_TERM(I)= 0.5*(extended_WORK(extended_index)+ ADVUGD1C.283
& extended_WORK(extended_index-1)) ADVUGD1C.284
ENDDO ADVUGD1C.285
ENDIF ADVUGD1C.286
ADVUGD1C.287
! Do penultimate point along each row ADVUGD1C.288
ADVUGD1C.289
IF (at_right_of_LPG) THEN ADVUGD1C.290
DO I=START_POINT_NO_HALO+LAST_ROW_PT-2,END_U_POINT_NO_HALO, ADVUGD1C.291
& ROW_LENGTH ADVUGD1C.292
extended_index=extended_address(I) ADVUGD1C.293
ADVUGD1C.294
U_TERM(I)= 0.5*(extended_WORK(extended_index)+ ADVUGD1C.295
& extended_WORK(extended_index-1)) ADVUGD1C.296
ENDDO ADVUGD1C.297
ENDIF ADVUGD1C.298
ADVUGD1C.299
U_TERM(START_POINT_NO_HALO)=0 ADVUGD1C.300
U_TERM(END_U_POINT_NO_HALO)=0 ADVUGD1C.301
ADVUGD1C.302
*ENDIF ADVUGD1C.303
END IF ! IF (L_SECOND) ADVUGD1C.304
ADVUGD1C.305
CL ADVUGD1C.306
CL--------------------------------------------------------------------- ADVUGD1C.307
CL SECTION 2. CALCULATE V_TERM IN EQUATION (37). ADVUGD1C.308
CL--------------------------------------------------------------------- ADVUGD1C.309
ADVUGD1C.310
C---------------------------------------------------------------------- ADVUGD1C.311
CL SECTION 2.1 CALCULATE TERM V D(FIELD)/D(PHI). ADVUGD1C.312
C---------------------------------------------------------------------- ADVUGD1C.313
ADVUGD1C.314
C CALCULATE TERM AT ALL POINTS EXCEPT LAST AND STORE IN WORK. ADVUGD1C.315
ADVUGD1C.316
IF (L_SECOND) THEN ADVUGD1C.317
ADVUGD1C.318
! Loop over field, mssing bottom row and top and bottom halos and last ADVUGD1C.319
! point. ADVUGD1C.320
DO 210 I=START_POINT_NO_HALO-ROW_LENGTH, ADVUGD1C.321
& END_U_POINT_NO_HALO-1 ADVUGD1C.322
WORK(I) = .5*(V(I)+V(I+1))*LATITUDE_STEP_INVERSE* ADVUGD1C.323
* (FIELD(I) - FIELD(I+ROW_LENGTH)) ADVUGD1C.324
210 CONTINUE ADVUGD1C.325
ADVUGD1C.326
*IF DEF,GLOBAL ADVUGD1C.327
C IF GLOBAL MODEL RECALCULATE END-POINT VALUE. ADVUGD1C.328
WORK(END_U_POINT_NO_HALO)=WORK(END_U_POINT_NO_HALO-1) ADVUGD1C.329
*ENDIF ADVUGD1C.330
ADVUGD1C.331
ELSE ! Fourth order ADVUGD1C.332
! Calculate WORK at the Southern halo too. This is needed for the ADVUGD1C.333
! computation of the Southern row ADVUGD1C.334
ADVUGD1C.335
! DO I=extended_START_POINT_NO_HALO-2*extended_ROW_LENGTH, ADVUGD1C.336
! & extended_END_U_POINT_NO_HALO+extended_ROW_LENGTH ADVUGD1C.337
IF (at_top_of_LPG) THEN ADVUGD1C.338
I_start=extended_address(TOP_ROW_START) ADVUGD1C.339
ELSE ADVUGD1C.340
I_start=extended_START_POINT_NO_HALO-2*extended_ROW_LENGTH ADVUGD1C.341
ENDIF ADVUGD1C.342
IF (at_base_of_LPG) THEN ADVUGD1C.343
I_end=extended_END_U_POINT_NO_HALO-1 ADVUGD1C.344
ELSE ADVUGD1C.345
I_end=extended_END_U_POINT_NO_HALO-1+extended_ROW_LENGTH ADVUGD1C.346
ENDIF ADVUGD1C.347
DO I=I_start,I_end ADVUGD1C.348
extended_WORK(I)=0.5*(V(I)+V(I+1))*LATITUDE_STEP_INVERSE* ADVUGD1C.349
& (extended_FIELD(I)-extended_FIELD(I+extended_ROW_LENGTH)) ADVUGD1C.350
ENDDO ADVUGD1C.351
extended_WORK(I_end+1)=extended_WORK(I_end) GPB5F403.2
ADVUGD1C.352
ENDIF ! L_SECOND ADVUGD1C.353
ADVUGD1C.354
ADVUGD1C.355
C---------------------------------------------------------------------- ADVUGD1C.356
CL SECTION 2.2 CALCULATE V ADVECTION TERM IN EQUATION (37). ADVUGD1C.357
CL IF L_SECOND=TRUE ONLY DO SECOND ORDER ADVECTION. ADVUGD1C.358
C---------------------------------------------------------------------- ADVUGD1C.359
ADVUGD1C.360
IF(L_SECOND) THEN ADVUGD1C.361
*IF DEF,GLOBAL ADVUGD1C.362
C GLOBAL MODEL. ADVUGD1C.363
C CALCULATE ALL VALUES EXCEPT ON ROWS NEXT TO POLES. ADVUGD1C.364
ADVUGD1C.365
! Loop over field, missing top and bottom rows and halos ADVUGD1C.366
DO I=START_POINT_NO_HALO,END_U_POINT_NO_HALO ADVUGD1C.367
V_TERM(I) = .5*(WORK(I-ROW_LENGTH)+WORK(I)) ADVUGD1C.368
END DO ADVUGD1C.369
ADVUGD1C.370
*ELSE ADVUGD1C.371
C LIMITED AREA MODEL. ADVUGD1C.372
C CALCULATE ALL VALUES EXCEPT ON ROWS NEXT TO BOUNDARIES. ADVUGD1C.373
ADVUGD1C.374
! Loop over field, missing top and bottom rows and halos, and ADVUGD1C.375
! first and last points. ADVUGD1C.376
DO I=START_POINT_NO_HALO+1,END_U_POINT_NO_HALO-1 ADVUGD1C.377
V_TERM(I) = .5*(WORK(I-ROW_LENGTH)+WORK(I)) ADVUGD1C.378
END DO ADVUGD1C.379
ADVUGD1C.380
C SET LAST POINT OF LOOP TO ZERO. ADVUGD1C.381
V_TERM(END_U_POINT_NO_HALO-ROW_LENGTH) = 0.0 ADVUGD1C.382
ADVUGD1C.383
C CORNER VALUES ADVUGD1C.384
ADVUGD1C.385
V_TERM(START_POINT_NO_HALO)=0.0 ADVUGD1C.386
V_TERM(END_U_POINT_NO_HALO)=0.0 ADVUGD1C.387
ADVUGD1C.388
*ENDIF ADVUGD1C.389
ELSE ! Fourth order ADVUGD1C.390
*IF DEF,GLOBAL ADVUGD1C.391
C GLOBAL MODEL. ADVUGD1C.392
! Calculate all values except on rows next to poles and next to the ADVUGD1C.393
! processor interfaces ADVUGD1C.394
ADVUGD1C.395
! Loop over field, missing top and bottom rows and halos ADVUGD1C.396
IF (at_top_of_LPG) THEN ADVUGD1C.397
I_start=START_POINT_NO_HALO+ROW_LENGTH ADVUGD1C.398
ELSE ADVUGD1C.399
I_start=START_POINT_NO_HALO ADVUGD1C.400
ENDIF ADVUGD1C.401
IF (at_base_of_LPG) THEN ADVUGD1C.402
I_end=END_U_POINT_NO_HALO-ROW_LENGTH ADVUGD1C.403
ELSE ADVUGD1C.404
I_end=END_U_POINT_NO_HALO ADVUGD1C.405
ENDIF ADVUGD1C.406
! DO I=START_POINT_NO_HALO,END_U_POINT_NO_HALO ADVUGD1C.407
DO I=I_start,I_end ADVUGD1C.408
extended_index=extended_address(I) ADVUGD1C.409
ADVUGD1C.410
V_TERM(I) = (1.0+NUY(I))*0.5* ADVUGD1C.411
& (extended_WORK(extended_index-extended_ROW_LENGTH) ADVUGD1C.412
& + extended_WORK(extended_index)) ADVUGD1C.413
& - NUY(I) *0.5* ADVUGD1C.414
& (extended_WORK(extended_index+extended_ROW_LENGTH) ADVUGD1C.415
& + extended_WORK(extended_index-2*extended_ROW_LENGTH)) ADVUGD1C.416
ENDDO ADVUGD1C.417
ADVUGD1C.418
C CALCULATE VALUES ON SLICES NEXT TO POLES AND POLAR MERIDIONAL FLUXES. ADVUGD1C.419
C THESE TERMS ARE DIFFERENT TO THE ONES IN LOOP 220 SO AS TO ENSURE ADVUGD1C.420
C CONSERVATION OF FOURTH ORDER SCHEME WITHOUT USING VALUES FROM THE ADVUGD1C.421
C OTHER SIDE OF THE POLE. ADVUGD1C.422
ADVUGD1C.423
IF (at_top_of_LPG) THEN ADVUGD1C.424
! Loop over row beneath pole ADVUGD1C.425
DO I=START_POINT_NO_HALO,START_POINT_NO_HALO+ROW_LENGTH-1 ADVUGD1C.426
extended_index=extended_address(I) ADVUGD1C.427
ADVUGD1C.428
V_TERM(I)=0.5*((1.0+NUY(I))* ADVUGD1C.429
& extended_WORK(extended_index-extended_ROW_LENGTH) + ADVUGD1C.430
& extended_WORK(extended_index)) ADVUGD1C.431
& - NUY(I)*0.5* ADVUGD1C.432
& extended_WORK(extended_index+extended_ROW_LENGTH) ADVUGD1C.433
ENDDO ADVUGD1C.434
ENDIF ADVUGD1C.435
ADVUGD1C.436
IF (at_base_of_LPG) THEN ADVUGD1C.437
! Loop over row above pole ADVUGD1C.438
DO I=END_U_POINT_NO_HALO-ROW_LENGTH+1,END_U_POINT_NO_HALO ADVUGD1C.439
extended_index=extended_address(I) ADVUGD1C.440
ADVUGD1C.441
V_TERM(I)= ADVUGD1C.442
& 0.5*(extended_WORK(extended_index-extended_ROW_LENGTH) ADVUGD1C.443
& + (1.0+NUY(I))*extended_WORK(extended_index)) ADVUGD1C.444
& - NUY(I)*0.5* ADVUGD1C.445
& extended_WORK(extended_index-2*extended_ROW_LENGTH) ADVUGD1C.446
ADVUGD1C.447
ENDDO ADVUGD1C.448
ENDIF ADVUGD1C.449
ADVUGD1C.450
*ELSE ADVUGD1C.451
C LIMITED AREA MODEL. ADVUGD1C.452
C CALCULATE ALL VALUES EXCEPT ON ROWS NEXT TO BOUNDARIES. ADVUGD1C.453
ADVUGD1C.454
! Loop over field, missing top and bottom rows and halos ADVUGD1C.455
IF (at_top_of_LPG) THEN ADVUGD1C.456
I_start=START_POINT_NO_HALO+ROW_LENGTH ADVUGD1C.457
ELSE ADVUGD1C.458
I_start=START_POINT_NO_HALO ADVUGD1C.459
ENDIF ADVUGD1C.460
IF (at_base_of_LPG) THEN ADVUGD1C.461
I_end=END_U_POINT_NO_HALO-ROW_LENGTH ADVUGD1C.462
ELSE ADVUGD1C.463
I_end=END_U_POINT_NO_HALO ADVUGD1C.464
ENDIF ADVUGD1C.465
! DO I=START_POINT_NO_HALO,END_U_POINT_NO_HALO ADVUGD1C.466
DO I=I_start,I_end ADVUGD1C.467
extended_index=extended_address(I) ADVUGD1C.468
ADVUGD1C.469
V_TERM(I) = (1.0+NUY(I))*0.5* ADVUGD1C.470
& (extended_WORK(extended_index-extended_ROW_LENGTH) ADVUGD1C.471
& + extended_WORK(extended_index)) ADVUGD1C.472
& - NUY(I) *0.5* ADVUGD1C.473
& (extended_WORK(extended_index+extended_ROW_LENGTH) ADVUGD1C.474
& + extended_WORK(extended_index-2*extended_ROW_LENGTH)) ADVUGD1C.475
ENDDO ADVUGD1C.476
ADVUGD1C.477
C CALCULATE VALUES ON SLICES NEXT TO BOUNDARIES AS SECOND ORDER. ADVUGD1C.478
IF (at_top_of_LPG) THEN ADVUGD1C.479
! Loop over row beneath top row ADVUGD1C.480
DO I=START_POINT_NO_HALO+FIRST_ROW_PT-1, ADVUGD1C.481
& START_POINT_NO_HALO+LAST_ROW_PT-1 ADVUGD1C.482
extended_index=extended_address(I) ADVUGD1C.483
V_TERM(I)=0.5* ADVUGD1C.484
& (extended_WORK(extended_index-extended_ROW_LENGTH) ADVUGD1C.485
& + extended_WORK(extended_index)) ADVUGD1C.486
ENDDO ADVUGD1C.487
ENDIF ADVUGD1C.488
ADVUGD1C.489
IF (at_base_of_LPG) THEN ADVUGD1C.490
DO I=END_U_POINT_NO_HALO-ROW_LENGTH+FIRST_ROW_PT, ADVUGD1C.491
& END_U_POINT_NO_HALO-ROW_LENGTH+LAST_ROW_PT ADVUGD1C.492
extended_index=extended_address(I) ADVUGD1C.493
V_TERM(I)=0.5* ADVUGD1C.494
& (extended_WORK(extended_index-extended_ROW_LENGTH) ADVUGD1C.495
& + extended_WORK(extended_index)) ADVUGD1C.496
ENDDO ADVUGD1C.497
ENDIF ADVUGD1C.498
ADVUGD1C.499
C CORNER VALUES ADVUGD1C.500
C ADVUGD1C.501
V_TERM(START_POINT_NO_HALO)=0.0 ADVUGD1C.502
V_TERM(START_POINT_NO_HALO+ROW_LENGTH-1)=0.0 ADVUGD1C.503
V_TERM(END_U_POINT_NO_HALO-ROW_LENGTH+1)=0.0 ADVUGD1C.504
V_TERM(END_U_POINT_NO_HALO)=0.0 ADVUGD1C.505
ADVUGD1C.506
*ENDIF ADVUGD1C.507
END IF ADVUGD1C.508
ADVUGD1C.509
CL ADVUGD1C.510
CL--------------------------------------------------------------------- ADVUGD1C.511
CL SECTION 3. CALCULATE VERTICAL FLUX AND COMBINE WITH U AND V ADVUGD1C.512
CL TERMS TO FORM INCREMENT. ADVUGD1C.513
CL--------------------------------------------------------------------- ADVUGD1C.514
ADVUGD1C.515
CL VERTICAL FLUX ON INPUT IS .5*TIMESTEP*ETADOT*D(FIELD)/D(ETA) ADVUGD1C.516
CL AT LEVEL K-1/2. AT THE END OF THEIS SECTION IT IS THE SAME ADVUGD1C.517
CL QUANTITY BUT AT LEVEL K+1/2. ADVUGD1C.518
ADVUGD1C.519
! Loop over field, missing top and bottom rows and halos ADVUGD1C.520
DO 300 I=START_POINT_NO_HALO,END_U_POINT_NO_HALO ADVUGD1C.521
SCALAR1 = .5 * ADVECTION_TIMESTEP * ADVUGD1C.522
* ETADOT_UPPER(I) * (FIELD_UPPER(I) - FIELD(I)) ADVUGD1C.523
SCALAR2 = .5 * ADVECTION_TIMESTEP * ADVUGD1C.524
* ETADOT_LOWER(I) * (FIELD(I) - FIELD_LOWER(I)) ADVUGD1C.525
FIELD_INC(I) = ADVECTION_TIMESTEP * SEC_U_LATITUDE(I) * ADVUGD1C.526
* (U_TERM(I)+V_TERM(I)) ADVUGD1C.527
& + SCALAR1+SCALAR2 ADVUGD1C.528
IF (LWHITBROM) THEN ADVUGD1C.529
FIELD_INC(I) = FIELD_INC(I) ADVUGD1C.530
* + FIELD(I)*BRSP(I) ADVUGD1C.531
END IF ADVUGD1C.532
300 CONTINUE ADVUGD1C.533
ADVUGD1C.534
*IF -DEF,GLOBAL ADVUGD1C.535
ADVUGD1C.536
CL LIMITED AREA MODEL SET BOUNDARY INCREMENTS TO ZERO. ADVUGD1C.537
ADVUGD1C.538
IF (at_left_of_LPG) THEN ADVUGD1C.539
DO I=START_POINT_NO_HALO+FIRST_ROW_PT-1, ADVUGD1C.540
& END_U_POINT_NO_HALO,ROW_LENGTH ADVUGD1C.541
FIELD_INC(I)=0.0 ADVUGD1C.542
ENDDO ADVUGD1C.543
ENDIF ADVUGD1C.544
ADVUGD1C.545
IF (at_right_of_LPG) THEN ADVUGD1C.546
DO I=START_POINT_NO_HALO+LAST_ROW_PT-2, ADVUGD1C.547
& END_U_POINT_NO_HALO,ROW_LENGTH ADVUGD1C.548
FIELD_INC(I)=0.0 ADVUGD1C.549
FIELD_INC(I+1)=0.0 ADVUGD1C.550
ENDDO ADVUGD1C.551
ENDIF ADVUGD1C.552
ADVUGD1C.553
*ENDIF ADVUGD1C.554
ADVUGD1C.555
CL END OF ROUTINE ADV_U_GD ADVUGD1C.556
ADVUGD1C.557
RETURN ADVUGD1C.558
END ADVUGD1C.559
*ENDIF ATJ0F402.22
*ENDIF ADVUGD1C.560