*IF DEF,C90_1A,OR,DEF,C90_2A,OR,DEF,C90_2B,OR,DEF,RECON AAD2F404.291
C ******************************COPYRIGHT****************************** GTS2F400.739
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.740
C GTS2F400.741
C Use, duplication or disclosure of this code is subject to the GTS2F400.742
C restrictions as set forth in the contract. GTS2F400.743
C GTS2F400.744
C Meteorological Office GTS2F400.745
C London Road GTS2F400.746
C BRACKNELL GTS2F400.747
C Berkshire UK GTS2F400.748
C RG12 2SZ GTS2F400.749
C GTS2F400.750
C If no contract has been raised with this copy of the code, the use, GTS2F400.751
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.752
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.753
C Modelling at the above address. GTS2F400.754
C ******************************COPYRIGHT****************************** GTS2F400.755
C GTS2F400.756
CLL SUBROUTINE CALC_RS --------------------------------------------- CALCRS1A.3
CLL CALCRS1A.4
CLL PURPOSE: CALCULATES RS AS A FUNCTION OF PRESSURE USING CALCRS1A.5
CLL EQUATION (17) AND THE U.M. STANDARD ATMOSPHERE. CALCRS1A.6
CLL ALSO RETURNS U.M. STANDARD TEMPERATURE AT THE CALCRS1A.7
CLL INPUT PRESSURE. CALCRS1A.8
CLL CALCRS1A.9
CLL VERSION FOR CRAY Y-MP CALCRS1A.10
CLL NOT SUITABLE FOR I.B.M. USE. CALCRS1A.11
CLL CALCRS1A.12
CLL WRITTEN BY M.H MAWSON. CALCRS1A.13
CLL CALCRS1A.14
CLL MODEL MODIFICATION HISTORY FROM MODEL VERSION 3.0: CALCRS1A.15
CLL VERSION DATE CALCRS1A.16
CLL 3.1 24/02/93 Tidy code to remove QA Fortran messages. MM240293.1
CLL 3.4 26/05/94 Argument LLINTS added and passed to CALC_TS GSS1F304.158
CLL S.J.Swarbrick GSS1F304.159
CLL CALCRS1A.17
CLL PROGRAMMING STANDARD: UNIFIED MODEL DOCUMENTATION PAPER NO. 4, CALCRS1A.18
CLL STANDARD A. VERSION 2, DATED 18/01/90 CALCRS1A.19
CLL CALCRS1A.20
CLL LOGICAL COMPONENTS COVERED: P194 CALCRS1A.21
CLL CALCRS1A.22
CLL PROJECT TASK: P1 CALCRS1A.23
CLL CALCRS1A.24
CLL DOCUMENTATION: THE EQUATION USED IS (17) CALCRS1A.25
CLL IN UNIFIED MODEL DOCUMENTATION PAPER NO. 10 CALCRS1A.26
CLL M.J.P. CULLEN, T.DAVIES AND M.H.MAWSON, CALCRS1A.27
CLL VERSION 9, DATED 27/06/90. CALCRS1A.28
CLLEND------------------------------------------------------------- CALCRS1A.29
CALCRS1A.30
C*L ARGUMENTS:--------------------------------------------------- CALCRS1A.31
SUBROUTINE CALC_RS 21,5CALCRS1A.32
1 (PSTAR,AK,BK,TS,RS_LOWER,RS,POINTS,LEVEL_REQUESTED,LEVELS, GSS1F304.160
2 LLINTS) GSS1F304.161
CALCRS1A.34
IMPLICIT NONE CALCRS1A.35
LOGICAL LLINTS ! Logical switch for linear TS in CALC_TS GSS1F304.162
CALCRS1A.36
INTEGER CALCRS1A.37
* POINTS !IN. NUMBER OF POINTS OVER WHICH CALCULATION CALCRS1A.38
* !IS TO BE PERFORMED. CALCRS1A.39
*, LEVEL_REQUESTED !IN. MODEL LEVEL AT WHICH ROUTINE IS BEING CALCRS1A.40
* !PERFORMED. CALCRS1A.41
*, LEVELS !IN. NUMBER OF MODEL LEVELS CALCRS1A.42
CALCRS1A.43
REAL CALCRS1A.44
* PSTAR(POINTS) !IN. SURFACE PRESSURE VALUES. CALCRS1A.45
*, RS_LOWER(POINTS) !IN. HOLDS RS VALUES ONE LEVEL LOWER THAN CALCRS1A.46
* ! REQUESTED IN CALL. IF CALLED FROM LEVEL 1 CALCRS1A.47
* ! THEN HOLDS DUMMY VALUES AND IS NOT USED. CALCRS1A.48
*, AK(LEVELS) !IN. HOLDS AK VALUES AT PRESSURE LEVELS. CALCRS1A.49
*, BK(LEVELS) !IN. HOLDS BK VALUES AT PRESSURE LEVELS. CALCRS1A.50
CALCRS1A.51
REAL CALCRS1A.52
* RS(POINTS) !OUT. RS VALUES. NOTE THIS ARRAY HAS NO LEVELS CALCRS1A.53
* !UNLIKE RS IN OTHER ROUTINES. THE RETURNED VALUES CALCRS1A.54
* !ARE STORED IN THE LEVEL DETERMINED BY THE CALL. CALCRS1A.55
CALCRS1A.56
REAL CALCRS1A.57
* TS(POINTS) !INOUT. U.M. STANDARD TEMPERATURE AT PRESSURE P. CALCRS1A.58
C*--------------------------------------------------------------------- CALCRS1A.59
CALCRS1A.60
C*L DEFINE ARRAYS AND VARIABLES USED IN THIS ROUTINE----------------- CALCRS1A.61
CL 3 LOCAL ARRAYS NEEDED. CALCRS1A.62
REAL CALCRS1A.63
* P_LEVEL(POINTS) ! PRESSURE AT LEVEL_REQUESTED. CALCRS1A.64
*, P_LEVEL_MINUS1(POINTS) ! PRESSURE AT INPUT_REQUESTED MINUS 1 CALCRS1A.65
*, TS_LEVEL(POINTS) ! TS AT LEVEL_REQUESTED. CALCRS1A.66
C*--------------------------------------------------------------------- CALCRS1A.67
C REAL SCALARS CALCRS1A.68
REAL TS0_BY_P0 CALCRS1A.69
C COUNT VARIABLES FOR DO LOOPS CALCRS1A.70
INTEGER CALCRS1A.71
* I CALCRS1A.72
C LOGICAL VARIABLE CALCRS1A.73
LOGICAL CALCRS1A.74
* CONSTANT_PRESSURE ! SET TO TRUE IF LEVEL_REQUIRED IS A CALCRS1A.75
* ! CONSTANT PRESSURE LEVEL. CALCRS1A.76
CALCRS1A.77
C*L EXTERNAL SUBROUTINE CALLS:--------------------------------------- CALCRS1A.78
EXTERNAL CALC_TS CALCRS1A.79
C*--------------------------------------------------------------------- CALCRS1A.80
CL CALL COMDECK TO OBTAIN CONSTANTS USED. CALCRS1A.81
CALCRS1A.82
*CALL C_CALCRS 
CALCRS1A.83
CALCRS1A.84
CL MAXIMUM VECTOR LENGTH IS DETERMINED BY POINTS. CALCRS1A.85
CL CALCRS1A.86
CL--------------------------------------------------------------------- CALCRS1A.87
CL INTERNAL STRUCTURE INCLUDING SUBROUTINE CALLS: CALCRS1A.88
CL--------------------------------------------------------------------- CALCRS1A.89
CL CALCRS1A.90
CL ON A CALL TO CALC_TS EITHER SECTION 1 OR SECTION 2 IS USED CALCRS1A.91
CL DEPENDING ON WHETHER LEVEL_REQUESTED IS 1 OR NOT. CALCRS1A.92
CL CALCRS1A.93
CL--------------------------------------------------------------------- CALCRS1A.94
CALCRS1A.95
CL CHECK TO SEE IF LEVEL_REQUESTED IS A CONSTANT PRESSURE LEVEL. CALCRS1A.96
CALCRS1A.97
IF(BK(LEVEL_REQUESTED).EQ.0.) THEN CALCRS1A.98
CONSTANT_PRESSURE= .TRUE. CALCRS1A.99
ELSE CALCRS1A.100
CONSTANT_PRESSURE= .FALSE. CALCRS1A.101
END IF CALCRS1A.102
CL--------------------------------------------------------------------- CALCRS1A.103
CL SECTION 1. IF LEVEL_REQUESTED IS 1 CALCULATE RS USING CALCRS1A.104
CL EQUATION 17 WITH THE VALUES AT P0 BEING TAKEN FROM CALCRS1A.105
CL THE COMDECK. CALCRS1A.106
CL EITHER A) IF CONSTANT_PRESSURE USE SECTIONS 1.1 TO 1.3 CALCRS1A.107
CL OR B) IF NOT CONSTANT_PRESSURE THEN USE SECTIONS 1.4 - 1.6 CALCRS1A.108
CL CALCRS1A.109
CL NOTE THIS SECTION IS NOT VERY ACCURATE IF RUNNING CALCRS1A.110
CL STRATOSPHERIC MODEL. CALCRS1A.111
CL--------------------------------------------------------------------- CALCRS1A.112
CALCRS1A.113
CL A) CALCRS1A.114
IF(LEVEL_REQUESTED.EQ.1) THEN CALCRS1A.115
CALCRS1A.116
IF(CONSTANT_PRESSURE) THEN CALCRS1A.117
C---------------------------------------------------------------------- CALCRS1A.118
CL SECTION 1.1 STORE PRESSURE AT LEVEL 1 IN P_LEVEL(1) ONLY. CALCRS1A.119
CL THIS IS BECAUSE NO OTHER ADDRESSES IN P_LEVEL WILL BE CALCRS1A.120
CL ACCESSED. CALCRS1A.121
C---------------------------------------------------------------------- CALCRS1A.122
CALCRS1A.123
P_LEVEL(1) = AK(1) CALCRS1A.124
CALCRS1A.125
C---------------------------------------------------------------------- CALCRS1A.126
CL SECTION 1.2 CALL CALC_TS TO OBTAIN TS AT LEVEL 1. CALCRS1A.127
C---------------------------------------------------------------------- CALCRS1A.128
CALCRS1A.129
CALL CALC_TS(P_LEVEL,TS,POINTS,CONSTANT_PRESSURE,LLINTS) GSS1F304.163
CALCRS1A.131
C---------------------------------------------------------------------- CALCRS1A.132
CL SECTION 1.3 CALCULATE RS AT PRESSURE P USING EQUATION 17. CALCRS1A.133
C---------------------------------------------------------------------- CALCRS1A.134
CALCRS1A.135
CL RS IS CALCULATED FOR POINT 1 AND THEN RS(I) FOR CALCRS1A.136
CL I=2 TO POINTS IS SET EQUAL TO RS(1) CALCRS1A.137
RS(1)=A + HALF_R_OVER_G*(TS0 / P0 + TS(1)/P_LEVEL(1)) CALCRS1A.138
* *(P0-P_LEVEL(1)) CALCRS1A.139
DO 130 I=2,POINTS CALCRS1A.140
RS(I) = RS(1) CALCRS1A.141
130 CONTINUE CALCRS1A.142
CALCRS1A.143
CL B) CALCRS1A.144
ELSE CALCRS1A.145
C---------------------------------------------------------------------- CALCRS1A.146
CL SECTION 1.4 CALCULATE PRESSURE AT LEVEL 1. CALCRS1A.147
C---------------------------------------------------------------------- CALCRS1A.148
DO 140 I=1,POINTS CALCRS1A.149
P_LEVEL(I) = AK(1)+PSTAR(I)*BK(1) CALCRS1A.150
140 CONTINUE CALCRS1A.151
CALCRS1A.152
C---------------------------------------------------------------------- CALCRS1A.153
CL SECTION 1.5 CALL CALC_TS TO OBTAIN TS AT LEVEL 1. CALCRS1A.154
C---------------------------------------------------------------------- CALCRS1A.155
CALCRS1A.156
CALL CALC_TS(P_LEVEL,TS,POINTS,CONSTANT_PRESSURE,LLINTS) GSS1F304.164
CALCRS1A.158
C---------------------------------------------------------------------- CALCRS1A.159
CL SECTION 1.6 CALCULATE RS AT PRESSURE P USING EQUATION 17. CALCRS1A.160
C---------------------------------------------------------------------- CALCRS1A.161
CALCRS1A.162
TS0_BY_P0 = TS0 / P0 CALCRS1A.163
DO 160 I=1,POINTS CALCRS1A.164
RS(I)=A + HALF_R_OVER_G*( TS0_BY_P0+ TS(I)/P_LEVEL(I)) CALCRS1A.165
* *(P0-P_LEVEL(I)) CALCRS1A.166
160 CONTINUE CALCRS1A.167
CALCRS1A.168
ENDIF CALCRS1A.169
CALCRS1A.170
ELSE CALCRS1A.171
CL--------------------------------------------------------------------- CALCRS1A.172
CL SECTION 2. IF LEVEL_REQUESTED IS NOT 1 THEN CALCULATE CALCRS1A.173
CL INCREMENT TO RS BETWEEN PRESSURE AT LEVEL_REQUESTED CALCRS1A.174
CL MINUS 1 AND LEVEL_REQUESTED USING EQUATION 17 AND CALCRS1A.175
CL ADD ON TO RS AT LEVEL_REQUESTED MINUS 1. CALCRS1A.176
CL CALCRS1A.177
CL EITHER A) IF NOT CONSTANT_PRESSURE USE SECTIONS 2.1 TO 2.3. CALCRS1A.178
CL OR B) IF CONSTANT_PRESSURE BUT LEVEL_REQUESTED - 1 IS CALCRS1A.179
CL NOT CONSTANT PRESSURE THEN USE SECTIONS 2.4 TO 2.6 CALCRS1A.180
CL OR C) BOTH CONSTANT PRESSURE USE SECTIONS 2.7 TO 2.9. CALCRS1A.181
CL--------------------------------------------------------------------- CALCRS1A.182
CALCRS1A.183
CL A) CALCRS1A.184
IF(.NOT.CONSTANT_PRESSURE) THEN CALCRS1A.185
C---------------------------------------------------------------------- CALCRS1A.186
CL SECTION 2.1 CALCULATE PRESSURE AT LEVEL_REQUESTED AND CALCRS1A.187
CL LEVEL_REQUESTED MINUS 1. CALCRS1A.188
C---------------------------------------------------------------------- CALCRS1A.189
CALCRS1A.190
DO 210 I=1,POINTS CALCRS1A.191
P_LEVEL(I) = AK(LEVEL_REQUESTED) + BK(LEVEL_REQUESTED)* CALCRS1A.192
* PSTAR(I) CALCRS1A.193
P_LEVEL_MINUS1(I) = AK(LEVEL_REQUESTED-1) + CALCRS1A.194
* BK(LEVEL_REQUESTED-1)*PSTAR(I) CALCRS1A.195
210 CONTINUE CALCRS1A.196
CALCRS1A.197
C---------------------------------------------------------------------- CALCRS1A.198
CL SECTION 2.2 CALL CALC_TS TO GET TS AT LEVEL_REQUESTED AND STORE CALCRS1A.199
CL IN TS_LEVEL. CALCRS1A.200
C---------------------------------------------------------------------- CALCRS1A.201
CALCRS1A.202
CALL CALC_TS(P_LEVEL,TS_LEVEL,POINTS,CONSTANT_PRESSURE, GSS1F304.165
& LLINTS) GSS1F304.166
CALCRS1A.204
C---------------------------------------------------------------------- CALCRS1A.205
CL SECTION 2.3 CALCULATE INTEGRAL IN EQUATION 17 BETWEEN THE CALCRS1A.206
CL PRESSURES CALCULATED IN 2.1 AND ADD ONTO RS AT CALCRS1A.207
CL LEVEL_REQUESTED MINUS 1 TO GET VALUE AT CALCRS1A.208
CL LEVEL_REQUESTED. THEN OVER-WRITE OLD VALUE OF TS CALCRS1A.209
CL WITH VALUE CALCULATED IN CALL TO TS_CALC IN 2.2. CALCRS1A.210
C---------------------------------------------------------------------- CALCRS1A.211
CALCRS1A.212
DO 230 I=1,POINTS CALCRS1A.213
RS(I) = RS_LOWER(I) + (P_LEVEL_MINUS1(I)-P_LEVEL(I)) CALCRS1A.214
* *HALF_R_OVER_G*(TS(I)/P_LEVEL_MINUS1(I) + CALCRS1A.215
* TS_LEVEL(I)/P_LEVEL(I)) CALCRS1A.216
TS(I) = TS_LEVEL(I) CALCRS1A.217
230 CONTINUE CALCRS1A.218
CALCRS1A.219
ELSE IF(BK(LEVEL_REQUESTED-1).NE.0.) THEN MM240293.2
CALCRS1A.221
CL B) CALCRS1A.222
C---------------------------------------------------------------------- CALCRS1A.223
CL SECTION 2.4 CALCULATE PRESSURE AT LEVEL_REQUESTED-1 AT ALL POINTS CALCRS1A.224
CL PRESSURE AT LEVEL_REQUESTED SET TO AK AT POINT 1 ONLY CALCRS1A.225
CL AS NO OTHER ADDRESSES ARE USED. CALCRS1A.226
C---------------------------------------------------------------------- CALCRS1A.227
CALCRS1A.228
P_LEVEL(1) = AK(LEVEL_REQUESTED) CALCRS1A.229
DO 240 I=1,POINTS CALCRS1A.230
P_LEVEL_MINUS1(I) = AK(LEVEL_REQUESTED-1) + CALCRS1A.231
* BK(LEVEL_REQUESTED-1)*PSTAR(I) CALCRS1A.232
240 CONTINUE CALCRS1A.233
CALCRS1A.234
C---------------------------------------------------------------------- CALCRS1A.235
CL SECTION 2.5 CALL CALC_TS TO GET TS AT LEVEL_REQUESTED AND STORE CALCRS1A.236
CL IN TS_LEVEL. CALCRS1A.237
C---------------------------------------------------------------------- CALCRS1A.238
CALCRS1A.239
CALL CALC_TS(P_LEVEL,TS_LEVEL,POINTS,CONSTANT_PRESSURE, GSS1F304.167
& LLINTS) GSS1F304.168
CALCRS1A.241
C---------------------------------------------------------------------- CALCRS1A.242
CL SECTION 2.6 CALCULATE INTEGRAL IN EQUATION 17 BETWEEN THE CALCRS1A.243
CL PRESSURES CALCULATED IN 2.4 AND ADD ONTO RS AT CALCRS1A.244
CL LEVEL_REQUESTED MINUS 1 TO GET VALUE AT CALCRS1A.245
CL LEVEL_REQUESTED. THEN OVER-WRITE OLD VALUE OF TS CALCRS1A.246
CL WITH VALUE CALCULATED IN CALL TO TS_CALC IN 2.5. CALCRS1A.247
C---------------------------------------------------------------------- CALCRS1A.248
CALCRS1A.249
TS0_BY_P0 = TS_LEVEL(1) / P_LEVEL(1) CALCRS1A.250
DO 260 I=1,POINTS CALCRS1A.251
RS(I) = RS_LOWER(I) + (P_LEVEL_MINUS1(I)-P_LEVEL(1)) CALCRS1A.252
* *HALF_R_OVER_G*(TS(I)/P_LEVEL_MINUS1(I) + CALCRS1A.253
* TS0_BY_P0) CALCRS1A.254
TS(I) = TS_LEVEL(I) CALCRS1A.255
260 CONTINUE CALCRS1A.256
CALCRS1A.257
ELSE CALCRS1A.258
CALCRS1A.259
CL C) CALCRS1A.260
C---------------------------------------------------------------------- CALCRS1A.261
CL SECTION 2.7 SET PRESSURE AT LEVEL_REQUESTED-1 TO CALCRS1A.262
CL AK(LEVEL_REQUESTED-1) AND PRESSURE AT LEVEL_REQUESTED CALCRS1A.263
CL TO AK(LEVEL_REQUESTED) AT POINT 1 ONLY CALCRS1A.264
CL AS NO OTHER ADDRESSES ARE USED. CALCRS1A.265
C---------------------------------------------------------------------- CALCRS1A.266
CALCRS1A.267
P_LEVEL(1) = AK(LEVEL_REQUESTED) CALCRS1A.268
P_LEVEL_MINUS1(1) = AK(LEVEL_REQUESTED-1) CALCRS1A.269
CALCRS1A.270
C---------------------------------------------------------------------- CALCRS1A.271
CL SECTION 2.8 CALL CALC_TS TO GET TS AT LEVEL_REQUESTED AND STORE CALCRS1A.272
CL IN TS_LEVEL. CALCRS1A.273
C---------------------------------------------------------------------- CALCRS1A.274
CALCRS1A.275
CALL CALC_TS(P_LEVEL,TS_LEVEL,POINTS,CONSTANT_PRESSURE, GSS1F304.169
& LLINTS) GSS1F304.170
CALCRS1A.277
C---------------------------------------------------------------------- CALCRS1A.278
CL SECTION 2.9 CALCULATE INTEGRAL IN EQUATION 17 BETWEEN THE CALCRS1A.279
CL PRESSURES CALCULATED IN 2.7 AND ADD ONTO RS AT CALCRS1A.280
CL LEVEL_REQUESTED MINUS 1 TO GET VALUE AT CALCRS1A.281
CL LEVEL_REQUESTED. THEN OVER-WRITE OLD VALUE OF TS CALCRS1A.282
CL WITH VALUE CALCULATED IN CALL TO TS_CALC IN 2.5. CALCRS1A.283
C---------------------------------------------------------------------- CALCRS1A.284
CALCRS1A.285
TS0_BY_P0 = HALF_R_OVER_G*(P_LEVEL_MINUS1(1)-P_LEVEL(1)) CALCRS1A.286
* *(TS(1)/P_LEVEL_MINUS1(1) + CALCRS1A.287
* TS_LEVEL(1) / P_LEVEL(1)) CALCRS1A.288
DO 290 I=1,POINTS CALCRS1A.289
RS(I) = RS_LOWER(I) + TS0_BY_P0 CALCRS1A.290
TS(I) = TS_LEVEL(I) CALCRS1A.291
290 CONTINUE CALCRS1A.292
CALCRS1A.293
END IF CALCRS1A.294
CALCRS1A.295
END IF CALCRS1A.296
CALCRS1A.297
CL END OF ROUTINE CALC_RS CALCRS1A.298
CALCRS1A.299
RETURN CALCRS1A.300
END CALCRS1A.301
CALCRS1A.302
*ENDIF CALCRS1A.303