*IF DEF,A16_1A SNOWPR1A.2
C ******************************COPYRIGHT****************************** GTS2F400.9217
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9218
C GTS2F400.9219
C Use, duplication or disclosure of this code is subject to the GTS2F400.9220
C restrictions as set forth in the contract. GTS2F400.9221
C GTS2F400.9222
C Meteorological Office GTS2F400.9223
C London Road GTS2F400.9224
C BRACKNELL GTS2F400.9225
C Berkshire UK GTS2F400.9226
C RG12 2SZ GTS2F400.9227
C GTS2F400.9228
C If no contract has been raised with this copy of the code, the use, GTS2F400.9229
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9230
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9231
C Modelling at the above address. GTS2F400.9232
C ******************************COPYRIGHT****************************** GTS2F400.9233
C GTS2F400.9234
CLL SUBROUTINE SNOWPR ------------------------------------------------- SNOWPR1A.3
CLL SNOWPR1A.4
CLL Purpose: This routine calculates the snowfall probabilty SNOWPR1A.5
CLL using an equation based on the 1000-850 TT SNOWPR1A.6
CLL Tested under compiler CFT77 SNOWPR1A.7
CLL Tested under OS version 5.1 SNOWPR1A.8
CLL SNOWPR1A.9
CLL J.Heming <- programmer of some or all of previous code or changes SNOWPR1A.10
CLL D.Robinson <- programmer of some or all of previous code or changes SNOWPR1A.11
CLL SNOWPR1A.12
CLL Model Modification history from model version 3.0: SNOWPR1A.13
CLL version Date SNOWPR1A.14
!LL 4.5 15/04/98 Start-end args added to enable dupicate halo GSM1F405.438
!LL calculations to be avoided. S.D.Mullerworth GSM1F405.439
CLL SNOWPR1A.15
CLL Logical components covered D432 SNOWPR1A.16
CLL Project TASK: D4 SNOWPR1A.17
CLL SNOWPR1A.18
CLL Programming standard: U M DOC Paper NO. 4, SNOWPR1A.19
CLL SNOWPR1A.20
CLL External documentation SNOWPR1A.21
CLL SNOWPR1A.22
CLLEND------------------------------------------------------------------ SNOWPR1A.23
C SNOWPR1A.24
C*L ARGUMENTS:---------------------------------------------------------- SNOWPR1A.25
SUBROUTINE SNOWPR 1,2SNOWPR1A.26
1 (P,PSTAR,P_EXNER_HALF,THETA,Q,MODEL_HALF_HEIGHT, SNOWPR1A.27
2 P_FIELD,P_LEVELS,Q_LEVELS,Z_REF,AKH,BKH, SNOWPR1A.28
& SNPROB,START,END) GSM1F405.440
C* SNOWPR1A.30
C*L--------------------------------------------------------------------- SNOWPR1A.31
IMPLICIT NONE SNOWPR1A.32
C* SNOWPR1A.33
C*L--------------------------------------------------------------------- SNOWPR1A.34
INTEGER SNOWPR1A.35
* P_FIELD ! IN No of points in field SNOWPR1A.36
*, P_LEVELS ! IN No of pressure levels SNOWPR1A.37
*, Q_LEVELS ! IN No of wet levels SNOWPR1A.38
*, Z_REF ! IN Level of model used to calculate PMSL SNOWPR1A.39
&, START,END ! IN Range of points to calculate GSM1F405.441
C----------------------------------------------------------------------- SNOWPR1A.40
REAL SNOWPR1A.41
* P(P_FIELD,P_LEVELS) ! IN Pressure array SNOWPR1A.42
*, PSTAR(P_FIELD) ! IN Pressure on surface of earth SNOWPR1A.43
*, P_EXNER_HALF(P_FIELD,P_LEVELS+1) !IN Exner press on half levels SNOWPR1A.44
*, THETA(P_FIELD,P_LEVELS) !IN Potential temperature SNOWPR1A.45
*, Q(P_FIELD,Q_LEVELS) !IN Specific Humidity SNOWPR1A.46
*, MODEL_HALF_HEIGHT(P_FIELD,P_LEVELS+1) !IN Heights on half levels SNOWPR1A.47
*, AKH(P_LEVELS+1) !IN A values on half levels SNOWPR1A.48
*, BKH(P_LEVELS+1) !IN B values on half levels SNOWPR1A.49
*, SNPROB(P_FIELD) ! OUT Snow probability in % SNOWPR1A.50
C*---------------------------------------------------------------------- SNOWPR1A.51
C SNOWPR1A.52
C*L WORKSPACE USAGE----------------------------------------------------- SNOWPR1A.53
REAL SNOWPR1A.54
* PRESSURE(P_FIELD) ! Pressure at which height is calculated SNOWPR1A.55
*, Z_100000(P_FIELD) ! Height at 1000000 Pa SNOWPR1A.56
*, Z_85000(P_FIELD) ! Height at 850000 Pa SNOWPR1A.57
C*---------------------------------------------------------------------- SNOWPR1A.58
C SNOWPR1A.59
C*L EXTERNAL SUBROUTINES CALLED----------------------------------------- SNOWPR1A.60
EXTERNAL V_INT_Z SNOWPR1A.61
C*---------------------------------------------------------------------- SNOWPR1A.62
C SNOWPR1A.63
*CALL C_R_CP 
SNOWPR1A.64
*CALL C_G SNOWPR1A.65
C SNOWPR1A.66
C*L--------------------------------------------------------------------- SNOWPR1A.67
C DEFINE LOCAL VARIABLES SNOWPR1A.68
C----------------------------------------------------------------------- SNOWPR1A.69
INTEGER SNOWPR1A.70
* I ! Loop counter SNOWPR1A.71
*, EDGE ! Highest height at which snow prob will be calculated SNOWPR1A.72
C*---------------------------------------------------------------------- SNOWPR1A.73
CL 1. Calculate height of surface at pressure of 100000Pa SNOWPR1A.74
C----------------------------------------------------------------------- SNOWPR1A.75
DO I=START,END GSM1F405.442
PRESSURE(I)=100000. SNOWPR1A.77
ENDDO SNOWPR1A.78
C----------------------------------------------------------------------- SNOWPR1A.81
CALL V_INT_Z(PRESSURE,P(1,Z_REF),PSTAR,P_EXNER_HALF,THETA,Q, SNOWPR1A.82
& MODEL_HALF_HEIGHT,Z_100000,P_FIELD,P_LEVELS,Q_LEVELS, SNOWPR1A.83
& Z_REF,AKH,BKH,START,END) GSM1F405.443
C----------------------------------------------------------------------- SNOWPR1A.85
CL 2. Calculate height of surface at pressure of 85000Pa SNOWPR1A.86
C----------------------------------------------------------------------- SNOWPR1A.87
DO I=START,END GSM1F405.444
PRESSURE(I)=85000. SNOWPR1A.89
ENDDO SNOWPR1A.90
C----------------------------------------------------------------------- SNOWPR1A.92
CALL V_INT_Z(PRESSURE,P(1,Z_REF),PSTAR,P_EXNER_HALF,THETA,Q, SNOWPR1A.93
& MODEL_HALF_HEIGHT,Z_85000,P_FIELD,P_LEVELS,Q_LEVELS, SNOWPR1A.94
& Z_REF,AKH,BKH,START,END) GSM1F405.445
C----------------------------------------------------------------------- SNOWPR1A.98
CL 3. Calculate the snow probability in % SNOWPR1A.99
C----------------------------------------------------------------------- SNOWPR1A.100
EDGE=1.E8 SNOWPR1A.101
DO I=START,END GSM1F405.446
IF (Z_100000(I).LE.EDGE) THEN SNOWPR1A.103
SNPROB(I)=4.*(1305.-(Z_85000(I)-.96666*Z_100000(I))) SNOWPR1A.104
ELSE SNOWPR1A.105
SNPROB(I)=0. SNOWPR1A.106
ENDIF SNOWPR1A.107
IF (SNPROB(I).LE.0.) SNPROB(I)=0. SNOWPR1A.108
IF (SNPROB(I).GE.100.) SNPROB(I)=100. SNOWPR1A.109
ENDDO SNOWPR1A.110
C----------------------------------------------------------------------- SNOWPR1A.111
RETURN SNOWPR1A.112
END SNOWPR1A.113
*ENDIF SNOWPR1A.114