*IF DEF,SEAICE,OR,DEF,S40_1A SJC0F305.14
C ******************************COPYRIGHT****************************** GTS2F400.10999
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.11000
C GTS2F400.11001
C Use, duplication or disclosure of this code is subject to the GTS2F400.11002
C restrictions as set forth in the contract. GTS2F400.11003
C GTS2F400.11004
C Meteorological Office GTS2F400.11005
C London Road GTS2F400.11006
C BRACKNELL GTS2F400.11007
C Berkshire UK GTS2F400.11008
C RG12 2SZ GTS2F400.11009
C GTS2F400.11010
C If no contract has been raised with this copy of the code, the use, GTS2F400.11011
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.11012
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.11013
C Modelling at the above address. GTS2F400.11014
C ******************************COPYRIGHT****************************** GTS2F400.11015
C GTS2F400.11016
C*LL UV_TO_H.3
CLL SUBROUTINE UV_TO_H UV_TO_H.4
CLL ------------------- UV_TO_H.5
CLL UV_TO_H.6
CLL DYNAMIC SEA ICE MODEL SUBROUTINE TO INTERPOLATE ARAKAWA B GRID UV_TO_H.7
CLL VELOCITY POINTS TO MASS POINTS. UV_TO_H.8
CLL UV_TO_H.9
CLL IT CAN BE COMPILED BY CFT77, BUT DOES NOT CONFORM TO ANSI UV_TO_H.10
CLL FORTRAN77 STANDARDS, BECAUSE OF THE INLINE COMMENTS. UV_TO_H.11
CLL UV_TO_H.12
CLL ALL QUANTITIES IN THIS ROUTINE ARE IN S.I. UNITS UNLESS UV_TO_H.13
CLL OTHERWISE STATED. UV_TO_H.14
CLL UV_TO_H.15
CLL WRITTEN BY J.F.THOMSON (20/05/93) UV_TO_H.16
CLL UV_TO_H.17
CLL MODEL MODIFICATION HISTORY: UV_TO_H.18
CLL VERSION DATE UV_TO_H.19
CLL 3.4 6/94 Generalise for use by SLAB ice dynamics. J.Thomson SJT1F304.1087
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.5376
! 4.3 01.02.97 Correct indices on data_h. R.Hill ORH3F403.83
CLL UV_TO_H.20
CLL THIS ROUTINE FORMS PART OF SYSTEM COMPONENT P4. UV_TO_H.21
CLL UV_TO_H.22
CLL ADHERES TO THE STANDARDS OF DOCUMENTATION PAPER 4, VERSION 1. UV_TO_H.23
CLL UV_TO_H.24
CLLEND--------------------------------------------------------------- UV_TO_H.25
C*L UV_TO_H.26
subroutine uv_to_h( 5,2UV_TO_H.27
*CALL ARGOINDX 
ORH7F402.200
& data_uv UV_TO_H.28
&,data_h UV_TO_H.29
&,imt,jmt,jmtm1 UV_TO_H.30
& ) UV_TO_H.31
C UV_TO_H.32
implicit none UV_TO_H.33
C UV_TO_H.34
*CALL CNTLOCN ORH1F305.5377
*CALL TYPOINDX ORH7F402.201
! ORH1F305.5378
integer UV_TO_H.35
& jmt ! in number of rows on mass grid. UV_TO_H.36
&,jmtm1 ! in number of rows on velocity grid. UV_TO_H.37
&,imt ! in number of points in each mass row. UV_TO_H.38
real UV_TO_H.39
& data_uv(imt,jmtm1)! in data on B grid velocity points. UV_TO_H.40
&,data_h(imt,jmt) ! out data on mass grid UV_TO_H.41
C UV_TO_H.42
C variables local to this subroutine are now defined UV_TO_H.43
C UV_TO_H.44
integer UV_TO_H.45
& i UV_TO_H.46
&,j UV_TO_H.47
&,imtm1 UV_TO_H.48
C* UV_TO_H.49
C start executable code UV_TO_H.50
*IF DEF,MPP,AND,-DEF,SLAB SCH0F405.42
C===================================================================== ORH4F402.192
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION ORH4F402.193
C===================================================================== ORH4F402.194
ORH4F402.195
CALL SWAPBOUNDS(DATA_UV,IMT,JMTM1,O_EW_HALO,O_NS_HALO,1) ORH4F402.196
ORH4F402.197
*ENDIF ORH4F402.198
ORH4F402.199
C UV_TO_H.51
imtm1 = imt - 1 UV_TO_H.52
C UV_TO_H.53
C Interpolate velocitiy field. UV_TO_H.54
C UV_TO_H.55
do j=J_2,J_jmtm1 ORH3F402.410
do i=2,imt UV_TO_H.57
data_h(i,j) = (data_uv(i-1,j-1)+data_uv(i,j-1)+data_uv(i-1,j) UV_TO_H.58
& + data_uv(i,j) ) * 0.25 UV_TO_H.59
end do UV_TO_H.60
end do UV_TO_H.61
*IF DEF,MPP,AND,-DEF,SLAB SCH0F405.43
IF (JST.LE.1.AND.JFIN.GE.1) THEN ORH3F402.412
*ENDIF ORH3F402.413
do i=2,imt UV_TO_H.62
data_h(i,1) = ( data_uv(i-1,1) + data_uv(i,1) ) * 0.5 UV_TO_H.63
end do UV_TO_H.64
*IF DEF,MPP,AND,-DEF,SLAB SCH0F405.44
ENDIF ORH3F402.415
*ENDIF ORH3F402.416
IF (L_OCYCLIC) THEN ORH1F305.5379
C UV_TO_H.74
C Make cyclic if necessary. UV_TO_H.75
C UV_TO_H.76
do j=J_1,J_jmtm1 ORH3F402.417
data_h(1,j) = data_h(imtm1,j) UV_TO_H.78
data_h(imt,j) = data_h(2,j) UV_TO_H.79
end do UV_TO_H.80
ELSE ORH1F305.5380
*IF DEF,SLAB,AND,DEF,GLOBAL SJT1F304.1090
C For atmosphere model cyclic conditions. SJT1F304.1091
do j=2,jmtm1 SJT1F304.1092
data_h(1,j) = (data_uv(imt,j-1)+data_uv(1,j-1)+data_uv(imt,j) SJT1F304.1093
& + data_uv(1,j) ) * 0.25 SJT1F304.1094
end do SJT1F304.1095
data_h(1,1) = data_uv(1,1) SJT1F304.1096
*ELSE SJT1F304.1097
C SJT1F304.1098
C For non-cyclic boundary conditions, deal with boundaries. SJT1F304.1099
C SJT1F304.1100
do j=J_2,J_jmtm1 ORH3F402.418
data_h(1,j) = ( data_uv(1,j-1) + data_uv(1,j) ) * 0.5 SJT1F304.1102
end do SJT1F304.1103
*IF DEF,MPP,AND,-DEF,SLAB SCH0F405.45
IF (JST.LE.1.AND.JFIN.GE.1) THEN ORH3F402.420
*ENDIF ORH3F402.421
data_h(1,1) = data_uv(1,1) SJT1F304.1104
*IF DEF,MPP,AND,-DEF,SLAB SCH0F405.46
ENDIF ORH3F402.423
*ENDIF ORH3F402.424
*ENDIF SJT1F304.1105
ENDIF ORH1F305.5381
*IF DEF,MPP,AND,-DEF,SLAB SCH0F405.47
! If rows JMTM1_GLOBAL and JMT_GLOBAL are not on the same ORH3F402.426
! processor, we must send JMTM1_GLOBAL to the process ORH3F402.427
! dealing with JMT_GLOBAL. Use SWAPBOUNDS to do this for now. ORH3F402.428
CALL SWAPBOUNDS (data_h,IMT,JMT,O_EW_Halo,O_NS_Halo,1) ORH3F402.429
ORH3F402.430
IF (JST.LE.JMT_GLOBAL.AND.JFIN.GE.JMT_GLOBAL) THEN ORH3F402.431
*ENDIF ORH3F402.432
do i=1,imt UV_TO_H.82
data_h(i,J_jmt) = data_h(i,J_jmtm1) ORH3F403.84
end do UV_TO_H.84
*IF DEF,MPP,AND,-DEF,SLAB SCH0F405.48
ENDIF ORH3F402.434
*ENDIF ORH3F402.435
C UV_TO_H.85
return UV_TO_H.86
end UV_TO_H.87
*ENDIF UV_TO_H.88