*IF DEF,A13_1C DIFCTL1C.2
C ******************************COPYRIGHT****************************** DIFCTL1C.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. DIFCTL1C.4
C DIFCTL1C.5
C Use, duplication or disclosure of this code is subject to the DIFCTL1C.6
C restrictions as set forth in the contract. DIFCTL1C.7
C DIFCTL1C.8
C Meteorological Office DIFCTL1C.9
C London Road DIFCTL1C.10
C BRACKNELL DIFCTL1C.11
C Berkshire UK DIFCTL1C.12
C RG12 2SZ DIFCTL1C.13
C DIFCTL1C.14
C If no contract has been raised with this copy of the code, the use, DIFCTL1C.15
C duplication or disclosure of it is strictly prohibited. Permission DIFCTL1C.16
C to do so must first be obtained in writing from the Head of Numerical DIFCTL1C.17
C Modelling at the above address. DIFCTL1C.18
C ******************************COPYRIGHT****************************** DIFCTL1C.19
C DIFCTL1C.20
CLL SUBROUTINE DIF_CTL ------------------------------------------ DIFCTL1C.21
CLL DIFCTL1C.22
CLL PURPOSE: CALCULATES AND ADDS DIFFUSION INCREMENTS TO U,V, QT DIFCTL1C.23
CLL AND THETAL USING EQUATIONS (47) AND (48). ONE MORE DIFCTL1C.24
CLL PRESSURE THAN VELOCITY ROW IS UPDATED. DIFCTL1C.25
CLL DIFCTL1C.26
CLL NOT SUITABLE FOR SINGLE COLUMN USE. DIFCTL1C.27
CLL DIFCTL1C.28
CLL WRITTEN BY M.H MAWSON. DIFCTL1C.29
CLL DIFCTL1C.30
CLL MODEL MODIFICATION HISTORY: DIFCTL1C.31
CLL VERSION DATE DIFCTL1C.32
CLL DIFCTL1C.33
!LL 4.4 11/08/97 New version optimised for T3E. DIFCTL1C.34
!LL Not bit-reproducible with DIFCTL1A. DIFCTL1C.35
CLL 4.4 25/07/97 Calling sequence changed for UV_DIF, TH_Q_DIF, DIFCTL1C.36
CLL COEFF_UV, COEF_TH_Q from once per diffusion DIFCTL1C.37
CLL sweep per level to once per dynamics DIFCTL1C.38
CLL sweep, in order to improve MPP scalability. DIFCTL1C.39
CLL A. Dickinson DIFCTL1C.40
CLL DIFCTL1C.41
CLL DIFCTL1C.42
CLL PROGRAMMING STANDARD: DIFCTL1C.43
CLL DIFCTL1C.44
CLL SYSTEM COMPONENTS COVERED: P13 DIFCTL1C.45
CLL DIFCTL1C.46
CLL SYSTEM TASK: P1 DIFCTL1C.47
CLL DIFCTL1C.48
CLL DOCUMENTATION: THE EQUATIONS USED ARE (47) AND (48) DIFCTL1C.49
CLL IN UNIFIED MODEL DOCUMENTATION PAPER DIFCTL1C.50
CLL NO. 10 M.J.P. CULLEN,T.DAVIES AND M.H.MAWSON DIFCTL1C.51
CLLEND------------------------------------------------------------- DIFCTL1C.52
C DIFCTL1C.53
C*L ARGUMENTS:--------------------------------------------------- DIFCTL1C.54
SUBROUTINE DIF_CTL 1,31DIFCTL1C.55
1 (PSTAR,U,V,THETAL,QT,RS_SQUARED_DELTAP,K1,K2, DIFCTL1C.56
2 KEXP_K1,KEXP_K2, DIFCTL1C.57
& DELTA_AK,DELTA_BK,AK,BK,ADVECTION_TIMESTEP, DIFCTL1C.58
3 COS_U_LATITUDE,COS_P_LATITUDE,SEC_U_LATITUDE, DIFCTL1C.59
4 SEC_P_LATITUDE,LONGITUDE_STEP_INVERSE,P_FIELD, DIFCTL1C.60
5 LATITUDE_STEP_INVERSE,U_FIELD,ROW_LENGTH, DIFCTL1C.61
*CALL ARGFLDPT 
DIFCTL1C.62
6 P_LEVELS,Q_LEVELS, DIFCTL1C.63
7 COS_U_LONGITUDE,SIN_U_LONGITUDE, DIFCTL1C.64
8 PRESSURE_ALTITUDE,L_TRACER_THETAL_QT) DIFCTL1C.65
DIFCTL1C.66
IMPLICIT NONE DIFCTL1C.67
DIFCTL1C.68
INTEGER DIFCTL1C.69
* U_FIELD !IN DIMENSION OF FIELDS ON VELOCITY GRID DIFCTL1C.70
*, P_FIELD !IN DIMENSION OF FIELDS ON PRESSURE GRID DIFCTL1C.71
*, P_LEVELS !IN NUMBER OF MODEL LEVELS. DIFCTL1C.72
*, Q_LEVELS !IN NUMBER OF MOIST MODEL LEVELS. DIFCTL1C.73
*, ROW_LENGTH !IN NUMBER OF POINTS PER ROW DIFCTL1C.74
&, KEXP_K1(P_LEVELS) !IN. EXPONENT OF DIFFUSION SCHEME FOR U,V DIFCTL1C.75
& ! AND THETAL FIELDS. DIFCTL1C.76
&, KEXP_K2(Q_LEVELS) !IN. EXPONENT OF DIFFUSION SCHEME FOR DIFCTL1C.77
& ! QT FIELD. DIFCTL1C.78
DIFCTL1C.79
! All TYPFLDPT arguments are intent IN DIFCTL1C.80
*CALL TYPFLDPT DIFCTL1C.81
DIFCTL1C.82
REAL DIFCTL1C.83
* U(U_FIELD,P_LEVELS) !INOUT U VELOCITY FIELD. DIFCTL1C.84
*,V(U_FIELD,P_LEVELS) !INOUT V VELOCITY FIELD. DIFCTL1C.85
*,THETAL(P_FIELD,P_LEVELS) !INOUT THETAL FIELD. DIFCTL1C.86
*,QT(P_FIELD,Q_LEVELS) !INOUT QT FIELD. DIFCTL1C.87
DIFCTL1C.88
REAL DIFCTL1C.89
* PSTAR(P_FIELD) !IN PSTAR FIELD. DIFCTL1C.90
*,RS_SQUARED_DELTAP(P_FIELD,P_LEVELS) !IN RS*RS*DELTA P DIFCTL1C.91
*,COS_U_LATITUDE(U_FIELD) !IN COS(LAT) AT U POINTS. DIFCTL1C.92
*,COS_P_LATITUDE(P_FIELD) !IN COS(LAT) AT P POINTS. DIFCTL1C.93
*,SEC_U_LATITUDE(U_FIELD) !IN 1/COS(LAT) AT U POINTS. DIFCTL1C.94
*,SEC_P_LATITUDE(P_FIELD) !IN 1/COS(LAT) AT P POINTS. DIFCTL1C.95
*,COS_U_LONGITUDE(ROW_LENGTH) !IN COS(LONGITUDE) AT U POINTS. DIFCTL1C.96
*,SIN_U_LONGITUDE(ROW_LENGTH) !IN SIN(LONGITUDE) AT U POINTS. DIFCTL1C.97
DIFCTL1C.98
REAL DIFCTL1C.99
* DELTA_AK(P_LEVELS) !IN LAYER THICKNESS DIFCTL1C.100
*,DELTA_BK(P_LEVELS) !IN LAYER THICKNESS DIFCTL1C.101
*,AK(P_LEVELS) !LAYER AK'S DIFCTL1C.102
*,BK(P_LEVELS) !LAYER BK'S DIFCTL1C.103
*,K1(P_LEVELS) !IN DIFFUSION COEFF SEE EQ. (45) DIFCTL1C.104
*,K2(P_LEVELS) !IN DIFFUSION COEFF SEE EQ. (45) DIFCTL1C.105
*,LONGITUDE_STEP_INVERSE !IN 1/(DELTA LAMDA) DIFCTL1C.106
*,LATITUDE_STEP_INVERSE !IN 1/(DELTA PHI) DIFCTL1C.107
*,ADVECTION_TIMESTEP !IN DIFCTL1C.108
*, PRESSURE_ALTITUDE ! ALTITUDE FOR HIGHEST SLOPE TEST DIFCTL1C.109
DIFCTL1C.110
LOGICAL DIFCTL1C.111
* L_TRACER_THETAL_QT ! T if tracer advn. for thetal,qt DIFCTL1C.112
C*--------------------------------------------------------------------- DIFCTL1C.113
DIFCTL1C.114
C*L DEFINE ARRAYS AND VARIABLES USED IN THIS ROUTINE----------------- DIFCTL1C.115
C DEFINE LOCAL ARRAYS: 13 ARE REQUIRED DIFCTL1C.116
REAL DIFCTL1C.117
DIFCTL1C.118
* RECIP_RS_SQUARED_DELTAP(P_FIELD,P_LEVELS) ! 1./RS*RS*DELTA P DIFCTL1C.119
*,PSTAR_UV(U_FIELD) ! HOLDS PRESSURE AT U POINTS. DIFCTL1C.120
*, PRESSURE(P_FIELD,P_LEVELS) !3-D PRESSURE ARRAY FOR TESTING DIFCTL1C.121
* ! SLOPE. LEVEL_P=1 IS SURFACE, LEVEL_P=K IS LEVEL K-1 DIFCTL1C.122
* ! FOR UV POINTS PRESSURE RE-CALCULATED TO UV POINTS DIFCTL1C.123
*, DIFFUSION_EW(P_FIELD,P_LEVELS) DIFCTL1C.124
!HOLDS EFFECTIVE EAST-WEST DIFFUSION DIFCTL1C.125
* ! COEFFICIENT DIFCTL1C.126
*, DIFFUSION_NS(P_FIELD,P_LEVELS) DIFCTL1C.127
!HOLDS EFFECTIVE NORTH-SOUTH DIFFUSION DIFCTL1C.128
* ! COEFFICIENT DIFCTL1C.129
*,COS_FUNCTION_U(U_FIELD) DIFCTL1C.130
*,COS_FUNCTION_P(P_FIELD) DIFCTL1C.131
DIFCTL1C.132
C*--------------------------------------------------------------------- DIFCTL1C.133
C DEFINE LOCAL VARIABLES DIFCTL1C.134
INTEGER DIFCTL1C.135
& START_U_UPDATE ! First U point to be updated DIFCTL1C.136
&, END_U_UPDATE ! Last U point to be updated DIFCTL1C.137
DIFCTL1C.138
REAL DIFCTL1C.139
* SCALAR,PRESSURE_TEST DIFCTL1C.140
C COUNT VARIABLES FOR DO LOOPS ETC. DIFCTL1C.141
INTEGER DIFCTL1C.142
* I,J,K,LEVEL_BASE DIFCTL1C.143
DIFCTL1C.144
C*L EXTERNAL SUBROUTINE CALLS:--------------------------------------- DIFCTL1C.145
EXTERNAL DIFCTL1C.146
* TH_Q_DIF,UV_DIF,P_TO_UV,COEFF_TH_Q,COEFF_UV DIFCTL1C.147
C*--------------------------------------------------------------------- DIFCTL1C.148
CL MAXIMUM VECTOR LENGTH ASSUMED IS P_FIELD DIFCTL1C.149
CL--------------------------------------------------------------------- DIFCTL1C.150
CL INTERNAL STRUCTURE. DIFCTL1C.151
CL--------------------------------------------------------------------- DIFCTL1C.152
CL DIFCTL1C.153
CL--------------------------------------------------------------------- DIFCTL1C.154
CL SECTION 1. INITIALISE LOCAL VARIABLES AND INTERPOLATE PSTAR DIFCTL1C.155
CL ONTO U-GRID. DIFCTL1C.156
CL--------------------------------------------------------------------- DIFCTL1C.157
DIFCTL1C.158
C**************************************************************** DIFCTL1C.159
C SET PRESSURE_TEST TO PRESSURE_ALTITUDE ABOVE WHICH HEIGHT DIFCTL1C.160
C NO SLOPE TESTING FOR EFFECTIVE DIFFUSION DIFCTL1C.161
C*************************************************************** DIFCTL1C.162
PRESSURE_TEST=PRESSURE_ALTITUDE DIFCTL1C.163
DIFCTL1C.164
! Diffusion is a bit different from the other dynamics routines. DIFCTL1C.165
! START_U_UPDATE and END_U_UPDATE are different for global and LAM DIFCTL1C.166
! models - for the global model they include the polar rows, DIFCTL1C.167
! but for the LAM they miss the Northern and Southern rows. So DIFCTL1C.168
! for this section of code only, we will keep the START_U_UPDATE DIFCTL1C.169
! and END_U_UPDATE, rather than using TYPFLDPT equivalents. DIFCTL1C.170
DIFCTL1C.171
*IF DEF,GLOBAL DIFCTL1C.172
! Update U field over entire field, including poles DIFCTL1C.173
START_U_UPDATE=FIRST_FLD_PT DIFCTL1C.174
END_U_UPDATE=LAST_U_FLD_PT DIFCTL1C.175
*ELSE DIFCTL1C.176
! Update U field, missing top and bottom rows DIFCTL1C.177
START_U_UPDATE=START_POINT_NO_HALO DIFCTL1C.178
END_U_UPDATE=END_U_POINT_NO_HALO DIFCTL1C.179
*ENDIF DIFCTL1C.180
SCALAR = LATITUDE_STEP_INVERSE*LATITUDE_STEP_INVERSE/ DIFCTL1C.181
1 (LONGITUDE_STEP_INVERSE*LONGITUDE_STEP_INVERSE) DIFCTL1C.182
DO I=FIRST_VALID_PT,LAST_U_VALID_PT DIFCTL1C.183
COS_FUNCTION_U(I) = COS_U_LATITUDE(I)*COS_U_LATITUDE(I)*SCALAR DIFCTL1C.184
COS_FUNCTION_P(I) = COS_P_LATITUDE(I)*COS_P_LATITUDE(I)*SCALAR DIFCTL1C.185
END DO DIFCTL1C.186
DIFCTL1C.187
DO I=LAST_U_VALID_PT+1,LAST_P_VALID_PT DIFCTL1C.188
COS_FUNCTION_P(I) = COS_P_LATITUDE(I)*COS_P_LATITUDE(I)*SCALAR DIFCTL1C.189
END DO DIFCTL1C.190
DIFCTL1C.191
CL CALL P_TO_UV DIFCTL1C.192
C STORE PSTAR ON U GRID IN PSTAR_UV. DIFCTL1C.193
DIFCTL1C.194
CALL P_TO_UV(PSTAR,PSTAR_UV,P_FIELD,U_FIELD,ROW_LENGTH,tot_P_ROWS) DIFCTL1C.195
*IF DEF,MPP DIFCTL1C.196
! Get correct values in halos DIFCTL1C.197
CALL SWAPBOUNDS(PSTAR_UV,ROW_LENGTH,tot_U_ROWS,EW_Halo,NS_Halo,1) DIFCTL1C.198
*ENDIF DIFCTL1C.199
DIFCTL1C.200
CL MAKE 3-D PRESSURE ARRAY AT P POINTS DIFCTL1C.201
CL LEVEL_P=1 SURFACE, LEVEL_P=K IS LEVEL K-1 DIFCTL1C.202
CL ONLY NEED P_LEVELS AS SURFACES SHOULD BE PRESSURE SURFACES DIFCTL1C.203
CL NEAR TOP OF MODEL SO TESTING UNNECESSARY DIFCTL1C.204
C**************************************************************** DIFCTL1C.205
C IF USING TRACER ADVECTION OF THETAL AND QT THEN DIFFUSION IS DIFCTL1C.206
C CALLED FOR TOP LEVEL THETAL AND FOR ALL U'S AND V'S ONLY DIFCTL1C.207
C NOTE STEEP SLOPE TEST SHOULD BE DISABLED BY APPROPRIATE DIFCTL1C.208
C SETTING OF PRESSURE ALTITUDE WHICH MEANS THAT PRESSURES DIFCTL1C.209
C DO NOT NEED CALCULATING FOR PRESSURE ARRAY DIFCTL1C.210
C*************************************************************** DIFCTL1C.211
DIFCTL1C.212
IF(.NOT.L_TRACER_THETAL_QT)THEN DIFCTL1C.213
DIFCTL1C.214
CL FIRST LEVEL DIFCTL1C.215
DO I=FIRST_VALID_PT,LAST_P_VALID_PT DIFCTL1C.216
RECIP_RS_SQUARED_DELTAP(I,1)=1./RS_SQUARED_DELTAP(I,1) DIFCTL1C.217
PRESSURE(I,1)=PSTAR(I) DIFCTL1C.218
END DO DIFCTL1C.219
CL OTHER LEVELS DIFCTL1C.220
DO K=2,P_LEVELS DIFCTL1C.221
DO I=FIRST_VALID_PT,LAST_P_VALID_PT DIFCTL1C.222
RECIP_RS_SQUARED_DELTAP(I,K)=1./RS_SQUARED_DELTAP(I,K) DIFCTL1C.223
PRESSURE(I,K)=AK(K-1)+BK(K-1)*PSTAR(I) DIFCTL1C.224
END DO DIFCTL1C.225
END DO DIFCTL1C.226
DIFCTL1C.227
C POINTER FOR DIFFUSION LEVEL START DIFCTL1C.228
LEVEL_BASE=1 DIFCTL1C.229
DIFCTL1C.230
ELSE DIFCTL1C.231
CLL DIFCTL1C.232
C IF USING TRACER ADVECTION OF THETAL AND QT THEN DIFFUSION IS DIFCTL1C.233
C CALLED FOR TOP LEVEL THETAL AND FOR ALL U'S AND V'S ONLY DIFCTL1C.234
C LEVEL_BASE IS THEN SET TO P_LEVELS OTHERWISE SET TO 1 DIFCTL1C.235
C IF NECESSARY THE TEST COULD BE MADE ON THE VALUE OF THE DIFCTL1C.236
C DIFFUSION COEFFICIENT K1 FOR EACH LEVEL DIFCTL1C.237
C NOTE STEEP SLOPE TEST SHOULD BE DISABLED BY APPROPRIATE DIFCTL1C.238
C SETTING OF PRESSURE ALTITUDE WHICH MEANS THAT PRESSURES DIFCTL1C.239
C DO NOT NEED CALCULATING FOR PRESSURE ARRAY DIFCTL1C.240
CLL DIFCTL1C.241
LEVEL_BASE=P_LEVELS DIFCTL1C.242
DIFCTL1C.243
END IF DIFCTL1C.244
DIFCTL1C.245
DIFCTL1C.246
CL DIFCTL1C.247
CL--------------------------------------------------------------------- DIFCTL1C.248
CL SECTION 2. CALCULATE DIFFUSION OF THETAL. DIFCTL1C.249
CL ADD ON INCREMENT TO ALL POINTS EXCEPT POLES DIFCTL1C.250
CL WHICH WOULD HAVE BEEN DONE INSIDE TH_Q_DIF. DIFCTL1C.251
CL--------------------------------------------------------------------- DIFCTL1C.252
DIFCTL1C.253
DIFCTL1C.254
C CALL COEFF_TH_Q FOR EFFECTIVE DIFFUSION COEFFICIENT FOR THETAL DIFCTL1C.255
C AVERAGING IS DONE AS REQUIRED IN EQUATION(48). DIFCTL1C.256
C COEFFICIENTS ARE SET TO ZERO FOR STEEP SLOPES DIFCTL1C.257
C VALUES ARE IN DIFFUSION_EW AND DIFFUSION_NS DIFCTL1C.258
DIFCTL1C.259
CALL COEFF_TH_Q DIFCTL1C.260
1 (DIFFUSION_EW,DIFFUSION_NS, DIFCTL1C.261
2 PRESSURE,LEVEL_BASE,PRESSURE_TEST,AK,BK, DIFCTL1C.262
3 COS_U_LATITUDE,ROW_LENGTH, DIFCTL1C.263
*CALL ARGFLDPT DIFCTL1C.264
5 LATITUDE_STEP_INVERSE,LONGITUDE_STEP_INVERSE, DIFCTL1C.265
6 P_FIELD,U_FIELD,P_LEVELS, DIFCTL1C.266
7 K1,DELTA_AK,DELTA_BK,PSTAR_UV,COS_FUNCTION_U) DIFCTL1C.267
DIFCTL1C.268
DIFCTL1C.269
CL--------------------------------------------------------------------- DIFCTL1C.270
CL CALL TH_Q_DIF DIFCTL1C.271
CL DIFCTL1C.272
CL--------------------------------------------------------------------- DIFCTL1C.273
CL NEW VERSION INCLUDES PRESSURE TEST ON SLOPES DIFCTL1C.274
DIFCTL1C.275
CALL TH_Q_DIF(THETAL,RECIP_RS_SQUARED_DELTAP, DIFCTL1C.276
& SEC_P_LATITUDE,ROW_LENGTH, DIFCTL1C.277
*CALL ARGFLDPT DIFCTL1C.278
& LEVEL_BASE,P_LEVELS, DIFCTL1C.279
& KEXP_K1,ADVECTION_TIMESTEP, DIFCTL1C.280
& P_FIELD,U_FIELD, DIFCTL1C.281
& DIFFUSION_EW,DIFFUSION_NS) DIFCTL1C.282
DIFCTL1C.283
DIFCTL1C.284
CL DIFCTL1C.285
CL--------------------------------------------------------------------- DIFCTL1C.286
CL SECTION 4. CALCULATE DIFFUSION OF QT AND DIFCTL1C.287
CL ADD ON INCREMENT TO ALL POINTS EXCEPT POLES DIFCTL1C.288
CL WHICH WOULD HAVE BEEN DONE INSIDE TH_Q_DIF. DIFCTL1C.289
CL--------------------------------------------------------------------- DIFCTL1C.290
DIFCTL1C.291
IF(.NOT.L_TRACER_THETAL_QT)THEN DIFCTL1C.292
DIFCTL1C.293
C CALL COEFF_TH_Q FOR EFFECTIVE DIFFUSION COEFFICIENT FOR QT DIFCTL1C.294
C AVERAGING IS DONE AS REQUIRED IN EQUATION(48). DIFCTL1C.295
C COEFFICIENTS ARE SET TO ZERO FOR STEEP SLOPES DIFCTL1C.296
C VALUES ARE IN DIFFUSION_EW AND DIFFUSION_NS DIFCTL1C.297
CALL COEFF_TH_Q DIFCTL1C.298
1 (DIFFUSION_EW,DIFFUSION_NS, DIFCTL1C.299
2 PRESSURE,1,PRESSURE_TEST,AK,BK, DIFCTL1C.300
3 COS_U_LATITUDE,ROW_LENGTH, DIFCTL1C.301
*CALL ARGFLDPT DIFCTL1C.302
5 LATITUDE_STEP_INVERSE,LONGITUDE_STEP_INVERSE, DIFCTL1C.303
6 P_FIELD,U_FIELD,Q_LEVELS, DIFCTL1C.304
7 K2,DELTA_AK,DELTA_BK,PSTAR_UV,COS_FUNCTION_U) DIFCTL1C.305
DIFCTL1C.306
CL--------------------------------------------------------------------- DIFCTL1C.307
CL CALL TH_Q_DIF AT A MOIST LEVEL. DIFCTL1C.308
CL DIFCTL1C.309
CL--------------------------------------------------------------------- DIFCTL1C.310
CL NEW VERSION INCLUDES PRESSURE TEST ON SLOPES DIFCTL1C.311
DIFCTL1C.312
CALL TH_Q_DIF(QT,RECIP_RS_SQUARED_DELTAP, DIFCTL1C.313
& SEC_P_LATITUDE,ROW_LENGTH, DIFCTL1C.314
*CALL ARGFLDPT DIFCTL1C.315
& 1,Q_LEVELS, DIFCTL1C.316
& KEXP_K2,ADVECTION_TIMESTEP, DIFCTL1C.317
& P_FIELD,U_FIELD, DIFCTL1C.318
& DIFFUSION_EW,DIFFUSION_NS) DIFCTL1C.319
C DIFCTL1C.320
CL END IF TEST FOR NO DIFFUSION WITH TRACER ADVECTION DIFCTL1C.321
END IF DIFCTL1C.322
DIFCTL1C.323
CL MAKE 3-D PRESSURE ARRAY AT UV POINTS DIFCTL1C.324
CL LEVEL_P=1 SURFACE, LEVEL_P=K IS LEVEL K-1 DIFCTL1C.325
CL ONLY NEED P_LEVELS AS SURFACES SHOULD BE PRESSURE SURFACES DIFCTL1C.326
CL NEAR TOP OF MODEL SO TESTING UNNECESSARY DIFCTL1C.327
CL FIRST LEVEL DIFCTL1C.328
DO I=FIRST_VALID_PT,LAST_U_VALID_PT DIFCTL1C.329
PRESSURE(I,1)=PSTAR_UV(I) DIFCTL1C.330
END DO DIFCTL1C.331
CL OTHER LEVELS DIFCTL1C.332
DO K=2,P_LEVELS DIFCTL1C.333
DO I=FIRST_VALID_PT,LAST_U_VALID_PT DIFCTL1C.334
PRESSURE(I,K)=AK(K-1)+BK(K-1)*PSTAR_UV(I) DIFCTL1C.335
END DO DIFCTL1C.336
END DO DIFCTL1C.337
DIFCTL1C.338
DIFCTL1C.339
CL DIFCTL1C.340
CL--------------------------------------------------------------------- DIFCTL1C.341
CL SECTION 5. SET DIFFUSION_COEFFICIENTS ON P GRID. DIFCTL1C.342
CL THEN CALCULATE DIFFUSION OF U AND V. DIFCTL1C.343
CL--------------------------------------------------------------------- DIFCTL1C.344
DIFCTL1C.345
C CALL COEFF_UV FOR EFFECTIVE DIFFUSION COEFFICIENT FOR U AND V DIFCTL1C.346
C AVERAGING IS DONE AS REQUIRED IN EQUATION(48). DIFCTL1C.347
C COEFFICIENTS ARE SET TO ZERO FOR STEEP SLOPES DIFCTL1C.348
C VALUES ARE RETURNED IN DIFFUSION_EW AND DIFFUSION_NS DIFCTL1C.349
CALL COEFF_UV DIFCTL1C.350
1 (DIFFUSION_EW,DIFFUSION_NS, DIFCTL1C.351
2 PRESSURE,PRESSURE_TEST,AK,BK, DIFCTL1C.352
3 COS_P_LATITUDE,START_U_UPDATE,END_U_UPDATE, DIFCTL1C.353
& ROW_LENGTH, DIFCTL1C.354
*CALL ARGFLDPT DIFCTL1C.355
4 LATITUDE_STEP_INVERSE, DIFCTL1C.356
5 LONGITUDE_STEP_INVERSE,P_FIELD,U_FIELD,P_LEVELS, DIFCTL1C.357
6 K1,DELTA_AK,DELTA_BK,PSTAR,COS_FUNCTION_P) DIFCTL1C.358
DIFCTL1C.359
DIFCTL1C.360
CL CALL UV_DIF FOR U &V DIFCTL1C.361
DIFCTL1C.362
CALL UV_DIF(U,V,RS_SQUARED_DELTAP, DIFCTL1C.363
* SEC_U_LATITUDE,START_U_UPDATE,END_U_UPDATE, DIFCTL1C.364
& ROW_LENGTH, DIFCTL1C.365
*CALL ARGFLDPT DIFCTL1C.366
& P_LEVELS,KEXP_K1,ADVECTION_TIMESTEP, DIFCTL1C.367
* P_FIELD,U_FIELD, DIFCTL1C.368
* DIFFUSION_EW,DIFFUSION_NS) DIFCTL1C.369
DIFCTL1C.370
CL END OF ROUTINE DIF_CTL DIFCTL1C.371
DIFCTL1C.372
RETURN DIFCTL1C.373
END DIFCTL1C.374
*ENDIF DIFCTL1C.375