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