*IF DEF,A05_3B CHGPHS3B.2
C ******************************COPYRIGHT****************************** CHGPHS3B.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. CHGPHS3B.4
C CHGPHS3B.5
C Use, duplication or disclosure of this code is subject to the CHGPHS3B.6
C restrictions as set forth in the contract. CHGPHS3B.7
C CHGPHS3B.8
C Meteorological Office CHGPHS3B.9
C London Road CHGPHS3B.10
C BRACKNELL CHGPHS3B.11
C Berkshire UK CHGPHS3B.12
C RG12 2SZ CHGPHS3B.13
C CHGPHS3B.14
C If no contract has been raised with this copy of the code, the use, CHGPHS3B.15
C duplication or disclosure of it is strictly prohibited. Permission CHGPHS3B.16
C to do so must first be obtained in writing from the Head of Numerical CHGPHS3B.17
C Modelling at the above address. CHGPHS3B.18
C ******************************COPYRIGHT****************************** CHGPHS3B.19
C CHGPHS3B.20
CLL SUBROUTINE CHG_PHSE---------------------------------------------- CHGPHS3B.21
CLL CHGPHS3B.22
CLL PURPOSE : CHANGE OF PHASE ROUTINE FOR POINTS WHERE NO CHGPHS3B.23
CLL DOWNDRAUGHT OCCURING CHGPHS3B.24
CLL CHGPHS3B.25
CLL UPDATES POTENTIAL TEMPERATURE OF LAYER K CHGPHS3B.26
CLL AS PRECIPITATION CHANGES PHASE IN SITU CHGPHS3B.27
CLL CHGPHS3B.28
CLL ADD LATENT HEATING WHERE PRECIPITATION CROSSES A CHGPHS3B.29
CLL MELTING OR FREEZING LEVEL CHGPHS3B.30
CLL Limit the freezing and melting of convective CHGPHS3B.31
CLL precipitation below cloud base so that the change CHGPHS3B.32
CLL of phase cannot take the temperature to the CHGPHS3B.33
CLL other side of the melting point of water (TM). CHGPHS3B.34
CLL CHGPHS3B.35
CLL SUITABLE FOR SINGLE COLUMN MODEL USE CHGPHS3B.36
CLL CHGPHS3B.37
CLL Code written by R.N.B.Smith (based on CHGPHS2A at vn4.2) Feb.97 CHGPHS3B.38
CLL CHGPHS3B.39
CLL MODEL MODIFICATION HISTORY: CHGPHS3B.40
CLL VERSION DATE CHGPHS3B.41
CLL CHGPHS3B.42
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 3 CHGPHS3B.43
CLL VERSION NO. 4 DATED 5/2/92 CHGPHS3B.44
CLL CHGPHS3B.45
CLL PROJECT TASK : P27 CHGPHS3B.46
CLL CHGPHS3B.47
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER 27 CHGPHS3B.48
CLL CHGPHS3B.49
CLLEND----------------------------------------------------------------- CHGPHS3B.50
C CHGPHS3B.51
C*L ARGUMENTS--------------------------------------------------------- CHGPHS3B.52
C CHGPHS3B.53
SUBROUTINE CHG_PHSE (NPNTS,K,RAIN,SNOW,DTHBYDT_KM1, 4CHGPHS3B.54
& EXK,EXKM1,DELPKM1,THE_K,THE_KM1, CHGPHS3B.55
& TIMESTEP,CCA) CHGPHS3B.56
C CHGPHS3B.57
IMPLICIT NONE CHGPHS3B.58
C CHGPHS3B.59
C---------------------------------------------------------------------- CHGPHS3B.60
C MODEL CONSTANTS CHGPHS3B.61
C---------------------------------------------------------------------- CHGPHS3B.62
C CHGPHS3B.63
*CALL C_LHEAT 
CHGPHS3B.64
*CALL C_R_CP CHGPHS3B.65
*CALL C_G CHGPHS3B.66
*CALL C_0_DG_C CHGPHS3B.67
*CALL CLDAREA CHGPHS3B.68
C CHGPHS3B.69
C---------------------------------------------------------------------- CHGPHS3B.70
C VECTOR LENGTHS AND LOOP COUNTERS CHGPHS3B.71
C---------------------------------------------------------------------- CHGPHS3B.72
C CHGPHS3B.73
INTEGER NPNTS ! IN VECTOR LENGTH CHGPHS3B.74
C CHGPHS3B.75
INTEGER I ! LOOP COUNTER CHGPHS3B.76
C CHGPHS3B.77
INTEGER K ! IN MODEL LAYER CHGPHS3B.78
C CHGPHS3B.79
C---------------------------------------------------------------------- CHGPHS3B.80
C VARIABLES WHICH ARE INPUT CHGPHS3B.81
C---------------------------------------------------------------------- CHGPHS3B.82
C CHGPHS3B.83
REAL EXK(NPNTS) ! IN EXNER RATIO FOR LAYER K CHGPHS3B.84
C CHGPHS3B.85
REAL EXKM1(NPNTS) ! IN EXNER RATIO FOR LAYER K-1 CHGPHS3B.86
C CHGPHS3B.87
REAL DELPKM1(NPNTS) ! IN PRESSURE DIFFERENCE ACROSS CHGPHS3B.88
! LAYER K-1 (PA) CHGPHS3B.89
C CHGPHS3B.90
REAL THE_K(NPNTS) ! IN POTENTIAL TEMPERATURE OF CHGPHS3B.91
! ENVIRONMENT IN LAYER K CHGPHS3B.92
C CHGPHS3B.93
REAL THE_KM1(NPNTS) ! IN POTENTIAL TEMPERATURE OF CHGPHS3B.94
! ENVIRONMENT IN LAYER K-1 CHGPHS3B.95
C CHGPHS3B.96
REAL TIMESTEP ! IN Timestep in seconds CHGPHS3B.97
C CHGPHS3B.98
REAL CCA(NPNTS) ! IN Convective cloud area CHGPHS3B.99
C CHGPHS3B.100
C---------------------------------------------------------------------- CHGPHS3B.101
C VARIABLES WHICH ARE INPUT AND OUTPUT CHGPHS3B.102
C---------------------------------------------------------------------- CHGPHS3B.103
C CHGPHS3B.104
REAL RAIN(NPNTS) ! INOUT CHGPHS3B.105
! IN AMOUNT OF FALLING RAIN CHGPHS3B.106
! (KG/M**2/S) CHGPHS3B.107
! OUT UPDATED AMOUNT OF FALLING CHGPHS3B.108
! RAIN (KG/M**2/S) CHGPHS3B.109
C CHGPHS3B.110
REAL SNOW(NPNTS) ! INOUT CHGPHS3B.111
! IN AMOUNT OF FALLING SNOW CHGPHS3B.112
! (KG/M**2/S) CHGPHS3B.113
! OUT UPDATED AMOUNT OF FALLING CHGPHS3B.114
! SNOW (KG/M**2/S) CHGPHS3B.115
C CHGPHS3B.116
REAL DTHBYDT_KM1(NPNTS) ! INOUT CHGPHS3B.117
! IN INCREMENT TO MODEL POTENTIAL CHGPHS3B.118
! TEMPERATURE IN LAYER K-1 CHGPHS3B.119
! OUT UPDATED INCREMENT TO MODEL CHGPHS3B.120
! POTENTIAL TEMPERATURE IN LAYER CHGPHS3B.121
! K-1 DUE TO CHANGE OF PHASE CHGPHS3B.122
C CHGPHS3B.123
C---------------------------------------------------------------------- CHGPHS3B.124
C VARIABLES WHICH ARE DEFINED LOCALLY CHGPHS3B.125
C--------------------------------------------------------------------- CHGPHS3B.126
C CHGPHS3B.127
REAL FACTOR ! USED IN THE CALCULATION OF CHGPHS3B.128
! CHANGE OF PHASE OF FALLING CHGPHS3B.129
! PRECIPITATION CHGPHS3B.130
C CHGPHS3B.131
REAL WPC ! AMOUNT OF PRECIPITATION WHICH CAN CHGPHS3B.132
C ! CHANGE PHASE CHGPHS3B.133
C CHGPHS3B.134
REAL CA ! LOCAL CLOUD AREA CHGPHS3B.135
C CHGPHS3B.136
REAL THE_KM1_NEW ! THE_KM1 UPDATED WITH ALL INCREMENTS CHGPHS3B.137
C ! PRIOR TO THIS SUBROUTINE CHGPHS3B.138
C CHGPHS3B.139
LOGICAL BPPNWT_K ! MASK WHERE PRECIPITATION IS LIQUID CHGPHS3B.140
! IN LAYER K CHGPHS3B.141
C CHGPHS3B.142
LOGICAL BPPNWT_KM1 ! MASK WHERE PRECIPITATION IS LIQUID CHGPHS3B.143
! IN LAYER K-1 CHGPHS3B.144
C CHGPHS3B.145
CL CHGPHS3B.146
CL---------------------------------------------------------------------- CHGPHS3B.147
CL ADD LATENT HEATING WHERE PRECIP CROSSES A MELTING OR FREEZING LEVEL CHGPHS3B.148
CL CHGPHS3B.149
CL UM DOCUMENTATION PAPER P27 CHGPHS3B.150
CL SECTION (11), EQUATION (42) CHGPHS3B.151
CL---------------------------------------------------------------------- CHGPHS3B.152
CL CHGPHS3B.153
DO I=1,NPNTS CHGPHS3B.154
THE_KM1_NEW = THE_KM1(I) + TIMESTEP*DTHBYDT_KM1(I) CHGPHS3B.155
BPPNWT_K = THE_K(I).GT.TM/EXK(I) CHGPHS3B.156
BPPNWT_KM1 = THE_KM1_NEW .GT. TM/EXKM1(I) CHGPHS3B.157
FACTOR = LF*G/(EXKM1(I)*CP*DELPKM1(I)) CHGPHS3B.158
CA = CLDAREA * CCA(I) CHGPHS3B.159
C CHGPHS3B.160
C FREEZE CHGPHS3B.161
C CHGPHS3B.162
IF (.NOT.BPPNWT_KM1.AND.(BPPNWT_K.OR.RAIN(I).GT.0.0)) THEN CHGPHS3B.163
WPC = MIN( RAIN(I), CHGPHS3B.164
& CA * (TM/EXKM1(I) - THE_KM1_NEW) / CHGPHS3B.165
& (TIMESTEP * FACTOR) ) CHGPHS3B.166
DTHBYDT_KM1(I) = DTHBYDT_KM1(I) + WPC * FACTOR CHGPHS3B.167
SNOW(I) = SNOW(I) + WPC CHGPHS3B.168
RAIN(I) = RAIN(I) - WPC CHGPHS3B.169
END IF CHGPHS3B.170
C CHGPHS3B.171
C MELT CHGPHS3B.172
C CHGPHS3B.173
IF (BPPNWT_KM1.AND.(.NOT.BPPNWT_K.OR.SNOW(I).GT.0.0)) THEN CHGPHS3B.174
WPC = MIN( SNOW(I), CHGPHS3B.175
& CA * (THE_KM1_NEW - TM/EXKM1(I)) / CHGPHS3B.176
& (TIMESTEP * FACTOR) ) CHGPHS3B.177
DTHBYDT_KM1(I) = DTHBYDT_KM1(I) - WPC * FACTOR CHGPHS3B.178
RAIN(I) = RAIN(I) + WPC CHGPHS3B.179
SNOW(I) = SNOW(I) - WPC CHGPHS3B.180
END IF CHGPHS3B.181
END DO CHGPHS3B.182
C CHGPHS3B.183
RETURN CHGPHS3B.184
END CHGPHS3B.185
C CHGPHS3B.186
*ENDIF CHGPHS3B.187