*IF DEF,A05_2A,OR,DEF,A05_2C,OR,DEF,A05_3B GKR1F405.2
C ******************************COPYRIGHT****************************** GTS2F400.1927
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.1928
C GTS2F400.1929
C Use, duplication or disclosure of this code is subject to the GTS2F400.1930
C restrictions as set forth in the contract. GTS2F400.1931
C GTS2F400.1932
C Meteorological Office GTS2F400.1933
C London Road GTS2F400.1934
C BRACKNELL GTS2F400.1935
C Berkshire UK GTS2F400.1936
C RG12 2SZ GTS2F400.1937
C GTS2F400.1938
C If no contract has been raised with this copy of the code, the use, GTS2F400.1939
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.1940
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.1941
C Modelling at the above address. GTS2F400.1942
C ******************************COPYRIGHT****************************** GTS2F400.1943
C GTS2F400.1944
CLL SUBROUTINE DET_RATE----------------------------------------------- DETRAT1A.3
CLL DETRAT1A.4
CLL PURPOSE : CALCULATES THE FORCED DETRAINMENT RATE IN LAYER K DETRAT1A.5
CLL DETRAT1A.6
CLL SUITABLE FOR SINGLE COLUMN MODEL USE DETRAT1A.7
CLL DETRAT1A.8
CLL CODE REWORKED FOR CRAY Y-MP BY D.GREGORY AUTUMN/WINTER 1989/90 DETRAT1A.9
CLL DETRAT1A.10
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: DETRAT1A.11
CLL VERSION DATE DETRAT1A.12
CLL 4.5 01/10/98 Removed old section-version defs. K Rogers GKR1F405.1
CLL DETRAT1A.13
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 4 DETRAT1A.14
CLL VERSION NO. 1 DETRAT1A.15
CLL DETRAT1A.16
CLL LOGICAL COMPONENTS COVERED: P27 DETRAT1A.17
CLL DETRAT1A.18
CLL SYSTEM TASK : DETRAT1A.19
CLL DETRAT1A.20
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER P27 DETRAT1A.21
CLL SECTION (6), EQUATION (31) DETRAT1A.22
CLL DETRAT1A.23
CLLEND----------------------------------------------------------------- DETRAT1A.24
C DETRAT1A.25
C*L ARGUMENTS--------------------------------------------------------- DETRAT1A.26
C DETRAT1A.27
SUBROUTINE DET_RATE (NPNTS,DELTAK,THRK,XSQR,THPK,THEK,THEKP1, 2DETRAT1A.28
* XSQKP1,THPKP1,BWKP1,BCALC,EKP14,EKP34, DETRAT1A.29
* EXK,EXKP1) DETRAT1A.30
C DETRAT1A.31
IMPLICIT NONE DETRAT1A.32
C DETRAT1A.33
C----------------------------------------------------------------------- DETRAT1A.34
C MODEL CONSTANTS DETRAT1A.35
C----------------------------------------------------------------------- DETRAT1A.36
C DETRAT1A.37
*CALL C_R_CP 
DETRAT1A.38
*CALL C_LHEAT DETRAT1A.39
C DETRAT1A.40
C----------------------------------------------------------------------- DETRAT1A.41
C VECTOR LENGTHS AND LOOP COUNTERS DETRAT1A.42
C----------------------------------------------------------------------- DETRAT1A.43
C DETRAT1A.44
INTEGER NPNTS ! VECTOR LENGTH DETRAT1A.45
C DETRAT1A.46
INTEGER I ! LOOP COUNTER DETRAT1A.47
C DETRAT1A.48
C DETRAT1A.49
C----------------------------------------------------------------------- DETRAT1A.50
C VARIABLES THAT ARE INPUT DETRAT1A.51
C----------------------------------------------------------------------- DETRAT1A.52
C DETRAT1A.53
REAL THRK(NPNTS) ! IN PARCEL DETRAINMENT POTENTIAL DETRAT1A.54
! TEMPERATURE IN LAYER K (K) DETRAT1A.55
C DETRAT1A.56
REAL XSQR(NPNTS) ! IN EXCESS WATER VAPOUR OF THE DETRAT1A.57
! DETRAINING AIR IN LAYER K (KG/KG) DETRAT1A.58
C DETRAT1A.59
REAL THPK(NPNTS) ! IN PARCEL POTENTIAL TEMPERATURE DETRAT1A.60
! IN LAYER K (K) DETRAT1A.61
C DETRAT1A.62
REAL THEK(NPNTS) ! IN ENVIRONMENT POTENTIAL TEMPERATURE DETRAT1A.63
! IN LAYER K (K) DETRAT1A.64
C DETRAT1A.65
REAL THEKP1(NPNTS) ! IN ENVIRONMENT POTENTIAL TEMPERATURE DETRAT1A.66
! IN LAYER K+1 (K) DETRAT1A.67
C DETRAT1A.68
REAL XSQKP1(NPNTS) ! IN EXCESS WATER VAPOUR OF THE PARCEL DETRAT1A.69
! IN LAYER K+1 (KG/KG) DETRAT1A.70
C DETRAT1A.71
REAL THPKP1(NPNTS) ! IN PARCEL POTENTIAL TEMPERATURE DETRAT1A.72
! IN LAYER K+1 (K) DETRAT1A.73
C DETRAT1A.74
LOGICAL BCALC(NPNTS) ! IN MASK FOR POINTS AT WHICH DETRAT1A.75
! CALCULATIONS OF THIS ROUTINE DETRAT1A.76
! ARE NEEDED DETRAT1A.77
C DETRAT1A.78
LOGICAL BWKP1(NPNTS) ! IN MASK FOR THOSE POINTS AT WHICH DETRAT1A.79
! CONDENSATE IS LIQUID IN LAYER K+1 DETRAT1A.80
C DETRAT1A.81
REAL EKP14(NPNTS) ! IN ENTRAINEMNT RATE FOR LEVEL K+1/4 DETRAT1A.82
! MULTIPLIED BY APPROPRIATE LAYER DETRAT1A.83
! THICKNESS DETRAT1A.84
C DETRAT1A.85
REAL EKP34(NPNTS) ! IN ENTRAINEMNT RATE FOR LEVEL K+3/4 DETRAT1A.86
! MULTIPLIED BY APPROPRIATE LAYER DETRAT1A.87
! THICKNESS DETRAT1A.88
C DETRAT1A.89
REAL EXK(NPNTS) ! IN EXNER RATIO FOR LEVEL K DETRAT1A.90
C DETRAT1A.91
REAL EXKP1(NPNTS) ! IN EXNER RATIO FOR LEVEL K+1 DETRAT1A.92
C DETRAT1A.93
C DETRAT1A.94
C----------------------------------------------------------------------- DETRAT1A.95
C VARIABLES THAT ARE OUTPUT DETRAT1A.96
C----------------------------------------------------------------------- DETRAT1A.97
C DETRAT1A.98
REAL DELTAK(NPNTS) ! OUT PARCEL FORCED DETRAINMENT RATE DETRAT1A.99
! IN LAYER K MULTIPLIED BY DETRAT1A.100
! APPROPRIATE LAYER THICKNESS DETRAT1A.101
C DETRAT1A.102
C DETRAT1A.103
C----------------------------------------------------------------------- DETRAT1A.104
C VARIABLES THAT ARE DEFINED LOCALLY DETRAT1A.105
C----------------------------------------------------------------------- DETRAT1A.106
C DETRAT1A.107
REAL EL ! LATENT HEAT OF CONDENSATION OR DETRAT1A.108
! (CONDENSATION + FUSION) (J/KG) DETRAT1A.109
C DETRAT1A.110
REAL EPSS ! (1+EKP14)*(1+EKP34) DETRAT1A.111
C DETRAT1A.112
C*--------------------------------------------------------------------- DETRAT1A.113
CL DETRAT1A.114
CL--------------------------------------------------------------------- DETRAT1A.115
CL NO SIGNIFICANT STRUCTURE DETRAT1A.116
CL--------------------------------------------------------------------- DETRAT1A.117
CL DETRAT1A.118
C DETRAT1A.119
DO 10 I=1,NPNTS DETRAT1A.120
EPSS = (1. + EKP14(I)) * (1. + EKP34(I)) DETRAT1A.121
C DETRAT1A.122
C----------------------------------------------------------------------- DETRAT1A.123
C CREATE A VECTOR OF LATENT HEATS DETRAT1A.124
C----------------------------------------------------------------------- DETRAT1A.125
C DETRAT1A.126
IF (BWKP1(I)) THEN DETRAT1A.127
EL = LC DETRAT1A.128
ELSE DETRAT1A.129
EL = LC + LF DETRAT1A.130
ENDIF DETRAT1A.131
C DETRAT1A.132
C----------------------------------------------------------------------- DETRAT1A.133
C CALCULATE DETRAINMENT RATES DETRAT1A.134
C----------------------------------------------------------------------- DETRAT1A.135
C DETRAT1A.136
IF (BCALC(I)) THEN DETRAT1A.137
DELTAK(I) = EKP14(I)*THEK(I) DETRAT1A.138
* + EKP34(I)*(1.+EKP14(I))*THEKP1(I) DETRAT1A.139
* - EPSS*(THPKP1(I) - EL/(EXKP1(I)*CP) * XSQKP1(I)) DETRAT1A.140
C DETRAT1A.141
DELTAK(I) = (DELTAK(I) + THPK(I)) DETRAT1A.142
* /(DELTAK(I) + THRK(I) - EL/(EXK(I)*CP) * XSQR(I)) DETRAT1A.143
C DETRAT1A.144
C---------------------------------------------------------------------- DETRAT1A.145
C FROM A THEORETICAL VIEW POINT DELTAK CANNOT = 1 . HOWEVER DETRAT1A.146
C BECAUSE OF APPROXIMATION USED IN THE CALCULATION NUMERICALLY IT DETRAT1A.147
C MAY BE POSSIBLE. HENCE IF DELTAK = 1 SET IT TO SLIGHTLY SMALLER DETRAT1A.148
C THAN 1 DETRAT1A.149
C---------------------------------------------------------------------- DETRAT1A.150
C DETRAT1A.151
IF (DELTAK(I).EQ.1.0) DELTAK(I) = 0.99999 DETRAT1A.152
C DETRAT1A.153
ENDIF DETRAT1A.154
10 CONTINUE DETRAT1A.155
C DETRAT1A.156
RETURN DETRAT1A.157
END DETRAT1A.158
*ENDIF DETRAT1A.159