*IF DEF,A06_1A,OR,DEF,A06_2A GWSURF1A.2
C ******************************COPYRIGHT****************************** GTS2F400.3691
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3692
C GTS2F400.3693
C Use, duplication or disclosure of this code is subject to the GTS2F400.3694
C restrictions as set forth in the contract. GTS2F400.3695
C GTS2F400.3696
C Meteorological Office GTS2F400.3697
C London Road GTS2F400.3698
C BRACKNELL GTS2F400.3699
C Berkshire UK GTS2F400.3700
C RG12 2SZ GTS2F400.3701
C GTS2F400.3702
C If no contract has been raised with this copy of the code, the use, GTS2F400.3703
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3704
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3705
C Modelling at the above address. GTS2F400.3706
C ******************************COPYRIGHT****************************** GTS2F400.3707
C GTS2F400.3708
CLL SUBROUTINE GW_SURF------------------------------------------ GWSURF1A.3
CLL GWSURF1A.4
CLL PURPOSE: TO CALCULATE 'SURFACE' STRESS DUE TO SUBGRID-SCALE GWSURF1A.5
CLL OROGRAPHIC GRAVITY WAVES. GWSURF1A.6
CLL THE SURFACE STRESS IS CALCULATED FROM THE VARIANCE OF GWSURF1A.7
CLL THE OROGRAPHY.THE MAXIMUM WAVE AMPLITUDE IS EITHER GWSURF1A.8
CLL LIMITED BY A LIMIT TO THE S.D. OF THE OROGRAPHY OR GWSURF1A.9
CLL BY THE FROUDE NUMBER RESTRICTED TO < OR = 1 GWSURF1A.10
CLL SUITABLE FOR SINGLE COLUMN USE GWSURF1A.11
CLL GWSURF1A.12
CLL SUITABLE FOR ROTATED GRIDS GWSURF1A.13
CLL GWSURF1A.14
CLL FURTHER ALTERATIONS MAY BE REQUIRED FOR AUTOTASKING EFFICIENCY GWSURF1A.15
CLL PROGRAMMING STANDARD: UNIFIED MODEL DOCUMENTATION PAPER NO. 4, GWSURF1A.16
CLL VERSION 1, DATED 12/09/89 GWSURF1A.17
CLL GWSURF1A.18
CLL SYSTEM TASK: PART OF P22 GWSURF1A.19
CLL GWSURF1A.20
CLL C.WILSON <- PROGRAMMER OF SOME OR ALL OF PREVIOUS CODE OR CHANGES GWSURF1A.21
CLL D.GREGORY <- PROGRAMMER OF SOME OR ALL OF PREVIOUS CODE OR CHANGES GWSURF1A.22
CLL GWSURF1A.23
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: GWSURF1A.24
CLL VERSION DATE GWSURF1A.25
CLL 3.4 12/04/94 DEF FROUDE replaced by LOGICAL LFROUDE GSS1F304.69
CLL S.J.Swarbrick GSS1F304.70
CLL GWSURF1A.26
CLL DOCUMENTATION: THE EQUATIONS USED ARE (2.2) TO (2.5) GWSURF1A.27
CLL IN UNIFIED MODEL DOCUMENTATION PAPER NO 22 GWSURF1A.28
CLL C. A. WILSON AND R. SWINBANK GWSURF1A.29
CLL VERSION 1,DATED 15/12/89 GWSURF1A.30
CLLEND------------------------------------------------------------- GWSURF1A.31
GWSURF1A.32
C GWSURF1A.33
C*L ARGUMENTS:--------------------------------------------------- GWSURF1A.34
SUBROUTINE GW_SURF 2GWSURF1A.35
1 (PSTAR,PEXNER,THETA,U,V,SD_OROG,S_STRESS,LEVELS,POINTS, GWSURF1A.36
2 AK,BK,AKH,BKH,KAY,SIN_A,COS_A,LFROUDE) GSS1F304.71
GWSURF1A.38
IMPLICIT NONE GWSURF1A.39
GWSURF1A.40
INTEGER GWSURF1A.41
* LEVELS !IN NUMBER OF MODEL LEVELS GWSURF1A.42
*,POINTS !IN NUMBER OF POINTS GWSURF1A.43
C GWSURF1A.44
GWSURF1A.45
REAL GWSURF1A.46
* PSTAR(POINTS) !IN PSTAR FIELD GWSURF1A.47
*,PEXNER(POINTS,LEVELS+1) !IN PEXNER GWSURF1A.48
*,THETA(POINTS,LEVELS) !IN THETA FIELD GWSURF1A.49
*,U(POINTS,LEVELS) !IN U FIELD GWSURF1A.50
*,V(POINTS,LEVELS) !IN V FIELD GWSURF1A.51
C AK,BK DEFINE HYBRID VERTICAL COORDINATES P=A+BP*, GWSURF1A.52
REAL GWSURF1A.53
* AK (LEVELS) !IN VALUE AT LAYER CENTRE GWSURF1A.54
*,BK (LEVELS) !IN VALUE AT LAYER CENTRE GWSURF1A.55
*,AKH(LEVELS+1) !IN VALUE AT LAYER boundary GWSURF1A.56
*,BKH(LEVELS+1) !IN VALUE AT LAYER boundary GWSURF1A.57
*,KAY !IN surface stress constant (m-1) GWSURF1A.58
*,SD_OROG(POINTS) !IN STANDARD DEVIATION OF OROGRAPHY GWSURF1A.59
*,S_STRESS(POINTS) !OUT 'SURFACE' STRESS GWSURF1A.60
*,SIN_A(POINTS) !OUT SIN (WIND DIRECTION FROM NORTH) GWSURF1A.61
*,COS_A(POINTS) !OUT COS (WIND DIRECTION FROM NORTH) GWSURF1A.62
C*--------------------------------------------------------------------- GWSURF1A.63
GWSURF1A.64
C*L WORKSPACE USAGE:------------------------------------------------- GWSURF1A.65
C DEFINE LOCAL WORKSPACE ARRAYS: GWSURF1A.66
C 0 REAL ARRAYS OF FULL FIELD LENGTH REQUIRED GWSURF1A.67
C GWSURF1A.68
REAL GWSURF1A.69
* Z ! HEIGHT DIFFERENCE GWSURF1A.70
*,RHO ! DENSITY GWSURF1A.71
*,SPEED ! WIND SPEED GWSURF1A.72
*,SPEED_SQ ! SQUARE OF WIND SPEED GWSURF1A.73
*,N ! BRUNT_VAISALA FREQUENCY GWSURF1A.74
*,N_SQ ! SQUARE OF BRUNT_VAISALA FREQUENCY GWSURF1A.75
*,AMPL_SQ ! SQUARE OF WAVE-AMPLITUDE GWSURF1A.76
*,FROUDEC ! MAX SQUARE OF WAVE-AMPLITUDE (FROUDE <=1) GWSURF1A.77
C*--------------------------------------------------------------------- GWSURF1A.78
C GWSURF1A.79
C*L EXTERNAL SUBROUTINES CALLED--------------------------------------- GWSURF1A.80
C NONE GWSURF1A.81
C*------------------------------------------------------------------ GWSURF1A.82
CL MAXIMUM VECTOR LENGTH ASSUMED = POINTS GWSURF1A.83
CL--------------------------------------------------------------------- GWSURF1A.84
C---------------------------------------------------------------------- GWSURF1A.85
C GWSURF1A.86
INTEGER I ! LOOP COUNTER IN ROUTINE GWSURF1A.87
C GWSURF1A.88
LOGICAL LFROUDE ! Logical switch GSS1F304.72
C GSS1F304.73
C INCLUDE PHYSICAL CONSTANTS GWSURF1A.89
*CALL C_G 
GWSURF1A.90
*CALL C_R_CP GWSURF1A.91
GWSURF1A.92
C LOCAL CONSTANTS GWSURF1A.93
*CALL C_GWAVE GWSURF1A.94
GWSURF1A.95
GWSURF1A.96
REAL GWSURF1A.97
& PU,PL,PU3,PL3 GWSURF1A.98
*CALL P_EXNERC GWSURF1A.99
GWSURF1A.100
C------------------------------------------------------------------- GWSURF1A.101
CL INTERNAL STRUCTURE INCLUDING SUBROUTINE CALLS: GWSURF1A.102
CL START LOOP POINTS GWSURF1A.103
C------------------------------------------ GWSURF1A.104
GWSURF1A.105
DO I=1,POINTS GWSURF1A.106
GWSURF1A.107
C------------------------------------------------------------------- GWSURF1A.108
CL 1. CALCULATE HEIGHT DIFFERENCE Z3-Z1 EQN 2.4 GWSURF1A.109
C------------------------------------------ ------- GWSURF1A.110
GWSURF1A.111
PU=PSTAR(I)*BKH(2) + AKH(2) GWSURF1A.112
PL=PSTAR(I)*BKH(1) + AKH(1) GWSURF1A.113
PU3=PSTAR(I)*BKH(4) + AKH(4) GWSURF1A.114
PL3=PSTAR(I)*BKH(3) + AKH(3) GWSURF1A.115
GWSURF1A.116
Z=((P_EXNER_C( PEXNER(I,2),PEXNER(I,1),PU,PL,KAPPA) GWSURF1A.117
& -PEXNER(I,2))*THETA(I,1) GWSURF1A.118
* +(PEXNER(I,2)-PEXNER(I,3))*THETA(I,2) GWSURF1A.119
* +(PEXNER(I,3)- GWSURF1A.120
& P_EXNER_C( PEXNER(I,4),PEXNER(I,3),PU3,PL3,KAPPA)) GWSURF1A.121
* *THETA(I,3))*CP/G GWSURF1A.122
GWSURF1A.123
C------------------------------------------------------------------ GWSURF1A.124
CL 2 CALCULATE DENSITY AT LEVEL 2 GWSURF1A.125
C------------------------------------------------------------------ GWSURF1A.126
GWSURF1A.127
RHO=( AK(2) + BK(2)*PSTAR(I) )/( R*THETA(I,2)* GWSURF1A.128
& P_EXNER_C( PEXNER(I,3),PEXNER(I,2),PL3,PU,KAPPA)) GWSURF1A.129
GWSURF1A.130
C------------------------------------------------------------------ GWSURF1A.131
CL 3 CALCULATE WIND SPEED AND DIRECTION AT LEVEL 2 GWSURF1A.132
C------------------------------------------------------------------ GWSURF1A.133
GWSURF1A.134
SPEED_SQ = U(I,2)*U(I,2) + V(I,2)*V(I,2) GWSURF1A.135
SPEED = SQRT( SPEED_SQ ) GWSURF1A.136
IF(SPEED.GT.0.0) THEN GWSURF1A.137
SIN_A(I) = U(I,2)/SPEED GWSURF1A.138
COS_A(I) = V(I,2)/SPEED GWSURF1A.139
ENDIF GWSURF1A.140
GWSURF1A.141
C------------------------------------------------------------------ GWSURF1A.142
CL 4 CALCULATE BRUNT-VAISALA FREQUENCY EQN 2.3 GWSURF1A.143
C------------------------------------------------------------------ GWSURF1A.144
GWSURF1A.145
N_SQ = G*( THETA(I,3) - THETA(I,1) )/ GWSURF1A.146
& ( 0.5*( THETA(I,3) + THETA(I,1) )*Z ) GWSURF1A.147
IF( N_SQ .LT.0.0 ) N_SQ = 0.0 GWSURF1A.148
C NO WAVES IF UNSTABLE GWSURF1A.149
N = SQRT( N_SQ ) GWSURF1A.150
GWSURF1A.151
C------------------------------------------------------------------ GWSURF1A.152
CL 5 LIMIT SQUARE OF WAVE AMPLITUDE BY FROUDE NO.CRITERION GWSURF1A.153
CL OR BY IMPOSED VARIANCE MAXIMUM GWSURF1A.154
C------------------------------------------------------------------ GWSURF1A.155
GWSURF1A.156
AMPL_SQ = SD_OROG(I) * SD_OROG(I) GWSURF1A.157
GWSURF1A.158
IF (LFROUDE) THEN GSS1F304.74
GWSURF1A.160
IF( N_SQ .GT.0.0 ) THEN GWSURF1A.161
FROUDEC = SPEED_SQ / N_SQ GWSURF1A.162
ELSE GWSURF1A.163
FROUDEC = 0.0 GWSURF1A.164
ENDIF GWSURF1A.165
IF( AMPL_SQ . GT. FROUDEC ) AMPL_SQ = FROUDEC GWSURF1A.166
GWSURF1A.167
ELSE GSS1F304.75
GWSURF1A.169
IF( AMPL_SQ . GT. VAR_MAX ) AMPL_SQ = VAR_MAX GWSURF1A.170
GWSURF1A.171
END IF GSS1F304.76
GWSURF1A.173
C------------------------------------------------------------------ GWSURF1A.174
CL 6 CALCULATE 'SURFACE' STRESS EQN 2.2a GWSURF1A.175
C------------------------------------------------------------------ GWSURF1A.176
GWSURF1A.177
S_STRESS(I) = KAY*RHO*N*SPEED*AMPL_SQ GWSURF1A.178
END DO GWSURF1A.179
CL END LOOP POINTS GWSURF1A.180
GWSURF1A.181
RETURN GWSURF1A.182
END GWSURF1A.183
*ENDIF GWSURF1A.184