*IF DEF,A17_1A SOOT1A.2
C *****************************COPYRIGHT****************************** SOOT1A.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. SOOT1A.4
C SOOT1A.5
C Use, duplication or disclosure of this code is subject to the SOOT1A.6
C restrictions as set forth in the contract. SOOT1A.7
C SOOT1A.8
C Meteorological Office SOOT1A.9
C London Road SOOT1A.10
C BRACKNELL SOOT1A.11
C Berkshire UK SOOT1A.12
C RG12 2SZ SOOT1A.13
C SOOT1A.14
C If no contract has been raised with this copy of the code, the use, SOOT1A.15
C duplication or disclosure of it is strictly prohibited. Permission SOOT1A.16
C to do so must first be obtained in writing from the Head of Numerical SOOT1A.17
C Modelling at the above address. SOOT1A.18
C ******************************COPYRIGHT****************************** SOOT1A.19
C*LL SUBROUTINES NEW2OLD and SOOTSCAV --------------------------------- SOOT1A.20
!LL Purpose: SOOT1A.21
!LL NEW2OLD converts a proportion of the fresh soot to an aged SOOT1A.22
!LL variety. This conversion takes place as an exponential decay SOOT1A.23
!LL with an e-folding time of 1.6 days. SOOT1A.24
!LL SOOT1A.25
!LL SOOTSCAV causes a fraction of the aged soot to become SOOT1A.26
!LL scavenged by cloud droplets, creating the third mode of SOOT1A.27
!LL soot, soot in cloud water. SOOT1A.28
!LL SOOT1A.29
!LL Modification History from Version 4.4 SOOT1A.30
!LL Version Date SOOT1A.31
!LL 4.5 Jun 1998 New Deck Luke Robinson SOOT1A.32
!LL SOOT1A.33
!LL Programming standard: Unified Model Documentation Paper No 3 SOOT1A.34
!LL Code Description: SOOT1A.35
!LL Language: FORTRAN77 + common extensions SOOT1A.36
!LL SOOT1A.37
!LL Logical component covered: SOOT1A.38
!LL SOOT1A.39
!LL Project task: SOOT1A.40
!LL SOOT1A.41
!LL Documentation: Not yet available. SOOT1A.42
!LL SOOT1A.43
C*L Arguments:--------------------------------------------------------- SOOT1A.44
SUBROUTINE NEW2OLD(NPTS, 1SOOT1A.45
& FIRST_POINT, SOOT1A.46
& LAST_POINT, SOOT1A.47
& P_FIELD, SOOT1A.48
& SootBefore, SOOT1A.49
& SootAfter, SOOT1A.50
& TimeStep) SOOT1A.51
SOOT1A.52
! Converts fresh soot to aged using an exponential decay of former. SOOT1A.53
SOOT1A.54
INTEGER !,INTENT(IN) SOOT1A.55
& NPTS, ! No. of points in 3D array. SOOT1A.56
& FIRST_POINT, SOOT1A.57
& LAST_POINT, SOOT1A.58
& P_FIELD ! No. of points in each level. SOOT1A.59
SOOT1A.60
real TimeStep !,INTENT(IN) SOOT1A.61
SOOT1A.62
real !,INTENT(INOUT) SOOT1A.63
& SootAfter(NPTS), ! Aged soot. SOOT1A.64
& SootBefore(NPTS) ! Fresh soot. SOOT1A.65
SOOT1A.66
! LOCAL VARIABLES. SOOT1A.67
! SOOT1A.68
INTEGER i,j,k SOOT1A.69
real Delta ! Amount of soot converted to aged. SOOT1A.70
real rate ! Decay rate. SOOT1A.71
SOOT1A.72
parameter(rate=7.1E-6) SOOT1A.73
SOOT1A.74
! This loop cycles through all points on all levels, SOOT1A.75
! but avoids the polar points. SOOT1A.76
SOOT1A.77
do k = 1, NPTS-P_FIELD + 1, P_FIELD SOOT1A.78
do j = FIRST_POINT, LAST_POINT SOOT1A.79
i = k + j - 1 SOOT1A.80
Delta = (rate * TimeStep) * SootBefore(i) SOOT1A.81
SootBefore(i) = SootBefore(i) - Delta SOOT1A.82
SootAfter(i) = SootAfter(i) + Delta SOOT1A.83
enddo SOOT1A.84
enddo SOOT1A.85
SOOT1A.86
return SOOT1A.87
end SOOT1A.88
!=================================================================== SOOT1A.89
SOOT1A.90
SUBROUTINE SOOTSCAV(Soot, 1SOOT1A.91
& SOOTINCLOUD, SOOT1A.92
& CLOUDF, SOOT1A.93
& NPNTS,QPNTS,NPFLD,TSTEP, SOOT1A.94
& QCL,QCF, SOOT1A.95
& FIRST_POINT,LAST_POINT SOOT1A.96
& ) SOOT1A.97
SOOT1A.98
! Performs nucleation scavenging, creating soot in cloud water SOOT1A.99
! from a proportion of the aged soot. SOOT1A.100
SOOT1A.101
!------------------------------------------------------------------- SOOT1A.102
SOOT1A.103
INTEGER SOOT1A.104
& NPNTS, !IN no. of pts in 3_D array on P_LEVS SOOT1A.105
& QPNTS, !IN no. of pts in 3_D array on Q_LEVS SOOT1A.106
& NPFLD, !IN no. of pts in 2_D field SOOT1A.107
& FIRST_POINT, !IN first point for calcns to be done SOOT1A.108
& LAST_POINT !IN last point for calcns to be done SOOT1A.109
! SOOT1A.110
REAL SOOT1A.111
& CLEARF(QPNTS), ! IN clear air fraction (1-CLOUDF) SOOT1A.112
& CLOUDF(QPNTS), ! IN cloud fraction (range 0 TO 1) SOOT1A.113
& DELTASOOTEVAP(NPNTS), ! amount of soot released SOOT1A.114
! when cloud water evaporates. SOOT1A.115
& DELTAST_NUCL(NPNTS), ! amount of soot converted from aged SOOT1A.116
! to SOOTINCLOUD by nucleation. SOOT1A.117
& EVAPTIME, ! timescale for cloud droplets to evaporate SOOT1A.118
& QCTOTAL(QPNTS), ! total condensed water amount.(QCL+QCF) SOOT1A.119
& QCL(QPNTS), !IN cloud liquid water (mmr) SOOT1A.120
& QCF(QPNTS), !IN cloud frozen water (mmr) SOOT1A.121
! SOOT1A.122
& SOOT(NPNTS), !INOUT mass mix rat of SOOT SOOT1A.123
& SOOTINCLOUD(NPNTS), !OUT mass mix rat of soot SOOT1A.124
! suspended in cloudwater. SOOT1A.125
& TSTEP !IN physics timestep SOOT1A.126
SOOT1A.127
*CALL C_ST_CHM 
SOOT1A.128
! SOOT1A.129
!-------------------------------------------------------------------- SOOT1A.130
! Initialise DELTA increments to 0.0 SOOT1A.131
!-------------------------------------------------------------------- SOOT1A.132
! SOOT1A.133
DO J=1,NPNTS-NPFLD+1,NPFLD ! J loops over all model points SOOT1A.134
DO I=FIRST_POINT,LAST_POINT ! I loop omits N & S polar rows SOOT1A.135
K=I+J-1 SOOT1A.136
DELTASOOTEVAP(K) = 0.0 SOOT1A.137
DELTAST_NUCL(K) = 0.0 SOOT1A.138
END DO SOOT1A.139
END DO SOOT1A.140
SOOT1A.141
SOOT1A.142
!------------------------------------------------------------------- SOOT1A.143
! Calculate the total water content and the clear air fraction. SOOT1A.144
!------------------------------------------------------------------- SOOT1A.145
SOOT1A.146
DO J=1,QPNTS-NPFLD+1,NPFLD ! J loops over all model points SOOT1A.147
DO I=FIRST_POINT,LAST_POINT ! I loop omits N & S polar rows SOOT1A.148
K=I+J-1 SOOT1A.149
QCTOTAL(K) = QCL(K) + QCF(K) SOOT1A.150
CLEARF(K)=1.0-CLOUDF(K) SOOT1A.151
END DO SOOT1A.152
END DO SOOT1A.153
! SOOT1A.154
!------------------------------------------------------------------- SOOT1A.155
! Release of aerosol from evaporating cloud droplets: SOOT1A.156
! if no condensed water (liquid + ice) in grid box, release SOOT1A.157
! soot as aged soot. SOOT1A.158
!-------------------------------------------------------------------- SOOT1A.159
! SOOT1A.160
DO J=1,QPNTS-NPFLD+1,NPFLD ! J loops over all model points SOOT1A.161
DO I=FIRST_POINT,LAST_POINT ! I loop omits N & S polar rows SOOT1A.162
K=I+J-1 SOOT1A.163
! If cloud fraction less than 0.95, release some in clear air. SOOT1A.164
IF ( QCTOTAL(K) .LT. THOLD ) THEN SOOT1A.165
DELTASOOTEVAP(K) = SOOTINCLOUD(K) SOOT1A.166
ELSE IF ( CLOUDF(K).LT.0.95 ) THEN SOOT1A.167
EVAPTIME = EVAPTAU + 0.5*CLOUDTAU SOOT1A.168
DELTASOOTEVAP(K) = ( 1.0 - EXP(-TSTEP/EVAPTIME) ) SOOT1A.169
& *SOOTINCLOUD(K) SOOT1A.170
ELSE SOOT1A.171
DELTASOOTEVAP(K) = 0.0 SOOT1A.172
ENDIF SOOT1A.173
END DO SOOT1A.174
END DO SOOT1A.175
! SOOT1A.176
! Also release any dissolved aerosol in a non-wet level, SOOT1A.177
! where it should not be. SOOT1A.178
! SOOT1A.179
IF (QPNTS.LT.NPNTS) THEN ! ie. if dry points exist. SOOT1A.180
DO J=QPNTS+1,NPNTS-NPFLD+1,NPFLD ! J loop omits wet points SOOT1A.181
DO I=FIRST_POINT,LAST_POINT ! I loop omits N & S polar rows SOOT1A.182
K=I+J-1 SOOT1A.183
DELTASOOTEVAP(K) = SOOTINCLOUD(K) SOOT1A.184
END DO SOOT1A.185
END DO SOOT1A.186
ENDIF SOOT1A.187
! SOOT1A.188
! SOOT1A.189
!------------------------------------------------------------------- SOOT1A.190
! Nucleation of aerosol forming SOOTINCLOUD (i.e. soot acting as CCN) SOOT1A.191
!------------------------------------------------------------------- SOOT1A.192
! SOOT1A.193
! THIS CODE ASSUMES THAT THE PARAMETER NUCTAU, WHICH IS THE SOOT1A.194
! TIMESCALE FOR NUCLEATION ONCE A PARTICLE ENTERS A CLOUD, IS SOOT1A.195
! VERY SHORT COMPARED WITH CLOUDTAU. SOOT1A.196
! SOOT1A.197
DO J=1,QPNTS-NPFLD+1,NPFLD ! J loops over all model points SOOT1A.198
DO I=FIRST_POINT,LAST_POINT ! I loop omits N AND S polar rows SOOT1A.199
K=I+J-1 SOOT1A.200
IF ((QCTOTAL(K) .GE. THOLD) .AND. (CLOUDF(K).GT.0.0)) THEN SOOT1A.201
NUCTIME=NUCTAU + ( (CLEARF(K)*CLOUDTAU)/(2.0*CLOUDF(K)) ) SOOT1A.202
DELTAST_NUCL(K) = ( 1.0 - EXP(-TSTEP/NUCTIME) )*SOOT(K) SOOT1A.203
ENDIF SOOT1A.204
END DO SOOT1A.205
END DO SOOT1A.206
! SOOT1A.207
!------------------------------------------------------------------- SOOT1A.208
! UPDATE soot. SOOT1A.209
!-------------------------------------------------------------------- SOOT1A.210
! SOOT1A.211
DO J=1,QPNTS-NPFLD+1,NPFLD ! J loops over all model points SOOT1A.212
DO I=FIRST_POINT,LAST_POINT ! I loop omits N & S polar rows SOOT1A.213
K=I+J-1 SOOT1A.214
SOOT(K) = SOOT(K) SOOT1A.215
& + DELTASOOTEVAP(K) SOOT1A.216
& - DELTAST_NUCL(K) SOOT1A.217
SOOTINCLOUD(K) = SOOTINCLOUD(K) SOOT1A.218
& - DELTASOOTEVAP(K) SOOT1A.219
& + DELTAST_NUCL(K) SOOT1A.220
END DO SOOT1A.221
END DO SOOT1A.222
! SOOT1A.223
!-------------------------------------------------------------------- SOOT1A.224
RETURN SOOT1A.225
END SOOT1A.226
*ENDIF SOOT1A.227