*IF DEF,A15_1A VORTI11A.2
C ******************************COPYRIGHT****************************** GTS2F400.11773
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.11774
C GTS2F400.11775
C Use, duplication or disclosure of this code is subject to the GTS2F400.11776
C restrictions as set forth in the contract. GTS2F400.11777
C GTS2F400.11778
C Meteorological Office GTS2F400.11779
C London Road GTS2F400.11780
C BRACKNELL GTS2F400.11781
C Berkshire UK GTS2F400.11782
C RG12 2SZ GTS2F400.11783
C GTS2F400.11784
C If no contract has been raised with this copy of the code, the use, GTS2F400.11785
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.11786
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.11787
C Modelling at the above address. GTS2F400.11788
C ******************************COPYRIGHT****************************** GTS2F400.11789
C GTS2F400.11790
CLL SUBROUTINE VORTIC1 ----------------------------------------------- VORTI11A.3
CLL VORTI11A.4
CLL Purpose: To compute 'vorticity1'. VORTI11A.5
CLL This is a term that is calculated here to be used later VORTI11A.6
CLL in the calculation of potential vorticity. VORTI11A.7
CLL Vorticity1 = -2*omega*cos(phi)/rs * D(rs)/D(phi) VORTI11A.8
CLL Not suitable for single column use. VORTI11A.9
CLL VORTI11A.10
CLL Version for cray y-mp VORTI11A.11
CLL VORTI11A.12
CLL Written by Simon Anderson VORTI11A.13
CLL VORTI11A.14
CLL Model Modification history from model version 3.0: VORTI11A.15
CLL version Date VORTI11A.16
CLL 3.2 28/07/93 Change subroutine name to uppercase for TS280793.24
CLL portability. Tracey Smith TS280793.25
!LL 4.3 17/02/97 Added ARGFLDPT arguments and MPP code P.Burton GSM3F403.1220
CLL VORTI11A.17
CLL Programming standard: Unified model documentation paper no. 4, VORTI11A.18
CLL standard b. version 2, dated 18/01/90 VORTI11A.19
CLL VORTI11A.20
CLL Logical components covered: D415 VORTI11A.21
CLL VORTI11A.22
CLL System task: D4 VORTI11A.23
CLL VORTI11A.24
CLL Documentation: U.M.D.P No 13. Derivation and Calculation of VORTI11A.25
CLL Unified Model Potential Vorticity. VORTI11A.26
CLL by Simon Anderson and Ian Roulstone. VORTI11A.27
CLL VORTI11A.28
CLLEND------------------------------------------------------------------ VORTI11A.29
VORTI11A.30
C*L ARGUMENTS:---------------------------------------------------------- VORTI11A.31
SUBROUTINE VORTIC1 1,1TS280793.26
1 (rs_on_theta, VORTI11A.33
2 sec_p_latitude,vorticity1, VORTI11A.34
3 p_field,row_length, VORTI11A.35
*CALL ARGFLDPT 
GSM3F403.1221
4 latitude_step_inverse,longitude_step_inverse) VORTI11A.36
VORTI11A.37
implicit none VORTI11A.38
VORTI11A.39
C Input variables ------------------------------------------------------ VORTI11A.40
VORTI11A.41
integer VORTI11A.42
& p_field !IN Number of points in pressure field. VORTI11A.43
&,row_length !IN Number of points per row. VORTI11A.44
*CALL TYPFLDPT GSM3F403.1222
VORTI11A.45
real VORTI11A.46
& rs_on_theta(p_field) !IN Pseudo radius of earth at p points. VORTI11A.47
&,sec_p_latitude(p_field)!IN 1/cos(lat) at p points. VORTI11A.48
&,latitude_step_inverse !IN 1/latitude increment. VORTI11A.49
&,longitude_step_inverse !IN 1/longitude increment. VORTI11A.50
VORTI11A.51
C Output variables ----------------------------------------------------- VORTI11A.52
VORTI11A.53
real VORTI11A.54
& vorticity1(p_field) !OUT Term used in potential vorticity eqn. VORTI11A.55
VORTI11A.56
C*---------------------------------------------------------------------- VORTI11A.57
C*L Workspace usage:- 1 local array required. VORTI11A.58
VORTI11A.59
real VORTI11A.60
& drs_dlatitude(p_field) VORTI11A.61
VORTI11A.62
C*---------------------------------------------------------------------- VORTI11A.63
C*L Call comdecks to get required variables: VORTI11A.64
*CALL C_OMEGA VORTI11A.65
VORTI11A.66
C*---------------------------------------------------------------------- VORTI11A.67
C*L Define local variables: VORTI11A.68
integer VORTI11A.69
& i,j ! Loop counts. VORTI11A.70
*IF DEF,MPP,AND,DEF,GLOBAL GSM3F403.1223
&, info ! GCOM return code GSM3F403.1224
*ENDIF GSM3F403.1225
VORTI11A.71
real VORTI11A.72
& scalar ! Local scalar. VORTI11A.73
VORTI11A.74
*IF DEF,GLOBAL VORTI11A.75
real sum_n,sum_s VORTI11A.76
*ENDIF VORTI11A.77
VORTI11A.78
VORTI11A.79
C ---------------------------------------------------------------------- VORTI11A.80
CL Calculate 'vorticity1'. VORTI11A.81
C ---------------------------------------------------------------------- VORTI11A.82
VORTI11A.83
C Calculate d(rs)/d(phi). VORTI11A.84
do 110 i=START_POINT_NO_HALO,END_P_POINT_NO_HALO GSM3F403.1226
drs_dlatitude(i) = latitude_step_inverse*.5* VORTI11A.86
& (rs_on_theta(i-row_length)- VORTI11A.87
& rs_on_theta(i+row_length)) VORTI11A.88
110 continue VORTI11A.89
VORTI11A.90
C Calculate vorticity1. VORTI11A.91
do 120 i=START_POINT_NO_HALO,END_P_POINT_NO_HALO GSM3F403.1227
vorticity1(i) = -2.*omega/(sec_p_latitude(i)* VORTI11A.93
& rs_on_theta(i))*drs_dlatitude(i) VORTI11A.94
120 continue VORTI11A.95
VORTI11A.96
*IF DEF,GLOBAL VORTI11A.97
C Calculate vorticity1 at poles by summing d(rs)/d(lat) around polar VORTI11A.98
C circle and averaging. VORTI11A.99
scalar = .5*latitude_step_inverse/GLOBAL_ROW_LENGTH GSM3F403.1228
GSM3F403.1229
*IF DEF,MPP GSM3F403.1230
if (at_top_of_LPG) then GSM3F403.1231
*ENDIF GSM3F403.1232
sum_n=0.0 GSM3F403.1233
GSM3F403.1234
*IF -DEF,MPP GSM3F403.1235
do i=TOP_ROW_START+FIRST_ROW_PT-1+ROW_LENGTH, GSM3F403.1236
& TOP_ROW_START+LAST_ROW_PT-1+ROW_LENGTH GSM3F403.1237
sum_n=sum_n+rs_on_theta(i) GSM3F403.1238
enddo GSM3F403.1239
*ELSE GSM3F403.1240
*IF DEF,REPROD GSM3F403.1241
CALL GCG_RVECSUMR( GSM3F403.1242
*ELSE GSM3F403.1243
CALL GCG_RVECSUMF( GSM3F403.1244
*ENDIF GSM3F403.1245
& ROW_LENGTH-2*EW_Halo,ROW_LENGTH-2*EW_Halo,1,1, GSM3F403.1246
& rs_on_theta(TOP_ROW_START+FIRST_ROW_PT-1+ROW_LENGTH), GSM3F403.1247
& GC_ROW_GROUP,info,sum_n) GSM3F403.1248
*ENDIF GSM3F403.1249
sum_n=-sum_n*scalar GSM3F403.1250
GSM3F403.1251
do i=TOP_ROW_START,TOP_ROW_START+ROW_LENGTH-1 GSM3F403.1252
vorticity1(i) = -sum_n*2.0*omega/(sec_p_latitude(i)* GSM3F403.1253
& rs_on_theta(i)) GSM3F403.1254
enddo GSM3F403.1255
*IF DEF,MPP GSM3F403.1256
endif GSM3F403.1257
GSM3F403.1258
if (at_base_of_LPG) then GSM3F403.1259
*ENDIF GSM3F403.1260
sum_s=0.0 GSM3F403.1261
GSM3F403.1262
*IF -DEF,MPP GSM3F403.1263
do i=P_BOT_ROW_START-row_length+FIRST_ROW_PT-1, GSM3F403.1264
& P_BOT_ROW_START-row_length+LAST_ROW_PT-1 GSM3F403.1265
sum_s=sum_s+rs_on_theta(i) GSM3F403.1266
enddo GSM3F403.1267
*ELSE GSM3F403.1268
*IF DEF,REPROD GSM3F403.1269
CALL GCG_RVECSUMR( GSM3F403.1270
*ELSE GSM3F403.1271
CALL GCG_RVECSUMF( GSM3F403.1272
*ENDIF GSM3F403.1273
& ROW_LENGTH-2*EW_Halo,ROW_LENGTH-2*EW_Halo,1,1, GSM3F403.1274
& rs_on_theta(P_BOT_ROW_START-row_length+LAST_ROW_PT-1), GSM3F403.1275
& GC_ROW_GROUP,info,sum_s) GSM3F403.1276
*ENDIF GSM3F403.1277
sum_s=sum_s*scalar GSM3F403.1278
GSM3F403.1279
do i=P_BOT_ROW_START,P_BOT_ROW_START+ROW_LENGTH-1 GSM3F403.1280
vorticity1(i) = -sum_s*2.0*omega/(sec_p_latitude(i)* GSM3F403.1281
& rs_on_theta(i)) GSM3F403.1282
enddo GSM3F403.1283
*IF DEF,MPP GSM3F403.1284
endif GSM3F403.1285
*ENDIF GSM3F403.1286
*ELSE VORTI11A.118
C Set vorticity1 at Northern and Southern boundaries to zero. VORTI11A.119
*IF DEF,MPP GSM3F403.1287
if (at_top_of_LPG) then GSM3F403.1288
*ENDIF GSM3F403.1289
do i=TOP_ROW_START,TOP_ROW_START+ROW_LENGTH-1 GSM3F403.1290
vorticity1(i)=0.0 GSM3F403.1291
enddo GSM3F403.1292
*IF DEF,MPP GSM3F403.1293
endif GSM3F403.1294
GSM3F403.1295
if (at_base_of_LPG) then GSM3F403.1296
*ENDIF GSM3F403.1297
do i=P_BOT_ROW_START,P_BOT_ROW_START+ROW_LENGTH-1 GSM3F403.1298
vorticity1(i)=0.0 GSM3F403.1299
enddo GSM3F403.1300
*IF DEF,MPP GSM3F403.1301
endif GSM3F403.1302
*ENDIF GSM3F403.1303
*ENDIF VORTI11A.125
VORTI11A.126
*IF DEF,MPP GSM3F403.1304
! Set rest of array GSM3F403.1305
CALL SWAPBOUNDS(vorticity1,ROW_LENGTH,tot_P_ROWS, GSM3F403.1306
& EW_Halo,NS_Halo,1) GSM3F403.1307
*ENDIF GSM3F403.1308
VORTI11A.127
CL End of routine vortic1 VORTI11A.128
VORTI11A.129
return VORTI11A.130
end VORTI11A.131
VORTI11A.132
*ENDIF VORTI11A.133