*IF DEF,A04_3B LSPPN3B.2
*****************************COPYRIGHT****************************** LSPPN3B.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. LSPPN3B.4
C LSPPN3B.5
C Use, duplication or disclosure of this code is subject to the LSPPN3B.6
C restrictions as set forth in the contract. LSPPN3B.7
C LSPPN3B.8
C Meteorological Office LSPPN3B.9
C London Road LSPPN3B.10
C BRACKNELL LSPPN3B.11
C Berkshire UK LSPPN3B.12
C RG12 2SZ LSPPN3B.13
C LSPPN3B.14
C If no contract has been raised with this copy of the code, the use, LSPPN3B.15
C duplication or disclosure of it is strictly prohibited. Permission LSPPN3B.16
C to do so must first be obtained in writing from the Head of Numerical LSPPN3B.17
C Modelling at the above address. LSPPN3B.18
C ******************************COPYRIGHT****************************** LSPPN3B.19
C LSPPN3B.20
C*LL SUBROUTINES LS_PPN and LS_PPNC------------------------------------ LSPPN3B.21
!LL Purpose: LSPPN3B.22
!LL LS_PPN and LS_PPNC: LSPPN3B.23
!LL Calculate large-scale (dynamical) precipitation. LSPPN3B.24
!LL LS_PPNC is the gather/scatter routine which then LSPPN3B.25
!LL calls LSP_ICE. LSPPN3B.26
!LL Note: in all cases, level counters (incl subscripts) run from 1 LSPPN3B.27
!LL (lowest model layer) to Q_LEVELS (topmost "wet" model LSPPN3B.28
!LL layer) - it is assumed that the bottom Q_LEVELS layers are LSPPN3B.29
!LL the "wet" layers. LSPPN3B.30
!LL LSPPN3B.31
!LL Put through fpp on Cray. Activate *IF definition CRAY if running LSPPN3B.32
!LL on the Cray. LSPPN3B.33
!LL LSPPN3B.34
!LL Modification History from Version 4.4 LSPPN3B.35
!LL Version Date LSPPN3B.36
!LL 4.5 March 98 New Deck Damian Wilson LSPPN3B.37
!LL LSPPN3B.38
!LL Programming standard: Unified Model Documentation Paper No 4, LSPPN3B.39
!LL Version 2, dated 18/1/90. LSPPN3B.40
!LL LSPPN3B.41
!LL Logical component covered: P26. LSPPN3B.42
!LL LSPPN3B.43
!LL Project task: LSPPN3B.44
!LL LSPPN3B.45
!LL Documentation: UM Documentation Paper 26. LSPPN3B.46
!LL LSPPN3B.47
C*L Arguments:--------------------------------------------------------- LSPPN3B.48
SUBROUTINE LS_PPN( 3,4LSPPN3B.49
&AK,BK,CF,DELTA_AK,DELTA_BK,PSTAR,TIMESTEP,BLAND, LSPPN3B.50
&CW_SEA,CW_LAND, LSPPN3B.51
&CLOUD_LIQ_FRAC,CLOUD_ICE_FRAC, LSPPN3B.52
&RHCRIT, LSPPN3B.53
&RHCPT, L_RHCPT, LSPPN3B.54
&Q_LEVELS,PFIELD, LSPPN3B.55
&POINTS,K1STPT,LSPICE_DIM1,LSPICE_DIM2,A_LEVELS,Q,QCF,QCL,T, LSPPN3B.56
&SO2,L_SULPC_SO2, LSPPN3B.57
&NH3,L_SULPC_NH3, !MW LSPPN3B.58
&SO4_AIT,SO4_ACC,SO4_DIS, LSPPN3B.59
& AGED_SOOT, L_SOOT, LSPPN3B.60
&AEROSOL,L_MURK, LSPPN3B.61
&LSRAIN,LSSNOW, LSPPN3B.62
&LSRAIN3D,LSSNOW3D, LSPPN3B.63
&LSCAV_SO2,LSCAV_SO4AIT,LSCAV_SO4ACC,LSCAV_SO4DIS, LSPPN3B.64
&LSCAV_NH3, !MW LSPPN3B.65
& LSCAV_AGEDSOOT, LSPPN3B.66
&ERROR LSPPN3B.67
&) LSPPN3B.68
IMPLICIT NONE LSPPN3B.69
INTEGER LSPPN3B.70
& Q_LEVELS ! IN Number of "wet" levels in the model. LSPPN3B.71
&,PFIELD ! IN Number of gridpoints in one field (at one level). LSPPN3B.72
&,POINTS ! IN Number of gridpoints being processed. LSPPN3B.73
&,K1STPT ! IN First gridpoint processed within complete field. LSPPN3B.74
&,LSPICE_DIM1 ! Dimension of arrays LSRAIN3D and LSSNOW3D. LSPPN3B.75
&,LSPICE_DIM2 ! Dimension of arrays LSRAIN3D and LSSNOW3D. LSPPN3B.76
&,A_LEVELS ! IN Number of aerosol levels. LSPPN3B.77
REAL LSPPN3B.78
& CF(PFIELD,Q_LEVELS) ! IN Cloud fraction. LSPPN3B.79
&,PSTAR(PFIELD) ! IN Surface pressure (Pa). LSPPN3B.80
&,AK(Q_LEVELS) ! IN Hybrid co-ordinate for centre of layer. LSPPN3B.81
&,BK(Q_LEVELS) ! IN Hybrid co-ordinate for centre of layer. LSPPN3B.82
&,DELTA_AK(Q_LEVELS) ! IN Change of hybrid co-ord across layer. LSPPN3B.83
! (Upper minus lower). LSPPN3B.84
&,DELTA_BK(Q_LEVELS) ! IN Change of hybrid co-ord across layer. LSPPN3B.85
! (Upper minus lower). LSPPN3B.86
&,RHCRIT(Q_LEVELS) ! IN Critical humidity for cloud formation. LSPPN3B.87
&,RHCPT(PFIELD,Q_LEVELS) ! IN: Crit. hum. for cloud formation LSPPN3B.88
&,CLOUD_LIQ_FRAC(PFIELD,Q_LEVELS) !IN Cloud liquid fraction. LSPPN3B.89
&,CLOUD_ICE_FRAC(PFIELD,Q_LEVELS) !IN Cloud ice fraction. LSPPN3B.90
REAL TIMESTEP ! IN Timestep (sec). LSPPN3B.91
& ,CW_SEA ! IN threshold cloud liquid water content LSPPN3B.92
! over sea for conversion to ppn LSPPN3B.93
! (kg water per m**3) LSPPN3B.94
& ,CW_LAND ! IN threshold cloud liquid water content LSPPN3B.95
! over land for conversion to ppn LSPPN3B.96
! (kg water per m**3) LSPPN3B.97
LOGICAL BLAND(PFIELD) ! IN Land/sea mask LSPPN3B.98
&, L_MURK ! IN Aerosol needs scavenging. LSPPN3B.99
LOGICAL L_RHCPT ! Indicates whether RHcrit parametrization is on. LSPPN3B.100
LOGICAL L_SULPC_SO2 !IN Sulphur Cycle on, tracers scavenged if T LSPPN3B.101
&, L_SULPC_NH3 !IN indicates if NH3 present !MW LSPPN3B.102
&, L_SOOT !IN indicates whether soot present LSPPN3B.103
! LSPPN3B.104
REAL LSPPN3B.105
& Q(PFIELD,Q_LEVELS) ! INOUT Specific humidity (kg water/kg air). LSPPN3B.106
&,QCF(PFIELD,Q_LEVELS) ! INOUT Cloud ice (kg per kg air). LSPPN3B.107
&,QCL(PFIELD,Q_LEVELS) ! INOUT Cloud liquid water (kg per kg air). LSPPN3B.108
&,T(PFIELD,Q_LEVELS) ! INOUT Temperature (K). LSPPN3B.109
&,AEROSOL(PFIELD,A_LEVELS) ! INOUT Aerosol (K). LSPPN3B.110
REAL !INOUT, Sulphur Cycle tracers (mmr kg/kg) LSPPN3B.111
& SO2(PFIELD,Q_LEVELS) LSPPN3B.112
& ,NH3(PFIELD,Q_LEVELS) !MW LSPPN3B.113
& ,SO4_AIT(PFIELD,Q_LEVELS) LSPPN3B.114
& ,SO4_ACC(PFIELD,Q_LEVELS) LSPPN3B.115
& ,SO4_DIS(PFIELD,Q_LEVELS) LSPPN3B.116
& ,AGED_SOOT(PFIELD,Q_LEVELS) LSPPN3B.117
! LSPPN3B.118
REAL LSPPN3B.119
& LSRAIN(PFIELD) ! OUT Surface rainfall rate (kg per sq m per s). LSPPN3B.120
&,LSSNOW(PFIELD) ! OUT Surface snowfall rate (kg per sq m per s). LSPPN3B.121
REAL ! OUT column totals of S Cycle tracers scavngd LSPPN3B.122
& LSCAV_SO2(PFIELD) LSPPN3B.123
& ,LSCAV_NH3(PFIELD) !MW LSPPN3B.124
& ,LSCAV_SO4AIT(PFIELD) LSPPN3B.125
& ,LSCAV_SO4ACC(PFIELD) LSPPN3B.126
& ,LSCAV_SO4DIS(PFIELD) LSPPN3B.127
& ,LSCAV_AGEDSOOT(PFIELD) LSPPN3B.128
! LSPPN3B.129
REAL LSPPN3B.130
& LSRAIN3D(LSPICE_DIM1,LSPICE_DIM2) ! OUT Rain rate out of LSPPN3B.131
! each model layer LSPPN3B.132
& ,LSSNOW3D(LSPICE_DIM1,LSPICE_DIM2) ! OUT Snow rate out of LSPPN3B.133
! each model layer LSPPN3B.134
! LSPPN3B.135
INTEGER LSPPN3B.136
& ERROR ! OUT Return code - 0 if OK, LSPPN3B.137
! 1 if bad arguments. LSPPN3B.138
C*L Workspace usage --------------------------------------------------- LSPPN3B.139
! 0 real,1 logical and 2 integer blocks are required, as follows :- LSPPN3B.140
LOGICAL LSPPN3B.141
& H(PFIELD) ! Used as "logical" in compression. LSPPN3B.142
&,L_SCAVENGE ! scavenge aerosol on level. LSPPN3B.143
INTEGER LSPPN3B.144
& IX(PFIELD) ! Index for compress/expand. LSPPN3B.145
REAL F_DELTA_SNOW(PFIELD) ! snow fraction from ice falling LSPPN3B.146
! as water LSPPN3B.147
REAL VFALL(PFIELD) ! snow fall velocity (m per s). LSPPN3B.148
! Allocate CX and CONSTP arrays LSPPN3B.149
*CALL C_LSPSIZ 
LSPPN3B.150
! External subroutines called ----------------------------------------- LSPPN3B.151
EXTERNAL LS_PPNC,LSPCON LSPPN3B.152
C*---------------------------------------------------------------------- LSPPN3B.153
! Physical constants ------------------------------------------------- LSPPN3B.154
REAL CFMIN LSPPN3B.155
PARAMETER ( LSPPN3B.156
& CFMIN=1.0E-3 ! Used for LS_PPNC compress. LSPPN3B.157
&) LSPPN3B.158
! Define local variables ---------------------------------------------- LSPPN3B.159
INTEGER I,K ! Loop counters: I - horizontal field index; LSPPN3B.160
! K - vertical level index. LSPPN3B.161
&,N ! "nval" for WHEN routine. LSPPN3B.162
! LSPPN3B.163
ERROR=0 LSPPN3B.164
IF((K1STPT+POINTS-1).GT.PFIELD)THEN LSPPN3B.165
ERROR=1 LSPPN3B.166
GOTO9999 LSPPN3B.167
ENDIF LSPPN3B.168
! Define CX and CONSTP values LSPPN3B.169
CALL LSPCON(CX,CONSTP) LSPPN3B.170
!----------------------------------------------------------------------- LSPPN3B.171
!L Internal structure. LSPPN3B.172
!L 1. Initialise rain and snow to zero. LSPPN3B.173
! Initialise scavenged amounts of S Cycle tracers to 0 for full field LSPPN3B.174
!----------------------------------------------------------------------- LSPPN3B.175
DO I=K1STPT,K1STPT+POINTS-1 LSPPN3B.176
LSRAIN(I)=0.0 LSPPN3B.177
LSSNOW(I)=0.0 LSPPN3B.178
F_DELTA_SNOW(I)=0.0 LSPPN3B.179
VFALL(I)=0.0 LSPPN3B.180
END DO ! Loop over points LSPPN3B.181
! LSPPN3B.182
DO I=1,PFIELD LSPPN3B.183
LSCAV_SO2(I)=0.0 LSPPN3B.184
LSCAV_NH3(I)=0.0 !MW LSPPN3B.185
LSCAV_SO4AIT(I)=0.0 LSPPN3B.186
LSCAV_SO4ACC(I)=0.0 LSPPN3B.187
LSCAV_SO4DIS(I)=0.0 LSPPN3B.188
LSCAV_AGEDSOOT(I)=0.0 LSPPN3B.189
END DO LSPPN3B.190
! LSPPN3B.191
!----------------------------------------------------------------------- LSPPN3B.192
!L 2. Loop round levels from top down (counting bottom level as level 1, LSPPN3B.193
!L as is standard in the Unified model). LSPPN3B.194
!----------------------------------------------------------------------- LSPPN3B.195
! LSPPN3B.196
DO K=Q_LEVELS,1,-1 LSPPN3B.197
!----------------------------------------------------------------------- LSPPN3B.198
!L 2.5 Form INDEX IX to gather/scatter variables in LS_PPNC LSPPN3B.199
!----------------------------------------------------------------------- LSPPN3B.200
! LSPPN3B.201
! Set index where cloud fraction > CFMIN or where non-zero pptn LSPPN3B.202
! Note: whenimd is functionally equivalent to WHENILE (but autotasks). LSPPN3B.203
! LSPPN3B.204
! LSPPN3B.205
N=0 LSPPN3B.206
DO I=K1STPT,K1STPT+POINTS-1 LSPPN3B.207
IF (CLOUD_LIQ_FRAC(I,K).GT.CFMIN LSPPN3B.208
& .OR. (LSRAIN(I)+LSSNOW(I)).GT.0.0 LSPPN3B.209
& .OR. QCF(I,K).GT.0.0 ) THEN LSPPN3B.210
N=N+1 LSPPN3B.211
IX(N)=I - K1STPT + 1 LSPPN3B.212
ENDIF LSPPN3B.213
END DO ! Loop over points LSPPN3B.214
! LSPPN3B.215
L_SCAVENGE = L_MURK .AND. (K.LE.A_LEVELS) LSPPN3B.216
! LSPPN3B.217
IF(N.GT.0)THEN LSPPN3B.218
LSPPN3B.219
CALL LS_PPNC(IX,N,TIMESTEP,POINTS,PSTAR(K1STPT), LSPPN3B.220
& LSRAIN(K1STPT),LSSNOW(K1STPT),CF(K1STPT,K), LSPPN3B.221
& QCF(K1STPT,K),QCL(K1STPT,K),T(K1STPT,K), LSPPN3B.222
& SO2(K1STPT,K),L_SULPC_SO2, LSPPN3B.223
& NH3(K1STPT,K),L_SULPC_NH3, !MW LSPPN3B.224
& SO4_AIT(K1STPT,K),SO4_ACC(K1STPT,K),SO4_DIS(K1STPT,K), LSPPN3B.225
& AGED_SOOT(K1STPT,K), L_SOOT, LSPPN3B.226
! Aerosol is only defined on A_LEVELS not Q_LEVELS so limit index K LSPPN3B.227
& AEROSOL(K1STPT,MIN(K,A_LEVELS)),L_SCAVENGE, LSPPN3B.228
& LSCAV_NH3(K1STPT), !MW LSPPN3B.229
& LSCAV_SO2(K1STPT),LSCAV_SO4AIT(K1STPT), LSPPN3B.230
& LSCAV_SO4ACC(K1STPT),LSCAV_SO4DIS(K1STPT), LSPPN3B.231
& LSCAV_AGEDSOOT(K1STPT), LSPPN3B.232
& Q(K1STPT,K),AK(K),BK(K),DELTA_AK(K),DELTA_BK(K), LSPPN3B.233
& F_DELTA_SNOW(K1STPT),BLAND(K1STPT),CW_SEA, LSPPN3B.234
& CW_LAND, LSPPN3B.235
& CLOUD_LIQ_FRAC(K1STPT,K),CLOUD_ICE_FRAC(K1STPT,K), LSPPN3B.236
& RHCRIT(K), LSPPN3B.237
& RHCPT(K1STPT,K), L_RHCPT, LSPPN3B.238
& VFALL(K1STPT),CX,CONSTP) LSPPN3B.239
ENDIF LSPPN3B.240
! LSPPN3B.241
! Copy rainfall and snowfall rates to 3D fields for diagnostic output LSPPN3B.242
! LSPPN3B.243
IF (LSPICE_DIM1 .EQ. PFIELD LSPPN3B.244
& .AND. LSPICE_DIM2 .EQ. Q_LEVELS) THEN LSPPN3B.245
! Only copy rain and snow to 3D fields if arrays are dimensionalized. LSPPN3B.246
DO I=K1STPT,K1STPT+POINTS-1 LSPPN3B.247
LSRAIN3D(I,K)=LSRAIN(I) LSPPN3B.248
LSSNOW3D(I,K)=LSSNOW(I) LSPPN3B.249
END DO ! Loop over I for 3D diagnostics LSPPN3B.250
ENDIF LSPPN3B.251
! LSPPN3B.252
END DO ! Loop over K LSPPN3B.253
9999 CONTINUE ! Branch for error exit LSPPN3B.254
RETURN LSPPN3B.255
END LSPPN3B.256
C*LL SUBROUTINE LS_PPNC------------------------------------------------ LSPPN3B.257
C*L Arguments:--------------------------------------------------------- LSPPN3B.258
SUBROUTINE LS_PPNC( 3,22LSPPN3B.259
& IX,N,TIMESTEP,POINTS,PSTAR,LSRAIN,LSSNOW LSPPN3B.260
&,CF,QCF,QCL,T LSPPN3B.261
&,SO2,L_SULPC_SO2 LSPPN3B.262
&,NH3,L_SULPC_NH3 !MW LSPPN3B.263
&,SO4_AIT,SO4_ACC,SO4_DIS LSPPN3B.264
&,AGED_SOOT, L_SOOT LSPPN3B.265
&,AEROSOL,L_MURK LSPPN3B.266
&,LSCAV_NH3 !MW LSPPN3B.267
&,LSCAV_SO2,LSCAV_SO4AIT,LSCAV_SO4ACC,LSCAV_SO4DIS LSPPN3B.268
&,LSCAV_AGEDSOOT,Q LSPPN3B.269
&,AK,BK,DELTA_AK,DELTA_BK LSPPN3B.270
&,F_DELTA_SNOW,BLAND,CW_SEA,CW_LAND LSPPN3B.271
! &,LSC_QC,LSC_BS LSPPN3B.272
&,CLOUD_LIQ_FRAC,CLOUD_ICE_FRAC LSPPN3B.273
&,RHCRIT LSPPN3B.274
&,RHCPT, L_RHCPT LSPPN3B.275
&,VFALL,CX,CONSTP LSPPN3B.276
&) LSPPN3B.277
IMPLICIT NONE LSPPN3B.278
INTEGER LSPPN3B.279
& N ! IN Number of points where pptn non-zero from above LSPPN3B.280
! or where CF>CFMIN LSPPN3B.281
&,IX(N) ! IN gather/scatter index LSPPN3B.282
&,POINTS ! IN Number of gridpoints being processed. LSPPN3B.283
REAL LSPPN3B.284
& PSTAR(POINTS) ! IN Surface pressure (Pa). LSPPN3B.285
&,CF(POINTS) ! IN Cloud fraction. LSPPN3B.286
&,AK ! IN Hybrid co-ordinate for centre of layer. LSPPN3B.287
&,BK ! IN Hybrid co-ordinate for centre of layer. LSPPN3B.288
&,DELTA_AK ! IN Change of hybrid co-ord across layer. LSPPN3B.289
! (Upper minus lower). LSPPN3B.290
&,DELTA_BK ! IN Change of hybrid co-ord across layer. LSPPN3B.291
! (Upper minus lower). LSPPN3B.292
&,RHCRIT ! IN Critical humidity for cloud formation. LSPPN3B.293
&,RHCPT(POINTS) ! IN Critical humidity for cloud formation. LSPPN3B.294
! &,LSC_QC(POINTS) ! IN Large scale cloud Qc (kg/kg air). LSPPN3B.295
! &,LSC_BS(POINTS) ! IN Large scale cloud bs, moisture fluctuation. LSPPN3B.296
&,CLOUD_LIQ_FRAC(POINTS) ! IN Cloud liquid fraction. LSPPN3B.297
&,CLOUD_ICE_FRAC(POINTS) ! IN Cloud ice fraction. LSPPN3B.298
&,TIMESTEP ! IN Timestep (sec). LSPPN3B.299
&,CW_SEA ! IN threshold cloud liquid water content over sea LSPPN3B.300
! for conversion to ppn (kg water per m**3). LSPPN3B.301
&,CW_LAND ! IN threshold cloud liq. water content over land LSPPN3B.302
! for conversion to ppn (kg water per m**3). LSPPN3B.303
LOGICAL BLAND(POINTS) ! IN Land/sea mask LSPPN3B.304
&,L_MURK ! IN Aerosol needs scavenging. LSPPN3B.305
LOGICAL L_RHCPT ! Indicates whether RHcrit parametrization is on. LSPPN3B.306
LOGICAL L_SULPC_SO2 !IN Sulphur Cycle on, tracers scavngd if T LSPPN3B.307
&, L_SULPC_NH3 !IN indicates if NH3 present !MW LSPPN3B.308
&, L_SOOT LSPPN3B.309
! LSPPN3B.310
REAL LSPPN3B.311
& Q(POINTS) ! INOUT Specific humidity (kg water/kg air). LSPPN3B.312
&,QCF(POINTS) ! INOUT Cloud ice (kg per kg air). LSPPN3B.313
&,QCL(POINTS) ! INOUT Cloud liquid water (kg per kg air). LSPPN3B.314
&,T(POINTS) ! INOUT Temperature (K). LSPPN3B.315
&,AEROSOL(POINTS) ! INOUT Aerosol (K). LSPPN3B.316
&,LSRAIN(POINTS) !INOUT Surface rainfall rate (kg per sq m per s). LSPPN3B.317
&,LSSNOW(POINTS) !INOUT Surface snowfall rate (kg per sq m per s). LSPPN3B.318
&,F_DELTA_SNOW(POINTS) ! INOUT snow fraction from ice falling as LSPPN3B.319
! water. LSPPN3B.320
&,VFALL(POINTS) ! INOUT fall velocity of ice (m per s). LSPPN3B.321
REAL !INOUT S Cycle tracers & scavngd amounts LSPPN3B.322
& SO2(POINTS) LSPPN3B.323
& ,NH3(POINTS) !MW LSPPN3B.324
& ,SO4_AIT(POINTS) LSPPN3B.325
& ,SO4_ACC(POINTS) LSPPN3B.326
& ,SO4_DIS(POINTS) LSPPN3B.327
& ,LSCAV_SO2(POINTS) LSPPN3B.328
& ,LSCAV_NH3(POINTS) !MW LSPPN3B.329
& ,LSCAV_SO4AIT(POINTS) LSPPN3B.330
& ,LSCAV_SO4ACC(POINTS) LSPPN3B.331
& ,LSCAV_SO4DIS(POINTS) LSPPN3B.332
& ,AGED_SOOT(POINTS) LSPPN3B.333
& ,LSCAV_AGEDSOOT(POINTS) LSPPN3B.334
! LSPPN3B.335
C*L Workspace usage --------------------------------------------------- LSPPN3B.336
! LSPPN3B.337
REAL LSPPN3B.338
& PSTAR_C(N) ! gathered Surface pressure (Pa). LSPPN3B.339
&,CF_C(N) ! gathered Cloud fraction. LSPPN3B.340
&,Q_C(N) ! gathered Specific humidity (kg water/kg air). LSPPN3B.341
&,QCF_C(N) ! gathered Cloud ice (kg per kg air). LSPPN3B.342
&,QCL_C(N) ! gathered Cloud liquid water (kg per kg air). LSPPN3B.343
&,T_C(N) ! gathered Temperature (K). LSPPN3B.344
&,AERO_C(N) ! gathered Aerosol. LSPPN3B.345
&,LSRAIN_C(N) !gathered Surface rainfall rate (kg per sq m per s). LSPPN3B.346
&,LSSNOW_C(N) !gathered Surface snowfall rate (kg per sq m per s). LSPPN3B.347
&,F_DELTA_SNOW_C(N) ! gathered fraction of snow LSPPN3B.348
! &,LSC_QC_C(N) ! gathered Large scale cloud Qc (kg per kg air) LSPPN3B.349
! &,LSC_BS_C(N) ! gathered Large scale cloud bs. LSPPN3B.350
&,CLF_C(N) ! gathered Cloud liquid fraction. LSPPN3B.351
&,CIF_C(N) ! gathered Cloud ice fraction. LSPPN3B.352
&,VFALL_C(N) ! gathered fall velocity (m per s). LSPPN3B.353
&,RHCPT_C(N) ! gathered Critical relative humidity LSPPN3B.354
REAL ! gathered S Cycle tracer arrays LSPPN3B.355
& SO2_C(N) LSPPN3B.356
& ,NH3_C(N) !MW LSPPN3B.357
& ,SO4_AIT_C(N) LSPPN3B.358
& ,SO4_ACC_C(N) LSPPN3B.359
& ,SO4_DIS_C(N) LSPPN3B.360
& ,LSCAV_SO2_C(N) LSPPN3B.361
& ,LSCAV_NH3_C(N) !MW LSPPN3B.362
& ,LSCAV_SO4AIT_C(N) LSPPN3B.363
& ,LSCAV_SO4ACC_C(N) LSPPN3B.364
& ,LSCAV_SO4DIS_C(N) LSPPN3B.365
& ,AGED_SOOT_C(N) LSPPN3B.366
& ,LSCAV_AGEDSOOT_C(N) LSPPN3B.367
! LSPPN3B.368
REAL LSPPN3B.369
& RHODZ(N) ! WORK Used for air mass p.u.a. in successive LSPPN3B.370
! layers. LSPPN3B.371
&,P(N) ! WORK Used for pressure at successive levels. LSPPN3B.372
LOGICAL BLAND_C(N) ! gathered land/sea mask LSPPN3B.373
! LSPPN3B.374
! Call size of CX and CONSTP LSPPN3B.375
*CALL C_LSPSIZ LSPPN3B.376
! LSPPN3B.377
! Call comdecks containing large scale precipitation scavenging LSPPN3B.378
! coefficients for Sulphur Cycle and soot variables LSPPN3B.379
*CALL C_SULLSP LSPPN3B.380
*CALL C_ST_LSP LSPPN3B.381
! LSPPN3B.382
! External subroutines called ----------------------------------------- LSPPN3B.383
EXTERNAL LSP_ICE,LSP_SCAV LSPPN3B.384
& ,SLSPSCV LSPPN3B.385
C*---------------------------------------------------------------------- LSPPN3B.386
! Physical constants ------------------------------------------------- LSPPN3B.387
*CALL C_G LSPPN3B.388
REAL P1UPONG LSPPN3B.389
PARAMETER ( LSPPN3B.390
& P1UPONG=1./G ! One upon g (sq seconds per m). LSPPN3B.391
&) LSPPN3B.392
! Define local variables ---------------------------------------------- LSPPN3B.393
INTEGER I ! Loop counters: I - horizontal field index; LSPPN3B.394
! LSPPN3B.395
!----------------------------------------------------------------------- LSPPN3B.396
!L Internal structure. LSPPN3B.397
!L 1. gather variables using index LSPPN3B.398
!----------------------------------------------------------------------- LSPPN3B.399
DO I=1,N LSPPN3B.400
LSRAIN_C(I)=LSRAIN(IX(I)) LSPPN3B.401
LSSNOW_C(I)=LSSNOW(IX(I)) LSPPN3B.402
PSTAR_C(I) =PSTAR(IX(I)) LSPPN3B.403
BLAND_C(I) =BLAND(IX(I)) LSPPN3B.404
CF_C(I)=CF(IX(I)) LSPPN3B.405
! LSC_QC_C(I)=LSC_QC(IX(I)) LSPPN3B.406
! LSC_BS_C(I)=LSC_BS(IX(I)) LSPPN3B.407
CLF_C(I)=CLOUD_LIQ_FRAC(IX(I)) LSPPN3B.408
CIF_C(I)=CLOUD_ICE_FRAC(IX(I)) LSPPN3B.409
QCF_C(I)=QCF(IX(I)) LSPPN3B.410
QCL_C(I)=QCL(IX(I)) LSPPN3B.411
Q_C(I)=Q(IX(I)) LSPPN3B.412
T_C(I)=T(IX(I)) LSPPN3B.413
IF (L_MURK) AERO_C(I)=AEROSOL(IX(I)) LSPPN3B.414
F_DELTA_SNOW_C(I)=F_DELTA_SNOW(IX(I)) LSPPN3B.415
VFALL_C(I)=VFALL(IX(I)) LSPPN3B.416
END DO ! Loop over points LSPPN3B.417
IF (L_RHCPT) THEN LSPPN3B.418
DO I=1,N LSPPN3B.419
RHCPT_C(I)=RHCPT(IX(I)) LSPPN3B.420
ENDDO LSPPN3B.421
ELSE LSPPN3B.422
DO I=1,N LSPPN3B.423
RHCPT_C(I)=RHCRIT LSPPN3B.424
ENDDO LSPPN3B.425
ENDIF LSPPN3B.426
! LSPPN3B.427
IF (L_SULPC_SO2) THEN ! gather S Cycle tracers LSPPN3B.428
DO I=1,N LSPPN3B.429
SO2_C(I)=SO2(IX(I)) LSPPN3B.430
SO4_AIT_C(I)=SO4_AIT(IX(I)) LSPPN3B.431
SO4_ACC_C(I)=SO4_ACC(IX(I)) LSPPN3B.432
SO4_DIS_C(I)=SO4_DIS(IX(I)) LSPPN3B.433
LSCAV_SO2_C(I)=LSCAV_SO2(IX(I)) LSPPN3B.434
LSCAV_SO4AIT_C(I)=LSCAV_SO4AIT(IX(I)) LSPPN3B.435
LSCAV_SO4ACC_C(I)=LSCAV_SO4ACC(IX(I)) LSPPN3B.436
LSCAV_SO4DIS_C(I)=LSCAV_SO4DIS(IX(I)) LSPPN3B.437
END DO LSPPN3B.438
! !MW LSPPN3B.439
IF (L_SULPC_NH3) THEN !MW LSPPN3B.440
DO I=1,N !MW LSPPN3B.441
NH3_C(I)=NH3(IX(I)) !MW LSPPN3B.442
LSCAV_NH3_C(I)=LSCAV_NH3(IX(I)) !MW LSPPN3B.443
END DO !MW LSPPN3B.444
END IF !MW LSPPN3B.445
! !MW LSPPN3B.446
END IF LSPPN3B.447
! LSPPN3B.448
IF (L_SOOT) THEN LSPPN3B.449
DO I=1,N LSPPN3B.450
AGED_SOOT_C(I)=AGED_SOOT(IX(I)) LSPPN3B.451
LSCAV_AGEDSOOT_C(I)=LSCAV_AGEDSOOT(IX(I)) LSPPN3B.452
ENDDO LSPPN3B.453
END IF LSPPN3B.454
! LSPPN3B.455
!----------------------------------------------------------------------- LSPPN3B.456
!L 2 Calculate pressure at current level, and air mass p.u.a. of LSPPN3B.457
!L current layer. LSPPN3B.458
! (Negative in RHODZ formula takes account of sign of DELTAs.) LSPPN3B.459
!----------------------------------------------------------------------- LSPPN3B.460
DO I=1,N LSPPN3B.461
P(I)=AK+PSTAR_C(I)*BK LSPPN3B.462
RHODZ(I)=-P1UPONG*(DELTA_AK+PSTAR_C(I)*DELTA_BK) LSPPN3B.463
END DO ! Loop over points LSPPN3B.464
! LSPPN3B.465
!----------------------------------------------------------------------- LSPPN3B.466
! ICE FORMATION/EVAPORATION/MELTING LSPPN3B.467
! WATER CLOUD AND RAIN FORMATION/EVAPORATION LSPPN3B.468
!----------------------------------------------------------------------- LSPPN3B.469
! The call to LSP_ICE replaces the calls to LSP_EVAP, LSPFRMT LSPPN3B.470
! and LSP_FORM. LSPPN3B.471
! CLF_C contains cloud fraction for ice LSPPN3B.472
! CIF_C contains cloud fraction for water LSPPN3B.473
CALL LSP_ICE(P,RHODZ,TIMESTEP,N, LSPPN3B.474
& RHCPT_C, LSPPN3B.475
! Make available sulphur cycle parameters to influence the cloud LSPPN3B.476
! microphysics as INTENT IN varables LSPPN3B.477
& SO4_ACC_C,SO4_DIS_C, LSPPN3B.478
& QCF_C,QCL_C,Q_C,LSRAIN_C,LSSNOW_C,VFALL_C,T_C, LSPPN3B.479
& CLF_C,CIF_C,BLAND_C,CX,CONSTP) LSPPN3B.480
!----------------------------------------------------------------------- LSPPN3B.481
!L 3.4 Lose aerosol by scavenging: call LSP_SCAV LSPPN3B.482
!----------------------------------------------------------------------- LSPPN3B.483
! LSPPN3B.484
IF (L_MURK) THEN LSPPN3B.485
CALL LSP_SCAV(TIMESTEP,N,LSRAIN_C,LSSNOW_C,AERO_C) LSPPN3B.486
ENDIF LSPPN3B.487
! LSPPN3B.488
!L 3.4.1 Scavenge Sulphur Cycle tracers: call SLSPSCV LSPPN3B.489
! LSPPN3B.490
IF (L_SULPC_SO2) THEN LSPPN3B.491
! LSPPN3B.492
! scavenge SO2 LSPPN3B.493
IF (KLRAIN_SO2.GT.0.0 .OR. KLSNOW_SO2.GT.0.0) THEN !MW LSPPN3B.494
CALL SLSPSCV(SO2_C,LSCAV_SO2_C, LSPPN3B.495
& KLRAIN_SO2,KLSNOW_SO2, LSPPN3B.496
& RHODZ,TIMESTEP,N,LSRAIN_C,LSSNOW_C) LSPPN3B.497
END IF !MW LSPPN3B.498
! LSPPN3B.499
! scavenge NH3 if present !MW LSPPN3B.500
IF (L_SULPC_NH3) THEN !MW LSPPN3B.501
! !MW LSPPN3B.502
IF (KLRAIN_NH3.GT.0.0 .OR. KLSNOW_NH3.GT.0.0) THEN !MW LSPPN3B.503
CALL SLSPSCV(NH3_C,LSCAV_NH3_C, !MW LSPPN3B.504
& KLRAIN_NH3,KLSNOW_NH3, !MW LSPPN3B.505
& RHODZ,TIMESTEP,N,LSRAIN_C,LSSNOW_C) !MW LSPPN3B.506
END IF !MW LSPPN3B.507
! !MW LSPPN3B.508
END IF ! end L_SULPC_NH3 condition !MW LSPPN3B.509
! !MW LSPPN3B.510
! scavenge SO4_AIT LSPPN3B.511
IF (KLRAIN_SO4AIT.GT.0.0 .OR. KLSNOW_SO4AIT.GT.0.0) THEN !MW LSPPN3B.512
CALL SLSPSCV(SO4_AIT_C,LSCAV_SO4AIT_C, LSPPN3B.513
& KLRAIN_SO4AIT,KLSNOW_SO4AIT, LSPPN3B.514
& RHODZ,TIMESTEP,N,LSRAIN_C,LSSNOW_C) LSPPN3B.515
END IF !MW LSPPN3B.516
! LSPPN3B.517
! scavenge SO4_ACC LSPPN3B.518
IF (KLRAIN_SO4ACC.GT.0.0 .OR. KLSNOW_SO4ACC.GT.0.0) THEN !MW LSPPN3B.519
CALL SLSPSCV(SO4_ACC_C,LSCAV_SO4ACC_C, LSPPN3B.520
& KLRAIN_SO4ACC,KLSNOW_SO4ACC, LSPPN3B.521
& RHODZ,TIMESTEP,N,LSRAIN_C,LSSNOW_C) LSPPN3B.522
END IF !MW LSPPN3B.523
! LSPPN3B.524
! scavenge SO4_DIS LSPPN3B.525
IF (KLRAIN_SO4DIS.GT.0.0 .OR. KLSNOW_SO4DIS.GT.0.0) THEN LSPPN3B.526
CALL SLSPSCV(SO4_DIS_C,LSCAV_SO4DIS_C, LSPPN3B.527
& KLRAIN_SO4DIS,KLSNOW_SO4DIS, LSPPN3B.528
& RHODZ,TIMESTEP,N,LSRAIN_C,LSSNOW_C) LSPPN3B.529
END IF !MW LSPPN3B.530
! LSPPN3B.531
END IF LSPPN3B.532
! LSPPN3B.533
! LSPPN3B.534
IF (L_SOOT) THEN ! Scavenge soot. LSPPN3B.535
CALL SLSPSCV(AGED_SOOT_C,LSCAV_AGEDSOOT_C, LSPPN3B.536
& KLRAIN_AGEDSOOT,KLSNOW_AGEDSOOT, LSPPN3B.537
& RHODZ,TIMESTEP,N,LSRAIN_C,LSSNOW_C) LSPPN3B.538
END IF LSPPN3B.539
! LSPPN3B.540
LSPPN3B.541
!----------------------------------------------------------------------- LSPPN3B.542
!L 4 Scatter back arrays which will have been changed. LSPPN3B.543
!L LSPPN3B.544
!----------------------------------------------------------------------- LSPPN3B.545
! LSPPN3B.546
CDIR$ IVDEP LSPPN3B.547
DO I=1,N LSPPN3B.548
T(IX(I))=T_C(I) LSPPN3B.549
Q(IX(I))=Q_C(I) LSPPN3B.550
QCF(IX(I))=QCF_C(I) LSPPN3B.551
QCL(IX(I))=QCL_C(I) LSPPN3B.552
IF (L_MURK) AEROSOL(IX(I))=AERO_C(I) LSPPN3B.553
LSRAIN(IX(I))=LSRAIN_C(I) LSPPN3B.554
LSSNOW(IX(I))=LSSNOW_C(I) LSPPN3B.555
F_DELTA_SNOW(IX(I)) = F_DELTA_SNOW_C(I) LSPPN3B.556
VFALL(IX(I))=VFALL_C(I) LSPPN3B.557
END DO ! Loop over points LSPPN3B.558
! LSPPN3B.559
IF (L_SULPC_SO2) THEN ! scatter back S Cycle tracer arrays LSPPN3B.560
DO I=1,N LSPPN3B.561
SO2(IX(I))=SO2_C(I) LSPPN3B.562
SO4_AIT(IX(I))=SO4_AIT_C(I) LSPPN3B.563
SO4_ACC(IX(I))=SO4_ACC_C(I) LSPPN3B.564
SO4_DIS(IX(I))=SO4_DIS_C(I) LSPPN3B.565
LSCAV_SO2(IX(I))=LSCAV_SO2_C(I) LSPPN3B.566
LSCAV_SO4AIT(IX(I))=LSCAV_SO4AIT_C(I) LSPPN3B.567
LSCAV_SO4ACC(IX(I))=LSCAV_SO4ACC_C(I) LSPPN3B.568
LSCAV_SO4DIS(IX(I))=LSCAV_SO4DIS_C(I) LSPPN3B.569
END DO LSPPN3B.570
! !MW LSPPN3B.571
IF (L_SULPC_NH3) THEN !MW LSPPN3B.572
DO I=1,N !MW LSPPN3B.573
NH3(IX(I))=NH3_C(I) !MW LSPPN3B.574
LSCAV_NH3(IX(I))=LSCAV_NH3_C(I) !MW LSPPN3B.575
END DO !MW LSPPN3B.576
END IF !MW LSPPN3B.577
! !MW LSPPN3B.578
END IF LSPPN3B.579
! LSPPN3B.580
IF (L_SOOT) THEN LSPPN3B.581
DO I=1,N LSPPN3B.582
AGED_SOOT(IX(I))=AGED_SOOT_C(I) LSPPN3B.583
LSCAV_AGEDSOOT(IX(I))=LSCAV_AGEDSOOT_C(I) LSPPN3B.584
ENDDO LSPPN3B.585
END IF LSPPN3B.586
! LSPPN3B.587
RETURN LSPPN3B.588
END LSPPN3B.589
*ENDIF LSPPN3B.590