SUBROUTINE VORTIC5 1,1TS280793.38
1 (u_on_press,v_on_press,rs_on_press, VORTI51A.35
2 cos_u_latitude,sec_p_latitude, VORTI51A.36
3 vorticity5, VORTI51A.37
4 p_field,u_field,row_length, VORTI51A.38
*CALL ARGFLDPT 
GSM3F403.1095
5 latitude_step_inverse,longitude_step_inverse) VORTI51A.39
VORTI51A.40
implicit none VORTI51A.41
VORTI51A.42
C Input variables ------------------------------------------------------ VORTI51A.43
VORTI51A.44
integer VORTI51A.45
& p_field !IN Number of points in pressure field. VORTI51A.46
&,u_field !IN Number of points in velocity field. VORTI51A.47
&,row_length !IN Number of points per row. VORTI51A.48
*CALL TYPFLDPT GSM3F403.1096
VORTI51A.49
real VORTI51A.50
& u_on_press(u_field) !IN Mass weighted u velocity. VORTI51A.51
&,v_on_press(u_field) !IN Mass weighted v velocity* VORTI51A.52
& ! cos(latitude). VORTI51A.53
&,rs_on_press(p_field) !IN Pseudo radius at p-points. VORTI51A.54
&,cos_u_latitude(u_field)!IN Cos(lat) at uv-points. VORTI51A.55
&,sec_p_latitude(p_field)!IN 1/cos(lat) at p-points. VORTI51A.56
&,latitude_step_inverse !IN 1/latitude increment. VORTI51A.57
&,longitude_step_inverse !IN 1/longitude increment. VORTI51A.58
VORTI51A.59
C Output variables ----------------------------------------------------- VORTI51A.60
VORTI51A.61
real VORTI51A.62
& vorticity5(p_field) !OUT Term used in potential vorticity eqn. VORTI51A.63
VORTI51A.64
C*---------------------------------------------------------------------- VORTI51A.65
C*L Workspace usage:- 3 local arrays required. VORTI51A.66
VORTI51A.67
real VORTI51A.68
& dv_dlongitude(p_field) VORTI51A.69
&,dcosphiu_dlatitude(p_field) VORTI51A.70
&,dcosphiu_dlatitude2(u_field) VORTI51A.71
VORTI51A.72
C*---------------------------------------------------------------------- VORTI51A.73
C*L External subroutine calls: None. VORTI51A.74
VORTI51A.75
C*--------------------------------------------------------------------- VORTI51A.76
C*L Define local variables: VORTI51A.77
integer VORTI51A.78
& i,j ! Loop counts. VORTI51A.79
*IF DEF,MPP,AND,DEF,GLOBAL GSM3F403.1097
&, info ! GC return code GSM3F403.1098
VORTI51A.80
REAL GSM3F403.1099
& pole_sum(row_length) ! array containing polar vals to sum GSM3F403.1100
*ENDIF GSM3F403.1101
GSM3F403.1102
real VORTI51A.81
& scalar ! Local scalar. VORTI51A.82
VORTI51A.83
*IF DEF,GLOBAL VORTI51A.84
real sum_n,sum_s VORTI51A.85
*ENDIF VORTI51A.86
VORTI51A.87
VORTI51A.88
CL--------------------------------------------------------------------- VORTI51A.89
CL Calculate 'vorticity5'. VORTI51A.90
CL--------------------------------------------------------------------- VORTI51A.91
VORTI51A.92
C Calculate d(v)/d(lambda). VORTI51A.93
*IF -DEF,GLOBAL VORTI51A.94
CMIC$ PARALLEL SHARED(ROW_LENGTH,P_FIELD,VORTICITY5,RS_ON_PRESS, VORTI51A.95
CMIC$1 SEC_P_LATITUDE,DCOSPHIU_DLATITUDE,U_FIELD,COS_U_LATITUDE, VORTI51A.96
CMIC$2 LATITUDE_STEP_INVERSE,U_ON_PRESS,LONGITUDE_STEP_INVERSE, VORTI51A.97
CMIC$3 V_ON_PRESS,DV_DLONGITUDE) PRIVATE(J,I) VORTI51A.98
CMIC$ DO PARALLEL VECTOR VORTI51A.99
CDIR$ IVDEP VORTI51A.100
! Fujitsu vectorization directive GRB0F405.571
!OCL NOVREC GRB0F405.572
*ENDIF VORTI51A.101
do 110 i=TOP_ROW_START+1,LAST_U_FLD_PT GSM3F403.1103
dv_dlongitude(i) = longitude_step_inverse* VORTI51A.103
& (v_on_press(i) - v_on_press(i-1)) VORTI51A.104
110 continue VORTI51A.105
VORTI51A.106
C Calculate d(cosphiu)/d(phi). VORTI51A.107
*IF -DEF,GLOBAL VORTI51A.108
CMIC$ DO PARALLEL VECTOR VORTI51A.109
CDIR$ IVDEP VORTI51A.110
! Fujitsu vectorization directive GRB0F405.573
!OCL NOVREC GRB0F405.574
*ENDIF VORTI51A.111
do 120 i=START_POINT_NO_HALO,LAST_U_FLD_PT GSM3F403.1104
dcosphiu_dlatitude(i) = latitude_step_inverse* VORTI51A.113
& (cos_u_latitude(i-row_length)* VORTI51A.114
& u_on_press(i-row_length) - VORTI51A.115
& cos_u_latitude(i)* VORTI51A.116
& u_on_press(i)) VORTI51A.117
120 continue VORTI51A.118
VORTI51A.119
*IF DEF,GLOBAL VORTI51A.120
C Calculate average of dcosphiu_dlatitude at p-points. VORTI51A.121
do 130 i=START_POINT_NO_HALO+1,END_P_POINT_NO_HALO GSM3F403.1105
dcosphiu_dlatitude2(i) = dcosphiu_dlatitude(i) + VORTI51A.123
& dcosphiu_dlatitude(i-1) VORTI51A.124
130 continue VORTI51A.125
VORTI51A.126
C Now do first point on each slice for VORTI51A.127
C dv_dlongitude and dcosphiu_dlatitude2. VORTI51A.128
*IF -DEF,MPP GSM3F403.1106
i=FIRST_FLD_PT GSM3F403.1107
dv_dlongitude(i) = longitude_step_inverse * VORTI51A.130
& (v_on_press(i) - v_on_press(i+row_length-1)) VORTI51A.131
do 140 i=FIRST_FLD_PT+row_length,LAST_U_FLD_PT,row_length GSM3F403.1108
dv_dlongitude(i) = longitude_step_inverse * VORTI51A.133
& (v_on_press(i) - v_on_press(i+row_length-1)) VORTI51A.134
dcosphiu_dlatitude2(i) = dcosphiu_dlatitude(i)+ VORTI51A.135
& dcosphiu_dlatitude(i+row_length-1) VORTI51A.136
140 continue VORTI51A.137
*ELSE GSM3F403.1109
! Put a sensible number in the first element (halo) GSM3F403.1110
i=TOP_ROW_START GSM3F403.1111
dv_dlongitude(i) = dv_dlongitude(i+1) GSM3F403.1112
i=START_POINT_NO_HALO GSM3F403.1113
dcosphiu_dlatitude2(i) = dcosphiu_dlatitude2(i+1) GSM3F403.1114
*ENDIF GSM3F403.1115
VORTI51A.138
C Calculate vorticity5. VORTI51A.139
VORTI51A.140
do 150 j=START_POINT_NO_HALO,END_P_POINT_NO_HALO GSM3F403.1116
vorticity5(j)=sec_p_latitude(j)/rs_on_press(j)* VORTI51A.142
& .5*(dv_dlongitude(j)+ VORTI51A.143
& dv_dlongitude(j-row_length)- VORTI51A.144
& dcosphiu_dlatitude2(j)) VORTI51A.145
150 continue VORTI51A.146
VORTI51A.147
*ELSE VORTI51A.148
dv_dlongitude(FIRST_FLD_PT) = 0. GSM3F403.1117
VORTI51A.150
C Calculate vorticity5. VORTI51A.151
VORTI51A.152
CMIC$ DO PARALLEL VECTOR VORTI51A.153
CDIR$ IVDEP VORTI51A.154
! Fujitsu vectorization directive GRB0F405.575
!OCL NOVREC GRB0F405.576
do 130 j=START_POINT_NO_HALO+1,END_P_POINT_NO_HALO-1 GSM3F403.1118
vorticity5(j)=sec_p_latitude(j)/rs_on_press(j)* VORTI51A.156
& .5*(dv_dlongitude(j)+ VORTI51A.157
& dv_dlongitude(j-row_length)- VORTI51A.158
& dcosphiu_dlatitude(j)- VORTI51A.159
& dcosphiu_dlatitude(j-1)) VORTI51A.160
130 continue VORTI51A.161
VORTI51A.162
C Zero vorticity5 on boundaries. VORTI51A.163
*IF DEF,MPP GSM3F403.1119
if (at_top_of_LPG) then GSM3F403.1120
*ENDIF GSM3F403.1121
! Northern boundary GSM3F403.1122
do j=TOP_ROW_START,TOP_ROW_START+row_length-1 GSM3F403.1123
vorticity5(j) = 0.0 GSM3F403.1124
enddo GSM3F403.1125
*IF DEF,MPP GSM3F403.1126
endif GSM3F403.1127
VORTI51A.176
if (at_base_of_LPG) then GSM3F403.1128
*ENDIF GSM3F403.1129
! Southern boundary GSM3F403.1130
do j=P_BOT_ROW_START,P_BOT_ROW_START+row_length-1 GSM3F403.1131
vorticity5(j) = 0.0 GSM3F403.1132
enddo GSM3F403.1133
*IF DEF,MPP GSM3F403.1134
endif GSM3F403.1135
GSM3F403.1136
if (at_left_of_LPG) then GSM3F403.1137
*ENDIF GSM3F403.1138
! Western boundary GSM3F403.1139
do j=TOP_ROW_START+FIRST_ROW_PT-1+row_length, GSM3F403.1140
& END_P_POINT_NO_HALO, GSM3F403.1141
& row_length GSM3F403.1142
vorticity5(j) = 0.0 GSM3F403.1143
enddo GSM3F403.1144
*IF DEF,MPP GSM3F403.1145
endif GSM3F403.1146
GSM3F403.1147
if (at_right_of_LPG) then GSM3F403.1148
*ENDIF GSM3F403.1149
! Eastern boundary GSM3F403.1150
do j=TOP_ROW_START+LAST_ROW_PT-1+row_length, GSM3F403.1151
& END_P_POINT_NO_HALO, GSM3F403.1152
& row_length GSM3F403.1153
vorticity5(j)=0.0 GSM3F403.1154
enddo GSM3F403.1155
*IF DEF,MPP GSM3F403.1156
endif GSM3F403.1157
*ENDIF GSM3F403.1158
*ENDIF VORTI51A.178
VORTI51A.179
*IF DEF,GLOBAL VORTI51A.180
C Calculate vorticity5 at poles by summing dcosphiu/dlatitude around VORTI51A.181
C Polar circle and averaging. VORTI51A.182
scalar = latitude_step_inverse/GLOBAL_ROW_LENGTH GSM3F403.1159
*IF DEF,MPP GSM3F403.1160
if (at_top_of_LPG) then GSM3F403.1161
*ENDIF GSM3F403.1162
sum_n=0.0 GSM3F403.1163
*IF -DEF,MPP GSM3F403.1164
do i=TOP_ROW_START,TOP_ROW_START+ROW_LENGTH-1 GSM3F403.1165
sum_n = sum_n - cos_u_latitude(i)*u_on_press(i)*scalar GSM3F403.1166
enddo GSM3F403.1167
*ELSE GSM3F403.1168
do i=1,ROW_LENGTH-2*EW_Halo GSM3F403.1169
j=TOP_ROW_START+FIRST_ROW_PT+i-2 GSM3F403.1170
pole_sum(i)=-cos_u_latitude(j)*u_on_press(j)*scalar GSM3F403.1171
enddo GSM3F403.1172
VORTI51A.191
*IF DEF,REPROD GSM3F403.1173
CALL GCG_RVECSUMR( GSM3F403.1174
*ELSE GSM3F403.1175
CALL GCG_RVECSUMF( GSM3F403.1176
*ENDIF GSM3F403.1177
& ROW_LENGTH-2*EW_Halo,ROW_LENGTH-2*EW_Halo,1,1, GSM3F403.1178
& pole_sum, GSM3F403.1179
& GC_ROW_GROUP,info,sum_n) GSM3F403.1180
*ENDIF GSM3F403.1181
do i=TOP_ROW_START,TOP_ROW_START+ROW_LENGTH-1 GSM3F403.1182
vorticity5(i)=-sum_n*sec_p_latitude(i)/ rs_on_press(i) GSM3F403.1183
enddo GSM3F403.1184
*IF DEF,MPP GSM3F403.1185
endif GSM3F403.1186
VORTI51A.199
if (at_base_of_LPG) then GSM3F403.1187
*ENDIF GSM3F403.1188
sum_s=0.0 GSM3F403.1189
*IF -DEF,MPP GSM3F403.1190
do i=P_BOT_ROW_START-row_length,P_BOT_ROW_START-1 GSM3F403.1191
sum_s = sum_s + cos_u_latitude(i)*u_on_press(i)*scalar GSM3F403.1192
enddo GSM3F403.1193
*ELSE GSM3F403.1194
do i=1,ROW_LENGTH-2*EW_Halo GSM3F403.1195
j=P_BOT_ROW_START+FIRST_ROW_PT-row_length-2+i GSM3F403.1196
pole_sum(i)=cos_u_latitude(j)*u_on_press(j)*scalar GSM3F403.1197
enddo GSM3F403.1198
GSM3F403.1199
*IF DEF,REPROD GSM3F403.1200
CALL GCG_RVECSUMR( GSM3F403.1201
*ELSE GSM3F403.1202
CALL GCG_RVECSUMF( GSM3F403.1203
*ENDIF GSM3F403.1204
& ROW_LENGTH-2*EW_Halo,ROW_LENGTH-2*EW_Halo,1,1, GSM3F403.1205
& pole_sum, GSM3F403.1206
& GC_ROW_GROUP,info,sum_s) GSM3F403.1207
*ENDIF GSM3F403.1208
do i=P_BOT_ROW_START,P_BOT_ROW_START+row_length-1 GSM3F403.1209
vorticity5(i)=-sum_s*sec_p_latitude(i)/ rs_on_press(i) GSM3F403.1210
enddo GSM3F403.1211
*IF DEF,MPP GSM3F403.1212
endif GSM3F403.1213
*ENDIF GSM3F403.1214
*ENDIF GSM3F403.1215
*IF DEF,MPP GSM3F403.1216
! Set rest of array to sensible values GSM3F403.1217
CALL SWAPBOUNDS(vorticity5,ROW_LENGTH,tot_P_ROWS, GSM3F403.1218
& EW_Halo,NS_Halo,1) GSM3F403.1219
*ENDIF VORTI51A.200
VORTI51A.201
CL end of routine vortic5 VORTI51A.202
VORTI51A.203
return VORTI51A.204
end VORTI51A.205
VORTI51A.206
*ENDIF VORTI51A.207