*IF DEF,A05_2A,OR,DEF,A05_2C AJX1F405.152
C ******************************COPYRIGHT****************************** GTS2F400.847
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.848
C GTS2F400.849
C Use, duplication or disclosure of this code is subject to the GTS2F400.850
C restrictions as set forth in the contract. GTS2F400.851
C GTS2F400.852
C Meteorological Office GTS2F400.853
C London Road GTS2F400.854
C BRACKNELL GTS2F400.855
C Berkshire UK GTS2F400.856
C RG12 2SZ GTS2F400.857
C GTS2F400.858
C If no contract has been raised with this copy of the code, the use, GTS2F400.859
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.860
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.861
C Modelling at the above address. GTS2F400.862
C ******************************COPYRIGHT****************************** GTS2F400.863
C GTS2F400.864
CLL SUBROUTINE CHG_PHSE---------------------------------------------- CHGPHS2A.3
CLL CHGPHS2A.4
CLL PURPOSE : CHANGE OF PHASE ROUTINE FOR POINTS WHERE NO CHGPHS2A.5
CLL DOWNDRAUGHT OCCURING CHGPHS2A.6
CLL CHGPHS2A.7
CLL UPDATES POTENTIAL TEMPERATURE OF LAYER K CHGPHS2A.8
CLL AS PRECIPITATION CHANGES PHASE IN SITU CHGPHS2A.9
CLL CHGPHS2A.10
CLL ADD LATENT HEATING WHERE PRECIPITATION CROSSES A CHGPHS2A.11
CLL MELTING OR FREEZING LEVEL CHGPHS2A.12
CLL CHGPHS2A.13
CLL SUITABLE FOR SINGLE COLUMN MODEL USE CHGPHS2A.14
CLL CHGPHS2A.15
CLL CODE WRITTEN FOR CRAY Y-MP BY S.BETT AND D.GREGORY AUTUMN 1991 CHGPHS2A.16
CLL CHGPHS2A.17
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: CHGPHS2A.18
CLL VERSION DATE CHGPHS2A.19
CLL CHGPHS2A.20
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 3 CHGPHS2A.21
CLL VERSION NO. 4 DATED 5/2/92 CHGPHS2A.22
CLL CHGPHS2A.23
CLL PROJECT TASK : P27 CHGPHS2A.24
CLL CHGPHS2A.25
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER P27 CHGPHS2A.26
CLL CHGPHS2A.27
CLLEND----------------------------------------------------------------- CHGPHS2A.28
C CHGPHS2A.29
C*L ARGUMENTS--------------------------------------------------------- CHGPHS2A.30
C CHGPHS2A.31
SUBROUTINE CHG_PHSE (NPNTS,K,RAIN,SNOW,DTHBYDT_KM1, 4CHGPHS2A.32
* EXK,EXKM1,DELPKM1,THE_K,THE_KM1) CHGPHS2A.33
C CHGPHS2A.34
IMPLICIT NONE CHGPHS2A.35
C CHGPHS2A.36
C---------------------------------------------------------------------- CHGPHS2A.37
C MODEL CONSTANTS CHGPHS2A.38
C---------------------------------------------------------------------- CHGPHS2A.39
C CHGPHS2A.40
*CALL C_LHEAT 
CHGPHS2A.41
*CALL C_R_CP CHGPHS2A.42
*CALL C_G CHGPHS2A.43
*CALL C_0_DG_C CHGPHS2A.44
C CHGPHS2A.45
C---------------------------------------------------------------------- CHGPHS2A.46
C VECTOR LENGTHS AND LOOP COUNTERS CHGPHS2A.47
C---------------------------------------------------------------------- CHGPHS2A.48
C CHGPHS2A.49
INTEGER NPNTS ! IN VECTOR LENGTH CHGPHS2A.50
C CHGPHS2A.51
INTEGER I ! LOOP COUNTER CHGPHS2A.52
C CHGPHS2A.53
INTEGER K ! IN MODEL LAYER CHGPHS2A.54
C CHGPHS2A.55
C---------------------------------------------------------------------- CHGPHS2A.56
C VARIABLES WHICH ARE INPUT CHGPHS2A.57
C---------------------------------------------------------------------- CHGPHS2A.58
C CHGPHS2A.59
REAL EXK(NPNTS) ! IN EXNER RATIO FOR LAYER K CHGPHS2A.60
C CHGPHS2A.61
REAL EXKM1(NPNTS) ! IN EXNER RATIO FOR LAYER K-1 CHGPHS2A.62
C CHGPHS2A.63
REAL DELPKM1(NPNTS) ! IN PRESSURE DIFFERENCE ACROSS CHGPHS2A.64
! LAYER K-1 (PA) CHGPHS2A.65
C CHGPHS2A.66
REAL THE_K(NPNTS) ! IN POTENTIAL TEMPERATURE OF CHGPHS2A.67
! ENVIRONMENT IN LAYER K CHGPHS2A.68
C CHGPHS2A.69
REAL THE_KM1(NPNTS) ! IN POTENTIAL TEMPERATURE OF CHGPHS2A.70
! ENVIRONMENT IN LAYER K-1 CHGPHS2A.71
C CHGPHS2A.72
C---------------------------------------------------------------------- CHGPHS2A.73
C VARIABLES WHICH ARE INPUT AND OUTPUT CHGPHS2A.74
C---------------------------------------------------------------------- CHGPHS2A.75
C CHGPHS2A.76
REAL RAIN(NPNTS) ! INOUT CHGPHS2A.77
! IN AMOUNT OF FALLING RAIN CHGPHS2A.78
! (KG/M**2/S) CHGPHS2A.79
! OUT UPDATED AMOUNT OF FALLING CHGPHS2A.80
! RAIN (KG/M**2/S) CHGPHS2A.81
C CHGPHS2A.82
REAL SNOW(NPNTS) ! INOUT CHGPHS2A.83
! IN AMOUNT OF FALLING SNOW CHGPHS2A.84
! (KG/M**2/S) CHGPHS2A.85
! OUT UPDATED AMOUNT OF FALLING CHGPHS2A.86
! SNOW (KG/M**2/S) CHGPHS2A.87
C CHGPHS2A.88
REAL DTHBYDT_KM1(NPNTS) ! INOUT CHGPHS2A.89
! IN INCREMENT TO MODEL POTENTIAL CHGPHS2A.90
! TEMPERATURE IN LAYER K-1 CHGPHS2A.91
! OUT UPDATED INCREMENT TO MODEL CHGPHS2A.92
! POTENTIAL TEMPERATURE IN LAYER CHGPHS2A.93
! K-1 DUE TO CHANGE OF PHASE CHGPHS2A.94
C CHGPHS2A.95
C---------------------------------------------------------------------- CHGPHS2A.96
C VARIABLES WHICH ARE DEFINED LOCALLY CHGPHS2A.97
C--------------------------------------------------------------------- CHGPHS2A.98
C CHGPHS2A.99
REAL FACTOR ! USED IN THE CALCULATION OF CHGPHS2A.100
! CHANGE OF PHASE OF FALLING CHGPHS2A.101
! PRECIPITATION CHGPHS2A.102
C CHGPHS2A.103
LOGICAL BPPNWT_K ! MASK WHERE PRECIPITATION IS LIQUID CHGPHS2A.104
! IN LAYER K CHGPHS2A.105
C CHGPHS2A.106
LOGICAL BPPNWT_KM1 ! MASK WHERE PRECIPITATION IS LIQUID CHGPHS2A.107
! IN LAYER K-1 CHGPHS2A.108
C CHGPHS2A.109
CL CHGPHS2A.110
CL---------------------------------------------------------------------- CHGPHS2A.111
CL ADD LATENT HEATING WHERE PRECIP CROSSES A MELTING OR FREEZING LEVEL CHGPHS2A.112
CL CHGPHS2A.113
CL UM DOCUMENTATION PAPER P27 CHGPHS2A.114
CL SECTION (11), EQUATION (42) CHGPHS2A.115
CL---------------------------------------------------------------------- CHGPHS2A.116
CL CHGPHS2A.117
DO I=1,NPNTS CHGPHS2A.118
BPPNWT_K = THE_K(I).GT.TM/EXK(I) CHGPHS2A.119
BPPNWT_KM1 = THE_KM1(I).GT.TM/EXKM1(I) CHGPHS2A.120
FACTOR = LF*G/(EXKM1(I)*CP*DELPKM1(I)) CHGPHS2A.121
C FREEZE CHGPHS2A.122
IF (.NOT.BPPNWT_KM1.AND.(BPPNWT_K.OR.RAIN(I).GT.0.0)) THEN CHGPHS2A.123
DTHBYDT_KM1(I) = DTHBYDT_KM1(I)+RAIN(I)*FACTOR CHGPHS2A.124
SNOW(I) = SNOW(I)+RAIN(I) CHGPHS2A.125
RAIN(I) = 0.0 CHGPHS2A.126
END IF CHGPHS2A.127
C MELT CHGPHS2A.128
IF (BPPNWT_KM1.AND.(.NOT.BPPNWT_K.OR.SNOW(I).GT.0.0)) THEN CHGPHS2A.129
DTHBYDT_KM1(I) = DTHBYDT_KM1(I)-SNOW(I)*FACTOR CHGPHS2A.130
RAIN(I) = RAIN(I)+SNOW(I) CHGPHS2A.131
SNOW(I) = 0.0 CHGPHS2A.132
END IF CHGPHS2A.133
END DO CHGPHS2A.134
C CHGPHS2A.135
RETURN CHGPHS2A.136
END CHGPHS2A.137
C CHGPHS2A.138
*ENDIF CHGPHS2A.139