*IF DEF,A16_1A FREEZE1A.2
C ******************************COPYRIGHT****************************** GTS2F400.3151
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.3152
C GTS2F400.3153
C Use, duplication or disclosure of this code is subject to the GTS2F400.3154
C restrictions as set forth in the contract. GTS2F400.3155
C GTS2F400.3156
C Meteorological Office GTS2F400.3157
C London Road GTS2F400.3158
C BRACKNELL GTS2F400.3159
C Berkshire UK GTS2F400.3160
C RG12 2SZ GTS2F400.3161
C GTS2F400.3162
C If no contract has been raised with this copy of the code, the use, GTS2F400.3163
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.3164
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.3165
C Modelling at the above address. GTS2F400.3166
C ******************************COPYRIGHT****************************** GTS2F400.3167
C GTS2F400.3168
CLL SUBROUTINE FREEZE------------------------------------------ FREEZE1A.3
CLL FREEZE1A.4
CLL PURPOSE: Calculates the true height and pressure of a temperature FREEZE1A.5
CLL surface with temperature T0. FREEZE1A.6
CLL T0 set in PHY_DIAG. T0=273.16K for freezing level FREEZE1A.7
CLL T0=253.16K for -20 degree C level FREEZE1A.8
CLL Tested under compiler CFT77 FREEZE1A.9
CLL Tested under OS version 5.1 FREEZE1A.10
CLL FREEZE1A.11
CLL J.Heming <- programmer of some or all of previous code or changes FREEZE1A.12
CLL D.Robinson <- programmer of some or all of previous code or changes FREEZE1A.13
CLL P.Smith <- programmer of some or all of previous code or changes APS3F304.1
CLL FREEZE1A.14
CLL Model Modification history from model version 3.0: FREEZE1A.15
CLL version Date FREEZE1A.16
CLL 3.4 23/8/94 Correct search for T0 to find highest occurence APS3F304.2
CLL avioding low level inversions PJS APS3F304.3
!LL 4.5 15/04/98 Start-end args added to enable dupicate halo GSM1F405.549
!LL calculations to be avoided. S.D.Mullerworth GSM1F405.550
CLL FREEZE1A.17
CLL Logical components covered D422,D421,D423 FREEZE1A.18
CLL Project TASK: D4 FREEZE1A.19
CLL FREEZE1A.20
CLL Programming standard: U M DOC Paper NO. 4, FREEZE1A.21
CLL FREEZE1A.22
CLL External documentation FREEZE1A.23
CLL FREEZE1A.24
CLLEND------------------------------------------------------------- FREEZE1A.25
C FREEZE1A.26
C*L ARGUMENTS:--------------------------------------------------- FREEZE1A.27
SUBROUTINE FREEZE( 4,1FREEZE1A.28
C data in FREEZE1A.29
& T0,P,THETA,T,P_EXNER_HALF,PSTAR,Q,MODEL_HALF_HEIGHT,OROG, FREEZE1A.30
C data out FREEZE1A.31
& Z_AT_T0,P_AT_T0, FREEZE1A.32
C constants in FREEZE1A.33
& POINTS,P_LEVELS,Q_LEVELS,L,AKH,BKH,START,END) GSM1F405.551
C* FREEZE1A.35
C*L FREEZE1A.36
C----------------------------------------------------------------------- FREEZE1A.37
IMPLICIT NONE FREEZE1A.38
C----------------------------------------------------------------------- FREEZE1A.39
EXTERNAL V_INT_Z FREEZE1A.40
C----------------------------------------------------------------------- FREEZE1A.41
INTEGER FREEZE1A.42
* POINTS ! IN NO OF POINTS FREEZE1A.43
*,P_LEVELS ! IN NO OF MODEL LEVELS FREEZE1A.44
*,Q_LEVELS ! IN NO OF HUMIDITY LEVELS FREEZE1A.45
*,L ! IN LEVEL OF MODEL USED TO CALC HEIGHT FREEZE1A.46
&,START,END ! IN Range of points to calculate GSM1F405.552
C----------------------------------------------------------------------- FREEZE1A.47
REAL FREEZE1A.48
* P(POINTS,P_LEVELS) ! IN PRESSURE AT FULL LEVELS FREEZE1A.49
*,THETA(POINTS,P_LEVELS) ! IN POTENTIAL TEMPERATURE " " " FREEZE1A.50
*,T(POINTS,P_LEVELS) ! IN TEMPERATURE AT FULL LEVELS FREEZE1A.51
*,P_EXNER_HALF(POINTS,P_LEVELS+1) ! IN EXNER PRESSURE AT MODEL FREEZE1A.52
* ! HALF LEVELS FREEZE1A.53
*,PSTAR(POINTS) ! IN SURFACE PRESSURE FREEZE1A.54
*,Q(POINTS,Q_LEVELS) ! SPECIFIC HUM AT FULL LEVELS FREEZE1A.55
*,MODEL_HALF_HEIGHT(POINTS,P_LEVELS+1)!IN HEIGHT OF HALF LVLS FREEZE1A.56
*,OROG(POINTS) ! IN MODEL OROGRAPHY FREEZE1A.57
*,T0 ! IN TEMP OF SURFACE IN K FREEZE1A.58
*,AKH(P_LEVELS+1) ! IN A values at half levels. FREEZE1A.59
*,BKH(P_LEVELS+1) ! IN B values at half levels. FREEZE1A.60
*,P_AT_T0(POINTS) ! OUT PRESSURE AT LEVEL WITH TEMP T0 FREEZE1A.61
*,Z_AT_T0(POINTS) ! OUT HEIGHT AT LEVEL WITH TEMP T0 FREEZE1A.62
C* FREEZE1A.63
C*L FREEZE1A.64
C----------------------------------------------------------------------- FREEZE1A.65
C Local Variables FREEZE1A.66
C----------------------------------------------------------------------- FREEZE1A.67
INTEGER FREEZE1A.68
* I,K ! LOOP COUNTERS FREEZE1A.69
*,J ! LOWEST ETA LEVEL WITH TEMP<T0 FREEZE1A.70
REAL FREEZE1A.71
* PJP1, PJ, PJM1 ! Pressure at half levels J+1,J,J-1 FREEZE1A.72
*,P_EXNER_FULL_JM1 ! EXNER PRESSURE AT FULL LEVEL J-1 FREEZE1A.73
*,P_EXNER_FULL_J ! " " " " " J FREEZE1A.74
*,DEL_EXNER_JM1 ! EXNER PRESSURE DIFF BET LEVELS FREEZE1A.75
* ! J-3/2 AND J-1/2 FREEZE1A.76
*,DEL_EXNER_J ! " " " " "J-1/2 AND J+1/2 FREEZE1A.77
*,TERM1,TERM2 ! FREEZE1A.78
*,LAPSE_RATE ! LAPSE RATE BETWEEN LEVELS J-1 AND J FREEZE1A.79
*,Z(POINTS,P_LEVELS)! HEIGHT OF POINTS WITH PRESSURE P FREEZE1A.80
C----------------------------------------------------------------------- FREEZE1A.81
C Note: these variables are temporary FREEZE1A.82
C----------------------------------------------------------------------- FREEZE1A.83
INTEGER I_F FREEZE1A.84
REAL T1,MULT FREEZE1A.85
C----------------------------------------------------------------------- FREEZE1A.86
C Constants FREEZE1A.87
C----------------------------------------------------------------------- FREEZE1A.88
C* FREEZE1A.89
*CALL C_R_CP 
FREEZE1A.90
*CALL C_G FREEZE1A.91
C----------------------------------------------------------------------- FREEZE1A.92
REAL CP_OVER_G FREEZE1A.93
PARAMETER(CP_OVER_G=CP/G) FREEZE1A.94
FREEZE1A.95
*CALL P_EXNERC FREEZE1A.96
C----------------------------------------------------------------------- FREEZE1A.97
CL Calculate heights of full levels FREEZE1A.98
C----------------------------------------------------------------------- FREEZE1A.99
DO K=1,P_LEVELS FREEZE1A.100
CALL V_INT_Z(P(1,K),P(1,L),PSTAR,P_EXNER_HALF,THETA,Q, FREEZE1A.101
& MODEL_HALF_HEIGHT,Z(1,K),POINTS,P_LEVELS,Q_LEVELS,L,AKH,BKH GSM1F405.553
& ,START,END) GSM1F405.554
ENDDO FREEZE1A.103
C----------------------------------------------------------------------- FREEZE1A.104
T1=T0 FREEZE1A.105
I_F=0 FREEZE1A.106
C----------------------------------------------------------------------- FREEZE1A.107
CL Search upwards for levels with temperature less than T0 where level APS3F304.4
CL below is greater than T0. Highest of these is used for calulations. APS3F304.5
C----------------------------------------------------------------------- FREEZE1A.109
DO 111 I=START,END GSM1F405.555
J=0 FREEZE1A.111
DO K=1,P_LEVELS FREEZE1A.112
IF (T(I,K).LT.T0) THEN APS3F304.6
IF (K.EQ.1) THEN APS3F304.7
J = K APS3F304.8
ELSEIF (T(I,K-1).GT.T0) THEN APS3F304.9
J = K APS3F304.10
ENDIF APS3F304.11
ENDIF APS3F304.12
ENDDO FREEZE1A.114
C----------------------------------------------------------------------- FREEZE1A.115
IF (J.GE.2) THEN FREEZE1A.116
I_F=I_F+1 FREEZE1A.117
C----------------------------------------------------------------------- FREEZE1A.118
CL Exner pressure at full levels FREEZE1A.119
C----------------------------------------------------------------------- FREEZE1A.120
PJP1 = AKH(J+1) + BKH(J+1)*PSTAR(I) FREEZE1A.121
PJ = AKH(J) + BKH(J) *PSTAR(I) FREEZE1A.122
PJM1 = AKH(J-1) + BKH(J-1)*PSTAR(I) FREEZE1A.123
P_EXNER_FULL_J = P_EXNER_C FREEZE1A.124
& (P_EXNER_HALF(I,J+1),P_EXNER_HALF(I,J),PJP1,PJ,KAPPA) FREEZE1A.125
P_EXNER_FULL_JM1 = P_EXNER_C FREEZE1A.126
& (P_EXNER_HALF(I,J),P_EXNER_HALF(I,J-1),PJ,PJM1,KAPPA) FREEZE1A.127
C----------------------------------------------------------------------- FREEZE1A.128
CL Exner pressure difference across half layers FREEZE1A.129
C----------------------------------------------------------------------- FREEZE1A.130
DEL_EXNER_J=P_EXNER_HALF(I,J)-P_EXNER_FULL_J FREEZE1A.131
DEL_EXNER_JM1=P_EXNER_FULL_JM1-P_EXNER_HALF(I,J) FREEZE1A.132
C----------------------------------------------------------------------- FREEZE1A.133
CL Denominator FREEZE1A.134
C----------------------------------------------------------------------- FREEZE1A.135
TERM2=CP_OVER_G*(THETA(I,J-1)*DEL_EXNER_JM1 FREEZE1A.136
* +THETA(I,J)*DEL_EXNER_J) FREEZE1A.137
C----------------------------------------------------------------------- FREEZE1A.138
CL Numerator FREEZE1A.139
C----------------------------------------------------------------------- FREEZE1A.140
TERM1=THETA(I,J-1)*P_EXNER_FULL_JM1-THETA(I,J)*P_EXNER_FULL_J FREEZE1A.141
C----------------------------------------------------------------------- FREEZE1A.142
CL Lapse rate between level j-1 and j FREEZE1A.143
C----------------------------------------------------------------------- FREEZE1A.144
LAPSE_RATE=TERM1/TERM2 FREEZE1A.145
MULT=(T(I,J-1)-T0)/LAPSE_RATE FREEZE1A.146
C----------------------------------------------------------------------- FREEZE1A.147
CL Calculate the height and pressure at level with temperature T0 FREEZE1A.148
C----------------------------------------------------------------------- FREEZE1A.149
Z_AT_T0(I)=Z(I,J-1)+(T(I,J-1)-T0)/LAPSE_RATE FREEZE1A.150
P_AT_T0(I)=P(I,J-1)*(T0/T(I,J-1))**(G/(R*LAPSE_RATE)) FREEZE1A.151
ELSE IF(J.EQ.1) THEN FREEZE1A.152
Z_AT_T0(I)=OROG(I) FREEZE1A.153
P_AT_T0(I)=PSTAR(I) FREEZE1A.154
ELSE ! J=0 FREEZE1A.155
Z_AT_T0(I)=-1 FREEZE1A.156
P_AT_T0(I)=-1 FREEZE1A.157
ENDIF FREEZE1A.158
111 CONTINUE FREEZE1A.159
C----------------------------------------------------------------------- FREEZE1A.160
RETURN FREEZE1A.161
END FREEZE1A.162
*ENDIF FREEZE1A.163