*IF DEF,SEAICE,OR,DEF,S40_1A SJC0F305.12
C ******************************COPYRIGHT****************************** GTS2F400.10963
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.10964
C GTS2F400.10965
C Use, duplication or disclosure of this code is subject to the GTS2F400.10966
C restrictions as set forth in the contract. GTS2F400.10967
C GTS2F400.10968
C Meteorological Office GTS2F400.10969
C London Road GTS2F400.10970
C BRACKNELL GTS2F400.10971
C Berkshire UK GTS2F400.10972
C RG12 2SZ GTS2F400.10973
C GTS2F400.10974
C If no contract has been raised with this copy of the code, the use, GTS2F400.10975
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.10976
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.10977
C Modelling at the above address. GTS2F400.10978
C ******************************COPYRIGHT****************************** GTS2F400.10979
C GTS2F400.10980
C*LL UV_TO_CU.3
CLL SUBROUTINE UV_TO_CU UV_TO_CU.4
CLL ------------------- UV_TO_CU.5
CLL UV_TO_CU.6
CLL DYNAMIC SEA ICE MODEL SUBROUTINE TO INTERPOLATE X COMPONENT UV_TO_CU.7
CLL FIELDS ON ARAKAWA B GRID VELOCITY POINTS TO ARAKAWA C GRID. UV_TO_CU.8
CLL UV_TO_CU.9
CLL IT CAN BE COMPILED BY CFT77, BUT DOES NOT CONFORM TO ANSI UV_TO_CU.10
CLL FORTRAN77 STANDARDS, BECAUSE OF THE INLINE COMMENTS. UV_TO_CU.11
CLL UV_TO_CU.12
CLL ALL QUANTITIES IN THIS ROUTINE ARE IN S.I. UNITS UNLESS UV_TO_CU.13
CLL OTHERWISE STATED. UV_TO_CU.14
CLL UV_TO_CU.15
CLL WRITTEN BY J.F.THOMSON (07/05/93) UV_TO_CU.16
CLL UV_TO_CU.17
CLL MODEL MODIFICATION HISTORY: UV_TO_CU.18
CLL VERSION DATE UV_TO_CU.19
CLL 3.4Generalise for slab model. J.Thomson SJT1F304.1040
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.5367
! 4.3 01.02.97 Correct indices on data_cu/data_uv. R.Hill ORH3F403.81
! 4.5 03/09/98 For CALL SWAPBOUNDS change all *IF DEF,MPP SCH0F405.35
! to be *IF DEF,MPP,AND,-DEF,SLAB since the SCH0F405.36
! slab model can now run with mpp selected. SCH0F405.37
! C. D. Hewitt SCH0F405.38
CLL UV_TO_CU.20
CLL ADHERES TO THE STANDARDS OF DOCUMENTATION PAPER 4, VERSION 1. UV_TO_CU.21
CLL UV_TO_CU.22
CLL THIS ROUTINE FORMS PART OF SYSTEM COMPONENT P4. UV_TO_CU.23
CLL UV_TO_CU.24
CLLEND--------------------------------------------------------------- UV_TO_CU.25
C*L UV_TO_CU.26
subroutine uv_to_cu( 6,1UV_TO_CU.27
*CALL ARGOINDX
ORH7F402.206
& data_uv UV_TO_CU.28
&,data_cu UV_TO_CU.29
&,jmtm1 UV_TO_CU.30
&,imt UV_TO_CU.31
& ) UV_TO_CU.32
C UV_TO_CU.33
implicit none UV_TO_CU.34
*CALL CNTLOCN
ORH1F305.5368
*CALL TYPOINDX
ORH7F402.207
C UV_TO_CU.35
integer UV_TO_CU.36
& jmtm1 ! in number of rows on velocity grid. UV_TO_CU.37
&,imt ! in number of points in each row. UV_TO_CU.38
real UV_TO_CU.39
& data_uv(imt,jmtm1) ! in data on B grid. UV_TO_CU.40
&,data_cu(imt,jmtm1) ! out data on C grid. UV_TO_CU.41
C UV_TO_CU.42
C variables local to this subroutine are now defined UV_TO_CU.43
C UV_TO_CU.44
integer UV_TO_CU.45
& i UV_TO_CU.46
&,j UV_TO_CU.47
C* UV_TO_CU.48
C start executable code UV_TO_CU.49
C UV_TO_CU.50
*IF DEF,MPP,AND,-DEF,SLAB SCH0F405.39
C===================================================================== ORH4F402.174
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION ORH4F402.175
C===================================================================== ORH4F402.176
ORH4F402.177
CALL SWAPBOUNDS
(DATA_UV,IMT,JMTM1,O_EW_HALO,O_NS_HALO,1) ORH4F402.178
ORH4F402.179
*ENDIF ORH4F402.180
ORH4F402.181
C Interpolate velocity field. UV_TO_CU.51
C UV_TO_CU.52
do j=J_1,J_jmtm2 ORH3F402.398
do i=1,imt UV_TO_CU.54
data_cu(i,j) = ( data_uv(i,j) + data_uv(i,j+1) ) * 0.5 UV_TO_CU.55
end do UV_TO_CU.56
end do UV_TO_CU.57
*IF DEF,MPP,AND,-DEF,SLAB SCH0F405.40
IF (JST.LE.JMTM1_GLOBAL.AND.JFIN.GE.JMTM1_GLOBAL) THEN ORH3F402.400
*ENDIF ORH3F402.401
do i=1,imt UV_TO_CU.58
data_cu(i,J_jmtm1) = data_uv(i,J_jmtm1) ORH3F403.82
end do UV_TO_CU.60
*IF DEF,MPP,AND,-DEF,SLAB SCH0F405.41
ENDIF ORH3F402.403
*ENDIF ORH3F402.404
*IF DEF,OCEAN SJT1F304.1041
IF (L_OCYCLIC) THEN ORH1F305.5369
C UV_TO_CU.62
C Make cyclic if necessary. UV_TO_CU.63
C UV_TO_CU.64
do j=J_1,J_jmtm1 ORH3F402.405
ORH3F402.406
data_cu(1,j) = data_cu(imt-1,j) UV_TO_CU.66
data_cu(imt,j) = data_cu(2,j) UV_TO_CU.67
end do UV_TO_CU.68
ENDIF ORH1F305.5370
*ENDIF UV_TO_CU.69
C UV_TO_CU.70
return UV_TO_CU.71
end UV_TO_CU.72
*ENDIF UV_TO_CU.73