*IF DEF,A15_1A VORTI31A.2
C ******************************COPYRIGHT****************************** GTS2F400.11809
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.11810
C GTS2F400.11811
C Use, duplication or disclosure of this code is subject to the GTS2F400.11812
C restrictions as set forth in the contract. GTS2F400.11813
C GTS2F400.11814
C Meteorological Office GTS2F400.11815
C London Road GTS2F400.11816
C BRACKNELL GTS2F400.11817
C Berkshire UK GTS2F400.11818
C RG12 2SZ GTS2F400.11819
C GTS2F400.11820
C If no contract has been raised with this copy of the code, the use, GTS2F400.11821
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.11822
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.11823
C Modelling at the above address. GTS2F400.11824
C ******************************COPYRIGHT****************************** GTS2F400.11825
C GTS2F400.11826
CLL SUBROUTINE VORTIC3 ----------------------------------------------- VORTI31A.3
CLL VORTI31A.4
CLL Purpose: To compute 1/(rs*rs*cos(phi)) * VORTI31A.5
CLL D(rs.v)/D(p) * D(theta)/D(lambda) VORTI31A.6
CLL - 1/(rs*rs) * VORTI31A.7
CLL D(rs.u)/D(p) * D(theta)/D(phi). VORTI31A.8
CLL This is a term that is calculated here to be used later VORTI31A.9
CLL in the calculation of potential vorticity VORTI31A.10
CLL in subroutine CALC_PV_P. VORTI31A.11
CLL VORTI31A.12
CLL Not suitable for single column use. VORTI31A.13
CLL VORTI31A.14
CLL VERSION FOR CRAY Y-MP VORTI31A.15
CLL VORTI31A.16
CLL Model Modification history: VORTI31A.17
CLL Version Date VORTI31A.18
CLL 3.1 2/11/92 Written by Simon Anderson. VORTI31A.19
CLL 3.1 18/01/93 New deck at the release of Version 3.1. VORTI31A.20
CLL 3.2 28/07/93 Change subroutine name to uppercase for TS280793.30
CLL portability. Tracey Smith TS280793.31
!LL 4.3 18/02/97 Added ARGFLDPT arguments and MPP code P.Burton GSM3F403.1014
CLL VORTI31A.21
CLL Programming standard: Unified model documentation paper no. 4, VORTI31A.22
CLL standard b. version 2, dated 18/01/90 VORTI31A.23
CLL VORTI31A.24
CLL Logical components covered: D415 VORTI31A.25
CLL VORTI31A.26
CLL Project task: D4 VORTI31A.27
CLL VORTI31A.28
CLL Documentation: U.M.D.P No 13. Derivation and Calculation of VORTI31A.29
CLL Unified Model Potential Vorticity. VORTI31A.30
CLL By Simon Anderson and Ian Roulstone. VORTI31A.31
CLL VORTI31A.32
CLLEND------------------------------------------------------------------ VORTI31A.33
VORTI31A.34
C*L ARGUMENTS:---------------------------------------------------------- VORTI31A.35
SUBROUTINE VORTIC3 1,1TS280793.32
1 (rs_on_press,theta_on_press,drsu_dp,drsv_dp, VORTI31A.37
2 sec_p_latitude, VORTI31A.38
3 vorticity3,dtheta_dlatitude, VORTI31A.39
4 p_field,row_length, VORTI31A.40
*CALL ARGFLDPT 
GSM3F403.1015
5 latitude_step_inverse,longitude_step_inverse) VORTI31A.41
VORTI31A.42
implicit none VORTI31A.43
VORTI31A.44
C Input variables ------------------------------------------------------ VORTI31A.45
VORTI31A.46
integer VORTI31A.47
& p_field !IN Number of points in pressure field. VORTI31A.48
&,row_length !IN Number of points per row. VORTI31A.49
*CALL TYPFLDPT GSM3F403.1016
VORTI31A.50
real VORTI31A.51
& rs_on_press(p_field) !IN Pseudo radius at p-points. VORTI31A.52
&,theta_on_press(p_field)!IN Theta field at p-points. VORTI31A.53
&,drsu_dp(p_field) !IN D(rs.u)/D(p) at p-points. VORTI31A.54
&,drsv_dp(p_field) !IN D(rs.v)/D(p) at p-points. VORTI31A.55
&,sec_p_latitude(p_field)!IN 1/cos(lat) at p-points. VORTI31A.56
&,latitude_step_inverse !IN 1/latitude increment. VORTI31A.57
&,longitude_step_inverse !IN 1/longitude increment. VORTI31A.58
VORTI31A.59
C Output variables ----------------------------------------------------- VORTI31A.60
VORTI31A.61
real VORTI31A.62
& vorticity3(p_field) !OUT Term used in potential vorticity eqn. VORTI31A.63
&,dtheta_dlatitude(p_field) !OUT D(Theta)/D(phi) field. VORTI31A.64
VORTI31A.65
C*---------------------------------------------------------------------- VORTI31A.66
C*L Workspace usage:- 1 local array required. VORTI31A.67
VORTI31A.68
real VORTI31A.69
& dtheta_dlongitude(p_field) VORTI31A.70
VORTI31A.71
C*---------------------------------------------------------------------- VORTI31A.72
C*L External subroutine calls: None. VORTI31A.73
VORTI31A.74
C*---------------------------------------------------------------------- VORTI31A.75
C*L Define local variables: VORTI31A.76
VORTI31A.77
integer VORTI31A.78
& i,j ! Loop counts. VORTI31A.79
VORTI31A.80
real VORTI31A.81
& scalar ! Local scalar. VORTI31A.82
VORTI31A.83
VORTI31A.87
VORTI31A.88
CL---------------------------------------------------------------------- VORTI31A.89
CL Calculate 'vorticity3'. VORTI31A.90
CL---------------------------------------------------------------------- VORTI31A.91
VORTI31A.92
C Calculate d(theta)/d(lambda). VORTI31A.93
*IF -DEF,GLOBAL VORTI31A.94
CMIC$ PARALLEL SHARED(ROW_LENGTH,P_FIELD,VORTICITY3,RS_ON_PRESS, VORTI31A.95
CMIC$1 SEC_P_LATITUDE,DRSV_DP,DRSU_DP,DTHETA_DLATITUDE, VORTI31A.96
CMIC$2 LATITUDE_STEP_INVERSE,THETA_ON_PRESS,LONGITUDE_STEP_INVERSE, VORTI31A.97
CMIC$3 DTHETA_DLONGITUDE) PRIVATE(J,I) VORTI31A.98
CMIC$ DO PARALLEL VECTOR VORTI31A.99
CDIR$ IVDEP VORTI31A.100
! Fujitsu vectorization directive GRB0F405.565
!OCL NOVREC GRB0F405.566
*ENDIF VORTI31A.101
do 110 i=START_POINT_NO_HALO+1,END_P_POINT_NO_HALO-1 GSM3F403.1017
dtheta_dlongitude(i) = (longitude_step_inverse * .5) * GSM3F403.1018
& (theta_on_press(i+1)- VORTI31A.104
& theta_on_press(i-1)) VORTI31A.105
110 continue VORTI31A.106
VORTI31A.107
C Calculate d(theta)/d(phi). VORTI31A.108
*IF -DEF,GLOBAL VORTI31A.109
CMIC$ DO PARALLEL VECTOR VORTI31A.110
CDIR$ IVDEP VORTI31A.111
! Fujitsu vectorization directive GRB0F405.567
!OCL NOVREC GRB0F405.568
*ENDIF VORTI31A.112
do 120 i=START_POINT_NO_HALO,END_P_POINT_NO_HALO GSM3F403.1019
dtheta_dlatitude(i) = (latitude_step_inverse * .5) * GSM3F403.1020
& (theta_on_press(i-row_length)- VORTI31A.115
& theta_on_press(i+row_length)) VORTI31A.116
120 continue VORTI31A.117
VORTI31A.118
*IF DEF,GLOBAL VORTI31A.119
*IF -DEF,MPP GSM3F403.1021
C Recalculate first and last point on each slice for d(theta)/d(lambda). VORTI31A.120
VORTI31A.121
do 130 i=row_length+1,p_field-row_length,row_length VORTI31A.122
dtheta_dlongitude(i) = (longitude_step_inverse * .5) * GSM3F403.1022
& (theta_on_press(i+1)- VORTI31A.124
& theta_on_press(i+row_length-1)) VORTI31A.125
j=i+row_length-1 VORTI31A.126
dtheta_dlongitude(j) = (longitude_step_inverse * .5) * GSM3F403.1023
& (theta_on_press(j-row_length+1)- VORTI31A.128
& theta_on_press(j-1)) VORTI31A.129
130 continue VORTI31A.130
*ELSE GSM3F403.1024
i=START_POINT_NO_HALO GSM3F403.1025
dtheta_dlongitude(i)=dtheta_dlongitude(i+1) GSM3F403.1026
GSM3F403.1027
i=END_P_POINT_NO_HALO GSM3F403.1028
dtheta_dlongitude(i)=dtheta_dlongitude(i-1) GSM3F403.1029
*ENDIF GSM3F403.1030
VORTI31A.131
C Calculate vorticity3. VORTI31A.132
VORTI31A.133
do 140 j=START_POINT_NO_HALO,END_P_POINT_NO_HALO GSM3F403.1031
vorticity3(j) = (1./(rs_on_press(j)*rs_on_press(j)))* GSM3F403.1032
& ((sec_p_latitude(j)* GSM3F403.1033
& drsv_dp(j))*dtheta_dlongitude(j)) GSM3F403.1034
& - (1./(rs_on_press(j)*rs_on_press(j)))* GSM3F403.1035
& (drsu_dp(j)*dtheta_dlatitude(j)) GSM3F403.1036
140 continue VORTI31A.140
VORTI31A.141
*ELSE VORTI31A.142
VORTI31A.144
C Calculate vorticity3. VORTI31A.145
VORTI31A.146
CMIC$ DO PARALLEL VECTOR VORTI31A.147
CDIR$ IVDEP VORTI31A.148
! Fujitsu vectorization directive GRB0F405.569
!OCL NOVREC GRB0F405.570
do 130 j=START_POINT_NO_HALO+1,END_P_POINT_NO_HALO-1 GSM3F403.1037
vorticity3(j) = (1./(rs_on_press(j)*rs_on_press(j)))* GSM3F403.1038
& ((sec_p_latitude(j)* GSM3F403.1039
& drsv_dp(j))*dtheta_dlongitude(j)) GSM3F403.1040
& - (1./(rs_on_press(j)*rs_on_press(j)))* GSM3F403.1041
& (drsu_dp(j)*dtheta_dlatitude(j)) GSM3F403.1042
130 continue VORTI31A.155
VORTI31A.156
C Zero vorticity3 on boundaries. VORTI31A.157
*IF DEF,MPP GSM3F403.1043
if (at_top_of_LPG) then GSM3F403.1044
*ENDIF GSM3F403.1045
! Northern boundary GSM3F403.1046
do j=TOP_ROW_START,TOP_ROW_START+row_length-1 GSM3F403.1047
vorticity3(j) = 0.0 GSM3F403.1048
enddo GSM3F403.1049
*IF DEF,MPP GSM3F403.1050
endif GSM3F403.1051
GSM3F403.1052
if (at_base_of_LPG) then GSM3F403.1053
*ENDIF GSM3F403.1054
! Southern boundary GSM3F403.1055
do j=P_BOT_ROW_START,P_BOT_ROW_START+row_length-1 GSM3F403.1056
vorticity3(j) = 0.0 GSM3F403.1057
enddo GSM3F403.1058
*IF DEF,MPP GSM3F403.1059
endif GSM3F403.1060
GSM3F403.1061
if (at_left_of_LPG) then GSM3F403.1062
*ENDIF GSM3F403.1063
! Western boundary GSM3F403.1064
do j=TOP_ROW_START+FIRST_ROW_PT-1+row_length, GSM3F403.1065
& END_P_POINT_NO_HALO, GSM3F403.1066
& row_length GSM3F403.1067
vorticity3(j) = 0.0 GSM3F403.1068
enddo GSM3F403.1069
*IF DEF,MPP GSM3F403.1070
endif GSM3F403.1071
GSM3F403.1072
if (at_right_of_LPG) then GSM3F403.1073
*ENDIF GSM3F403.1074
! Eastern boundary GSM3F403.1075
do j=TOP_ROW_START+LAST_ROW_PT-1+row_length, GSM3F403.1076
& END_P_POINT_NO_HALO, GSM3F403.1077
& row_length GSM3F403.1078
vorticity3(j)=0.0 GSM3F403.1079
enddo GSM3F403.1080
*IF DEF,MPP GSM3F403.1081
endif GSM3F403.1082
*ENDIF GSM3F403.1083
VORTI31A.171
*ENDIF VORTI31A.172
VORTI31A.173
*IF DEF,GLOBAL VORTI31A.174
C Zero vorticity3 at the poles. TD141293.12
do i=1,row_length TD141293.13
*IF DEF,MPP GSM3F403.1084
if (at_top_of_LPG) vorticity3(TOP_ROW_START+i)=0.0 GSM3F403.1085
if (at_base_of_LPG)vorticity3(P_BOT_ROW_START+i)=0.0 GSM3F403.1086
*ELSE GSM3F403.1087
vorticity3(i)=0.0 TD141293.14
vorticity3(p_field-row_length+i)=0.0 TD141293.15
*ENDIF GSM3F403.1088
end do TD141293.16
VORTI31A.193
*ENDIF GSM3F403.1089
*IF DEF,MPP GSM3F403.1090
! Set rest of array to sensible values GSM3F403.1091
CALL SWAPBOUNDS(vorticity3,ROW_LENGTH,tot_P_ROWS, GSM3F403.1092
& EW_Halo,NS_Halo,1) GSM3F403.1093
*ENDIF VORTI31A.194
VORTI31A.195
CL End of routine vortic3 VORTI31A.196
VORTI31A.197
return VORTI31A.198
end VORTI31A.199
VORTI31A.200
*ENDIF VORTI31A.201