1 
C $Header: /u/gcmpack/MITgcm/verification/aim.5l_cs/code/mom_vi_hfacz_diss.F,v 1.1 2002/01/09 00:28:56 jmc Exp $ 
2 
C $Name: $ 
3 

4 
#include "CPP_OPTIONS.h" 
5 

6 
SUBROUTINE MOM_VI_HFACZ_DISS( 
7 
I bi,bj,k, 
8 
O hFacZ,r_hFacZ, 
9 
I myThid) 
10 
IMPLICIT NONE 
11 
C 
12 
C Compute hFactor (and reciprol) at the corner (Zpoint) 
13 
C used for vorticity,divergence form of viscous term 
14 
C (also in Shap_S2 formulation) 
15 
C 
16 

17 
C == Global variables == 
18 
#include "SIZE.h" 
19 
#include "EEPARAMS.h" 
20 
#include "PARAMS.h" 
21 
#include "GRID.h" 
22 

23 
C == Routine arguments == 
24 
INTEGER bi,bj,k 
25 
_RS hFacZ(1OLx:sNx+OLx,1OLy:sNy+OLy) 
26 
_RS r_hFacZ(1OLx:sNx+OLx,1OLy:sNy+OLy) 
27 
_RS hFacZOpen 
28 
INTEGER myThid 
29 

30 
C == Local variables == 
31 
INTEGER I,J 
32 

33 
C Calculate open water fraction at vorticity points 
34 

35 
DO i=1Olx,sNx+Olx 
36 
hFacZ(i,1Oly)=0. 
37 
r_hFacZ(i,1Oly)=0. 
38 
ENDDO 
39 

40 
DO j=2Oly,sNy+Oly 
41 
hFacZ(1Olx,j)=0. 
42 
r_hFacZ(1Olx,j)=0. 
43 
DO i=2Olx,sNx+Olx 
44 
hFacZOpen=MIN(_hFacW(i,j,k,bi,bj) 
45 
& + _hFacW(i,j1,k,bi,bj) 
46 
& , _hFacS(i,j,k,bi,bj) 
47 
& + _hFacS(i1,j,k,bi,bj) 
48 
& ) 
49 
hFacZ(i,j)=0.5*hFacZOpen 
50 
IF (hFacZ(i,j).EQ.0.) THEN 
51 
r_hFacZ(i,j)=0. 
52 
ELSE 
53 
r_hFacZ(i,j)=1./hFacZ(i,j) 
54 
ENDIF 
55 
ENDDO 
56 
ENDDO 
57 

58 
C Special stuff for Cubed Sphere 
59 
C above formula is ambiguous when only 3 edges instead of 4, 
60 
C => return to min3 definition at the CubedSphere corners 
61 
IF (useCubedSphereExchange) THEN 
62 
DO j=1,sNy+1,sNy 
63 
DO i=1,sNx+1,sNx 
64 
hFacZOpen=MIN( _hFacW(i,j,k,bi,bj) 
65 
& , _hFacW(i,j1,k,bi,bj) 
66 
& , _hFacS(i,j,k,bi,bj) 
67 
& , _hFacS(i1,j,k,bi,bj) 
68 
& ) 
69 
hFacZ(i,j)=hFacZOpen 
70 
IF (hFacZOpen.EQ.0.) THEN 
71 
r_hFacZ(i,j)=0. 
72 
ELSE 
73 
r_hFacZ(i,j)=1./hFacZOpen 
74 
ENDIF 
75 
ENDDO 
76 
ENDDO 
77 
ENDIF 
78 

79 
RETURN 
80 
END 