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

Annotation 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 - (hide annotations) (download)
Wed Jan 9 00:28:56 2002 UTC (22 years, 4 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 jmc 1.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