*IF DEF,A06_3A,OR,DEF,A06_3B ADR2F405.3
C ******************************COPYRIGHT****************************** GTS2F400.3709
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3710
C GTS2F400.3711
C Use, duplication or disclosure of this code is subject to the GTS2F400.3712
C restrictions as set forth in the contract. GTS2F400.3713
C GTS2F400.3714
C Meteorological Office GTS2F400.3715
C London Road GTS2F400.3716
C BRACKNELL GTS2F400.3717
C Berkshire UK GTS2F400.3718
C RG12 2SZ GTS2F400.3719
C GTS2F400.3720
C If no contract has been raised with this copy of the code, the use, GTS2F400.3721
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3722
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3723
C Modelling at the above address. GTS2F400.3724
C ******************************COPYRIGHT****************************** GTS2F400.3725
C GTS2F400.3726
! SUBROUTINE GW_SURF TO CALCULATE SURFACE STRESS VECTOR FOR GWD GWSURF3A.3
! GWSURF3A.4
SUBROUTINE GW_SURF 2GWSURF3A.5
1 (PSTAR,PEXNER,THETA,U,V,SD_OROG,SIGMA_XX,SIGMA_XY,SIGMA_YY, GWSURF3A.6
2 S_X_STRESS,S_Y_STRESS,S_X_OROG,S_Y_OROG,LEVELS, GWSURF3A.7
3 POINTS,AK,BK,AKH,BKH,KAY,TEST,K_LIFT,U_S,V_S,RHO_S) GWSURF3A.8
GWSURF3A.9
IMPLICIT NONE GWSURF3A.10
! Description: GWSURF3A.11
! Finds lift height for a blocked layer. Averages wind & stability from GWSURF3A.12
! the largest of lift height or level 2, upto a height of 1.4*sig(h) or GWSURF3A.13
! lev 3. Calculates anisotropic 'surface' stress due to sub-grid scale GWSURF3A.14
! orography via squared gradients and variance. The wave amplitude is GWSURF3A.15
! dependant on variance and may be proportional or follow a square or GWSURF3A.16
! cubic law w.r.t wind speed. These regimes are controlled by GWSURF3A.17
! parameters alpha and beta. GWSURF3A.18
! Method: UNIFIED MODEL DOCUMENTATION PAPER NO. ? GWSURF3A.19
! THE EQUATIONS USED ARE (1),(2) GWSURF3A.20
! GWSURF3A.21
! Current code owner: S.Webster ASW1F403.46
! GWSURF3A.23
! History: GWSURF3A.24
! Version Date Comment GWSURF3A.25
! 3.4 18/10/94 Original Code. J.R.Mitchell GWSURF3A.26
! 4.4 19/09/97 Remove *IF -DEF,CRAY compile options. S.Webster ASW1F404.7
! GWSURF3A.27
! Code Description: GWSURF3A.28
! Language: Fortran 77 + common extensions GWSURF3A.29
! This code is written to UMDP3 v6 programming standards. GWSURF3A.30
! System component covered: ORIGINAL VERSION FOR CRAY Y-MP GWSURF3A.31
! System task covered: PART OF P22 GWSURF3A.32
! SUITABLE FOR SINGLE COLUMN USE,ROTATED GRIDS GWSURF3A.33
! FURTHER ALTERATIONS MAY BE REQUIRED FOR AUTOTASKING EFFICIENCY GWSURF3A.34
GWSURF3A.35
! Global Variables GWSURF3A.36
*CALL C_G 
GWSURF3A.37
*CALL C_R_CP GWSURF3A.38
! Local constants GWSURF3A.39
*CALL C_GWAVE GWSURF3A.40
GWSURF3A.41
! Subroutine arguements GWSURF3A.42
INTEGER GWSURF3A.43
* LEVELS !IN NUMBER OF MODEL LEVELS GWSURF3A.44
*,POINTS !IN NUMBER OF POINTS GWSURF3A.45
*,K_LIFT(POINTS) !OUT MODEL LEVEL HEIGHT OF BLOCKED LAYER GWSURF3A.46
GWSURF3A.47
REAL GWSURF3A.48
* PSTAR(POINTS) !IN PSTAR FIELD GWSURF3A.49
*,PEXNER(POINTS,LEVELS+1) !IN PEXNER GWSURF3A.50
*,THETA(POINTS,LEVELS) !IN THETA FIELD GWSURF3A.51
*,U(POINTS,LEVELS) !IN U FIELD GWSURF3A.52
*,V(POINTS,LEVELS) !IN V FIELD GWSURF3A.53
! AK,BK DEFINE HYBRID VERTICAL COORDINATES P=A+BP*, GWSURF3A.54
REAL GWSURF3A.55
* AK (LEVELS) !IN VALUE AT LAYER CENTRE GWSURF3A.56
*,BK (LEVELS) !IN VALUE AT LAYER CENTRE GWSURF3A.57
*,AKH(LEVELS+1) !IN VALUE AT LAYER boundary GWSURF3A.58
*,BKH(LEVELS+1) !IN VALUE AT LAYER boundary GWSURF3A.59
*,KAY !IN surface stress constant (m-1) GWSURF3A.60
*,SD_OROG(POINTS) !IN STANDARD DEVIATION OF OROGRAPHY GWSURF3A.61
*,SIGMA_XX(POINTS) !IN DH/DX SQUARED GRADIENT OROG GWSURF3A.62
*,SIGMA_XY(POINTS) !IN (DH/DX)(DH/DY) GRADIENT OROG GWSURF3A.63
*,SIGMA_YY(POINTS) !IN DH/DY SQUARED GRADIENT OROG GWSURF3A.64
*,S_X_STRESS(POINTS) !OUT 'SURFACE' STRESS IN X-DIRN GWSURF3A.65
*,S_Y_STRESS(POINTS) !OUT 'SURFACE' STRESS IN Y-DIRN GWSURF3A.66
*,S_X_OROG(POINTS) !OUT 'SURFACE' STRESS/OROG IN X-DIRN GWSURF3A.67
*,S_Y_OROG(POINTS) !OUT 'SURFACE' STRESS/OROG IN Y-DIRN GWSURF3A.68
*,TEST(POINTS) !OUT TEST HYDROLOIC JUMP (SIMILAR TO FROUDE) GWSURF3A.69
*,U_S(POINTS) !OUT U-WINDS AVERAGED OVER 'SURFACE' GWSURF3A.70
*,V_S(POINTS) !OUT V-WINDS AVERAGED OVER 'SURFACE' GWSURF3A.71
*,RHO_S(POINTS) !OUT DENSITY AVERAGED OVER 'SURFACE' GWSURF3A.72
GWSURF3A.73
! Local parameters GWSURF3A.74
REAL CPBYG GWSURF3A.75
PARAMETER(CPBYG=CP/G) GWSURF3A.76
! Local scalers GWSURF3A.77
LOGICAL FLAG GWSURF3A.78
GWSURF3A.79
INTEGER I ! LOOP COUNTER IN ROUTINE GWSURF3A.80
INTEGER K,KK,KL,KU ! LEVEL COUNTERS IN ROUTINE GWSURF3A.81
INTEGER K_MOUNT ! LIMIT OF MOUNTAIN LEVELS GWSURF3A.82
GWSURF3A.83
REAL GWSURF3A.84
* RHO ! DENSITY GWSURF3A.85
*,SPEED ! WIND SPEED / WIND SPEED IN DIRN STRESS GWSURF3A.86
*,SPEEDCALC ! NUMERATOR OF CALCUATION FOR SPEED GWSURF3A.87
*,S_STRESS_SQ ! DENOMINATER OF CALCUATION FOR SPEED GWSURF3A.88
*,N ! BRUNT_VAISALA FREQUENCY GWSURF3A.89
*,N_SQAV ! AVERAGE OF BRUNT VAISALLA FREQ SQ GWSURF3A.90
*,H_SQ ! H1*H2 OF NEW PARMS FORMULA (55) GWSURF3A.91
*,ALPHA1 ! DUMMY FOR ALPHA (C_GWAWE) GWSURF3A.92
*,BETA1 ! DUMMY FOR BETA (C_GWAVE) GWSURF3A.93
*,R_ALPHA ! RECIPRICOL OF ALPHA1 GWSURF3A.94
*,R_BETA ! RECIPRICOL OF BETA1 GWSURF3A.95
*,CALC ! CALCULATION FOR SURFACE STRESS MAGNITUDE GWSURF3A.96
*,UOVERN ! UBYN FOR ONE LAYER GWSURF3A.97
*,DEL_EXNER ! EXNER DIFFERENCE ACROSS LAYER GWSURF3A.98
*,DELTA_P ! PRESSURE DIFFERENCE GWSURF3A.99
*,PU,PL ! PRESSURES AT LAYER BOUNDARIES GWSURF3A.100
GWSURF3A.101
! Local dynamic arrays GWSURF3A.102
! LOCAL WORKSPACE ARRAYS: 13 ARRAYS OF FULL FIELD LENGTH GWSURF3A.103
! GWSURF3A.104
LOGICAL GWSURF3A.114
* L_CONT(POINTS) ! LEVEL CONTINUE GWSURF3A.115
*,L_CONT2(POINTS) ! LEVEL CONTINUE GWSURF3A.116
GWSURF3A.117
INTEGER GWSURF3A.118
* K_BOT(POINTS) ! MODEL LEVEL HEIGHT OF BLOCKED LAYER GWSURF3A.119
*,K_TOP(POINTS) ! MODEL LEVEL AT MOUNTAIN TOPS GWSURF3A.120
GWSURF3A.121
REAL GWSURF3A.122
* LIFT(POINTS) ! OROGRAPHIC CONTRIBUTION TO H_JUMP HEIGHT GWSURF3A.123
*,P_EXNER_CENTRE(POINTS,2) ! EXNER PRESSURE AT LAYER CENTRES GWSURF3A.124
*,N_SQ(POINTS,2) ! SQUARE OF BRUNT_VAISALA FREQUENCY GWSURF3A.125
*,ZH(POINTS) ! TOTAL HEIGHT ABOVE GROUND (M) GWSURF3A.126
*,DELTA_P_SUM(POINTS) ! DELTA PRESSURE CUMULATIVE SUM GWSURF3A.127
*,NSQ_S(POINTS) ! N SQUARED AVERAGED OVER 'SURFACE' GWSURF3A.128
GWSURF3A.130
! Function and subroutine calls GWSURF3A.131
*CALL P_EXNERC GWSURF3A.132
GWSURF3A.133
!----------------------------------------------------------------- GWSURF3A.134
! CODE ASSUMES ALPHA < BETA . SWAP IS POSSIBLE BECAUSE OF GWSURF3A.135
! SYMMETRY OF CALCULATION ( SEE EQN(55), DOC ) GWSURF3A.136
!---------------------------------------------------------------- GWSURF3A.137
IF( ALPHA.GT.BETA ) THEN GWSURF3A.138
ALPHA1=BETA GWSURF3A.139
BETA1=ALPHA GWSURF3A.140
ELSE GWSURF3A.141
ALPHA1=ALPHA GWSURF3A.142
BETA1=BETA GWSURF3A.143
ENDIF GWSURF3A.144
GWSURF3A.145
GWSURF3A.146
R_ALPHA=1.0/ALPHA1 GWSURF3A.147
R_BETA=1.0/BETA1 GWSURF3A.148
GWSURF3A.149
KL=1 GWSURF3A.150
KU=2 GWSURF3A.151
GWSURF3A.152
!--------------------------------------------------------------------- GWSURF3A.153
! 1.0 Find approximate level limit of orography. Initialation GWSURF3A.154
!--------------------------------------------------------------------- GWSURF3A.155
FLAG = .TRUE. GWSURF3A.156
K_MOUNT = LEVELS-2 GWSURF3A.157
DO K= 3,LEVELS-2 GWSURF3A.158
IF (FLAG) THEN GWSURF3A.159
PU=100000.*BKH(K+1) + AKH(K+1) GWSURF3A.160
IF ( PU .LT. 50000. ) THEN GWSURF3A.161
K_MOUNT = K GWSURF3A.162
FLAG = .FALSE. GWSURF3A.163
ENDIF GWSURF3A.164
ENDIF GWSURF3A.165
ENDDO GWSURF3A.166
DO I=1,POINTS GWSURF3A.167
DELTA_P_SUM(I) = 0.0 GWSURF3A.168
NSQ_S(I) = 0.0 GWSURF3A.169
RHO_S(I) = 0.0 GWSURF3A.170
U_S(I) = 0.0 GWSURF3A.171
V_S(I) = 0.0 GWSURF3A.172
L_CONT(I) =.TRUE. GWSURF3A.173
L_CONT2(I) =.TRUE. GWSURF3A.174
ENDDO GWSURF3A.175
!--------------------------------------------------------------------- GWSURF3A.176
! 1.1 Calculate N by U averaged over boundary values of level 2 GWSURF3A.177
! Use this to calculate level depth of any blocked layer - GWSURF3A.178
! K_LIFT (eqn 7) GWSURF3A.179
!--------------------------------------------------------------------- GWSURF3A.180
DO K=2,K_MOUNT GWSURF3A.181
DO I=1,POINTS GWSURF3A.182
IF( K.EQ.2 ) THEN GWSURF3A.183
! level 1.5 GWSURF3A.184
PU=PSTAR(I)*BKH(K) + AKH(K) GWSURF3A.185
PL=PSTAR(I)*BKH(K-1) + AKH(K-1) GWSURF3A.186
P_EXNER_CENTRE(I,KL)= GWSURF3A.187
& P_EXNER_C( PEXNER(I,K),PEXNER(I,K-1),PU,PL,KAPPA) GWSURF3A.188
PL=PU GWSURF3A.189
PU=PSTAR(I)*BKH(K+1) + AKH(K+1) GWSURF3A.190
P_EXNER_CENTRE(I,KU)= GWSURF3A.191
& P_EXNER_C( PEXNER(I,K+1),PEXNER(I,K),PU,PL,KAPPA) GWSURF3A.192
N_SQ(I,KL) = G*(THETA(I,K)-THETA(I,K-1))/(THETA(I,K)* GWSURF3A.193
& THETA(I,K-1)*(P_EXNER_CENTRE(I,KL)-P_EXNER_CENTRE(I,KU))* GWSURF3A.194
& CPBYG) GWSURF3A.195
! level 2.5 GWSURF3A.196
P_EXNER_CENTRE(I,KL)=P_EXNER_CENTRE(I,KU) GWSURF3A.197
PL=PU GWSURF3A.198
PU=PSTAR(I)*BKH(K+2) + AKH(K+2) GWSURF3A.199
P_EXNER_CENTRE(I,KU)= GWSURF3A.200
& P_EXNER_C( PEXNER(I,K+2),PEXNER(I,K+1),PU,PL,KAPPA) GWSURF3A.201
N_SQ(I,KU) = G*(THETA(I,K+1)-THETA(I,K))/(THETA(I,K+1)* GWSURF3A.202
& THETA(I,K)*(P_EXNER_CENTRE(I,KL)-P_EXNER_CENTRE(I,KU))* GWSURF3A.203
& CPBYG) GWSURF3A.204
! n_squared averaged interpolating boundary values of level 2 GWSURF3A.205
N_SQAV = ( (PEXNER(I,K)-P_EXNER_CENTRE(I,KL))*N_SQ(I,KU)+ GWSURF3A.206
& (P_EXNER_CENTRE(I,KL) - PEXNER(I,K+1))*N_SQ(I,KL) ) GWSURF3A.207
& / ( PEXNER(I,K) - PEXNER(I,K+1) ) GWSURF3A.208
GWSURF3A.209
SPEED = U(I,2)*U(I,2) + V(I,2)*V(I,2) GWSURF3A.210
IF ( N_SQAV .LE. 0.0 .OR. SPEED .LE. 0.0 ) THEN GWSURF3A.211
UOVERN = 0.0 GWSURF3A.212
LIFT(I)=0.0 GWSURF3A.213
ELSE GWSURF3A.214
UOVERN= SPEED / N_SQAV GWSURF3A.215
UOVERN = SQRT( UOVERN ) GWSURF3A.216
LIFT(I) = 1.4*SD_OROG(I) - 0.985*UOVERN GWSURF3A.217
ENDIF GWSURF3A.218
IF ( LIFT(I) .LE. 0.0 ) THEN GWSURF3A.219
K_LIFT(I) = 0 GWSURF3A.220
L_CONT(I) = .FALSE. GWSURF3A.221
ENDIF GWSURF3A.222
GWSURF3A.223
K_BOT(I) = 1 GWSURF3A.224
DEL_EXNER = PEXNER(I,K-1) - PEXNER(I,K) GWSURF3A.225
ZH(I) = CPBYG*THETA(I,K-1)*DEL_EXNER GWSURF3A.226
GWSURF3A.227
ENDIF ! k=2 GWSURF3A.228
!------------------------------------------------------------------ GWSURF3A.229
! Substitute in Eqn 7. Orographic height Hm = 1.4*SD_OROG(I) GWSURF3A.230
!------------------------------------------------------------------ GWSURF3A.231
DEL_EXNER = PEXNER(I,K) - PEXNER(I,K+1) GWSURF3A.232
ZH(I) = ZH(I) + CPBYG*THETA(I,K)*DEL_EXNER GWSURF3A.233
IF ( L_CONT(I) .AND. GWSURF3A.234
* (ZH(I).GT.LIFT(I) .OR. ZH(I).GT.750.) ) THEN GWSURF3A.235
K_LIFT(I) = K GWSURF3A.236
K_BOT(I) = K GWSURF3A.237
L_CONT(I) = .FALSE. GWSURF3A.238
ENDIF GWSURF3A.239
!------------------------------------------------------------------ GWSURF3A.240
! Find top of mountains where flow is still impacted upon. GWSURF3A.241
!------------------------------------------------------------------ GWSURF3A.242
IF ( L_CONT2(I) .AND. GWSURF3A.243
* (ZH(I).GT.1.4*SD_OROG(I) .OR. ZH(I).GT.750.) ) THEN GWSURF3A.244
K_TOP(I) = K GWSURF3A.245
IF( K_TOP(I).LT.3 ) K_TOP(I)=3 GWSURF3A.246
IF( K_BOT(I).GE.K_TOP(I) ) K_BOT(I)=K_TOP(I)-1 GWSURF3A.247
L_CONT2(I) = .FALSE. GWSURF3A.248
ENDIF GWSURF3A.249
GWSURF3A.250
ENDDO ! Points GWSURF3A.251
ENDDO ! Levels 2 to K_Mount GWSURF3A.252
!--------------------------------------------------------------------- GWSURF3A.253
! 1.2 Calculate average N, U ,V ,RHO over 'surface' integral between GWSURF3A.254
! K_BOT and K_TOP as diagnosed above GWSURF3A.255
! N_SQAV is linearised from N_SQ at layer boundaries GWSURF3A.256
!--------------------------------------------------------------------- GWSURF3A.257
DO K=2,K_MOUNT GWSURF3A.258
DO I=1,POINTS GWSURF3A.259
IF( K.GT.K_BOT(I) .AND. K.LE.K_TOP(I) ) THEN GWSURF3A.260
GWSURF3A.261
IF( K.EQ.K_BOT(I)+1 ) THEN GWSURF3A.262
ZH(I)=0.0 GWSURF3A.263
PU=PSTAR(I)*BKH(K) + AKH(K) GWSURF3A.264
PL=PSTAR(I)*BKH(K-1) + AKH(K-1) GWSURF3A.265
! lower layer labelled KU GWSURF3A.266
P_EXNER_CENTRE(I,KU)= GWSURF3A.267
& P_EXNER_C( PEXNER(I,K),PEXNER(I,K-1),PU,PL,KAPPA ) GWSURF3A.268
PL=PU GWSURF3A.269
PU=PSTAR(I)*BKH(K+1) + AKH(K+1) GWSURF3A.270
! upper layer labelled KL ready for next level stage GWSURF3A.271
P_EXNER_CENTRE(I,KL)= P_EXNER_C( GWSURF3A.272
& PEXNER(I,K+1),PEXNER(I,K),PU,PL,KAPPA) GWSURF3A.273
N_SQ(I,KL) = G*(THETA(I,K)-THETA(I,K-1))/(THETA(I,K)* GWSURF3A.274
& THETA(I,K-1)*(P_EXNER_CENTRE(I,KU)-P_EXNER_CENTRE(I,KL))* GWSURF3A.275
& CPBYG) GWSURF3A.276
ENDIF GWSURF3A.277
GWSURF3A.278
! next level stage GWSURF3A.279
PU=PSTAR(I)*BKH(K+2) + AKH(K+2) GWSURF3A.280
PL=PSTAR(I)*BKH(K+1) + AKH(K+1) GWSURF3A.281
P_EXNER_CENTRE(I,KU)= GWSURF3A.282
& P_EXNER_C( PEXNER(I,K+2),PEXNER(I,K+1),PU,PL,KAPPA) GWSURF3A.283
N_SQ(I,KU) = G*(THETA(I,K+1)-THETA(I,K))/(THETA(I,K+1)* GWSURF3A.284
& THETA(I,K)*(P_EXNER_CENTRE(I,KL)-P_EXNER_CENTRE(I,KU))* GWSURF3A.285
& CPBYG) GWSURF3A.286
N_SQAV = ( (PEXNER(I,K)-P_EXNER_CENTRE(I,KL))*N_SQ(I,KU) + GWSURF3A.287
& (P_EXNER_CENTRE(I,KL) - PEXNER(I,K+1))*N_SQ(I,KL) ) GWSURF3A.288
& / ( PEXNER(I,K) - PEXNER(I,K+1) ) GWSURF3A.289
PU=PSTAR(I)*BKH(K) + AKH(K) GWSURF3A.290
RHO=( AK(K) + BK(K)*PSTAR(I) )/( R*THETA(I,K)* GWSURF3A.291
& P_EXNER_C( PEXNER(I,K+1),PEXNER(I,K),PL,PU,KAPPA)) GWSURF3A.292
GWSURF3A.293
!-------------------------------------------------------------------- GWSURF3A.294
! Average 'surface' quantities with pressure GWSURF3A.295
!-------------------------------------------------------------------- GWSURF3A.296
DELTA_P = PSTAR(I)*BKH(K) + AKH(K) - PL GWSURF3A.297
DELTA_P_SUM(I) = DELTA_P_SUM(I) + DELTA_P GWSURF3A.298
NSQ_S(I)=NSQ_S(I)+( N_SQAV-NSQ_S(I))*DELTA_P/DELTA_P_SUM(I) GWSURF3A.299
RHO_S(I)=RHO_S(I)+( RHO - RHO_S(I) )*DELTA_P/DELTA_P_SUM(I) GWSURF3A.300
U_S(I) =U_S(I) +( U(I,K)-U_S(I) )*DELTA_P/DELTA_P_SUM(I) GWSURF3A.301
V_S(I) =V_S(I) +( V(I,K)-V_S(I) )*DELTA_P/DELTA_P_SUM(I) GWSURF3A.302
GWSURF3A.303
ENDIF ! H_Jump and L_Cont GWSURF3A.304
ENDDO ! Points GWSURF3A.305
! Rename lower centre array as upper centre ready for next level GWSURF3A.306
KK=KU GWSURF3A.307
KU=KL GWSURF3A.308
KL=KK GWSURF3A.309
ENDDO ! Levels 2 to K_Trop GWSURF3A.310
GWSURF3A.311
!------------------------------------------------------------------ GWSURF3A.312
! 2.0 Begin calulation of surface stress GWSURF3A.313
!----------------------------------------------------------------- GWSURF3A.314
DO I=1,POINTS GWSURF3A.315
GWSURF3A.316
SPEED = U_S(I)*U_S(I) + V_S(I)*V_S(I) GWSURF3A.317
GWSURF3A.318
IF ( SPEED .LE. 0.0 ) THEN GWSURF3A.319
S_X_OROG(I) = 0.0 GWSURF3A.320
S_Y_OROG(I) = 0.0 GWSURF3A.321
ELSE GWSURF3A.322
SPEED = SQRT(SPEED) GWSURF3A.323
! Surf X/Y orog define orography as seen by the surface gravity wave GWSURF3A.324
S_X_OROG(I)= (U_S(I)*SIGMA_XX(I)+V_S(I)*SIGMA_XY(I)) /SPEED GWSURF3A.325
S_Y_OROG(I)= (U_S(I)*SIGMA_XY(I)+V_S(I)*SIGMA_YY(I)) /SPEED GWSURF3A.326
GWSURF3A.327
S_STRESS_SQ= S_X_OROG(I)*S_X_OROG(I)+S_Y_OROG(I)*S_Y_OROG(I) GWSURF3A.328
SPEEDCALC = U_S(I)*S_X_OROG(I) + V_S(I)*S_Y_OROG(I) GWSURF3A.329
IF ( S_STRESS_SQ .LE. 0.0 ) THEN GWSURF3A.330
SPEED = 0.0 GWSURF3A.331
ELSE GWSURF3A.332
SPEED = SPEEDCALC / SQRT( S_STRESS_SQ ) GWSURF3A.333
! Speed component in dirn. of surface gravity wave GWSURF3A.334
ENDIF GWSURF3A.335
ENDIF GWSURF3A.336
GWSURF3A.337
!------------------------------------------------------------------ GWSURF3A.338
! 2.1 Calculate BRUNT-VAISALA frequency Eqn 1,2 GWSURF3A.339
!------------------------------------------------------------------ GWSURF3A.340
IF( NSQ_S(I).LE.0.0 .OR. SPEED.LE.0.0 GWSURF3A.341
& .OR. SD_OROG(I).LE.0.0 ) THEN GWSURF3A.342
S_X_STRESS(I) = 0.0 GWSURF3A.343
S_Y_STRESS(I) = 0.0 GWSURF3A.344
TEST(I)=1.0 GWSURF3A.345
! NO WAVES IF UNSTABLE OR IF NO OROGRAPHY GWSURF3A.346
ELSE GWSURF3A.347
N = SQRT( NSQ_S(I) ) GWSURF3A.348
GWSURF3A.349
!------------------------------------------------------------------ GWSURF3A.350
! 2.2 Impose semi-emperical formula. LINEAR/SQUARE/CUBIC DRAG GWSURF3A.351
!------------------------------------------------------------------ GWSURF3A.352
H_SQ = 1.0 GWSURF3A.353
TEST(I) = N*SD_OROG(I) / SPEED GWSURF3A.354
IF( BETA1.GT.TEST(I) .AND. TEST(I).GE.ALPHA1 ) THEN GWSURF3A.355
H_SQ = TEST(I)*R_BETA GWSURF3A.356
ELSE IF( TEST(I).LT.ALPHA1 ) THEN GWSURF3A.357
H_SQ = TEST(I)*R_BETA*TEST(I)*R_ALPHA GWSURF3A.358
ENDIF GWSURF3A.359
GWSURF3A.360
!------------------------------------------------------------------ GWSURF3A.361
! 2.3 Calculate 'SURFACE' STRESS GWSURF3A.362
!------------------------------------------------------------------ GWSURF3A.363
CALC= KAY*RHO_S(I)*(SPEED**3)*H_SQ/(N*SD_OROG(I)*SD_OROG(I)) GWSURF3A.364
S_X_STRESS(I) = S_X_OROG(I) * CALC GWSURF3A.365
S_Y_STRESS(I) = S_Y_OROG(I) * CALC GWSURF3A.366
GWSURF3A.367
ENDIF ! SPEED OR N OR OROG .LE. 0.0 ELSE GWSURF3A.368
END DO ! I=POINTS GWSURF3A.369
! END LOOP POINTS GWSURF3A.370
GWSURF3A.371
GWSURF3A.372
RETURN GWSURF3A.373
END GWSURF3A.374
*ENDIF GWSURF3A.375