*IF DEF,A05_2C LAYERD2C.2
C ******************************COPYRIGHT****************************** LAYERD2C.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. LAYERD2C.4
C LAYERD2C.5
C Use, duplication or disclosure of this code is subject to the LAYERD2C.6
C restrictions as set forth in the contract. LAYERD2C.7
C LAYERD2C.8
C Meteorological Office LAYERD2C.9
C London Road LAYERD2C.10
C BRACKNELL LAYERD2C.11
C Berkshire UK LAYERD2C.12
C RG12 2SZ LAYERD2C.13
C LAYERD2C.14
C If no contract has been raised with this copy of the code, the use, LAYERD2C.15
C duplication or disclosure of it is strictly prohibited. Permission LAYERD2C.16
C to do so must first be obtained in writing from the Head of Numerical LAYERD2C.17
C Modelling at the above address. LAYERD2C.18
C ******************************COPYRIGHT****************************** LAYERD2C.19
C LAYERD2C.20
CLL SUBROUTINE LAYER_DD-------------------------------------------- LAYERD2C.21
CLL LAYERD2C.22
CLL PURPOSE : CALCULATES LAYER DEPENDENT CONSTANTS FOR LAYER K LAYERD2C.23
CLL -PRESSURE LAYERD2C.24
CLL -LAYER THICKNESS LAYERD2C.25
CLL -ENTRAINMENT COEFFICIENTS LAYERD2C.26
CLL -DETRAINMENT COEFFICIENTS LAYERD2C.27
CLL LAYERD2C.28
CLL SUITABLE FOR SINGLE COLUMN MODEL USE LAYERD2C.29
CLL LAYERD2C.30
CLL MODEL MODIFICATION HISTORY:: LAYERD2C.31
CLL VERSION DATE LAYERD2C.32
CLL 4.2 1/11/96 New deck version based on LAYERD2A with HADCM2 LAYERD2C.33
CLL specific modifications: R Jones LAYERD2C.34
CLL 4.3 Feb. 97 T3E optimisation: introduce recip_pstar to GSS1F403.228
CLL eliminate divisions by pstar. S.J.Swarbrick GSS1F403.229
!LL 4.5 18/02/98 Call comdecks. D. Robinson. ADR1F405.51
!LL 20/02/98 Remove redundant code. A. Dickinson ADR1F405.52
CLL LAYERD2C.35
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 3 LAYERD2C.36
CLL VERSION NO. 4 DATED 5/2/92 LAYERD2C.37
CLL LAYERD2C.38
CLL SYSTEM TASK : P27 LAYERD2C.39
CLL LAYERD2C.40
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER 27 LAYERD2C.41
CLL LAYERD2C.42
CLLEND----------------------------------------------------------------- LAYERD2C.43
C LAYERD2C.44
C*L ARGUMENTS--------------------------------------------------------- LAYERD2C.45
C LAYERD2C.46
SUBROUTINE LAYER_DD(NPNTS,K,KCT,THE_K,THE_KM1,FLX_STRT,AK, 4LAYERD2C.47
* BK,AKM12,BKM12,DELAK,DELBK,EXNER_KM12, LAYERD2C.48
* EXNER_KP12,EXNER_KM32,PSTAR,PK,PKM1,DELPK, LAYERD2C.49
* DELPKM1,EXK,EXKM1,AMDETK,EKM14,EKM34,KMIN, LAYERD2C.50
* BDDI,recip_pstar) GSS1F403.230
C LAYERD2C.52
IMPLICIT NONE LAYERD2C.53
C LAYERD2C.54
C---------------------------------------------------------------------- LAYERD2C.55
C MODEL CONSTANTS LAYERD2C.56
C---------------------------------------------------------------------- LAYERD2C.57
C LAYERD2C.58
*CALL C_0_DG_C 
ADR1F405.53
*CALL C_R_CP ADR1F405.54
*CALL ENTCNST ADR1F405.55
*CALL ENTDD ADR1F405.56
*CALL DDKMDET ADR1F405.57
C LAYERD2C.97
C---------------------------------------------------------------------- LAYERD2C.98
C VECTOR LENGTHS AND LOOP COUNTER LAYERD2C.99
C---------------------------------------------------------------------- LAYERD2C.100
C LAYERD2C.101
INTEGER NPNTS ! IN VECTOR LENGTH LAYERD2C.102
C LAYERD2C.103
INTEGER K ! IN PRESENT MODEL LAYER LAYERD2C.104
C LAYERD2C.105
INTEGER I ! COUNTER FOR DO LOOPS LAYERD2C.106
C LAYERD2C.107
INTEGER KCT ! IN CONVECTIVE CLOUD TOP LAYER LAYERD2C.108
C LAYERD2C.109
C---------------------------------------------------------------------- LAYERD2C.110
C VARIABLES WHICH ARE INPUT LAYERD2C.111
C---------------------------------------------------------------------- LAYERD2C.112
C LAYERD2C.113
REAL AK(K) ! IN ) HYBRID CO-ORDINATE VALUES AT LAYERD2C.114
REAL BK(K) ! IN ) MID-LAYER OF LAYER K LAYERD2C.115
C LAYERD2C.116
REAL AKM12(K+1) ! IN ) HYBRID CO-ORDINATE VALUES AT LAYERD2C.117
REAL BKM12(K+1) ! IN ) LOWER LAYER BOUNDARY OF LAYER K LAYERD2C.118
C LAYERD2C.119
REAL DELAK(K) ! IN ) HYBRID CO-ORDINATE VALUES FOR LAYERD2C.120
REAL DELBK(K) ! IN ) FOR THICKNESS OF LAYER K LAYERD2C.121
C LAYERD2C.122
REAL PSTAR(NPNTS) ! IN SURFACE PRESSURE (PA) LAYERD2C.123
C LAYERD2C.124
REAL EXNER_KM12(NPNTS) ! IN EXNER FUNCTION AT LAYER K-1/2 LAYERD2C.125
C LAYERD2C.126
REAL EXNER_KP12(NPNTS) ! IN EXNER FUNCTION AT LAYER K+1/2 LAYERD2C.127
C LAYERD2C.128
REAL EXNER_KM32(NPNTS) ! IN EXNER FUNCTION AT LAYER K-3/2 LAYERD2C.129
C LAYERD2C.130
REAL FLX_STRT(NPNTS) ! IN UPDRAUGHT MASSFLUX AT LEVEL WHERE LAYERD2C.131
! DOWNDRAUGHT STARTS (PA/S) LAYERD2C.132
C LAYERD2C.133
REAL THE_K(NPNTS) ! IN POTENTIAL TEMPERATURE OF LAYERD2C.134
! ENVIRONMENT IN LAYER K (K) LAYERD2C.135
C LAYERD2C.136
REAL THE_KM1(NPNTS) ! IN POTENTIAL TEMPERATURE OF LAYERD2C.137
! ENVIRONMENT IN LAYER K-1 (K) LAYERD2C.138
C LAYERD2C.139
LOGICAL BDDI(NPNTS) ! IN MASK FOR POINTS WHERE DOWNDRAUGHT LAYERD2C.140
! MAY INITIATE LAYERD2C.141
REAL recip_PSTAR(NPNTS)! Reciprocal of pstar array GSS1F403.232
C LAYERD2C.142
C---------------------------------------------------------------------- LAYERD2C.143
C VARIABLES WHICH ARE INPUT AND OUTPUT LAYERD2C.144
C---------------------------------------------------------------------- LAYERD2C.145
C LAYERD2C.146
INTEGER KMIN(NPNTS) ! INOUT LAYERD2C.147
! FREEZING LEVEL LAYERD2C.148
C LAYERD2C.149
C---------------------------------------------------------------------- LAYERD2C.150
C VARIABLES WHICH ARE OUTPUT LAYERD2C.151
C---------------------------------------------------------------------- LAYERD2C.152
C LAYERD2C.153
REAL PK(NPNTS) ! OUT PRESSURE AT LAYER K (PA) LAYERD2C.154
C LAYERD2C.155
REAL PKM1(NPNTS) ! OUT PRESSURE AT LAYER K-1 (PA) LAYERD2C.156
C LAYERD2C.157
REAL DELPK(NPNTS) ! OUT THICKNESS OF LAYER K (PA) LAYERD2C.158
C LAYERD2C.159
REAL DELPKM1(NPNTS) ! OUT THICHNESS OF LAYER K-1 (PA) LAYERD2C.160
C LAYERD2C.161
REAL EKM14(NPNTS) ! OUT ENTRAINMENT COEFFICIENT AT LAYERD2C.162
! LEVEL K-1/4 MULTIPLIED BY LAYERD2C.163
! APPROPRIATE LAYER THICKNESS LAYERD2C.164
C LAYERD2C.165
REAL EKM34(NPNTS) ! OUT ENTRAINMENT COEFFICIENT AT LAYERD2C.166
! LEVEL K-3/4 MULTIPLIED BY LAYERD2C.167
! APPROPRIATE LAYER THICKNESS LAYERD2C.168
C LAYERD2C.169
REAL AMDETK(NPNTS) ! OUT MIXING DETRAINMENT COEFFICIENT LAYERD2C.170
! AT LEVEL K MULTIPLIED BY LAYERD2C.171
! APPROPRIATE LAYER THICKNESS LAYERD2C.172
C LAYERD2C.173
REAL EXK(NPNTS) ! OUT EXNER FUNCTION AT LEVEL K LAYERD2C.174
C LAYERD2C.175
REAL EXKM1(NPNTS) ! OUT EXNER FUNCTION AT LEVEL K-1 LAYERD2C.176
C LAYERD2C.177
C---------------------------------------------------------------------- LAYERD2C.178
C VARIABLES WHICH ARE DEFINED LOCALLY LAYERD2C.179
C---------------------------------------------------------------------- LAYERD2C.180
C LAYERD2C.181
REAL TTK ! TEMPERATURE STORE AT LAYER K LAYERD2C.182
C LAYERD2C.183
REAL TTKM1 ! TEMPERATURE STORE AT LAYER K-1 LAYERD2C.184
C LAYERD2C.185
REAL THKM12 ! POTENTIAL TEMPERATURE STORE AT LAYERD2C.186
! LAYER K-1/2 LAYERD2C.187
C LAYERD2C.188
REAL TTKM12 ! TEMPERATURE STORE AT LAYER K-1/2 LAYERD2C.189
C LAYERD2C.190
REAL INCR_FAC ! INCREMENT FACTOR FOR ENTRAINMENT LAYERD2C.191
! RATES AT FREEZING LEVEL LAYERD2C.192
C LAYERD2C.193
REAL LAYERD2C.194
& PU,PL LAYERD2C.195
*CALL P_EXNERC ADR1F405.58
LAYERD2C.208
C---------------------------------------------------------------------- LAYERD2C.209
C SET KMIN TO INITIAL VALUE LAYERD2C.210
CL CALCULATE PK, DELPK AND EXNER FUNCTION - IF K = KCT THEN LAYERD2C.211
CL VALUES FOR PREVIOUS PASS THROUGH ROUTINE AT (K-1)+1 ARE TAKEN LAYERD2C.212
C---------------------------------------------------------------------- LAYERD2C.213
C LAYERD2C.214
IF (K.EQ.KCT+1) THEN LAYERD2C.215
DO I=1,NPNTS LAYERD2C.216
KMIN(I) = KCT+2 LAYERD2C.217
PK(I) = AK(K) + BK(K)*PSTAR(I) LAYERD2C.218
DELPK(I) = - DELAK(K) - DELBK(K)*PSTAR(I) LAYERD2C.219
PU=PSTAR(I)*BKM12(K+1) + AKM12(K+1) LAYERD2C.220
PL=PSTAR(I)*BKM12(K) + AKM12(K) LAYERD2C.221
EXK(I) = P_EXNER_C(EXNER_KP12(I),EXNER_KM12(I),PU,PL,KAPPA) LAYERD2C.222
END DO LAYERD2C.223
ELSE LAYERD2C.224
DO I=1,NPNTS LAYERD2C.225
PK(I) = PKM1(I) LAYERD2C.226
DELPK(I) = DELPKM1(I) LAYERD2C.227
EXK(I) = EXKM1(I) LAYERD2C.228
END DO LAYERD2C.229
END IF LAYERD2C.230
CL LAYERD2C.231
CL--------------------------------------------------------------------- LAYERD2C.232
CL CALCULATE PKM1, DELPKM1 LAYERD2C.233
CL CALCULATE EXNER FUNCTIONS AT MID-LAYES K AND K-1, AND LAYERD2C.234
CL DIFFERENCE OF EXNER FUNCTION ACROSS LAYER K LAYERD2C.235
CL--------------------------------------------------------------------- LAYERD2C.236
CL LAYERD2C.237
DO I=1,NPNTS LAYERD2C.238
PKM1(I) = AK(K-1) + BK(K-1)*PSTAR(I) LAYERD2C.239
DELPKM1(I) = - DELAK(K-1) - DELBK(K-1)*PSTAR(I) LAYERD2C.240
PU=PSTAR(I)*BKM12(K) + AKM12(K) LAYERD2C.241
PL=PSTAR(I)*BKM12(K-1) + AKM12(K-1) LAYERD2C.242
EXKM1(I) = P_EXNER_C(EXNER_KM12(I),EXNER_KM32(I),PU,PL,KAPPA) LAYERD2C.243
C LAYERD2C.244
CL LAYERD2C.245
CL--------------------------------------------------------------------- LAYERD2C.246
CL CALCULATE FREEZING LEVEL : CHECK IF FREEZING LEVEL IN THIS LAYER LAYERD2C.247
CL--------------------------------------------------------------------- LAYERD2C.248
CL LAYERD2C.249
IF (KMIN(I).EQ.KCT+2) THEN LAYERD2C.250
TTK = THE_K(I)*EXK(I) LAYERD2C.251
TTKM1 = THE_KM1(I)*EXKM1(I) LAYERD2C.252
THKM12 = (THE_KM1(I)+THE_K(I))*0.5 LAYERD2C.253
TTKM12 = THKM12*EXNER_KM12(I) LAYERD2C.254
IF (TTKM12 .GE. TM .AND. TTK .LT. TM) THEN LAYERD2C.255
KMIN(I) = K LAYERD2C.256
ELSE IF (TTKM1 .GE. TM .AND. TTKM12 .LT. TM) THEN LAYERD2C.257
KMIN(I) = K-1 LAYERD2C.258
END IF LAYERD2C.259
END IF LAYERD2C.260
C LAYERD2C.261
CL LAYERD2C.262
CL--------------------------------------------------------------------- LAYERD2C.263
CL CALCULATE ENTRAINMENT COEFFICIENTS MULTIPLIED BY LAYERD2C.264
CL APPROPRIATE LAYER THICKNESS LAYERD2C.265
CL LAYERD2C.266
CL CALCULATE MIXING DETRAINMENT COEFFICIENT MULTIPLIED BY LAYERD2C.267
CL APPROPRIATE LAYER THICKNESS LAYERD2C.268
CL LAYERD2C.269
CL UM DOCUMENTATION PAPER P27 LAYERD2C.270
CL SECTION (2C), EQUATION(14) LAYERD2C.271
CL--------------------------------------------------------------------- LAYERD2C.272
CL LAYERD2C.273
EKM14(I) = AE2 * (AKM12(K)+BKM12(K)*PSTAR(I)-PK(I)) * GSS1F403.237
& recip_PSTAR(I) GSS1F403.238
EKM34(I) = AE2 * (PKM1(I)-AKM12(K)-BKM12(K)*PSTAR(I)) * GSS1F403.239
& recip_PSTAR(I) GSS1F403.240
C LAYERD2C.276
IF (PK(I).LT.PSTAR(I)-DET_LYR) THEN LAYERD2C.277
AMDETK(I) = (EKM14(I)+EKM34(I)) * (1.0-1.0/AE2) LAYERD2C.278
ELSE LAYERD2C.279
AMDETK(I) = DELPK(I) / (PSTAR(I)*(1.0-BKM12(K+1))-AKM12(K+1)) LAYERD2C.280
END IF LAYERD2C.281
C LAYERD2C.282
IF (BDDI(I)) THEN LAYERD2C.283
C LAYERD2C.284
IF (K.EQ.KMIN(I) .AND. PK(I).LT.PSTAR(I)-DET_LYR) THEN LAYERD2C.285
INCR_FAC = FLX_STRT(I)*DDCOEF1*recip_pstar(I) GSS1F403.244
IF (INCR_FAC.GT.6.0) INCR_FAC=6.0 LAYERD2C.287
EKM14(I) = EKM14(I)*INCR_FAC LAYERD2C.288
EKM34(I) = EKM34(I)*INCR_FAC LAYERD2C.289
ELSE LAYERD2C.290
EKM14(I) = EKM14(I)*DDCOEF2 LAYERD2C.291
EKM34(I) = EKM34(I)*DDCOEF2 LAYERD2C.292
IF (KMIN(I).NE.KCT+2 .AND. K.LT.KMIN(I) .AND. PK(I).LT. LAYERD2C.293
* PSTAR(I)-DET_LYR) AMDETK(I) = AMDETK(I)*DDCOEF2 LAYERD2C.294
END IF LAYERD2C.295
C LAYERD2C.296
END IF LAYERD2C.297
END DO LAYERD2C.298
C LAYERD2C.299
RETURN LAYERD2C.300
END LAYERD2C.301
C LAYERD2C.302
*ENDIF LAYERD2C.303