*IF DEF,A05_3B,OR,DEF,A05_3C AJX1F405.188
C *****************************COPYRIGHT****************************** SCONSC1A.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. SCONSC1A.4
C SCONSC1A.5
C Use, duplication or disclosure of this code is subject to the SCONSC1A.6
C restrictions as set forth in the contract. SCONSC1A.7
C SCONSC1A.8
C Meteorological Office SCONSC1A.9
C London Road SCONSC1A.10
C BRACKNELL SCONSC1A.11
C Berkshire UK SCONSC1A.12
C RG12 2SZ SCONSC1A.13
C SCONSC1A.14
C If no contract has been raised with this copy of the code, the use, SCONSC1A.15
C duplication or disclosure of it is strictly prohibited. Permission SCONSC1A.16
C to do so must first be obtained in writing from the Head of Numerical SCONSC1A.17
C Modelling at the above address. SCONSC1A.18
C ******************************COPYRIGHT****************************** SCONSC1A.19
! SUBROUTINE SCONSCV ----------------------------------------------- SCONSC1A.20
! SCONSC1A.21
! Purpose: Scavenge Sulphur Cycle tracers by convective precipitation SCONSC1A.22
! assuming loss rate = cost * conv ppn rate at surface SCONSC1A.23
! for all levels below cloud top. SCONSC1A.24
! SCONSC1A.25
! Called from CONV_CT1 if Sulphur Cycle is on SCONSC1A.26
! SCONSC1A.27
! Current code owner: M. Woodage SCONSC1A.28
! SCONSC1A.29
! History: SCONSC1A.30
! Version Date Comment SCONSC1A.31
! ------- ---- ------- SCONSC1A.32
! 4.1 06/06/96 Original Code M. Woodage SCONSC1A.33
! 4.3 17/04/97 Tidy DEFS and code so that blank source is not GSH1F403.11
CLL produced (A. Brady) GSH1F403.12
! 4.4 30/09/97 Add logical to control below cloud scavenging. AWO1F404.122
! Use conv cloud amount to adjust amount scavenged AWO1F404.123
! assuming CCA=0.05. (M Woodage) AWO1F404.124
! SCONSC1A.34
! Code Description: SCONSC1A.35
! Language: FORTRAN 77 + common extensions. SCONSC1A.36
! This code is written to UMDP3 v6 programming standards. SCONSC1A.37
! SCONSC1A.38
! System component covered: SCONSC1A.39
! SCONSC1A.40
! System task: SCONSC1A.41
! SCONSC1A.42
! Documentation: Not yet available SCONSC1A.43
! SCONSC1A.44
!------------------------------------------------------------------- SCONSC1A.45
! SCONSC1A.46
SUBROUTINE SCONSCV(TRACER, 6SCONSC1A.47
& TIMESTEP, SCONSC1A.48
& TR_LEVS, SCONSC1A.49
& NPFLD, SCONSC1A.50
& FIRST_POINT,LAST_POINT, SCONSC1A.51
& CCLDBASE,CCLDTOP, SCONSC1A.52
& L_SCAV_BELOW_CLOUD,CCA, AWO1F404.125
& RAINRATE,SNOWRATE, SCONSC1A.53
& K_RAIN,K_SNOW, SCONSC1A.54
& ACCU_SCAV_TR, SCONSC1A.55
& AKDIFF,BKDIFF, SCONSC1A.56
& PLEVS,P_STAR) SCONSC1A.57
! SCONSC1A.58
IMPLICIT NONE SCONSC1A.59
! SCONSC1A.60
INTEGER NPFLD ! IN, no. of pts in a 2_D field PXORDER.48
INTEGER CCLDBASE(NPFLD), ! IN, convective cloud base SCONSC1A.61
& CCLDTOP(NPFLD), ! IN, convective cloud top SCONSC1A.62
& PLEVS, ! IN, no. of p_levels SCONSC1A.63
& TR_LEVS, ! IN, no. of tracer levels SCONSC1A.64
& FIRST_POINT, ! IN, first point for calcs to be do SCONSC1A.66
& LAST_POINT ! IN, last point for calcns to be do SCONSC1A.67
! SCONSC1A.68
! SCONSC1A.69
REAL TIMESTEP, ! IN, timestep in secs SCONSC1A.70
& K_RAIN, ! IN, scavenging rate coeff for rain SCONSC1A.71
& K_SNOW ! IN, scavenging rate coeff for snow SCONSC1A.72
! SCONSC1A.73
LOGICAL L_SCAV_BELOW_CLOUD !IN, control for scavenging levels AWO1F404.126
! AWO1F404.127
REAL CCA(NPFLD) ! IN, convective cloud amount (fraction) AWO1F404.128
REAL RAINRATE(NPFLD), ! IN conv rain rate at surface kg/m2 SCONSC1A.74
& SNOWRATE(NPFLD), ! IN conv snow rate at surface kg/m2 SCONSC1A.75
& TRACER(NPFLD,TR_LEVS), ! IN and OUT, tracer SCONSC1A.76
& ACCU_SCAV_TR(NPFLD), ! OUT, column total of scvnged trcr SCONSC1A.77
& AKDIFF(PLEVS), ! IN, for layer thickness calcn: SCONSC1A.78
& BKDIFF(PLEVS), ! IN, " SCONSC1A.79
& P_STAR(NPFLD) ! IN, " SCONSC1A.80
! SCONSC1A.81
! Local variables SCONSC1A.82
! SCONSC1A.83
INTEGER I,K ! loop counters SCONSC1A.84
INTEGER START_LEVEL ! lowest level for scavenging AWO1F404.129
! SCONSC1A.85
REAL TERMR, ! to assist calcn of scav rate SCONSC1A.86
& TERMS, ! SCONSC1A.87
& RDZ, ! mass p.u.area of air in layer SCONSC1A.88
& DELTA_TR ! tracer increment due to scvnging SCONSC1A.89
! SCONSC1A.90
REAL SCONSC1A.91
& TOTRATE, ! total scav rate SCONSC1A.92
& INVTRAT ! 1/(1+TOTRATE) SCONSC1A.93
! SCONSC1A.94
*CALL C_G 
! G=9.80665 for tracer calcn SCONSC1A.95
! SCONSC1A.96
! SCONSC1A.98
! Initialise ACCU_SCAV_TR array to zero before adding accumulations SCONSC1A.99
DO I=1,NPFLD SCONSC1A.100
ACCU_SCAV_TR(I)=0.0 SCONSC1A.101
END DO SCONSC1A.102
! SCONSC1A.103
! Calculate total scavenging rate SCONSC1A.104
! SCONSC1A.105
DO I=FIRST_POINT,LAST_POINT ! leave out polar rows SCONSC1A.106
! SCONSC1A.107
IF (CCLDTOP(I).GT.0 .AND. CCA(I).GT.0.0) THEN AWO1F404.130
! AWO1F404.131
! Set up START_LEVEL for scavenging AWO1F404.132
IF (L_SCAV_BELOW_CLOUD) THEN AWO1F404.133
START_LEVEL = 1 AWO1F404.134
ELSE AWO1F404.135
START_LEVEL = CCLDBASE(I) AWO1F404.136
END IF AWO1F404.137
! AWO1F404.138
IF (RAINRATE(I).LE.0.0) THEN ! check for negative ppn SCONSC1A.108
TERMR=0.0 SCONSC1A.109
ELSE SCONSC1A.110
TERMR=K_RAIN*RAINRATE(I) SCONSC1A.111
ENDIF SCONSC1A.112
! SCONSC1A.113
IF (SNOWRATE(I).LE.0.0) THEN SCONSC1A.114
TERMS=0.0 SCONSC1A.115
ELSE SCONSC1A.116
TERMS=K_SNOW*SNOWRATE(I) SCONSC1A.117
ENDIF SCONSC1A.118
! SCONSC1A.119
! Calculate TOTRATE, *3600.0 because K_RAIN and K_SNOW are derived for SCONSC1A.120
! ppn rates in mm/hr, but model values are kg/m2/s (cf CON_SCAV) SCONSC1A.121
TOTRATE=(TERMR+TERMS)*3600.0*TIMESTEP SCONSC1A.122
! Increase TOTRATE to obtain rate in cloudy part of grid box AWO1F404.139
! Assume CCA=0.05 AWO1F404.140
TOTRATE=TOTRATE / 0.05 AWO1F404.141
INVTRAT=1.0/(1.0+TOTRATE) SCONSC1A.123
! SCONSC1A.124
! Do scavenging, leaving out N and S polar rows SCONSC1A.125
! Calculate amount of tracer scavenged and add to column total SCONSC1A.126
! SCONSC1A.127
DO K = START_LEVEL,CCLDTOP(I) AWO1F404.142
! SCONSC1A.130
! Calculate proportion of tracer mixing ratio scavenged out SCONSC1A.131
DELTA_TR=TRACER(I,K)*(1.0-INVTRAT) SCONSC1A.132
! Reduce DELTA_TR to allow for non_cloudy part of grid box AWO1F404.143
DELTA_TR = DELTA_TR * 0.05 AWO1F404.144
! SCONSC1A.133
! Calculate mass of air per unit area in layer for conversion of tracer SCONSC1A.134
! mixing ratio increment to mass p.u.a. for STASH SCONSC1A.135
RDZ=(-AKDIFF(K)-BKDIFF(K)*P_STAR(I))/G SCONSC1A.136
! SCONSC1A.137
! Increment column total mass p.u.a. of scavenged tracer SCONSC1A.138
ACCU_SCAV_TR(I)=ACCU_SCAV_TR(I)+DELTA_TR*RDZ SCONSC1A.139
! SCONSC1A.140
! Decrement tracer mixing ratio SCONSC1A.141
TRACER(I,K)=TRACER(I,K)-DELTA_TR SCONSC1A.142
! SCONSC1A.143
END DO ! end K loop SCONSC1A.144
END IF SCONSC1A.145
! SCONSC1A.146
END DO ! end of I loop SCONSC1A.147
! SCONSC1A.148
! SCONSC1A.149
RETURN SCONSC1A.150
END SCONSC1A.151
! SCONSC1A.152
*ENDIF SCONSC1A.153