/[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.1 - (show annotations) (download)
Wed Jan 9 00:28:56 2002 UTC (22 years, 3 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint48f_post, checkpoint47j_post, checkpoint48d_pre, branch-exfmods-tag, checkpoint47e_post, checkpoint43a-release1mods, checkpoint44h_pre, checkpoint47i_post, checkpoint48i_post, checkpoint47f_post, checkpoint46j_post, checkpoint47c_post, checkpoint50e_post, checkpoint50c_post, checkpoint46i_post, checkpoint47d_post, checkpoint44e_post, checkpoint44f_pre, checkpoint47a_post, checkpoint46f_post, checkpoint46d_pre, checkpoint48e_post, checkpoint46e_post, checkpoint48h_post, checkpoint50c_pre, release1-branch_tutorials, checkpoint46c_post, checkpoint44g_post, checkpoint46h_pre, checkpoint44h_post, checkpoint46l_post, checkpoint46k_post, checkpoint46e_pre, checkpoint50d_pre, checkpoint45d_post, checkpoint46j_pre, checkpoint45b_post, checkpoint46b_pre, checkpoint47h_post, checkpoint48c_post, chkpt44a_pre, release1-branch-end, release1_final_v1, checkpoint51b_post, checkpoint46, checkpoint51c_post, checkpoint46c_pre, checkpoint44, checkpoint45, checkpoint48, checkpoint49, checkpoint44f_post, checkpoint47b_post, checkpoint48d_post, checkpoint48g_post, checkpoint46l_pre, checkpoint44b_post, chkpt44c_post, chkpt44d_post, checkpoint51, checkpoint50, checkpoint50d_post, checkpoint46g_pre, checkpoint51b_pre, checkpoint46a_post, checkpoint47g_post, chkpt44a_post, checkpoint44b_pre, checkpoint46m_post, checkpoint48a_post, checkpoint46a_pre, checkpoint50g_post, checkpoint45c_post, checkpoint50b_pre, checkpoint44e_pre, checkpoint46b_post, checkpoint46d_post, checkpoint48b_post, checkpoint50b_post, checkpoint46g_post, checkpoint45a_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint47d_pre, checkpoint51d_post, checkpoint48c_pre, release1-branch_branchpoint, checkpoint47, checkpoint51a_post, checkpoint46h_post, checkpoint50e_pre, checkpoint50i_post, chkpt44c_pre
Branch point for: release1, release1_final, release1-branch, branch-exfmods-curt 
modified momentum_VI and Shapiro S/R :
 enable AIM to run on Cube Sphere with partial cell.
1 C $Header: $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 SUBROUTINE SHAP_FILT_RELVORT3(
7 I bi,bj,k,
8 I uFld, vFld, hFacZ,
9 O vort3,
10 I myThid)
11 IMPLICIT NONE
12 C /==========================================================\
13 C | S/R SHAP_FILT_RELVORT3 |
14 C |==========================================================|
15 C \==========================================================/
16
17 C == Global variables ==
18 #include "SIZE.h"
19 #include "EEPARAMS.h"
20 #include "PARAMS.h"
21 #include "GRID.h"
22 C == Routine arguments ==
23 C myThid - Instance number for this innvocation of CALC_MOM_RHS
24 INTEGER bi,bj,k
25 _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
26 _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
27 _RS hFacZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
28 _RL vort3(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
29 INTEGER myThid
30
31 #ifdef ALLOW_SHAP_FILT
32 C == Local variables ==
33 INTEGER i,j
34 _RL AZcorner
35
36 DO J=2-Oly,sNy+Oly
37 DO I=2-Olx,sNx+Olx
38
39 C Horizontal curl of flow field - ignoring lopping factors
40 vort3(I,J)=
41 & recip_rAz(I,J,bi,bj)*(
42 & vFld(I,J)*dyc(I,J,bi,bj)
43 & -vFld(I-1,J)*dyc(I-1,J,bi,bj)
44 & -uFld(I,J)*dxc(I,J,bi,bj)
45 & +uFld(I,J-1)*dxc(I,J-1,bi,bj)
46 & )
47
48 C Horizontal curl of flow field - including lopping factors
49 c IF (hFacZ(i,j).NE.0.) THEN
50 c vort3(I,J)=
51 c & recip_rAz(I,J,bi,bj)*(
52 c & vFld(I,J)*dyc(I,J,bi,bj)*_hFacW(i,j,k,bi,bj)
53 c & -vFld(I-1,J)*dyc(I-1,J,bi,bj)*_hFacW(i-1,j,k,bi,bj)
54 c & -uFld(I,J)*dxc(I,J,bi,bj)*_hFacS(i,j,k,bi,bj)
55 c & +uFld(I,J-1)*dxc(I,J-1,bi,bj)*_hFacS(i,j-1,k,bi,bj)
56 c & )
57 c & /hFacZ(i,j)
58 c ELSE
59 c vort3(I,J)=0.
60 c ENDIF
61
62 ENDDO
63 ENDDO
64
65 C Special stuff for Cubed Sphere
66 IF (useCubedSphereExchange) THEN
67 AZcorner = 0.75 _d 0
68 I=1
69 J=1
70 vort3(I,J)=
71 c & +recip_rAz(I,J,bi,bj)*(
72 & +recip_rA(I,J,bi,bj)/AZcorner*(
73 & vFld(I,J)*dyc(I,J,bi,bj)
74 & -uFld(I,J)*dxc(I,J,bi,bj)
75 & +uFld(I,J-1)*dxc(I,J-1,bi,bj)
76 & )
77 cph & -vFld(I-1,J)*dyc(I-1,J,bi,bj)
78 I=sNx+1
79 J=1
80 vort3(I,J)=
81 c & +recip_rAz(I,J,bi,bj)*(
82 & +recip_rA(I-1,J,bi,bj)/AZcorner*(
83 & -vFld(I-1,J)*dyc(I-1,J,bi,bj)
84 & -uFld(I,J)*dxc(I,J,bi,bj)
85 & +uFld(I,J-1)*dxc(I,J-1,bi,bj)
86 & )
87 cph & vFld(I,J)*dyc(I,J,bi,bj)
88 I=1
89 J=sNy+1
90 vort3(I,J)=
91 c & +recip_rAz(I,J,bi,bj)*(
92 & +recip_rA(I,J-1,bi,bj)/AZcorner*(
93 & vFld(I,J)*dyc(I,J,bi,bj)
94 & -uFld(I,J)*dxc(I,J,bi,bj)
95 & +uFld(I,J-1)*dxc(I,J-1,bi,bj)
96 & )
97 cph & -vFld(I-1,J)*dyc(I-1,J,bi,bj)
98 I=sNx+1
99 J=sNy+1
100 vort3(I,J)=
101 c & +recip_rAz(I,J,bi,bj)*(
102 & +recip_rA(I-1,J-1,bi,bj)/AZcorner*(
103 & -vFld(I-1,J)*dyc(I-1,J,bi,bj)
104 & -uFld(I,J)*dxc(I,J,bi,bj)
105 & +uFld(I,J-1)*dxc(I,J-1,bi,bj)
106 & )
107 cph & vFld(I,J)*dyc(I,J,bi,bj)
108 ENDIF
109
110 #endif /* ALLOW_SHAP_FILT */
111
112 RETURN
113 END
  ViewVC Help
Powered by ViewVC 1.1.22