*IF DEF,A05_2A,OR,DEF,A05_3B AJX1F405.183
C ******************************COPYRIGHT****************************** GTS2F400.5257
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.5258
C GTS2F400.5259
C Use, duplication or disclosure of this code is subject to the GTS2F400.5260
C restrictions as set forth in the contract. GTS2F400.5261
C GTS2F400.5262
C Meteorological Office GTS2F400.5263
C London Road GTS2F400.5264
C BRACKNELL GTS2F400.5265
C Berkshire UK GTS2F400.5266
C RG12 2SZ GTS2F400.5267
C GTS2F400.5268
C If no contract has been raised with this copy of the code, the use, GTS2F400.5269
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.5270
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.5271
C Modelling at the above address. GTS2F400.5272
C ******************************COPYRIGHT****************************** GTS2F400.5273
C GTS2F400.5274
CLL SUBROUTINE LAYER_DD-------------------------------------------- LAYERD2A.3
CLL LAYERD2A.4
CLL PURPOSE : CALCULATES LAYER DEPENDENT CONSTANTS FOR LAYER K LAYERD2A.5
CLL -PRESSURE LAYERD2A.6
CLL -LAYER THICKNESS LAYERD2A.7
CLL -ENTRAINMENT COEFFICIENTS LAYERD2A.8
CLL -DETRAINMENT COEFFICIENTS LAYERD2A.9
CLL LAYERD2A.10
CLL SUITABLE FOR SINGLE COLUMN MODEL USE LAYERD2A.11
CLL LAYERD2A.12
CLL CODE WRITTEN FOR CRAY Y-MP BY S.BETT & D.GREGORY SUMMER 1992 LAYERD2A.13
CLL LAYERD2A.14
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: LAYERD2A.15
CLL VERSION DATE LAYERD2A.16
CLL 3.3 23/12/93 : DG060893 : CORRECTION TO PREVENT OVER PREDICTION DG060893.143
CLL OF SNOW SHOWERS; REARRANGEMENT OF DG060893.144
CLL ENTRAINMENT RATES DG060893.145
CLL 4.3 Feb. 97 T3E optimisation: introduce recip_pstar to GSS1F403.209
CLL eliminate divisions by pstar. S.J.Swarbrick GSS1F403.210
!LL 4.5 20/02/98 Remove redundant code. A. Dickinson ADR1F405.50
CLL DG060893.146
CLL LAYERD2A.17
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 3 LAYERD2A.18
CLL VERSION NO. 4 DATED 5/2/92 LAYERD2A.19
CLL LAYERD2A.20
CLL SYSTEM TASK : P27 LAYERD2A.21
CLL LAYERD2A.22
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER P27 LAYERD2A.23
CLL LAYERD2A.24
CLLEND----------------------------------------------------------------- LAYERD2A.25
C LAYERD2A.26
C*L ARGUMENTS--------------------------------------------------------- LAYERD2A.27
C LAYERD2A.28
SUBROUTINE LAYER_DD(NPNTS,K,KCT,THE_K,THE_KM1,FLX_STRT,AK, 4LAYERD2A.29
* BK,AKM12,BKM12,DELAK,DELBK,EXNER_KM12, LAYERD2A.30
* EXNER_KP12,EXNER_KM32,PSTAR,PK,PKM1,DELPK, LAYERD2A.31
* DELPKM1,EXK,EXKM1,AMDETK,EKM14,EKM34,KMIN, LAYERD2A.32
* BDDI,recip_pstar) GSS1F403.211
C LAYERD2A.34
IMPLICIT NONE LAYERD2A.35
C LAYERD2A.36
C---------------------------------------------------------------------- LAYERD2A.37
C MODEL CONSTANTS LAYERD2A.38
C---------------------------------------------------------------------- LAYERD2A.39
C LAYERD2A.40
*CALL C_0_DG_C 
LAYERD2A.41
*CALL C_R_CP LAYERD2A.42
*CALL ENTCNST LAYERD2A.43
*CALL ENTDD LAYERD2A.44
*CALL DDKMDET LAYERD2A.45
C LAYERD2A.46
C---------------------------------------------------------------------- LAYERD2A.47
C VECTOR LENGTHS AND LOOP COUNTER LAYERD2A.48
C---------------------------------------------------------------------- LAYERD2A.49
C LAYERD2A.50
INTEGER NPNTS ! IN VECTOR LENGTH LAYERD2A.51
C LAYERD2A.52
INTEGER K ! IN PRESENT MODEL LAYER LAYERD2A.53
C LAYERD2A.54
INTEGER I ! COUNTER FOR DO LOOPS LAYERD2A.55
C LAYERD2A.56
INTEGER KCT ! IN CONVECTIVE CLOUD TOP LAYER LAYERD2A.57
C LAYERD2A.58
C---------------------------------------------------------------------- LAYERD2A.59
C VARIABLES WHICH ARE INPUT LAYERD2A.60
C---------------------------------------------------------------------- LAYERD2A.61
C LAYERD2A.62
REAL AK(K) ! IN ) HYBRID CO-ORDINATE VALUES AT LAYERD2A.63
REAL BK(K) ! IN ) MID-LAYER OF LAYER K LAYERD2A.64
C LAYERD2A.65
REAL AKM12(K+1) ! IN ) HYBRID CO-ORDINATE VALUES AT LAYERD2A.66
REAL BKM12(K+1) ! IN ) LOWER LAYER BOUNDARY OF LAYER K LAYERD2A.67
C LAYERD2A.68
REAL DELAK(K) ! IN ) HYBRID CO-ORDINATE VALUES FOR LAYERD2A.69
REAL DELBK(K) ! IN ) FOR THICKNESS OF LAYER K LAYERD2A.70
C LAYERD2A.71
REAL PSTAR(NPNTS) ! IN SURFACE PRESSURE (PA) LAYERD2A.72
C LAYERD2A.73
REAL EXNER_KM12(NPNTS) ! IN EXNER FUNCTION AT LAYER K-1/2 LAYERD2A.74
C LAYERD2A.75
REAL EXNER_KP12(NPNTS) ! IN EXNER FUNCTION AT LAYER K+1/2 LAYERD2A.76
C LAYERD2A.77
REAL EXNER_KM32(NPNTS) ! IN EXNER FUNCTION AT LAYER K-3/2 LAYERD2A.78
C LAYERD2A.79
REAL FLX_STRT(NPNTS) ! IN UPDRAUGHT MASSFLUX AT LEVEL WHERE LAYERD2A.80
! DOWNDRAUGHT STARTS (PA/S) LAYERD2A.81
C LAYERD2A.82
REAL THE_K(NPNTS) ! IN POTENTIAL TEMPERATURE OF LAYERD2A.83
! ENVIRONMENT IN LAYER K (K) LAYERD2A.84
C LAYERD2A.85
REAL THE_KM1(NPNTS) ! IN POTENTIAL TEMPERATURE OF LAYERD2A.86
! ENVIRONMENT IN LAYER K-1 (K) LAYERD2A.87
C LAYERD2A.88
LOGICAL BDDI(NPNTS) ! IN MASK FOR POINTS WHERE DOWNDRAUGHT LAYERD2A.89
! MAY INITIATE LAYERD2A.90
REAL recip_PSTAR(NPNTS) ! Reciprocal of pstar array GSS1F403.213
C LAYERD2A.91
C---------------------------------------------------------------------- LAYERD2A.92
C VARIABLES WHICH ARE INPUT AND OUTPUT LAYERD2A.93
C---------------------------------------------------------------------- LAYERD2A.94
C LAYERD2A.95
INTEGER KMIN(NPNTS) ! INOUT LAYERD2A.96
! FREEZING LEVEL LAYERD2A.97
C LAYERD2A.98
C---------------------------------------------------------------------- LAYERD2A.99
C VARIABLES WHICH ARE OUTPUT LAYERD2A.100
C---------------------------------------------------------------------- LAYERD2A.101
C LAYERD2A.102
REAL PK(NPNTS) ! OUT PRESSURE AT LAYER K (PA) LAYERD2A.103
C LAYERD2A.104
REAL PKM1(NPNTS) ! OUT PRESSURE AT LAYER K-1 (PA) LAYERD2A.105
C LAYERD2A.106
REAL DELPK(NPNTS) ! OUT THICKNESS OF LAYER K (PA) LAYERD2A.107
C LAYERD2A.108
REAL DELPKM1(NPNTS) ! OUT THICHNESS OF LAYER K-1 (PA) LAYERD2A.109
C LAYERD2A.110
REAL EKM14(NPNTS) ! OUT ENTRAINMENT COEFFICIENT AT LAYERD2A.111
! LEVEL K-1/4 MULTIPLIED BY LAYERD2A.112
! APPROPRIATE LAYER THICKNESS LAYERD2A.113
C LAYERD2A.114
REAL EKM34(NPNTS) ! OUT ENTRAINMENT COEFFICIENT AT LAYERD2A.115
! LEVEL K-3/4 MULTIPLIED BY LAYERD2A.116
! APPROPRIATE LAYER THICKNESS LAYERD2A.117
C LAYERD2A.118
REAL AMDETK(NPNTS) ! OUT MIXING DETRAINMENT COEFFICIENT LAYERD2A.119
! AT LEVEL K MULTIPLIED BY LAYERD2A.120
! APPROPRIATE LAYER THICKNESS LAYERD2A.121
C LAYERD2A.122
REAL EXK(NPNTS) ! OUT EXNER FUNCTION AT LEVEL K LAYERD2A.123
C LAYERD2A.124
REAL EXKM1(NPNTS) ! OUT EXNER FUNCTION AT LEVEL K-1 LAYERD2A.125
C LAYERD2A.126
C---------------------------------------------------------------------- LAYERD2A.127
C VARIABLES WHICH ARE DEFINED LOCALLY LAYERD2A.128
C---------------------------------------------------------------------- LAYERD2A.129
C LAYERD2A.130
REAL TTK ! TEMPERATURE STORE AT LAYER K LAYERD2A.131
C LAYERD2A.132
REAL TTKM1 ! TEMPERATURE STORE AT LAYER K-1 LAYERD2A.133
C LAYERD2A.134
REAL THKM12 ! POTENTIAL TEMPERATURE STORE AT LAYERD2A.135
! LAYER K-1/2 LAYERD2A.136
C LAYERD2A.137
REAL TTKM12 ! TEMPERATURE STORE AT LAYER K-1/2 LAYERD2A.138
C LAYERD2A.139
REAL INCR_FAC ! INCREMENT FACTOR FOR ENTRAINMENT LAYERD2A.140
! RATES AT FREEZING LEVEL LAYERD2A.141
C LAYERD2A.142
REAL LAYERD2A.143
& PU,PL LAYERD2A.144
*CALL P_EXNERC LAYERD2A.145
LAYERD2A.146
C---------------------------------------------------------------------- LAYERD2A.147
C SET KMIN TO INITIAL VALUE LAYERD2A.148
CL CALCULATE PK, DELPK AND EXNER FUNCTION - IF K = KCT THEN LAYERD2A.149
CL VALUES FOR PREVIOUS PASS THROUGH ROUTINE AT (K-1)+1 ARE TAKEN LAYERD2A.150
C---------------------------------------------------------------------- LAYERD2A.151
C LAYERD2A.152
IF (K.EQ.KCT+1) THEN LAYERD2A.153
DO I=1,NPNTS LAYERD2A.154
KMIN(I) = KCT+2 LAYERD2A.155
PK(I) = AK(K) + BK(K)*PSTAR(I) LAYERD2A.156
DELPK(I) = - DELAK(K) - DELBK(K)*PSTAR(I) LAYERD2A.157
PU=PSTAR(I)*BKM12(K+1) + AKM12(K+1) LAYERD2A.158
PL=PSTAR(I)*BKM12(K) + AKM12(K) LAYERD2A.159
EXK(I) = P_EXNER_C(EXNER_KP12(I),EXNER_KM12(I),PU,PL,KAPPA) LAYERD2A.160
END DO LAYERD2A.161
ELSE LAYERD2A.162
DO I=1,NPNTS LAYERD2A.163
PK(I) = PKM1(I) LAYERD2A.164
DELPK(I) = DELPKM1(I) LAYERD2A.165
EXK(I) = EXKM1(I) LAYERD2A.166
END DO LAYERD2A.167
END IF LAYERD2A.168
CL LAYERD2A.169
CL--------------------------------------------------------------------- LAYERD2A.170
CL CALCULATE PKM1, DELPKM1 LAYERD2A.171
CL CALCULATE EXNER FUNCTIONS AT MID-LAYES K AND K-1, AND LAYERD2A.172
CL DIFFERENCE OF EXNER FUNCTION ACROSS LAYER K LAYERD2A.173
CL--------------------------------------------------------------------- LAYERD2A.174
CL LAYERD2A.175
DO I=1,NPNTS LAYERD2A.176
PKM1(I) = AK(K-1) + BK(K-1)*PSTAR(I) LAYERD2A.177
DELPKM1(I) = - DELAK(K-1) - DELBK(K-1)*PSTAR(I) LAYERD2A.178
PU=PSTAR(I)*BKM12(K) + AKM12(K) LAYERD2A.179
PL=PSTAR(I)*BKM12(K-1) + AKM12(K-1) LAYERD2A.180
EXKM1(I) = P_EXNER_C(EXNER_KM12(I),EXNER_KM32(I),PU,PL,KAPPA) LAYERD2A.181
C LAYERD2A.182
CL LAYERD2A.183
CL--------------------------------------------------------------------- LAYERD2A.184
CL CALCULATE FREEZING LEVEL : CHECK IF FREEZING LEVEL IN THIS LAYER LAYERD2A.185
CL--------------------------------------------------------------------- LAYERD2A.186
CL LAYERD2A.187
IF (KMIN(I).EQ.KCT+2) THEN LAYERD2A.188
TTK = THE_K(I)*EXK(I) LAYERD2A.189
TTKM1 = THE_KM1(I)*EXKM1(I) LAYERD2A.190
THKM12 = (THE_KM1(I)+THE_K(I))*0.5 LAYERD2A.191
TTKM12 = THKM12*EXNER_KM12(I) LAYERD2A.192
IF (TTKM12 .GE. TM .AND. TTK .LT. TM) THEN LAYERD2A.193
KMIN(I) = K LAYERD2A.194
ELSE IF (TTKM1 .GE. TM .AND. TTKM12 .LT. TM) THEN LAYERD2A.195
KMIN(I) = K-1 LAYERD2A.196
END IF LAYERD2A.197
END IF LAYERD2A.198
C LAYERD2A.199
CL LAYERD2A.200
CL--------------------------------------------------------------------- LAYERD2A.201
CL CALCULATE ENTRAINMENT COEFFICIENTS MULTIPLIED BY LAYERD2A.202
CL APPROPRIATE LAYER THICKNESS LAYERD2A.203
CL LAYERD2A.204
CL CALCULATE MIXING DETRAINMENT COEFFICIENT MULTIPLIED BY LAYERD2A.205
CL APPROPRIATE LAYER THICKNESS LAYERD2A.206
CL LAYERD2A.207
CL UM DOCUMENTATION PAPER P27 LAYERD2A.208
CL SECTION (2C), EQUATION(14) LAYERD2A.209
CL--------------------------------------------------------------------- LAYERD2A.210
CL LAYERD2A.211
IF (PK(I).LT.PSTAR(I)-DET_LYR) THEN LAYERD2A.215
EKM14(I) = AE2 * (AKM12(K)+BKM12(K)*PSTAR(I)-PK(I)) * GSS1F403.218
& recip_PSTAR(I) GSS1F403.219
EKM34(I) = AE2 * (PKM1(I)-AKM12(K)-BKM12(K)*PSTAR(I)) * GSS1F403.220
& recip_PSTAR(I) GSS1F403.221
AMDETK(I) = (EKM14(I)+EKM34(I)) * (1.0-1.0/AE2) DG060893.149
ELSE LAYERD2A.217
EKM14(I) = 0.0 DG060893.150
EKM34(I) = 0.0 DG060893.151
AMDETK(I) = DELPK(I) / (PSTAR(I)*(1.0-BKM12(K+1))-AKM12(K+1)) DG060893.152
END IF LAYERD2A.219
C LAYERD2A.220
IF (BDDI(I)) THEN LAYERD2A.221
C LAYERD2A.222
IF (K.EQ.KMIN(I) .AND. PK(I).LT.PSTAR(I)-DET_LYR) THEN LAYERD2A.223
INCR_FAC = FLX_STRT(I)*DDCOEF1*recip_PSTAR(I) GSS1F403.225
IF (INCR_FAC.GT.6.0) INCR_FAC=6.0 LAYERD2A.225
EKM14(I) = EKM14(I)*INCR_FAC LAYERD2A.226
EKM34(I) = EKM34(I)*INCR_FAC LAYERD2A.227
ELSE LAYERD2A.228
EKM14(I) = EKM14(I)*DDCOEF2 LAYERD2A.229
EKM34(I) = EKM34(I)*DDCOEF2 LAYERD2A.230
IF (KMIN(I).NE.KCT+2 .AND. K.LT.KMIN(I) .AND. PK(I).LT. LAYERD2A.231
* PSTAR(I)-DET_LYR) AMDETK(I) = AMDETK(I)*DDCOEF2 LAYERD2A.232
END IF LAYERD2A.233
C LAYERD2A.234
END IF LAYERD2A.235
END DO LAYERD2A.236
C LAYERD2A.237
RETURN LAYERD2A.238
END LAYERD2A.239
C LAYERD2A.240
*ENDIF LAYERD2A.241