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