*IF DEF,A05_2A,OR,DEF,A05_2C,OR,DEF,A05_3B,OR,DEF,A05_3C AJX1F405.126
C ******************************COPYRIGHT****************************** GTS2F400.1909
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.1910
C GTS2F400.1911
C Use, duplication or disclosure of this code is subject to the GTS2F400.1912
C restrictions as set forth in the contract. GTS2F400.1913
C GTS2F400.1914
C Meteorological Office GTS2F400.1915
C London Road GTS2F400.1916
C BRACKNELL GTS2F400.1917
C Berkshire UK GTS2F400.1918
C RG12 2SZ GTS2F400.1919
C GTS2F400.1920
C If no contract has been raised with this copy of the code, the use, GTS2F400.1921
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.1922
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.1923
C Modelling at the above address. GTS2F400.1924
C ******************************COPYRIGHT****************************** GTS2F400.1925
C GTS2F400.1926
CLL SUBROUTINE DETRAIN------------------------------------------------ DETRAI1A.3
CLL DETRAI1A.4
CLL PURPOSE : FORCED DETRAINMENT CALCULATION DETRAI1A.5
CLL DETRAI1A.6
CLL SUBROUTINE THP_DET CALCULATES THE POTENTIAL DETRAI1A.7
CLL TEMPERATURE OF THE PARCEL IN LAYER K+1 DETRAI1A.8
CLL AFTER FORCED DETRAINMENT DETRAI1A.9
CLL DETRAI1A.10
CLL SUBROUTINE THETAR CALCULATES THE POTENTIAL TEMPERATURE DETRAI1A.11
CLL OF THE AIR IN LAYER K UNDERGOING FORCED DETRAINMENT DETRAI1A.12
CLL DETRAI1A.13
CLL SUBROUTINE DET_RATE CALCULATES THE FORCED DETRAINMENT DETRAI1A.14
CLL RATE OF THE ENSEMBLE IN LAYER K DETRAI1A.15
CLL DETRAI1A.16
CLL SUITABLE FOR SINGLE COLUMN MODEL USE DETRAI1A.17
CLL DETRAI1A.18
CLL CODE REWORKED FOR CRAY Y-MP BY D.GREGORY AUTUMN/WINTER 1989/90 DETRAI1A.19
CLL DETRAI1A.20
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: DETRAI1A.21
CLL VERSION DATE DETRAI1A.22
CLL 3.3 23/12/93 : DG020893 : TO MAKE CALCULATIONS OF FORCED DG020893.1
CLL DETRAINMENT RATE LESS PRONE TO DG020893.2
CLL FAILURE DG020893.3
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.8
CLL DG020893.4
CLL DETRAI1A.23
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 4 DETRAI1A.24
CLL VERSION NO. 1 DETRAI1A.25
CLL DETRAI1A.26
CLL LOGICAL COMPONENTS COVERED: P27 DETRAI1A.27
CLL DETRAI1A.28
CLL SYSTEM TASK : DETRAI1A.29
CLL DETRAI1A.30
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER P27 DETRAI1A.31
CLL DETRAI1A.32
CLLEND----------------------------------------------------------------- DETRAI1A.33
C DETRAI1A.34
C*L ARGUMENTS--------------------------------------------------------- DETRAI1A.35
C DETRAI1A.36
SUBROUTINE DETRAIN (NPNTS,THEK,QEK,THPK,QPK,QSEK,DQSK,BGMK, 2,7DETRAI1A.37
* THEKP1,QEKP1,THPKP1,QPKP1,QSEKP1,DQSKP1, DETRAI1A.38
* BGMKP1,BWKP1,XSQKP1, DETRAI1A.39
* DELTAK,THRK,QRK,EKP14,EKP34,PK,PKP1, DETRAI1A.40
* EXK,EXKP1) DETRAI1A.41
C DETRAI1A.42
IMPLICIT NONE DETRAI1A.43
C DETRAI1A.44
C---------------------------------------------------------------------- DETRAI1A.45
C VECTOR LENGTHS AND LOOP COUNTERS DETRAI1A.46
C---------------------------------------------------------------------- DETRAI1A.47
C DETRAI1A.48
INTEGER NPNTS ! IN VECTOR LENGTH DETRAI1A.52
C DETRAI1A.53
INTEGER I ! LOOP COUNTER DETRAI1A.54
C DETRAI1A.55
INTEGER NREDO ! NUMBER OF POINTS FOR WHICH FORCED DETRAI1A.56
! DETRAINMENT CALCULATION MUST BE DETRAI1A.57
! AS THE PROCESSES EITHER CAUSES THE DETRAI1A.58
! PARCEL TO BECOME SATURATED OR DETRAI1A.59
! SUB-SATURATED DETRAI1A.60
C DETRAI1A.61
C DETRAI1A.62
C---------------------------------------------------------------------- DETRAI1A.63
C VECTOR LENGTHS AND LOOP COUNTERS DETRAI1A.64
C---------------------------------------------------------------------- DETRAI1A.65
C DETRAI1A.66
REAL THEK(NPNTS) ! IN POTENTIAL TEMPERATURE OF CLOUD DETRAI1A.67
! ENVIRONMENT IN LAYER K (K) DETRAI1A.68
C DETRAI1A.69
REAL THEKP1(NPNTS) ! IN POTENTIAL TEMPERATURE OF CLOUD DETRAI1A.70
! ENVIRONMENT IN LAYER K+1 (K) DETRAI1A.71
C DETRAI1A.72
REAL QEK(NPNTS) ! IN MIXING RATIO OF CLOUD DETRAI1A.73
! ENVIRONMENT IN LAYER K (KG/KG) DETRAI1A.74
C DETRAI1A.75
REAL QEKP1(NPNTS) ! IN MIXING RATIO OF CLOUD DETRAI1A.76
! ENVIRONMENT IN LAYER K+1 (KG/KG) DETRAI1A.77
C DETRAI1A.78
REAL QSEKP1(NPNTS) ! IN SATURATION MIXING RATIO OF CLOUD DETRAI1A.79
! ENVIRONMENT IN LAYER K+1 (KG/KG) DETRAI1A.80
C DETRAI1A.81
REAL DQSKP1(NPNTS) ! IN GRADIENT OF SATURATION MIXING RATIO DETRAI1A.82
! WITH POTENTIAL TEMPERATURE FOR THE DETRAI1A.83
! CLOUD ENVIRONMENT IN LAYER K+1 DETRAI1A.84
! (KG/KG/K) DETRAI1A.85
C DETRAI1A.86
REAL THPK(NPNTS) ! IN PARCEL POTENTIAL TEMPERATURE IN DETRAI1A.87
! LAYER K (K) DETRAI1A.88
C DETRAI1A.89
REAL QPK(NPNTS) ! IN PARCEL MIXING RATIO IN LAYER K (KG/KG) DETRAI1A.90
C DETRAI1A.91
REAL QSEK(NPNTS) ! IN SATURATION MIXING RATIO OF CLOUD DETRAI1A.92
! ENVIRONMENT IN LAYER K (KG/KG) DETRAI1A.93
C DETRAI1A.94
REAL DQSK(NPNTS) ! IN GRADIENT OF SATURATION MIXING RATIO DETRAI1A.95
! WITH POTENTIAL TEMPERATURE FOR THE DETRAI1A.96
! CLOUD ENVIRONMENT OF LAYER K DETRAI1A.97
! (KG/KG/K) DETRAI1A.98
C DETRAI1A.99
LOGICAL BWKP1(NPNTS) ! IN MASK FOR WHETHER CONDENSATE IS DETRAI1A.100
! LIQUID IN LAYER K+1 DETRAI1A.101
C DETRAI1A.102
LOGICAL BGMK(NPNTS) ! IN MASK FOR PARCELS WHICH ARE DETRAI1A.103
! SATURATED IN LAYER K DETRAI1A.104
C DETRAI1A.105
REAL EKP14(NPNTS) ! IN ENTRAINMENT COEFFICIENT AT LEVEL DETRAI1A.106
! K+1/4 MULTIPLIED BY APPROPRIATE DETRAI1A.107
! LAYER THICKNESS DETRAI1A.108
C DETRAI1A.109
REAL EKP34(NPNTS) ! IN ENTRAINMENT COEFFICIENT AT LEVEL DETRAI1A.110
! K+3/4 MULTIPLIED BY APPROPRIATE DETRAI1A.111
! LAYER THICKNESS DETRAI1A.112
C DETRAI1A.113
REAL EXKP1(NPNTS) ! IN EXNER RATIO AT LEVEL K+1 DETRAI1A.114
C DETRAI1A.115
REAL EXK(NPNTS) ! IN EXNER RATIO AT LEVEL K DETRAI1A.116
C DETRAI1A.117
REAL PKP1(NPNTS) ! IN PRESSURE AT LEVEL K+1 (PA) DETRAI1A.118
C DETRAI1A.119
REAL PK(NPNTS) ! IN PRESSURE AT LEVEL K (PA) DETRAI1A.120
C DETRAI1A.121
C DETRAI1A.122
C----------------------------------------------------------------------- DETRAI1A.123
C VARIABLES WHICH INPUT AND OUTPUT DETRAI1A.124
C----------------------------------------------------------------------- DETRAI1A.125
C DETRAI1A.126
REAL THPKP1(NPNTS) ! INOUT DETRAI1A.127
! IN PARCEL POTENTIAL TEMPERATURE IN DETRAI1A.128
! LAYER K+1 AFTER ENTRAINMENT AND DETRAI1A.129
! LATENT HEATING (K) DETRAI1A.130
! OUT ADJUSTED PARCEL POTENTIAL DETRAI1A.131
! IN LAYER K+1 AFTER FORCED DETRAI1A.132
! DETRAINMENT (K) DETRAI1A.133
C DETRAI1A.134
REAL QPKP1(NPNTS) ! INOUT DETRAI1A.135
! IN PARCEL MIXING RATIO IN DETRAI1A.136
! LAYER K+1 AFTER ENTRAINMENT AND DETRAI1A.137
! LATENT HEATING (KG/KG) DETRAI1A.138
! OUT ADJUSTED PARCEL POTENTIAL DETRAI1A.139
! IN LAYER K+1 AFTER FORCED DETRAI1A.140
! DETRAINMENT (KG/KG) DETRAI1A.141
C DETRAI1A.142
REAL XSQKP1(NPNTS) ! INOUT DETRAI1A.143
! IN EXCESS WATER IN PARCEL AFTER DETRAI1A.144
! LIFTING FROM LAYER K TO K+1 AFTER DETRAI1A.145
! ENTRAINMENT AND LATENT HEATING DETRAI1A.146
! (KG/KG) DETRAI1A.147
! OUT EXCESS WATER IN PARCEL IN LAYER DETRAI1A.148
! K+1 AFTER FORCED DETRAINMENT DETRAI1A.149
! (KG/KG) DETRAI1A.150
C DETRAI1A.151
LOGICAL BGMKP1(NPNTS) ! INOUT DETRAI1A.152
! IN MASK FOR PARCELS WHICH ARE DETRAI1A.153
! SATURATED IN LAYER K+1 AFTER DETRAI1A.154
! ENTRAINMENT AND LATENT HEATING DETRAI1A.155
! OUT MASK FOR PARCELS WHICH ARE DETRAI1A.156
! SATURATED IN LAYER K+1 AFTER DETRAI1A.157
! FORCED DETRAINMENT DETRAI1A.158
C DETRAI1A.159
C DETRAI1A.160
C----------------------------------------------------------------------- DETRAI1A.161
C VARIABLES WHICH ARE OUTPUT DETRAI1A.162
C----------------------------------------------------------------------- DETRAI1A.163
C DETRAI1A.164
REAL THRK(NPNTS) ! OUT PARCEL DETRAINMENT POTENTIAL DETRAI1A.165
! TEMPERATURE IN LAYER K (K) DETRAI1A.166
C DETRAI1A.167
REAL QRK(NPNTS) ! OUT PARCEL DETRAINMENT MIXING RATIO DETRAI1A.168
! IN LAYER K (KG/KG) DETRAI1A.169
C DETRAI1A.170
REAL DELTAK(NPNTS) ! OUT PARCEL FORCED DETRAINMENT RATE DETRAI1A.171
! IN LAYER K DETRAI1A.172
C DETRAI1A.173
C DETRAI1A.174
C----------------------------------------------------------------------- DETRAI1A.175
C VARIABLES WHICH ARE DEFINED LOCALLY DETRAI1A.176
C DETRAI1A.177
LOGICAL BDETK(NPNTS) ! MASK FOR PARCELS WHICH ARE DETRAI1A.207
! UNDERGOING FORCED DETRAINMENT DETRAI1A.208
! IN THEIR ASCENT FROM LAYER K DETRAI1A.209
! TO K+1 DETRAI1A.210
C DETRAI1A.211
REAL XSQR(NPNTS) ! EXCESS PARCEL WATER VAPOUR DETRAI1A.212
! DURING DETRAINMENT (KG/KG) DETRAI1A.213
C DETRAI1A.214
REAL THPKP1W(NPNTS) , ! TEMPORARY STOREAGE FOR PARCEL DETRAI1A.215
* QPKP1W(NPNTS) , ! POTENTIAL TEMPERATURE (K), MIXING DETRAI1A.216
* XSQK1W(NPNTS) ! RATIO (KG/KG), EXCESS WATER VAPOUR DETRAI1A.217
LOGICAL BGKP1W(NPNTS) ! (KG/KG) AND MASK FOR SATURATION DETRAI1A.218
! IN LAYER K+1 DETRAI1A.219
C DETRAI1A.220
LOGICAL BRECAL(NPNTS) ! MASK FOR THOSE POINTS AT WHICH THE DETRAI1A.221
! THE DETRAINMENT CALCULATION NEEDS DETRAI1A.222
! REPEATING DETRAI1A.223
C DETRAI1A.224
REAL TT(NPNTS) ! TEMPORARY STORE FOR TEMPERATURE DETRAI1A.225
! FOR THE CALCULATION OF SATURATED DETRAI1A.226
! MIXING RATIO (K) DETRAI1A.227
C DETRAI1A.228
REAL EPSS ! (1+EKP14)*(1+EKP34) DETRAI1A.230
C DETRAI1A.231
C---------------------------------------------------------------------- DETRAI1A.232
C EXTERNAL ROUTINES CALLED DETRAI1A.233
C---------------------------------------------------------------------- DETRAI1A.234
C DETRAI1A.235
EXTERNAL THP_DET,QSAT,THETAR,DET_RATE DETRAI1A.236
C DETRAI1A.237
C*--------------------------------------------------------------------- DETRAI1A.238
C DETRAI1A.239
DO 10 I=1,NPNTS DETRAI1A.240
C DETRAI1A.241
C---------------------------------------------------------------------- DETRAI1A.242
C AT START OF ROUTINE FORCED DETARINMENT DONE AT ALL POINTS SO DETRAI1A.243
C SET ARRAY BDETK EQUAL TO .TRUE. DETRAI1A.244
C SET FORCED DETRAINMENT RATE EQUAL TO ZERO DETRAI1A.245
C---------------------------------------------------------------------- DETRAI1A.246
C DETRAI1A.247
BDETK(I) = .TRUE. DETRAI1A.248
DELTAK(I) = 0.0 DETRAI1A.249
C DETRAI1A.250
C----------------------------------------------------------------------- DETRAI1A.251
C SAVE THE CURRENT VALUES OF QPKP1, XSQKP1 AND BGMKP1 DETRAI1A.252
C----------------------------------------------------------------------- DETRAI1A.253
C DETRAI1A.254
THPKP1W(I) = THPKP1(I) DETRAI1A.255
QPKP1W(I) = QPKP1(I) DETRAI1A.256
XSQK1W(I) = XSQKP1(I) DETRAI1A.257
BGKP1W(I) = BGMKP1(I) DETRAI1A.258
C DETRAI1A.259
C----------------------------------------------------------------------- DETRAI1A.260
C ADD THE EXCESS WATER VAPOUR BACK INTO THE DETRAINING PARCELS DETRAI1A.261
C----------------------------------------------------------------------- DETRAI1A.262
C DETRAI1A.263
QPKP1(I) = QPKP1(I) + XSQKP1(I) DETRAI1A.264
10 CONTINUE DETRAI1A.265
CL DETRAI1A.266
CL---------------------------------------------------------------------- DETRAI1A.267
CL CALCULATE THE ENSEMBLE AVERAGE POTENTIAL TEMPERATURE IN LAYER K+1 DETRAI1A.268
CL AT THE POINTS WHERE DETRAINMENT IS TAKING PLACE DETRAI1A.269
CL DETRAI1A.270
CL SUBROUTINE THP_DET DETRAI1A.271
CL DETRAI1A.272
CL UM DOCUMENTATION PAPER P27 DETRAI1A.273
CL SECTION (6), EQUATION (28) DETRAI1A.274
CL---------------------------------------------------------------------- DETRAI1A.275
CL DETRAI1A.276
CALL THP_DET
(NPNTS,THPKP1,THEKP1,QPKP1,QEKP1,QSEKP1,DQSKP1, DETRAI1A.277
* BGMKP1,BDETK) DETRAI1A.278
CL DETRAI1A.279
CL--------------------------------------------------------------------- DETRAI1A.280
CL CHECK TO SEE IF SUFFICIENT EXCESS WATER VAPOUR IN THE DETRAI1A.281
CL INITIAL DRY ASCENT TO ALLOW PARCEL TO BE SATURATED DETRAI1A.282
CL IN LAYER K+1 AFTER FORCED DETRAINMENT DETRAI1A.283
CL DETRAI1A.284
CL UM DOCUMENTATION PAPER P27 DETRAI1A.285
CL SECTION (6), EQUATION (29) DETRAI1A.286
CL DG020893.5
CL NOTE : ONLY ALLOW PARCEL TO BE SATURATED IN LAYER K+1 IF DG020893.6
CL SATURATED INITIALLY. IT IS POSSIBLE FOR SMALL DG020893.7
CL SUPERSATURATIONS TO IF SUBROUTINE LATENT_H CAUSES DG020893.8
CL PARCEL TO BE COME UNSATURATED. IN THIS CASE TREAT DG020893.9
CL THE PARCEL AS UNSATURATED IN LAYER K+1 DG020893.10
CL--------------------------------------------------------------------- DETRAI1A.287
CL DETRAI1A.288
C DETRAI1A.289
C----------------------------------------------------------------------- DETRAI1A.290
C CALCULATE THE EXCESS WATER VAPOUR IN LAYER K+1 AND RECALCULATE DETRAI1A.291
C BGMKP1 AND QPKP1. DETRAI1A.292
C----------------------------------------------------------------------- DETRAI1A.293
C DETRAI1A.294
C DETRAI1A.295
C----------------------------------------------------------------------- DETRAI1A.296
C CONVERT POTENTIAL TEMPERATURE TO TEMPERATURE AND CALCULATE DETRAI1A.297
C PRESSURE OF LAYER K FOR CALCULATION OF SATURATED DETRAI1A.298
C MIXING RATIO DETRAI1A.299
C----------------------------------------------------------------------- DETRAI1A.300
C DETRAI1A.301
DO 25 I = 1,NPNTS DETRAI1A.302
TT(I) = THPKP1(I)*EXKP1(I) DETRAI1A.303
25 CONTINUE DETRAI1A.304
CALL QSAT (XSQKP1,TT,PKP1,NPNTS) DETRAI1A.305
C DETRAI1A.306
DO 30 I=1,NPNTS DETRAI1A.307
XSQKP1(I) = QPKP1(I) - XSQKP1(I) DETRAI1A.308
C DETRAI1A.309
BRECAL(I) = BGMKP1(I) DETRAI1A.310
C DETRAI1A.311
C---------------------------------------------------------------------- DG020893.11
C ONLY ALLOW PARCEL TO BE SATURATED IN INITIAL BGMKP1 = .TRUE. DG020893.12
C (STORED IN BRECAL AT THIS POINT) DG020893.13
C---------------------------------------------------------------------- DG020893.14
C DG020893.15
IF ( BGMK(I) .OR.( (XSQKP1(I) .GT. 0.) .AND. BRECAL(I) ) ) THEN DG020893.16
BGMKP1(I) = .TRUE. DETRAI1A.313
ELSE DETRAI1A.314
BGMKP1(I) = .FALSE. DETRAI1A.315
XSQKP1(I) = 0.0 DETRAI1A.316
END IF DETRAI1A.317
C DETRAI1A.318
QPKP1(I) = QPKP1(I) - XSQKP1(I) DETRAI1A.319
CL DETRAI1A.320
CL---------------------------------------------------------------------- DETRAI1A.321
CL RECALCULATE THE ENSEMBLE AVERAGE POTENTIAL TEMPERATURE AT POINTS DETRAI1A.322
CL WHERE THE ENSEMBLE HAS BECOME UNSATURATED. DETRAI1A.323
CL DETRAI1A.324
CL UM DOCUMENTATION PAPER P27 DETRAI1A.325
CL SECTION (6), EQUATION (28) DETRAI1A.326
CL---------------------------------------------------------------------- DETRAI1A.327
CL DETRAI1A.328
BRECAL(I) = BDETK(I) .AND. BRECAL(I) .AND. .NOT.BGMKP1(I) DETRAI1A.329
30 CONTINUE DETRAI1A.330
C DETRAI1A.331
CALL THP_DET (NPNTS,THPKP1,THEKP1,QPKP1,QEKP1,QSEKP1,DQSKP1, DETRAI1A.332
* BGMKP1,BRECAL) DETRAI1A.333
CL DETRAI1A.334
CL---------------------------------------------------------------------- DETRAI1A.335
CL BECAUSE OF THE REMOVAL OF LATENT HEATING, THE NEW PARCEL POTENTIAL DETRAI1A.336
CL TEMPERATURE MAY BE LOWER THAN ITS VALUE BEFORE THE DETRAINMENT DETRAI1A.337
CL CALCULATION. IN THIS CASE ABANDON THE DETRAINMENT CALCULATION. DETRAI1A.338
CL---------------------------------------------------------------------- DETRAI1A.339
CL DETRAI1A.340
DO 90 I=1,NPNTS DETRAI1A.341
BDETK(I) = THPKP1(I) .GT. THPKP1W(I) DETRAI1A.342
90 CONTINUE DETRAI1A.343
CL DETRAI1A.344
CL---------------------------------------------------------------------- DETRAI1A.345
CL CALCULATE THE POTENTIAL TEMPERATURE AND MIXING RATIO OF DETRAINING DETRAI1A.346
CL AIR AND THE EXCESS WATER VAPOUR CONDESED FROM DETRAINING AIR DETRAI1A.347
CL DETRAI1A.348
CL UM DOCUMENTATION PAPER P27 DETRAI1A.349
CL SECTION (6), EQUATION (26) DETRAI1A.350
CL---------------------------------------------------------------------- DETRAI1A.351
CL DETRAI1A.352
CALL THETAR (NPNTS,THRK,QRK,XSQR,BGMK,THEK,QEK,QPK,QSEK,DQSK, DETRAI1A.353
* BWKP1,EXK,PK) DETRAI1A.354
CL DETRAI1A.355
CL---------------------------------------------------------------------- DETRAI1A.356
CL CALCULATE THE DETRAINMENT RATE, DELTAK. DETRAI1A.357
CL DETRAI1A.358
CL UM DOCUMENTATION PAPER P27 DETRAI1A.359
CL SECTION (6), EQUATION (31) DETRAI1A.360
CL---------------------------------------------------------------------- DETRAI1A.361
CL DETRAI1A.362
CALL DET_RATE (NPNTS,DELTAK,THRK,XSQR,THPK,THEK,THEKP1, DETRAI1A.363
* XSQKP1,THPKP1,BWKP1,BDETK,EKP14,EKP34,EXK,EXKP1) DETRAI1A.364
C DETRAI1A.365
NREDO = 0 DETRAI1A.366
CL DETRAI1A.367
CL---------------------------------------------------------------------- DETRAI1A.368
CL ADD WATER VAPOUR WHICH WAS REMOVED FROM DETRAINING AIR INTO XSQKP1 DETRAI1A.369
CL DETRAI1A.370
CL UM DOCUMENTATION PAPER P27 DETRAI1A.371
CL SECTION 86), EQUATION (11C) DETRAI1A.372
CL---------------------------------------------------------------------- DETRAI1A.373
CL DETRAI1A.374
DO 120 I=1,NPNTS DETRAI1A.375
C DETRAI1A.376
EPSS = (1.+EKP14(I))*(1.+EKP34(I)) DETRAI1A.377
C DETRAI1A.378
IF (BDETK(I)) DETRAI1A.379
* XSQKP1(I) = XSQKP1(I) + (DELTAK(I)*XSQR(I)/ DETRAI1A.380
* (EPSS*(1.-DELTAK(I)))) DETRAI1A.381
CL DETRAI1A.382
CL---------------------------------------------------------------------- DETRAI1A.383
CL IF THE EXCESS WATER VAPOUR IN LAYER K+1 IS LESS THAN ZERO DETRAI1A.384
CL I.E. THE PARCEL HAS BECOME UNSATURATED THROUGH THE FORCED DETRAI1A.385
CL DETRAINMENT PROCESS THEN ABANDON THE CALCULATION DETRAI1A.386
CL---------------------------------------------------------------------- DETRAI1A.387
CL DETRAI1A.388
BRECAL(I) = BGMKP1(I) DETRAI1A.389
C DETRAI1A.390
BGMKP1(I) = XSQKP1(I) .GT. 0. DETRAI1A.391
C DETRAI1A.392
BRECAL(I) = BDETK(I) .AND. BRECAL(I) .AND. .NOT.BGMKP1(I) DETRAI1A.393
C DETRAI1A.394
IF (BRECAL(I)) THEN DETRAI1A.395
QPKP1(I) = QPKP1(I) + XSQKP1(I) DETRAI1A.396
* - (DELTAK(I)*XSQR(I)/(EPSS*(1.-DELTAK(I)))) DETRAI1A.397
XSQKP1(I) = 0. DETRAI1A.398
ENDIF DETRAI1A.399
C DETRAI1A.400
C---------------------------------------------------------------------- DETRAI1A.401
C COUNT POINTS AT WHICH DETRAINMENT CALCULATION NEEDS REPEATING DETRAI1A.402
C---------------------------------------------------------------------- DETRAI1A.403
C DETRAI1A.404
IF (BRECAL(I)) NREDO = NREDO + 1 DETRAI1A.405
120 CONTINUE DETRAI1A.406
CL DETRAI1A.407
CL--------------------------------------------------------------------- DETRAI1A.408
CL REPEAT CALCULATION OF PARCEL POTENTIAL TEMPERATURE, DETRAINMENT DETRAI1A.409
CL RATE AND EXCESS PARCEL WATER IF THE PARCEL BECOMES UNSATURATED DETRAI1A.410
CL IN LAYER K+1 AFTER FORCED DETARINMENT DETRAI1A.411
CL--------------------------------------------------------------------- DETRAI1A.412
CL DETRAI1A.413
IF (NREDO .GT. 0) THEN DETRAI1A.414
C DETRAI1A.415
C---------------------------------------------------------------------- DETRAI1A.416
C CALCULATE NEW PARCEL POTENTIAL TEMPERATURE IN LAYER K+1 DETRAI1A.417
C AFTER FORCED DETRAINMENT DETRAI1A.418
C---------------------------------------------------------------------- DETRAI1A.419
C DETRAI1A.420
CALL THP_DET (NPNTS,THPKP1,THEKP1,QPKP1,QEKP1,QSEKP1,DQSKP1, DETRAI1A.421
* BGMKP1,BRECAL) DETRAI1A.422
C DETRAI1A.423
C---------------------------------------------------------------------- DETRAI1A.424
C CHECK IF FORCED DETRAINMENT STILL POSSIBLE AND RESET RECALCUATION DETRAI1A.425
C MASK TO FALSE IF IT IS NOT DETRAI1A.426
C---------------------------------------------------------------------- DETRAI1A.427
C DETRAI1A.428
DO 130 I=1,NPNTS DETRAI1A.429
IF (BRECAL(I)) THEN DETRAI1A.430
BDETK(I) = THPKP1(I) .GT. THPKP1W(I) DETRAI1A.431
BRECAL(I) = BDETK(I) DETRAI1A.432
END IF DETRAI1A.433
130 CONTINUE DETRAI1A.434
C DETRAI1A.435
C---------------------------------------------------------------------- DETRAI1A.436
C RCALCULATE FORCED DETRAINEMNT RATE DETRAI1A.437
C---------------------------------------------------------------------- DETRAI1A.438
C DETRAI1A.439
CALL DET_RATE (NPNTS,DELTAK,THRK,XSQR,THPK,THEK,THEKP1, DETRAI1A.440
* XSQKP1,THPKP1,BWKP1,BRECAL,EKP14,EKP34,EXK,EXKP1) DETRAI1A.441
C DETRAI1A.442
C---------------------------------------------------------------------- DETRAI1A.443
C RECALCULATE EXCESS WATER VAPOUR IN LAYER K+1 DETRAI1A.444
C AFTER FORCED DETRAINMENT DETRAI1A.445
C---------------------------------------------------------------------- DETRAI1A.446
C DETRAI1A.447
DO 140 I=1,NPNTS DETRAI1A.448
IF (BRECAL(I)) THEN DETRAI1A.449
EPSS = (1.+EKP14(I))*(1.+EKP34(I)) DETRAI1A.450
XSQKP1(I) = XSQKP1(I) + (DELTAK(I)*XSQR(I)/ DETRAI1A.451
* (EPSS*(1.-DELTAK(I)))) DETRAI1A.452
END IF DETRAI1A.453
140 CONTINUE DETRAI1A.454
C DETRAI1A.455
END IF DETRAI1A.456
CL DETRAI1A.457
CL---------------------------------------------------------------------- DETRAI1A.458
CL MAKE SURE THAT THE DETRAINMENT RATE IS BETWEEN 0 AND 1 DG020893.17
CL DG020893.18
CL IF <0 THEN NO DETRAINMENT OCCURS AND ORIGINAL VALUES ARE DG020893.19
CL RESTORED DG020893.20
CL DG020893.21
CL IF >1 THEN SET TO 1 AND THRK = THPK, QRK = QPK AND VALUES DG020893.22
CL IN LAYER K+1 ARE RESTORED. ALTHOUGH THESE ARE NOT USED DG020893.23
CL IN ANY THERMODYNAMIC CALCULATION THEY ARE USED TO SPECIFY DG020893.24
CL CLOUD TOP IN SUBROUTIBE CONRAD DG020893.25
CL---------------------------------------------------------------------- DETRAI1A.461
CL DETRAI1A.462
DO 180 I=1,NPNTS DETRAI1A.463
C DETRAI1A.466
IF (BDETK(I)) THEN DG020893.26
C DETRAI1A.472
IF (DELTAK(I).LE.0.0) THEN DG020893.27
BDETK(I) = .FALSE. DG020893.28
THPKP1 (I) = THPKP1W(I) DG020893.29
QPKP1 (I) = QPKP1W(I) DG020893.30
XSQKP1(I) = XSQK1W(I) DG020893.31
BGMKP1(I) = BGKP1W(I) DG020893.32
DELTAK(I) = 0.0 DG020893.33
ELSE IF (DELTAK(I).GT.1.0) THEN DG020893.34
DELTAK(I) = 1.0 DG020893.35
THRK(I) = THPK(I) DG020893.36
QRK(I) = QPK(I) DG020893.37
THPKP1 (I) = THPKP1W(I) DG020893.38
QPKP1 (I) = QPKP1W(I) DG020893.39
XSQKP1(I) = XSQK1W(I) DG020893.40
BGMKP1(I) = BGKP1W(I) DG020893.41
END IF DG020893.42
C DG020893.43
ENDIF DETRAI1A.479
180 CONTINUE DETRAI1A.480
C DETRAI1A.481
RETURN DETRAI1A.482
END DETRAI1A.483
*ENDIF DETRAI1A.484