*IF DEF,C92_1A VINTZH1A.2
C ******************************COPYRIGHT****************************** GTS2F400.11719
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.11720
C GTS2F400.11721
C Use, duplication or disclosure of this code is subject to the GTS2F400.11722
C restrictions as set forth in the contract. GTS2F400.11723
C GTS2F400.11724
C Meteorological Office GTS2F400.11725
C London Road GTS2F400.11726
C BRACKNELL GTS2F400.11727
C Berkshire UK GTS2F400.11728
C RG12 2SZ GTS2F400.11729
C GTS2F400.11730
C If no contract has been raised with this copy of the code, the use, GTS2F400.11731
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.11732
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.11733
C Modelling at the above address. GTS2F400.11734
C ******************************COPYRIGHT****************************** GTS2F400.11735
C GTS2F400.11736
CLL SUBROUTINE V_INT_ZH---------------------------------------------- VINTZH1A.3
CLL VINTZH1A.4
CLL Purpose: Calculates height of each layer boundary (half level) VINTZH1A.5
CLL using the hydrostatic approximation. VINTZH1A.6
CLL VINTZH1A.7
CLL A.Dickinson <- programmer of some or all of previous code or changes VINTZH1A.8
CLL D.Robinson <- programmer of some or all of previous code or changes VINTZH1A.9
CLL VINTZH1A.10
CLL Model Modification history from model version 3.0: VINTZH1A.11
CLL version Date VINTZH1A.12
CLL VINTZH1A.13
CLL 4.2 16/07/96 THETAV made into scalar temporary. Saves GSS5F402.342
CLL dynamic memory allocation and memory accesses. GSS5F402.343
CLL GSS5F402.344
CLL Author: A. Dickinson Reviewer: R. Rawlins GSS5F402.345
CLL GSS5F402.346
CLL Programming standard : VINTZH1A.14
CLL VINTZH1A.15
CLL Logical components covered : D473 VINTZH1A.16
CLL VINTZH1A.17
CLL Project task : VINTZH1A.18
CLL VINTZH1A.19
CLL Documentation: The interpolation formulae are described in VINTZH1A.20
CLL unified model on-line documentation paper S1. VINTZH1A.21
CLL VINTZH1A.22
CLLEND ----------------------------------------------------------------- VINTZH1A.23
C VINTZH1A.24
C*L Arguments:------------------------------------------------------- VINTZH1A.25
SUBROUTINE V_INT_ZH 6VINTZH1A.26
*(P_EXNER_HALF,THETA,Q,PHI_STAR,ZH,POINTS,P_LEVELS,Q_LEVELS) GSS5F402.347
C ,START,END) ! These arguments not yet implemented GSS5F402.348
VINTZH1A.28
IMPLICIT NONE VINTZH1A.29
VINTZH1A.30
INTEGER VINTZH1A.31
* POINTS !IN Number of points to be processed VINTZH1A.32
*,P_LEVELS !IN Number of model levels VINTZH1A.33
*,Q_LEVELS !IN Number of wet levels VINTZH1A.34
*,START !IN First point to be processed in POINTS dimension GSS5F402.349
*,END !IN Last point to be processed in POINTS dimension GSS5F402.350
GSS5F402.351
VINTZH1A.35
REAL VINTZH1A.36
* P_EXNER_HALF(POINTS,P_LEVELS+1)!IN Exner pressure at model VINTZH1A.37
* ! half levels VINTZH1A.38
*,THETA(POINTS,P_LEVELS) !IN Potential temperature at full levels VINTZH1A.39
*,Q(POINTS,Q_LEVELS) !IN Specific humidity at full levels VINTZH1A.40
*,PHI_STAR(POINTS) !IN Geopotential height of topography VINTZH1A.41
*,ZH(POINTS,P_LEVELS+1) !OUT Height of model half levels VINTZH1A.42
VINTZH1A.43
C Workspace usage:----------------------------------------------------- VINTZH1A.44
C None GSS5F402.352
C---------------------------------------------------------------------- VINTZH1A.46
C External subroutines called:----------------------------------------- VINTZH1A.47
C None VINTZH1A.48
C*--------------------------------------------------------------------- VINTZH1A.49
C Define local variables:---------------------------------------------- VINTZH1A.50
INTEGER I,K VINTZH1A.51
REAL DEL_EXNER,THETAV GSS5F402.353
C---------------------------------------------------------------------- VINTZH1A.53
C Constants from comdecks:--------------------------------------------- VINTZH1A.54
*CALL C_EPSLON 
VINTZH1A.55
*CALL C_G VINTZH1A.56
*CALL C_R_CP VINTZH1A.57
C---------------------------------------------------------------------- VINTZH1A.58
VINTZH1A.59
CL 1. Define local constants and initialise height of first layer VINTZH1A.60
CL boundary. VINTZH1A.61
VINTZH1A.62
REAL ONE_OVER_G,CP_OVER_G VINTZH1A.63
PARAMETER(CP_OVER_G=CP/G) VINTZH1A.64
PARAMETER(ONE_OVER_G=1/G) VINTZH1A.65
VINTZH1A.66
C Height of orography in metres VINTZH1A.67
C Interim fix for START,END arguments GSS5F402.354
START=1 GSS5F402.355
END =POINTS GSS5F402.356
GSS5F402.357
DO 100 I=1,POINTS VINTZH1A.68
ZH(I,1)=ONE_OVER_G*PHI_STAR(I) VINTZH1A.69
100 CONTINUE VINTZH1A.70
VINTZH1A.71
CL 2. Compute height of remaining layer boundaries VINTZH1A.72
VINTZH1A.73
C Loop over wet levels GSS5F402.358
DO 200 K=1,Q_LEVELS GSS5F402.359
DO 210 I=START,END GSS5F402.360
VINTZH1A.76
C Calculate virtual potential temperature VINTZH1A.77
THETAV=THETA(I,K)*(1.0+C_VIRTUAL*Q(I,K)) GSS5F402.361
VINTZH1A.87
C Accumulate heights using equation (3.5) VINTZH1A.88
DEL_EXNER=P_EXNER_HALF(I,K)-P_EXNER_HALF(I,K+1) GSS5F402.362
ZH(I,K+1)=ZH(I,K)+CP_OVER_G*THETAV*DEL_EXNER GSS5F402.363
GSS5F402.364
210 CONTINUE GSS5F402.365
200 CONTINUE GSS5F402.366
C Loop over dry levels GSS5F402.367
DO 230 K=Q_LEVELS+1,P_LEVELS GSS5F402.368
DO 220 I=START,END GSS5F402.369
GSS5F402.370
C Accumulate heights using equation (3.5) GSS5F402.371
DEL_EXNER=P_EXNER_HALF(I,K)-P_EXNER_HALF(I,K+1) GSS5F402.372
ZH(I,K+1)=ZH(I,K)+CP_OVER_G*THETA(I,K)*DEL_EXNER GSS5F402.373
GSS5F402.374
220 CONTINUE GSS5F402.375
230 CONTINUE VINTZH1A.92
VINTZH1A.93
VINTZH1A.95
RETURN VINTZH1A.96
END VINTZH1A.97
VINTZH1A.98
VINTZH1A.99
*ENDIF VINTZH1A.100