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