*IF DEF,A03_3A,OR,DEF,A03_5A,OR,DEF,A03_5B,OR,DEF,A03_7A,OR,DEF,A03_6A ARN1F404.1
C ******************************COPYRIGHT****************************** GTS2F400.12187
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.12188
C GTS2F400.12189
C Use, duplication or disclosure of this code is subject to the GTS2F400.12190
C restrictions as set forth in the contract. GTS2F400.12191
C GTS2F400.12192
C Meteorological Office GTS2F400.12193
C London Road GTS2F400.12194
C BRACKNELL GTS2F400.12195
C Berkshire UK GTS2F400.12196
C RG12 2SZ GTS2F400.12197
C GTS2F400.12198
C If no contract has been raised with this copy of the code, the use, GTS2F400.12199
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.12200
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.12201
C Modelling at the above address. GTS2F400.12202
C ******************************COPYRIGHT****************************** GTS2F400.12203
C GTS2F400.12204
C*LL SUBROUTINE Z ----------------------------------------------------- Z1A.3
CLL Z1A.4
CLL Purpose: Calculate virtual temperature at one model level, and Z1A.5
CLL depth of layer containing this level, and height of Z1A.6
CLL the top of this layer. Z1A.7
CLL Z1A.8
CLL Suitable for Single Column use. Z1A.9
CLL Z1A.10
CLL Model Modification history from model version 3.0: Z1A.11
CLL version date Z1A.12
CLL 3.4 20/04/94 DEF TIMER replaced by LOGICAL LTIMER ASJ1F304.412
CLL Argument LTIMER added ASJ1F304.413
CLL S.J.Swarbrick ASJ1F304.414
CLL Z1A.13
CLL ASJ1F304.415
CLL Programming standard: Unified Model Documentation Paper No 4, Z1A.14
CLL Version 2, dates 18/1/90. Z1A.15
CLL Z1A.16
CLL System component covered: ancillary to P24. Z1A.17
CLL Z1A.18
CLL Documentation: UM Documentation Paper 24, section P243. Z1A.19
CLL See especially Appendix A. Z1A.20
CLL Z1A.21
C*---------------------------------------------------------------------- Z1A.22
C*L Z1A.23
C----------------------------------------------------------------------- Z1A.24
CL Arguments :- Z1A.25
C----------------------------------------------------------------------- Z1A.26
SUBROUTINE Z ( 5,2Z1A.27
+ POINTS Z1A.28
+,EXNER_LOWER,EXNER_UPPER,PSTAR,AKH,BKH,Q,QCF,QCL,T,Z_LOWER Z1A.29
+,TV,Z_UPPER,DELTA_Z,DELTA_Z_LOWER,LTIMER ASJ1F304.416
+) Z1A.31
IMPLICIT NONE Z1A.32
LOGICAL LTIMER ASJ1F304.417
INTEGER Z1A.33
+ POINTS ! IN No of gridpoints being processed. Z1A.34
REAL Z1A.35
+ EXNER_LOWER(POINTS) ! IN Exner function for lower boundary of Z1A.36
C ! this layer. Z1A.37
+,EXNER_UPPER(POINTS) ! IN Exner function for upper boundary of Z1A.38
C ! this layer. Z1A.39
+,PSTAR(POINTS) ! IN surface pressure (Pa) Z1A.40
+,AKH(2) ! IN AK value at bottom and top of this layer Z1A.41
+,BKH(2) ! IN BK value at bottom and top of this layer Z1A.42
+,Q(POINTS) ! IN Sp humidity at this level (kg water Z1A.43
C ! per kg of air). Z1A.44
+,QCF(POINTS) ! IN Cloud ice at this level (kg per Z1A.45
C ! kg of air). Z1A.46
+,QCL(POINTS) ! IN Cloud liquid water at this level (kg Z1A.47
C ! per kg of air). Z1A.48
+,T(POINTS) ! IN Temperature at this level (K). Z1A.49
+,Z_LOWER(POINTS) ! IN Height above surface of lower boundary Z1A.50
C ! of this layer (metres). Z1A.51
REAL Z1A.52
+ TV(POINTS) ! OUT Virtual temperature for this level Z1A.53
C ! (K). Z1A.54
+,Z_UPPER(POINTS) ! OUT Height above surface of upper boundary Z1A.55
C ! of this layer (metres). Z1A.56
+,DELTA_Z(POINTS) ! OUT Depth of this layer (metres). Z1A.57
+,DELTA_Z_LOWER(POINTS) ! OUT Depth of lower half layer (metres). Z1A.58
C* Z1A.59
C*L Z1A.60
EXTERNAL TIMER Z1A.62
C* Z1A.64
C----------------------------------------------------------------------- Z1A.65
C*L Local and other parameters. Z1A.66
C----------------------------------------------------------------------- Z1A.67
*CALL C_EPSLON 
Z1A.68
*CALL C_G Z1A.69
*CALL C_R_CP Z1A.70
REAL CPRG Z1A.71
PARAMETER ( Z1A.72
+ CPRG=CP/G ! CP upon G. Z1A.73
+) Z1A.74
C* Z1A.75
C----------------------------------------------------------------------- Z1A.76
C Declare local variable. Z1A.77
C----------------------------------------------------------------------- Z1A.78
INTEGER Z1A.79
+ I ! Loop counter; horizontal field index. Z1A.80
C----------------------------------------------------------------------- Z1A.81
CL No significant structure. Z1A.82
C----------------------------------------------------------------------- Z1A.83
Z1A.84
REAL Z1A.85
& PU,PL Z1A.86
*CALL P_EXNERC Z1A.87
Z1A.88
IF (LTIMER) THEN ASJ1F304.418
CALL TIMER('Z ',3) Z1A.90
ENDIF ASJ1F304.419
DO 1 I=1,POINTS Z1A.92
C Z1A.93
C Calculate virtual temperature. Cf eqn P243.A2 (which calculates Z1A.94
C virtual potential temperature). Z1A.95
C ~~~~~~~~~ Z1A.96
TV(I) = T(I) * ( 1.0 + C_VIRTUAL*Q(I) - QCF(I) - QCL(I) ) Z1A.97
C Z1A.98
C Calculate layer depth, eqn P243.A3. Z1A.99
C Z1A.100
PU=PSTAR(I)*BKH(2) + AKH(2) Z1A.101
PL=PSTAR(I)*BKH(1) + AKH(1) Z1A.102
DELTA_Z(I) = CPRG * ( TV(I) / Z1A.103
+ P_EXNER_C( EXNER_UPPER(I),EXNER_LOWER(I),PU,PL,KAPPA) !Exner k Z1A.104
+ ) * Z1A.105
+ ( EXNER_LOWER(I) - EXNER_UPPER(I) ) ! -(Exner k+1/2 - k-1/2) Z1A.106
C Z1A.107
C Calculate lower half layer depth, eqn P243.A6. Z1A.108
C Z1A.109
DELTA_Z_LOWER(I) = CPRG * TV(I) * Z1A.110
+ ( EXNER_LOWER(I) / Z1A.111
+ P_EXNER_C( EXNER_UPPER(I),EXNER_LOWER(I),PU,PL,KAPPA) -1.) Z1A.112
C Z1A.113
C Calculate height of top of layer, eqn P243.A4. Z1A.114
C Z1A.115
Z_UPPER(I) = Z_LOWER(I) + DELTA_Z(I) Z1A.116
1 CONTINUE Z1A.117
IF (LTIMER) THEN ASJ1F304.420
CALL TIMER('Z ',4) Z1A.119
ENDIF ASJ1F304.421
RETURN Z1A.121
END Z1A.122
*ENDIF Z1A.123