/[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.4 - (hide annotations) (download)
Sun Jun 28 01:08:26 2009 UTC (14 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint62, checkpoint63, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61s, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.3: +2 -2 lines 
add bj in exch2 arrays and S/R
1 jmc 1.4 C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_computvort.F,v 1.3 2009/05/12 19:56:36 jmc Exp $
2 jmc 1.1 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 jmc 1.3 #include "W2_EXCH2_SIZE.h"
33 jmc 1.1 #include "W2_EXCH2_TOPOLOGY.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 jmc 1.2 #ifdef ALLOW_AUTODIFF_TAMC
62 jmc 1.1 C- Initialisation :
63     DO j=1-Oly,sNy+Oly
64     DO i=1-Olx,sNx+Olx
65     vort(i,j)= 0.
66     ENDDO
67     ENDDO
68 jmc 1.2 #endif
69    
70 jmc 1.1 C- replace Physical calc Div & Vort by computational one :
71 jmc 1.2 DO j=2-Oly,sNy+Oly
72     DO i=2-Olx,sNx+Olx
73 jmc 1.1 vort(i,j) = ( vFld(i,j)-vFld(i-1,j) )
74     & - ( uFld(i,j)-uFld(i,j-1) )
75     maskZ = (maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj))
76     & *(maskS(i,j,k,bi,bj)+maskS(i-1,j,k,bi,bj))
77     IF (maskZ.LT.1.) vort(i,j)=0.
78     ENDDO
79     ENDDO
80    
81     C- Special stuff for Cubed Sphere
82     IF (useCubedSphereExchange) THEN
83     #ifdef ALLOW_EXCH2
84 jmc 1.4 myTile = W2_myTileList(bi,bj)
85 jmc 1.1 myFace = exch2_myFace(myTile)
86     southWestCorner = exch2_isWedge(myTile).EQ.1
87     & .AND. exch2_isSedge(myTile).EQ.1
88     southEastCorner = exch2_isEedge(myTile).EQ.1
89     & .AND. exch2_isSedge(myTile).EQ.1
90     northEastCorner = exch2_isEedge(myTile).EQ.1
91     & .AND. exch2_isNedge(myTile).EQ.1
92     northWestCorner = exch2_isWedge(myTile).EQ.1
93     & .AND. exch2_isNedge(myTile).EQ.1
94     #else
95     myFace = bi
96     southWestCorner = .TRUE.
97     southEastCorner = .TRUE.
98     northWestCorner = .TRUE.
99     northEastCorner = .TRUE.
100     #endif /* ALLOW_EXCH2 */
101     C---
102     IF ( southWestCorner ) THEN
103     i=1
104     j=1
105     maskZ = maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj)
106     & +maskS(i,j,k,bi,bj)
107     IF (maskZ.GE.2.) THEN
108     vort(i,j)=
109     & (+vFld(i,j) -uFld(i,j) ) +uFld(i,j-1)
110     vort(i,j)=vort(i,j)*4. _d 0 / 3. _d 0
111     ELSE
112     vort(i,j)=0.
113     ENDIF
114     ENDIF
115     C---
116     IF ( southEastCorner ) THEN
117     i=sNx+1
118     j=1
119     maskZ = maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj)
120     & +maskS(i-1,j,k,bi,bj)
121     IF (maskZ.GE.2.) THEN
122     IF ( myFace.EQ.2 ) THEN
123     vort(i,j)=
124     & (-uFld(i,j) -vFld(i-1,j) ) +uFld(i,j-1)
125     ELSEIF ( myFace.EQ.4 ) THEN
126     vort(i,j)=
127     & (-vFld(i-1,j) +uFld(i,j-1) ) -uFld(i,j)
128     ELSE
129     vort(i,j)=
130     & (+uFld(i,j-1) -uFld(i,j) ) -vFld(i-1,j)
131     ENDIF
132     vort(i,j)=vort(i,j)*4. _d 0 / 3. _d 0
133     ELSE
134     vort(i,j)=0.
135     ENDIF
136     ENDIF
137     C---
138     IF ( northWestCorner ) THEN
139     i=1
140     j=sNy+1
141     maskZ = maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj)
142     & +maskS(i,j,k,bi,bj)
143     IF (maskZ.GE.2.) THEN
144     IF ( myFace.EQ.1 ) THEN
145     vort(i,j)=
146     & (+uFld(i,j-1) +vFld(i,j) ) -uFld(i,j)
147     ELSEIF ( myFace.EQ.3 ) THEN
148     vort(i,j)=
149     & (-uFld(i,j) +uFld(i,j-1) ) +vFld(i,j)
150     ELSE
151     vort(i,j)=
152     & (+vFld(i,j) -uFld(i,j) ) +uFld(i,j-1)
153     ENDIF
154     vort(i,j)=vort(i,j)*4. _d 0 / 3. _d 0
155     ELSE
156     vort(i,j)=0.
157     ENDIF
158     ENDIF
159     C---
160     IF ( northEastCorner ) THEN
161     i=sNx+1
162     j=sNy+1
163     maskZ = maskW(i,j,k,bi,bj)+maskW(i,j-1,k,bi,bj)
164     & +maskS(i-1,j,k,bi,bj)
165     IF (maskZ.GE.2.) THEN
166     IF ( MOD(myFace,2).EQ.1 ) THEN
167     vort(i,j)=
168     & (-uFld(i,j) -vFld(i-1,j) ) +uFld(i,j-1)
169     ELSE
170     vort(i,j)=
171     & (+uFld(i,j-1) -uFld(i,j) ) -vFld(i-1,j)
172     ENDIF
173     vort(i,j)=vort(i,j)*4. _d 0 / 3. _d 0
174     ELSE
175     vort(i,j)=0.
176     ENDIF
177     ENDIF
178     C--- end if useCubedSphereExchange:
179     ENDIF
180    
181     c---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
182    
183     #endif /* ALLOW_SHAP_FILT */
184    
185     RETURN
186     END
  ViewVC Help
Powered by ViewVC 1.1.22