*IF DEF,A03_5A SFRUGH5A.2
C *****************************COPYRIGHT****************************** SFRUGH5A.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. SFRUGH5A.4
C SFRUGH5A.5
C Use, duplication or disclosure of this code is subject to the SFRUGH5A.6
C restrictions as set forth in the contract. SFRUGH5A.7
C SFRUGH5A.8
C Meteorological Office SFRUGH5A.9
C London Road SFRUGH5A.10
C BRACKNELL SFRUGH5A.11
C Berkshire UK SFRUGH5A.12
C RG12 2SZ SFRUGH5A.13
C SFRUGH5A.14
C If no contract has been raised with this copy of the code, the use, SFRUGH5A.15
C duplication or disclosure of it is strictly prohibited. Permission SFRUGH5A.16
C to do so must first be obtained in writing from the Head of Numerical SFRUGH5A.17
C Modelling at the above address. SFRUGH5A.18
C ******************************COPYRIGHT****************************** SFRUGH5A.19
C*LL SUBROUTINE SF_ROUGH----------------------------------------------- SFRUGH5A.20
CLL SFRUGH5A.21
CLL Purpose: Calculate roughness lengths, blending height and wind SFRUGH5A.22
CLL profile factor SFRUGH5A.23
CLL SFRUGH5A.24
C Modification History: AJC1F405.50
C Version Date Change AJC1F405.51
C 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.52
CLL SFRUGH5A.25
CLLEND------------------------------------------------------------------ SFRUGH5A.26
C* SFRUGH5A.27
C*L Arguaments -------------------------------------------------------- SFRUGH5A.28
SUBROUTINE SF_ROUGH ( 6,4SFRUGH5A.29
& P_POINTS,LAND_PTS,LAND_MASK, SFRUGH5A.30
& P1,LAND_INDEX, SFRUGH5A.32
& L_Z0_OROG,Z1,Z0MSEA,ICE_FRACT, SFRUGH5A.34
& LYING_SNOW,Z0V,SIL_OROG,HO2R2_OROG,RIB,Z0M_EFF,Z0M,Z0H, SFRUGH5A.35
& WIND_PROFILE_FACTOR,H_BLEND,CD_LEAD,Z0HS,Z0F,Z0FS, SFRUGH5A.36
& LTIMER) SFRUGH5A.37
SFRUGH5A.38
IMPLICIT NONE SFRUGH5A.39
C SFRUGH5A.40
INTEGER ! Variables defining grid. SFRUGH5A.41
& P_POINTS ! IN Number of P-grid points to be processed. SFRUGH5A.42
&,LAND_PTS ! IN Number of land points to be processed. SFRUGH5A.43
C SFRUGH5A.44
&,LAND_INDEX(LAND_PTS)! IN Index for compressed land point array; SFRUGH5A.46
C ! i'th element holds position in the FULL SFRUGH5A.47
C ! field of the ith land pt to be SFRUGH5A.48
C ! processed SFRUGH5A.49
&,P1 ! IN First P-point to be processed. SFRUGH5A.50
LOGICAL SFRUGH5A.52
& LAND_MASK(P_POINTS) ! IN .TRUE. for land; .FALSE. elsewhere. F60. SFRUGH5A.53
&,L_Z0_OROG ! IN .TRUE. to use orographic roughness. SFRUGH5A.54
C SFRUGH5A.55
REAL SFRUGH5A.56
& HO2R2_OROG(LAND_PTS)! IN Peak to trough height of unresolved SFRUGH5A.57
C ! orography devided by 2SQRT(2) (m). SFRUGH5A.58
&,ICE_FRACT(P_POINTS) ! IN Fraction of gridbox which is sea-ice. SFRUGH5A.59
&,LYING_SNOW(P_POINTS)! IN Lying snow amount (kg per sq metre). SFRUGH5A.60
&,RIB(P_POINTS) ! IN Bulk Richardson number for lowest layer. SFRUGH5A.61
&,SIL_OROG(LAND_PTS) ! IN Silhouette area of unresolved orography SFRUGH5A.62
C ! per unit horizontal area SFRUGH5A.63
&,Z0V(P_POINTS) ! IN Vegetative roughness length (m). F6418. SFRUGH5A.64
&,Z1(P_POINTS) ! IN Height of lowest atmospheric level (m). SFRUGH5A.65
C SFRUGH5A.66
C Modified (INOUT) variables. SFRUGH5A.67
C SFRUGH5A.68
REAL SFRUGH5A.69
& Z0MSEA(P_POINTS) ! INOUT Sea-surface roughness length for SFRUGH5A.70
C ! momentum (m). F617. SFRUGH5A.71
C SFRUGH5A.72
C Output variables. SFRUGH5A.73
C SFRUGH5A.74
REAL SFRUGH5A.75
& CD_LEAD(P_POINTS) ! Bulk transfer coefficient for momentum SFRUGH5A.76
C ! over sea-ice leads.Missing data over non SFRUGH5A.77
C ! sea-ice points.(Temporary store for Z0MIZ) SFRUGH5A.78
&,H_BLEND(P_POINTS) ! OUT Blending height SFRUGH5A.79
&,WIND_PROFILE_FACTOR(P_POINTS) SFRUGH5A.80
C ! For transforming effective surface transfer SFRUGH5A.81
C ! coefficients to those excluding form drag. SFRUGH5A.82
&,Z0M_EFF(P_POINTS) ! OUT Effective roughness length for momentum SFRUGH5A.83
&,Z0F(P_POINTS) ! Roughness length for free-convective heat SFRUGH5A.84
C ! and moisture transport. SFRUGH5A.85
&,Z0H(P_POINTS) ! OUT Roughness length for heat and moisture SFRUGH5A.86
&,Z0M(P_POINTS) ! OUT Roughness length for momentum (m). SFRUGH5A.87
&,Z0FS(P_POINTS) ! Roughness length for free-convective heat SFRUGH5A.88
C ! and moisture transport over sea. SFRUGH5A.89
&,Z0HS(P_POINTS) ! Roughness length for heat and moisture SFRUGH5A.90
C ! transport over sea. SFRUGH5A.91
SFRUGH5A.92
LOGICAL LTIMER ! Logical switch for TIMER diags SFRUGH5A.93
C SFRUGH5A.94
C Work Variables SFRUGH5A.95
C SFRUGH5A.96
INTEGER SFRUGH5A.97
& I ! Loop counter SFRUGH5A.98
&,L ! Another loop counter - this time for land points SFRUGH5A.99
SFRUGH5A.100
REAL SFRUGH5A.101
& RIB_FN ! Interpolation coefficient for 0 < RIB < RI_CRIT SFRUGH5A.102
&,ZETA1 ! Work space SFRUGH5A.103
&,ZETA2 ! More work space SFRUGH5A.104
&,ZETA3 ! Even more work space SFRUGH5A.105
&,Z0 ! yet more workspace SFRUGH5A.106
C SFRUGH5A.107
C Common parameters SFRUGH5A.108
SFRUGH5A.109
*CALL C_MDI 
SFRUGH5A.110
*CALL C_VKMAN SFRUGH5A.111
*CALL C_ROUGH SFRUGH5A.112
*CALL C_SURF SFRUGH5A.113
SFRUGH5A.114
C Local parameters SFRUGH5A.115
SFRUGH5A.116
REAL H_BLEND_MIN,H_BLEND_MAX SFRUGH5A.117
PARAMETER ( SFRUGH5A.118
& H_BLEND_MIN=0.0 ! Minimun value of blending height SFRUGH5A.119
&,H_BLEND_MAX=1000.0 ! Maximum value of blending height SFRUGH5A.120
& ) SFRUGH5A.121
SFRUGH5A.122
IF (LTIMER) THEN SFRUGH5A.123
CALL TIMER('SFROUGH ',3) SFRUGH5A.124
ENDIF SFRUGH5A.125
C----------------------------------------------------------------------- SFRUGH5A.126
CL 1 Fix roughness lengths for the various surface types. SFRUGH5A.127
C----------------------------------------------------------------------- SFRUGH5A.128
DO I = 1,P_POINTS SFRUGH5A.129
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFRUGH5A.130
CL 1.1 Liquid sea. Overwrite sea-ice and land in 3.1.2, 3.1.3. SFRUGH5A.131
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFRUGH5A.132
Z0M(I) = Z0MSEA(I) ! P243.B5 SFRUGH5A.133
Z0H(I) = Z0HSEA ! " SFRUGH5A.134
Z0M_EFF(I) = Z0MSEA(I) SFRUGH5A.135
Z0F(I) = Z0FSEA ! " SFRUGH5A.136
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFRUGH5A.137
CL 1.2 Sea ice: Z0MIZ set on all points for input to FCDCH routine SFRUGH5A.138
CL in CD_MIZ,CH_MIZ calculations. Similarily Z0HSEA,Z0FSEA for SFRUGH5A.139
CL CD_LEAD,CH_LEAD calculations. Z0SICE for CD,CH over sea-ice. SFRUGH5A.140
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFRUGH5A.141
CD_LEAD(I) = Z0MIZ SFRUGH5A.142
Z0HS(I) = Z0HSEA SFRUGH5A.143
Z0FS(I) = Z0FSEA SFRUGH5A.144
IF (ICE_FRACT(I).GT.0.0 .AND. .NOT.LAND_MASK(I)) THEN SFRUGH5A.145
Z0M(I) = Z0SICE ! P243.B4 SFRUGH5A.146
Z0H(I) = Z0SICE ! " SFRUGH5A.147
Z0M_EFF(I) = Z0SICE SFRUGH5A.148
Z0F(I) = Z0SICE ! " SFRUGH5A.149
ENDIF SFRUGH5A.150
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFRUGH5A.151
CL 1.2a Specify blending height for all points. Set to minimum value SFRUGH5A.152
CL so that LAMBDA_EFF = LAMBDA over the sea in KMKH. SFRUGH5A.153
CL This avoids having to pass land-sea mask into KMKH. SFRUGH5A.154
CL Also set the wind profile factor to the default value of 1.0 SFRUGH5A.155
CL for non-land points. SFRUGH5A.156
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFRUGH5A.157
SFRUGH5A.158
H_BLEND(I) = H_BLEND_MIN SFRUGH5A.159
WIND_PROFILE_FACTOR(I) = 1.0 SFRUGH5A.160
C SFRUGH5A.161
ENDDO SFRUGH5A.163
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFRUGH5A.165
CL 1.3 Land. Reduce roughness if there is any snow lying. SFRUGH5A.166
CL Eqns P243.B1, B2. SFRUGH5A.167
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFRUGH5A.168
CDIR$ IVDEP SFRUGH5A.173
! Fujitsu vectorization directive GRB0F405.515
!OCL NOVREC GRB0F405.516
DO L = 1,LAND_PTS SFRUGH5A.174
I = LAND_INDEX(L) - (P1-1) SFRUGH5A.175
IF (LYING_SNOW(I) .LT. 5.0E3) THEN ! Only reduce non-orographic SFRUGH5A.177
C ! roughness for land points SFRUGH5A.178
C ! without permanent snow. SFRUGH5A.179
C SFRUGH5A.180
Z0 = Z0V(I) - 4.0E-4 * LYING_SNOW(I) SFRUGH5A.181
ZETA1 = MIN( 5.0E-4 , Z0V(I) ) SFRUGH5A.182
Z0M(I) = MAX( ZETA1 , Z0 ) SFRUGH5A.183
Z0H(I) = MIN( Z0V(I) , Z0M(I) ) SFRUGH5A.184
Z0F(I) = Z0H(I) SFRUGH5A.185
ELSE ! for permanent land-ice Z0V is appropriate SFRUGH5A.186
Z0M(I) = Z0V(I) ! P243.B1, based on P243.B2 (2nd case) SFRUGH5A.187
Z0H(I) = Z0V(I) ! " , " " " ( " " ) SFRUGH5A.188
Z0F(I) = Z0V(I) ! " , " " " ( " " ) SFRUGH5A.189
ENDIF SFRUGH5A.190
C SFRUGH5A.191
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFRUGH5A.192
CL 1.4 Orographic roughness. Calculate Z0M_EFF in neutral case. SFRUGH5A.193
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - SFRUGH5A.194
IF (L_Z0_OROG) THEN SFRUGH5A.195
C SFRUGH5A.196
C ! Set blending height, effective roughness length and SFRUGH5A.197
C ! wind profile factor at land points. SFRUGH5A.198
C SFRUGH5A.199
SFRUGH5A.200
ZETA1 = 0.5 * OROG_DRAG_PARAM * SIL_OROG(L) SFRUGH5A.201
ZETA2 = LOG ( 1.0 + Z1(I)/Z0M(I) ) SFRUGH5A.202
ZETA3 = 1.0 / SQRT ( ZETA1/(VKMAN*VKMAN) + 1.0/(ZETA2*ZETA2) ) SFRUGH5A.203
ZETA2 = 1.0 / EXP(ZETA3) SFRUGH5A.204
H_BLEND(I) = MAX ( Z1(I) / (1.0 - ZETA2) , SFRUGH5A.205
& HO2R2_OROG(L) * SQRT(2.0) ) SFRUGH5A.206
H_BLEND(I) = MIN ( H_BLEND_MAX, H_BLEND(I) ) SFRUGH5A.207
SFRUGH5A.208
SFRUGH5A.209
! Apply simple stability correction to form drag if RIB is stable SFRUGH5A.210
SFRUGH5A.211
IF (SIL_OROG(L) .EQ. RMDI) THEN SFRUGH5A.212
ZETA1 = 0.0 SFRUGH5A.213
ELSE SFRUGH5A.214
RIB_FN = ( 1.0 - RIB(I) / RI_CRIT ) SFRUGH5A.215
IF (RIB_FN.GT.1.0) RIB_FN = 1.0 SFRUGH5A.216
IF (RIB_FN.LT.0.0) RIB_FN = 0.0 SFRUGH5A.217
ZETA1 = 0.5 * OROG_DRAG_PARAM * SIL_OROG(L) * RIB_FN SFRUGH5A.218
ENDIF SFRUGH5A.219
SFRUGH5A.220
SFRUGH5A.221
Z0M_EFF(I) = H_BLEND(I) / EXP ( VKMAN / SQRT ( ZETA1 + SFRUGH5A.222
& (VKMAN / LOG ( H_BLEND(I) / Z0M(I) ) ) * SFRUGH5A.223
& (VKMAN / LOG ( H_BLEND(I) / Z0M(I) ) ) ) ) SFRUGH5A.224
SFRUGH5A.225
SFRUGH5A.226
IF (RIB(I).GT.RI_CRIT) Z0M_EFF(I)=Z0M(I) SFRUGH5A.227
SFRUGH5A.228
WIND_PROFILE_FACTOR(I) = LOG ( H_BLEND(I) / Z0M_EFF(I) ) / SFRUGH5A.229
& LOG ( H_BLEND(I) / Z0M(I) ) SFRUGH5A.230
SFRUGH5A.231
ELSE ! Orographic roughness not represented so SFRUGH5A.232
C ! leave blending height and wind profile factor at their SFRUGH5A.233
C ! default values and set effective roughness length to its SFRUGH5A.234
C ! value based on land type. SFRUGH5A.235
C SFRUGH5A.236
Z0M_EFF(I) = Z0M(I) SFRUGH5A.237
ENDIF SFRUGH5A.238
SFRUGH5A.239
ENDDO SFRUGH5A.244
SFRUGH5A.246
IF (LTIMER) THEN SFRUGH5A.247
CALL TIMER('SFROUGH ',4) SFRUGH5A.248
ENDIF SFRUGH5A.249
RETURN SFRUGH5A.250
END SFRUGH5A.251
SFRUGH5A.252
*ENDIF SFRUGH5A.253