/[MITgcm]/MITgcm/pkg/shap_filt/shap_filt_computvort.F
ViewVC logotype

Annotation of /MITgcm/pkg/shap_filt/shap_filt_computvort.F

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

Revision 1.1 - (hide annotations) (download)
Fri Oct 7 00:21:07 2005 UTC (18 years, 7 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint58e_post, checkpoint57v_post, checkpoint58u_post, checkpoint58w_post, checkpoint58r_post, checkpoint57y_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint57y_pre, checkpoint58q_post, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59i, checkpoint59h, checkpoint59j, checkpoint59, checkpoint58, checkpoint58f_post, checkpoint57x_post, checkpoint58d_post, checkpoint58c_post, checkpoint57w_post, checkpint57u_post, checkpoint58a_post, checkpoint58i_post, checkpoint58g_post, checkpoint58o_post, checkpoint57z_post, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post, checkpoint58b_post, checkpoint58m_post 
- new S/R shap_filt_computvort (simplified version of calc_relvort3, with
    no grid spacing), used for computational mode filter.
- import the recent modifications of mom_calc_relvort3.
1 jmc 1.1 C $Header: $
2     C $Name: $
3    
4     #include "SHAP_FILT_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: SHAP_FILT_COMPUTVORT
8     C !INTERFACE:
9     SUBROUTINE SHAP_FILT_COMPUTVORT(
10     I uFld, vFld,
11     O vort,
12     I k, bi,bj, myThid )
13     C !DESCRIPTION: \bv
14     C *==========================================================*
15     C | S/R SHAP_FILT_COMPUTVORT
16     C | o Calculate delta_i[vFld]-delta_j[uFld]
17     C *==========================================================*
18     C | o used in computational-mode filter to replace relative
19     C | vorticity
20     C *==========================================================*
21     C \ev
22    
23     C !USES:
24     IMPLICIT NONE
25    
26     C == Global variables ===
27     #include "SIZE.h"
28     #include "EEPARAMS.h"
29     #include "PARAMS.h"
30     #include "GRID.h"
31     #ifdef ALLOW_EXCH2
32     #include "W2_EXCH2_TOPOLOGY.h"
33     #include "W2_EXCH2_PARAMS.h"
34     #endif /* ALLOW_EXCH2 */
35    
36     C !INPUT/OUTPUT PARAMETERS:
37     C == Routine arguments
38     C uFld :: velocity field (U component) on which filter applies
39     C vFld :: velocity field (V component) on which filter applies
40     C myThid :: Thread number for this instance of SHAP_FILT_UV_S2
41     _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
42     _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
43     _RL vort(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
44     INTEGER k, bi,bj
45     INTEGER myThid
46    
47     #ifdef ALLOW_SHAP_FILT
48    
49     C !LOCAL VARIABLES:
50     C == Local variables ==
51     INTEGER i,j
52     _RS maskZ
53     LOGICAL northWestCorner, northEastCorner,
54     & southWestCorner, southEastCorner
55     INTEGER myFace
56     #ifdef ALLOW_EXCH2
57     INTEGER myTile
58     #endif /* ALLOW_EXCH2 */
59     CEOP
60    
61     C- Initialisation :
62     DO j=1-Oly,sNy+Oly
63     DO i=1-Olx,sNx+Olx
64     vort(i,j)= 0.
65     ENDDO
66     ENDDO
67     C- replace Physical calc Div & Vort by computational one :
68     DO j=3-Oly,sNy+Oly-1
69     DO i=3-Olx,sNx+Olx-1
70     vort(i,j) = ( vFld(i,j)-vFld(i-1,j) )
71     & - ( uFld(i,j)-uFld(i,j-1) )
72     maskZ = (maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj))
73     & *(maskS(i,j,k,bi,bj)+maskS(i-1,j,k,bi,bj))
74     IF (maskZ.LT.1.) vort(i,j)=0.
75     ENDDO
76     ENDDO
77    
78     C- Special stuff for Cubed Sphere
79     IF (useCubedSphereExchange) THEN
80     #ifdef ALLOW_EXCH2
81     myTile = W2_myTileList(bi)
82     myFace = exch2_myFace(myTile)
83     southWestCorner = exch2_isWedge(myTile).EQ.1
84     & .AND. exch2_isSedge(myTile).EQ.1
85     southEastCorner = exch2_isEedge(myTile).EQ.1
86     & .AND. exch2_isSedge(myTile).EQ.1
87     northEastCorner = exch2_isEedge(myTile).EQ.1
88     & .AND. exch2_isNedge(myTile).EQ.1
89     northWestCorner = exch2_isWedge(myTile).EQ.1
90     & .AND. exch2_isNedge(myTile).EQ.1
91     #else
92     myFace = bi
93     southWestCorner = .TRUE.
94     southEastCorner = .TRUE.
95     northWestCorner = .TRUE.
96     northEastCorner = .TRUE.
97     #endif /* ALLOW_EXCH2 */
98     C---
99     IF ( southWestCorner ) THEN
100     i=1
101     j=1
102     maskZ = maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj)
103     & +maskS(i,j,k,bi,bj)
104     IF (maskZ.GE.2.) THEN
105     vort(i,j)=
106     & (+vFld(i,j) -uFld(i,j) ) +uFld(i,j-1)
107     vort(i,j)=vort(i,j)*4. _d 0 / 3. _d 0
108     ELSE
109     vort(i,j)=0.
110     ENDIF
111     ENDIF
112     C---
113     IF ( southEastCorner ) THEN
114     i=sNx+1
115     j=1
116     maskZ = maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj)
117     & +maskS(i-1,j,k,bi,bj)
118     IF (maskZ.GE.2.) THEN
119     IF ( myFace.EQ.2 ) THEN
120     vort(i,j)=
121     & (-uFld(i,j) -vFld(i-1,j) ) +uFld(i,j-1)
122     ELSEIF ( myFace.EQ.4 ) THEN
123     vort(i,j)=
124     & (-vFld(i-1,j) +uFld(i,j-1) ) -uFld(i,j)
125     ELSE
126     vort(i,j)=
127     & (+uFld(i,j-1) -uFld(i,j) ) -vFld(i-1,j)
128     ENDIF
129     vort(i,j)=vort(i,j)*4. _d 0 / 3. _d 0
130     ELSE
131     vort(i,j)=0.
132     ENDIF
133     ENDIF
134     C---
135     IF ( northWestCorner ) THEN
136     i=1
137     j=sNy+1
138     maskZ = maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj)
139     & +maskS(i,j,k,bi,bj)
140     IF (maskZ.GE.2.) THEN
141     IF ( myFace.EQ.1 ) THEN
142     vort(i,j)=
143     & (+uFld(i,j-1) +vFld(i,j) ) -uFld(i,j)
144     ELSEIF ( myFace.EQ.3 ) THEN
145     vort(i,j)=
146     & (-uFld(i,j) +uFld(i,j-1) ) +vFld(i,j)
147     ELSE
148     vort(i,j)=
149     & (+vFld(i,j) -uFld(i,j) ) +uFld(i,j-1)
150     ENDIF
151     vort(i,j)=vort(i,j)*4. _d 0 / 3. _d 0
152     ELSE
153     vort(i,j)=0.
154     ENDIF
155     ENDIF
156     C---
157     IF ( northEastCorner ) THEN
158     i=sNx+1
159     j=sNy+1
160     maskZ = maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj)
161     & +maskS(i-1,j,k,bi,bj)
162     IF (maskZ.GE.2.) THEN
163     IF ( MOD(myFace,2).EQ.1 ) THEN
164     vort(i,j)=
165     & (-uFld(i,j) -vFld(i-1,j) ) +uFld(i,j-1)
166     ELSE
167     vort(i,j)=
168     & (+uFld(i,j-1) -uFld(i,j) ) -vFld(i-1,j)
169     ENDIF
170     vort(i,j)=vort(i,j)*4. _d 0 / 3. _d 0
171     ELSE
172     vort(i,j)=0.
173     ENDIF
174     ENDIF
175     C--- end if useCubedSphereExchange:
176     ENDIF
177    
178     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
179    
180     #endif /* ALLOW_SHAP_FILT */
181    
182     RETURN
183     END
  ViewVC Help
Powered by ViewVC 1.1.22