*IF DEF,A03_7A ACB1F405.2
C *****************************COPYRIGHT****************************** BTQINT5B.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. BTQINT5B.4
C BTQINT5B.5
C Use, duplication or disclosure of this code is subject to the BTQINT5B.6
C restrictions as set forth in the contract. BTQINT5B.7
C BTQINT5B.8
C Meteorological Office BTQINT5B.9
C London Road BTQINT5B.10
C BRACKNELL BTQINT5B.11
C Berkshire UK BTQINT5B.12
C RG12 2SZ BTQINT5B.13
C BTQINT5B.14
C If no contract has been raised with this copy of the code, the use, BTQINT5B.15
C duplication or disclosure of it is strictly prohibited. Permission BTQINT5B.16
C to do so must first be obtained in writing from the Head of Numerical BTQINT5B.17
C Modelling at the above address. BTQINT5B.18
C ******************************COPYRIGHT****************************** BTQINT5B.19
! SUBROUTINE BTQ_INT BTQINT5B.20
!!! Purpose: To interpolate buoyancy parameters BT and BQ from full BTQINT5B.21
!!! levels to half levels BTQINT5B.22
!!! BTQINT5B.23
!!! ORIGINAL PROGRAMMER: J James BTQINT5B.24
!!! CURRENT CODE OWNER: RNB Smith BTQINT5B.25
!!! BTQINT5B.26
!!! HISTORY: BTQINT5B.27
!!! DATE VERSION COMMENT BTQINT5B.28
!!! ---- ------- ------- BTQINT5B.29
!!! BTQINT5B.30
!!! 30/1/97 4.3 New Deck. S.Jackson BTQINT5B.31
!!! 8/9/97 4.4 L_BL_LSPICE specifies mixed phase precipitation ADM3F404.375
!!! scheme. D.Wilson ADM3F404.376
!!! BTQINT5B.32
!!! CODE DESCRIPTION: BTQINT5B.33
!!! LANGUAGE: FORTRAN 77 + CRAY EXTENSIONS BTQINT5B.34
!!! THIS CODE IS WRITTEN TO UMDP3 PROGRAMMING STANDARDS. BTQINT5B.35
!!! BTQINT5B.36
!!! SYSTEM COMPONENT COVERED: P24 BTQINT5B.37
!!! SYSTEM TASK: BTQINT5B.38
!!!--------------------------------------------------------------------- BTQINT5B.39
SUBROUTINE BTQ_INT ( 2,4BTQINT5B.40
& P_FIELD,P1 BTQINT5B.41
&,P_POINTS,BL_LEVELS BTQINT5B.42
&,BQ,BT,BF,DZL ADM3F404.377
&,RDZ BTQINT5B.44
&,QW,QCF,TL ADM3F404.378
&,L_BL_LSPICE,LTIMER ADM3F404.379
& ) BTQINT5B.47
BTQINT5B.48
IMPLICIT NONE BTQINT5B.49
BTQINT5B.50
! ARGUMENTS WITH INTENT IN. IE: INPUT VARIABLES. BTQINT5B.51
BTQINT5B.52
LOGICAL LTIMER ! IN Flag for TIMER diagnostics BTQINT5B.53
&, L_BL_LSPICE !IN ADM3F404.380
! TRUE Use scientific treatment of mixed ADM3F404.381
! phase precip scheme. ADM3F404.382
! FALSE Do not use mixed phase precip ADM3F404.383
! considerations ADM3F404.384
BTQINT5B.54
INTEGER BTQINT5B.55
& P_FIELD ! IN No. of P-grid points in whole field. BTQINT5B.56
&,P1 ! IN First P-grid point to be processed. BTQINT5B.57
&,P_POINTS ! IN No. of P-grid points to be processed. BTQINT5B.58
&,BL_LEVELS ! IN No. of atmospheric levels for which BTQINT5B.59
! boundary layer fluxes are calculated. BTQINT5B.60
! Assumed ! <=30 for dimensioning GAMMA() BTQINT5B.61
! in common deck C_GAMMA BTQINT5B.62
REAL BTQINT5B.63
& DZL(P_FIELD,BL_LEVELS) ! IN Layer depths (m). DZL(,K) is the BTQINT5B.64
! distance from layer boundary K-1/2 BTQINT5B.65
! to layer boundary K+1/2. For K=1 BTQINT5B.66
! the lower boundary is the surface. BTQINT5B.67
&,RDZ(P_FIELD,BL_LEVELS) ! IN Reciprocal of distance between BTQINT5B.68
! hybrid levels (m-1). 1/RDZ(,K) is BTQINT5B.69
! the vertical distance from level BTQINT5B.70
! K-1 to level K, except that for BTQINT5B.71
! K=1 it is just the height of the BTQINT5B.72
! lowest atmospheric level. BTQINT5B.73
BTQINT5B.74
REAL ! INOUT arrays, BTQINT5B.75
& QW(P_FIELD,BL_LEVELS) ! INOUT Total water content (kg/kg air). BTQINT5B.76
&,QCF(P_FIELD,BL_LEVELS) ! INOUT Ice water content (kg/kg air). ADM3F404.385
&,TL(P_FIELD,BL_LEVELS) ! INOUT Liquid/frozen water temperature BTQINT5B.77
! (K). BTQINT5B.78
&,BQ(P_FIELD,BL_LEVELS) ! INOUT A buoyancy parameter BTQINT5B.79
! (beta q tilde). BTQINT5B.80
&,BT(P_FIELD,BL_LEVELS) ! INOUT A buoyancy parameter BTQINT5B.81
! (beta T tilde). BTQINT5B.82
&,BF(P_FIELD,BL_LEVELS) ! INOUT A buoyancy parameter ADM3F404.386
! (beta F tilde). ADM3F404.387
BTQINT5B.83
!----------------------------------------------------------------------- BTQINT5B.84
! External references :- BTQINT5B.85
EXTERNAL TIMER BTQINT5B.86
BTQINT5B.87
!----------------------------------------------------------------------- BTQINT5B.88
! Local and other symbolic constants :- BTQINT5B.89
*CALL C_LHEAT 
BTQINT5B.90
*CALL C_R_CP BTQINT5B.91
*CALL C_G BTQINT5B.92
*CALL C_0_DG_C BTQINT5B.93
*CALL C_EPSLON BTQINT5B.94
BTQINT5B.95
REAL ETAR,GRCP,LCRCP,LFRCP,LS,LSRCP BTQINT5B.96
PARAMETER ( BTQINT5B.97
& ETAR=1.0/(1.0-EPSILON) ! Used in buoyancy parameter BETAC. BTQINT5B.98
&,GRCP=G/CP ! Used in DZTL, FTL calculations. BTQINT5B.99
&,LCRCP=LC/CP ! Latent heat of condensation / CP. BTQINT5B.100
&,LFRCP=LF/CP ! Latent heat of fusion / CP. BTQINT5B.101
&,LS=LC+LF ! Latent heat of sublimation. BTQINT5B.102
&,LSRCP=LS/CP ! Latent heat of sublimation / CP. BTQINT5B.103
&) BTQINT5B.104
BTQINT5B.105
BTQINT5B.106
! Define local storage. BTQINT5B.107
BTQINT5B.108
! (b) Scalars. BTQINT5B.109
BTQINT5B.110
REAL BTQINT5B.111
& BQM ! Temporary in calculation of Richardson number RI(,K) BTQINT5B.112
&,BTM ! Temporary in calculation of Richardson number RI(,K) BTQINT5B.113
&,BFM ! Temporary in calculation of Richardson number RI(,K) ADM3F404.388
&,DZB ! Temporary in calculation of Richardson number RI(,K). BTQINT5B.114
&,DZQW ! Difference of QW between "current" and "lower" levels. BTQINT5B.115
&,DZTL ! Liquid/ice static energy difference between adjacent BTQINT5B.116
! levels. BTQINT5B.117
&,DZQI ! Difference of QCF between "current" and "lower" levels. ADM3F404.389
&,WK ! Temporary in calculation of RHO. BTQINT5B.118
&,WKM1 ! Temporary in calculation of RHO. BTQINT5B.119
BTQINT5B.120
INTEGER BTQINT5B.121
& I ! Loop counter (horizontal field index). BTQINT5B.122
&,K ! Loop counter (vertical level index). BTQINT5B.123
! ! mixing layer; set to BL_LEVELS-1. BTQINT5B.124
BTQINT5B.125
IF (LTIMER) THEN BTQINT5B.126
CALL TIMER('BTQ_INT ',3) BTQINT5B.127
ENDIF BTQINT5B.128
!----------------------------------------------------------------------- BTQINT5B.129
!! 1. Loop round "boundary" levels. BTQINT5B.130
!----------------------------------------------------------------------- BTQINT5B.131
BTQINT5B.132
DO K=2,BL_LEVELS BTQINT5B.133
DO I=P1,P1+P_POINTS-1 BTQINT5B.134
BTQINT5B.135
!----------------------------------------------------------------------- BTQINT5B.136
!! 2 Calculate wind shear and other "jumps" between "current" and BTQINT5B.137
!! previous (lower) level. BTQINT5B.138
!----------------------------------------------------------------------- BTQINT5B.139
BTQINT5B.140
DZTL = TL(I,K) - TL(I,K-1) + GRCP/RDZ(I,K) ! Used in P243.C2 BTQINT5B.141
DZQW = QW(I,K) - QW(I,K-1) ! Used in P243.C2 BTQINT5B.142
DZQI = QCF(I,K) - QCF(I,K-1) ADM3F404.390
BTQINT5B.143
!----------------------------------------------------------------------- BTQINT5B.144
!! 3. Calculate buoyancy parameters BT, BQ, DZB at interface between BTQINT5B.145
!! "current" and previous levels (i.e. at level K-1/2, if current BTQINT5B.146
!! level is level K). BTQINT5B.147
!----------------------------------------------------------------------- BTQINT5B.148
BTQINT5B.149
WKM1 = 0.5 * DZL(I,K-1) * RDZ(I,K) ! P243.C5 (2nd eqn) BTQINT5B.150
WK = 0.5 * DZL(I,K) * RDZ(I,K) ! P243.C5 (1st eqn) BTQINT5B.151
BTQINT5B.152
BTM = WK*BT(I,K) + WKM1*BT(I,K-1) ! P243.C3 (1st eqn) BTQINT5B.153
BQM = WK*BQ(I,K) + WKM1*BQ(I,K-1) ! P243.C3 (2nd eqn) BTQINT5B.154
BFM = WK*BF(I,K) + WKM1*BF(I,K-1) ADM3F404.391
BTQINT5B.155
IF (L_BL_LSPICE) THEN ADM3F404.392
DZB = BTM*DZTL + BQM*DZQW - BFM*DZQI ADM3F404.393
ELSE ADM3F404.394
DZB = BTM*DZTL + BQM*DZQW ADM3F404.395
ENDIF ADM3F404.396
BTQINT5B.157
! For rationale of next IF block, see the discussion in the last BTQINT5B.158
! paragraph of Appendix C of the P243 documentation. BTQINT5B.159
BTQINT5B.160
IF (DZB.GT.0.0) THEN BTQINT5B.161
BTM = 0.5 * ( BT(I,K) + BT(I,K-1) ) BTQINT5B.162
BQM = 0.5 * ( BQ(I,K) + BQ(I,K-1) ) BTQINT5B.163
BFM = 0.5 * ( BF(I,K) + BF(I,K-1) ) ADM3F404.397
IF (L_BL_LSPICE) THEN ADM3F404.398
DZB = BTM*DZTL + BQM*DZQW - BFM*DZQI ADM3F404.399
ELSE ADM3F404.400
DZB = BTM*DZTL + BQM*DZQW ADM3F404.401
ENDIF ADM3F404.402
ENDIF BTQINT5B.165
BTQINT5B.166
BT(I,K-1) = BTM BTQINT5B.167
BQ(I,K-1) = BQM BTQINT5B.168
BF(I,K-1) = BFM ADM3F404.403
BTQINT5B.169
ENDDO ! p_points BTQINT5B.170
ENDDO ! bl_levels BTQINT5B.171
BTQINT5B.172
IF (LTIMER) THEN BTQINT5B.173
CALL TIMER('BTQ_INT ',4) BTQINT5B.174
ENDIF BTQINT5B.175
BTQINT5B.176
RETURN BTQINT5B.177
END BTQINT5B.178
*ENDIF BTQINT5B.179