SUBROUTINE GW_SATN 2GWSATN3B.23
1 (PSTAR,PEXNER,THETA,U,V,S_X_STRESS,S_Y_STRESS,START_L,LEVELS GWSATN3B.24
2 ,POINTS,AKH,BKH,DELTA_AK,DELTA_BK,KAY,SD_OROG,H_O_LEV,H_JUMP GWSATN3B.25
3 ,H_CRIT,S_X_OROG,S_Y_OROG,DU_DT,DV_DT GWSATN3B.26
! Diagnostics GWSATN3B.27
4 ,STRESS_UD,POINTS_STRESS_UD,STRESS_UD_ON GWSATN3B.28
5 ,STRESS_VD,POINTS_STRESS_VD,STRESS_VD_ON GWSATN3B.29
6 ,DU_DT_SATN,POINTS_DU_DT_SATN,DU_DT_SATN_ON GWSATN3B.30
7 ,DV_DT_SATN,POINTS_DV_DT_SATN,DV_DT_SATN_ON ) GWSATN3B.31
GWSATN3B.32
IMPLICIT NONE GWSATN3B.33
! Description: GWSATN3B.34
! TO CALCULATE STRESS PROFILE DUE TO SUBGRID-SCALE GWSATN3B.35
! OROGRAPHIC LONG HYDROSTATIC WAVES. GWSATN3B.36
! THE WAVES PROPOGATE VERTICALLY WITH STRESS INDEPENDENT GWSATN3B.37
! OF HEIGHT UNLESS A CRITICAL LEVEL OR WAVE BREAKING IS GWSATN3B.38
! DIAGNOSED. THE CRITICAL STRESS IS CALCULATED GWSATN3B.39
! FROM WIND COMPONENT PARALLEL TO THE ORIGINAL SURFACE GWSATN3B.40
! STRESS , NOT NECESSARILY PARALLEL TO SURFACE WIND. GWSATN3B.41
! THE X AND Y COMPONENTS OF STRESS ARE TREATED GWSATN3B.42
! INDEPENDANTLY BUT THE VECTOR CAN NOT TURN. GWSATN3B.43
! IF HYDROLIC JUMP HAS BEEN DIAGNOSED THEN THIS GWSATN3B.44
! ROUTINE STARTS FROM H_O_LEV AND EQUIVALENT STARTING GWSATN3B.45
! STRESS OF A THIRD 'SURFACE' STRESS ,UNLESS A GWSATN3B.46
! CRITICAL LAYER HAS ALREADY BEEN DIAGNOSED. GWSATN3B.47
! DRAG ON MEAN FLOW IS CALCULATED FROM STRESS PROFILE. GWSATN3B.48
! GWSATN3B.49
! Method: UNIFIED MODEL DOCUMENTATION PAPER NO. ? GWSATN3B.50
! THE EQUATIONS USED ARE (1),(2),(3),(4),(6) GWSATN3B.51
! GWSATN3B.52
! Current code owner: S.Webster GWSATN3B.53
! GWSATN3B.54
! History: GWSATN3B.55
! Version Date Comment GWSATN3B.56
! 4.5 03/06/98 Original Code. Copy of 4.4 GWSATN3A with operational GWSATN3B.57
! changes. GWSATN3B.58
! Equal acceleration in bottom 3 layers. Gamma factor GWSATN3B.59
! introduced into critical stress formula. GWSATN3B.60
! D. Robinson GWSATN3B.61
! GWSATN3B.62
! Code Description: GWSATN3B.63
! Language: Fortran 77 + common extensions GWSATN3B.64
! This code is written to UMDP3 v6 programming standards. GWSATN3B.65
! System component covered: ORIGINAL VERSION FOR CRAY Y-MP GWSATN3B.66
! System task covered: PART OF P22 GWSATN3B.67
! SUITABLE FOR SINGLE COLUMN USE,ROTATED GRIDS GWSATN3B.68
! FURTHER ALTERATIONS MAY BE REQUIRED FOR AUTOTASKING EFFICIENCY GWSATN3B.69
GWSATN3B.70
! Global Variables GWSATN3B.71
*CALL C_G 
GWSATN3B.72
*CALL C_R_CP GWSATN3B.73
! Local constants GWSATN3B.74
*CALL C_GWAVE GWSATN3B.75
! Subroutine arguements; GWSATN3B.76
GWSATN3B.77
INTEGER GWSATN3B.78
* LEVELS !IN NUMBER OF MODEL LEVELS GWSATN3B.79
*,START_L !IN START LEVEL FOR WAVE-BREAKING TEST GWSATN3B.80
*,POINTS !IN NUMBER OF POINTS GWSATN3B.81
*,POINTS_STRESS_UD !IN ) No of land points in diagnostic GWSATN3B.82
*,POINTS_STRESS_VD !IN ) arrays for GW stress - u and v GWSATN3B.83
*,POINTS_DU_DT_SATN !IN ) No of land points in diagnostic GWSATN3B.84
*,POINTS_DV_DT_SATN !IN ) arrays for GW satn - du and dv GWSATN3B.85
*,H_O_LEV(POINTS) !IN LEVEL OF CRITICAL/JUMP HEIGHT GWSATN3B.86
GWSATN3B.87
LOGICAL GWSATN3B.88
* H_JUMP(POINTS) !IN TRUE IF POINT IS TO BE LINEARIZED GWSATN3B.89
*,H_CRIT(POINTS) !IN TRUE IF CRITICAL HEIGHT BEFORE JUMP GWSATN3B.90
*,STRESS_UD_ON !IN U stress diagnostic switch GWSATN3B.91
*,STRESS_VD_ON !IN V stress diagnostic switch GWSATN3B.92
*,DU_DT_SATN_ON !IN U accel (saturation) diagnostic switch GWSATN3B.93
*,DV_DT_SATN_ON !IN V accel (saturation) diagnostic switch GWSATN3B.94
GWSATN3B.95
REAL GWSATN3B.96
* PSTAR(POINTS) !IN PSTAR FIELD GWSATN3B.97
*,PEXNER(POINTS,LEVELS+1) !IN PEXNER GWSATN3B.98
*,THETA(POINTS,LEVELS) !IN THETA FIELD GWSATN3B.99
*,U(POINTS,LEVELS) !IN U FIELD GWSATN3B.100
*,V(POINTS,LEVELS) !IN V FIELD GWSATN3B.101
*,S_X_STRESS(POINTS) !IN 'SURFACE' X_STRESS GWSATN3B.102
*,S_Y_STRESS(POINTS) !IN 'SURFACE' Y_STRESS GWSATN3B.103
*,S_X_OROG(POINTS) !IN 'SURFACE' X_OROG GWSATN3B.104
*,S_Y_OROG(POINTS) !IN 'SURFACE' Y_OROG GWSATN3B.105
*,SD_OROG(POINTS) !IN STANDARD DEVIATION OF OROGRAPHY GWSATN3B.106
! AKH,BKH DEFINE HYBRID VERTICAL COORDINATES P=A+BP*-LAYER EDGES, GWSATN3B.107
! DELTA_AK,DELTA_BK DEFINE PRESSURE DIFFERENCES ACROSS LAYERS GWSATN3B.108
*,AKH(LEVELS+1) !IN VALUE AT LAYER BOUNDARY GWSATN3B.109
*,BKH(LEVELS+1) !IN VALUE AT LAYER BOUMDARY GWSATN3B.110
*,DELTA_AK(LEVELS) !IN DIFFERENCE ACROSS LAYER GWSATN3B.111
*,DELTA_BK(LEVELS) !IN DIFFERENCE ACROSS LAYER GWSATN3B.112
*,KAY !IN stress constant (m-1) GWSATN3B.113
*,DU_DT(POINTS,LEVELS) !OUT U-ACCELERATION GWSATN3B.114
*,DV_DT(POINTS,LEVELS) !OUT V-ACCELERATION GWSATN3B.115
! Diagnostics GWSATN3B.116
REAL GWSATN3B.117
* DU_DT_SATN(POINTS_DU_DT_SATN,LEVELS) !U-ACCELN DIAGNOSTIC GWSATN3B.118
*,DV_DT_SATN(POINTS_DV_DT_SATN,LEVELS) !V-ACCELN DIAGNOSTIC GWSATN3B.119
*,STRESS_UD(POINTS_STRESS_UD,LEVELS+1) !U-STRESS DIAGNOSTIC GWSATN3B.120
*,STRESS_VD(POINTS_STRESS_VD,LEVELS+1) !V-STRESS DIAGNOSTIC GWSATN3B.121
GWSATN3B.122
! Local parameters GWSATN3B.123
REAL CPBYG GWSATN3B.124
PARAMETER(CPBYG=CP/G) GWSATN3B.125
GWSATN3B.126
! Local scalers GWSATN3B.127
REAL GWSATN3B.128
* RHO ! DENSITY AT LAYER BOUNDARY GWSATN3B.129
*,TB ! TEMPERATURE AT LAYER BOUNDARY GWSATN3B.130
*,DZB ! HEIGHT DIFFERENCE ACROSS LAYER BOUNDARY GWSATN3B.131
*,UB ! U-WIND AT LAYER BOUNDARY GWSATN3B.132
*,VB ! V-WIND AT LAYER BOUNDARY GWSATN3B.133
*,N ! BRUNT_VAISALA FREQUENCY GWSATN3B.134
*,N_SQ ! SQUARE OF BRUNT_VAISALA FREQUENCY GWSATN3B.135
*,C_X_STRESS ! CRITICAL X_STRESS (EQN 56) GWSATN3B.136
*,C_Y_STRESS ! CRITICAL Y_STRESS (EQN 56) GWSATN3B.137
*,S_STRESS_SQ ! SQUARE OF SURFACE STRESS GWSATN3B.138
*,S_STRESS ! MAGNITUDE OF SURFACE STRESS GWSATN3B.139
*,SPEEDCALC ! DOT PRODUCT CALCULATION FOR SPEED/STRESS GWSATN3B.140
*,DELTA_P ! DIFFERENCE IN PRESSURE ACROSS LAYER GWSATN3B.141
*,ALPHA1 ! ALLOWS SWAP OF ALPHA AND BETA GWSATN3B.142
*,BETA1 ! " GWSATN3B.143
*,GAMMA_SQ ! Parameter for scaling critical stress GWSATN3B.144
*,DELTA_AK_SUM ! DELTA_AK SUMMED OVER LOWEST LAYERS UP TO START_L GWSATN3B.145
*,DELTA_BK_SUM ! DELTA_BK SUMMED OVER LOWEST LAYERS UP TO START_L GWSATN3B.146
*,PU,PL,P_EXNER_CENTRE GWSATN3B.147
INTEGER I,K ! LOOP COUNTER IN ROUTINE GWSATN3B.148
INTEGER KK,KL,KU,KT ! LEVEL COUNTERS IN ROUTINE GWSATN3B.149
INTEGER H_O_L ! DUMMY FOR H_O_LEV(I) GWSATN3B.150
GWSATN3B.151
! Local dynamic arrays GWSATN3B.152
! LOCAL WORKSPACE ARRAYS: 11 ARRAYS OF FULL FIELD LENGTH GWSATN3B.153
! GWSATN3B.154
REAL GWSATN3B.155
* DZ(POINTS,3) ! HEIGHT DIFFERENCES IN EACH HALF LAYER GWSATN3B.156
*,T(POINTS,2) ! TEMPERATURES (LEVELS) GWSATN3B.157
*,X_STRESS(POINTS,2) ! X_STRESSES (LAYER BOUNDARIES) GWSATN3B.158
*,Y_STRESS(POINTS,2) ! Y_STRESSES (LAYER BOUNDARIES) GWSATN3B.159
*,X_S_CONST(POINTS) ! LEVEL INDEPEDANT CONSTS FOR CALCULATION GWSATN3B.160
*,Y_S_CONST(POINTS) ! OF CRITICAL STRESSES GWSATN3B.161
GWSATN3B.162
! Function and subroutine calls GWSATN3B.163
*CALL P_EXNERC GWSATN3B.164
GWSATN3B.165
!------------------------------------------------------------------- GWSATN3B.166
! INTERNAL STRUCTURE INCLUDING SUBROUTINE CALLS: GWSATN3B.167
! 1. START LEVEL PRELIMINARIES GWSATN3B.168
!------------------------------------------ GWSATN3B.169
GWSATN3B.170
CFPP$ NOCONCUR L GWSATN3B.171
! TREAT LAYERS BELOW AND INCLUDING START_L AS ONE LAYER GWSATN3B.172
DELTA_AK_SUM = 0.0 GWSATN3B.173
DELTA_BK_SUM = 0.0 GWSATN3B.174
DO K=1,START_L GWSATN3B.175
DELTA_AK_SUM = DELTA_AK_SUM + DELTA_AK(K) GWSATN3B.176
DELTA_BK_SUM = DELTA_BK_SUM + DELTA_BK(K) GWSATN3B.177
END DO GWSATN3B.178
CFPP$ CONCUR GWSATN3B.179
GWSATN3B.180
!----------------------------------------------------------------- GWSATN3B.181
! CODE ASSUMES ALPHA < BETA . SWAP IS POSSIBLE BECAUSE OF GWSATN3B.182
! SYMMETRY OF CALCULATION ( SEE EQN(55), DOC ) GWSATN3B.183
!---------------------------------------------------------------- GWSATN3B.184
IF( ALPHA.GT.BETA ) THEN GWSATN3B.185
ALPHA1 = BETA GWSATN3B.186
BETA1 = ALPHA GWSATN3B.187
ELSE GWSATN3B.188
ALPHA1 = ALPHA GWSATN3B.189
BETA1 = BETA GWSATN3B.190
ENDIF GWSATN3B.191
GWSATN3B.192
GAMMA_SQ = GAMMA_SATN * GAMMA_SATN GWSATN3B.193
GWSATN3B.194
KL=1 GWSATN3B.195
KU=2 GWSATN3B.196
KT=3 GWSATN3B.197
GWSATN3B.198
DO I=1,POINTS GWSATN3B.199
GWSATN3B.200
IF( H_JUMP(I) .AND. H_CRIT(I) ) THEN GWSATN3B.201
X_STRESS(I,KL) = 0.0 GWSATN3B.202
Y_STRESS(I,KL) = 0.0 GWSATN3B.203
H_O_L=H_O_LEV(I) GWSATN3B.204
GWSATN3B.205
ELSE IF( H_JUMP(I) ) THEN GWSATN3B.206
X_STRESS(I,KL) = S_X_STRESS(I)/6.0 GWSATN3B.207
Y_STRESS(I,KL) = S_Y_STRESS(I)/6.0 GWSATN3B.208
H_O_L=H_O_LEV(I) GWSATN3B.209
PU=PSTAR(I)*BKH(H_O_L+1) + AKH(H_O_L+1) GWSATN3B.210
PL=PSTAR(I)*BKH(H_O_L) + AKH(H_O_L) GWSATN3B.211
P_EXNER_CENTRE= GWSATN3B.212
& P_EXNER_C( PEXNER(I,H_O_L+1),PEXNER(I,H_O_L),PU,PL,KAPPA) GWSATN3B.213
GWSATN3B.214
DZ(I,KL) = (P_EXNER_CENTRE - PEXNER(I,H_O_L+1)) GWSATN3B.215
* *THETA(I,H_O_L)*CPBYG GWSATN3B.216
T(I,KL) = P_EXNER_CENTRE*THETA(I,H_O_L) GWSATN3B.217
DZ(I,KT) = DZ(I,KL) GWSATN3B.218
T(I,KU) = T(I,KL) GWSATN3B.219
GWSATN3B.220
ELSE GWSATN3B.221
X_STRESS(I,KL) = S_X_STRESS(I) GWSATN3B.222
Y_STRESS(I,KL) = S_Y_STRESS(I) GWSATN3B.223
PU=PSTAR(I)*BKH(START_L+1) + AKH(START_L+1) GWSATN3B.224
PL=PSTAR(I)*BKH(START_L) + AKH(START_L) GWSATN3B.225
P_EXNER_CENTRE= GWSATN3B.226
& P_EXNER_C( PEXNER(I,START_L+1),PEXNER(I,START_L),PU,PL,KAPPA) GWSATN3B.227
GWSATN3B.228
DZ(I,KL) = (P_EXNER_CENTRE - PEXNER(I,START_L+1)) GWSATN3B.229
* *THETA(I,START_L)*CPBYG GWSATN3B.230
T(I,KL) = P_EXNER_CENTRE*THETA(I,START_L) GWSATN3B.231
GWSATN3B.232
ENDIF GWSATN3B.233
GWSATN3B.234
!------------------------------------------------------------------ GWSATN3B.235
! 1.1 CALCULATE LEVEL INDEPENDANT STRESS CONSTANTS FOR SECTION 2.2 GWSATN3B.236
!------------------------------------------------------------------ GWSATN3B.237
S_STRESS_SQ = S_X_STRESS(I)**2 + S_Y_STRESS(I)**2 GWSATN3B.238
S_STRESS=SQRT(S_STRESS_SQ) GWSATN3B.239
IF((BETA*SD_OROG(I)*SD_OROG(I)*S_STRESS_SQ*S_STRESS).LE.1.0E-30 GWSATN3B.240
& .OR.SD_OROG(I).LE.0.0 .OR. S_STRESS_SQ.LE.0.0 )THEN GWSATN3B.241
X_S_CONST(I) = 0.0 GWSATN3B.242
Y_S_CONST(I) = 0.0 GWSATN3B.243
ELSE GWSATN3B.244
Y_S_CONST(I) = KAY*ALPHA*GAMMA_SQ/ GWSATN3B.245
* (BETA*SD_OROG(I)*SD_OROG(I)*S_STRESS_SQ*S_STRESS) GWSATN3B.246
X_S_CONST(I) = Y_S_CONST(I)*S_X_OROG(I) GWSATN3B.247
Y_S_CONST(I) = Y_S_CONST(I)*S_Y_OROG(I) GWSATN3B.248
GWSATN3B.249
GWSATN3B.250
ENDIF GWSATN3B.251
GWSATN3B.252
END DO GWSATN3B.253
GWSATN3B.254
IF( STRESS_UD_ON ) THEN GWSATN3B.255
DO I=1,POINTS GWSATN3B.256
IF( H_JUMP(I) ) THEN GWSATN3B.257
STRESS_UD(I,H_O_LEV(I)) = X_STRESS(I,KL) GWSATN3B.258
ELSE GWSATN3B.259
STRESS_UD(I,START_L) = X_STRESS(I,KL) GWSATN3B.260
ENDIF GWSATN3B.261
END DO GWSATN3B.262
ENDIF GWSATN3B.263
GWSATN3B.264
IF( STRESS_VD_ON ) THEN GWSATN3B.265
DO I=1,POINTS GWSATN3B.266
IF( H_JUMP(I) ) THEN GWSATN3B.267
STRESS_VD(I,H_O_LEV(I)) = Y_STRESS(I,KL) GWSATN3B.268
ELSE GWSATN3B.269
STRESS_VD(I,START_L) = Y_STRESS(I,KL) GWSATN3B.270
ENDIF GWSATN3B.271
END DO GWSATN3B.272
ENDIF GWSATN3B.273
GWSATN3B.274
!------------------------------------------------------------------ GWSATN3B.275
! 2 LOOP LEVELS GWSATN3B.276
!------------------------------------------------------------------ GWSATN3B.277
GWSATN3B.278
DO K=START_L+1,LEVELS GWSATN3B.279
GWSATN3B.280
GWSATN3B.281
DO I=1,POINTS GWSATN3B.282
GWSATN3B.283
X_STRESS(I,KU) = X_STRESS(I,KL) GWSATN3B.284
Y_STRESS(I,KU) = Y_STRESS(I,KL) GWSATN3B.285
GWSATN3B.286
IF( K .EQ. START_L+1 ) THEN GWSATN3B.287
DELTA_P = DELTA_AK_SUM+DELTA_BK_SUM*PSTAR(I) GWSATN3B.288
ELSE GWSATN3B.289
DELTA_P = DELTA_AK(K-1)+DELTA_BK(K-1)*PSTAR(I) GWSATN3B.290
END IF GWSATN3B.291
GWSATN3B.292
IF( (.NOT.H_JUMP(I)) .OR. K.GT.H_O_LEV(I) ) THEN GWSATN3B.293
GWSATN3B.294
IF( (X_STRESS(I,KL) .NE. 0.0) GWSATN3B.295
* .OR.(Y_STRESS(I,KL) .NE. 0.0) ) THEN GWSATN3B.296
GWSATN3B.297
PU=PSTAR(I)*BKH(K+1) + AKH(K+1) GWSATN3B.298
PL=PSTAR(I)*BKH(K) + AKH(K) GWSATN3B.299
P_EXNER_CENTRE= GWSATN3B.300
& P_EXNER_C( PEXNER(I,K+1),PEXNER(I,K),PU,PL,KAPPA) GWSATN3B.301
GWSATN3B.302
! lower half height of upper layer GWSATN3B.303
DZ(I,KU) = (PEXNER(I,K) - P_EXNER_CENTRE)*THETA(I,K) GWSATN3B.304
* *CPBYG GWSATN3B.305
! upper half height of upper layer GWSATN3B.306
DZ(I,KT) = (P_EXNER_CENTRE - PEXNER(I,K+1))*THETA(I,K) GWSATN3B.307
* *CPBYG GWSATN3B.308
! model level height difference GWSATN3B.309
DZB = DZ(I,KU) + DZ(I,KL) GWSATN3B.310
UB = (DZ(I,KU)*U(I,K-1)+DZ(I,KL)*U(I,K)) / DZB GWSATN3B.311
VB = (DZ(I,KU)*V(I,K-1)+DZ(I,KL)*V(I,K)) / DZB GWSATN3B.312
T(I,KU) = P_EXNER_CENTRE*THETA(I,K) GWSATN3B.313
TB = (DZ(I,KU)*T(I,KL) + DZ(I,KL)*T(I,KU))/DZB GWSATN3B.314
RHO = ( AKH(K) + BKH(K)*PSTAR(I) )/(R*TB) GWSATN3B.315
GWSATN3B.316
!------------------------------------------------------------------ GWSATN3B.317
! 2.2 CALCULATE BRUNT-VAISALA FREQUENCY GWSATN3B.318
!------------------------------------------------------------------ GWSATN3B.319
GWSATN3B.320
N_SQ = G*( THETA(I,K) - THETA(I,K-1) )*PEXNER(I,K)/ GWSATN3B.321
* ( TB*DZB ) GWSATN3B.322
GWSATN3B.323
IF( N_SQ .LE. 0.0 ) THEN GWSATN3B.324
! SET STRESS TO ZERO IF UNSTABLE GWSATN3B.325
N_SQ = 0.0 GWSATN3B.326
X_STRESS(I,KU) = 0.0 GWSATN3B.327
Y_STRESS(I,KU) = 0.0 GWSATN3B.328
ELSE GWSATN3B.329
N = SQRT( N_SQ ) GWSATN3B.330
SPEEDCALC = UB*S_X_STRESS(I) + VB*S_Y_STRESS(I) GWSATN3B.331
C_Y_STRESS = (SPEEDCALC**3)*RHO/N GWSATN3B.332
C_X_STRESS = X_S_CONST(I)*C_Y_STRESS GWSATN3B.333
C_Y_STRESS = Y_S_CONST(I)*C_Y_STRESS GWSATN3B.334
GWSATN3B.335
!------------------------------------------------------------------ GWSATN3B.336
! 2.3 CALCULATE CRITICAL STRESS FOR GWSATN3B.337
! EACH COMPONENT (EQN 6) GWSATN3B.338
! TEST FOR WAVE-BREAKING GWSATN3B.339
! AND MODIFY STRESS AT UPPER LAYER BOUNDARY GWSATN3B.340
!------------------------------------------------------------------ GWSATN3B.341
GWSATN3B.342
IF( X_STRESS(I,KL) .GT. 0.0 ) THEN GWSATN3B.343
IF( C_X_STRESS .LT. 0.0 ) THEN GWSATN3B.344
C_X_STRESS = 0.0 GWSATN3B.345
ENDIF GWSATN3B.346
GWSATN3B.347
IF( C_X_STRESS .LT. X_STRESS(I,KU) ) THEN GWSATN3B.348
X_STRESS(I,KU) = C_X_STRESS GWSATN3B.349
ENDIF GWSATN3B.350
ENDIF GWSATN3B.351
IF( X_STRESS(I,KL) .LT. 0.0 ) THEN GWSATN3B.352
IF( C_X_STRESS .GT. 0.0 ) THEN GWSATN3B.353
C_X_STRESS = 0.0 GWSATN3B.354
ENDIF GWSATN3B.355
GWSATN3B.356
IF( C_X_STRESS .GT. X_STRESS(I,KU) ) THEN GWSATN3B.357
X_STRESS(I,KU) = C_X_STRESS GWSATN3B.358
ENDIF GWSATN3B.359
ENDIF GWSATN3B.360
GWSATN3B.361
IF( Y_STRESS(I,KL) .GT. 0.0 ) THEN GWSATN3B.362
IF( C_Y_STRESS .LT. 0.0 ) THEN GWSATN3B.363
C_Y_STRESS = 0.0 GWSATN3B.364
ENDIF GWSATN3B.365
GWSATN3B.366
IF( C_Y_STRESS .LT. Y_STRESS(I,KU) ) THEN GWSATN3B.367
Y_STRESS(I,KU) = C_Y_STRESS GWSATN3B.368
ENDIF GWSATN3B.369
ENDIF GWSATN3B.370
IF( Y_STRESS(I,KL) .LT. 0.0 ) THEN GWSATN3B.371
IF( C_Y_STRESS .GT. 0.0 ) THEN GWSATN3B.372
C_Y_STRESS = 0.0 GWSATN3B.373
ENDIF GWSATN3B.374
GWSATN3B.375
IF( C_Y_STRESS .GT. Y_STRESS(I,KU) ) THEN GWSATN3B.376
Y_STRESS(I,KU) = C_Y_STRESS GWSATN3B.377
ENDIF GWSATN3B.378
ENDIF GWSATN3B.379
GWSATN3B.380
END IF ! (N_SQ < 0) ELSE N_SQ > 0 GWSATN3B.381
GWSATN3B.382
END IF ! STRESS X OR Y NE 0 GWSATN3B.383
GWSATN3B.384
END IF ! no jump or above jump height GWSATN3B.385
GWSATN3B.386
!------------------------------------------------------------------ GWSATN3B.387
! 2.4 CALCULATE DRAG FROM VERTICAL STRESS CONVERGENCE GWSATN3B.388
! AND ACCELERATIONS FOR WIND COMPONENTS GWSATN3B.389
!------------------------------------------------------------------ GWSATN3B.390
GWSATN3B.391
DU_DT(I,K-1) = G*(X_STRESS(I,KL) - X_STRESS(I,KU))/DELTA_P GWSATN3B.392
DV_DT(I,K-1) = G*(Y_STRESS(I,KL) - Y_STRESS(I,KU))/DELTA_P GWSATN3B.393
GWSATN3B.394
END DO GWSATN3B.395
GWSATN3B.396
! Diagnostics GWSATN3B.397
IF( STRESS_UD_ON ) THEN GWSATN3B.398
DO I=1,POINTS GWSATN3B.399
STRESS_UD(I,K) = X_STRESS(I,KU) GWSATN3B.400
END DO GWSATN3B.401
ENDIF GWSATN3B.402
GWSATN3B.403
IF( STRESS_VD_ON ) THEN GWSATN3B.404
DO I=1,POINTS GWSATN3B.405
STRESS_VD(I,K) = Y_STRESS(I,KU) GWSATN3B.406
END DO GWSATN3B.407
ENDIF GWSATN3B.408
GWSATN3B.409
IF( DU_DT_SATN_ON ) THEN GWSATN3B.410
DO I=1,POINTS GWSATN3B.411
DU_DT_SATN(I,K-1) = DU_DT(I,K-1) GWSATN3B.412
END DO GWSATN3B.413
ENDIF GWSATN3B.414
GWSATN3B.415
IF( DV_DT_SATN_ON ) THEN GWSATN3B.416
DO I=1,POINTS GWSATN3B.417
DV_DT_SATN(I,K-1) = DV_DT(I,K-1) GWSATN3B.418
END DO GWSATN3B.419
ENDIF GWSATN3B.420
GWSATN3B.421
! Swap storage for lower and upper layers GWSATN3B.422
KK=KL GWSATN3B.423
KL=KU GWSATN3B.424
KU=KK GWSATN3B.425
GWSATN3B.426
! Replace top half height of lower layer ready for next pass GWSATN3B.427
DO I=1,POINTS GWSATN3B.428
DZ(I,KL)=DZ(I,KT) GWSATN3B.429
END DO GWSATN3B.430
GWSATN3B.431
END DO GWSATN3B.432
! END LOOP LEVELS GWSATN3B.433
GWSATN3B.434
! GWSATN3B.435
!------------------------------------------------------------------ GWSATN3B.436
! 3.0 TOP OF MODEL. SET ACCELERATION SAME AS PENULTIMATE LAYER GWSATN3B.437
! WITH PROVISO THAT STRESS COMPONENTS DO NOT PASS THROUGH 0 GWSATN3B.438
!------------------------------------------------------------------ GWSATN3B.439
GWSATN3B.440
DO I=1,POINTS GWSATN3B.441
DELTA_P = DELTA_AK(LEVELS) + DELTA_BK(LEVELS)*PSTAR(I) GWSATN3B.442
GWSATN3B.443
X_STRESS(I,KU) = X_STRESS(I,KL) - DU_DT(I,LEVELS-1)*DELTA_P/G GWSATN3B.444
IF( (X_STRESS(I,KU).LT.0.0) .AND. (X_STRESS(I,KL).GT.0.0) ) GWSATN3B.445
& X_STRESS(I,KU) = 0.0 GWSATN3B.446
IF( (X_STRESS(I,KU).GT.0.0) .AND. (X_STRESS(I,KL).LT.0.0) ) GWSATN3B.447
& X_STRESS(I,KU) = 0.0 GWSATN3B.448
GWSATN3B.449
Y_STRESS(I,KU) = Y_STRESS(I,KL) - DV_DT(I,LEVELS-1)*DELTA_P/G GWSATN3B.450
IF( (Y_STRESS(I,KU).LT.0.0) .AND. (Y_STRESS(I,KL).GT.0.0) ) GWSATN3B.451
& Y_STRESS(I,KU) = 0.0 GWSATN3B.452
IF( (Y_STRESS(I,KU).GT.0.0) .AND. (Y_STRESS(I,KL).LT.0.0) ) GWSATN3B.453
& Y_STRESS(I,KU) = 0.0 GWSATN3B.454
GWSATN3B.455
DU_DT(I,LEVELS) = G*(X_STRESS(I,KL) - X_STRESS(I,KU))/DELTA_P GWSATN3B.456
DV_DT(I,LEVELS) = G*(Y_STRESS(I,KL) - Y_STRESS(I,KU))/DELTA_P GWSATN3B.457
GWSATN3B.458
END DO GWSATN3B.459
GWSATN3B.460
! Diagnostics GWSATN3B.461
IF( STRESS_UD_ON ) THEN GWSATN3B.462
DO I=1,POINTS GWSATN3B.463
STRESS_UD(I,LEVELS+1) = X_STRESS(I,KU) GWSATN3B.464
END DO GWSATN3B.465
ENDIF GWSATN3B.466
GWSATN3B.467
IF( STRESS_VD_ON ) THEN GWSATN3B.468
DO I=1,POINTS GWSATN3B.469
STRESS_VD(I,LEVELS+1) = Y_STRESS(I,KU) GWSATN3B.470
END DO GWSATN3B.471
ENDIF GWSATN3B.472
GWSATN3B.473
IF( DU_DT_SATN_ON ) THEN GWSATN3B.474
DO I=1,POINTS GWSATN3B.475
DU_DT_SATN(I,LEVELS) = DU_DT(I,LEVELS) GWSATN3B.476
END DO GWSATN3B.477
ENDIF GWSATN3B.478
GWSATN3B.479
IF( DV_DT_SATN_ON ) THEN GWSATN3B.480
DO I=1,POINTS GWSATN3B.481
DV_DT_SATN(I,LEVELS) = DV_DT(I,LEVELS) GWSATN3B.482
END DO GWSATN3B.483
ENDIF GWSATN3B.484
GWSATN3B.485
RETURN GWSATN3B.486
END GWSATN3B.487
GWSATN3B.488
*ENDIF GWSATN3B.489