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

Contents 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 - (show annotations) (download)
Fri Oct 7 00:21:07 2005 UTC (18 years, 8 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 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