*IF DEF,A04_2B,OR,DEF,A04_2C ARN1F304.30
C ******************************COPYRIGHT****************************** GTS2F400.5455
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.5456
C GTS2F400.5457
C Use, duplication or disclosure of this code is subject to the GTS2F400.5458
C restrictions as set forth in the contract. GTS2F400.5459
C GTS2F400.5460
C Meteorological Office GTS2F400.5461
C London Road GTS2F400.5462
C BRACKNELL GTS2F400.5463
C Berkshire UK GTS2F400.5464
C RG12 2SZ GTS2F400.5465
C GTS2F400.5466
C If no contract has been raised with this copy of the code, the use, GTS2F400.5467
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.5468
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.5469
C Modelling at the above address. GTS2F400.5470
C ******************************COPYRIGHT****************************** GTS2F400.5471
C GTS2F400.5472
C*LL SUBROUTINES LS_PPN LS_PPNC and LSP_FORM--------------------------- LSPPN2B.3
CLL Purpose: LSPPN2B.4
CLL LS_PPN and LS_PPNC: LSPPN2B.5
CLL Calculate large-scale (dynamical) precipitation. LSPPN2B.6
CLL LS_PPNC is the gather/scatter routine which then LSPPN2B.7
CLL calls LSP_EVAP,LSP_FRMT,LSP_FORM. LSPPN2B.8
CLL Treatment of evaporation made implicit. C Wilson 18/09/90. LSPPN2B.9
CLL Note: in all cases, level counters (incl subscripts) run from 1 LSPPN2B.10
CLL (lowest model layer) to Q_LEVELS (topmost "wet" model LSPPN2B.11
CLL layer) - it is assumed that the bottom Q_LEVELS layers are LSPPN2B.12
CLL the "wet" layers. LSPPN2B.13
CLL LSPPN2B.14
CLL Put through fpp on Cray. Activate *IF definition CRAY if running LSPPN2B.15
CLL on the Cray. Function FOCWWIL is now a COMDECK LSPPN2B.16
CLL (This function is called by LSP_FORM.) LSPPN2B.17
CLL LSPPN2B.18
CLL This routine is suitable for single-column use. LSPPN2B.19
CLL LSPPN2B.20
CLL C.Wilson <- programmer of some or all of previous code or changes LSPPN2B.21
CLL C.Senior <- programmer of some or all of previous code or changes LSPPN2B.22
CLL LSPPN2B.23
CLL Model Modification history from model version 3.0: LSPPN2B.24
CLL version Date LSPPN2B.25
CLL 3.1 23/02/93 LS_PPN and LS_PPNC LSPPN2B.26
CLL Inclusion of F_DELTA_SNOW (fraction of snow from LSPPN2B.27
CLL ice falling as water) for use in LSP_FORM with LSPPN2B.28
CLL fully divergent ice fallout. LSPPN2B.29
CLL 3.4 15/08/94 Include layer rain and snow deltas for aerosol. APC3F304.115
CLL LSPPN2B.30
CLL Ruth Carnell 26/02/93 LSPPN2B.31
CLL 3.4 21/09/94 Correct gather/scatter index code (only accessed ARR2F304.7
CLL when *DEF CRAY is not active). Note that *DEF CRAY ARR2F304.8
CLL is used inappropriately in this routine to ARR2F304.9
CLL separate code for the full model and the single ARR2F304.10
CLL column model. R. Rawlins ARR2F304.11
CLL 4.2 Oct. 96 T3E migration: *DEF CRAY removed, whenimd removed. GSS2F402.257
CLL S.J.Swarbrick GSS2F402.258
CLL 4.5 01/05/98 Restrict murk aerosol calculations to aerosol APC0F405.777
CLL levels=boundary levels. P.Clark APC0F405.778
CLL LSPPN2B.32
CLL Programming standard: Unified Model Documentation Paper No 4, LSPPN2B.33
CLL Version 2, dated 18/1/90. LSPPN2B.34
CLL LSPPN2B.35
CLL Logical component covered: P26. LSPPN2B.36
CLL LSPPN2B.37
CLL Project task: LSPPN2B.38
CLL LSPPN2B.39
CLL Documentation: UM Documentation Paper 26. LSPPN2B.40
CLL LSPPN2B.41
C*L Arguments:--------------------------------------------------------- LSPPN2B.42
SUBROUTINE LS_PPN( 3,4LSPPN2B.43
+AK,BK,CF,DELTA_AK,DELTA_BK,PSTAR,TIMESTEP,BLAND, LSPPN2B.44
+CW_SEA,CW_LAND,Q_LEVELS,PFIELD, LSPPN2B.45
& POINTS,K1STPT,A_LEVELS,Q,QCF,QCL,T, APC0F405.779
& AEROSOL,L_MURK,LSRAIN,LSSNOW, APC0F405.780
& ERROR APC3F304.117
+) LSPPN2B.47
IMPLICIT NONE LSPPN2B.48
INTEGER LSPPN2B.49
+ Q_LEVELS ! IN Number of "wet" levels in the model. LSPPN2B.50
&,A_LEVELS ! IN Number of aerosol levels APC0F405.781
+,PFIELD ! IN Number of gridpoints in one field (at one level). LSPPN2B.51
+,POINTS ! IN Number of gridpoints being processed. LSPPN2B.52
+,K1STPT ! IN First gridpoint processed within complete field. LSPPN2B.53
REAL LSPPN2B.54
+ CF(PFIELD,Q_LEVELS) ! IN Cloud fraction. LSPPN2B.55
+,PSTAR(PFIELD) ! IN Surface pressure (Pa). LSPPN2B.56
+,AK(Q_LEVELS) ! IN Hybrid co-ordinate for centre of layer. LSPPN2B.57
+,BK(Q_LEVELS) ! IN Hybrid co-ordinate for centre of layer. LSPPN2B.58
+,DELTA_AK(Q_LEVELS) ! IN Change of hybrid co-ord across layer. LSPPN2B.59
C ! (Upper minus lower). LSPPN2B.60
+,DELTA_BK(Q_LEVELS) ! IN Change of hybrid co-ord across layer. LSPPN2B.61
C ! (Upper minus lower). LSPPN2B.62
REAL TIMESTEP ! IN Timestep (sec). LSPPN2B.63
REAL CW_SEA, ! IN threshold cloud liquid water content LSPPN2B.64
C ! over sea for conversion to ppn LSPPN2B.65
C ! (kg water per m**3) LSPPN2B.66
+ CW_LAND ! IN threshold cloud liquid water content LSPPN2B.67
C ! over land for conversion to ppn LSPPN2B.68
C ! (kg water per m**3) LSPPN2B.69
LOGICAL BLAND(PFIELD) ! IN Land/sea mask LSPPN2B.70
& , L_MURK ! IN : Aerosol needs scavenging. APC3F304.118
REAL LSPPN2B.71
+ Q(PFIELD,Q_LEVELS) ! INOUT Specific humidity (kg water/kg air). LSPPN2B.72
+,QCF(PFIELD,Q_LEVELS) ! INOUT Cloud ice (kg per kg air). LSPPN2B.73
+,QCL(PFIELD,Q_LEVELS) ! INOUT Cloud liquid water (kg per kg air). LSPPN2B.74
+,T(PFIELD,Q_LEVELS) ! INOUT Temperature (K). LSPPN2B.75
&,AEROSOL(PFIELD,A_LEVELS) ! INOUT Aerosol APC0F405.782
REAL LSPPN2B.76
+ LSRAIN(PFIELD) ! OUT Surface rainfall rate (kg per sq m per s). LSPPN2B.77
+,LSSNOW(PFIELD) ! OUT Surface snowfall rate (kg per sq m per s). LSPPN2B.78
INTEGER LSPPN2B.79
+ ERROR ! OUT Return code - 0 if OK, LSPPN2B.80
C ! 1 if bad arguments. LSPPN2B.81
C*L Workspace usage --------------------------------------------------- LSPPN2B.82
C 0 real,1 logical and 1 integer blocks are required, as follows :- LSPPN2B.84
LOGICAL LSPPN2B.85
+ H(PFIELD) ! Used as "logical" in compression. LSPPN2B.86
& ,L_SCAVENGE ! scavenge aerosol on level. APC0F405.783
INTEGER LSPPN2B.87
+ IX(PFIELD) ! Index for compress/expand. LSPPN2B.88
REAL F_DELTA_SNOW(PFIELD) ! snow fraction from ice falling LSPPN2B.89
C ! as water LSPPN2B.90
C External subroutines called ----------------------------------------- LSPPN2B.100
EXTERNAL LS_PPNC LSPPN2B.101
C*---------------------------------------------------------------------- LSPPN2B.108
C Physical constants ------------------------------------------------- LSPPN2B.109
REAL CFMIN LSPPN2B.110
PARAMETER ( LSPPN2B.111
+ CFMIN=1.0E-3 ! Used for LS_PPNC compress. LSPPN2B.112
+) LSPPN2B.113
C Define local variables ---------------------------------------------- LSPPN2B.114
INTEGER I,K ! Loop counters: I - horizontal field index; LSPPN2B.115
C ! K - vertical level index. LSPPN2B.116
+,N ! "nval" for WHEN routine. LSPPN2B.117
! AYY2F400.231
ERROR=0 LSPPN2B.121
IF((K1STPT+POINTS-1).GT.PFIELD)THEN LSPPN2B.122
ERROR=1 LSPPN2B.123
GOTO20 LSPPN2B.124
ENDIF LSPPN2B.125
C----------------------------------------------------------------------- LSPPN2B.126
CL Internal structure. LSPPN2B.127
CL 1. Initialise rain and snow to zero. LSPPN2B.128
C----------------------------------------------------------------------- LSPPN2B.129
DO 1 I=K1STPT,K1STPT+POINTS-1 LSPPN2B.130
LSRAIN(I)=0.0 LSPPN2B.131
LSSNOW(I)=0.0 LSPPN2B.132
F_DELTA_SNOW(I)=0.0 LSPPN2B.133
1 CONTINUE LSPPN2B.134
C LSPPN2B.135
C----------------------------------------------------------------------- LSPPN2B.136
CL 2. Loop round levels from top down (counting bottom level as level 1, LSPPN2B.137
CL as is standard in the Unified model). LSPPN2B.138
C----------------------------------------------------------------------- LSPPN2B.139
C LSPPN2B.140
DO 5 K=Q_LEVELS,1,-1 LSPPN2B.141
C----------------------------------------------------------------------- LSPPN2B.142
CL 2.5 Form INDEX IX to gather/scatter variables in LS_PPNC LSPPN2B.143
C----------------------------------------------------------------------- LSPPN2B.144
C LSPPN2B.145
C Set index where cloud fraction > CFMIN or where non-zero pptn LSPPN2B.146
C Note: whenimd is functionally equivalent to WHENILE (but autotasks). LSPPN2B.147
C LSPPN2B.148
N=0 LSPPN2B.156
DO 10 I=K1STPT,K1STPT+POINTS-1 LSPPN2B.157
IF (CF(I,K).GT.CFMIN .OR. (LSRAIN(I)+LSSNOW(I)).GT.0.0) THEN LSPPN2B.158
N=N+1 LSPPN2B.159
IX(N)=I-K1STPT+1 ARR2F304.12
ENDIF LSPPN2B.161
10 CONTINUE LSPPN2B.162
C LSPPN2B.164
L_SCAVENGE = L_MURK .AND. (K.LE.A_LEVELS) APC0F405.784
IF(N.GT.0)THEN LSPPN2B.165
LSPPN2B.166
CALL LS_PPNC
(IX,N,TIMESTEP,POINTS,PSTAR(K1STPT), LSPPN2B.167
& LSRAIN(K1STPT),LSSNOW(K1STPT),CF(K1STPT,K), LSPPN2B.168
& QCF(K1STPT,K),QCL(K1STPT,K),T(K1STPT,K), LSPPN2B.169
& AEROSOL(K1STPT,MIN(K,A_LEVELS)),L_SCAVENGE, APC0F405.785
& Q(K1STPT,K),AK(K),BK(K),DELTA_AK(K),DELTA_BK(K), LSPPN2B.170
& F_DELTA_SNOW(K1STPT),BLAND(K1STPT),CW_SEA,CW_LAND) LSPPN2B.171
ENDIF LSPPN2B.172
C LSPPN2B.173
5 CONTINUE LSPPN2B.174
20 CONTINUE LSPPN2B.175
RETURN LSPPN2B.179
END LSPPN2B.180
C*LL SUBROUTINE LS_PPNC------------------------------------------------ LSPPN2B.181
C*L Arguments:--------------------------------------------------------- LSPPN2B.182
SUBROUTINE LS_PPNC( 3,22LSPPN2B.183
& IX,N,TIMESTEP,POINTS,PSTAR,LSRAIN,LSSNOW, APC3F304.121
& CF,QCF,QCL,T,AEROSOL,L_MURK,Q, APC3F304.122
+ AK,BK,DELTA_AK,DELTA_BK LSPPN2B.185
+,F_DELTA_SNOW,BLAND,CW_SEA,CW_LAND LSPPN2B.186
+) LSPPN2B.187
IMPLICIT NONE LSPPN2B.188
INTEGER LSPPN2B.189
+ N ! IN Number of points where pptn non-zero from above LSPPN2B.190
+,IX(N) ! IN gather/scatter index LSPPN2B.191
+,POINTS ! IN Number of gridpoints being processed. LSPPN2B.192
+ ! or where CF>CFMIN LSPPN2B.193
REAL LSPPN2B.194
+ PSTAR(POINTS) ! IN Surface pressure (Pa). LSPPN2B.195
+,CF(POINTS) ! IN Cloud fraction. LSPPN2B.196
+,AK ! IN Hybrid co-ordinate for centre of layer. LSPPN2B.197
+,BK ! IN Hybrid co-ordinate for centre of layer. LSPPN2B.198
+,DELTA_AK ! IN Change of hybrid co-ord across layer. LSPPN2B.199
C ! (Upper minus lower). LSPPN2B.200
+,DELTA_BK ! IN Change of hybrid co-ord across layer. LSPPN2B.201
C ! (Upper minus lower). LSPPN2B.202
REAL CW_SEA, ! IN threshold cloud liquid water content LSPPN2B.203
C ! over sea for conversion to ppn LSPPN2B.204
C ! (kg water per m**3) LSPPN2B.205
+ CW_LAND ! IN threshold cloud liquid water content LSPPN2B.206
C ! over land for conversion to ppn LSPPN2B.207
C ! (kg water per m**3) LSPPN2B.208
LOGICAL BLAND(POINTS) ! IN Land/sea mask LSPPN2B.209
& , L_MURK ! IN : Aerosol needs scavenging. APC3F304.123
REAL TIMESTEP ! IN Timestep (sec). LSPPN2B.210
REAL LSPPN2B.211
+ Q(POINTS) ! INOUT Specific humidity (kg water/kg air). LSPPN2B.212
+,QCF(POINTS) ! INOUT Cloud ice (kg per kg air). LSPPN2B.213
+,QCL(POINTS) ! INOUT Cloud liquid water (kg per kg air). LSPPN2B.214
+,T(POINTS) ! INOUT Temperature (K). LSPPN2B.215
&,AEROSOL(POINTS) ! INOUT Aerosol (K). APC3F304.124
REAL LSPPN2B.216
+ LSRAIN(POINTS) !INOUT Surface rainfall rate (kg per sq m per s). LSPPN2B.217
+,LSSNOW(POINTS) !INOUT Surface snowfall rate (kg per sq m per s). LSPPN2B.218
+,F_DELTA_SNOW(POINTS) !INOUT snow fraction from ice falling as LSPPN2B.219
C !water. LSPPN2B.220
C*L Workspace usage --------------------------------------------------- LSPPN2B.221
C 10 real,0 logical and 0 integer blocks are required, as follows :- LSPPN2B.223
REAL LSPPN2B.224
+ PSTAR_C(N) ! gathered Surface pressure (Pa). LSPPN2B.225
+,CF_C(N) ! gathered Cloud fraction. LSPPN2B.226
+,Q_C(N) ! gathered Specific humidity (kg water/kg air). LSPPN2B.227
+,QCF_C(N) ! gathered Cloud ice (kg per kg air). LSPPN2B.228
+,QCL_C(N) ! gathered Cloud liquid water (kg per kg air). LSPPN2B.229
+,T_C(N) ! gathered Temperature (K). LSPPN2B.230
&,AERO_C(N) ! Aerosol APC3F304.125
+,LSRAIN_C(N) !gathered Surface rainfall rate (kg per sq m per s). LSPPN2B.231
+,LSSNOW_C(N) !gathered Surface snowfall rate (kg per sq m per s). LSPPN2B.232
+,F_DELTA_SNOW_C(N) !gathered fraction of snow LSPPN2B.233
REAL LSPPN2B.234
+ RHODZ(N) ! WORK Used for air mass p.u.a. in successive LSPPN2B.235
C ! layers. LSPPN2B.236
+,P(N) ! WORK Used for pressure at successive levels. LSPPN2B.237
LOGICAL BLAND_C(N) ! gathered land/sea mask LSPPN2B.238
C External subroutines called ----------------------------------------- LSPPN2B.259
EXTERNAL LSP_EVAP,LSP_FORM,LSP_FRMT,LSP_SCAV APC3F304.127
C*---------------------------------------------------------------------- LSPPN2B.264
C Physical constants ------------------------------------------------- LSPPN2B.265
*CALL C_G LSPPN2B.266
REAL P1UPONG LSPPN2B.267
PARAMETER ( LSPPN2B.268
+ P1UPONG=1./G ! One upon g (sq seconds per m). LSPPN2B.269
+) LSPPN2B.270
C Define local variables ---------------------------------------------- LSPPN2B.271
INTEGER I ! Loop counters: I - horizontal field index; LSPPN2B.272
C LSPPN2B.273
C----------------------------------------------------------------------- LSPPN2B.277
CL Internal structure. LSPPN2B.278
CL 1. gather variables using index LSPPN2B.279
C----------------------------------------------------------------------- LSPPN2B.280
DO 1 I=1,N LSPPN2B.281
LSRAIN_C(I)=LSRAIN(IX(I)) LSPPN2B.282
LSSNOW_C(I)=LSSNOW(IX(I)) LSPPN2B.283
PSTAR_C(I) =PSTAR(IX(I)) LSPPN2B.284
BLAND_C(I) =BLAND(IX(I)) LSPPN2B.285
CF_C(I)=CF(IX(I)) LSPPN2B.286
QCF_C(I)=QCF(IX(I)) LSPPN2B.287
QCL_C(I)=QCL(IX(I)) LSPPN2B.288
Q_C(I)=Q(IX(I)) LSPPN2B.289
T_C(I)=T(IX(I)) LSPPN2B.290
IF (L_MURK) AERO_C(I)=AEROSOL(IX(I)) APC3F304.128
F_DELTA_SNOW_C(I)=F_DELTA_SNOW(IX(I)) LSPPN2B.291
1 CONTINUE LSPPN2B.292
C LSPPN2B.293
C----------------------------------------------------------------------- LSPPN2B.294
CL 2 Calculate pressure at current level, and air mass p.u.a. of LSPPN2B.295
CL current layer. LSPPN2B.296
C (Negative in RHODZ formula takes account of sign of DELTAs.) LSPPN2B.297
C----------------------------------------------------------------------- LSPPN2B.298
DO 2 I=1,N LSPPN2B.299
P(I)=AK+PSTAR_C(I)*BK LSPPN2B.300
RHODZ(I)=-P1UPONG*(DELTA_AK+PSTAR_C(I)*DELTA_BK) LSPPN2B.301
2 CONTINUE LSPPN2B.302
C LSPPN2B.303
C----------------------------------------------------------------------- LSPPN2B.304
CL 3 If there is precipitation falling from above, then :- LSPPN2B.305
C----------------------------------------------------------------------- LSPPN2B.306
C LSPPN2B.307
CL 3.1 Evaporate from precipitation, and calculate the effect on the LSPPN2B.308
CL temperature and specific humidity. Do this by calling LSP_EVAP. LSPPN2B.309
C LSPPN2B.310
CALL LSP_EVAP(P,RHODZ,TIMESTEP,N, LSPPN2B.311
+ Q_C,LSRAIN_C,LSSNOW_C,T_C ) LSPPN2B.312
C LSPPN2B.313
C LSPPN2B.314
CL 3.2 Change phase of precipitation where necessary, and calculate LSPPN2B.315
CL the effect on the temperature and specific humidity. Also set LSPPN2B.316
CL rain/snow indicator (after any incrementing of the temperature). LSPPN2B.317
CL All this is done by calling LSP_FRMT. LSPPN2B.318
C LSPPN2B.319
CALL LSP_FRMT(RHODZ,TIMESTEP,N,QCF_C, LSPPN2B.320
+ QCL_C,LSRAIN_C,LSSNOW_C,T_C ) LSPPN2B.321
C----------------------------------------------------------------------- LSPPN2B.322
CL 3.3 Form (or augment) precipitation at the expense of cloud water. LSPPN2B.323
CL Do this by calling LSP_FORM. LSPPN2B.324
C----------------------------------------------------------------------- LSPPN2B.325
C LSPPN2B.326
CALL LSP_FORM(CF_C,P,Q_C,RHODZ,T_C,TIMESTEP,N,QCF_C,QCL_C, LSPPN2B.327
+ LSRAIN_C,LSSNOW_C,F_DELTA_SNOW_C,BLAND_C, LSPPN2B.328
+ CW_SEA,CW_LAND) LSPPN2B.329
C LSPPN2B.330
IF (L_MURK) THEN APC3F304.129
C Lose aerosol by scavenging. APC3F304.130
C APC3F304.131
CALL LSP_SCAV(TIMESTEP,N,LSRAIN_C,LSSNOW_C,AERO_C) APC3F304.132
C APC3F304.133
END IF APC3F304.134
C----------------------------------------------------------------------- LSPPN2B.331
CL 4 Scatter back arrays which will have been changed. LSPPN2B.332
CL LSPPN2B.333
C----------------------------------------------------------------------- LSPPN2B.334
C LSPPN2B.335
CDIR$ IVDEP LSPPN2B.336
DO 4 I=1,N LSPPN2B.337
T(IX(I))=T_C(I) LSPPN2B.338
Q(IX(I))=Q_C(I) LSPPN2B.339
QCF(IX(I))=QCF_C(I) LSPPN2B.340
QCL(IX(I))=QCL_C(I) LSPPN2B.341
IF (L_MURK) AEROSOL(IX(I))=AERO_C(I) APC3F304.135
LSRAIN(IX(I))=LSRAIN_C(I) LSPPN2B.342
LSSNOW(IX(I))=LSSNOW_C(I) LSPPN2B.343
F_DELTA_SNOW(IX(I)) = F_DELTA_SNOW_C(I) LSPPN2B.344
4 CONTINUE LSPPN2B.345
RETURN LSPPN2B.349
END LSPPN2B.350
*ENDIF LSPPN2B.351