*IF DEF,A06_2A GWLINP2A.2
C ******************************COPYRIGHT****************************** GTS2F400.3619
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3620
C GTS2F400.3621
C Use, duplication or disclosure of this code is subject to the GTS2F400.3622
C restrictions as set forth in the contract. GTS2F400.3623
C GTS2F400.3624
C Meteorological Office GTS2F400.3625
C London Road GTS2F400.3626
C BRACKNELL GTS2F400.3627
C Berkshire UK GTS2F400.3628
C RG12 2SZ GTS2F400.3629
C GTS2F400.3630
C If no contract has been raised with this copy of the code, the use, GTS2F400.3631
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3632
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3633
C Modelling at the above address. GTS2F400.3634
C ******************************COPYRIGHT****************************** GTS2F400.3635
C GTS2F400.3636
CLL SUBROUTINE GW_LIN_P----------------------------------------- GWLINP2A.3
CLL GWLINP2A.4
CLL PURPOSE: TO CALCULATE STRESS PROFILE DUE TO SUBGRID-SCALE GWLINP2A.5
CLL OROGRAPHIC GRAVITY WAVES AND HENCE DRAG ON MEAN FLOW. GWLINP2A.6
CLL THE WAVES PROPOGATE VERTICALLY WITH STRESS DECREASING GWLINP2A.7
CLL WITH PRESSURE;IF A CRITICAL LEVEL IS GWLINP2A.8
CLL DIAGNOSED THE STRESS IS SET TO ZERO> GWLINP2A.9
CLL SUITABLE FOR SINGLE COLUMN USE GWLINP2A.10
CLL GWLINP2A.11
CLL SUITABLE FOR ROTATED GRIDS GWLINP2A.12
CLL GWLINP2A.13
CLL ORIGINAL VERSION FOR CRAY Y-MP GWLINP2A.14
CLL WRITTEN BY C. WILSON GWLINP2A.15
CLL FURTHER ALTERATIONS MAY BE REQUIRED FOR AUTOTASKING EFFICIENCY GWLINP2A.16
CLL PROGRAMMING STANDARD: UNIFIED MODEL DOCUMENTATION PAPER NO. 4, GWLINP2A.17
CLL GWLINP2A.18
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: GWLINP2A.19
CLL VERSION DATE GWLINP2A.20
CLL GWLINP2A.21
CLL 3.3 25/10/93 Removal of DIAG06 directive. New arguments to DR251093.134
CLL dimension diagnostic arrays. D. Robinson. DR251093.135
CLL 4.4 19/09/97 Remove *IF -DEF,CRAY compile options. S.Webster ASW1F404.5
CLL DR251093.136
CLL LOGICAL COMPONENTS COVERED: P22 GWLINP2A.22
CLL GWLINP2A.23
CLL SYSTEM TASK: PART OF P22 GWLINP2A.24
CLL GWLINP2A.25
CLL DOCUMENTATION: THE EQUATIONS USED ARE (???) TO (???) GWLINP2A.26
CLL IN UNIFIED MODEL DOCUMENTATION PAPER NO 22 GWLINP2A.27
CLL C. A. WILSON AND R. SWINBANK GWLINP2A.28
CLL VERSION ?,DATED ??/??/91 GWLINP2A.29
CLLEND------------------------------------------------------------- GWLINP2A.30
GWLINP2A.31
C GWLINP2A.32
C*L ARGUMENTS:--------------------------------------------------- GWLINP2A.33
SUBROUTINE GW_LIN_P 1GWLINP2A.34
1 (PSTAR,PEXNER,THETA,U,V,S_STRESS,START_L,LEVELS,POINTS, GWLINP2A.35
2 AKH,BKH,DELTA_AK,DELTA_BK,SIN_A,COS_A, GWLINP2A.36
3 DU_DT,DV_DT, DR251093.137
4 STRESS_UD_LAND,LAND_POINTS_UD,STRESS_UD_ON, DR251093.138
5 STRESS_VD_LAND,LAND_POINTS_VD,STRESS_VD_ON) DR251093.139
GWLINP2A.48
IMPLICIT NONE GWLINP2A.49
GWLINP2A.50
INTEGER GWLINP2A.51
* LEVELS !IN NUMBER OF MODEL LEVELS GWLINP2A.52
*,START_L !IN START LEVEL FOR WAVE-BREAKING TEST GWLINP2A.53
*,POINTS !IN NUMBER OF POINTS GWLINP2A.54
*,LAND_POINTS_UD !IN ) No of land points of diagnostic DR251093.140
*,LAND_POINTS_VD !IN ) arrays for GW stress - u and v DR251093.141
GWLINP2A.56
REAL GWLINP2A.57
* PSTAR(POINTS) !IN PSTAR FIELD GWLINP2A.58
*,PEXNER(POINTS,LEVELS+1) !IN PEXNER GWLINP2A.59
*,THETA(POINTS,LEVELS) !IN THETA FIELD GWLINP2A.60
*,U(POINTS,LEVELS) !IN U FIELD GWLINP2A.61
*,V(POINTS,LEVELS) !IN V FIELD GWLINP2A.62
*,S_STRESS(POINTS) !IN 'SURFACE' STRESS GWLINP2A.63
C AKH,BKH DEFINE HYBRID VERTICAL COORDINATES P=A+BP*-LAYER EDGES, GWLINP2A.64
C DELTA_AK,DELTA_BK DEFINE PRESSURE DIFFERENCES ACROSS LAYERS GWLINP2A.65
REAL GWLINP2A.66
* AKH(LEVELS+1) !IN VALUE AT LAYER BOUNDARY GWLINP2A.67
*,BKH(LEVELS+1) !IN VALUE AT LAYER BOUMDARY GWLINP2A.68
*,DELTA_AK (LEVELS) !IN DIFFERENCE ACROSS LAYER GWLINP2A.69
*,DELTA_BK (LEVELS) !IN DIFFERENCE ACROSS LAYER GWLINP2A.70
*,SIN_A(POINTS) !IN SIN (STRESS DIRECTION FROM NORTH) GWLINP2A.71
*,COS_A(POINTS) !IN COS (STRESS DIRECTION FROM NORTH) GWLINP2A.72
*,DU_DT(POINTS,LEVELS) !OUT U-ACCELERATION GWLINP2A.73
*,DV_DT(POINTS,LEVELS) !OUT V-ACCELERATION GWLINP2A.74
GWLINP2A.75
REAL DR251093.142
* STRESS_UD_LAND(LAND_POINTS_UD,LEVELS+1) !U STRESS DIAGNOSTIC DR251093.143
*,STRESS_VD_LAND(LAND_POINTS_VD,LEVELS+1) !V STRESS DIAGNOSTIC DR251093.144
GWLINP2A.77
LOGICAL DR251093.145
* STRESS_UD_ON ! ) Diagnostic switches for GW stress - DR251093.146
*,STRESS_VD_ON ! ) u and v (Item Nos 201 and 202) DR251093.147
GWLINP2A.83
C*--------------------------------------------------------------------- GWLINP2A.84
GWLINP2A.85
C*L WORKSPACE USAGE:------------------------------------------------- GWLINP2A.86
C DEFINE LOCAL WORKSPACE ARRAYS: GWLINP2A.87
C 9 REAL ARRAYS OF FULL FIELD LENGTH REQUIRED GWLINP2A.88
C GWLINP2A.89
GWLINP2A.95
REAL GWLINP2A.96
* DZ(POINTS,3) ! HEIGHT DIFFERENCES IN EACH HALF LAYER GWLINP2A.97
*,SPEED(POINTS,2) ! WIND SPEEDS (LEVELS) GWLINP2A.98
*,STRESS(POINTS,2) ! STRESSES (LAYER BOUNDARIES) GWLINP2A.99
*,D_STRESS_DP(POINTS) ! STRESS GRADIENT GWLINP2A.100
*,DRAG(POINTS) ! DRAG EXERTED ON LAYER(IN DIRECTION OF GWLINP2A.101
* ! SURFACE STRESS GWLINP2A.102
GWLINP2A.104
C*--------------------------------------------------------------------- GWLINP2A.105
C GWLINP2A.106
C*L EXTERNAL SUBROUTINES CALLED--------------------------------------- GWLINP2A.107
C NONE GWLINP2A.108
C*------------------------------------------------------------------ GWLINP2A.109
CL MAXIMUM VECTOR LENGTH ASSUMED = POINTS GWLINP2A.110
CL--------------------------------------------------------------------- GWLINP2A.111
C---------------------------------------------------------------------- GWLINP2A.112
C GWLINP2A.113
C DEFINE LOCAL VARIABLES GWLINP2A.114
C LOCAL VARIABLES: GWLINP2A.115
C GWLINP2A.116
REAL GWLINP2A.117
* SPEEDB ! WIND SPEEDS AT LAYER BOUNDARY GWLINP2A.118
*,DZB ! HEIGHT DIFFERENCE ACROSS LAYER BOUNDARY GWLINP2A.119
*,DELTA_P ! DIFFERENCE IN PRESSURE ACROSS LAYER GWLINP2A.120
REAL GWLINP2A.121
* DELTA_AK_SUM ! DELTA_AK SUMMED OVER LOWEST LAYERS UP TO START_L GWLINP2A.122
*,DELTA_BK_SUM ! DELTA_BK SUMMED OVER LOWEST LAYERS UP TO START_L GWLINP2A.123
INTEGER I,K ! LOOP COUNTER IN ROUTINE GWLINP2A.124
INTEGER KK,KL,KU,KT ! LEVEL COUNTERS IN ROUTINE GWLINP2A.125
C GWLINP2A.126
C INCLUDE PHYSICAL CONSTANTS GWLINP2A.127
*CALL C_G 
GWLINP2A.128
*CALL C_R_CP GWLINP2A.129
GWLINP2A.130
C LOCAL CONSTANTS GWLINP2A.131
*CALL C_GWAVE GWLINP2A.132
GWLINP2A.133
REAL CPBYG GWLINP2A.134
PARAMETER(CPBYG=CP/G) GWLINP2A.135
GWLINP2A.136
REAL GWLINP2A.137
& PU,PL,P_EXNER_CENTRE GWLINP2A.138
*CALL P_EXNERC GWLINP2A.139
GWLINP2A.140
C------------------------------------------------------------------- GWLINP2A.141
CL INTERNAL STRUCTURE INCLUDING SUBROUTINE CALLS: GWLINP2A.142
CL 1. START LEVEL PRELIMINARIES GWLINP2A.143
C------------------------------------------ GWLINP2A.144
GWLINP2A.145
CFPP$ NOCONCUR L GWLINP2A.146
C TREAT LAYERS BELOW AND INCLUDING START_L AS ONE LAYER GWLINP2A.147
DELTA_AK_SUM = 0.0 GWLINP2A.148
DELTA_BK_SUM = 0.0 GWLINP2A.149
DO K=1,START_L GWLINP2A.150
DELTA_AK_SUM = DELTA_AK_SUM + DELTA_AK(K) GWLINP2A.151
DELTA_BK_SUM = DELTA_BK_SUM + DELTA_BK(K) GWLINP2A.152
END DO GWLINP2A.153
CFPP$ CONCUR GWLINP2A.154
GWLINP2A.155
KL=1 GWLINP2A.156
KU=2 GWLINP2A.157
KT=3 GWLINP2A.158
GWLINP2A.159
DO I=1,POINTS GWLINP2A.160
GWLINP2A.161
SPEED(I,KL) = U(I,START_L)*SIN_A(I) + V(I,START_L)*COS_A(I) GWLINP2A.162
STRESS(I,KL) = S_STRESS(I) GWLINP2A.163
D_STRESS_DP(I) = S_STRESS(I)/ PSTAR(I) GWLINP2A.164
GWLINP2A.165
PU=PSTAR(I)*BKH(START_L+1) + AKH(START_L+1) GWLINP2A.166
PL=PSTAR(I)*BKH(START_L) + AKH(START_L) GWLINP2A.167
P_EXNER_CENTRE= GWLINP2A.168
& P_EXNER_C( PEXNER(I,START_L+1),PEXNER(I,START_L),PU,PL,KAPPA) GWLINP2A.169
GWLINP2A.170
DZ(I,KL) = (P_EXNER_CENTRE - PEXNER(I,START_L+1)) GWLINP2A.171
* *THETA(I,START_L)*CPBYG GWLINP2A.172
GWLINP2A.179
END DO GWLINP2A.180
DR251093.148
IF (STRESS_UD_ON) THEN DR251093.149
DO I=1,POINTS DR251093.150
STRESS_UD_LAND(I,START_L) = STRESS(I,KL)*SIN_A(I) DR251093.151
END DO DR251093.152
ENDIF DR251093.153
IF (STRESS_VD_ON) THEN DR251093.154
DO I=1,POINTS DR251093.155
STRESS_VD_LAND(I,START_L) = STRESS(I,KL)*COS_A(I) DR251093.156
END DO DR251093.157
ENDIF DR251093.158
GWLINP2A.181
C------------------------------------------------------------------ GWLINP2A.182
CL 2 LOOP LEVELS GWLINP2A.183
C------------------------------------------------------------------ GWLINP2A.184
GWLINP2A.185
DO K=START_L+1,LEVELS GWLINP2A.186
GWLINP2A.187
DO I=1,POINTS GWLINP2A.189
DELTA_P = DELTA_AK(K-1)+DELTA_BK(K-1)*PSTAR(I) GWLINP2A.190
STRESS(I,KU) = STRESS(I,KL) GWLINP2A.191
IF(STRESS(I,KL) .GT. 0.0) THEN GWLINP2A.192
SPEED(I,KU) = U(I,K)*SIN_A(I) + V(I,K)*COS_A(I) GWLINP2A.193
GWLINP2A.194
PU=PSTAR(I)*BKH(K+1) + AKH(K+1) GWLINP2A.195
PL=PSTAR(I)*BKH(K) + AKH(K) GWLINP2A.196
P_EXNER_CENTRE= GWLINP2A.197
& P_EXNER_C( PEXNER(I,K+1),PEXNER(I,K),PU,PL,KAPPA) GWLINP2A.198
GWLINP2A.199
C lower half height of upper layer GWLINP2A.200
DZ(I,KU) = (PEXNER(I,K) - P_EXNER_CENTRE)*THETA(I,K) GWLINP2A.201
* *CPBYG GWLINP2A.202
C upper half height of upper layer GWLINP2A.203
DZ(I,KT) = (P_EXNER_CENTRE - PEXNER(I,K+1))*THETA(I,K) GWLINP2A.204
* *CPBYG GWLINP2A.205
C model level height difference GWLINP2A.206
DZB = DZ(I,KU) + DZ(I,KL) GWLINP2A.207
SPEEDB = (DZ(I,KU)*SPEED(I,KL)+DZ(I,KL)*SPEED(I,KU))/ GWLINP2A.208
* DZB GWLINP2A.209
GWLINP2A.210
C------------------------------------------------------------------ GWLINP2A.211
CL 2.1 TEST FOR CRITICAL LEVEL V < or = 0 GWLINP2A.212
C------------------------------------------------------------------ GWLINP2A.213
GWLINP2A.214
IF( SPEEDB .LE. 0.0) THEN GWLINP2A.215
STRESS(I,KU) = 0.0 GWLINP2A.216
ELSE GWLINP2A.217
GWLINP2A.218
C------------------------------------------------------------------ GWLINP2A.219
CL 2.2 CALCULATE STRESS AT UPPER BOUNDARY ASSUMING GWLINP2A.220
CL UNIFORM PROFILE (WITH PRESSURE) GWLINP2A.221
CL N.B. DELTA_P IS -VE GWLINP2A.222
C------------------------------------------------------------------ GWLINP2A.223
GWLINP2A.224
STRESS(I,KU) = STRESS(I,KL)+D_STRESS_DP(I)*DELTA_P GWLINP2A.225
GWLINP2A.226
END IF ! SPEED < 0 ELSE SPEED >0 GWLINP2A.227
GWLINP2A.228
END IF ! STRESS >0 GWLINP2A.229
GWLINP2A.230
IF( K .EQ. START_L+1 ) THEN GWLINP2A.231
DELTA_P = DELTA_AK_SUM+DELTA_BK_SUM*PSTAR(I) GWLINP2A.232
END IF GWLINP2A.233
GWLINP2A.234
C------------------------------------------------------------------ GWLINP2A.235
CL 2.4 CALCULATE DRAG FROM VERTICAL STRESS CONVERGENCE GWLINP2A.236
CL AND ACCELERATIONS FOR WIND COMPONENTS GWLINP2A.237
CL EQN 2.1 GWLINP2A.238
C------------------------------------------------------------------ GWLINP2A.239
GWLINP2A.240
DRAG(I) = G*(STRESS(I,KU) - STRESS(I,KL) )/DELTA_P GWLINP2A.241
DU_DT(I,K-1) = -DRAG(I)*SIN_A(I) GWLINP2A.242
DV_DT(I,K-1) = -DRAG(I)*COS_A(I) GWLINP2A.243
GWLINP2A.244
END DO GWLINP2A.251
GWLINP2A.252
IF (STRESS_UD_ON) THEN DR251093.159
DO I=1,POINTS DR251093.160
STRESS_UD_LAND(I,K) = STRESS(I,KU)*SIN_A(I) DR251093.161
END DO DR251093.162
ENDIF DR251093.163
IF (STRESS_VD_ON) THEN DR251093.164
DO I=1,POINTS DR251093.165
STRESS_VD_LAND(I,K) = STRESS(I,KU)*COS_A(I) DR251093.166
END DO DR251093.167
ENDIF DR251093.168
GWLINP2A.253
IF( K .EQ. START_L+1 .AND. START_L .GT.1 ) THEN GWLINP2A.254
C SET ACCELERATION SAME IN ALL LAYERS UP TO START_L GWLINP2A.255
DO KK=1,START_L-1 GWLINP2A.256
DO I=1,POINTS GWLINP2A.257
DU_DT(I,KK) = DU_DT(I,START_L) GWLINP2A.258
DV_DT(I,KK) = DV_DT(I,START_L) GWLINP2A.259
END DO GWLINP2A.260
END DO GWLINP2A.261
END IF GWLINP2A.262
GWLINP2A.263
C Swap storage for lower and upper layers GWLINP2A.264
KK=KL GWLINP2A.265
KL=KU GWLINP2A.266
KU=KK GWLINP2A.267
GWLINP2A.268
C Replace top half height of lower layer ready for next pass GWLINP2A.269
DO I=1,POINTS GWLINP2A.270
DZ(I,KL)=DZ(I,KT) GWLINP2A.271
ENDDO GWLINP2A.272
GWLINP2A.273
END DO GWLINP2A.274
CL END LOOP LEVELS GWLINP2A.275
GWLINP2A.276
C------------------------------------------------------------------ GWLINP2A.277
CL 3 TOP OF MODEL. SET ACCELERATION SAME AS PENULTIMATE LAYER GWLINP2A.278
CL WITH PROVISO THAT STRESS >= 0 GWLINP2A.279
C------------------------------------------------------------------ GWLINP2A.280
GWLINP2A.281
DO I=1,POINTS GWLINP2A.282
DELTA_P = DELTA_AK(LEVELS) + DELTA_BK(LEVELS)*PSTAR(I) GWLINP2A.283
STRESS(I,KU) = STRESS(I,KL) + DRAG(I)*DELTA_P/G GWLINP2A.284
IF( STRESS(I,KU) .LT. 0.0) STRESS(I,KU) = 0.0 GWLINP2A.285
DRAG(I) = G*(STRESS(I,KU) - STRESS(I,KL) )/DELTA_P GWLINP2A.286
DU_DT(I,LEVELS) = -DRAG(I)*SIN_A(I) GWLINP2A.287
DV_DT(I,LEVELS) = -DRAG(I)*COS_A(I) GWLINP2A.288
END DO DR251093.169
GWLINP2A.289
IF (STRESS_UD_ON) THEN DR251093.170
DO I=1,POINTS DR251093.171
STRESS_UD_LAND(I,LEVELS+1) = STRESS(I,KU)*SIN_A(I) DR251093.172
ENDDO DR251093.173
ENDIF DR251093.174
IF (STRESS_VD_ON) THEN DR251093.175
DO I=1,POINTS DR251093.176
STRESS_VD_LAND(I,LEVELS+1) = STRESS(I,KU)*COS_A(I) DR251093.177
ENDDO DR251093.178
ENDIF DR251093.179
GWLINP2A.297
RETURN GWLINP2A.298
END GWLINP2A.299
GWLINP2A.300
*ENDIF GWLINP2A.301