*IF DEF,A05_3C CHGPHS3C.2
C ******************************COPYRIGHT****************************** CHGPHS3C.3
C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. CHGPHS3C.4
C CHGPHS3C.5
C Use, duplication or disclosure of this code is subject to the CHGPHS3C.6
C restrictions as set forth in the contract. CHGPHS3C.7
C CHGPHS3C.8
C Meteorological Office CHGPHS3C.9
C London Road CHGPHS3C.10
C BRACKNELL CHGPHS3C.11
C Berkshire UK CHGPHS3C.12
C RG12 2SZ CHGPHS3C.13
C CHGPHS3C.14
C If no contract has been raised with this copy of the code, the use, CHGPHS3C.15
C duplication or disclosure of it is strictly prohibited. Permission CHGPHS3C.16
C to do so must first be obtained in writing from the Head of Numerical CHGPHS3C.17
C Modelling at the above address. CHGPHS3C.18
C ******************************COPYRIGHT****************************** CHGPHS3C.19
C CHGPHS3C.20
CLL SUBROUTINE CHG_PHSE---------------------------------------------- CHGPHS3C.21
CLL CHGPHS3C.22
CLL PURPOSE : CHANGE OF PHASE ROUTINE FOR POINTS WHERE NO CHGPHS3C.23
CLL DOWNDRAUGHT OCCURING CHGPHS3C.24
CLL CHGPHS3C.25
CLL UPDATES POTENTIAL TEMPERATURE OF LAYER K CHGPHS3C.26
CLL AS PRECIPITATION CHANGES PHASE IN SITU CHGPHS3C.27
CLL CHGPHS3C.28
CLL ADD LATENT HEATING WHERE PRECIPITATION CROSSES A CHGPHS3C.29
CLL MELTING OR FREEZING LEVEL CHGPHS3C.30
CLL CHGPHS3C.31
CLL SUITABLE FOR SINGLE COLUMN MODEL USE CHGPHS3C.32
CLL CHGPHS3C.33
CLL CODE WRITTEN FOR CRAY Y-MP BY S.BETT AND D.GREGORY AUTUMN 1991 CHGPHS3C.34
CLL CHGPHS3C.35
CLL MODEL MODIFICATION HISTORY: CHGPHS3C.36
CLL VERSION DATE CHGPHS3C.37
!LL 4.4 17/10/97 New version optimised for T3E. CHGPHS3C.38
!LL Single PE optimisations D.Salmond CHGPHS3C.39
!LL 4.5 19/05/98 Allow treatment of precip below cloud base as AJX1F405.60
!LL in version 3A or 3B (HADAM3) of convection, in AJX1F405.61
!LL optimised code (version 3C). Julie Gregory AJX1F405.62
CLL CHGPHS3C.40
CLL PROGRAMMING STANDARDS : UNIFIED MODEL DOCUMENTATION PAPER NO. 3 CHGPHS3C.41
CLL VERSION NO. 4 DATED 5/2/92 CHGPHS3C.42
CLL CHGPHS3C.43
CLL PROJECT TASK : P27 CHGPHS3C.44
CLL CHGPHS3C.45
CLL DOCUMENTATION : UNIFIED MODEL DOCUMENTATION PAPER 27 CHGPHS3C.46
CLL CHGPHS3C.47
CLLEND----------------------------------------------------------------- CHGPHS3C.48
C CHGPHS3C.49
C*L ARGUMENTS--------------------------------------------------------- CHGPHS3C.50
C CHGPHS3C.51
SUBROUTINE CHG_PHSE (NPNTS,K,RAIN,SNOW,DTHBYDT_KM1, 4CHGPHS3C.52
& EXK,EXKM1,DELPKM1,THE_K,THE_KM1, AJX1F405.63
& TIMESTEP,CCA,L_PHASE_LIM) AJX1F405.64
C CHGPHS3C.54
IMPLICIT NONE CHGPHS3C.55
C CHGPHS3C.56
C---------------------------------------------------------------------- CHGPHS3C.57
C MODEL CONSTANTS CHGPHS3C.58
C---------------------------------------------------------------------- CHGPHS3C.59
C CHGPHS3C.60
*CALL C_LHEAT 
CHGPHS3C.61
*CALL C_R_CP CHGPHS3C.62
*CALL C_G CHGPHS3C.63
*CALL C_0_DG_C CHGPHS3C.64
*CALL CLDAREA AJX1F405.65
C CHGPHS3C.65
C---------------------------------------------------------------------- CHGPHS3C.66
C VECTOR LENGTHS AND LOOP COUNTERS CHGPHS3C.67
C---------------------------------------------------------------------- CHGPHS3C.68
C CHGPHS3C.69
INTEGER NPNTS ! IN VECTOR LENGTH CHGPHS3C.70
C CHGPHS3C.71
INTEGER I ! LOOP COUNTER CHGPHS3C.72
C CHGPHS3C.73
INTEGER K ! IN MODEL LAYER CHGPHS3C.74
C CHGPHS3C.75
C---------------------------------------------------------------------- CHGPHS3C.76
C VARIABLES WHICH ARE INPUT CHGPHS3C.77
C---------------------------------------------------------------------- CHGPHS3C.78
C CHGPHS3C.79
REAL EXK(NPNTS) ! IN EXNER RATIO FOR LAYER K CHGPHS3C.80
C CHGPHS3C.81
REAL EXKM1(NPNTS) ! IN EXNER RATIO FOR LAYER K-1 CHGPHS3C.82
C CHGPHS3C.83
REAL DELPKM1(NPNTS) ! IN PRESSURE DIFFERENCE ACROSS CHGPHS3C.84
! LAYER K-1 (PA) CHGPHS3C.85
C CHGPHS3C.86
REAL THE_K(NPNTS) ! IN POTENTIAL TEMPERATURE OF CHGPHS3C.87
! ENVIRONMENT IN LAYER K CHGPHS3C.88
C CHGPHS3C.89
REAL THE_KM1(NPNTS) ! IN POTENTIAL TEMPERATURE OF CHGPHS3C.90
! ENVIRONMENT IN LAYER K-1 CHGPHS3C.91
C CHGPHS3C.92
REAL TIMESTEP ! IN Timestep in seconds AJX1F405.66
C AJX1F405.67
REAL CCA(NPNTS) ! IN Convective cloud area AJX1F405.68
C AJX1F405.69
LOGICAL L_PHASE_LIM ! IN Switch to determine if phase AJX1F405.70
C ! change of precip should be AJX1F405.71
C ! limited as in hadam3 physics. AJX1F405.72
C---------------------------------------------------------------------- CHGPHS3C.93
C VARIABLES WHICH ARE INPUT AND OUTPUT CHGPHS3C.94
C---------------------------------------------------------------------- CHGPHS3C.95
C CHGPHS3C.96
REAL RAIN(NPNTS) ! INOUT CHGPHS3C.97
! IN AMOUNT OF FALLING RAIN CHGPHS3C.98
! (KG/M**2/S) CHGPHS3C.99
! OUT UPDATED AMOUNT OF FALLING CHGPHS3C.100
! RAIN (KG/M**2/S) CHGPHS3C.101
C CHGPHS3C.102
REAL SNOW(NPNTS) ! INOUT CHGPHS3C.103
! IN AMOUNT OF FALLING SNOW CHGPHS3C.104
! (KG/M**2/S) CHGPHS3C.105
! OUT UPDATED AMOUNT OF FALLING CHGPHS3C.106
! SNOW (KG/M**2/S) CHGPHS3C.107
C CHGPHS3C.108
REAL DTHBYDT_KM1(NPNTS) ! INOUT CHGPHS3C.109
! IN INCREMENT TO MODEL POTENTIAL CHGPHS3C.110
! TEMPERATURE IN LAYER K-1 CHGPHS3C.111
! OUT UPDATED INCREMENT TO MODEL CHGPHS3C.112
! POTENTIAL TEMPERATURE IN LAYER CHGPHS3C.113
! K-1 DUE TO CHANGE OF PHASE CHGPHS3C.114
C CHGPHS3C.115
C---------------------------------------------------------------------- CHGPHS3C.116
C VARIABLES WHICH ARE DEFINED LOCALLY CHGPHS3C.117
C--------------------------------------------------------------------- CHGPHS3C.118
C CHGPHS3C.119
REAL FACTOR ! USED IN THE CALCULATION OF CHGPHS3C.120
! CHANGE OF PHASE OF FALLING CHGPHS3C.121
! PRECIPITATION CHGPHS3C.122
C CHGPHS3C.123
REAL WPC ! AMOUNT OF PRECIPITATION WHICH CAN AJX1F405.73
C ! CHANGE PHASE AJX1F405.74
C AJX1F405.75
REAL CA ! LOCAL CLOUD AREA AJX1F405.76
C AJX1F405.77
REAL THE_KM1_NEW ! THE_KM1 UPDATED WITH ALL INCREMENTS AJX1F405.78
C ! PRIOR TO THIS SUBROUTINE AJX1F405.79
C AJX1F405.80
LOGICAL BPPNWT_K ! MASK WHERE PRECIPITATION IS LIQUID CHGPHS3C.124
! IN LAYER K CHGPHS3C.125
C CHGPHS3C.126
LOGICAL BPPNWT_KM1 ! MASK WHERE PRECIPITATION IS LIQUID CHGPHS3C.127
! IN LAYER K-1 CHGPHS3C.128
C CHGPHS3C.129
CL CHGPHS3C.130
CL---------------------------------------------------------------------- CHGPHS3C.131
CL ADD LATENT HEATING WHERE PRECIP CROSSES A MELTING OR FREEZING LEVEL CHGPHS3C.132
CL CHGPHS3C.133
CL UM DOCUMENTATION PAPER 27 CHGPHS3C.134
CL SECTION (11), EQUATION (42) CHGPHS3C.135
CL---------------------------------------------------------------------- CHGPHS3C.136
CL CHGPHS3C.137
C AJX1F405.81
IF (L_PHASE_LIM) THEN AJX1F405.82
C AJX1F405.83
DO I=1,NPNTS CHGPHS3C.138
THE_KM1_NEW = THE_KM1(I) + TIMESTEP*DTHBYDT_KM1(I) AJX1F405.84
BPPNWT_K = THE_K(I).GT.TM/EXK(I) AJX1F405.85
BPPNWT_KM1 = THE_KM1_NEW .GT. TM/EXKM1(I) AJX1F405.86
FACTOR = LF*G/(EXKM1(I)*CP*DELPKM1(I)) AJX1F405.87
CA = CLDAREA * CCA(I) AJX1F405.88
C AJX1F405.89
C FREEZE AJX1F405.90
C AJX1F405.91
IF (.NOT.BPPNWT_KM1.AND.(BPPNWT_K.OR.RAIN(I).GT.0.0)) THEN AJX1F405.92
WPC = MIN( RAIN(I), AJX1F405.93
& CA * (TM/EXKM1(I) - THE_KM1_NEW) / AJX1F405.94
& (TIMESTEP * FACTOR) ) AJX1F405.95
DTHBYDT_KM1(I) = DTHBYDT_KM1(I) + WPC * FACTOR AJX1F405.96
SNOW(I) = SNOW(I) + WPC AJX1F405.97
RAIN(I) = RAIN(I) - WPC AJX1F405.98
END IF AJX1F405.99
C AJX1F405.100
C MELT AJX1F405.101
C AJX1F405.102
IF (BPPNWT_KM1.AND.(.NOT.BPPNWT_K.OR.SNOW(I).GT.0.0)) THEN AJX1F405.103
WPC = MIN( SNOW(I), AJX1F405.104
& CA * (THE_KM1_NEW - TM/EXKM1(I)) / AJX1F405.105
& (TIMESTEP * FACTOR) ) AJX1F405.106
DTHBYDT_KM1(I) = DTHBYDT_KM1(I) - WPC * FACTOR AJX1F405.107
RAIN(I) = RAIN(I) + WPC AJX1F405.108
SNOW(I) = SNOW(I) - WPC AJX1F405.109
END IF AJX1F405.110
END DO AJX1F405.111
C AJX1F405.112
ELSE AJX1F405.113
C AJX1F405.114
DO I=1,NPNTS AJX1F405.115
BPPNWT_K = THE_K(I)*EXK(I).GT.TM CHGPHS3C.139
BPPNWT_KM1 = THE_KM1(I)*EXKM1(I).GT.TM CHGPHS3C.140
FACTOR = LF*G/(EXKM1(I)*CP*DELPKM1(I)) CHGPHS3C.141
C FREEZE CHGPHS3C.142
IF (.NOT.BPPNWT_KM1.AND.(BPPNWT_K.OR.RAIN(I).GT.0.0)) THEN CHGPHS3C.143
DTHBYDT_KM1(I) = DTHBYDT_KM1(I)+RAIN(I)*FACTOR CHGPHS3C.144
SNOW(I) = SNOW(I)+RAIN(I) CHGPHS3C.145
RAIN(I) = 0.0 CHGPHS3C.146
END IF CHGPHS3C.147
C MELT CHGPHS3C.148
IF (BPPNWT_KM1.AND.(.NOT.BPPNWT_K.OR.SNOW(I).GT.0.0)) THEN CHGPHS3C.149
DTHBYDT_KM1(I) = DTHBYDT_KM1(I)-SNOW(I)*FACTOR CHGPHS3C.150
RAIN(I) = RAIN(I)+SNOW(I) CHGPHS3C.151
SNOW(I) = 0.0 CHGPHS3C.152
END IF CHGPHS3C.153
END DO CHGPHS3C.154
C AJX1F405.116
ENDIF ! IF L_PHASE_LIM AJX1F405.117
C CHGPHS3C.155
RETURN CHGPHS3C.156
END CHGPHS3C.157
C CHGPHS3C.158
*ENDIF CHGPHS3C.159