*IF DEF,A03_7A SFRIB7A.2
C *****************************COPYRIGHT****************************** SFRIB7A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. SFRIB7A.4
C SFRIB7A.5
C Use, duplication or disclosure of this code is subject to the SFRIB7A.6
C restrictions as set forth in the contract. SFRIB7A.7
C SFRIB7A.8
C Meteorological Office SFRIB7A.9
C London Road SFRIB7A.10
C BRACKNELL SFRIB7A.11
C Berkshire UK SFRIB7A.12
C RG12 2SZ SFRIB7A.13
C SFRIB7A.14
C If no contract has been raised with this copy of the code, the use, SFRIB7A.15
C duplication or disclosure of it is strictly prohibited. Permission SFRIB7A.16
C to do so must first be obtained in writing from the Head of Numerical SFRIB7A.17
C Modelling at the above address. SFRIB7A.18
C ******************************COPYRIGHT****************************** SFRIB7A.19
! SFRIB7A.20
!!! SUBROUTINES SF_RIB_LAND and SF_RIB_SEA --------------------------- SFRIB7A.21
!!! SFRIB7A.22
!!! Purpose: Calculate bulk Richardson number for surface layer SFRIB7A.23
!!! SFRIB7A.24
!!! SJ, RE <- programmer of some or all of previous code changes SFRIB7A.25
!!! SFRIB7A.26
!!! ------------------------------------------------------------------ SFRIB7A.27
SFRIB7A.28
! SUBROUTINE SF_RIB_LAND-------------------------------------------- SFRIB7A.29
! SFRIB7A.30
! Calculate RIB for land tiles SFRIB7A.31
! SFRIB7A.32
! ------------------------------------------------------------------ SFRIB7A.33
SUBROUTINE SF_RIB_LAND ( 1,2SFRIB7A.34
& P_FIELD,LAND_FIELD,TILE_PTS,LAND_INDEX,TILE_INDEX, SFRIB7A.35
& BQ_1,BT_1,QSTAR,QW_1,RESFT,TL_1,TSTAR,VSHR,Z0H,Z0M,Z1_TQ,Z1_UV, SFRIB7A.36
& RIB,LTIMER SFRIB7A.37
& ) SFRIB7A.38
SFRIB7A.39
IMPLICIT NONE SFRIB7A.40
SFRIB7A.41
INTEGER SFRIB7A.42
& P_FIELD ! IN Total number of P-grid points. SFRIB7A.43
&,LAND_FIELD ! IN Total number of land points. SFRIB7A.44
&,TILE_PTS ! IN Number of tile points. SFRIB7A.45
&,LAND_INDEX(P_FIELD) ! IN Index of land points. SFRIB7A.46
&,TILE_INDEX(LAND_FIELD)! IN Index of tile points. SFRIB7A.47
SFRIB7A.48
LOGICAL SFRIB7A.49
& LTIMER ! IN logical for TIMER SFRIB7A.50
SFRIB7A.51
REAL SFRIB7A.52
& BQ_1(P_FIELD) ! IN A buoyancy parameter for lowest atm SFRIB7A.53
! ! level. ("beta-q twiddle"). SFRIB7A.54
&,BT_1(P_FIELD) ! IN A buoyancy parameter for lowest atm SFRIB7A.55
! ! level. ("beta-T twiddle"). SFRIB7A.56
&,QSTAR(LAND_FIELD) ! IN Surface saturated sp humidity. SFRIB7A.57
&,QW_1(P_FIELD) ! IN Total water content of lowest SFRIB7A.58
! ! atmospheric layer (kg per kg air). SFRIB7A.59
&,RESFT(LAND_FIELD) ! IN Total resistance factor. SFRIB7A.60
&,TL_1(P_FIELD) ! IN Liquid/frozen water temperature for SFRIB7A.61
! ! lowest atmospheric layer (K). SFRIB7A.62
&,TSTAR(LAND_FIELD) ! IN Surface temperature (K). SFRIB7A.63
&,VSHR(P_FIELD) ! IN Magnitude of surface-to-lowest-level SFRIB7A.64
! ! wind shear. SFRIB7A.65
&,Z0H(LAND_FIELD) ! IN Roughness length for heat and moisture m SFRIB7A.66
&,Z0M(LAND_FIELD) ! IN Effective roughness length for momentum SFRIB7A.67
&,Z1_TQ(P_FIELD) ! IN Height of lowest TQ level (m). SFRIB7A.68
&,Z1_UV(P_FIELD) ! IN Height of lowest UV level (m). SFRIB7A.69
SFRIB7A.70
REAL SFRIB7A.71
& RIB(LAND_FIELD) ! OUT Bulk Richardson number for lowest layer SFRIB7A.72
SFRIB7A.73
! Symbolic constants ----------------------------------------------- SFRIB7A.74
SFRIB7A.75
*CALL C_G 
SFRIB7A.76
*CALL C_R_CP SFRIB7A.77
SFRIB7A.78
! Workspace -------------------------------------------------------- SFRIB7A.79
INTEGER SFRIB7A.80
& I ! Horizontal field index. SFRIB7A.81
&,J ! Tile field index. SFRIB7A.82
&,L ! Land field index. SFRIB7A.83
SFRIB7A.84
REAL SFRIB7A.85
& DQ(LAND_FIELD) ! Sp humidity difference between surface SFRIB7A.86
! ! and lowest atmospheric level (Q1 - Q*). SFRIB7A.87
&,DTEMP(LAND_FIELD) ! Modified temperature difference between SFRIB7A.88
! surface and lowest atmospheric level. SFRIB7A.89
SFRIB7A.90
IF (LTIMER) THEN SFRIB7A.91
CALL TIMER('SF_RIB ',3) SFRIB7A.92
ENDIF SFRIB7A.93
SFRIB7A.94
!----------------------------------------------------------------------- SFRIB7A.95
!! 1 Calculate temperature (strictly, liquid/ice static energy) and SFRIB7A.96
!! humidity jumps across the surface layer. SFRIB7A.97
!----------------------------------------------------------------------- SFRIB7A.98
DO J=1,TILE_PTS SFRIB7A.99
L = TILE_INDEX(J) SFRIB7A.100
I = LAND_INDEX(L) SFRIB7A.101
DTEMP(L) = TL_1(I) - TSTAR(L) + (G/CP)*(Z1_TQ(I)+Z0M(L)-Z0H(L)) SFRIB7A.102
! ! P243.118 SFRIB7A.103
DQ(L) = QW_1(I) - QSTAR(L) ! P243.119 SFRIB7A.104
ENDDO SFRIB7A.105
SFRIB7A.106
!----------------------------------------------------------------------- SFRIB7A.107
!! 2 Calculate bulk Richardson numbers for the surface layer. SFRIB7A.108
!----------------------------------------------------------------------- SFRIB7A.109
DO J=1,TILE_PTS SFRIB7A.110
L = TILE_INDEX(J) SFRIB7A.111
I = LAND_INDEX(L) SFRIB7A.112
RIB(L) = G*Z1_UV(I)*(BT_1(I)*DTEMP(L) + BQ_1(I)*RESFT(L)*DQ(L)) SFRIB7A.113
& / ( VSHR(I)*VSHR(I) ) ! P243.43 SFRIB7A.114
ENDDO SFRIB7A.115
SFRIB7A.116
IF (LTIMER) THEN SFRIB7A.117
CALL TIMER('SF_RIB ',4) SFRIB7A.118
ENDIF SFRIB7A.119
SFRIB7A.120
RETURN SFRIB7A.121
END SFRIB7A.122
SFRIB7A.123
! SUBROUTINE SF_RIB_SEA--------------------------------------------- SFRIB7A.124
! SFRIB7A.125
! Calculate RIB for sea, sea-ice and sea-ice leads SFRIB7A.126
! SFRIB7A.127
! ------------------------------------------------------------------ SFRIB7A.128
SUBROUTINE SF_RIB_SEA ( 1,2SFRIB7A.129
& P_POINTS,P_FIELD,P1,LAND_MASK,NSICE,SICE_INDEX, SFRIB7A.130
& BQ_1,BT_1,ICE_FRACT,QSTAR_ICE,QSTAR_SEA,QW_1,TL_1,TSTAR_ICE, SFRIB7A.131
& TSTAR_SEA,VSHR,Z0H_ICE,Z0H_SEA,Z0M_ICE,Z0M_SEA,Z1_TQ,Z1_UV, SFRIB7A.132
& RIB_SEA,RIB_ICE,LTIMER SFRIB7A.133
& ) SFRIB7A.134
SFRIB7A.135
IMPLICIT NONE SFRIB7A.136
SFRIB7A.137
INTEGER SFRIB7A.138
& P_POINTS ! IN Number of P-grid points to be processed. SFRIB7A.139
&,P_FIELD ! IN Total number of P-grid points. SFRIB7A.140
&,P1 ! IN First P-point to be processed. SFRIB7A.141
&,NSICE ! IN Number of sea-ice points. SFRIB7A.142
&,SICE_INDEX(P_FIELD) ! IN Index of sea-ice points. SFRIB7A.143
SFRIB7A.144
LOGICAL SFRIB7A.145
& LTIMER ! IN logical for TIMER SFRIB7A.146
&,LAND_MASK(P_FIELD) ! IN .TRUE. for land; .FALSE. elsewhere. F60. SFRIB7A.147
SFRIB7A.148
REAL SFRIB7A.149
& BQ_1(P_FIELD) ! IN A buoyancy parameter for lowest atm SFRIB7A.150
! ! level. ("beta-q twiddle"). SFRIB7A.151
&,BT_1(P_FIELD) ! IN A buoyancy parameter for lowest atm SFRIB7A.152
! ! level. ("beta-T twiddle"). SFRIB7A.153
&,ICE_FRACT(P_FIELD) ! IN Fraction of gridbox which is sea-ice. SFRIB7A.154
&,QSTAR_ICE(P_FIELD) ! IN Surface saturated sp humidity over SFRIB7A.155
! ! sea-ice. SFRIB7A.156
&,QSTAR_SEA(P_FIELD) ! IN Surface saturated sp humidity over SFRIB7A.157
! ! sea and sea-ice leads. SFRIB7A.158
&,QW_1(P_FIELD) ! IN Total water content of lowest SFRIB7A.159
! ! atmospheric layer (kg per kg air). SFRIB7A.160
&,TL_1(P_FIELD) ! IN Liquid/frozen water temperature for SFRIB7A.161
! ! lowest atmospheric layer (K). SFRIB7A.162
&,TSTAR_ICE(P_FIELD) ! IN Surface temperature of sea-ice (K). SFRIB7A.163
&,TSTAR_SEA(P_FIELD) ! IN Surface temperature of sea and sea-ice SFRIB7A.164
! ! leads (K). SFRIB7A.165
&,VSHR(P_FIELD) ! IN Magnitude of surface-to-lowest-level SFRIB7A.166
! ! wind shear. SFRIB7A.167
&,Z0H_ICE(P_FIELD) ! IN Roughness length for heat and moisture SFRIB7A.168
! ! transport over sea-ice (m). SFRIB7A.169
&,Z0H_SEA(P_FIELD) ! IN Roughness length for heat and moisture SFRIB7A.170
! ! transport over sea or sea-ice leads (m). SFRIB7A.171
&,Z0M_ICE(P_FIELD) ! IN Roughness length for momentum over SFRIB7A.172
! ! sea-ice (m). SFRIB7A.173
&,Z0M_SEA(P_FIELD) ! IN Roughness length for momentum over sea SFRIB7A.174
! ! or sea-ice leads (m). SFRIB7A.175
&,Z1_TQ(P_FIELD) ! IN Height of lowest TQ level (m). SFRIB7A.176
&,Z1_UV(P_FIELD) ! IN Height of lowest UV level (m). SFRIB7A.177
SFRIB7A.178
REAL SFRIB7A.179
& RIB_SEA(P_FIELD) ! OUT Bulk Richardson number for lowest layer SFRIB7A.180
! ! over sea or sea-ice leads. SFRIB7A.181
&,RIB_ICE(P_FIELD) ! OUT Bulk Richardson number for lowest layer SFRIB7A.182
! ! over sea-ice. SFRIB7A.183
SFRIB7A.184
SFRIB7A.185
! Symbolic constants ----------------------------------------------- SFRIB7A.186
SFRIB7A.187
*CALL C_0_DG_C SFRIB7A.188
*CALL C_G SFRIB7A.189
*CALL C_R_CP SFRIB7A.190
SFRIB7A.191
! Workspace -------------------------------------------------------- SFRIB7A.192
INTEGER SFRIB7A.193
& I ! Horizontal field index. SFRIB7A.194
&,J !Sea-ice field index. SFRIB7A.195
REAL SFRIB7A.196
& DQ ! Sp humidity difference between surface SFRIB7A.197
! ! and lowest atmospheric level (Q1 - Q*). SFRIB7A.198
&,DTEMP ! Modified temperature difference between SFRIB7A.199
! ! surface and lowest atmospheric level. SFRIB7A.200
SFRIB7A.201
IF (LTIMER) THEN SFRIB7A.202
CALL TIMER('SF_RIB ',3) SFRIB7A.203
ENDIF SFRIB7A.204
SFRIB7A.205
DO I=P1,P1+P_POINTS-1 SFRIB7A.206
IF ( .NOT.LAND_MASK(I) ) THEN SFRIB7A.207
! Sea and sea-ice leads SFRIB7A.208
DTEMP = TL_1(I) - TSTAR_SEA(I) ! P243.118 SFRIB7A.209
& + (G/CP)*(Z1_TQ(I) + Z0M_SEA(I) - Z0H_SEA(I)) SFRIB7A.210
DQ = QW_1(I) - QSTAR_SEA(I) ! P243.119 SFRIB7A.211
RIB_SEA(I) = G*Z1_UV(I)*( BT_1(I)*DTEMP + BQ_1(I)*DQ ) / SFRIB7A.212
& ( VSHR(I)*VSHR(I) ) SFRIB7A.213
ENDIF SFRIB7A.214
ENDDO SFRIB7A.215
SFRIB7A.216
DO J=1,NSICE SFRIB7A.217
I = SICE_INDEX(J) SFRIB7A.218
! Sea-ice SFRIB7A.219
DTEMP = TL_1(I) - TSTAR_ICE(I) SFRIB7A.220
& + (G/CP)*(Z1_TQ(I) + Z0M_ICE(I) - Z0H_ICE(I)) SFRIB7A.221
DQ = QW_1(I) - QSTAR_ICE(I) SFRIB7A.222
RIB_ICE(I) = G*Z1_UV(I)*( BT_1(I)*DTEMP + BQ_1(I)*DQ ) / SFRIB7A.223
& ( VSHR(I) * VSHR(I) ) SFRIB7A.224
ENDDO SFRIB7A.225
SFRIB7A.226
IF (LTIMER) THEN SFRIB7A.227
CALL TIMER('SF_RIB ',4) SFRIB7A.228
ENDIF SFRIB7A.229
SFRIB7A.230
RETURN SFRIB7A.231
END SFRIB7A.232
*ENDIF SFRIB7A.233