*IF DEF,SEAICE,OR,DEF,S40_1A SJC0F305.10
C ******************************COPYRIGHT****************************** GTS2F400.4195
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.4196
C GTS2F400.4197
C Use, duplication or disclosure of this code is subject to the GTS2F400.4198
C restrictions as set forth in the contract. GTS2F400.4199
C GTS2F400.4200
C Meteorological Office GTS2F400.4201
C London Road GTS2F400.4202
C BRACKNELL GTS2F400.4203
C Berkshire UK GTS2F400.4204
C RG12 2SZ GTS2F400.4205
C GTS2F400.4206
C If no contract has been raised with this copy of the code, the use, GTS2F400.4207
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.4208
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.4209
C Modelling at the above address. GTS2F400.4210
C ******************************COPYRIGHT****************************** GTS2F400.4211
C GTS2F400.4212
C*LL H_TO_CU.3
CLL SUBROUTINE H_TO_CU H_TO_CU.4
CLL ------------------- H_TO_CU.5
CLL H_TO_CU.6
CLL DYNAMIC SEA ICE MODEL SUBROUTINE TO INTERPOLATE FIELDS ON H_TO_CU.7
CLL ARAKAWA B GRID MASS POINTS TO ARAKAWA C GRID U POINTS. H_TO_CU.8
CLL H_TO_CU.9
CLL IT CAN BE COMPILED BY CFT77, BUT DOES NOT CONFORM TO ANSI H_TO_CU.10
CLL FORTRAN77 STANDARDS, BECAUSE OF THE INLINE COMMENTS. H_TO_CU.11
CLL IT ADHERES TO THE STANDARDS OF DOCUMENTATION PAPER 4, VERSION 1. H_TO_CU.12
CLL H_TO_CU.13
CLL ALL QUANTITIES IN THIS ROUTINE ARE IN S.I. UNITS UNLESS H_TO_CU.14
CLL OTHERWISE STATED. H_TO_CU.15
CLL H_TO_CU.16
CLL WRITTEN BY J.F.THOMSON (07/05/93) H_TO_CU.17
CLL H_TO_CU.18
CLL MODEL MODIFICATION HISTORY: H_TO_CU.19
CLL VERSION DATE H_TO_CU.20
CLL 3.4Generalise for slab model. J Thomson SJT1F304.1057
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.4730
CLL H_TO_CU.21
CLL THIS ROUTINE FORMS PART OF SYSTEM COMPONENT P4. H_TO_CU.22
CLL H_TO_CU.23
CLL IT ADHERES TO THE STANDARDS OF DOCUMENTATION PAPER 4, VERSION 1. H_TO_CU.24
CLL H_TO_CU.25
CLLEND--------------------------------------------------------------- H_TO_CU.26
C*L H_TO_CU.27
subroutine h_to_cu( 5,1H_TO_CU.28
*CALL ARGOINDX 
ORH7F402.202
& data_h H_TO_CU.29
&,data_cu H_TO_CU.30
&,jmt H_TO_CU.31
&,jmtm1 H_TO_CU.32
&,imt H_TO_CU.33
& ) H_TO_CU.34
C H_TO_CU.35
implicit none H_TO_CU.36
C H_TO_CU.37
! ORH3F402.343
*CALL CNTLOCN ORH1F305.4731
*CALL TYPOINDX ORH7F402.203
integer H_TO_CU.38
& jmt ! in number of rows on mass grid. H_TO_CU.39
&,jmtm1 ! in number of rows on velocity grid. H_TO_CU.40
&,imt ! in number of points in each mass row. H_TO_CU.41
real H_TO_CU.42
& data_h(imt,jmt) ! in data on mass grid. H_TO_CU.43
&,data_cu(imt,jmtm1) ! out data on C grid x velocity points. H_TO_CU.44
C H_TO_CU.45
C variables local to this subroutine are now defined H_TO_CU.46
C H_TO_CU.47
integer H_TO_CU.48
& i H_TO_CU.49
&,j H_TO_CU.50
&,imtm1 H_TO_CU.51
C* H_TO_CU.52
C start executable code H_TO_CU.53
*IF DEF,MPP,AND,-DEF,SLAB SCH0F405.49
C===================================================================== ORH4F402.156
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION ORH4F402.157
C===================================================================== ORH4F402.158
ORH4F402.159
CALL SWAPBOUNDS(DATA_H,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.160
ORH4F402.161
*ENDIF ORH4F402.162
ORH4F402.163
C H_TO_CU.54
imtm1 = imt - 1 H_TO_CU.55
C H_TO_CU.56
C Interpolate velocity field. H_TO_CU.57
C H_TO_CU.58
do j=J_1,J_jmtm1 ORH3F402.344
do i=1,imtm1 H_TO_CU.60
data_cu(i,j) = ( data_h(i,j+1) + data_h(i+1,j+1) ) * 0.5 H_TO_CU.61
end do H_TO_CU.62
*IF DEF,SLAB SJT1F304.1058
data_cu(imt,j) = ( data_h(imt,j+1) + data_h(1,j+1) ) * 0.5 SJT1F304.1059
*ENDIF SJT1F304.1060
end do H_TO_CU.63
*IF DEF,OCEAN SJT1F304.1061
IF (L_OCYCLIC) THEN ORH1F305.4732
C H_TO_CU.72
C Make cyclic if necessary. H_TO_CU.73
C H_TO_CU.74
do j=J_1,J_jmtm1 ORH3F402.345
data_cu(1,j) = data_cu(imt-1,j) H_TO_CU.76
data_cu(imt,j) = data_cu(2,j) H_TO_CU.77
end do H_TO_CU.78
ELSE ORH1F305.4733
C SJT1F304.1064
C Deal with non cyclic boundaries SJT1F304.1065
C SJT1F304.1066
do j=J_1,J_jmtm1 ORH3F402.346
data_cu(imt,j) = data_h(imt,j+1) SJT1F304.1068
end do SJT1F304.1069
ENDIF ORH1F305.4734
*ENDIF H_TO_CU.79
C H_TO_CU.80
return H_TO_CU.81
end H_TO_CU.82
*ENDIF H_TO_CU.83