*IF DEF,A03_3A,OR,DEF,A03_5A,OR,DEF,A03_5B,OR,DEF,A03_7A,OR,DEF,A03_6A ARN1F404.2
C ******************************COPYRIGHT****************************** GTS2F400.10603
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.10604
C GTS2F400.10605
C Use, duplication or disclosure of this code is subject to the GTS2F400.10606
C restrictions as set forth in the contract. GTS2F400.10607
C GTS2F400.10608
C Meteorological Office GTS2F400.10609
C London Road GTS2F400.10610
C BRACKNELL GTS2F400.10611
C Berkshire UK GTS2F400.10612
C RG12 2SZ GTS2F400.10613
C GTS2F400.10614
C If no contract has been raised with this copy of the code, the use, GTS2F400.10615
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.10616
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.10617
C Modelling at the above address. GTS2F400.10618
C ******************************COPYRIGHT****************************** GTS2F400.10619
C GTS2F400.10620
C*LL SUBROUTINE TR_MIX ------------------------------------------------ TRMIX2C.3
CLL TRMIX2C.4
CLL Purpose: Calculate tracer flux and pass through to IMP_MIX to solve TRMIX2C.5
CLL TRMIX2C.6
CLL Suitable for single column use; activate *IF definition IBM. TRMIX2C.7
CLL TRMIX2C.8
CLL SDJ <- Programmers of some or all of previous code or changes TRMIX2C.9
CLL TRMIX2C.10
CLL Model Modification history: TRMIX2C.11
CLL version Date TRMIX2C.12
CLL TRMIX2C.13
CLL 3.4 18/10/94 *DECK inserted into UM version 3.4. S Jackson TRMIX2C.14
CLL 4.1 02/05/96 Surface emissions and dry deposition coefficients AJS1F401.1496
CLL added as input arguments; surface deposition flux AJS1F401.1497
CLL added as output argument. M.Woodage AJS1F401.1498
CLL 4.2 Oct. 96 T3E migration - *DEF CRAY removed GSS1F402.85
CLL S J Swarbrick GSS1F402.86
CLL 4.5 Jul. 98 Kill the IBM specific lines (JCThil) AJC1F405.42
CLL TRMIX2C.15
CLL Programming standard: UM Documentation Paper No 4, Version 2, TRMIX2C.16
CLL dated 18/1/90 TRMIX2C.17
CLL TRMIX2C.18
CLL System component covered: P244 TRMIX2C.19
CLL TRMIX2C.20
CLL Project task: P24 TRMIX2C.21
CLL TRMIX2C.22
CLL Documentation: UM Documentation Paper No 24. TRMIX2C.23
CLL TRMIX2C.24
C*---------------------------------------------------------------------- TRMIX2C.25
C*L Arguments :- TRMIX2C.26
SUBROUTINE TR_MIX ( 17,3TRMIX2C.27
& P_FIELD,BL_LEVELS,FIRST_ROW,ROW_LENGTH,N_ROWS TRMIX2C.28
&,DELTA_AK,DELTA_BK TRMIX2C.29
&,GAMMA_RHOKH_RDZ,RHOKH_1 TRMIX2C.30
&,PSTAR,TIMESTEP TRMIX2C.31
&,F_FIELD,FIELD TRMIX2C.32
&,SURF_EM,RES_FACTOR,SURF_DEP_FLUX AJS1F401.1499
&,NRML TRMIX2C.33
&,ERROR,LTIMER TRMIX2C.34
&) TRMIX2C.35
TRMIX2C.36
IMPLICIT NONE TRMIX2C.37
INTEGER TRMIX2C.38
& P_FIELD ! IN No. of points in P-grid. TRMIX2C.39
&,BL_LEVELS ! IN No. of atmospheric levels for TRMIX2C.43
C ! which boundary layer fluxes are TRMIX2C.44
C ! calculated. TRMIX2C.45
&,FIRST_ROW ! IN First row of data to be treated, TRMIX2C.46
C ! referred to P-grid (must be > 1 TRMIX2C.48
C ! since "polar" rows are never TRMIX2C.49
C ! treated). TRMIX2C.50
&,ROW_LENGTH ! IN No. of points in latitude row. TRMIX2C.54
&,N_ROWS ! IN No. of rows of data to be TRMIX2C.58
C ! treated, referred to P-grid. TRMIX2C.59
C ! FIRST_ROW+N_ROWS-1 must be less TRMIX2C.61
C ! than P_ROWS, since "polar" rows TRMIX2C.62
C ! are never treated. TRMIX2C.63
REAL TRMIX2C.67
& DELTA_AK(BL_LEVELS) ! IN Difference of hybrid 'A' across TRMIX2C.68
C ! boundary layers (K-1/2 to K+1/2) TRMIX2C.69
C ! (upper minus lower). TRMIX2C.70
&,DELTA_BK(BL_LEVELS) ! IN Difference of hybrid 'B' across TRMIX2C.71
C ! boundary layers (K-1/2 to K+1/2) TRMIX2C.72
C ! (upper minus lower). TRMIX2C.73
&,GAMMA_RHOKH_RDZ(P_FIELD,2:BL_LEVELS) TRMIX2C.74
C ! IN Mixing coeff. above surface TRMIX2C.75
C ! = GAMMA(K)*RHOKH(,K)*RDZ(K) TRMIX2C.76
C ! for K>=2 (from KMKH). TRMIX2C.77
&,RHOKH_1(P_FIELD) ! IN Surface exchange coeff. TRMIX2C.78
C ! from P243 (SF_EXCH) TRMIX2C.79
&,PSTAR(P_FIELD) ! IN Surface pressure (Pa). TRMIX2C.80
&,TIMESTEP ! IN Timestep in seconds. TRMIX2C.81
&,SURF_EM(P_FIELD) ! IN, Surface emissions in kg/m2/s AJS1F401.1500
&,RES_FACTOR(P_FIELD) ! IN, dry dep coeff=Ra/(Ra+Rb+Rc) AJS1F401.1501
C TRMIX2C.82
REAL TRMIX2C.83
& F_FIELD(P_FIELD,BL_LEVELS) ! OUT Flux of tracer in kg/m2/s. TRMIX2C.84
&,FIELD(P_FIELD,BL_LEVELS) ! INOUT Tracer amount in kg/kg. TRMIX2C.85
&,SURF_DEP_FLUX(P_FIELD) ! OUT, surface deposn flux (kg/m2/s) AJS1F401.1502
C TRMIX2C.86
INTEGER TRMIX2C.87
& NRML(P_FIELD) ! IN The number of model layers TRMIX2C.88
C ! in the unstable rapidly mixing TRMIX2C.89
C ! layer. Zero if surface layer TRMIX2C.90
C ! is stable. TRMIX2C.91
&,ERROR ! OUT 1 if bad arguments, else 0. TRMIX2C.92
C TRMIX2C.93
LOGICAL TRMIX2C.94
& LTIMER ! IN Logical switch for TIMER TRMIX2C.95
C ! diagnostics TRMIX2C.96
C* TRMIX2C.97
C*L External references :- TRMIX2C.98
EXTERNAL IMP_MIX,TIMER TRMIX2C.99
C* TRMIX2C.100
C*L Local and other symbolic constants :- TRMIX2C.101
*CALL C_G 
TRMIX2C.102
*CALL C_GAMMA TRMIX2C.103
C* TRMIX2C.104
C*L Workspace :- TRMIX2C.105
C TRMIX2C.106
REAL TRMIX2C.108
& RHOK_DEP(P_FIELD) ! Surface deposition coeficient AJS1F401.1503
C* TRMIX2C.121
C Local scalars :- TRMIX2C.122
INTEGER TRMIX2C.123
& P_POINTS ! Number of points on P-grid TRMIX2C.124
&,P1 ! First point in P-grid TRMIX2C.125
&,P_ROWS ! Number of rows in P-grid TRMIX2C.126
&,I ! Loop counter (horizontal field index). TRMIX2C.127
&,K ! Loop counter (vertical index). TRMIX2C.128
&,KM1 ! K minus 1. TRMIX2C.129
&,KP1 ! K plus 1. TRMIX2C.130
C TRMIX2C.131
C----------------------------------------------------------------------- TRMIX2C.132
CL 0. Check that the scalars input to define the grid are consistent. TRMIX2C.133
C See comments to routine SF_EXCH for details. TRMIX2C.134
C----------------------------------------------------------------------- TRMIX2C.135
C TRMIX2C.136
IF (LTIMER) THEN TRMIX2C.137
CALL TIMER('TRMIX ',3) TRMIX2C.138
ENDIF TRMIX2C.139
C----------------------------------------------------------------------- TRMIX2C.140
CL Set pointers, etc. TRMIX2C.141
C----------------------------------------------------------------------- TRMIX2C.142
C TRMIX2C.143
P_POINTS = N_ROWS * ROW_LENGTH TRMIX2C.144
P1 = 1 + (FIRST_ROW-1)*ROW_LENGTH TRMIX2C.145
P_ROWS = N_ROWS TRMIX2C.146
C TRMIX2C.147
TRMIX2C.148
ERROR=0 TRMIX2C.149
C TRMIX2C.150
C TRMIX2C.151
C----------------------------------------------------------------------- TRMIX2C.152
CL 1. Calculate flux of tracer: TRMIX2C.153
C----------------------------------------------------------------------- TRMIX2C.154
CL 1.1 Above the surface TRMIX2C.155
C----------------------------------------------------------------------- TRMIX2C.156
C TRMIX2C.157
DO 1 K=2,BL_LEVELS TRMIX2C.158
DO 11 I=P1,P1+P_POINTS-1 TRMIX2C.159
F_FIELD(I,K) = - (GAMMA_RHOKH_RDZ(I,K) / GAMMA(K)) * TRMIX2C.160
& (FIELD(I,K) - FIELD(I,K-1)) TRMIX2C.161
11 CONTINUE TRMIX2C.162
1 CONTINUE TRMIX2C.163
C TRMIX2C.164
C----------------------------------------------------------------------- TRMIX2C.165
CL 1.2 At the surface: (i) set surface flux equal to input emissions AJS1F401.1505
CL (should be passed in as ancillary file, else ZERO) AJS1F401.1506
CL (ii) Use input resistance factors to calculate AJS1F401.1507
CL surface deposition (if ZERO then no dry deposition) AJS1F401.1508
C----------------------------------------------------------------------- TRMIX2C.171
C TRMIX2C.172
DO 21 I=P1,P1+P_POINTS-1 TRMIX2C.173
F_FIELD(I,1) = SURF_EM(I) ! Inject surface emissions AJS1F401.1509
RHOK_DEP(I) = RES_FACTOR(I) * RHOKH_1(I) TRMIX2C.176
SURF_DEP_FLUX(I) = -RHOK_DEP(I) * FIELD(I,1) TRMIX2C.177
RHOK_DEP(I) = GAMMA(1) * RHOK_DEP(I) TRMIX2C.178
21 CONTINUE TRMIX2C.179
C TRMIX2C.180
C----------------------------------------------------------------------- TRMIX2C.181
CL 2. Call routine IMPL_CAL to calculate incrememnts to tracer field TRMIX2C.182
CL and suface deposition flux for output AJS1F401.1510
C----------------------------------------------------------------------- TRMIX2C.183
C TRMIX2C.184
CALL IMP_MIX ( TRMIX2C.185
& P_FIELD,P1,P_POINTS,BL_LEVELS,DELTA_AK,DELTA_BK TRMIX2C.186
&,GAMMA_RHOKH_RDZ,RHOK_DEP TRMIX2C.187
&,PSTAR,TIMESTEP TRMIX2C.188
&,F_FIELD,SURF_DEP_FLUX,FIELD TRMIX2C.189
&,NRML TRMIX2C.190
&,ERROR,LTIMER TRMIX2C.191
& ) TRMIX2C.192
TRMIX2C.193
! AJS1F401.1511
TRMIX2C.194
IF (LTIMER) THEN TRMIX2C.195
CALL TIMER('TRMIX ',4) TRMIX2C.196
ENDIF TRMIX2C.197
TRMIX2C.198
RETURN TRMIX2C.199
END TRMIX2C.200
*ENDIF TRMIX2C.201