SUBROUTINE GW_JUMP 2GWJUMP3A.5
1 (PSTAR,PEXNER,S_X_STRESS,S_Y_STRESS,START_L,LEVELS GWJUMP3A.6
2 ,POINTS,AKH,BKH,DELTA_AK,DELTA_BK,H_O_LEV,H_JUMP GWJUMP3A.7
3 ,H_CRIT,DU_DT,DV_DT GWJUMP3A.8
! Diagnostics GWJUMP3A.9
4 ,STRESS_UD,POINTS_STRESS_UD,STRESS_UD_ON GWJUMP3A.10
5 ,STRESS_VD,POINTS_STRESS_VD,STRESS_VD_ON GWJUMP3A.11
6 ,DU_DT_JUMP,POINTS_DU_DT_JUMP,DU_DT_JUMP_ON GWJUMP3A.12
7 ,DV_DT_JUMP,POINTS_DV_DT_JUMP,DV_DT_JUMP_ON ) GWJUMP3A.13
GWJUMP3A.14
IMPLICIT NONE GWJUMP3A.15
! Description: GWJUMP3A.16
! TO CALCULATE STRESS PROFILE DUE TO SUBGRID-SCALE GWJUMP3A.17
! OROGRAPHIC GRAVITY WAVES FOR HIGH DRAG HYDRAULIC JUMP GWJUMP3A.18
! STATES OR IF CRITICAL LAYER FOUND WITHIN JUMP. GWJUMP3A.19
! STRESS AND DRAG LINEARISED WITH PRESSURE UPTO JUMP/ GWJUMP3A.20
! CRITICAL HEIGHT FROM STARTING LEVEL. GWJUMP3A.21
! GWJUMP3A.22
! Method: UNIFIED MODEL DOCUMENTATION PAPER NO. ? GWJUMP3A.23
! THE EQUATIONS USED ARE (???) TO (???) GWJUMP3A.24
! GWJUMP3A.25
! Current code owner: S.Webster ASW1F403.48
! GWJUMP3A.27
! History: GWJUMP3A.28
! Version Date Comment GWJUMP3A.29
! 3.4 18/10/94 Original Code. J.R.Mitchell GWJUMP3A.30
! 4.4 19/09/97 Remove *IF -DEF,CRAY compile options. S.Webster ASW1F404.10
! GWJUMP3A.31
! Code Description: GWJUMP3A.32
! Language: Fortran 77 + common extensions GWJUMP3A.33
! This code is written to UMDP3 v6 programming standards. GWJUMP3A.34
! System component covered: ORIGINAL VERSION FOR CRAY Y-MP GWJUMP3A.35
! System task covered: PART OF P22 GWJUMP3A.36
! SUITABLE FOR SINGLE COLUMN USE,ROTATED GRIDS GWJUMP3A.37
! FURTHER ALTERATIONS MAY BE REQUIRED FOR AUTOTASKING EFFICIENCY GWJUMP3A.38
GWJUMP3A.39
! Global Variables GWJUMP3A.40
*CALL C_G 
GWJUMP3A.41
*CALL C_R_CP GWJUMP3A.42
! Local constants GWJUMP3A.43
*CALL C_GWAVE GWJUMP3A.44
! Subroutine arguements; GWJUMP3A.45
INTEGER GWJUMP3A.46
* LEVELS !IN NUMBER OF MODEL LEVELS GWJUMP3A.47
*,START_L !IN START LEVEL FOR WAVE-BREAKING TEST GWJUMP3A.48
*,POINTS !IN NUMBER OF POINTS GWJUMP3A.49
*,POINTS_STRESS_UD !IN ) No of land points in diagnostic GWJUMP3A.50
*,POINTS_STRESS_VD !IN ) arrays for GW stress - u and v GWJUMP3A.51
*,POINTS_DU_DT_JUMP !IN ) No of land points in diagnostic GWJUMP3A.52
*,POINTS_DV_DT_JUMP !IN ) arrays for GW satn - du and dv GWJUMP3A.53
*,H_O_LEV(POINTS) !IN LEVEL OF CRITICAL/JUMP HEIGHT GWJUMP3A.54
GWJUMP3A.55
LOGICAL GWJUMP3A.56
* H_JUMP(POINTS) !IN TRUE IF POINT IS TO BE LINEARIZED GWJUMP3A.57
*,H_CRIT(POINTS) !IN TRUE IF CRITICAL HEIGHT BEFORE JUMP GWJUMP3A.58
*,STRESS_UD_ON !U stress diagnostic switch GWJUMP3A.59
*,STRESS_VD_ON !V stress diagnostic switch GWJUMP3A.60
*,DU_DT_JUMP_ON !U accel (hydr jump) diagnostic switch GWJUMP3A.61
*,DV_DT_JUMP_ON !V accel (hydr jump) diagnostic switch GWJUMP3A.62
GWJUMP3A.63
REAL GWJUMP3A.64
* PSTAR(POINTS) !IN PSTAR FIELD GWJUMP3A.65
*,PEXNER(POINTS,LEVELS+1) !IN PEXNER GWJUMP3A.66
*,S_X_STRESS(POINTS) !IN 'SURFACE' X_STRESS GWJUMP3A.67
*,S_Y_STRESS(POINTS) !IN 'SURFACE' Y_STRESS GWJUMP3A.68
! AKH,BKH DEFINE HYBRID VERTICAL COORDINATES P=A+BP*-LAYER EDGES, GWJUMP3A.69
! DELTA_AK,DELTA_BK DEFINE PRESSURE DIFFERENCES ACROSS LAYERS GWJUMP3A.70
*,AKH(LEVELS+1) !IN VALUE AT LAYER BOUNDARY GWJUMP3A.71
*,BKH(LEVELS+1) !IN VALUE AT LAYER BOUMDARY GWJUMP3A.72
*,DELTA_AK(LEVELS) !IN DIFFERENCE ACROSS LAYER GWJUMP3A.73
*,DELTA_BK(LEVELS) !IN DIFFERENCE ACROSS LAYER GWJUMP3A.74
*,DU_DT(POINTS,LEVELS) !OUT U-ACCELERATION GWJUMP3A.75
*,DV_DT(POINTS,LEVELS) !OUT V-ACCELERATION GWJUMP3A.76
! Diagnostics GWJUMP3A.77
REAL GWJUMP3A.78
* DU_DT_JUMP(POINTS_DU_DT_JUMP,LEVELS) !U-ACCELN DIAGNOSTIC GWJUMP3A.79
*,DV_DT_JUMP(POINTS_DV_DT_JUMP,LEVELS) !V-ACCELN DIAGNOSTIC GWJUMP3A.80
*,STRESS_UD(POINTS_STRESS_UD,LEVELS+1) !U STRESS DIAGNOSTIC GWJUMP3A.81
*,STRESS_VD(POINTS_STRESS_VD,LEVELS+1) !V STRESS DIAGNOSTIC GWJUMP3A.82
GWJUMP3A.83
! Local parameters GWJUMP3A.84
REAL CPBYG GWJUMP3A.85
PARAMETER(CPBYG=CP/G) GWJUMP3A.86
GWJUMP3A.87
! Local scalers GWJUMP3A.88
REAL GWJUMP3A.89
* DELTA_P ! DIFFERENCE IN PRESSURE ACROSS LAYER(S) GWJUMP3A.90
*,DELTA_AK_SUM ! DELTA_AK SUMMED OVER LOWEST LAYERS UP TO START_L GWJUMP3A.91
*,DELTA_BK_SUM ! DELTA_BK SUMMED OVER LOWEST LAYERS UP TO START_L GWJUMP3A.92
*,PU,PL GWJUMP3A.93
INTEGER I,K ! LOOP COUNTER IN ROUTINE GWJUMP3A.94
INTEGER KK,KL,KU,KT ! LEVEL COUNTERS IN ROUTINE GWJUMP3A.95
GWJUMP3A.96
! Local dynamic arrays GWJUMP3A.97
! LOCAL WORKSPACE ARRAYS: 6 ARRAYS OF FULL FIELD LENGTH GWJUMP3A.98
! GWJUMP3A.99
GWJUMP3A.103
REAL GWJUMP3A.104
* X_STRESS(POINTS,2) ! X_STRESSES (LAYER BOUNDARIES) GWJUMP3A.105
*,Y_STRESS(POINTS,2) ! Y_STRESSES (LAYER BOUNDARIES) GWJUMP3A.106
*,DP_X_STRESS(POINTS) ! STRESS GRADIENT GWJUMP3A.107
* ! SURFACE X_STRESS GWJUMP3A.108
*,DP_Y_STRESS(POINTS) ! STRESS GRADIENT GWJUMP3A.109
* ! SURFACE Y_STRESS GWJUMP3A.110
GWJUMP3A.112
! Function and subroutine calls GWJUMP3A.113
*CALL P_EXNERC GWJUMP3A.114
GWJUMP3A.115
!------------------------------------------------------------------- GWJUMP3A.116
! 1. START LEVEL PRELIMINARIES GWJUMP3A.117
!------------------------------------------------------------------- GWJUMP3A.118
GWJUMP3A.119
CFPP$ NOCONCUR L GWJUMP3A.120
! TREAT LAYERS BELOW AND INCLUDING START_L AS ONE LAYER GWJUMP3A.121
DELTA_AK_SUM = 0.0 GWJUMP3A.122
DELTA_BK_SUM = 0.0 GWJUMP3A.123
DO K=2,START_L GWJUMP3A.124
DELTA_AK_SUM = DELTA_AK_SUM + DELTA_AK(K) GWJUMP3A.125
DELTA_BK_SUM = DELTA_BK_SUM + DELTA_BK(K) GWJUMP3A.126
END DO GWJUMP3A.127
CFPP$ CONCUR GWJUMP3A.128
GWJUMP3A.129
KL=1 GWJUMP3A.130
KU=2 GWJUMP3A.131
KT=3 GWJUMP3A.132
GWJUMP3A.133
DO I=1,POINTS GWJUMP3A.134
IF( H_JUMP(I) ) THEN GWJUMP3A.135
GWJUMP3A.136
PU=PSTAR(I)*BKH(H_O_LEV(I)) + AKH(H_O_LEV(I)) GWJUMP3A.137
PL=PSTAR(I)*BKH(START_L) + AKH(START_L) GWJUMP3A.138
DELTA_P= PL - PU GWJUMP3A.139
GWJUMP3A.140
IF( H_CRIT(I) ) THEN GWJUMP3A.141
DP_X_STRESS(I) = S_X_STRESS(I)/ ( DELTA_P ) GWJUMP3A.142
DP_Y_STRESS(I) = S_Y_STRESS(I)/ ( DELTA_P ) GWJUMP3A.143
ELSE GWJUMP3A.144
DP_X_STRESS(I) = 0.6666667*S_X_STRESS(I)/ GWJUMP3A.145
& ( DELTA_P ) GWJUMP3A.146
DP_Y_STRESS(I) = 0.6666667*S_Y_STRESS(I)/ GWJUMP3A.147
& ( DELTA_P ) GWJUMP3A.148
ENDIF GWJUMP3A.149
GWJUMP3A.150
ENDIF ! if H_JUMP GWJUMP3A.151
GWJUMP3A.152
END DO ! Points GWJUMP3A.153
GWJUMP3A.154
IF( STRESS_UD_ON ) THEN GWJUMP3A.155
DO I=1,POINTS GWJUMP3A.156
IF( H_JUMP(I) ) THEN GWJUMP3A.157
X_STRESS(I,KL) = S_X_STRESS(I) GWJUMP3A.158
STRESS_UD(I,START_L) = X_STRESS(I,KL) GWJUMP3A.159
ENDIF GWJUMP3A.160
END DO GWJUMP3A.161
ENDIF GWJUMP3A.162
GWJUMP3A.163
IF( STRESS_VD_ON ) THEN GWJUMP3A.164
DO I=1,POINTS GWJUMP3A.165
IF( H_JUMP(I) ) THEN GWJUMP3A.166
Y_STRESS(I,KL) = S_Y_STRESS(I) GWJUMP3A.167
STRESS_VD(I,START_L) = Y_STRESS(I,KL) GWJUMP3A.168
ENDIF GWJUMP3A.169
END DO GWJUMP3A.170
ENDIF GWJUMP3A.171
GWJUMP3A.172
!------------------------------------------------------------------ GWJUMP3A.173
! 2 LOOP LEVELS GWJUMP3A.174
!------------------------------------------------------------------ GWJUMP3A.175
GWJUMP3A.176
DO K=START_L+1,LEVELS GWJUMP3A.177
GWJUMP3A.178
GWJUMP3A.179
DO I=1,POINTS GWJUMP3A.180
IF( H_JUMP(I) .AND. K.LE.H_O_LEV(I) ) THEN GWJUMP3A.181
GWJUMP3A.182
IF( K .EQ. START_L+1 ) THEN GWJUMP3A.183
DELTA_P =(DELTA_AK(START_L)+DELTA_BK(START_L)*PSTAR(I)) GWJUMP3A.184
& /( DELTA_AK_SUM +DELTA_BK_SUM*PSTAR(I) ) GWJUMP3A.185
DU_DT(I,START_L) = - G*DP_X_STRESS(I)*DELTA_P GWJUMP3A.186
DV_DT(I,START_L) = - G*DP_Y_STRESS(I)*DELTA_P GWJUMP3A.187
ELSE GWJUMP3A.188
DU_DT(I,K-1) = - G*DP_X_STRESS(I) GWJUMP3A.189
DV_DT(I,K-1) = - G*DP_Y_STRESS(I) GWJUMP3A.190
ENDIF GWJUMP3A.191
GWJUMP3A.192
ENDIF ! if H_JUMP(I) .and. K<=H_O_LEV(I) GWJUMP3A.193
GWJUMP3A.194
END DO ! points GWJUMP3A.195
GWJUMP3A.196
! Diagnostics GWJUMP3A.197
IF( DU_DT_JUMP_ON ) THEN GWJUMP3A.198
DO I=1,POINTS GWJUMP3A.199
IF( H_JUMP(I) .AND. K.LE.H_O_LEV(I) ) THEN GWJUMP3A.200
DU_DT_JUMP(I,K-1) = DU_DT(I,K-1) GWJUMP3A.201
ENDIF GWJUMP3A.202
END DO GWJUMP3A.203
ENDIF GWJUMP3A.204
GWJUMP3A.205
IF( DV_DT_JUMP_ON ) THEN GWJUMP3A.206
DO I=1,POINTS GWJUMP3A.207
IF( H_JUMP(I) .AND. K.LE.H_O_LEV(I) ) THEN GWJUMP3A.208
DV_DT_JUMP(I,K-1) = DV_DT(I,K-1) GWJUMP3A.209
ENDIF GWJUMP3A.210
END DO GWJUMP3A.211
ENDIF GWJUMP3A.212
GWJUMP3A.213
IF( STRESS_UD_ON ) THEN GWJUMP3A.214
DO I=1,POINTS GWJUMP3A.215
IF( H_JUMP(I) .AND. K.LE.H_O_LEV(I) ) THEN GWJUMP3A.216
DELTA_P = DELTA_AK(K-1)+DELTA_BK(K-1)*PSTAR(I) GWJUMP3A.217
X_STRESS(I,KU) = X_STRESS(I,KL) GWJUMP3A.218
! Stress at upper boundary N.B. DELTA_P is -VE GWJUMP3A.219
X_STRESS(I,KU) = X_STRESS(I,KL)+DP_X_STRESS(I)*DELTA_P GWJUMP3A.220
STRESS_UD(I,K) = X_STRESS(I,KU) GWJUMP3A.221
! Top of model. Set acceln same as penultimate layer if stress >0 GWJUMP3A.222
! FOR COMPLETION- TOP LEVEL NEVER REACHED IN H_JUMP GWJUMP3A.223
IF( K .EQ. LEVELS ) THEN GWJUMP3A.224
DELTA_P = DELTA_AK(LEVELS) + DELTA_BK(LEVELS)*PSTAR(I) GWJUMP3A.225
X_STRESS(I,KL) = X_STRESS(I,KU) - DU_DT(I,LEVELS-1) GWJUMP3A.226
* *DELTA_P/G GWJUMP3A.227
IF( X_STRESS(I,KL) .LT. 0.0) X_STRESS(I,KL) = 0.0 GWJUMP3A.228
DU_DT(I,LEVELS) = G*(X_STRESS(I,KU) - X_STRESS(I,KL)) GWJUMP3A.229
* /DELTA_P GWJUMP3A.230
STRESS_UD(I,LEVELS+1) = X_STRESS(I,KL) GWJUMP3A.231
ENDIF ! top of model GWJUMP3A.232
ENDIF ! H_Jump & K < H_O_Lev GWJUMP3A.233
END DO GWJUMP3A.234
ENDIF ! Stress_ud on GWJUMP3A.235
GWJUMP3A.236
IF( STRESS_VD_ON ) THEN GWJUMP3A.237
DO I=1,POINTS GWJUMP3A.238
IF( H_JUMP(I) .AND. K.LE.H_O_LEV(I) ) THEN GWJUMP3A.239
DELTA_P = DELTA_AK(K-1)+DELTA_BK(K-1)*PSTAR(I) GWJUMP3A.240
Y_STRESS(I,KU) = Y_STRESS(I,KL) GWJUMP3A.241
! Stress at upper boundary N.B. DELTA_P is -VE GWJUMP3A.242
Y_STRESS(I,KU) = Y_STRESS(I,KL)+DP_Y_STRESS(I)*DELTA_P GWJUMP3A.243
STRESS_VD(I,K) = Y_STRESS(I,KU) GWJUMP3A.244
! Top of model. Set acceln same as penultimate layer if stress >0 GWJUMP3A.245
! FOR COMPLETION- TOP LEVEL NEVER REACHED IN H_JUMP GWJUMP3A.246
IF( K .EQ. LEVELS ) THEN GWJUMP3A.247
DELTA_P = DELTA_AK(LEVELS) + DELTA_BK(LEVELS)*PSTAR(I) GWJUMP3A.248
Y_STRESS(I,KL) = Y_STRESS(I,KU) - DV_DT(I,LEVELS-1) GWJUMP3A.249
* *DELTA_P/G GWJUMP3A.250
IF( Y_STRESS(I,KL) .LT. 0.0) Y_STRESS(I,KL) = 0.0 GWJUMP3A.251
DV_DT(I,LEVELS) = G*(Y_STRESS(I,KU) - Y_STRESS(I,KL)) GWJUMP3A.252
* /DELTA_P GWJUMP3A.253
STRESS_VD(I,LEVELS+1) = Y_STRESS(I,KL) GWJUMP3A.254
ENDIF ! top of model GWJUMP3A.255
ENDIF ! H_Jump & K < H_O_Lev GWJUMP3A.256
END DO GWJUMP3A.257
ENDIF ! Stress_vd on GWJUMP3A.258
GWJUMP3A.259
! Swap storage for lower and upper layers GWJUMP3A.260
KK=KL GWJUMP3A.261
KL=KU GWJUMP3A.262
KU=KK GWJUMP3A.263
GWJUMP3A.264
END DO GWJUMP3A.265
! END LOOP LEVELS GWJUMP3A.266
GWJUMP3A.267
RETURN GWJUMP3A.268
END GWJUMP3A.269
GWJUMP3A.270
*ENDIF GWJUMP3A.271