*IF DEF,A11_1A,OR,DEF,A03_5A,OR,DEF,A03_5B,OR,DEF,A03_7A,OR,DEF,A03_6A ARN1F404.17
C ******************************COPYRIGHT****************************** GTS2F400.10693
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.10694
C GTS2F400.10695
C Use, duplication or disclosure of this code is subject to the GTS2F400.10696
C restrictions as set forth in the contract. GTS2F400.10697
C GTS2F400.10698
C Meteorological Office GTS2F400.10699
C London Road GTS2F400.10700
C BRACKNELL GTS2F400.10701
C Berkshire UK GTS2F400.10702
C RG12 2SZ GTS2F400.10703
C GTS2F400.10704
C If no contract has been raised with this copy of the code, the use, GTS2F400.10705
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.10706
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.10707
C Modelling at the above address. GTS2F400.10708
C ******************************COPYRIGHT****************************** GTS2F400.10709
C GTS2F400.10710
C*LL SUBROUTINE TRSRCE ---------------------------------------------- TRSRCE1A.3
CLL TRSRCE1A.4
CLL Purpose: Adds source increments to a single level of the aerosol TRSRCE1A.5
CLL field. TRSRCE1A.6
CLL TRSRCE1A.7
CLL Suitable for single-column use. TRSRCE1A.8
CLL TRSRCE1A.9
CLL Pete Clark <- programmer of some or all of previous code or changes TRSRCE1A.10
CLL TRSRCE1A.11
CLL Model Modification history from model version 3.4: TRSRCE1A.12
CLL version Date TRSRCE1A.13
CLL 4.0 05/09/95 Model hour and minute added to call to TRSRCE. APC3F400.5
CLL Diurnal variation of emissions, hard wired to APC3F400.6
CLL peak at midday, with 10% amplitude, assumed. APC3F400.7
CLL Programmer Pete Clark. APC3F400.8
CLL 4.1 02/05/96 Amplitude of diurnal variation added to input AJS1F401.1487
CLL argument list. M.Woodage AJS1F401.1488
CLL TRSRCE1A.14
CLL Programming standard: Unified Model Documentation Paper No 3, TRSRCE1A.15
CLL Version 7, dated 11/3/93. TRSRCE1A.16
CLL TRSRCE1A.17
CLL TRSRCE1A.18
C*L Arguments:--------------------------------------------------------- TRSRCE1A.19
SUBROUTINE TRSRCE( 4TRSRCE1A.20
& DAKH,DBKH, TRSRCE1A.21
& POINTS,PFIELD, TRSRCE1A.22
& PSTAR,TR,TRSCE,TIMESTEP,I_HOUR,I_MINUTE,AMP,ERROR AJS1F401.1489
&) TRSRCE1A.24
C AJS1F401.1490
IMPLICIT NONE TRSRCE1A.25
INTEGER TRSRCE1A.26
& POINTS ! IN No. of gridpoints being processed. TRSRCE1A.27
&,PFIELD ! IN No. of points in global field (at one TRSRCE1A.28
C ! vertical level). TRSRCE1A.29
&,I_HOUR ! IN Local time hour APC3F400.10
&,I_MINUTE ! IN Local time minute APC3F400.11
C AJS1F401.1491
REAL TRSRCE1A.30
& DAKH,DBKH ! IN Layer thickness in terms of ak and bk TRSRCE1A.31
&,PSTAR(PFIELD) TRSRCE1A.32
&,TR(PFIELD) ! INOUT Tracer field TRSRCE1A.33
C ! (kg per kg air). TRSRCE1A.34
&,TRSCE(PFIELD) ! IN Tracer source field TRSRCE1A.35
C ! (kg per kg air per s). TRSRCE1A.36
&,TIMESTEP ! IN Timestep in seconds TRSRCE1A.37
&,AMP ! IN Amplitude of diurnal variation of emission AJS1F401.1492
C AJS1F401.1493
INTEGER ERROR ! OUT Error return code. TRSRCE1A.38
*CALL C_G 
TRSRCE1A.39
*CALL C_PI APC3F400.12
C TRSRCE1A.40
C*L Workspace usage---------------------------------------------------- TRSRCE1A.41
C*L External subroutine called ---------------------------------------- TRSRCE1A.42
C None TRSRCE1A.43
C EXTERNAL TRSRCE1A.44
C* Local, including SAVE'd, storage------------------------------------ TRSRCE1A.45
C TRSRCE1A.46
C (a) Scalars effectively expanded to workspace by the Cray (using TRSRCE1A.47
C vector registers). TRSRCE1A.48
REAL TRSRCE1A.49
& DM,FACTOR,TS TRSRCE1A.50
PARAMETER (FACTOR=1.0) ! Factor to multiply source term. TRSRCE1A.51
REAL TIME, TZERO AJS1F401.1494
PARAMETER (TZERO=12.0) ! Time of maximum emissions APC3F400.14
C TRSRCE1A.52
C (b) Others. TRSRCE1A.53
INTEGER I ! Loop counters: K - vertical level index. TRSRCE1A.54
C----------------------------------------------------------------------- TRSRCE1A.55
C Check input arguments for potential over-writing problems. TRSRCE1A.56
C----------------------------------------------------------------------- TRSRCE1A.57
ERROR=0 TRSRCE1A.58
IF(POINTS.GT.PFIELD)THEN TRSRCE1A.59
ERROR=1 TRSRCE1A.60
GOTO 9999 TRSRCE1A.61
ENDIF TRSRCE1A.62
C TRSRCE1A.63
C----------------------------------------------------------------------- TRSRCE1A.64
CL Subroutine structure : TRSRCE1A.65
CL Loop over field adding source term*timestep/level mass/unit area. TRSRCE1A.66
C----------------------------------------------------------------------- TRSRCE1A.67
C TRSRCE1A.68
C TRSRCE1A.69
C APC3F400.16
C Allow for source varying with time of day APC3F400.17
C APC3F400.18
TS=1.0 APC3F400.19
IF (AMP .GT. 0.0) THEN APC3F400.20
TS = 1.0 + APC3F400.21
& AMP*COS( (REAL(I_HOUR) + REAL(I_MINUTE)/60.0-TZERO) * PI/12.0) APC3F400.22
ENDIF APC3F400.23
TS = TS * TIMESTEP * FACTOR APC3F400.24
DO I=1,POINTS TRSRCE1A.71
DM = ABS((DAKH + PSTAR(I) * DBKH ) / G) ! DAKH,DBKH -ve TRSRCE1A.72
TR(I) = TR(I) + TRSCE(I)*TS/DM TRSRCE1A.73
ENDDO ! Loop over points TRSRCE1A.74
C TRSRCE1A.75
9999 CONTINUE ! Error exit TRSRCE1A.76
RETURN TRSRCE1A.77
END TRSRCE1A.78
*ENDIF TRSRCE1A.79