*IF DEF,A16_1A ICAOHT1A.2
C ******************************COPYRIGHT****************************** GTS2F400.4249
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.4250
C GTS2F400.4251
C Use, duplication or disclosure of this code is subject to the GTS2F400.4252
C restrictions as set forth in the contract. GTS2F400.4253
C GTS2F400.4254
C Meteorological Office GTS2F400.4255
C London Road GTS2F400.4256
C BRACKNELL GTS2F400.4257
C Berkshire UK GTS2F400.4258
C RG12 2SZ GTS2F400.4259
C GTS2F400.4260
C If no contract has been raised with this copy of the code, the use, GTS2F400.4261
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.4262
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.4263
C Modelling at the above address. GTS2F400.4264
C ******************************COPYRIGHT****************************** GTS2F400.4265
C GTS2F400.4266
CLL SUBROUTINE ICAO_HT----------------------------------------- ICAOHT1A.3
CLL ICAOHT1A.4
CLL PURPOSE: Performs an interpolation from pressure levels to the ICAOHT1A.5
CLL I.C.A.O standard atmosphere heights. ICAOHT1A.6
CLL e.g. tropopause heights or max wind heights in ICAOHT1A.7
CLL thousands of feet ICAOHT1A.8
CLL Tested under compiler CFT77 ICAOHT1A.9
CLL Tested under OS version 5.1 ICAOHT1A.10
CLL ICAOHT1A.11
CLL Author J.T.Heming ICAOHT1A.12
CLL Code version 1.0 Date 04/12/90 ICAOHT1A.13
CLL ICAOHT1A.14
CLL Model Modification history from model version 3.0: ICAOHT1A.15
CLL version date ICAOHT1A.16
CLL ICAOHT1A.17
CLL Logical components covered D4 ICAOHT1A.18
CLL ICAOHT1A.19
CLL Project TASK: D4 ICAOHT1A.20
CLL ICAOHT1A.21
CLL Programming standard: U M DOC Paper NO. 4, ICAOHT1A.22
CLL ICAOHT1A.23
CLL External documentation ICAOHT1A.24
CLL ICAOHT1A.25
CLLEND------------------------------------------------------------------ ICAOHT1A.26
C ICAOHT1A.27
C*L ARGUMENTS:--------------------------------------------------------- ICAOHT1A.28
SUBROUTINE ICAO_HT( 10ICAOHT1A.29
& PRESS_IN,POINTS,ICAO_HEIGHT) ICAOHT1A.30
C----------------------------------------------------------------------- ICAOHT1A.31
IMPLICIT NONE ICAOHT1A.32
C----------------------------------------------------------------------- ICAOHT1A.33
INTEGER ICAOHT1A.34
* POINTS ! IN No. of points to be processed ICAOHT1A.35
C----------------------------------------------------------------------- ICAOHT1A.36
REAL ICAOHT1A.37
* PRESS_IN(POINTS) ! IN Pressures to be converted to ICAO heights ICAOHT1A.38
C----------------------------------------------------------------------- ICAOHT1A.39
REAL ICAOHT1A.40
* ICAO_HEIGHT(POINTS) ! OUT ICAO height in thousands of feet ICAOHT1A.41
C*---------------------------------------------------------------------- ICAOHT1A.42
*CALL C_MDI 
ICAOHT1A.43
C ICAOHT1A.44
C*L WORKSPACE USAGE----------------------------------------------------- ICAOHT1A.45
C DEFINE LOCAL WORKSPACE ARRAYS ICAOHT1A.46
REAL ICAOHT1A.47
* PHST(15) ICAOHT1A.48
*,HST(15) ICAOHT1A.49
*,PRESSURE(POINTS) ! Local pressure array ICAOHT1A.50
C*---------------------------------------------------------------------- ICAOHT1A.51
C ICAOHT1A.52
C*L EXTERNAL SUBROUTINES CALLED----------------------------------------- ICAOHT1A.53
C NONE ICAOHT1A.54
C*---------------------------------------------------------------------- ICAOHT1A.55
C ICAOHT1A.56
C----------------------------------------------------------------------- ICAOHT1A.57
C*L DEFINE LOCAL VARIABLES ICAOHT1A.58
C----------------------------------------------------------------------- ICAOHT1A.59
INTEGER ICAOHT1A.60
* I,K ! LOOP COUNTERS ICAOHT1A.61
C----------------------------------------------------------------------- ICAOHT1A.62
REAL ICAOHT1A.63
* TERM1 ICAOHT1A.64
*,TERM2 ICAOHT1A.65
C----------------------------------------------------------------------- ICAOHT1A.66
LOGICAL ICAOHT1A.67
* FOUND(POINTS) ICAOHT1A.68
C* ICAOHT1A.69
C----------------------------------------------------------------------- ICAOHT1A.70
C*L DATA FOR LOCAL ARRAYS ICAOHT1A.71
C----------------------------------------------------------------------- ICAOHT1A.72
DATA PHST/101325.,95000.,85000.,70000.,50000.,40000.,30000., ICAOHT1A.73
+ 25000.,20000.,15000.,10000.,7000.,5000.,3000.,999./ ICAOHT1A.74
DATA HST/0.,2000.,5000.,10000.,18000.,24000.,30000.,34000., ICAOHT1A.75
+ 39000.,45000.,53000.,61000.,68000.,78000.,99000./ ICAOHT1A.76
C*---------------------------------------------------------------------- ICAOHT1A.77
C LOOP OVER ALL POINTS ICAOHT1A.78
C----------------------------------------------------------------------- ICAOHT1A.79
DO I=1,POINTS ICAOHT1A.80
PRESSURE(I)=PRESS_IN(I) ICAOHT1A.81
C----------------------------------------------------------------------- ICAOHT1A.82
CL 1. If the pressure is less than 10mb it is assumed to be 10mb ICAOHT1A.83
CL If pressure is greater than 1013.25mb it's assumed to be 1013.25mb ICAOHT1A.84
C----------------------------------------------------------------------- ICAOHT1A.85
IF(PRESSURE(I).LE.1000.AND.PRESSURE(I).GE.0.) PRESSURE(I)=1000. ICAOHT1A.86
IF(PRESSURE(I).GT.101325.) PRESSURE(I)=101325. ICAOHT1A.87
FOUND(I)=.FALSE. ICAOHT1A.88
ENDDO ICAOHT1A.89
C----------------------------------------------------------------------- ICAOHT1A.90
CL 2. FIND THE FIRST VALUE OF PHST THAT IS LESS THAN THE PRESSURE ICAOHT1A.91
C----------------------------------------------------------------------- ICAOHT1A.92
DO 1 K=1,14 ICAOHT1A.93
DO I=1,POINTS ICAOHT1A.94
C----------------------------------------------------------------------- ICAOHT1A.95
CL 3. If the pressure is set to missing data indicator, set ICAO height ICAOHT1A.96
CL to missing data indicator ICAOHT1A.97
C----------------------------------------------------------------------- ICAOHT1A.98
IF(PRESSURE(I).EQ.RMDI.AND.(.NOT.FOUND(I)))THEN ICAOHT1A.99
ICAO_HEIGHT(I)=RMDI ICAOHT1A.100
FOUND(I)=.TRUE. ICAOHT1A.101
ELSEIF((PHST(K+1).LT.PRESSURE(I)).AND.(.NOT.FOUND(I))) THEN ICAOHT1A.102
C----------------------------------------------------------------------- ICAOHT1A.103
CL 4. Calculate the ICAO height ICAOHT1A.104
C----------------------------------------------------------------------- ICAOHT1A.105
TERM1=(3*PHST(K)-PRESSURE(I))*(PRESSURE(I)-PHST(K)) ICAOHT1A.106
TERM2=(3*PHST(K)-PHST(K+1))*(PHST(K+1)-PHST(K)) ICAOHT1A.107
ICAO_HEIGHT(I)=((HST(K+1)-HST(K))*TERM1/TERM2+HST(K))*0.001 ICAOHT1A.108
FOUND(I)=.TRUE. ICAOHT1A.109
C----------------------------------------------------------------------- ICAOHT1A.110
ENDIF ICAOHT1A.111
ENDDO ICAOHT1A.112
1 CONTINUE ICAOHT1A.113
C----------------------------------------------------------------------- ICAOHT1A.114
RETURN ICAOHT1A.115
END ICAOHT1A.116
*ENDIF ICAOHT1A.117