*IF DEF,A11_1A TRAVAD1A.2
C ******************************COPYRIGHT****************************** GTS2F400.10567
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.10568
C GTS2F400.10569
C Use, duplication or disclosure of this code is subject to the GTS2F400.10570
C restrictions as set forth in the contract. GTS2F400.10571
C GTS2F400.10572
C Meteorological Office GTS2F400.10573
C London Road GTS2F400.10574
C BRACKNELL GTS2F400.10575
C Berkshire UK GTS2F400.10576
C RG12 2SZ GTS2F400.10577
C GTS2F400.10578
C If no contract has been raised with this copy of the code, the use, GTS2F400.10579
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.10580
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.10581
C Modelling at the above address. GTS2F400.10582
C ******************************COPYRIGHT****************************** GTS2F400.10583
C GTS2F400.10584
CLL SUBROUTINE TRAC_VERT_ADV TRAVAD1A.3
CLL TRAVAD1A.4
CLL PURPOSE: CALCULATES VERTICAL ADVECTION INCREMENTS TO A FIELD AT A TRAVAD1A.5
CLL SINGLE MODEL LEVEL USING A POSITIVE DEFINITE SCHEME. TRAVAD1A.6
CLL IN CALCULATING THE INCREMENTS THE TEST FOR THE TRAVAD1A.7
CLL DIRECTION OF THE WIND HAS BEEN REVERSED TO TAKE INTO TRAVAD1A.8
CLL ACCOUNT THE CHANGE IN SIGN INTRODUCED BY MASS TRAVAD1A.9
CLL WEIGHTING. TRAVAD1A.10
CLL SUITABLE FOR SINGLE COLUMN USE. TRAVAD1A.11
CLL TRAVAD1A.12
CLL M.MAWSON <- PROGRAMMER OF SOME OR ALL OF PREVIOUS CODE OR CHANGES TRAVAD1A.13
CLL TRAVAD1A.14
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: TRAVAD1A.15
CLL VERSION DATE TRAVAD1A.16
CLL 4.0 1/8/95 TOP LEVEL FLUXES AND LIMITERS MODIFIED ATD1F400.334
CLL FOR TRACER VERTICAL ADVECTION. T DAVIES ATD1F400.335
!LL 4.5 23/6/98 Optimisation changes GPB7F405.136
!LL D.Salmond, B.Carruthers and P.Burton GPB7F405.137
CLL TRAVAD1A.17
CLL PROGRAMMING STANDARD: UNIFIED MODEL DOCUMENTATION PAPER NO. 4, TRAVAD1A.18
CLL STANDARD B. TRAVAD1A.19
CLL TRAVAD1A.20
CLL SYSTEM COMPONENTS COVERED: P123 TRAVAD1A.21
CLL TRAVAD1A.22
CLL SYSTEM TASK: P1 TRAVAD1A.23
CLL TRAVAD1A.24
CLL DOCUMENTATION: U. M. Doc Paper 11 by M.J.P. Cullen TRAVAD1A.25
CLL TRAVAD1A.26
CLLEND----------------------------------------------------------------- TRAVAD1A.27
TRAVAD1A.28
C TRAVAD1A.29
C*L ARGUMENTS:------------------------------------------------------- TRAVAD1A.30
SUBROUTINE TRAC_VERT_ADV 17TRAVAD1A.31
& (FIELD,ETADOT,PSTAR, P_FIELD, TRAVAD1A.32
& ADVECTION_TIMESTEP,START_LEVEL,END_LEVEL, TRAVAD1A.33
& FIRST_POINT,POINTS,P_LEVELS, TRAVAD1A.34
& TR_FIRST_LEVEL,TR_LAST_LEVEL, TRAVAD1A.35
& RS,AK,BK,DELTA_AK,DELTA_BK, TRAVAD1A.36
& FIELD_LOWER_BOUNDARY, ATD1F400.336
& L_TRACER_THETAL_QT,L_SUPERBEE) ATD1F400.337
TRAVAD1A.38
IMPLICIT NONE TRAVAD1A.39
TRAVAD1A.40
LOGICAL TRAVAD1A.41
& L_SUPERBEE !IN True then use SUPERBEE limiter, TRAVAD1A.42
& ! False then use VAN LEER limiter. TRAVAD1A.43
& , L_TRACER_THETAL_QT ! TRUE IF USING TRACER ADVECTION FOR ATD1F400.338
& ! THETAL AND QT ATD1F400.339
TRAVAD1A.44
INTEGER TRAVAD1A.45
& P_FIELD !IN DIMENSION OF FIELDS ON PRESSURE GRID. TRAVAD1A.46
&,FIRST_POINT !IN FIRST POINT TO BE UPDATED TRAVAD1A.47
&,POINTS !IN NO. OF POINTS TO BE UPDATED TRAVAD1A.48
&,P_LEVELS !IN NUMBER OF P LEVELS TRAVAD1A.49
&,TR_FIRST_LEVEL !IN BOTTOM LEVEL FOR WHICH TRACER DEFINED TRAVAD1A.50
&,TR_LAST_LEVEL !IN TOP LEVEL FOR WHICH TRACER DEFINED TRAVAD1A.51
&,START_LEVEL !IN BOTTOM LEVEL FOR WHICH TRACER ADVECTED TRAVAD1A.52
&,END_LEVEL !IN TOP LEVEL FOR WHICH TRACER ADVECTED TRAVAD1A.53
TRAVAD1A.54
REAL TRAVAD1A.55
& PSTAR(P_FIELD) !IN SURFACE PRESSURE TRAVAD1A.56
&,ETADOT(P_FIELD,P_LEVELS) !IN ADVECTING ETADOT FIELD, TRAVAD1A.57
& ! MASS-WEIGHTED TRAVAD1A.58
&,FIELD(P_FIELD,TR_LAST_LEVEL+1-TR_FIRST_LEVEL) !IN FIELD TO BE TRAVAD1A.59
& ! ADVECTED. TRAVAD1A.60
&,ADVECTION_TIMESTEP !IN TRAVAD1A.61
TRAVAD1A.62
REAL TRAVAD1A.63
& AK(P_LEVELS) !IN TRAVAD1A.64
&,BK(P_LEVELS) !IN TRAVAD1A.65
&,DELTA_AK(P_LEVELS) !IN TRAVAD1A.66
&,DELTA_BK(P_LEVELS) !IN TRAVAD1A.67
&,RS(P_FIELD,P_LEVELS) !IN TRAVAD1A.68
&,FIELD_LOWER_BOUNDARY(P_FIELD) !IN TRAVAD1A.69
TRAVAD1A.70
C*--------------------------------------------------------------------- TRAVAD1A.71
TRAVAD1A.72
C*L DEFINE ARRAYS AND VARIABLES USED IN THIS ROUTINE----------------- TRAVAD1A.73
C DEFINE LOCAL ARRAYS: 25 ARE REQUIRED TRAVAD1A.74
TRAVAD1A.75
REAL TRAVAD1A.76
& FLUX_DELTA_T(P_FIELD,-1:+1) ! FLUX * ADVECTION TIMESTEP GPB7F405.138
&,B1(P_FIELD,-1:+1) ! ARGUMENT OF B_TERM GPB7F405.139
&,B2(P_FIELD) ! ARGUMENT OF B_TERM TRAVAD1A.79
&,B_TERM(P_FIELD) ! TRAVAD1A.80
&,COURANT(P_FIELD,-1:+1) ! COURANT NUMBER GPB7F405.140
&,ABS_COURANT(P_FIELD,-1:+1) ! ABSOLUTE VALUE OF COURANT NUMBER GPB7F405.141
&,COURANT_MW(P_FIELD,-1:+1) ! MASS WEIGHTED COURANT NUMBER GPB7F405.142
&,RS_SQUARED_DELTAP(P_FIELD) ! TRAVAD1A.89
&,MW(P_FIELD,-1:+1) ! MASS WEIGHT GPB7F405.143
&,FIELD_INC(P_FIELD,-1:+1) ! GPB7F405.144
&,RS_SQUARED_DELTAP_RECIP(P_FIELD,-1:+1) GPB7F405.145
&,B_SWITCH(P_FIELD) ! ENTROPY CONDITION SWITCH. TRAVAD1A.101
GPB7F405.146
LOGICAL GPB7F405.147
& COURANT_MW_GE_0(P_FIELD) GPB7F405.148
C*--------------------------------------------------------------------- TRAVAD1A.102
C DEFINE LOCAL VARIABLES TRAVAD1A.103
TRAVAD1A.104
INTEGER TRAVAD1A.105
& START_P_UPDATE ! FIRST P POINT TO BE UPDATED ATD1F400.340
&,END_P_UPDATE ! LAST P POINT TO BE UPDATED TRAVAD1A.108
&,TR_LEVEL ! LEVEL INDEX FOR TRACER FIELD TRAVAD1A.109
&,LEVEL ! LEVEL INDEX TRAVAD1A.110
TRAVAD1A.111
C COUNT VARIABLES FOR DO LOOPS ETC. TRAVAD1A.112
TRAVAD1A.113
INTEGER TRAVAD1A.114
& I,IM,I0,IP,ITM,II GPB7F405.149
c GPB7F405.150
integer saved_levels(3), saved_levels_loc(2) GPB7F405.151
c GPB7F405.152
equivalence (saved_levels(1), im) GPB7F405.153
equivalence (saved_levels(2), i0) GPB7F405.154
equivalence (saved_levels(3), ip) GPB7F405.155
TRAVAD1A.116
C*L NO EXTERNAL SUBROUTINE CALLS:------------------------------------ TRAVAD1A.117
C*--------------------------------------------------------------------- TRAVAD1A.118
TRAVAD1A.119
C CALL COMDECK FOR RADIUS OF EARTH TRAVAD1A.120
*CALL C_R_CP 
TRAVAD1A.121
TRAVAD1A.122
CL--------------------------------------------------------------------- TRAVAD1A.123
CL INTERNAL STRUCTURE. TRAVAD1A.124
CL--------------------------------------------------------------------- TRAVAD1A.125
CL TRAVAD1A.126
CL--------------------------------------------------------------------- TRAVAD1A.127
CL SECTION 0. INITIALISATION TRAVAD1A.128
CL--------------------------------------------------------------------- TRAVAD1A.129
TRAVAD1A.130
START_P_UPDATE = FIRST_POINT TRAVAD1A.131
END_P_UPDATE = START_P_UPDATE + POINTS - 1 TRAVAD1A.132
TRAVAD1A.133
IM=-1 GPB7F405.156
I0=0 GPB7F405.157
IP=+1 GPB7F405.158
GPB7F405.159
saved_levels_loc(1)=1 GPB7F405.160
saved_levels_loc(2)=3 GPB7F405.161
GPB7F405.162
CL TRAVAD1A.134
CL--------------------------------------------------------------------- TRAVAD1A.135
CL SECTION 1. CALCULATE FIELD INCREMENTS FOR VERTICAL ADVECTION TRAVAD1A.136
CL--------------------------------------------------------------------- TRAVAD1A.137
TRAVAD1A.138
DO I=START_P_UPDATE,END_P_UPDATE TRAVAD1A.139
RS_SQUARED_DELTAP(I) = RS(I,1)*RS(I,1)* TRAVAD1A.140
& (DELTA_AK(1)+DELTA_BK(1)*PSTAR(I)) TRAVAD1A.141
RS_SQUARED_DELTAP_RECIP(I,IP)=1./RS_SQUARED_DELTAP(I) GPB7F405.163
MW(I,IP) = RS_SQUARED_DELTAP(I) GPB7F405.164
ENDDO GPB7F405.165
DO I=START_P_UPDATE,END_P_UPDATE GPB7F405.166
COURANT_MW(I,IP) = 0.0 GPB7F405.167
COURANT(I,IP) = 0.0 GPB7F405.168
END DO TRAVAD1A.146
TRAVAD1A.147
C LOOP OVER LAYER BOUNDARIES, EXCEPT TOP AND BOTTOM ZONAL ADVECTIVE TRAVAD1A.148
C FLUX ASSUMED AT TOP AND BOTTOM TRACER LEVEL TRAVAD1A.149
TRAVAD1A.150
DO LEVEL=START_LEVEL-1,END_LEVEL TRAVAD1A.151
GPB7F405.169
IF(LEVEL.NE.START_LEVEL-1) THEN GPB7F405.170
ITM=IM GPB7F405.171
IM=I0 GPB7F405.172
I0=IP GPB7F405.173
IP=ITM GPB7F405.174
ENDIF GPB7F405.175
GPB7F405.176
TR_LEVEL=LEVEL+1-TR_FIRST_LEVEL TRAVAD1A.152
TRAVAD1A.153
CL Copy values of B1,FLUX_DELTA_T,COURANT_MW into position for TRAVAD1A.154
CL next level TRAVAD1A.155
TRAVAD1A.156
C---------------------------------------------------------------------- TRAVAD1A.157
CL SECTION 1.1 TRAVAD1A.158
C---------------------------------------------------------------------- TRAVAD1A.159
TRAVAD1A.160
C---------------------------------------------------------------------- TRAVAD1A.183
CL SECTION 1.2 CALCULATE COURANT NUMBER TRAVAD1A.184
C---------------------------------------------------------------------- TRAVAD1A.185
TRAVAD1A.186
IF(LEVEL.GT.0) THEN TRAVAD1A.187
IF(LEVEL.EQ.START_LEVEL-1) THEN TRAVAD1A.188
DO I=START_P_UPDATE,END_P_UPDATE TRAVAD1A.189
RS_SQUARED_DELTAP(I)=RS(I,LEVEL+1)*RS(I,LEVEL+1)* TRAVAD1A.191
& (DELTA_AK(LEVEL+1)+DELTA_BK(LEVEL+1)*PSTAR(I)) TRAVAD1A.192
RS_SQUARED_DELTAP_RECIP(I,IP)=1./RS_SQUARED_DELTAP(I) GPB7F405.177
end do GPB7F405.178
do i=start_p_update,end_p_update GPB7F405.179
COURANT_MW(I,IP)=ETADOT(I,LEVEL+1) *ADVECTION_TIMESTEP GPB7F405.180
COURANT(I,IP) = COURANT_MW(I,IP)* GPB7F405.181
& RS_SQUARED_DELTAP_RECIP(I,IP) GPB7F405.182
END DO TRAVAD1A.196
ELSE IF(LEVEL.LT.P_LEVELS) THEN TRAVAD1A.197
DO I=START_P_UPDATE,END_P_UPDATE TRAVAD1A.198
MW(I,IP) = RS_SQUARED_DELTAP(I) GPB7F405.183
RS_SQUARED_DELTAP(I)=RS(I,LEVEL+1)*RS(I,LEVEL+1)* TRAVAD1A.201
& (DELTA_AK(LEVEL+1)+DELTA_BK(LEVEL+1)*PSTAR(I)) TRAVAD1A.202
MW(I,IP) = 0.5*(MW(I,IP)+RS_SQUARED_DELTAP(I)) GPB7F405.184
RS_SQUARED_DELTAP_RECIP(I,IP)=1./RS_SQUARED_DELTAP(I) GPB7F405.185
end do GPB7F405.186
do i=start_p_update,end_p_update GPB7F405.187
COURANT_MW(I,IP)=ETADOT(I,LEVEL+1) *ADVECTION_TIMESTEP GPB7F405.188
COURANT(I,IP) = COURANT_MW(I,IP) / MW(I,IP) GPB7F405.189
END DO TRAVAD1A.206
ELSE TRAVAD1A.207
DO I=START_P_UPDATE,END_P_UPDATE TRAVAD1A.208
COURANT(I,IP) = 0. GPB7F405.190
END DO TRAVAD1A.210
END IF TRAVAD1A.211
END IF TRAVAD1A.212
TRAVAD1A.213
C---------------------------------------------------------------------- TRAVAD1A.214
CL SECTION 1.3 CALCULATE FLUX_DELTA_T AND B1 TRAVAD1A.215
C---------------------------------------------------------------------- TRAVAD1A.216
TRAVAD1A.217
IF(LEVEL.EQ.START_LEVEL-1) THEN TRAVAD1A.218
DO I=START_P_UPDATE,END_P_UPDATE TRAVAD1A.219
FLUX_DELTA_T(I,IP)=(FIELD(I,TR_LEVEL+1) GPB7F405.191
! & - FIELD_LOWER_BOUNDARY(I))* GPB7F405.192
& )* GPB7F405.193
& COURANT_MW(I,IP) GPB7F405.194
END DO TRAVAD1A.223
ELSE IF(LEVEL.EQ.P_LEVELS.OR.LEVEL.EQ.TR_LAST_LEVEL) THEN TRAVAD1A.224
DO I=START_P_UPDATE,END_P_UPDATE TRAVAD1A.225
FLUX_DELTA_T(I,IP)=0 GPB7F405.195
END DO TRAVAD1A.227
ELSE TRAVAD1A.228
DO I=START_P_UPDATE,END_P_UPDATE TRAVAD1A.229
FLUX_DELTA_T(I,IP) = (FIELD(I,TR_LEVEL+1)- GPB7F405.196
& FIELD(I,TR_LEVEL)) * COURANT_MW(I,IP) GPB7F405.197
END DO TRAVAD1A.232
END IF TRAVAD1A.233
TRAVAD1A.234
DO I= START_P_UPDATE,END_P_UPDATE TRAVAD1A.235
ABS_COURANT(I,IP) = ABS(COURANT(I,IP)) GPB7F405.198
B1(I,IP)=FLUX_DELTA_T(I,IP)*0.5* GPB7F405.199
& (1.0-ABS_COURANT(I,IP)) GPB7F405.200
END DO TRAVAD1A.239
TRAVAD1A.240
CL End of calculation for first pass through loop. TRAVAD1A.241
CL Remaining calculations can only be carried out if B1 is available TRAVAD1A.242
CL for 3 consecutive levels. TRAVAD1A.243
TRAVAD1A.244
IF(LEVEL.GT.START_LEVEL) THEN TRAVAD1A.245
TRAVAD1A.246
DO I=START_P_UPDATE,END_P_UPDATE GPB7F405.201
COURANT_MW_GE_0(I)=(COURANT_MW(I,I0).GE.0.0) GPB7F405.202
ENDDO GPB7F405.203
GPB7F405.204
C---------------------------------------------------------------------- TRAVAD1A.247
CL SECTION 1.4 CALCULATE B2 TRAVAD1A.248
C---------------------------------------------------------------------- TRAVAD1A.249
TRAVAD1A.250
IF(LEVEL.EQ.END_LEVEL) THEN TRAVAD1A.251
DO I=START_P_UPDATE,END_P_UPDATE TRAVAD1A.252
B2(I) = FLUX_DELTA_T(I,IM)*0.5*(MW(I,I0)/MW(I,IM)- GPB7F405.205
& ABS_COURANT(I,IM)) GPB7F405.206
B_SWITCH(I) = SIGN(1.,COURANT(I,I0)*COURANT(I,IM)) GPB7F405.207
IF (COURANT_MW_GE_0(I)) THEN GPB7F405.208
B2(I) = 0.0 TRAVAD1A.257
B_SWITCH(I) = 1.0 TRAVAD1A.258
END IF TRAVAD1A.259
END DO TRAVAD1A.260
ELSE TRAVAD1A.261
DO I=START_P_UPDATE,END_P_UPDATE TRAVAD1A.262
ii=max(0, nint(sign(1.0, courant_mw(i, i0)))) GPB7F405.209
ii=saved_levels(saved_levels_loc(ii+1)) GPB7F405.210
B2(I)=FLUX_DELTA_T(I,ii)*0.5*(MW(I,I0)/MW(I,ii)- GPB7F405.211
& ABS_COURANT(I,ii)) GPB7F405.212
end do GPB7F405.213
do i=start_p_update,end_p_update GPB7F405.214
ii=max(0, nint(sign(1.0, courant_mw(i, i0)))) GPB7F405.215
ii=saved_levels(saved_levels_loc(ii+1)) GPB7F405.216
B_SWITCH(I) = SIGN(1.,COURANT(I,I0)*COURANT(I,ii)) GPB7F405.217
END DO TRAVAD1A.271
END IF TRAVAD1A.272
TRAVAD1A.273
C---------------------------------------------------------------------- TRAVAD1A.274
CL SECTION 1.5 CALCULATE B_TERM TRAVAD1A.275
C---------------------------------------------------------------------- TRAVAD1A.276
TRAVAD1A.277
IF(L_SUPERBEE) THEN TRAVAD1A.278
CL SUPERBEE LIMITER. TRAVAD1A.279
TRAVAD1A.280
DO I=START_P_UPDATE,END_P_UPDATE TRAVAD1A.281
IF(ABS(B2(I)).GT.1.0E-8) THEN TRAVAD1A.282
B_SWITCH(I) = B_SWITCH(I) * B1(I,I0)/B2(I) GPB7F405.218
IF(B_SWITCH(I).GT.0.5.AND.B_SWITCH(I).LT.2.0) THEN GPB7F405.219
B_TERM(I) = B2(I) * MAX(B_SWITCH(I),1.0) GPB7F405.220
ELSE IF (B_SWITCH(I).LE.0.0) THEN GPB7F405.221
B_TERM(I) = 0.0 GPB7F405.222
ELSE GPB7F405.223
B_TERM(I) = 2.0 * B2(I) * MIN(B_SWITCH(I),1.0) GPB7F405.224
END IF GPB7F405.225
ELSE TRAVAD1A.284
B_SWITCH(I) = 0.0 TRAVAD1A.285
B_TERM(I) = 0.0 GPB7F405.226
END IF TRAVAD1A.286
END DO TRAVAD1A.287
TRAVAD1A.288
ELSE TRAVAD1A.299
TRAVAD1A.300
CL VAN LEER LIMITER. TRAVAD1A.301
TRAVAD1A.302
C LOOP OVER ALL POINTS TRAVAD1A.303
DO I=START_P_UPDATE,END_P_UPDATE TRAVAD1A.304
B_TERM(I) = 0.0 TRAVAD1A.305
IF (B1(I,I0)*B2(I)*B_SWITCH(I).GT.0.0) GPB7F405.227
& B_TERM(I) = 2.0*B1(I,I0)*B2(I)*B_SWITCH(I)/ GPB7F405.228
& (B1(I,I0)+B2(I)*B_SWITCH(I)) GPB7F405.229
END DO TRAVAD1A.309
TRAVAD1A.310
END IF TRAVAD1A.311
TRAVAD1A.312
C---------------------------------------------------------------------- TRAVAD1A.313
CL SECTION 1.6 CALCULATE INCREMENTS TO FIELD TRAVAD1A.314
C---------------------------------------------------------------------- TRAVAD1A.315
TRAVAD1A.316
CDIR$ IVDEP TRAVAD1A.317
IF( L_TRACER_THETAL_QT) THEN ATD1F400.341
CL FOR TRACER ADVECTION OF THETAL & QT MODIFY TOP LEVEL LIMITER TO ATD1F400.342
CL LOOK LIKE CENTRED SCHEME INCREMENT. ATD1F400.343
IF(LEVEL.GE.P_LEVELS)THEN ATD1F400.344
DO I=START_P_UPDATE,END_P_UPDATE ATD1F400.345
B_TERM(I)=0.5*FLUX_DELTA_T(I,I0) GPB7F405.230
END DO ATD1F400.347
ENDIF ATD1F400.348
ENDIF ATD1F400.349
TRAVAD1A.318
DO I=START_P_UPDATE,END_P_UPDATE TRAVAD1A.319
IF (COURANT_MW_GE_0(I)) THEN GPB7F405.231
FIELD_INC(I,I0) = B_TERM(I)-FLUX_DELTA_T(I,I0) GPB7F405.232
FIELD_INC(I,IP) = -B_TERM(I) GPB7F405.233
ELSE GPB7F405.234
FIELD_INC(I,I0) = - B_TERM(I) GPB7F405.235
FIELD_INC(I,IP) = B_TERM(I)-FLUX_DELTA_T(I,I0) GPB7F405.236
ENDIF GPB7F405.237
END DO TRAVAD1A.323
TRAVAD1A.324
TRAVAD1A.332
C---------------------------------------------------------------------- TRAVAD1A.333
CL SECTION 1.7 UPDATE FIELD TRAVAD1A.334
C---------------------------------------------------------------------- TRAVAD1A.335
TRAVAD1A.336
DO I=START_P_UPDATE,END_P_UPDATE TRAVAD1A.337
FIELD(I,TR_LEVEL-1) = FIELD(I,TR_LEVEL-1) + FIELD_INC(I,I0)* GPB7F405.238
& RS_SQUARED_DELTAP_RECIP(I,IM) GPB7F405.239
FIELD(I,TR_LEVEL) = FIELD(I,TR_LEVEL) + TRAVAD1A.340
& FIELD_INC(I,IP) * GPB7F405.240
& RS_SQUARED_DELTAP_RECIP(I,I0) GPB7F405.241
END DO TRAVAD1A.343
TRAVAD1A.344
END IF TRAVAD1A.345
TRAVAD1A.346
CL End loop over levels TRAVAD1A.347
TRAVAD1A.348
END DO TRAVAD1A.349
TRAVAD1A.350
CL END OF ROUTINE TRAC_VERT_ADV TRAVAD1A.351
TRAVAD1A.352
RETURN TRAVAD1A.353
END TRAVAD1A.354
*ENDIF TRAVAD1A.355