*IF DEF,A15_1A VORTI41A.2
C ******************************COPYRIGHT****************************** GTS2F400.11827
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.11828
C GTS2F400.11829
C Use, duplication or disclosure of this code is subject to the GTS2F400.11830
C restrictions as set forth in the contract. GTS2F400.11831
C GTS2F400.11832
C Meteorological Office GTS2F400.11833
C London Road GTS2F400.11834
C BRACKNELL GTS2F400.11835
C Berkshire UK GTS2F400.11836
C RG12 2SZ GTS2F400.11837
C GTS2F400.11838
C If no contract has been raised with this copy of the code, the use, GTS2F400.11839
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.11840
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.11841
C Modelling at the above address. GTS2F400.11842
C ******************************COPYRIGHT****************************** GTS2F400.11843
C GTS2F400.11844
CLL SUBROUTINE VORTIC4 ----------------------------------------------- VORTI41A.3
CLL VORTI41A.4
CLL Purpose: To compute 1/rs 2.omega.cos(phi) D(theta)/D(phi). VORTI41A.5
CLL This is a term that is calculated here to be used later VORTI41A.6
CLL in the calculation of potential vorticity VORTI41A.7
CLL in subroutine CALC_PV_P. VORTI41A.8
CLL VORTI41A.9
CLL Not suitable for single column use. VORTI41A.10
CLL VORTI41A.11
CLL VERSION FOR CRAY Y-MP VORTI41A.12
CLL VORTI41A.13
CLL Model Modification history: VORTI41A.14
CLL Version Date VORTI41A.15
CLL 3.1 29/10/92 Written by Simon Anderson. VORTI41A.16
CLL 3.1 18/01/93 New deck at the release of Version 3.1. VORTI41A.17
CLL 3.2 28/07/93 Change subroutine name to uppercase for TS280793.33
CLL portability. Tracey Smith TS280793.34
CLL 3.3 10/09/93 Correction to calculation at the poles. SA100993.1
!LL 4.3 18/02/97 Added ARGFLPT arguments and MPP code P.Burton GSM3F403.1443
CLL VORTI41A.18
CLL Programming standard: Unified model documentation paper no. 4, VORTI41A.19
CLL standard b. version 2, dated 18/01/90 VORTI41A.20
CLL VORTI41A.21
CLL Logical components covered: D415 VORTI41A.22
CLL VORTI41A.23
CLL Project task: D4 VORTI41A.24
CLL VORTI41A.25
CLL Documentation: U.M.D.P No 13. Derivation and Calculation of VORTI41A.26
CLL Unified Model Potential Vorticity. VORTI41A.27
CLL By Simon Anderson and Ian Roulstone. VORTI41A.28
CLL VORTI41A.29
CLLEND------------------------------------------------------------------ VORTI41A.30
VORTI41A.31
C*L ARGUMENTS:---------------------------------------------------------- VORTI41A.32
SUBROUTINE VORTIC4 1,1TS280793.35
1 (rs_on_press,theta_on_press,dtheta_dlatitude, VORTI41A.34
2 sec_p_latitude, VORTI41A.35
3 vorticity4, VORTI41A.36
4 p_field,row_length, VORTI41A.37
*CALL ARGFLDPT 
GSM3F403.1444
5 latitude_step_inverse,longitude_step_inverse) VORTI41A.38
VORTI41A.39
implicit none VORTI41A.40
VORTI41A.41
C Input variables ------------------------------------------------------ VORTI41A.42
VORTI41A.43
integer VORTI41A.44
& p_field !IN Number of points in pressure field. VORTI41A.45
&,row_length !IN Number of points per row. VORTI41A.46
*CALL TYPFLDPT GSM3F403.1445
VORTI41A.47
real VORTI41A.48
& rs_on_press(p_field) !IN Pseudo radius of earth at p-points. VORTI41A.49
&,theta_on_press(p_field)!IN Theta field at p-points. VORTI41A.50
&,dtheta_dlatitude(p_field)!IN D(Theta)/D(phi) field. VORTI41A.51
&,sec_p_latitude(p_field)!IN 1/cos(lat) at p-points. VORTI41A.52
&,latitude_step_inverse !IN 1/latitude increment. VORTI41A.53
&,longitude_step_inverse !IN 1/longitude increment. VORTI41A.54
VORTI41A.55
C Output variables ----------------------------------------------------- VORTI41A.56
VORTI41A.57
real VORTI41A.58
& vorticity4(p_field) !OUT Term used in potential vorticity eqn. VORTI41A.59
VORTI41A.60
C*---------------------------------------------------------------------- VORTI41A.61
C*L External subroutine calls: None. VORTI41A.62
VORTI41A.63
C*---------------------------------------------------------------------- VORTI41A.64
C*L Call comdecks to get required variables: VORTI41A.65
*CALL C_OMEGA VORTI41A.66
VORTI41A.67
C*---------------------------------------------------------------------- VORTI41A.68
C*L Define local variables: VORTI41A.69
integer VORTI41A.70
& i,j ! Loop counts. VORTI41A.71
*IF DEF,MPP,AND,DEF,GLOBAL GSM3F403.1446
&, info !GCOM return code GSM3F403.1447
*ENDIF GSM3F403.1448
VORTI41A.72
real VORTI41A.73
& scalar ! Local scalar. VORTI41A.74
VORTI41A.75
*IF DEF,GLOBAL VORTI41A.76
real sum_n,sum_s VORTI41A.77
*ENDIF VORTI41A.78
VORTI41A.79
VORTI41A.80
C ---------------------------------------------------------------------- VORTI41A.81
CL Calculate 'vorticity4'. VORTI41A.82
C ---------------------------------------------------------------------- VORTI41A.83
VORTI41A.84
C Calculate vorticity4. VORTI41A.85
do 120 i=START_POINT_NO_HALO,END_P_POINT_NO_HALO GSM3F403.1449
vorticity4(i) = 1./(rs_on_press(i)*sec_p_latitude(i))* VORTI41A.87
& 2.*omega*dtheta_dlatitude(i) VORTI41A.88
120 continue VORTI41A.89
VORTI41A.90
*IF DEF,GLOBAL VORTI41A.91
C Calculate vorticity4 at poles by summing d(theta)/d(lat) around polar VORTI41A.92
C circle and averaging. VORTI41A.93
scalar = .5*latitude_step_inverse/GLOBAL_ROW_LENGTH GSM3F403.1450
GSM3F403.1451
*IF DEF,MPP GSM3F403.1452
if (at_top_of_LPG) then GSM3F403.1453
*ENDIF GSM3F403.1454
sum_n=0.0 GSM3F403.1455
GSM3F403.1456
*IF -DEF,MPP GSM3F403.1457
do i=TOP_ROW_START+FIRST_ROW_PT-1+ROW_LENGTH, GSM3F403.1458
& TOP_ROW_START+LAST_ROW_PT-1+ROW_LENGTH GSM3F403.1459
sum_n=sum_n+theta_on_press(i) GSM3F403.1460
enddo GSM3F403.1461
*ELSE GSM3F403.1462
*IF DEF,REPROD GSM3F403.1463
CALL GCG_RVECSUMR( GSM3F403.1464
*ELSE GSM3F403.1465
CALL GCG_RVECSUMF( GSM3F403.1466
*ENDIF GSM3F403.1467
& ROW_LENGTH-2*EW_Halo,ROW_LENGTH-2*EW_Halo,1,1, GSM3F403.1468
& theta_on_press(TOP_ROW_START+FIRST_ROW_PT-1+ROW_LENGTH), GSM3F403.1469
& GC_ROW_GROUP,info,sum_n) GSM3F403.1470
*ENDIF GSM3F403.1471
sum_n=-sum_n*scalar GSM3F403.1472
GSM3F403.1473
do i=TOP_ROW_START,TOP_ROW_START+ROW_LENGTH-1 GSM3F403.1474
vorticity4(i) = 1./(rs_on_press(i)*sec_p_latitude(i))* GSM3F403.1475
& 2.*omega*sum_n GSM3F403.1476
enddo GSM3F403.1477
*IF DEF,MPP GSM3F403.1478
endif GSM3F403.1479
GSM3F403.1480
if (at_base_of_LPG) then GSM3F403.1481
*ENDIF GSM3F403.1482
sum_s=0.0 GSM3F403.1483
GSM3F403.1484
*IF -DEF,MPP GSM3F403.1485
do i=P_BOT_ROW_START+FIRST_ROW_PT-1-row_length, GSM3F403.1486
& P_BOT_ROW_START+LAST_ROW_PT-1-row_length GSM3F403.1487
sum_s=sum_s+theta_on_press(i) GSM3F403.1488
enddo GSM3F403.1489
*ELSE GSM3F403.1490
*IF DEF,REPROD GSM3F403.1491
CALL GCG_RVECSUMR( GSM3F403.1492
*ELSE GSM3F403.1493
CALL GCG_RVECSUMF( GSM3F403.1494
*ENDIF GSM3F403.1495
& ROW_LENGTH-2*EW_Halo,ROW_LENGTH-2*EW_Halo,1,1, GSM3F403.1496
& theta_on_press(P_BOT_ROW_START-row_length+LAST_ROW_PT-1), GSM3F403.1497
& GC_ROW_GROUP,info,sum_s) GSM3F403.1498
*ENDIF GSM3F403.1499
sum_s=sum_s*scalar GSM3F403.1500
GSM3F403.1501
do i=P_BOT_ROW_START,P_BOT_ROW_START+ROW_LENGTH-1 GSM3F403.1502
vorticity4(i) = 1./(rs_on_press(i)*sec_p_latitude(i))* GSM3F403.1503
& 2.*omega*sum_s GSM3F403.1504
enddo GSM3F403.1505
*IF DEF,MPP GSM3F403.1506
endif GSM3F403.1507
*ENDIF GSM3F403.1508
*ELSE VORTI41A.113
VORTI41A.114
C Set vorticity4 at Northern and Southern boundaries to zero. VORTI41A.115
*IF DEF,MPP GSM3F403.1509
if (at_top_of_LPG) then GSM3F403.1510
*ENDIF GSM3F403.1511
do i=TOP_ROW_START,TOP_ROW_START+ROW_LENGTH-1 GSM3F403.1512
vorticity4(i)=0.0 GSM3F403.1513
enddo GSM3F403.1514
*IF DEF,MPP GSM3F403.1515
endif GSM3F403.1516
GSM3F403.1517
if (at_base_of_LPG) then GSM3F403.1518
*ENDIF GSM3F403.1519
do i=P_BOT_ROW_START,P_BOT_ROW_START+ROW_LENGTH-1 GSM3F403.1520
vorticity4(i)=0.0 GSM3F403.1521
enddo GSM3F403.1522
*IF DEF,MPP GSM3F403.1523
endif GSM3F403.1524
*ENDIF GSM3F403.1525
VORTI41A.121
*ENDIF VORTI41A.122
*IF DEF,MPP GSM3F403.1526
! Set rest of array GSM3F403.1527
CALL SWAPBOUNDS(vorticity4,ROW_LENGTH,tot_P_ROWS, GSM3F403.1528
& EW_Halo,NS_Halo,1) GSM3F403.1529
*ENDIF GSM3F403.1530
VORTI41A.123
CL End of routine vortic4 VORTI41A.124
VORTI41A.125
return VORTI41A.126
end VORTI41A.127
VORTI41A.128
*ENDIF VORTI41A.129