*IF DEF,A03_6A BTQINT6A.2
C *****************************COPYRIGHT****************************** BTQINT6A.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. BTQINT6A.4
C BTQINT6A.5
C Use, duplication or disclosure of this code is subject to the BTQINT6A.6
C restrictions as set forth in the contract. BTQINT6A.7
C BTQINT6A.8
C Meteorological Office BTQINT6A.9
C London Road BTQINT6A.10
C BRACKNELL BTQINT6A.11
C Berkshire UK BTQINT6A.12
C RG12 2SZ BTQINT6A.13
C BTQINT6A.14
C If no contract has been raised with this copy of the code, the use, BTQINT6A.15
C duplication or disclosure of it is strictly prohibited. Permission BTQINT6A.16
C to do so must first be obtained in writing from the Head of Numerical BTQINT6A.17
C Modelling at the above address. BTQINT6A.18
C ******************************COPYRIGHT****************************** BTQINT6A.19
! SUBROUTINE BTQ_INT BTQINT6A.20
!!! Purpose: To interpolate buoyancy parameters BT and BQ from full BTQINT6A.21
!!! levels to half levels BTQINT6A.22
!!! BTQINT6A.23
!!! ORIGINAL PROGRAMMER: J. James BTQINT6A.24
!!! CURRENT CODE OWNER: R.N.B. Smith BTQINT6A.25
!!! BTQINT6A.26
!!! HISTORY: BTQINT6A.27
!!! DATE VERSION COMMENT BTQINT6A.28
!!! ---- ------- ------- BTQINT6A.29
!!! BTQINT6A.30
!!! 10/9/97 4.4 New Deck. R.N.B.Smith BTQINT6A.31
!!! BTQINT6A.32
!!! CODE DESCRIPTION: BTQINT6A.33
!!! LANGUAGE: FORTRAN 77 + CRAY EXTENSIONS BTQINT6A.34
!!! THIS CODE IS WRITTEN TO UMDP3 PROGRAMMING STANDARDS. BTQINT6A.35
!!! BTQINT6A.36
!!! SYSTEM COMPONENT COVERED: P24 BTQINT6A.37
!!!--------------------------------------------------------------------- BTQINT6A.38
SUBROUTINE BTQ_INT ( 2,4BTQINT6A.39
& P_FIELD,P1,P_POINTS,BL_LEVELS BTQINT6A.40
&,DZL,RDZ,BQ,BT,BQ_CLD,BT_CLD,A_QS,A_DQSDT BTQINT6A.41
&,BQM,BTM,BQM_CLD,BTM_CLD,A_QSM,A_DQSDTM BTQINT6A.42
&,LTIMER BTQINT6A.43
& ) BTQINT6A.44
BTQINT6A.45
IMPLICIT NONE BTQINT6A.46
BTQINT6A.47
! ARGUMENTS WITH INTENT IN. IE: INPUT VARIABLES. BTQINT6A.48
BTQINT6A.49
LOGICAL LTIMER ! IN Flag for TIMER diagnostics BTQINT6A.50
BTQINT6A.51
INTEGER BTQINT6A.52
& P_FIELD ! IN No. of P-grid points in whole field. BTQINT6A.53
&,P1 ! IN First P-grid point to be processed. BTQINT6A.54
&,P_POINTS ! IN No. of P-grid points to be processed. BTQINT6A.55
&,BL_LEVELS ! IN No. of atmospheric levels for which BTQINT6A.56
! boundary layer fluxes are calculated. BTQINT6A.57
! Assumed ! <=30 for dimensioning GAMMA() BTQINT6A.58
! in common deck C_GAMMA BTQINT6A.59
REAL BTQINT6A.60
& DZL(P_FIELD,BL_LEVELS) ! IN Layer depths (m). DZL(,K) is the BTQINT6A.61
! distance from layer boundary K-1/2 BTQINT6A.62
! to layer boundary K+1/2. For K=1 BTQINT6A.63
! the lower boundary is the surface. BTQINT6A.64
&,RDZ(P_FIELD,BL_LEVELS) ! IN Reciprocal of distance between BTQINT6A.65
! hybrid levels (m-1). 1/RDZ(,K) is BTQINT6A.66
! the vertical distance from level BTQINT6A.67
! K-1 to level K, except that for BTQINT6A.68
! K=1 it is just the height of the BTQINT6A.69
! lowest atmospheric level. BTQINT6A.70
&,BQ(P_FIELD,BL_LEVELS) ! IN A buoyancy parameter for clear air BTQINT6A.71
! ! on p,T,q-levels (full levels). BTQINT6A.72
&,BT(P_FIELD,BL_LEVELS) ! IN A buoyancy parameter for clear air BTQINT6A.73
! ! on p,T,q-levels (full levels). BTQINT6A.74
&,BQ_CLD(P_FIELD,BL_LEVELS) BTQINT6A.75
! ! IN A buoyancy parameter for cloudy air BTQINT6A.76
! ! on p,T,q-levels (full levels). BTQINT6A.77
&,BT_CLD(P_FIELD,BL_LEVELS) BTQINT6A.78
! ! IN A buoyancy parameter for cloudy air BTQINT6A.79
! ! on p,T,q-levels (full levels). BTQINT6A.80
&,A_QS(P_FIELD,BL_LEVELS) BTQINT6A.81
! ! IN Saturated lapse rate factor BTQINT6A.82
! ! on p,T,q-levels (full levels). BTQINT6A.83
&,A_DQSDT(P_FIELD,BL_LEVELS) BTQINT6A.84
! ! IN Saturated lapse rate factor BTQINT6A.85
! ! on p,T,q-levels (full levels). BTQINT6A.86
BTQINT6A.87
REAL ! OUT arrays, BTQINT6A.88
& BQM(P_FIELD,BL_LEVELS) ! OUT A buoyancy parameter for clear air BTQINT6A.89
! ! on intermediate levels (half levels): BTQINT6A.90
! ! (*,K) elements are k+1/2 values. BTQINT6A.91
&,BTM(P_FIELD,BL_LEVELS) ! OUT A buoyancy parameter for clear air BTQINT6A.92
! ! on intermediate levels (half levels): BTQINT6A.93
! ! (*,K) elements are k+1/2 values. BTQINT6A.94
&,BQM_CLD(P_FIELD,BL_LEVELS) BTQINT6A.95
! ! OUT A buoyancy parameter for cloudy air BTQINT6A.96
! ! on intermediate levels (half levels): BTQINT6A.97
! ! (*,K) elements are k+1/2 values. BTQINT6A.98
&,BTM_CLD(P_FIELD,BL_LEVELS) BTQINT6A.99
! ! OUT A buoyancy parameter for cloudy air BTQINT6A.100
! ! on intermediate levels (half levels): BTQINT6A.101
! ! (*,K) elements are k+1/2 values. BTQINT6A.102
&,A_QSM(P_FIELD,BL_LEVELS) BTQINT6A.103
! ! OUT Saturated lapse rate factor BTQINT6A.104
! ! on intermediate levels (half levels): BTQINT6A.105
! ! (*,K) elements are k+1/2 values. BTQINT6A.106
&,A_DQSDTM(P_FIELD,BL_LEVELS) BTQINT6A.107
! ! OUT Saturated lapse rate factor BTQINT6A.108
! ! on intermediate levels (half levels): BTQINT6A.109
! ! (*,K) elements are k+1/2 values. BTQINT6A.110
BTQINT6A.111
BTQINT6A.112
!----------------------------------------------------------------------- BTQINT6A.113
! External references :- BTQINT6A.114
EXTERNAL TIMER BTQINT6A.115
BTQINT6A.116
!----------------------------------------------------------------------- BTQINT6A.117
! Local and other symbolic constants :- BTQINT6A.118
BTQINT6A.119
! Define local storage. BTQINT6A.120
BTQINT6A.121
! (b) Scalars. BTQINT6A.122
BTQINT6A.123
REAL BTQINT6A.124
& WK ! Temporary in weighting factor. BTQINT6A.125
&,WKM1 ! Temporary in weighting factor. BTQINT6A.126
BTQINT6A.127
INTEGER BTQINT6A.128
& I ! Loop counter (horizontal field index). BTQINT6A.129
&,K ! Loop counter (vertical level index). BTQINT6A.130
BTQINT6A.131
IF (LTIMER) THEN BTQINT6A.132
CALL TIMER
('BTQ_INT ',3) BTQINT6A.133
ENDIF BTQINT6A.134
!----------------------------------------------------------------------- BTQINT6A.135
!! 1. Loop round levels. BTQINT6A.136
!----------------------------------------------------------------------- BTQINT6A.137
BTQINT6A.138
DO K=2,BL_LEVELS BTQINT6A.139
DO I=P1,P1+P_POINTS-1 BTQINT6A.140
BTQINT6A.141
!----------------------------------------------------------------------- BTQINT6A.142
!! 1.1 Calculate buoyancy parameters at half levels, BTQINT6A.143
!! i.e. at level K-1/2, if current level is level K. BTQINT6A.144
!----------------------------------------------------------------------- BTQINT6A.145
BTQINT6A.146
WKM1 = 0.5 * DZL(I,K-1) * RDZ(I,K) ! P243.C5 (2nd eqn) BTQINT6A.147
WK = 0.5 * DZL(I,K) * RDZ(I,K) ! P243.C5 (1st eqn) BTQINT6A.148
BTQINT6A.149
BTM(I,K-1) = WKM1*BT(I,K) + WK*BT(I,K-1) BTQINT6A.150
BQM(I,K-1) = WKM1*BQ(I,K) + WK*BQ(I,K-1) BTQINT6A.151
BTM_CLD(I,K-1) = WKM1*BT_CLD(I,K) + WK*BT_CLD(I,K-1) BTQINT6A.152
BQM_CLD(I,K-1) = WKM1*BQ_CLD(I,K) + WK*BQ_CLD(I,K-1) BTQINT6A.153
A_QSM(I,K-1) = WKM1*A_QS(I,K) + WK*A_QS(I,K-1) BTQINT6A.154
A_DQSDTM(I,K-1) = WKM1*A_DQSDT(I,K) + WK*A_DQSDT(I,K-1) BTQINT6A.155
BTQINT6A.156
ENDDO ! p_points BTQINT6A.157
ENDDO ! bl_levels BTQINT6A.158
BTQINT6A.159
IF (LTIMER) THEN BTQINT6A.160
CALL TIMER
('BTQ_INT ',4) BTQINT6A.161
ENDIF BTQINT6A.162
BTQINT6A.163
RETURN BTQINT6A.164
END BTQINT6A.165
*ENDIF BTQINT6A.166