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