/[MITgcm]/MITgcm/verification/aim.5l_cs/code/shap_filt_relvort3.F
ViewVC logotype

Contents of /MITgcm/verification/aim.5l_cs/code/shap_filt_relvort3.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.3 - (show annotations) (download)
Fri Oct 31 20:35:32 2003 UTC (20 years, 7 months ago) by edhill
Branch: MAIN
CVS Tags: branch-netcdf, checkpoint51r_post, checkpoint52b_pre, checkpoint52, checkpoint52a_post, checkpoint52b_post, checkpoint52c_post, ecco_c52_e35, checkpoint52a_pre, checkpoint51t_post, checkpoint51u_post, checkpoint51s_post
Branch point for: branch-nonh
Changes since 1.2: +2 -1 lines 
 o remove all '#include "PACACKAGES_CONFIG.h"' from model/inc/* and cleanup
   the verification tests that this breaks
 o this was confirmed to work for the basic tests ("testreport -ieee") on
   shelley
1 C $Header: /u/u3/gcmpack/MITgcm/verification/aim.5l_cs/code/shap_filt_relvort3.F,v 1.2 2003/08/03 03:43:10 jmc Exp $
2 C $Name: $
3
4 #include "PACKAGES_CONFIG.h"
5 #include "CPP_OPTIONS.h"
6
7 SUBROUTINE SHAP_FILT_RELVORT3(
8 I bi,bj,k,
9 I uFld, vFld, hFacZ,
10 O vort3,
11 I myThid)
12 IMPLICIT NONE
13 C *==========================================================*
14 C | S/R SHAP_FILT_RELVORT3
15 C *==========================================================*
16 C | copy of S/R MOM_VI_CALC_RELVORT3 (keep pkgs independent)
17 C *==========================================================*
18
19 C == Global variables ==
20 #include "SIZE.h"
21 #include "EEPARAMS.h"
22 #include "PARAMS.h"
23 #include "GRID.h"
24 C == Routine arguments ==
25 C myThid - Instance number for this innvocation of CALC_MOM_RHS
26 INTEGER bi,bj,k
27 _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
28 _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
29 _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
30 _RL vort3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
31 INTEGER myThid
32
33 #ifdef ALLOW_SHAP_FILT
34 C == Local variables ==
35 INTEGER i,j
36 _RL AZcorner
37
38 DO J=2-Oly,sNy+Oly
39 DO I=2-Olx,sNx+Olx
40
41 C Horizontal curl of flow field - ignoring lopping factors
42 vort3(I,J)=
43 & recip_rAz(I,J,bi,bj)*(
44 & vFld(I,J)*dyc(I,J,bi,bj)
45 & -vFld(I-1,J)*dyc(I-1,J,bi,bj)
46 & -uFld(I,J)*dxc(I,J,bi,bj)
47 & +uFld(I,J-1)*dxc(I,J-1,bi,bj)
48 & )
49
50 C Horizontal curl of flow field - including lopping factors
51 c IF (hFacZ(i,j).NE.0.) THEN
52 c vort3(I,J)=
53 c & recip_rAz(I,J,bi,bj)*(
54 c & vFld(I,J)*dyc(I,J,bi,bj)*_hFacW(i,j,k,bi,bj)
55 c & -vFld(I-1,J)*dyc(I-1,J,bi,bj)*_hFacW(i-1,j,k,bi,bj)
56 c & -uFld(I,J)*dxc(I,J,bi,bj)*_hFacS(i,j,k,bi,bj)
57 c & +uFld(I,J-1)*dxc(I,J-1,bi,bj)*_hFacS(i,j-1,k,bi,bj)
58 c & )
59 c & /hFacZ(i,j)
60 c ELSE
61 c vort3(I,J)=0.
62 c ENDIF
63
64 ENDDO
65 ENDDO
66
67 C Special stuff for Cubed Sphere
68 IF (useCubedSphereExchange) THEN
69 AZcorner = 0.75 _d 0
70 I=1
71 J=1
72 c vort3(I,J)=
73 c & +recip_rAz(I,J,bi,bj)*(
74 vort3(I,J)=
75 & +recip_rA(I,J,bi,bj)/AZcorner*(
76 & vFld(I,J)*dyc(I,J,bi,bj)
77 & -uFld(I,J)*dxc(I,J,bi,bj)
78 & +uFld(I,J-1)*dxc(I,J-1,bi,bj)
79 & )
80 cph & -vFld(I-1,J)*dyc(I-1,J,bi,bj)
81 I=sNx+1
82 J=1
83 c vort3(I,J)=
84 c & +recip_rAz(I,J,bi,bj)*(
85 vort3(I,J)=
86 & +recip_rA(I-1,J,bi,bj)/AZcorner*(
87 & -vFld(I-1,J)*dyc(I-1,J,bi,bj)
88 & -uFld(I,J)*dxc(I,J,bi,bj)
89 & +uFld(I,J-1)*dxc(I,J-1,bi,bj)
90 & )
91 cph & vFld(I,J)*dyc(I,J,bi,bj)
92 I=1
93 J=sNy+1
94 c vort3(I,J)=
95 c & +recip_rAz(I,J,bi,bj)*(
96 vort3(I,J)=
97 & +recip_rA(I,J-1,bi,bj)/AZcorner*(
98 & vFld(I,J)*dyc(I,J,bi,bj)
99 & -uFld(I,J)*dxc(I,J,bi,bj)
100 & +uFld(I,J-1)*dxc(I,J-1,bi,bj)
101 & )
102 cph & -vFld(I-1,J)*dyc(I-1,J,bi,bj)
103 I=sNx+1
104 J=sNy+1
105 c vort3(I,J)=
106 c & +recip_rAz(I,J,bi,bj)*(
107 vort3(I,J)=
108 & +recip_rA(I-1,J-1,bi,bj)/AZcorner*(
109 & -vFld(I-1,J)*dyc(I-1,J,bi,bj)
110 & -uFld(I,J)*dxc(I,J,bi,bj)
111 & +uFld(I,J-1)*dxc(I,J-1,bi,bj)
112 & )
113 cph & vFld(I,J)*dyc(I,J,bi,bj)
114 ENDIF
115
116 #endif /* ALLOW_SHAP_FILT */
117
118 RETURN
119 END
  ViewVC Help
Powered by ViewVC 1.1.22