*IF DEF,A04_2E,OR,DEF,A04_3B ADM0F405.286
C *****************************COPYRIGHT****************************** RAINOU1A.3
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved. RAINOU1A.4
C RAINOU1A.5
C Use, duplication or disclosure of this code is subject to the RAINOU1A.6
C restrictions as set forth in the contract. RAINOU1A.7
C RAINOU1A.8
C Meteorological Office RAINOU1A.9
C London Road RAINOU1A.10
C BRACKNELL RAINOU1A.11
C Berkshire UK RAINOU1A.12
C RG12 2SZ RAINOU1A.13
C RAINOU1A.14
C If no contract has been raised with this copy of the code, the use, RAINOU1A.15
C duplication or disclosure of it is strictly prohibited. Permission RAINOU1A.16
C to do so must first be obtained in writing from the Head of Numerical RAINOU1A.17
C Modelling at the above address. RAINOU1A.18
C ******************************COPYRIGHT****************************** RAINOU1A.19
! SUBROUTINE RAINOUT ------------------------------------ AWO4F405.202
! RAINOU1A.21
! Purpose: This subroutine removes dissolved tracer aerosol assuming AWO4F405.203
! the amount in grid box is reduced in the same proportion as RAINOU1A.23
! the reduction in the total condensed water (liquid + ice) RAINOU1A.24
! due to ppn. (It is assumed that the concn of tracer AWO4F405.204
! is the same in every droplet and ice particle) RAINOU1A.26
! RAINOU1A.27
! Called by LSPP_CTL AWO4F405.205
! RAINOU1A.29
! Current Code Owner: D L Roberts RAINOU1A.30
! RAINOU1A.31
! History: RAINOU1A.32
! Version Date Comments RAINOU1A.33
! ------- ---- -------- RAINOU1A.34
! 4.1 23/05/96 Original code D L Roberts RAINOU1A.35
! 4.3 17/03/96 Include layer thickness calcn for diagnostics. AWO1F403.9
! Disallow rainout if ppn does not reach surface. AWO1F403.10
! M Woodage AWO1F403.11
! 4.5 07/07/98 Generalise routine for any tracer (originally AWO4F405.206
! written for dissolved sulphate aerosol and AWO4F405.207
! called RAINOUT_SULPHATE) M Woodage AWO4F405.208
! RAINOU1A.36
! Code Description: RAINOU1A.37
! Language: FORTRAN77 + common extensions RAINOU1A.38
! This code is written to UMDP3 v6 programming standards RAINOU1A.39
! RAINOU1A.40
! System components covered: RAINOU1A.41
! RAINOU1A.42
! System task: RAINOU1A.43
! RAINOU1A.44
! Documentation: Not yet available RAINOU1A.45
! RAINOU1A.46
!----------------------------------------------------------------- RAINOU1A.47
! RAINOU1A.48
SUBROUTINE RAINOUT( 2AWO4F405.209
& QCF ! IN RAINOU1A.50
& ,QCL ! IN RAINOU1A.51
& ,QPREVIOUS ! IN RAINOU1A.52
& ,LS_RAIN ! IN AWO1F403.12
& ,LS_SNOW ! IN AWO1F403.13
& ,TRACER ! IN/OUT AWO4F405.210
& ,FIRST_POINT ! IN RAINOU1A.54
& ,LAST_POINT ! IN RAINOU1A.55
& ,P_FIELD ! IN RAINOU1A.56
& ,Q_LEVELS ! IN RAINOU1A.57
& ,RNOUT_TRACER ! OUT AWO4F405.211
& ,AKDIFF,BKDIFF,PSTAR !IN AWO1F403.14
& ) RAINOU1A.59
! RAINOU1A.60
IMPLICIT NONE RAINOU1A.61
! RAINOU1A.62
INTEGER RAINOU1A.63
& Q_LEVELS, !IN, no. of wet levels RAINOU1A.64
& P_FIELD, !IN, no. of pts in full 2_D field RAINOU1A.65
& FIRST_POINT, !IN, first point in 2D domain RAINOU1A.66
& LAST_POINT !IN, last point in 2D domain RAINOU1A.67
! RAINOU1A.68
REAL TRACER(P_FIELD,Q_LEVELS), !INOUT mmr of dissolved tracer AWO4F405.212
& QCL(P_FIELD,Q_LEVELS), !IN cloud liquid water (mmr) RAINOU1A.70
& QCF(P_FIELD,Q_LEVELS), !IN cloud frozen water (mmr) RAINOU1A.71
& LS_RAIN(P_FIELD), ! IN Large-scale rain at the surface AWO1F403.15
& LS_SNOW(P_FIELD), ! IN Large-scale snow at the surface AWO1F403.16
& QPREVIOUS(P_FIELD,Q_LEVELS) !IN, total condensed water RAINOU1A.72
! before precipitation RAINOU1A.73
REAL AKDIFF(Q_LEVELS), !IN, for layer thickness calcn AWO1F403.17
& BKDIFF(Q_LEVELS), !IN, " AWO1F403.18
& PSTAR(P_FIELD) !IN, " AWO1F403.19
REAL RNOUT_TRACER(P_FIELD) ! OUT tracer removed kg/m2/ts AWO4F405.213
! RAINOU1A.75
! Local variables RAINOU1A.76
! RAINOU1A.77
INTEGER I,LEVEL ! loop variables RAINOU1A.78
! RAINOU1A.79
REAL RAINOU1A.80
& QREMAIN, ! total condensed water after precipn. RAINOU1A.81
& FRACTION ! fraction of water remaining RAINOU1A.82
REAL DELTA_TRACER ! amount tracer removed from grid box AWO4F405.214
REAL SURF_PRECIP(P_FIELD) ! total precipn at surface AWO1F403.20
! RAINOU1A.84
REAL RDZ ! mass p.u.area of air in layer AWO1F403.21
! AWO1F403.22
*CALL C_G 
! G=9.80665 for layer thickness calcn AWO1F403.23
! AWO1F403.24
! WANT TO RESTRICT CALCULATIONS TO POINTS WHERE THERE IS SOME AWO4F405.215
! CONDENSED WATER, AND AWO4F405.216
! TO POINTS WHERE SOME PRECIPITATION ACTUALLY REACHES AWO1F403.27
! THE SURFACE. AWO1F403.28
! THERE ARE THEN THREE CASES TO CONSIDER. RAINOU1A.88
! (A) CONDENSED WATER CONTENT HAS ACTUALLY INCREASED. IN THIS RAINOU1A.89
! CASE WE LEAVE THE DISSOLVED TRACER UNCHANGED. AWO4F405.217
! (B) CONDENSED WATER CONTENT HAS DECREASED BUT IS NON-NEGATIVE. RAINOU1A.91
! IN THIS CASE WE REDUCE THE DISSOLVED TRACER IN THE AWO4F405.218
! SAME RATIO. RAINOU1A.93
! (C) CONDENSED WATER CONTENT HAS DECREASED TO LESS THAN ZERO. RAINOU1A.94
! IN THIS CASE WE REMOVE ALL THE DISSOLVED TRACER. AWO4F405.219
! (MAYBE THIS CASE SHOULD NOT OCCUR. HOWEVER IT COSTS RAINOU1A.96
! ALMOST NOTHING TO TRAP IT.) RAINOU1A.97
! RAINOU1A.98
! Initialise RNOUT_TRACER to zero before doing rainout AWO4F405.220
DO I = FIRST_POINT,LAST_POINT RAINOU1A.100
RNOUT_TRACER(I) = 0.0 AWO4F405.221
SURF_PRECIP(I) = LS_RAIN(I) + LS_SNOW(I) AWO1F403.29
END DO RAINOU1A.102
! RAINOU1A.103
DO LEVEL = 1,Q_LEVELS ! loops over wet levels RAINOU1A.104
DO I = FIRST_POINT,LAST_POINT ! loop over domain on a level. RAINOU1A.105
! RAINOU1A.106
IF( ( QPREVIOUS(I,LEVEL) .GT. 0.0 ) .AND. AWO1F403.30
& ( SURF_PRECIP(I) .GT. 0.0 ) ) THEN AWO1F403.31
! RAINOU1A.108
QREMAIN = QCF(I,LEVEL) + QCL(I,LEVEL) RAINOU1A.109
IF( QREMAIN .GT. QPREVIOUS(I,LEVEL) ) THEN RAINOU1A.110
FRACTION = 1.0 RAINOU1A.111
ELSE IF ( QREMAIN .GE. 0.0 ) THEN RAINOU1A.112
FRACTION = QREMAIN/QPREVIOUS(I,LEVEL) RAINOU1A.113
ELSE RAINOU1A.114
FRACTION = 0.0 RAINOU1A.115
ENDIF RAINOU1A.116
! RAINOU1A.117
! Calculate amount TRACER removed per grid box AWO4F405.222
DELTA_TRACER = TRACER(I,LEVEL) * (1.0-FRACTION) AWO4F405.223
! RAINOU1A.120
! Calculate mass of air per unit area in layer for conversion of AWO1F403.32
! tracer mixing ratio increment to mass p.u.area for STASH AWO1F403.33
RDZ=(-AKDIFF(LEVEL)-BKDIFF(LEVEL)*PSTAR(I))/G AWO1F403.34
! AWO1F403.35
! Accumulate removed TRACER for each level AWO4F405.224
RNOUT_TRACER(I) = RNOUT_TRACER(I) + DELTA_TRACER*RDZ AWO4F405.225
! RAINOU1A.123
! Decrement TRACER AWO4F405.226
TRACER(I,LEVEL) = TRACER(I,LEVEL) - DELTA_TRACER AWO4F405.227
! RAINOU1A.126
ENDIF ! END QPREVIOUS condition RAINOU1A.127
! RAINOU1A.128
END DO ! END OF I LOOP RAINOU1A.129
END DO ! END OF LEVEL LOOP RAINOU1A.130
! RAINOU1A.131
RETURN RAINOU1A.132
END RAINOU1A.133
! RAINOU1A.134
*ENDIF RAINOU1A.135