*IF DEF,SEAICE,OR,DEF,S40_1A SJC0F305.8
C ******************************COPYRIGHT****************************** GTS2F400.1513
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.1514
C GTS2F400.1515
C Use, duplication or disclosure of this code is subject to the GTS2F400.1516
C restrictions as set forth in the contract. GTS2F400.1517
C GTS2F400.1518
C Meteorological Office GTS2F400.1519
C London Road GTS2F400.1520
C BRACKNELL GTS2F400.1521
C Berkshire UK GTS2F400.1522
C RG12 2SZ GTS2F400.1523
C GTS2F400.1524
C If no contract has been raised with this copy of the code, the use, GTS2F400.1525
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.1526
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.1527
C Modelling at the above address. GTS2F400.1528
C ******************************COPYRIGHT****************************** GTS2F400.1529
C GTS2F400.1530
C*LL CU_TO_H.3
CLL SUBROUTINE CU_TO_H CU_TO_H.4
CLL ------------------- CU_TO_H.5
CLL CU_TO_H.6
CLL DYNAMIC SEA ICE MODEL SUBROUTINE TO INTERPOLATE FIELDS ON CU_TO_H.7
CLL ARAKAWA C GRID U POINTS TO ARAKAWA B GRID MASS POINTS. CU_TO_H.8
CLL CU_TO_H.9
CLL IT CAN BE COMPILED BY CFT77, BUT DOES NOT CONFORM TO ANSI CU_TO_H.10
CLL FORTRAN77 STANDARDS, BECAUSE OF THE INLINE COMMENTS. CU_TO_H.11
CLL CU_TO_H.12
CLL ALL QUANTITIES IN THIS ROUTINE ARE IN S.I. UNITS UNLESS CU_TO_H.13
CLL OTHERWISE STATED. CU_TO_H.14
CLL CU_TO_H.15
CLL WRITTEN BY J.F.THOMSON (07/05/93) CU_TO_H.16
CLL CU_TO_H.17
CLL MODEL MODIFICATION HISTORY: CU_TO_H.18
CLL VERSION DATE CU_TO_H.19
CLL 3.4 6/94 Generalise for use by SLAB ice dynamics. J.Thomson SJT1F304.1107
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.4711
CLL CU_TO_H.20
CLL THIS ROUTINE FORMS PART OF SYSTEM COMPONENT P4. CU_TO_H.21
CLL CU_TO_H.22
CLL ADHERES TO THE STANDARDS OF DOCUMENTATION PAPER 4, VERSION 1. CU_TO_H.23
CLL CU_TO_H.24
CLLEND--------------------------------------------------------------- CU_TO_H.25
C*L CU_TO_H.26
subroutine cu_to_h( 1,1CU_TO_H.27
*CALL ARGOINDX
ORH7F402.214
& data_cu CU_TO_H.28
&,data_h CU_TO_H.29
&,imt CU_TO_H.30
&,jmt CU_TO_H.31
&,jmtm1 CU_TO_H.32
& ) CU_TO_H.33
C CU_TO_H.34
implicit none CU_TO_H.35
*CALL CNTLOCN
ORH1F305.4712
*CALL TYPOINDX
ORH7F402.215
C CU_TO_H.36
integer CU_TO_H.37
& jmt ! in number of rows on mass grid. CU_TO_H.38
&,jmtm1 ! in number of rows on velocity grid. CU_TO_H.39
&,imt ! in number of points in each mass row. CU_TO_H.40
real CU_TO_H.41
& data_h(imt,jmt) ! out data on mass grid. CU_TO_H.42
&,data_cu(imt,jmtm1) ! in data on C grid x velocity points. CU_TO_H.43
C CU_TO_H.44
C variables local to this subroutine are now defined CU_TO_H.45
C CU_TO_H.46
integer CU_TO_H.47
& i CU_TO_H.48
&,j CU_TO_H.49
C* CU_TO_H.50
C start executable code CU_TO_H.51
*IF DEF,MPP,AND,-DEF,SLAB SCH0F405.51
C===================================================================== ORH4F402.201
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION ORH4F402.202
C===================================================================== ORH4F402.203
ORH4F402.204
CALL SWAPBOUNDS
(DATA_CU,IMT,JMTM1,O_EW_HALO,O_NS_HALO,1) ORH4F402.205
ORH4F402.206
*ENDIF ORH4F402.207
ORH4F402.208
ORH4F402.209
C CU_TO_H.52
C Interpolate velocity field. CU_TO_H.53
C CU_TO_H.54
do j=j_2,j_jmt ORH3F402.43
do i=2,imt CU_TO_H.56
data_h(i,j) = ( data_cu(i-1,j-1) + data_cu(i,j-1) ) * 0.5 CU_TO_H.57
end do CU_TO_H.58
*IF DEF,SLAB,AND,DEF,GLOBAL SJT1F304.1108
data_h(1,j) = ( data_cu(imt,j-1) + data_cu(1,j-1) ) * 0.5 SJT1F304.1109
*ELSE SJT1F304.1110
data_h(1,j) = data_cu(1,j-1) CU_TO_H.60
*ENDIF CU_TO_H.61
end do CU_TO_H.62
do i=1,imt CU_TO_H.63
data_h(i,1) = data_h(i,2) CU_TO_H.64
end do CU_TO_H.65
IF (L_OCYCLIC) THEN ORH1F305.4713
C CU_TO_H.67
C Make cyclic if necessary. CU_TO_H.68
C CU_TO_H.69
do j=j_1,j_jmt ORH3F402.44
data_h(1,j) = data_h(imt-1,j) CU_TO_H.71
data_h(imt,j) = data_h(2,j) CU_TO_H.72
end do CU_TO_H.73
ENDIF ORH1F305.4714
C CU_TO_H.75
return CU_TO_H.76
end CU_TO_H.77
*ENDIF CU_TO_H.78