SUBROUTINE GW_VERT 1,8GWVERT3B.23
1 (PSTAR,PEXNER,THETA,Q,U,V,S_X_STRESS,S_Y_STRESS,START_L,LEVELS GWVERT3B.24
2 ,Q_LEVELS,POINTS,AKH,BKH,DELTA_AK,DELTA_BK,KAY,KAY_LEE,SD_OROG GWVERT3B.25
3 ,S_X_OROG,S_Y_OROG,SIGMA_XX,SIGMA_XY,SIGMA_YY,TEST,DU_DT,DV_DT GWVERT3B.26
4 ,K_LIFT,U_S,V_S,RHO_S GWVERT3B.27
! Diagnostics GWVERT3B.28
5 ,STRESS_UD,POINTS_STRESS_UD,STRESS_UD_ON GWVERT3B.29
6 ,STRESS_VD,POINTS_STRESS_VD,STRESS_VD_ON GWVERT3B.30
7 ,DU_DT_SATN,POINTS_DU_DT_SATN,DU_DT_SATN_ON GWVERT3B.31
8 ,DV_DT_SATN,POINTS_DV_DT_SATN,DV_DT_SATN_ON GWVERT3B.32
9 ,DU_DT_JUMP,POINTS_DU_DT_JUMP,DU_DT_JUMP_ON GWVERT3B.33
& ,DV_DT_JUMP,POINTS_DV_DT_JUMP,DV_DT_JUMP_ON GWVERT3B.34
& ,DU_DT_LEE ,POINTS_DU_DT_LEE ,DU_DT_LEE_ON GWVERT3B.35
& ,DV_DT_LEE ,POINTS_DV_DT_LEE ,DV_DT_LEE_ON GWVERT3B.36
& ,TRANS_D ,POINTS_TRANS_D ,TRANS_D_ON ) GWVERT3B.37
GWVERT3B.38
IMPLICIT NONE GWVERT3B.39
! Description: TO CALCULATE VERTICAL STRESS PROFILE DUE TO SUBGRID-SCALE GWVERT3B.40
! ANISOTOPIC GRAVITY WAVES AND HENCE DRAG ON MEAN FLOW. GWVERT3B.41
! HYDRAULIC JUMP IS DIAGNOSED WITH TEST CONTAINING ALPHA. GWVERT3B.42
! THE HEIGHT OF THE UPSTREAM DIVIDING STREAMLINE IS GWVERT3B.43
! CALCULATED FOR JUMP POINTS, AND STRESS LINEARISED TO A GWVERT3B.44
! THIRD OF SURFACE STRESS AT THIS HEIGHT. THE REMAINING GWVERT3B.45
! WAVES AND NON_JUMP POINTS PROPOGATE VERTICALLY WITH GWVERT3B.46
! STRESS INDEPENDENT OF HEIGHT UNLESS A CRITICAL LEVEL OR GWVERT3B.47
! WAVE BREAKING IS DIAGNOSED. THE CRITICAL STRESS IS CALCULATED GWVERT3B.48
! BY A LAYER SATURATION HYPOTHESIS USING WIND COMPONENT PARALLEL GWVERT3B.49
! TO THE ORIGINAL SURFACE STRESS INSTEAD OF SURFACE WIND. GWVERT3B.50
! GWVERT3B.51
! Method: UNIFIED MODEL DOCUMENTATION PAPER NO. ? GWVERT3B.52
! THE EQUATIONS USED ARE (4),(5),(7),(8),(9) GWVERT3B.53
! GWVERT3B.54
! Current code owner: S.Webster GWVERT3B.55
! GWVERT3B.56
! History: GWVERT3B.57
! Version Date Comment GWVERT3B.58
! 4.5 03/06/98 Original Code. Copy of 4.4 GWVERT3A with GWVERT3B.59
! operational changes. GWVERT3B.60
! Equal acceleration in bottom 3 layers. Correction GWVERT3B.61
! to hydaulic jump height. D. Robinson. GWVERT3B.62
! GWVERT3B.63
! Code Description: GWVERT3B.64
! Language: Fortran 77 + common extensions GWVERT3B.65
! This code is written to UMDP3 v6 programming standards. GWVERT3B.66
! System component covered: ORIGINAL VERSION FOR CRAY Y-MP GWVERT3B.67
! System task covered: PART OF P22 GWVERT3B.68
! SUITABLE FOR SINGLE COLUMN USE,ROTATED GRIDS GWVERT3B.69
! FURTHER ALTERATIONS MAY BE REQUIRED FOR AUTOTASKING EFFICIENCY GWVERT3B.70
GWVERT3B.71
! Global Variables GWVERT3B.72
*CALL C_G 
GWVERT3B.73
*CALL C_R_CP GWVERT3B.74
! Local constants GWVERT3B.75
*CALL C_GWAVE GWVERT3B.76
GWVERT3B.77
! Subroutine arguements: GWVERT3B.78
GWVERT3B.79
INTEGER GWVERT3B.80
* LEVELS !IN NUMBER OF MODEL LEVELS GWVERT3B.81
*,Q_LEVELS !IN NUMBER OF WET LEVELS GWVERT3B.82
*,START_L !IN START LEVEL FOR WAVE-BREAKING TEST GWVERT3B.83
*,POINTS !IN NUMBER OF POINTS GWVERT3B.84
*,K_LIFT(POINTS) !IN MODEL LEVEL AT TOP OF BLOCKED LAYER GWVERT3B.85
*,POINTS_STRESS_UD !IN ) No of land points in diagnostic GWVERT3B.86
*,POINTS_STRESS_VD !IN ) arrays for GW stress - u and v GWVERT3B.87
*,POINTS_DU_DT_SATN !IN ) No of land points in diagnostic GWVERT3B.88
*,POINTS_DV_DT_SATN !IN ) arrays for GW satn - du and dv GWVERT3B.89
*,POINTS_DU_DT_JUMP !IN ) No of land points in diagnostic GWVERT3B.90
*,POINTS_DV_DT_JUMP !IN ) arrays for GW satn - du and dv GWVERT3B.91
*,POINTS_DU_DT_LEE !IN ) No of land points in diagnostic GWVERT3B.92
*,POINTS_DV_DT_LEE !IN ) arrays for GW lee - du and dv GWVERT3B.93
*,POINTS_TRANS_D !IN ) No of land points for trans diag GWVERT3B.94
GWVERT3B.95
REAL GWVERT3B.96
* PSTAR(POINTS) !IN PSTAR FIELD GWVERT3B.97
*,PEXNER(POINTS,LEVELS+1) !IN PEXNER GWVERT3B.98
*,THETA(POINTS,LEVELS) !IN THETA FIELD GWVERT3B.99
*,Q(POINTS,Q_LEVELS) !IN SATURATION FIELD GWVERT3B.100
*,U(POINTS,LEVELS) !IN U FIELD GWVERT3B.101
*,V(POINTS,LEVELS) !IN V FIELD GWVERT3B.102
*,U_S(POINTS) !IN 'SURFACE' U FIELD GWVERT3B.103
*,V_S(POINTS) !IN 'SURFACE' V FIELD GWVERT3B.104
*,RHO_S(POINTS) !IN 'SURFACE' DENSITY GWVERT3B.105
*,S_X_STRESS(POINTS) !IN 'SURFACE' X_STRESS GWVERT3B.106
*,S_Y_STRESS(POINTS) !IN 'SURFACE' Y_STRESS GWVERT3B.107
*,S_X_OROG(POINTS) !IN 'SURFACE' X_STRESS GWVERT3B.108
*,S_Y_OROG(POINTS) !IN 'SURFACE' Y_STRESS GWVERT3B.109
*,SIGMA_XX(POINTS) !IN DH/DX SQUARED GRADIENT OROGRAPHY GWVERT3B.110
*,SIGMA_XY(POINTS) !IN (DH/DX)(DH/DY) GRADIENT OROGRAPHY GWVERT3B.111
*,SIGMA_YY(POINTS) !IN DH/DY SQUARED GRADIENT OROGRAPHY GWVERT3B.112
*,TEST(POINTS) !IN TEST HYDROLOIC JUMP (SIMILAR TO FROUDE) GWVERT3B.113
*,SD_OROG(POINTS) !IN STANDARD DEVIATION OF OROGRAPHY GWVERT3B.114
! AKH,BKH DEFINE HYBRID VERTICAL COORDINATES P=A+BP*-LAYER EDGES, GWVERT3B.115
! DELTA_AK,DELTA_BK DEFINE PRESSURE DIFFERENCES ACROSS LAYERS GWVERT3B.116
*,AKH(LEVELS+1) !IN VALUE AT LAYER BOUNDARY GWVERT3B.117
*,BKH(LEVELS+1) !IN VALUE AT LAYER BOUMDARY GWVERT3B.118
*,DELTA_AK (LEVELS) !IN DIFFERENCE ACROSS LAYER GWVERT3B.119
*,DELTA_BK (LEVELS) !IN DIFFERENCE ACROSS LAYER GWVERT3B.120
*,KAY !IN stress constant (m-1) GWVERT3B.121
*,KAY_LEE !IN TRAPPED LEE WAVE CONSTANT GWVERT3B.122
*,DU_DT(POINTS,LEVELS) !OUT U-ACCELERATION GWVERT3B.123
*,DV_DT(POINTS,LEVELS) !OUT V-ACCELERATION GWVERT3B.124
GWVERT3B.125
! Diagnostics GWVERT3B.126
REAL GWVERT3B.127
* STRESS_UD(POINTS_STRESS_UD,LEVELS+1) !U STRESS DIAG GWVERT3B.128
*,STRESS_VD(POINTS_STRESS_VD,LEVELS+1) !V STRESS DIAG GWVERT3B.129
*,DU_DT_SATN(POINTS_DU_DT_SATN,LEVELS) !U ACCELN DIAG (SATURATION) GWVERT3B.130
*,DV_DT_SATN(POINTS_DV_DT_SATN,LEVELS) !V ACCELN DIAG (SATURATION) GWVERT3B.131
*,DU_DT_JUMP(POINTS_DU_DT_JUMP,LEVELS) !U ACCELN DIAG (HYDR JUMP) GWVERT3B.132
*,DV_DT_JUMP(POINTS_DV_DT_JUMP,LEVELS) !V ACCELN DIAG (HYDR JUMP) GWVERT3B.133
*,DU_DT_LEE(POINTS_DU_DT_LEE,LEVELS) !U ACCELN DIAG (LEE WAVE) GWVERT3B.134
*,DV_DT_LEE(POINTS_DV_DT_LEE,LEVELS) !V ACCELN DIAG (LEE WAVE) GWVERT3B.135
*,TRANS_D(POINTS_TRANS_D) ! TRANSMITTION COEFFICIENT DIAGNOSTIC GWVERT3B.136
GWVERT3B.137
LOGICAL GWVERT3B.138
* STRESS_UD_ON !U stress diagnostic switch GWVERT3B.139
*,STRESS_VD_ON !V stress diagnostic switch GWVERT3B.140
*,DU_DT_SATN_ON !U accel (saturation) diagnostic switch GWVERT3B.141
*,DV_DT_SATN_ON !V accel (saturation) diagnostic switch GWVERT3B.142
*,DU_DT_JUMP_ON !U accel (hydr jump) diagnostic switch GWVERT3B.143
*,DV_DT_JUMP_ON !V accel (hydr jump) diagnostic switch GWVERT3B.144
*,DU_DT_LEE_ON !U accel (lee wave) diagnostic switch GWVERT3B.145
*,DV_DT_LEE_ON !V accel (lee wave) diagnostic switch GWVERT3B.146
*,TRANS_D_ON !Transmittion coefficient diag switch GWVERT3B.147
GWVERT3B.148
! Local parameters GWVERT3B.149
REAL CPBYG GWVERT3B.150
PARAMETER(CPBYG=CP/G) GWVERT3B.151
! Local scalers GWVERT3B.152
REAL GWVERT3B.153
* UCPTSPD ! |U|COS(.) COMPONENT SPEEED DIRN STRESS GWVERT3B.154
*,S_STRESS_SQ ! SURFACE STRESS SQUARE MAGNITUDE GWVERT3B.155
*,S_STRESS ! SURFACE STRESS MAGNITUDE GWVERT3B.156
*,ALPHA1 ! ALLOWS SWAP OF ALPHA AND BETA GWVERT3B.157
*,BETA1 ! " GWVERT3B.158
*,SPEED ! WIND SPEED IN DIR OF STRESS AT LEVEL GWVERT3B.159
*,N_SQAV ! AVERAGE OF BRUNT VAISALLA FREQ SQ GWVERT3B.160
*,NOVERU ! NBYU FOR ONE LAYER GWVERT3B.161
*,DEL_EXNER ! EXNER DIFFERENCE ACROSS LAYER GWVERT3B.162
*,TEST_CALC ! CALCULATION FOR JUMP HEIGHT TEST GWVERT3B.163
*,PU,PL,PB ! PRESSURES GWVERT3B.164
GWVERT3B.165
LOGICAL FLAG GWVERT3B.166
GWVERT3B.167
INTEGER I,K ! LOOP COUNTER IN ROUTINE GWVERT3B.168
INTEGER KK,KL,KU ! LEVEL COUNTERS IN ROUTINE GWVERT3B.169
INTEGER K_TROP ! LIMIT OF LEVELS FOR H_JUMP GWVERT3B.170
GWVERT3B.171
! Local dynamic arrays GWVERT3B.172
! LOCAL WORKSPACE ARRAYS: 21 ARRAYS OF FULL FIELD LENGTH GWVERT3B.173
! GWVERT3B.174
LOGICAL GWVERT3B.175
* H_JUMP(POINTS) ! TRUE IF HYDROLIC JUMP REGIME GWVERT3B.176
*,H_CRIT(POINTS) ! TRUE IF CRITICAL LEVEL WITHIN JUMP GWVERT3B.177
*,L_CONT(POINTS) ! LEVEL CONTINUE GWVERT3B.178
*,L_LEE(POINTS) ! TRUE IF TRAPPED LEE WAVE DIAGNOSED GWVERT3B.179
GWVERT3B.180
INTEGER GWVERT3B.181
* H_O_LEV(POINTS) ! MODEL LEVEL HEIGHT OF H_JUMP/H_CRIT GWVERT3B.182
*,K_LEE(POINTS,2) ! MODEL LEVEL OF TRAPPED LEE WAVE GWVERT3B.183
* ! 'HEIGHT' AND TOP OF WAVE GWVERT3B.184
GWVERT3B.185
REAL GWVERT3B.186
* NBYU_P(POINTS) ! U/N FOR CALCULATION OF H_O; AVERAGED GWVERT3B.187
*,UNIT_X(POINTS) ! X_COMPNT OF UNIT STRESS VECTOR GWVERT3B.188
*,UNIT_Y(POINTS) ! Y_COMPNT OF UNIT STRESS VECTOR GWVERT3B.189
*,H_O(POINTS) ! GEOPOTENTIAL HEIGHT ABOVE SURFACE OF GWVERT3B.190
* ! HYDROLIC JUMP GWVERT3B.191
*,P_EXNER_CENTRE(POINTS,2) ! EXNER PRESSURE AT LAYER CENTRES GWVERT3B.192
*,N_SQ(POINTS,2) ! SQUARE OF BRUNT_VAISALA FREQUENCY GWVERT3B.193
*,ZH(POINTS) ! TOTAL HEIGHT OF JUMP CALCUALTION GWVERT3B.194
*,P0(POINTS) ! PSTAR OR PRESS AT TOP OF K_LIFT GWVERT3B.195
*,TRANS(POINTS) ! COEFFICIENT FOR TRANSMITTION OF GWVERT3B.196
* ! SURFACE STRESS GWVERT3B.197
*,H_LEE(POINTS) ! TRAPPED LEE WAVE 'HEIGHT' (SEE DOC) GWVERT3B.198
*,LSQ_LEE(POINTS,2) ! SCORER PARAMETER AVERAGED BELOW GWVERT3B.199
* ! AND ABOVE TRAPPED LEE WAVE HEIGHT GWVERT3B.200
GWVERT3B.201
! Function and subroutine calls: GWVERT3B.202
EXTERNAL GW_SCOR,GW_SATN,GW_JUMP,GW_LEE GWVERT3B.203
*CALL P_EXNERC GWVERT3B.204
GWVERT3B.205
!------------------------------------------------------------------- GWVERT3B.206
! 1.0 START PRELIMINARIES GWVERT3B.207
! Initialise increment and increment diagnostics GWVERT3B.208
!------------------------------------------------------------ GWVERT3B.209
DO K=1,LEVELS GWVERT3B.210
GWVERT3B.211
DO I=1,POINTS GWVERT3B.212
DU_DT(I,K)=0.0 GWVERT3B.213
DV_DT(I,K)=0.0 GWVERT3B.214
END DO GWVERT3B.215
GWVERT3B.216
IF( DU_DT_SATN_ON ) THEN GWVERT3B.217
DO I=1,POINTS GWVERT3B.218
DU_DT_SATN(I,K)=0.0 GWVERT3B.219
END DO GWVERT3B.220
ENDIF GWVERT3B.221
GWVERT3B.222
IF( DV_DT_SATN_ON ) THEN GWVERT3B.223
DO I=1,POINTS GWVERT3B.224
DV_DT_SATN(I,K)=0.0 GWVERT3B.225
END DO GWVERT3B.226
ENDIF GWVERT3B.227
GWVERT3B.228
IF( DU_DT_JUMP_ON ) THEN GWVERT3B.229
DO I=1,POINTS GWVERT3B.230
DU_DT_JUMP(I,K)=0.0 GWVERT3B.231
END DO GWVERT3B.232
ENDIF GWVERT3B.233
GWVERT3B.234
IF( DV_DT_JUMP_ON ) THEN GWVERT3B.235
DO I=1,POINTS GWVERT3B.236
DV_DT_JUMP(I,K)=0.0 GWVERT3B.237
END DO GWVERT3B.238
ENDIF GWVERT3B.239
GWVERT3B.240
IF( DU_DT_LEE_ON ) THEN GWVERT3B.241
DO I=1,POINTS GWVERT3B.242
DU_DT_LEE(I,K)=0.0 GWVERT3B.243
END DO GWVERT3B.244
ENDIF GWVERT3B.245
GWVERT3B.246
IF( DV_DT_LEE_ON ) THEN GWVERT3B.247
DO I=1,POINTS GWVERT3B.248
DV_DT_LEE(I,K)=0.0 GWVERT3B.249
END DO GWVERT3B.250
ENDIF GWVERT3B.251
GWVERT3B.252
ENDDO ! Levels GWVERT3B.253
!----------------------------------------------------------------- GWVERT3B.254
! Code assumes ALPHA < BETA . Swap is possible because of GWVERT3B.255
! symmetry of calculation( SEE EQN(55), DOC ) GWVERT3B.256
!---------------------------------------------------------------- GWVERT3B.257
IF( ALPHA.GT.BETA ) THEN GWVERT3B.258
ALPHA1 = BETA GWVERT3B.259
BETA1 = ALPHA GWVERT3B.260
ELSE GWVERT3B.261
ALPHA1 = ALPHA GWVERT3B.262
BETA1 = BETA GWVERT3B.263
ENDIF GWVERT3B.264
GWVERT3B.265
IF( START_L.LE.2 ) THEN GWVERT3B.266
WRITE(6,*) 'ERROR G_WAVE: ** START_L MUST BE GREATER THAN 2 ** ' GWVERT3B.267
START_L=3 GWVERT3B.268
ENDIF GWVERT3B.269
GWVERT3B.270
KL=1 GWVERT3B.271
KU=2 GWVERT3B.272
GWVERT3B.273
DO I=1,POINTS GWVERT3B.274
GWVERT3B.275
!------------------------------------------------------------------ GWVERT3B.276
! Calculate logical array for hydraulic jump regime. GWVERT3B.277
!------------------------------------------------------------------ GWVERT3B.278
IF( TEST(I).GE.ALPHA1 ) THEN GWVERT3B.279
H_JUMP(I)=.TRUE. GWVERT3B.280
ELSE GWVERT3B.281
H_JUMP(I)=.FALSE. GWVERT3B.282
ENDIF GWVERT3B.283
!------------------------------------------------------------------- GWVERT3B.284
! Initialisation. UNIT_X is x_compnt of unit surface stress vector GWVERT3B.285
!------------------------------------------------------------------- GWVERT3B.286
L_CONT(I) = .TRUE. GWVERT3B.287
NBYU_P(I) = 0.0 GWVERT3B.288
S_STRESS_SQ = S_X_STRESS(I)**2 + S_Y_STRESS(I)**2 GWVERT3B.289
IF ( S_STRESS_SQ .LE. 0.0 ) THEN GWVERT3B.290
UNIT_X(I) = 0.0 GWVERT3B.291
UNIT_Y(I) = 0.0 GWVERT3B.292
ELSE GWVERT3B.293
S_STRESS = SQRT( S_STRESS_SQ ) GWVERT3B.294
UNIT_X(I) = S_X_STRESS(I) / S_STRESS GWVERT3B.295
UNIT_Y(I) = S_Y_STRESS(I) / S_STRESS GWVERT3B.296
ENDIF GWVERT3B.297
GWVERT3B.298
ENDDO ! Points GWVERT3B.299
GWVERT3B.300
!-------------------------------------------------------------------- GWVERT3B.301
! 2.0 Assess the vertical structure by calculating Scorer parameter GWVERT3B.302
! for each level. Determine transmittion factor allowing GWVERT3B.303
! reduction of surface stress from reflection of wave energy GWVERT3B.304
! off contrast in averaged Scoror profile. Determine trapped GWVERT3B.305
! lee wave height ( if exists ) and associated paramters GWVERT3B.306
!---------------------------------------------------------------- GWVERT3B.307
CALL GW_SCOR GWVERT3B.308
1 (PSTAR,PEXNER,THETA,U,V,LEVELS,START_L,H_JUMP,POINTS,AKH,BKH GWVERT3B.309
2 ,UNIT_X,UNIT_Y,TRANS,K_LEE,H_LEE,LSQ_LEE,L_LEE) GWVERT3B.310
GWVERT3B.311
DO I=1,POINTS GWVERT3B.312
S_X_STRESS(I)=S_X_STRESS(I)*TRANS(I) GWVERT3B.313
S_Y_STRESS(I)=S_Y_STRESS(I)*TRANS(I) GWVERT3B.314
ENDDO GWVERT3B.315
GWVERT3B.316
IF( TRANS_D_ON ) THEN GWVERT3B.317
DO I=1,POINTS GWVERT3B.318
TRANS_D(I)=TRANS(I) GWVERT3B.319
END DO GWVERT3B.320
ENDIF GWVERT3B.321
GWVERT3B.322
!--------------------------------------------------------------------- GWVERT3B.323
! 3.0 Find approximate height of tropopause for maximum jump height GWVERT3B.324
! limit and level limit of orography GWVERT3B.325
!--------------------------------------------------------------------- GWVERT3B.326
FLAG = .TRUE. GWVERT3B.327
K_TROP = LEVELS-2 GWVERT3B.328
DO K= 3,LEVELS-2 GWVERT3B.329
IF (FLAG) THEN GWVERT3B.330
PU=100000.*BKH(K+1) + AKH(K+1) GWVERT3B.331
IF ( PU .LT. 25000. ) THEN GWVERT3B.332
K_TROP = K GWVERT3B.333
FLAG = .FALSE. GWVERT3B.334
ENDIF GWVERT3B.335
ENDIF GWVERT3B.336
ENDDO GWVERT3B.337
GWVERT3B.338
!--------------------------------------------------------------------- GWVERT3B.339
! 3.2 Calculate N by U averaged over levels K_LIFT to a max of K_TROP GWVERT3B.340
! to test if N/UdeltaZ is greater than 3PI/2. Where this occurs GWVERT3B.341
! is the jump height, H_O_LEVEL (eqn 8,9) GWVERT3B.342
! N_SQAV is linearised from N_SQ at layer boundaries GWVERT3B.343
!--------------------------------------------------------------------- GWVERT3B.344
DO K=2,K_TROP GWVERT3B.345
DO I=1,POINTS GWVERT3B.346
IF( H_JUMP(I) .AND. L_CONT(I) GWVERT3B.347
& .AND. K.GT.K_LIFT(I) ) THEN GWVERT3B.348
GWVERT3B.349
IF( K.EQ.K_LIFT(I)+1 .OR. K_LIFT(I).EQ.0) THEN GWVERT3B.350
ZH(I)=0.0 GWVERT3B.351
P0(I)=PSTAR(I)*BKH(K_LIFT(I)+1) +AKH(K_LIFT(I)+1) GWVERT3B.352
PU=PSTAR(I)*BKH(K) + AKH(K) GWVERT3B.353
PL=PSTAR(I)*BKH(K-1) + AKH(K-1) GWVERT3B.354
! lower layer labelled KU GWVERT3B.355
P_EXNER_CENTRE(I,KU)= GWVERT3B.356
& P_EXNER_C( PEXNER(I,K),PEXNER(I,K-1),PU,PL,KAPPA ) GWVERT3B.357
PL=PU GWVERT3B.358
PU=PSTAR(I)*BKH(K+1) + AKH(K+1) GWVERT3B.359
! upper layer labelled KL ready for next level stage GWVERT3B.360
P_EXNER_CENTRE(I,KL)= P_EXNER_C( GWVERT3B.361
& PEXNER(I,K+1),PEXNER(I,K),PU,PL,KAPPA) GWVERT3B.362
N_SQ(I,KL) = G*(THETA(I,K)-THETA(I,K-1))/(THETA(I,K)* GWVERT3B.363
& THETA(I,K-1)*(P_EXNER_CENTRE(I,KU)-P_EXNER_CENTRE(I,KL))* GWVERT3B.364
& CPBYG) GWVERT3B.365
IF( N_SQ(I,KL).LE. 0.0 ) THEN GWVERT3B.366
H_JUMP(I)=.FALSE. GWVERT3B.367
ENDIF GWVERT3B.368
ENDIF GWVERT3B.369
GWVERT3B.370
! next level stage GWVERT3B.371
PU=PSTAR(I)*BKH(K+2) + AKH(K+2) GWVERT3B.372
PL=PSTAR(I)*BKH(K+1) + AKH(K+1) GWVERT3B.373
P_EXNER_CENTRE(I,KU)= GWVERT3B.374
& P_EXNER_C( PEXNER(I,K+2),PEXNER(I,K+1),PU,PL,KAPPA) GWVERT3B.375
N_SQ(I,KU) = G*(THETA(I,K+1)-THETA(I,K))/(THETA(I,K+1)* GWVERT3B.376
& THETA(I,K)*(P_EXNER_CENTRE(I,KL)-P_EXNER_CENTRE(I,KU))* GWVERT3B.377
& CPBYG) GWVERT3B.378
N_SQAV = ( (PEXNER(I,K)-P_EXNER_CENTRE(I,KL))*N_SQ(I,KU) + GWVERT3B.379
& (P_EXNER_CENTRE(I,KL) - PEXNER(I,K+1))*N_SQ(I,KL) ) GWVERT3B.380
& / ( PEXNER(I,K) - PEXNER(I,K+1) ) GWVERT3B.381
IF( N_SQAV .LE. 0.0 ) THEN GWVERT3B.382
H_JUMP(I)=.FALSE. GWVERT3B.383
TEST_CALC = 0.0 GWVERT3B.384
ELSE GWVERT3B.385
!-------------------------------------------------------------------- GWVERT3B.386
! Note U is component parallel to stress vector GWVERT3B.387
!-------------------------------------------------------------------- GWVERT3B.388
UCPTSPD = U(I,K)*UNIT_X(I) + V(I,K)*UNIT_Y(I) GWVERT3B.389
IF ( UCPTSPD .LE. 0.0 ) THEN GWVERT3B.390
NOVERU = 0.0 GWVERT3B.391
ELSE GWVERT3B.392
NOVERU = SQRT( N_SQAV ) / UCPTSPD GWVERT3B.393
ENDIF GWVERT3B.394
IF ( K_LIFT(I).EQ.0 ) THEN GWVERT3B.395
PB=PSTAR(I) GWVERT3B.396
DEL_EXNER = PEXNER(I,1) - PEXNER(I,2) GWVERT3B.397
ZH(I) = CPBYG*THETA(I,1)*DEL_EXNER GWVERT3B.398
K_LIFT(I)=1 GWVERT3B.399
ELSE GWVERT3B.400
PB=PSTAR(I)*BKH(K) + AKH(K) GWVERT3B.401
ENDIF GWVERT3B.402
NBYU_P(I) = NBYU_P(I) + NOVERU*(PB-PL) GWVERT3B.403
DEL_EXNER = PEXNER(I,K) - PEXNER(I,K+1) GWVERT3B.404
ZH(I) = ZH(I) + CPBYG*THETA(I,K)*DEL_EXNER GWVERT3B.405
TEST_CALC = ZH(I)*NBYU_P(I)/ ( P0(I)-PL ) GWVERT3B.406
ENDIF GWVERT3B.407
!------------------------------------------------------------------ GWVERT3B.408
! Test to see if jump height is reached GWVERT3B.409
! Note: (3*PI) / 2 = 4.712389 GWVERT3B.410
! Jump height is defined above LIFT (height of blocked layer) GWVERT3B.411
!------------------------------------------------------------------ GWVERT3B.412
IF( TEST_CALC .GT. 4.712389 ) THEN GWVERT3B.413
H_O_LEV(I) = K GWVERT3B.414
L_CONT(I) = .FALSE. GWVERT3B.415
GWVERT3B.416
IF ( H_O_LEV(I) .LE. START_L ) THEN GWVERT3B.417
H_JUMP(I) = .FALSE. GWVERT3B.418
ENDIF GWVERT3B.419
GWVERT3B.420
ENDIF ! Test > 4.712 GWVERT3B.421
GWVERT3B.422
IF ( K .EQ. K_TROP .AND. L_CONT(I) ) THEN GWVERT3B.423
H_O_LEV(I) = K GWVERT3B.424
L_CONT(I) = .FALSE. GWVERT3B.425
ENDIF GWVERT3B.426
GWVERT3B.427
ENDIF ! H_Jump and L_Cont GWVERT3B.428
ENDDO ! Points GWVERT3B.429
! Rename lower centre array as upper centre ready for next level GWVERT3B.430
KK=KU GWVERT3B.431
KU=KL GWVERT3B.432
KL=KK GWVERT3B.433
ENDDO ! Levels 2 to K_Trop GWVERT3B.434
GWVERT3B.435
!------------------------------------------------------------------ GWVERT3B.436
! 3.3 Find if critical layer occurs before H_O_LEV(I) GWVERT3B.437
!------------------------------------------------------------------ GWVERT3B.438
DO I=1,POINTS GWVERT3B.439
H_CRIT(I)=.FALSE. GWVERT3B.440
ENDDO GWVERT3B.441
GWVERT3B.442
DO K=START_L+1,LEVELS GWVERT3B.443
DO I=1,POINTS GWVERT3B.444
IF( H_JUMP(I) .AND. K.LE.H_O_LEV(I) ) THEN GWVERT3B.445
SPEED=S_X_STRESS(I)*U(I,K)+S_Y_STRESS(I)*V(I,K) GWVERT3B.446
IF(SPEED .LE. 0.0) THEN GWVERT3B.447
H_CRIT(I)=.TRUE. GWVERT3B.448
H_O_LEV(I)=K GWVERT3B.449
ENDIF GWVERT3B.450
ENDIF GWVERT3B.451
ENDDO ! Points GWVERT3B.452
ENDDO ! Levels 1 to 5 GWVERT3B.453
GWVERT3B.454
!--------------------------------------------------------------------- GWVERT3B.455
! 4.0 If no hydraulic jump the saturation hypothesis is applied from GWVERT3B.456
! START_L with S_STRESS. GWVERT3B.457
! Else for jump points, saturation is applied from H_O_LEV with GWVERT3B.458
! S_STRESS/6. If a critical level is found GW_SATN skipped. GWVERT3B.459
!--------------------------------------------------------------------- GWVERT3B.460
CALL GW_SATN GWVERT3B.461
1 (PSTAR,PEXNER,THETA,U,V,S_X_STRESS,S_Y_STRESS,START_L,LEVELS GWVERT3B.462
2 ,POINTS,AKH,BKH,DELTA_AK,DELTA_BK,KAY,SD_OROG,H_O_LEV,H_JUMP GWVERT3B.463
3 ,H_CRIT,S_X_OROG,S_Y_OROG,DU_DT,DV_DT GWVERT3B.464
! Diagnostics GWVERT3B.465
4 ,STRESS_UD,POINTS_STRESS_UD,STRESS_UD_ON GWVERT3B.466
5 ,STRESS_VD,POINTS_STRESS_VD,STRESS_VD_ON GWVERT3B.467
6 ,DU_DT_SATN,POINTS_DU_DT_SATN,DU_DT_SATN_ON GWVERT3B.468
7 ,DV_DT_SATN,POINTS_DV_DT_SATN,DV_DT_SATN_ON ) GWVERT3B.469
GWVERT3B.470
GWVERT3B.471
! GWVERT3B.472
!------------------------------------------------------------------ GWVERT3B.473
! 5.0 Linearize stress profile with pressure up to H_O_LEV and GWVERT3B.474
! S_STRESS/3 if H_JUMP true. If H_CRIT true then linearise GWVERT3B.475
! upto zero stress. Skip for non-jump, non-critical points GWVERT3B.476
!------------------------------------------------------------------ GWVERT3B.477
CALL GW_JUMP GWVERT3B.478
1 (PSTAR,PEXNER,S_X_STRESS,S_Y_STRESS,START_L,LEVELS GWVERT3B.479
2 ,POINTS,AKH,BKH,DELTA_AK,DELTA_BK,H_O_LEV,H_JUMP GWVERT3B.480
3 ,H_CRIT,DU_DT,DV_DT GWVERT3B.481
! Diagnostics GWVERT3B.482
4 ,STRESS_UD,POINTS_STRESS_UD,STRESS_UD_ON GWVERT3B.483
5 ,STRESS_VD,POINTS_STRESS_VD,STRESS_VD_ON GWVERT3B.484
6 ,DU_DT_JUMP,POINTS_DU_DT_JUMP,DU_DT_JUMP_ON GWVERT3B.485
7 ,DV_DT_JUMP,POINTS_DV_DT_JUMP,DV_DT_JUMP_ON ) GWVERT3B.486
GWVERT3B.487
GWVERT3B.488
!--------------------------------------------------------------------- GWVERT3B.489
! 6.0 Calculate linearized stress profile for trapped lee wave points GWVERT3B.490
! Lee surface stress is calculated independantly of S_X_STRESS. GWVERT3B.491
! Lee Stress is distributed vertically upto K_LEE(I,1) where its GWVERT3B.492
! value at K_LEE(I,1) is reduced by a ratio also calculated GWVERT3B.493
! within GW_LEE. The remaining stress is deposited by a second GWVERT3B.494
! gradient, upto K_LEE(I,2). Drags calculated are ADDITIONAL. GWVERT3B.495
!--------------------------------------------------------------------- GWVERT3B.496
CALL GW_LEE GWVERT3B.497
1 (PSTAR,START_L,LEVELS,POINTS,AKH,BKH,DELTA_AK,DELTA_BK GWVERT3B.498
2 ,U_S,V_S,RHO_S,L_LEE,LSQ_LEE,H_LEE,K_LEE,KAY_LEE GWVERT3B.499
3 ,SIGMA_XX,SIGMA_XY,SIGMA_YY,DU_DT,DV_DT GWVERT3B.500
! Diagnostics GWVERT3B.501
4 ,STRESS_UD,POINTS_STRESS_UD,STRESS_UD_ON GWVERT3B.502
5 ,STRESS_VD,POINTS_STRESS_VD,STRESS_VD_ON GWVERT3B.503
6 ,DU_DT_LEE,POINTS_DU_DT_LEE,DU_DT_LEE_ON GWVERT3B.504
7 ,DV_DT_LEE,POINTS_DV_DT_LEE,DV_DT_LEE_ON ) GWVERT3B.505
GWVERT3B.506
!------------------------------------------------------------------ GWVERT3B.507
! 7.0 SET ACCELERATION SAME IN ALL LAYERS 1 UP TO START_L GWVERT3B.508
!------------------------------------------------------------------ GWVERT3B.509
DO KK=1,START_L-1 GWVERT3B.510
DO I=1,POINTS GWVERT3B.511
DU_DT(I,KK) = DU_DT(I,START_L) GWVERT3B.512
DV_DT(I,KK) = DV_DT(I,START_L) GWVERT3B.513
END DO GWVERT3B.514
END DO GWVERT3B.515
GWVERT3B.516
IF( DU_DT_SATN_ON ) THEN GWVERT3B.517
DO KK=1,START_L-1 GWVERT3B.518
DO I=1,POINTS GWVERT3B.519
DU_DT_SATN(I,KK) = DU_DT_SATN(I,START_L) GWVERT3B.520
END DO GWVERT3B.521
END DO GWVERT3B.522
ENDIF GWVERT3B.523
GWVERT3B.524
IF( DV_DT_SATN_ON ) THEN GWVERT3B.525
DO KK=1,START_L-1 GWVERT3B.526
DO I=1,POINTS GWVERT3B.527
DV_DT_SATN(I,KK) = DV_DT_SATN(I,START_L) GWVERT3B.528
END DO GWVERT3B.529
END DO GWVERT3B.530
ENDIF GWVERT3B.531
GWVERT3B.532
IF( DU_DT_JUMP_ON ) THEN GWVERT3B.533
DO KK=1,START_L-1 GWVERT3B.534
DO I=1,POINTS GWVERT3B.535
DU_DT_JUMP(I,KK) = DU_DT_JUMP(I,START_L) GWVERT3B.536
END DO GWVERT3B.537
END DO GWVERT3B.538
ENDIF GWVERT3B.539
GWVERT3B.540
IF( DV_DT_JUMP_ON ) THEN GWVERT3B.541
DO KK=1,START_L-1 GWVERT3B.542
DO I=1,POINTS GWVERT3B.543
DV_DT_JUMP(I,KK) = DV_DT_JUMP(I,START_L) GWVERT3B.544
END DO GWVERT3B.545
END DO GWVERT3B.546
ENDIF GWVERT3B.547
GWVERT3B.548
IF( DU_DT_LEE_ON ) THEN GWVERT3B.549
DO KK=1,START_L-1 GWVERT3B.550
DO I=1,POINTS GWVERT3B.551
DU_DT_LEE(I,KK) = DU_DT_LEE(I,START_L) GWVERT3B.552
END DO GWVERT3B.553
END DO GWVERT3B.554
ENDIF GWVERT3B.555
GWVERT3B.556
IF( DV_DT_LEE_ON ) THEN GWVERT3B.557
DO KK=1,START_L-1 GWVERT3B.558
DO I=1,POINTS GWVERT3B.559
DV_DT_LEE(I,KK) = DV_DT_LEE(I,START_L) GWVERT3B.560
END DO GWVERT3B.561
END DO GWVERT3B.562
ENDIF GWVERT3B.563
GWVERT3B.564
RETURN GWVERT3B.565
END GWVERT3B.566
GWVERT3B.567
*ENDIF GWVERT3B.568