*IF DEF,A04_2E ADM0F405.295
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.14997
C GTS2F400.14998
C Use, duplication or disclosure of this code is subject to the GTS2F400.14999
C restrictions as set forth in the contract. GTS2F400.15000
C GTS2F400.15001
C Meteorological Office GTS2F400.15002
C London Road GTS2F400.15003
C BRACKNELL GTS2F400.15004
C Berkshire UK GTS2F400.15005
C RG12 2SZ GTS2F400.15006
C GTS2F400.15007
C If no contract has been raised with this copy of the code, the use, GTS2F400.15008
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.15009
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.15010
C Modelling at the above address. GTS2F400.15011
C ******************************COPYRIGHT****************************** GTS2F400.15012
C GTS2F400.15013
C*LL SUBROUTINES LS_PPN and LS_PPNC------------------------------------ LSPPN2D.3
!LL Purpose: LSPPN2D.4
!LL LS_PPN and LS_PPNC: LSPPN2D.5
!LL Calculate large-scale (dynamical) precipitation. LSPPN2D.6
!LL LS_PPNC is the gather/scatter routine which then LSPPN2D.7
!LL calls LSP_EVAP,LSP_FRMT,LSP_FORM. LSPPN2D.8
!LL Treatment of evaporation made implicit. C Wilson 18/09/90. LSPPN2D.9
!LL Note: in all cases, level counters (incl subscripts) run from 1 LSPPN2D.10
!LL (lowest model layer) to Q_LEVELS (topmost "wet" model LSPPN2D.11
!LL layer) - it is assumed that the bottom Q_LEVELS layers are LSPPN2D.12
!LL the "wet" layers. LSPPN2D.13
!LL LSPPN2D.14
!LL Put through fpp on Cray. Activate *IF definition CRAY if running LSPPN2D.15
!LL on the Cray. Function FOCWWIL is now a COMDECK LSPPN2D.16
!LL (This function is called by LSP_FORM.) LSPPN2D.17
!LL LSPPN2D.18
!LL This routine is suitable for single-column use. LSPPN2D.19
!LL LSPPN2D.20
!LL C.Wilson <- programmer of some or all of previous code or changes LSPPN2D.21
!LL C.Senior <- programmer of some or all of previous code or changes LSPPN2D.22
!LL LSPPN2D.23
!LL Model Modification history from model version 3.0: LSPPN2D.24
!LL version Date LSPPN2D.25
!LL 3.1 23/02/93 LS_PPN and LS_PPNC LSPPN2D.26
!LL Inclusion of F_DELTA_SNOW (fraction of snow from LSPPN2D.27
!LL ice falling as water) for use in LSP_FORM with LSPPN2D.28
!LL fully divergent ice fallout. LSPPN2D.29
!LL Ruth Carnell 26/02/93 LSPPN2D.30
!LL LSPPN2D.31
!LL 3.4 15/08/94 LS_PPN and LS_PPNC LSPPN2D.32
!LL Include layer rain and snow deltas for aerosol. LSPPN2D.33
!LL LSPPN2D.34
!LL 3.4/4.0 21/11/94 LS_PPN and LS_PPNC LSPPN2D.35
!LL Inclusion of LS_GRID_QC and LS_BS moisture LSPPN2D.36
!LL distribution variables for use in LSP_FORM. LSPPN2D.37
!LL A.Bushell 22/11/94 LSPPN2D.38
!LL LSPPN2D.39
!LL 3.4/4.0 04/04/95 LS_PPN and LS_PPNC LSPPN2D.40
!LL Additional argument VFALL, the ice fall velocity LSPPN2D.41
!LL for use in LSP_FORM. LSPPN2D.42
!LL A.Bushell 04/04/95 LSPPN2D.43
!LL 4.1 06/06/96 Pass Sulphur Cycle tracers in for wet scavenging AWO4F401.130
!LL and output scavenged totals for stash. AWO4F401.131
!LL Call SLSPSCV to do wet scavenging. M Woodage AWO4F401.132
!LL 4.2 Oct. 96 T3E migration: *DEF CRAY removed, whenimd removed. GSS2F402.259
!LL S.J.Swarbrick GSS2F402.260
! 4.4 30/09/97 Prevent unnecessary calls to SLSPSCV for S Cycle AWO1F404.80
! (M Woodage) AWO1F404.81
! 4.5 02/04/98 Add NH3 to argument list and pass to LS_PPNC AWO4F405.155
! for scavenging (for S Cycle) AWO4F405.156
! M Woodage AWO4F405.157
! 4.5 12/03/98 Add aged soot to argument list and pass to AWO4F405.158
! LS_PPNC for scavenging. Luke Robinson. AWO4F405.159
! 4.5 01/05/98 Restrict murk aerosol calculations to aerosol APC0F405.790
! levels=boundary levels. P.Clark APC0F405.791
!LL LSPPN2D.44
!LL Programming standard: Unified Model Documentation Paper No 4, LSPPN2D.45
!LL Version 2, dated 18/1/90. LSPPN2D.46
!LL LSPPN2D.47
!LL Logical component covered: P26. LSPPN2D.48
!LL LSPPN2D.49
!LL Project task: LSPPN2D.50
!LL LSPPN2D.51
!LL Documentation: UM Documentation Paper 26. LSPPN2D.52
!LL LSPPN2D.53
C*L Arguments:--------------------------------------------------------- LSPPN2D.54
SUBROUTINE LS_PPN( 3,4LSPPN2D.55
&AK,BK,CF,DELTA_AK,DELTA_BK,PSTAR,TIMESTEP,BLAND, LSPPN2D.56
&CW_SEA,CW_LAND,LS_GRID_QC,LS_BS,Q_LEVELS,PFIELD, LSPPN2D.57
& POINTS,K1STPT,A_LEVELS,Q,QCF,QCL,T, APC0F405.792
&SO2,L_SULPC_SO2, AWO4F401.134
&NH3,L_SULPC_NH3, AWO4F405.160
&SO4_AIT,SO4_ACC,SO4_DIS, AWO4F401.135
& AGED_SOOT, !INOUT AWO4F405.307
& L_SOOT, AWO4F405.308
&AEROSOL,L_MURK, AWO4F401.136
&LSRAIN,LSSNOW, AWO4F401.137
&LSCAV_SO2,LSCAV_SO4AIT,LSCAV_SO4ACC,LSCAV_SO4DIS, AWO4F401.138
&LSCAV_NH3, AWO4F405.161
& LSCAV_AGEDSOOT, !INOUT AWO4F405.309
&ERROR LSPPN2D.59
&) LSPPN2D.60
IMPLICIT NONE LSPPN2D.61
INTEGER LSPPN2D.62
& Q_LEVELS ! IN Number of "wet" levels in the model. LSPPN2D.63
&,PFIELD ! IN Number of gridpoints in one field (at one level). LSPPN2D.64
&,POINTS ! IN Number of gridpoints being processed. LSPPN2D.65
&,K1STPT ! IN First gridpoint processed within complete field. LSPPN2D.66
&,A_LEVELS ! IN Number of aerosol levels APC0F405.793
REAL LSPPN2D.67
& CF(PFIELD,Q_LEVELS) ! IN Cloud fraction. LSPPN2D.68
&,PSTAR(PFIELD) ! IN Surface pressure (Pa). LSPPN2D.69
&,AK(Q_LEVELS) ! IN Hybrid co-ordinate for centre of layer. LSPPN2D.70
&,BK(Q_LEVELS) ! IN Hybrid co-ordinate for centre of layer. LSPPN2D.71
&,DELTA_AK(Q_LEVELS) ! IN Change of hybrid co-ord across layer. LSPPN2D.72
! (Upper minus lower). LSPPN2D.73
&,DELTA_BK(Q_LEVELS) ! IN Change of hybrid co-ord across layer. LSPPN2D.74
! (Upper minus lower). LSPPN2D.75
&,LS_GRID_QC(PFIELD,Q_LEVELS) !IN Large scale cloud Qc (kg/kg air). LSPPN2D.76
&,LS_BS(PFIELD,Q_LEVELS) !IN Large scale cloud bs value. LSPPN2D.77
REAL TIMESTEP ! IN Timestep (sec). LSPPN2D.78
& ,CW_SEA ! IN threshold cloud liquid water content LSPPN2D.79
! over sea for conversion to ppn LSPPN2D.80
! (kg water per m**3) LSPPN2D.81
& ,CW_LAND ! IN threshold cloud liquid water content LSPPN2D.82
! over land for conversion to ppn LSPPN2D.83
! (kg water per m**3) LSPPN2D.84
LOGICAL BLAND(PFIELD) ! IN Land/sea mask LSPPN2D.85
&, L_MURK ! IN Aerosol needs scavenging. LSPPN2D.86
LOGICAL L_SULPC_SO2 !IN Sulphur Cycle on, tracers scavenged if T AWO4F401.139
& ,L_SULPC_NH3 !IN indicates if NH3 present AWO4F405.162
! AWO4F405.163
&, L_SOOT ! IN Soot needs scavenging AWO4F405.310
! AWO4F401.140
REAL LSPPN2D.87
& Q(PFIELD,Q_LEVELS) ! INOUT Specific humidity (kg water/kg air). LSPPN2D.88
&,QCF(PFIELD,Q_LEVELS) ! INOUT Cloud ice (kg per kg air). LSPPN2D.89
&,QCL(PFIELD,Q_LEVELS) ! INOUT Cloud liquid water (kg per kg air). LSPPN2D.90
&,T(PFIELD,Q_LEVELS) ! INOUT Temperature (K). LSPPN2D.91
&,AEROSOL(PFIELD,A_LEVELS) ! INOUT Aerosol APC0F405.794
REAL !INOUT, Sulphur Cycle tracers (mmr kg/kg) AWO4F401.141
& SO2(PFIELD,Q_LEVELS) AWO4F401.142
& ,NH3(PFIELD,Q_LEVELS) AWO4F405.164
& ,SO4_AIT(PFIELD,Q_LEVELS) AWO4F401.143
& ,SO4_ACC(PFIELD,Q_LEVELS) AWO4F401.144
& ,SO4_DIS(PFIELD,Q_LEVELS) AWO4F401.145
& ,AGED_SOOT(PFIELD,Q_LEVELS) AWO4F405.311
! AWO4F401.146
REAL LSPPN2D.93
& LSRAIN(PFIELD) ! OUT Surface rainfall rate (kg per sq m per s). LSPPN2D.94
&,LSSNOW(PFIELD) ! OUT Surface snowfall rate (kg per sq m per s). LSPPN2D.95
REAL ! OUT column totals of S Cycle tracers scavngd AWO4F401.147
& LSCAV_SO2(PFIELD) AWO4F401.148
& ,LSCAV_NH3(PFIELD) AWO4F405.165
& ,LSCAV_SO4AIT(PFIELD) AWO4F401.149
& ,LSCAV_SO4ACC(PFIELD) AWO4F401.150
& ,LSCAV_SO4DIS(PFIELD) AWO4F401.151
& ,LSCAV_AGEDSOOT(PFIELD) AWO4F405.312
! AWO4F401.152
INTEGER LSPPN2D.96
& ERROR ! OUT Return code - 0 if OK, LSPPN2D.97
! 1 if bad arguments. LSPPN2D.98
C*L Workspace usage --------------------------------------------------- LSPPN2D.99
! 0 real,1 logical and 2 integer blocks are required, as follows :- LSPPN2D.101
LOGICAL LSPPN2D.102
& H(PFIELD) ! Used as "logical" in compression. LSPPN2D.103
& ,L_SCAVENGE ! scavenge aerosol on level. APC0F405.795
INTEGER LSPPN2D.104
& IX(PFIELD) ! Index for compress/expand. LSPPN2D.105
REAL F_DELTA_SNOW(PFIELD) ! snow fraction from ice falling LSPPN2D.106
! as water LSPPN2D.107
REAL VFALL(PFIELD) ! snow fall velocity (m per s). LSPPN2D.108
! External subroutines called ----------------------------------------- LSPPN2D.119
EXTERNAL LS_PPNC LSPPN2D.120
C*---------------------------------------------------------------------- LSPPN2D.124
! Physical constants ------------------------------------------------- LSPPN2D.125
REAL CFMIN LSPPN2D.126
PARAMETER ( LSPPN2D.127
& CFMIN=1.0E-3 ! Used for LS_PPNC compress. LSPPN2D.128
&) LSPPN2D.129
! Define local variables ---------------------------------------------- LSPPN2D.130
INTEGER I,K ! Loop counters: I - horizontal field index; LSPPN2D.131
! K - vertical level index. LSPPN2D.132
&,N ! "nval" for WHEN routine. LSPPN2D.133
! LSPPN2D.134
ERROR=0 LSPPN2D.135
IF((K1STPT+POINTS-1).GT.PFIELD)THEN LSPPN2D.136
ERROR=1 LSPPN2D.137
GOTO20 LSPPN2D.138
ENDIF LSPPN2D.139
!----------------------------------------------------------------------- LSPPN2D.140
!L Internal structure. LSPPN2D.141
!L 1. Initialise rain and snow to zero. LSPPN2D.142
! Initialise scavenged amounts of S Cycle tracers to 0 for full field AWO4F401.153
!----------------------------------------------------------------------- LSPPN2D.143
DO I=K1STPT,K1STPT+POINTS-1 LSPPN2D.144
LSRAIN(I)=0.0 LSPPN2D.145
LSSNOW(I)=0.0 LSPPN2D.146
F_DELTA_SNOW(I)=0.0 LSPPN2D.147
VFALL(I)=0.0 LSPPN2D.148
END DO ! Loop over points LSPPN2D.149
! LSPPN2D.150
DO I=1,PFIELD AWO4F401.154
LSCAV_SO2(I)=0.0 AWO4F401.155
LSCAV_NH3(I)=0.0 AWO4F405.166
LSCAV_SO4AIT(I)=0.0 AWO4F401.156
LSCAV_SO4ACC(I)=0.0 AWO4F401.157
LSCAV_SO4DIS(I)=0.0 AWO4F401.158
LSCAV_AGEDSOOT(I)=0.0 AWO4F405.313
END DO AWO4F401.159
! AWO4F401.160
!----------------------------------------------------------------------- LSPPN2D.151
!L 2. Loop round levels from top down (counting bottom level as level 1, LSPPN2D.152
!L as is standard in the Unified model). LSPPN2D.153
!----------------------------------------------------------------------- LSPPN2D.154
! LSPPN2D.155
DO K=Q_LEVELS,1,-1 LSPPN2D.156
!----------------------------------------------------------------------- LSPPN2D.157
!L 2.5 Form INDEX IX to gather/scatter variables in LS_PPNC LSPPN2D.158
!----------------------------------------------------------------------- LSPPN2D.159
! LSPPN2D.160
! Set index where cloud fraction > CFMIN or where non-zero pptn LSPPN2D.161
! Note: whenimd is functionally equivalent to WHENILE (but autotasks). LSPPN2D.162
! LSPPN2D.163
N=0 LSPPN2D.171
DO I=K1STPT,K1STPT+POINTS-1 LSPPN2D.172
IF (CF(I,K).GT.CFMIN .OR. (LSRAIN(I)+LSSNOW(I)).GT.0.0) THEN LSPPN2D.173
N=N+1 LSPPN2D.174
IX(N)=I - K1STPT + 1 LSPPN2D.175
ENDIF LSPPN2D.176
END DO ! Loop over points LSPPN2D.177
! LSPPN2D.179
L_SCAVENGE = L_MURK .AND. (K.LE.A_LEVELS) APC0F405.796
IF(N.GT.0)THEN LSPPN2D.180
LSPPN2D.181
CALL LS_PPNC
(IX,N,TIMESTEP,POINTS,PSTAR(K1STPT), LSPPN2D.182
& LSRAIN(K1STPT),LSSNOW(K1STPT),CF(K1STPT,K), LSPPN2D.183
& QCF(K1STPT,K),QCL(K1STPT,K),T(K1STPT,K), LSPPN2D.184
& SO2(K1STPT,K),L_SULPC_SO2, AWO4F401.161
& NH3(K1STPT,K),L_SULPC_NH3, AWO4F405.167
& SO4_AIT(K1STPT,K),SO4_ACC(K1STPT,K),SO4_DIS(K1STPT,K), AWO4F401.162
& AGED_SOOT(K1STPT,K), L_SOOT, AWO4F405.314
& AEROSOL(K1STPT,MIN(K,A_LEVELS)),L_SCAVENGE, APC0F405.797
& LSCAV_NH3(K1STPT), APC0F405.798
& LSCAV_SO2(K1STPT),LSCAV_SO4AIT(K1STPT), AWO4F401.163
& LSCAV_SO4ACC(K1STPT),LSCAV_SO4DIS(K1STPT), AWO4F401.164
& LSCAV_AGEDSOOT(K1STPT), AWO4F405.315
& Q(K1STPT,K),AK(K),BK(K),DELTA_AK(K),DELTA_BK(K), LSPPN2D.186
& F_DELTA_SNOW(K1STPT),BLAND(K1STPT),CW_SEA, LSPPN2D.187
& CW_LAND,LS_GRID_QC(K1STPT,K),LS_BS(K1STPT,K), LSPPN2D.188
& VFALL(K1STPT)) LSPPN2D.189
ENDIF LSPPN2D.190
! LSPPN2D.191
END DO ! Loop over K LSPPN2D.192
20 CONTINUE LSPPN2D.193
RETURN LSPPN2D.194
END LSPPN2D.195
C*LL SUBROUTINE LS_PPNC------------------------------------------------ LSPPN2D.196
C*L Arguments:--------------------------------------------------------- LSPPN2D.197
SUBROUTINE LS_PPNC( 3,22LSPPN2D.198
& IX,N,TIMESTEP,POINTS,PSTAR,LSRAIN,LSSNOW LSPPN2D.199
&,CF,QCF,QCL,T AWO4F401.165
&,SO2,L_SULPC_SO2 AWO4F401.166
&,NH3,L_SULPC_NH3 AWO4F405.168
&,SO4_AIT,SO4_ACC,SO4_DIS AWO4F401.167
&,AGED_SOOT, L_SOOT AWO4F405.316
&,AEROSOL,L_MURK AWO4F401.168
&,LSCAV_NH3 AWO4F405.169
&,LSCAV_SO2,LSCAV_SO4AIT,LSCAV_SO4ACC,LSCAV_SO4DIS AWO4F405.317
&,LSCAV_AGEDSOOT,Q AWO4F405.318
&,AK,BK,DELTA_AK,DELTA_BK LSPPN2D.201
&,F_DELTA_SNOW,BLAND,CW_SEA,CW_LAND,LSC_QC,LSC_BS,VFALL LSPPN2D.202
&) LSPPN2D.203
IMPLICIT NONE LSPPN2D.204
INTEGER LSPPN2D.205
& N ! IN Number of points where pptn non-zero from above LSPPN2D.206
! or where CF>CFMIN LSPPN2D.207
&,IX(N) ! IN gather/scatter index LSPPN2D.208
&,POINTS ! IN Number of gridpoints being processed. LSPPN2D.209
REAL LSPPN2D.210
& PSTAR(POINTS) ! IN Surface pressure (Pa). LSPPN2D.211
&,CF(POINTS) ! IN Cloud fraction. LSPPN2D.212
&,AK ! IN Hybrid co-ordinate for centre of layer. LSPPN2D.213
&,BK ! IN Hybrid co-ordinate for centre of layer. LSPPN2D.214
&,DELTA_AK ! IN Change of hybrid co-ord across layer. LSPPN2D.215
! (Upper minus lower). LSPPN2D.216
&,DELTA_BK ! IN Change of hybrid co-ord across layer. LSPPN2D.217
! (Upper minus lower). LSPPN2D.218
&,LSC_QC(POINTS) ! IN Large scale cloud Qc (kg/kg air). LSPPN2D.219
&,LSC_BS(POINTS) ! IN Large scale cloud bs, moisture fluctuation. LSPPN2D.220
&,TIMESTEP ! IN Timestep (sec). LSPPN2D.221
&,CW_SEA ! IN threshold cloud liquid water content over sea LSPPN2D.222
! for conversion to ppn (kg water per m**3). LSPPN2D.223
&,CW_LAND ! IN threshold cloud liq. water content over land LSPPN2D.224
! for conversion to ppn (kg water per m**3). LSPPN2D.225
LOGICAL BLAND(POINTS) ! IN Land/sea mask LSPPN2D.226
&,L_MURK ! IN Aerosol needs scavenging. LSPPN2D.227
LOGICAL L_SULPC_SO2 !IN Sulphur Cycle on, tracers scavngd if T AWO4F401.170
& ,L_SULPC_NH3 !IN indicates if NH3 present AWO4F405.170
! AWO4F405.171
&, L_SOOT ! IN Soot needs scavenging AWO4F405.319
! AWO4F401.171
REAL LSPPN2D.228
& Q(POINTS) ! INOUT Specific humidity (kg water/kg air). LSPPN2D.229
&,QCF(POINTS) ! INOUT Cloud ice (kg per kg air). LSPPN2D.230
&,QCL(POINTS) ! INOUT Cloud liquid water (kg per kg air). LSPPN2D.231
&,T(POINTS) ! INOUT Temperature (K). LSPPN2D.232
&,AEROSOL(POINTS) ! INOUT Aerosol (K). LSPPN2D.233
&,LSRAIN(POINTS) !INOUT Surface rainfall rate (kg per sq m per s). LSPPN2D.234
&,LSSNOW(POINTS) !INOUT Surface snowfall rate (kg per sq m per s). LSPPN2D.235
&,F_DELTA_SNOW(POINTS) ! INOUT snow fraction from ice falling as LSPPN2D.236
! water. LSPPN2D.237
&,VFALL(POINTS) ! INOUT fall velocity of ice (m per s). LSPPN2D.238
REAL !INOUT S Cycle tracers & scavngd amounts AWO4F401.172
& SO2(POINTS) AWO4F401.173
& ,NH3(POINTS) AWO4F405.172
& ,SO4_AIT(POINTS) AWO4F401.174
& ,SO4_ACC(POINTS) AWO4F401.175
& ,SO4_DIS(POINTS) AWO4F401.176
& ,LSCAV_SO2(POINTS) AWO4F401.177
& ,LSCAV_NH3(POINTS) AWO4F405.173
& ,LSCAV_SO4AIT(POINTS) AWO4F401.178
& ,LSCAV_SO4ACC(POINTS) AWO4F401.179
& ,LSCAV_SO4DIS(POINTS) AWO4F401.180
& ,AGED_SOOT(POINTS) AWO4F405.320
& ,LSCAV_AGEDSOOT(POINTS) AWO4F405.321
C*L Workspace usage --------------------------------------------------- LSPPN2D.239
! 14 real,1 logical and 0 integer blocks are required, as follows :- LSPPN2D.241
REAL LSPPN2D.242
& PSTAR_C(N) ! gathered Surface pressure (Pa). LSPPN2D.243
&,CF_C(N) ! gathered Cloud fraction. LSPPN2D.244
&,Q_C(N) ! gathered Specific humidity (kg water/kg air). LSPPN2D.245
&,QCF_C(N) ! gathered Cloud ice (kg per kg air). LSPPN2D.246
&,QCL_C(N) ! gathered Cloud liquid water (kg per kg air). LSPPN2D.247
&,T_C(N) ! gathered Temperature (K). LSPPN2D.248
&,AERO_C(N) ! gathered Aerosol. LSPPN2D.249
&,LSRAIN_C(N) !gathered Surface rainfall rate (kg per sq m per s). LSPPN2D.250
&,LSSNOW_C(N) !gathered Surface snowfall rate (kg per sq m per s). LSPPN2D.251
&,F_DELTA_SNOW_C(N) ! gathered fraction of snow LSPPN2D.252
&,LSC_QC_C(N) ! gathered Large scale cloud Qc (kg per kg air) LSPPN2D.253
&,LSC_BS_C(N) ! gathered Large scale cloud bs. LSPPN2D.254
&,VFALL_C(N) ! gathered fall velocity (m per s). LSPPN2D.255
REAL ! gathered S Cycle tracer arrays AWO4F401.181
& SO2_C(N) AWO4F401.182
& ,NH3_C(N) AWO4F405.174
& ,SO4_AIT_C(N) AWO4F401.183
& ,SO4_ACC_C(N) AWO4F401.184
& ,SO4_DIS_C(N) AWO4F401.185
& ,LSCAV_SO2_C(N) AWO4F401.186
& ,LSCAV_NH3_C(N) AWO4F405.175
& ,LSCAV_SO4AIT_C(N) AWO4F401.187
& ,LSCAV_SO4ACC_C(N) AWO4F401.188
& ,LSCAV_SO4DIS_C(N) AWO4F401.189
& ,AGED_SOOT_C(N) AWO4F405.322
& ,LSCAV_AGEDSOOT_C(N) AWO4F405.323
! AWO4F401.190
REAL LSPPN2D.256
& RHODZ(N) ! WORK Used for air mass p.u.a. in successive LSPPN2D.257
! layers. LSPPN2D.258
&,P(N) ! WORK Used for pressure at successive levels. LSPPN2D.259
LOGICAL BLAND_C(N) ! gathered land/sea mask LSPPN2D.260
! AWO4F401.201
! Call comdeck containing ls ppn scavenging coeffs for Sulphur Cycle AWO4F401.202
*CALL C_SULLSP AWO4F401.203
! Call comdeck containing constants for soot scavenging. AWO4F405.324
*CALL C_ST_LSP AWO4F405.325
! AWO4F401.204
! External subroutines called ----------------------------------------- LSPPN2D.285
EXTERNAL LSP_EVAP,LSP_FORM,LSP_FRMT,LSP_SCAV LSPPN2D.286
& ,SLSPSCV AWO4F401.205
C*---------------------------------------------------------------------- LSPPN2D.287
! Physical constants ------------------------------------------------- LSPPN2D.288
*CALL C_G LSPPN2D.289
REAL P1UPONG LSPPN2D.290
PARAMETER ( LSPPN2D.291
& P1UPONG=1./G ! One upon g (sq seconds per m). LSPPN2D.292
&) LSPPN2D.293
! Define local variables ---------------------------------------------- LSPPN2D.294
INTEGER I ! Loop counters: I - horizontal field index; LSPPN2D.295
! LSPPN2D.296
!----------------------------------------------------------------------- LSPPN2D.297
!L Internal structure. LSPPN2D.298
!L 1. gather variables using index LSPPN2D.299
!----------------------------------------------------------------------- LSPPN2D.300
DO I=1,N LSPPN2D.301
LSRAIN_C(I)=LSRAIN(IX(I)) LSPPN2D.302
LSSNOW_C(I)=LSSNOW(IX(I)) LSPPN2D.303
PSTAR_C(I) =PSTAR(IX(I)) LSPPN2D.304
BLAND_C(I) =BLAND(IX(I)) LSPPN2D.305
CF_C(I)=CF(IX(I)) LSPPN2D.306
LSC_QC_C(I)=LSC_QC(IX(I)) LSPPN2D.307
LSC_BS_C(I)=LSC_BS(IX(I)) LSPPN2D.308
QCF_C(I)=QCF(IX(I)) LSPPN2D.309
QCL_C(I)=QCL(IX(I)) LSPPN2D.310
Q_C(I)=Q(IX(I)) LSPPN2D.311
T_C(I)=T(IX(I)) LSPPN2D.312
IF (L_MURK) AERO_C(I)=AEROSOL(IX(I)) LSPPN2D.313
F_DELTA_SNOW_C(I)=F_DELTA_SNOW(IX(I)) LSPPN2D.314
VFALL_C(I)=VFALL(IX(I)) LSPPN2D.315
END DO ! Loop over points LSPPN2D.316
! AWO4F401.206
IF (L_SULPC_SO2) THEN ! gather S Cycle tracers AWO4F401.207
DO I=1,N AWO4F401.208
SO2_C(I)=SO2(IX(I)) AWO4F401.209
SO4_AIT_C(I)=SO4_AIT(IX(I)) AWO4F401.210
SO4_ACC_C(I)=SO4_ACC(IX(I)) AWO4F401.211
SO4_DIS_C(I)=SO4_DIS(IX(I)) AWO4F401.212
LSCAV_SO2_C(I)=LSCAV_SO2(IX(I)) AWO4F401.213
LSCAV_SO4AIT_C(I)=LSCAV_SO4AIT(IX(I)) AWO4F401.214
LSCAV_SO4ACC_C(I)=LSCAV_SO4ACC(IX(I)) AWO4F401.215
LSCAV_SO4DIS_C(I)=LSCAV_SO4DIS(IX(I)) AWO4F401.216
END DO AWO4F401.217
! AWO4F405.176
IF (L_SULPC_NH3) THEN AWO4F405.177
DO I=1,N AWO4F405.178
NH3_C(I)=NH3(IX(I)) AWO4F405.179
LSCAV_NH3_C(I)=LSCAV_NH3(IX(I)) AWO4F405.180
END DO AWO4F405.181
END IF AWO4F405.182
! AWO4F405.183
END IF AWO4F401.218
IF (L_SOOT) THEN AWO4F405.326
DO I=1,N AWO4F405.327
AGED_SOOT_C(I)=AGED_SOOT(IX(I)) AWO4F405.328
LSCAV_AGEDSOOT_C(I)=LSCAV_AGEDSOOT(IX(I)) AWO4F405.329
END DO AWO4F405.330
END IF AWO4F405.331
! AWO4F401.219
! LSPPN2D.317
!----------------------------------------------------------------------- LSPPN2D.318
!L 2 Calculate pressure at current level, and air mass p.u.a. of LSPPN2D.319
!L current layer. LSPPN2D.320
! (Negative in RHODZ formula takes account of sign of DELTAs.) LSPPN2D.321
!----------------------------------------------------------------------- LSPPN2D.322
DO I=1,N LSPPN2D.323
P(I)=AK+PSTAR_C(I)*BK LSPPN2D.324
RHODZ(I)=-P1UPONG*(DELTA_AK+PSTAR_C(I)*DELTA_BK) LSPPN2D.325
END DO ! Loop over points LSPPN2D.326
! LSPPN2D.327
!----------------------------------------------------------------------- LSPPN2D.328
!L 3 If there is precipitation falling from above, then :- LSPPN2D.329
!----------------------------------------------------------------------- LSPPN2D.330
! LSPPN2D.331
!L 3.1 Evaporate from precipitation, and calculate the effect on the LSPPN2D.332
!L temperature and specific humidity. Do this by calling LSP_EVAP. LSPPN2D.333
! LSPPN2D.334
CALL LSP_EVAP(P,RHODZ,TIMESTEP,N,Q_C,LSRAIN_C,LSSNOW_C,T_C) LSPPN2D.335
! LSPPN2D.336
!L 3.2 Change phase of precipitation where necessary, and calculate LSPPN2D.337
!L the effect on the temperature and specific humidity. Also set LSPPN2D.338
!L rain/snow indicator (after any incrementing of the temperature). LSPPN2D.339
!L All this is done by calling LSP_FRMT. LSPPN2D.340
! LSPPN2D.341
CALL LSP_FRMT(RHODZ,TIMESTEP,N,QCF_C,QCL_C,LSRAIN_C,LSSNOW_C,T_C) LSPPN2D.342
!----------------------------------------------------------------------- LSPPN2D.343
!L 3.3 Form (or augment) precipitation at the expense of cloud water. LSPPN2D.344
!L Do this by calling LSP_FORM. LSPPN2D.345
!----------------------------------------------------------------------- LSPPN2D.346
! LSPPN2D.347
CALL LSP_FORM(CF_C,P,Q_C,RHODZ,T_C,TIMESTEP,N,QCF_C,QCL_C, LSPPN2D.348
& LSRAIN_C,LSSNOW_C,F_DELTA_SNOW_C,BLAND_C, LSPPN2D.349
& CW_SEA,CW_LAND,LSC_QC_C,LSC_BS_C,VFALL_C) LSPPN2D.350
! LSPPN2D.351
!----------------------------------------------------------------------- LSPPN2D.352
!L 3.4 Lose aerosol by scavenging: call LSP_SCAV LSPPN2D.353
!----------------------------------------------------------------------- LSPPN2D.354
! LSPPN2D.355
IF (L_MURK) THEN LSPPN2D.356
CALL LSP_SCAV(TIMESTEP,N,LSRAIN_C,LSSNOW_C,AERO_C) LSPPN2D.357
ENDIF LSPPN2D.358
! LSPPN2D.359
!L 3.4.1 Scavenge Sulphur Cycle tracers: call SLSPSCV AWO4F401.220
! AWO4F401.221
IF (L_SULPC_SO2) THEN AWO4F401.222
! AWO4F401.223
! scavenge SO2 AWO4F401.224
IF (KLRAIN_SO2.GT.0.0 .OR. KLSNOW_SO2.GT.0.0) THEN AWO1F404.82
CALL SLSPSCV(SO2_C,LSCAV_SO2_C, AWO4F401.225
& KLRAIN_SO2,KLSNOW_SO2, AWO4F401.226
& RHODZ,TIMESTEP,N,LSRAIN_C,LSSNOW_C) AWO4F401.227
END IF AWO1F404.83
! AWO4F401.228
! scavenge NH3 if present AWO4F405.184
IF (L_SULPC_NH3) THEN AWO4F405.185
! AWO4F405.186
IF (KLRAIN_NH3.GT.0.0 .OR. KLSNOW_NH3.GT.0.0) THEN AWO4F405.187
CALL SLSPSCV(NH3_C,LSCAV_NH3_C, AWO4F405.188
& KLRAIN_NH3,KLSNOW_NH3, AWO4F405.189
& RHODZ,TIMESTEP,N,LSRAIN_C,LSSNOW_C) AWO4F405.190
END IF AWO4F405.191
! AWO4F405.192
END IF ! end L_SULPC_NH3 condition AWO4F405.193
! scavenge SO4_AIT AWO4F401.229
IF (KLRAIN_SO4AIT.GT.0.0 .OR. KLSNOW_SO4AIT.GT.0.0) THEN AWO1F404.84
CALL SLSPSCV(SO4_AIT_C,LSCAV_SO4AIT_C, AWO4F401.230
& KLRAIN_SO4AIT,KLSNOW_SO4AIT, AWO4F401.231
& RHODZ,TIMESTEP,N,LSRAIN_C,LSSNOW_C) AWO4F401.232
END IF AWO1F404.85
! AWO4F401.233
! scavenge SO4_ACC AWO4F401.234
IF (KLRAIN_SO4ACC.GT.0.0 .OR. KLSNOW_SO4ACC.GT.0.0) THEN AWO1F404.86
CALL SLSPSCV(SO4_ACC_C,LSCAV_SO4ACC_C, AWO4F401.235
& KLRAIN_SO4ACC,KLSNOW_SO4ACC, AWO4F401.236
& RHODZ,TIMESTEP,N,LSRAIN_C,LSSNOW_C) AWO4F401.237
END IF AWO1F404.87
! AWO4F401.238
! scavenge SO4_DIS AWO4F401.239
IF (KLRAIN_SO4DIS.GT.0.0 .OR. KLSNOW_SO4DIS.GT.0.0) THEN AWO1F404.88
CALL SLSPSCV(SO4_DIS_C,LSCAV_SO4DIS_C, AWO4F401.240
& KLRAIN_SO4DIS,KLSNOW_SO4DIS, AWO4F401.241
& RHODZ,TIMESTEP,N,LSRAIN_C,LSSNOW_C) AWO4F401.242
END IF AWO1F404.89
! AWO4F401.243
END IF AWO4F401.244
! AWO4F401.245
! AWO4F405.332
! Scavenging of aged soot by calling SLSPSCV: AWO4F405.333
IF ( (KLRAIN_AGEDSOOT.GT.0.0 .OR. KLSNOW_AGEDSOOT.GT.0.0) AWO4F405.334
& .AND. (L_SOOT) ) THEN AWO4F405.335
! Scavenge soot. AWO4F405.336
CALL SLSPSCV(AGED_SOOT_C,LSCAV_AGEDSOOT_C, AWO4F405.337
& KLRAIN_AGEDSOOT,KLSNOW_AGEDSOOT, AWO4F405.338
& RHODZ,TIMESTEP,N,LSRAIN_C,LSSNOW_C) AWO4F405.339
ENDIF AWO4F405.340
! AWO4F405.341
!----------------------------------------------------------------------- LSPPN2D.360
!L 4 Scatter back arrays which will have been changed. LSPPN2D.361
!L LSPPN2D.362
!----------------------------------------------------------------------- LSPPN2D.363
! LSPPN2D.364
CDIR$ IVDEP LSPPN2D.365
! Fujitsu vectorization directive GRB0F405.427
!OCL NOVREC GRB0F405.428
DO I=1,N LSPPN2D.366
T(IX(I))=T_C(I) LSPPN2D.367
Q(IX(I))=Q_C(I) LSPPN2D.368
QCF(IX(I))=QCF_C(I) LSPPN2D.369
QCL(IX(I))=QCL_C(I) LSPPN2D.370
IF (L_MURK) AEROSOL(IX(I))=AERO_C(I) LSPPN2D.371
LSRAIN(IX(I))=LSRAIN_C(I) LSPPN2D.372
LSSNOW(IX(I))=LSSNOW_C(I) LSPPN2D.373
F_DELTA_SNOW(IX(I)) = F_DELTA_SNOW_C(I) LSPPN2D.374
VFALL(IX(I))=VFALL_C(I) LSPPN2D.375
END DO ! Loop over points LSPPN2D.376
! AWO4F401.246
IF (L_SULPC_SO2) THEN ! scatter back S Cycle tracer arrays AWO4F401.247
DO I=1,N AWO4F401.248
SO2(IX(I))=SO2_C(I) AWO4F401.249
SO4_AIT(IX(I))=SO4_AIT_C(I) AWO4F401.250
SO4_ACC(IX(I))=SO4_ACC_C(I) AWO4F401.251
SO4_DIS(IX(I))=SO4_DIS_C(I) AWO4F401.252
LSCAV_SO2(IX(I))=LSCAV_SO2_C(I) AWO4F401.253
LSCAV_SO4AIT(IX(I))=LSCAV_SO4AIT_C(I) AWO4F401.254
LSCAV_SO4ACC(IX(I))=LSCAV_SO4ACC_C(I) AWO4F401.255
LSCAV_SO4DIS(IX(I))=LSCAV_SO4DIS_C(I) AWO4F401.256
END DO AWO4F401.257
! AWO4F405.194
IF (L_SULPC_NH3) THEN AWO4F405.195
DO I=1,N AWO4F405.196
NH3(IX(I))=NH3_C(I) AWO4F405.197
LSCAV_NH3(IX(I))=LSCAV_NH3_C(I) AWO4F405.198
END DO AWO4F405.199
END IF AWO4F405.200
! AWO4F405.201
END IF AWO4F401.258
! AWO4F401.259
IF (L_SOOT) THEN AWO4F405.342
DO I=1,N AWO4F405.343
AGED_SOOT(IX(I))=AGED_SOOT_C(I) AWO4F405.344
LSCAV_AGEDSOOT(IX(I))=LSCAV_AGEDSOOT_C(I) AWO4F405.345
END DO AWO4F405.346
END IF AWO4F405.347
AWO4F405.348
RETURN LSPPN2D.377
END LSPPN2D.378
*ENDIF LSPPN2D.379