*IF DEF,SEAICE,OR,DEF,S40_1A SJC0F305.9
C ******************************COPYRIGHT****************************** GTS2F400.1549
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.1550
C GTS2F400.1551
C Use, duplication or disclosure of this code is subject to the GTS2F400.1552
C restrictions as set forth in the contract. GTS2F400.1553
C GTS2F400.1554
C Meteorological Office GTS2F400.1555
C London Road GTS2F400.1556
C BRACKNELL GTS2F400.1557
C Berkshire UK GTS2F400.1558
C RG12 2SZ GTS2F400.1559
C GTS2F400.1560
C If no contract has been raised with this copy of the code, the use, GTS2F400.1561
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.1562
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.1563
C Modelling at the above address. GTS2F400.1564
C ******************************COPYRIGHT****************************** GTS2F400.1565
C GTS2F400.1566
C*LL CV_TO_H.3
CLL SUBROUTINE CV_TO_H CV_TO_H.4
CLL ------------------- CV_TO_H.5
CLL CV_TO_H.6
CLL DYNAMIC SEA ICE MODEL SUBROUTINE TO INTERPOLATE FIELDS ON CV_TO_H.7
CLL ARAKAWA C GRID V POINTS TO ARAKAWA B GRID MASS POINTS. CV_TO_H.8
CLL CV_TO_H.9
CLL IT CAN BE COMPILED BY CFT77, BUT DOES NOT CONFORM TO ANSI CV_TO_H.10
CLL FORTRAN77 STANDARDS, BECAUSE OF THE INLINE COMMENTS. CV_TO_H.11
CLL CV_TO_H.12
CLL ALL QUANTITIES IN THIS ROUTINE ARE IN S.I. UNITS UNLESS CV_TO_H.13
CLL OTHERWISE STATED. CV_TO_H.14
CLL CV_TO_H.15
CLL WRITTEN BY J.F.THOMSON (07/05/93) CV_TO_H.16
CLL CV_TO_H.17
CLL MODEL MODIFICATION HISTORY: CV_TO_H.18
CLL VERSION DATE CV_TO_H.19
CLL 3.4 6/94 Generalise for use by SLAB ice dynamics. J.Thomson SJT1F304.1112
CLL CV_TO_H.20
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.4719
CLL THIS ROUTINE FORMS PART OF SYSTEM COMPONENT P4. CV_TO_H.21
CLL CV_TO_H.22
CLL ADHERES TO THE STANDARDS OF DOCUMENTATION PAPER 4, VERSION 1. CV_TO_H.23
CLL CV_TO_H.24
CLLEND--------------------------------------------------------------- CV_TO_H.25
C*L CV_TO_H.26
subroutine cv_to_h( 1,1CV_TO_H.27
*CALL ARGOINDX
ORH7F402.216
& data_cv CV_TO_H.28
&,data_h CV_TO_H.29
&,imt CV_TO_H.30
&,jmt CV_TO_H.31
&,jmtm1 CV_TO_H.32
& ) CV_TO_H.33
C CV_TO_H.34
implicit none CV_TO_H.35
C CV_TO_H.36
*CALL CNTLOCN
ORH1F305.4720
*CALL TYPOINDX
ORH7F402.217
! ORH1F305.4721
integer CV_TO_H.37
& jmt ! in number of rows on mass grid. CV_TO_H.38
&,jmtm1 ! in number of rows on velocity grid. CV_TO_H.39
&,imt ! in number of points in each mass row. CV_TO_H.40
real CV_TO_H.41
& data_h(imt,jmt) ! out data on mass grid. CV_TO_H.42
&,data_cv(imt,jmtm1) ! in data on C grid y velocity points. CV_TO_H.43
C CV_TO_H.44
C variables local to this subroutine are now defined CV_TO_H.45
C CV_TO_H.46
integer CV_TO_H.47
& i CV_TO_H.48
&,j CV_TO_H.49
C* CV_TO_H.50
C start executable code CV_TO_H.51
*IF DEF,MPP,AND,-DEF,SLAB SCH0F405.52
C===================================================================== ORH4F402.211
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION ORH4F402.212
C===================================================================== ORH4F402.213
ORH4F402.214
CALL SWAPBOUNDS
(DATA_CV,IMT,JMTM1,O_EW_HALO,O_NS_HALO,1) ORH4F402.215
ORH4F402.216
*ENDIF ORH4F402.217
ORH4F402.218
ORH4F402.219
ORH4F402.220
ORH4F402.221
ORH4F402.222
ORH4F402.223
ORH4F402.224
ORH4F402.225
ORH4F402.226
ORH4F402.227
ORH4F402.228
ORH4F402.229
ORH4F402.230
ORH4F402.231
ORH4F402.232
ORH4F402.233
C CV_TO_H.52
C Interpolate velocity field. CV_TO_H.53
C CV_TO_H.54
do j = j_2, j_jmtm1 ORH3F402.53
do i=2,imt CV_TO_H.56
data_h(i,j) = ( data_cv(i-1,j-1) + data_cv(i-1,j) ) * 0.5 CV_TO_H.57
end do CV_TO_H.58
end do SJT1F304.1113
do i=2,imt CV_TO_H.66
*IF DEF,MPP ORH3F402.54
IF (JST.EQ.1) THEN ORH3F402.55
data_h(i,J_1) = data_cv(i-1,J_1) ORH3F402.56
ENDIF ORH3F402.57
IF (JFIN.EQ.JMT_global) THEN ORH3F402.58
data_h(i,j_jmt) = data_cv(i-1,J_jmt-1) ORH3F402.59
ENDIF ORH3F402.60
*ELSE ORH3F402.61
data_h(i,1) = data_cv(i-1,1) CV_TO_H.67
data_h(i,jmt) = data_cv(i-1,jmtm1) CV_TO_H.68
*ENDIF ORH3F402.62
end do CV_TO_H.69
*IF DEF,SLAB,AND,DEF,GLOBAL SJT1F304.1114
do j=2,jmtm1 SJT1F304.1115
data_h(1,j) = ( data_cv(imt,j-1) + data_cv(imt,j) ) * 0.5 SJT1F304.1116
end do SJT1F304.1117
data_h(1,1) = data_cv(imt,1) SJT1F304.1118
data_h(1,jmt) = data_cv(imt,jmtm1) SJT1F304.1119
*ELSE CV_TO_H.72
do j = j_2, j_jmtm1 ORH3F402.63
data_h(1,j) = data_h(2,j) SJT1F304.1121
end do SJT1F304.1122
*IF DEF,MPP ORH3F402.64
IF (JST.EQ.1) THEN ORH3F402.65
data_h(1,J_1) = data_cv(1,J_1) ORH3F402.66
ENDIF ORH3F402.67
IF (JFIN.EQ.JMT_global) THEN ORH3F402.68
data_h(1,J_jmt) = data_cv(1,J_jmt-1) ORH3F402.69
ENDIF ORH3F402.70
*ELSE ORH3F402.71
data_h(1,1) = data_cv(1,1) SJT1F304.1123
data_h(1,jmt) = data_cv(1,jmtm1) SJT1F304.1124
*ENDIF ORH3F402.72
*ENDIF SJT1F304.1125
IF (L_OCYCLIC) THEN ORH1F305.4722
C CV_TO_H.73
C Make cyclic if necessary. CV_TO_H.74
C CV_TO_H.75
do j=J_1,J_jmt ORH3F402.73
data_h(1,j) = data_h(imt-1,j) SJT1F304.1127
data_h(imt,j)= data_h(2,j) SJT1F304.1128
end do CV_TO_H.79
ENDIF ORH1F305.4723
C CV_TO_H.81
return CV_TO_H.82
end CV_TO_H.83
*ENDIF CV_TO_H.84