SUBROUTINE UV_DIF 2,15UVDIF1A.32
1 (FIELDU,FIELDV,RS_SQUARED_DELTAP, ATD1F400.781
2 SEC_U_LATITUDE,START_U_UPDATE,END_U_UPDATE, ATD1F400.782
3 ROW_LENGTH, APB0F401.1670
*CALL ARGFLDPT 
APB0F401.1671
& P_FIELD,U_FIELD, APB0F401.1672
4 DIFFUSION_EW,DIFFUSION_NS) ATD1F400.784
UVDIF1A.40
IMPLICIT NONE UVDIF1A.41
UVDIF1A.42
INTEGER UVDIF1A.43
* U_FIELD !IN DIMENSION OF FIELDS ON VELOCITY GRID UVDIF1A.44
*, P_FIELD !IN DIMENSION OF FIELDS ON PRESSURE GRID UVDIF1A.45
*, ROW_LENGTH !IN NUMBER OF POINTS PER ROW UVDIF1A.46
*, START_U_UPDATE !IN FIRST POINT TO BE UPDATED. UVDIF1A.47
*, END_U_UPDATE !IN LAST POINT TO BE UPDATED. UVDIF1A.48
APB0F401.1673
! All TYPFLDPT arguments are intent IN APB0F401.1674
*CALL TYPFLDPT APB0F401.1675
UVDIF1A.49
REAL UVDIF1A.50
* FIELDU(U_FIELD) !INOUT. U DIFFUSION FIELD. ATD1F400.785
*,FIELDV(U_FIELD) !INOUT. V DIFFUSION FIELD. ATD1F400.786
UVDIF1A.53
REAL UVDIF1A.54
* RS_SQUARED_DELTAP(U_FIELD) !IN HOLDS RS*RS*DELTA P UVDIF1A.55
*,DIFFUSION_EW(P_FIELD) !IN EFFECTIVE EW DIFFUSION COEFFICIENT ATD1F400.787
*,DIFFUSION_NS(P_FIELD) !IN EFFECTIVE NS DIFFUSION COEFFICIENT ATD1F400.788
*,SEC_U_LATITUDE(U_FIELD) !IN 1/COS(LAT) AT U POINTS UVDIF1A.65
UVDIF1A.70
UVDIF1A.75
C*L DEFINE ARRAYS AND VARIABLES USED IN THIS ROUTINE----------------- UVDIF1A.76
C DEFINE LOCAL ARRAYS: 4 ARE REQUIRED UVDIF1A.77
UVDIF1A.78
*IF DEF,MPP,AND,DEF,T3E GSS2F403.174
*IF DEF,MPP GSS2F403.175
*CALL AMAXSIZE GSS2F403.176
*ENDIF GSS2F403.177
*ENDIF GSS2F403.178
REAL UVDIF1A.79
* FIELD1(P_FIELD) ! GENERAL WORKSPACE ATD1F400.789
*,FIELD2(P_FIELD) ! GENERAL WORKSPACE ATD1F400.790
*,FIELD3(P_FIELD) ! GENERAL WORKSPACE ATD1F400.791
*,FIELD4(P_FIELD) ! GENERAL WORKSPACE ATD1F400.792
*IF DEF,MPP APB0F401.1676
*IF DEF,MPP,AND,DEF,T3E GSS2F403.179
&,u_copy(row_length_max) ! copy of polar row GSS2F403.180
&,v_copy(row_length_max) ! copy of polar row GSS2F403.181
&,u_out_copy(row_length_max) GSS2F403.182
&,v_out_copy(row_length_max) GSS2F403.183
c GSS2F403.184
integer ipad1(32), ipad2(32), ipad3(32), ipad4(32) GSS2F403.185
c GSS2F403.186
common/uv_dif_shmem/ ipad1, u_copy, ipad2, v_copy, ipad3 GSS2F403.187
c GSS2F403.188
*CALL PARVARS GSS2F403.189
integer g_start(maxproc), g_new_start, l_new_length, GSS2F403.190
2 l_iadd, current_length, l_rem_iadd, my_row_pe GSS2F403.191
*ELSE GSS2F403.192
&,U_COPY(ROW_LENGTH) ! copy of polar row APB0F401.1677
&,V_COPY(ROW_LENGTH) ! copy of polar row APB0F401.1678
*ENDIF GSS2F403.193
*ENDIF APB0F401.1679
C*--------------------------------------------------------------------- UVDIF1A.82
C DEFINE LOCAL VARIABLES UVDIF1A.83
UVDIF1A.84
C LOCAL REALS. UVDIF1A.85
REAL UVDIF1A.86
* SCALAR UVDIF1A.87
C COUNT VARIABLES FOR DO LOOPS ETC. UVDIF1A.88
INTEGER UVDIF1A.89
* I,IJ,J,JI,HALF_RL ATD1F400.793
*IF DEF,GLOBAL,AND,DEF,MPP APB0F401.1680
INTEGER info APB0F401.1681
*ENDIF APB0F401.1682
UVDIF1A.91
C*L EXTERNAL SUBROUTINE CALLS: NONE--------------------------------- ATD1F400.794
C*--------------------------------------------------------------------- UVDIF1A.95
CL MAXIMUM VECTOR LENGTH ASSUMED IS END_U_UPDATE-START_U_UPDATE+1+ UVDIF1A.96
CL ROW_LENGTH UVDIF1A.97
CL--------------------------------------------------------------------- UVDIF1A.98
CL INTERNAL STRUCTURE. UVDIF1A.99
CL--------------------------------------------------------------------- UVDIF1A.100
CL UVDIF1A.101
CL--------------------------------------------------------------------- UVDIF1A.102
CL SECTION 1. CALCULATE FIRST TERM IN EQUATION (47) UVDIF1A.103
CL--------------------------------------------------------------------- UVDIF1A.104
UVDIF1A.105
C---------------------------------------------------------------------- ATD1F400.795
CL SECTION 1.1 CALCULATE DELTALAMBDA TERMS ATD1F400.796
C---------------------------------------------------------------------- ATD1F400.797
ATD1F400.798
ATD1F400.799
DO I=START_U_UPDATE+1,END_U_UPDATE ATD1F400.800
FIELD1(I) =FIELDU(I)-FIELDU(I-1) ATD1F400.801
FIELD2(I) =FIELDV(I)-FIELDV(I-1) ATD1F400.802
END DO ATD1F400.803
ATD1F400.804
*IF -DEF,MPP APB0F401.1683
C CORRECT END POINTS ATD1F400.805
ATD1F400.806
DO I=START_U_UPDATE,END_U_UPDATE,ROW_LENGTH ATD1F400.807
IJ=I+ROW_LENGTH-1 ATD1F400.808
FIELD1(I) =FIELDU(I)-FIELDU(IJ) ATD1F400.809
FIELD2(I) =FIELDV(I)-FIELDV(IJ) ATD1F400.810
END DO ATD1F400.811
*ELSE APB0F401.1684
FIELD1(START_U_UPDATE)=FIELD1(START_U_UPDATE+1) APB0F401.1685
FIELD2(START_U_UPDATE)=FIELD2(START_U_UPDATE+1) APB0F401.1686
*ENDIF APB0F401.1687
ATD1F400.812
C---------------------------------------------------------------------- ATD1F400.813
CL SECTION 1.3 COMPLETE DELTALAMBDA TERM ATD1F400.814
C---------------------------------------------------------------------- ATD1F400.815
ATD1F400.816
DO I= START_U_UPDATE+1,END_U_UPDATE ATD1F400.818
FIELD3(I-1)=(DIFFUSION_EW(I)*FIELD1(I)- ATD1F400.822
& DIFFUSION_EW(I-1)*FIELD1(I-1))* ATD1F400.823
& SEC_U_LATITUDE(I-1) ATD1F400.824
FIELD4(I-1)=(DIFFUSION_EW(I)*FIELD2(I)- ATD1F400.825
& DIFFUSION_EW(I-1)*FIELD2(I-1))* ATD1F400.826
& SEC_U_LATITUDE(I-1) ATD1F400.827
END DO ATD1F400.828
ATD1F400.829
C CORRECT END POINT ATD1F400.830
*IF -DEF,MPP APB0F401.1688
ATD1F400.831
DO I= START_U_UPDATE,END_U_UPDATE,ROW_LENGTH ATD1F400.832
IJ=I+ROW_LENGTH-1 ATD1F400.833
FIELD3(IJ)=(DIFFUSION_EW(I)*FIELD1(I)- ATD1F400.834
& DIFFUSION_EW(IJ)*FIELD1(IJ))* ATD1F400.835
& SEC_U_LATITUDE(IJ) ATD1F400.836
FIELD4(IJ)=(DIFFUSION_EW(I)*FIELD2(I)- ATD1F400.837
& DIFFUSION_EW(IJ)*FIELD2(IJ))* ATD1F400.838
& SEC_U_LATITUDE(IJ) ATD1F400.839
END DO ATD1F400.840
*ELSE APB0F401.1689
FIELD3(END_U_UPDATE)=FIELD3(END_U_UPDATE-1) APB0F401.1690
FIELD4(END_U_UPDATE)=FIELD4(END_U_UPDATE-1) APB0F401.1691
*ENDIF APB0F401.1692
ATD1F400.841
CL ATD1F400.842
CL--------------------------------------------------------------------- ATD1F400.843
CL SECTION 2. CALCULATE PHI DIRECTION TERM AND ADD ATD1F400.844
CL ONTO FIRST TO GET TOTAL INCREMENT. ATD1F400.845
CL--------------------------------------------------------------------- ATD1F400.846
ATD1F400.847
! Loop over field, missing top row APB0F401.1693
DO I=START_POINT_NO_HALO,LAST_U_VALID_PT APB0F401.1694
FIELD1(I)=FIELDU(I-ROW_LENGTH)-FIELDU(I) ATD1F400.849
FIELD2(I)=FIELDV(I-ROW_LENGTH)-FIELDV(I) ATD1F400.850
END DO ATD1F400.851
ATD1F400.852
*IF DEF,GLOBAL ATD1F400.853
C CALCULATE POLAR TERMS USING ACROSS-POLE DIFFERENCE, REMEMBERING SIGN ATD1F400.854
C CHANGE ACROSS THE POLE ATD1F400.855
C NB: EFFECTIVE COS_P_LATITUDE IS 1/4 THAT AT ADJACENT ROW ATD1F400.856
ATD1F400.857
HALF_RL = global_ROW_LENGTH/2 APB0F401.1695
APB0F401.1696
*IF -DEF,MPP APB0F401.1697
ATD1F400.859
DO I=1,HALF_RL ATD1F400.860
C NORTH POLE (FIRST HALF OF ROW) ATD1F400.861
J = I+HALF_RL ATD1F400.862
FIELD1(I)=-(FIELDU(I)+FIELDU(J)) ATD1F400.863
FIELD2(I)=-(FIELDV(I)+FIELDV(J)) ATD1F400.864
FIELD1(J)=-(FIELDU(I)+FIELDU(J)) ATD1F400.865
FIELD2(J)=-(FIELDV(I)+FIELDV(J)) ATD1F400.866
ATD1F400.867
C SOUTH POLE (SECOND HALF OF ROW) ATD1F400.868
IJ = U_FIELD+J ATD1F400.869
JI = U_FIELD+I ATD1F400.870
FIELD1(IJ)= FIELDU(IJ-ROW_LENGTH)+ FIELDU(JI-ROW_LENGTH) ATD1F400.871
FIELD2(IJ)= FIELDV(IJ-ROW_LENGTH)+ FIELDV(JI-ROW_LENGTH) ATD1F400.872
FIELD1(JI)= FIELDU(IJ-ROW_LENGTH)+ FIELDU(JI-ROW_LENGTH) ATD1F400.873
FIELD2(JI)= FIELDV(IJ-ROW_LENGTH)+ FIELDV(JI-ROW_LENGTH) ATD1F400.874
END DO ATD1F400.875
*ELSE APB0F401.1698
*IF DEF,MPP,AND,DEF,T3E GSS2F403.194
c GSS2F403.195
c--for MPP Code, check that we have enough processors GSS2F403.196
if(nproc_x.eq.1 .or. nproc_y.eq.1) then GSS2F403.197
c GSS2F403.198
*ENDIF GSS2F403.199
IF (at_top_of_LPG) THEN APB0F401.1699
! North Pole APB0F401.1700
! Copy NP row into U/V_COPY arrays APB0F401.1701
DO I=1,ROW_LENGTH APB0F401.1702
J=TOP_ROW_START+I-1 ! point along North Pole row APB0F401.1703
U_COPY(I)=FIELDU(J) APB0F401.1704
V_COPY(I)=FIELDV(J) APB0F401.1705
ENDDO APB0F401.1706
APB0F401.1707
! and rotate these rows by half a global row length, so that item I now APB0F401.1708
! contains the value which was on the opposite side of the pole. APB0F401.1709
APB0F401.1710
CALL GCG_RVECSHIFT(ROW_LENGTH,ROW_LENGTH-2*EW_Halo, APB0F401.1711
& FIRST_ROW_PT,1,HALF_RL,.TRUE.,U_COPY, APB0F401.1712
& GC_ROW_GROUP,info) APB0F401.1713
CALL GCG_RVECSHIFT(ROW_LENGTH,ROW_LENGTH-2*EW_Halo, APB0F401.1714
& FIRST_ROW_PT,1,HALF_RL,.TRUE.,V_COPY, APB0F401.1715
& GC_ROW_GROUP,info) APB0F401.1716
APB0F401.1717
DO I=1,ROW_LENGTH APB0F401.1718
J=TOP_ROW_START+I-1 ! point along North Pole row APB0F401.1719
FIELD1(J)=-(FIELDU(J)+U_COPY(I)) APB0F401.1720
FIELD2(J)=-(FIELDV(J)+V_COPY(I)) APB0F401.1721
ENDDO APB0F401.1722
ENDIF ! (IF at_top_of_LPG) APB0F401.1723
APB0F401.1724
IF (at_base_of_LPG) THEN APB0F401.1725
! South Pole APB0F401.1726
! Copy SP row in U/V_COPY arrays APB0F401.1727
DO I=1,ROW_LENGTH APB0F401.1728
J=U_BOT_ROW_START+I-1 ! point along South Pole row APB0F401.1729
U_COPY(I)=FIELDU(J) APB0F401.1730
V_COPY(I)=FIELDV(J) APB0F401.1731
ENDDO APB0F401.1732
APB0F401.1733
! and rotate these rows by half a global row length, so that item I now APB0F401.1734
! contains the value which was on the opposite side of the pole. APB0F401.1735
APB0F401.1736
CALL GCG_RVECSHIFT(ROW_LENGTH,ROW_LENGTH-2*EW_Halo, APB0F401.1737
& FIRST_ROW_PT,1,HALF_RL,.TRUE.,U_COPY, APB0F401.1738
& GC_ROW_GROUP,info) APB0F401.1739
CALL GCG_RVECSHIFT(ROW_LENGTH,ROW_LENGTH-2*EW_Halo, APB0F401.1740
& FIRST_ROW_PT,1,HALF_RL,.TRUE.,V_COPY, APB0F401.1741
& GC_ROW_GROUP,info) APB0F401.1742
APB0F401.1743
DO I=1,ROW_LENGTH APB0F401.1744
J=P_BOT_ROW_START+I-1 APB0F401.1745
FIELD1(J)=U_COPY(I)+FIELDU(J-ROW_LENGTH) APB0F401.1746
FIELD2(J)=V_COPY(I)+FIELDV(J-ROW_LENGTH) APB0F401.1747
ENDDO APB0F401.1748
ENDIF ! (IF at_base_of_LPG) APB0F401.1749
*IF DEF,MPP,AND,DEF,T3E GSS2F403.200
c GSS2F403.201
else ! MPP/T3E and only 1 processor along either direction GSS2F403.202
c GSS2F403.203
call barrier() GSS2F403.204
c GSS2F403.205
IF (at_top_of_LPG) THEN GSS2F403.206
! North Pole GSS2F403.207
! Copy NP row into U/V_COPY arrays GSS2F403.208
DO I=1,ROW_LENGTH GSS2F403.209
J=TOP_ROW_START+I-1 ! point along North Pole row GSS2F403.210
U_COPY(I)=FIELDU(J) GSS2F403.211
V_COPY(I)=FIELDV(J) GSS2F403.212
ENDDO GSS2F403.213
ENDIF ! (IF at_top_of_LPG) GSS2F403.214
GSS2F403.215
IF (at_base_of_LPG) THEN GSS2F403.216
! South Pole GSS2F403.217
! Copy SP row in U/V_COPY arrays GSS2F403.218
DO I=1,ROW_LENGTH GSS2F403.219
J=U_BOT_ROW_START+I-1 ! point along South Pole row GSS2F403.220
U_COPY(I)=FIELDU(J) GSS2F403.221
V_COPY(I)=FIELDV(J) GSS2F403.222
ENDDO GSS2F403.223
ENDIF ! (IF at_base_of_LPG) GSS2F403.224
c GSS2F403.225
call barrier() GSS2F403.226
c GSS2F403.227
c--process North and South Rows together GSS2F403.228
IF (at_top_of_LPG .or. at_base_of_LPG) THEN GSS2F403.229
c--work out the PE at the start of my Row GSS2F403.230
my_row_pe=(mype/nproc_x)*nproc_x GSS2F403.231
g_start(1)=1 GSS2F403.232
c--find the global start addresses for PE's in my row GSS2F403.233
do i=2, nproc_x+1 GSS2F403.234
g_start(i)=g_start(i-1)+g_blsizep(1,i-2) GSS2F403.235
end do GSS2F403.236
c write(0,*) my_pe(), (g_start(i), i=1, nproc_x+1) GSS2F403.237
c GSS2F403.238
c--set the global start address for the start of my exchange GSS2F403.239
g_new_start=g_start(mype-my_row_pe+1)+half_rl GSS2F403.240
c--set the length of the data to exchange GSS2F403.241
l_new_length=row_length-2*ew_halo GSS2F403.242
c--set the start address GSS2F403.243
l_iadd=1+ew_halo GSS2F403.244
c--loop until we have moved all the segments for this PE GSS2F403.245
1000 continue GSS2F403.246
c--check we not off the end GSS2F403.247
if(g_new_start.gt.glsize(1)) g_new_start= GSS2F403.248
2 g_new_start-glsize(1) GSS2F403.249
c--loop over the PE's in a row GSS2F403.250
do i=1, nproc_x GSS2F403.251
c--check if this glocal address is on the the current remote PE GSS2F403.252
if(g_new_start.ge.g_start(i) .and. GSS2F403.253
2 g_new_start.lt.g_start(i+1)) then GSS2F403.254
c--compute the new local address on the remote PE GSS2F403.255
l_rem_iadd=g_new_start-g_start(i) GSS2F403.256
c--compute the number of words to move on this get GSS2F403.257
current_length=min(l_new_length, GSS2F403.258
2 g_start(i+1)-g_new_start) GSS2F403.259
c write(0,*) my_pe(), ' fetch ', current_length, GSS2F403.260
c 2 ' from PE ',i-1, ' at ',l_rem_iadd+halo_4th, GSS2F403.261
c 3 ' to ', l_iadd GSS2F403.262
c--get the data GSS2F403.263
call shmem_get(u_out_copy(l_iadd), GSS2F403.264
2 u_copy(l_rem_iadd+1+ew_halo), current_length, GSS2F403.265
3 my_row_pe+i-1) GSS2F403.266
call shmem_get(v_out_copy(l_iadd), GSS2F403.267
2 v_copy(l_rem_iadd+1+ew_halo), current_length, GSS2F403.268
3 my_row_pe+i-1) GSS2F403.269
GSS2F403.270
c--update the global address and local addresses and lengths GSS2F403.271
g_new_start=g_new_start+current_length GSS2F403.272
l_iadd=l_iadd+current_length GSS2F403.273
l_new_length=l_new_length-current_length GSS2F403.274
c--check if we have finished GSS2F403.275
if(l_new_length.gt.0) goto 1000 GSS2F403.276
goto 1100 GSS2F403.277
endif GSS2F403.278
end do GSS2F403.279
write(0,*) 'PE ', my_pe(), ' is Lost in UV_DIF ', GSS2F403.280
2 l_new_length, current_length, l_rem_iadd+halo_4th, l_iadd, GSS2F403.281
3 g_new_start, (g_start(i), i=1, nproc_x+1) GSS2F403.282
call abort('Lost in UV_DIF') GSS2F403.283
GSS2F403.284
1100 continue GSS2F403.285
u_out_copy(1)=u_copy(1) GSS2F403.286
u_out_copy(row_length)=u_copy(row_length) GSS2F403.287
v_out_copy(1)=v_copy(1) GSS2F403.288
v_out_copy(row_length)=v_copy(row_length) GSS2F403.289
c write(0,*) my_pe(), (v_copy(i), i=1, row_length) GSS2F403.290
GSS2F403.291
ENDIF ! (at_top_of_LPG .or. at_base_of_LPG) GSS2F403.292
c GSS2F403.293
IF (at_top_of_LPG) THEN GSS2F403.294
! North Pole GSS2F403.295
DO I=1,ROW_LENGTH GSS2F403.296
J=TOP_ROW_START+I-1 ! point along North Pole row GSS2F403.297
FIELD1(J)=-(FIELDU(J)+u_out_copy(I)) GSS2F403.298
FIELD2(J)=-(FIELDV(J)+v_out_copy(I)) GSS2F403.299
ENDDO GSS2F403.300
ENDIF ! (IF at_top_of_LPG) GSS2F403.301
c GSS2F403.302
IF (at_base_of_LPG) THEN GSS2F403.303
! South Pole GSS2F403.304
DO I=1,ROW_LENGTH GSS2F403.305
J=P_BOT_ROW_START+I-1 GSS2F403.306
FIELD1(J)=u_out_copy(I)+FIELDU(J-ROW_LENGTH) GSS2F403.307
FIELD2(J)=v_out_copy(I)+FIELDV(J-ROW_LENGTH) GSS2F403.308
ENDDO GSS2F403.309
ENDIF ! (IF at_base_of_LPG) GSS2F403.310
c GSS2F403.311
endif ! Code for more then one processor in each direction GSS2F403.312
c GSS2F403.313
*ENDIF GSS2F403.314
APB0F401.1750
*ENDIF APB0F401.1751
*ENDIF ATD1F400.876
ATD1F400.877
C---------------------------------------------------------------------- ATD1F400.878
CL SECTION 2.3 CALCULATE SECOND TERM IN EQUATION (47) AND ADD ATD1F400.879
CL ONTO FIRST TERM TO GET TOTAL CORRECTION. ATD1F400.880
C---------------------------------------------------------------------- ATD1F400.881
ATD1F400.882
DO I= START_U_UPDATE,END_U_UPDATE ATD1F400.883
SCALAR=SEC_U_LATITUDE(I)/RS_SQUARED_DELTAP(I) ATD1F400.884
FIELDU(I)=(FIELD3(I)+DIFFUSION_NS(I)*FIELD1(I) ATD1F400.885
& -DIFFUSION_NS(I+ROW_LENGTH)*FIELD1(I+ROW_LENGTH))* ATD1F400.886
& SCALAR ATD1F400.887
FIELDV(I)=(FIELD4(I)+DIFFUSION_NS(I)*FIELD2(I) ATD1F400.888
& -DIFFUSION_NS(I+ROW_LENGTH)*FIELD2(I+ROW_LENGTH))* ATD1F400.889
& SCALAR ATD1F400.890
END DO ATD1F400.891
ATD1F400.892
CL LIMITED AREA ZERO AT LATERAL BOUNDARIES ATD1F400.893
ATD1F400.894
*IF -DEF,GLOBAL ATD1F400.895
ATD1F400.896
! Set all boundaries of the increment to zero. APB0F401.1752
*IF DEF,MPP APB0F401.1753
IF (at_top_of_LPG) THEN APB0F401.1754
*ENDIF APB0F401.1755
! Northern boundary APB0F401.1756
DO I=TOP_ROW_START,TOP_ROW_START+ROW_LENGTH-1 APB0F401.1757
FIELDU(I)=0.0 APB0F401.1758
FIELDV(I)=0.0 APB0F401.1759
ENDDO APB0F401.1760
*IF DEF,MPP APB0F401.1761
ENDIF APB0F401.1762
APB0F401.1763
IF (at_base_of_LPG) THEN APB0F401.1764
*ENDIF APB0F401.1765
! Southern boundary APB0F401.1766
DO I=U_BOT_ROW_START,U_BOT_ROW_START+ROW_LENGTH-1 APB0F401.1767
FIELDU(I)=0.0 APB0F401.1768
FIELDV(I)=0.0 APB0F401.1769
ENDDO APB0F401.1770
*IF DEF,MPP APB0F401.1771
ENDIF APB0F401.1772
APB0F401.1773
IF (at_left_of_LPG) THEN APB0F401.1774
*ENDIF APB0F401.1775
! Western boundary APB0F401.1776
DO I=START_U_UPDATE+FIRST_ROW_PT-1,END_U_UPDATE,ROW_LENGTH APB0F401.1777
FIELDU(I)=0.0 APB0F401.1778
FIELDV(I)=0.0 APB0F401.1779
ENDDO APB0F401.1780
*IF DEF,MPP APB0F401.1781
ENDIF APB0F401.1782
APB0F401.1783
IF (at_right_of_LPG) THEN APB0F401.1784
*ENDIF APB0F401.1785
! Eastern boundary - set last two points of each row to zero APB0F401.1786
DO I=START_U_UPDATE+LAST_ROW_PT-2,END_U_UPDATE,ROW_LENGTH APB0F401.1787
FIELDU(I)=0.0 APB0F401.1788
FIELDU(I+1)=0.0 APB0F401.1789
FIELDV(I)=0.0 APB0F401.1790
FIELDV(I+1)=0.0 APB0F401.1791
ENDDO APB0F401.1792
*IF DEF,MPP APB0F401.1793
ENDIF APB0F401.1794
*ENDIF APB0F401.1795
ATD1F400.913
*ENDIF ATD1F400.914
CL END OF ROUTINE UV_DIF UVDIF1A.267
UVDIF1A.268
RETURN UVDIF1A.269
END UVDIF1A.270
*ENDIF UVDIF1A.271