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

Contents of /MITgcm/pkg/shap_filt/shap_filt_tracer_s2.F

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

Revision 1.4 - (show annotations) (download)
Mon Mar 4 01:32:55 2002 UTC (22 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint51k_post, checkpoint47e_post, checkpoint52l_pre, hrcube4, hrcube5, checkpoint46l_post, checkpoint46g_pre, checkpoint47c_post, checkpoint50c_post, checkpoint46f_post, checkpoint52d_pre, checkpoint48e_post, checkpoint50c_pre, checkpoint44f_post, checkpoint46b_post, checkpoint52j_pre, checkpoint51o_pre, checkpoint51l_post, checkpoint48i_post, checkpoint46l_pre, checkpoint52l_post, checkpoint52k_post, checkpoint51, checkpoint50, checkpoint53, checkpoint52, checkpoint50d_post, checkpoint52f_post, checkpoint50b_pre, checkpoint51f_post, checkpoint48b_post, checkpoint51d_post, checkpoint48c_pre, checkpoint47d_pre, checkpoint51t_post, checkpoint51n_post, checkpoint52i_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint51s_post, checkpoint47a_post, checkpoint48d_pre, checkpoint51j_post, checkpoint47i_post, checkpoint52e_pre, checkpoint52e_post, checkpoint51n_pre, checkpoint47d_post, checkpoint53d_post, checkpoint46d_pre, checkpoint48d_post, checkpoint48f_post, checkpoint45d_post, checkpoint52b_pre, checkpoint46j_pre, checkpoint51l_pre, checkpoint52m_post, checkpoint44h_pre, checkpoint48h_post, checkpoint51q_post, checkpoint51b_pre, checkpoint46a_post, checkpoint47g_post, checkpoint52b_post, checkpoint52c_post, checkpoint46j_post, checkpoint51h_pre, checkpoint46k_post, checkpoint48a_post, checkpoint45a_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint52f_pre, checkpoint47j_post, checkpoint53c_post, branch-exfmods-tag, checkpoint44g_post, branchpoint-genmake2, checkpoint46e_pre, checkpoint51r_post, checkpoint48c_post, checkpoint45b_post, checkpoint46b_pre, checkpoint51i_post, checkpoint51b_post, checkpoint51c_post, checkpoint46c_pre, checkpoint53a_post, checkpoint46, checkpoint47b_post, checkpoint46h_pre, checkpoint52d_post, checkpoint46m_post, checkpoint46a_pre, checkpoint50g_post, checkpoint45c_post, checkpoint44h_post, checkpoint46g_post, checkpoint52a_pre, checkpoint50h_post, checkpoint52i_post, checkpoint50e_pre, checkpoint50i_post, checkpoint51i_pre, checkpoint52h_pre, checkpoint53f_post, checkpoint52j_post, checkpoint47f_post, checkpoint50e_post, checkpoint46i_post, checkpoint46c_post, branch-netcdf, checkpoint50d_pre, checkpoint52n_post, checkpoint53b_pre, checkpoint46e_post, checkpoint51e_post, checkpoint47, checkpoint45, checkpoint48, checkpoint49, checkpoint46h_post, checkpoint51o_post, checkpoint51f_pre, checkpoint48g_post, checkpoint53b_post, checkpoint47h_post, checkpoint52a_post, checkpoint44f_pre, checkpoint51g_post, ecco_c52_e35, checkpoint46d_post, checkpoint50b_post, checkpoint51m_post, checkpoint53d_pre, checkpoint51a_post, checkpoint51p_post, checkpoint51u_post
Branch point for: branch-exfmods-curt, branch-genmake2, branch-nonh, tg2-branch, netcdf-sm0, checkpoint51n_branch
Changes since 1.3: +55 -23 lines 
o parameter Shap_noSlip replace CPP option NO_SLIP_SHAP
o add filter time scale (missing in some Shap_filt S/R)
o add exchange at the end (missing in some Shapi_filt S/R)
o working arrays (in common block SHAP_FILT.h) become argument
  of Shap_filt S/R.  => Enable to filter 2D fields.
1 C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_tracer_s2.F,v 1.3 2001/06/15 15:14:56 jmc Exp $
2 C $Name: $
3
4 #include "SHAP_FILT_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: SHAP_FILT_TRACER_S2
8 C !INTERFACE:
9 SUBROUTINE SHAP_FILT_TRACER_S2(
10 U field, tmpFld,
11 I kSize, myTime, myThid )
12 C !DESCRIPTION: \bv
13 C *==========================================================*
14 C | S/R SHAP_FILT_TRACER_S2
15 C | o Applies Shapiro filter to 2D field (cell center).
16 C | o use filtering function "S2" = [1 - (d_xx+d_yy)^n]
17 C | o Options for computational filter (no grid spacing)
18 C | or physical space filter (with grid spacing) or both.
19 C *==========================================================*
20 C \ev
21
22 C !USES:
23 IMPLICIT NONE
24
25 C == Global variables ===
26 #include "SIZE.h"
27 #include "EEPARAMS.h"
28 #include "PARAMS.h"
29 #include "GRID.h"
30 #include "SHAP_FILT.h"
31
32 C !INPUT/OUTPUT PARAMETERS:
33 C == Routine arguments
34 C field :: cell-centered 2D field on which filter applies
35 C tmpFld :: working temporary array
36 C kSize :: length of 3rd Dim : either =1 (2D field) or =Nr (3D field)
37 C myTime :: Current time in simulation
38 C myThid :: Thread number for this instance of SHAP_FILT_TRACER_S2
39 INTEGER kSize
40 _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
41 _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
42 _RL myTime
43 INTEGER myThid
44
45 #ifdef ALLOW_SHAP_FILT
46
47 C !LOCAL VARIABLES:
48 C == Local variables ==
49 INTEGER nShapComput
50 INTEGER bi,bj,K,I,J,N
51 _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
52 CEOP
53
54 IF (nShapT.gt.0) THEN
55 C-------
56 C Apply computational filter ^(nShap-nShapPhys) without grid factor
57 C then apply Physical filter ^nShapPhys with grid factors
58 C-------
59 nShapComput = nShapT - nShapTrPhys
60
61 DO bj=myByLo(myThid),myByHi(myThid)
62 DO bi=myBxLo(myThid),myBxHi(myThid)
63 DO K=1,kSize
64 DO J=1-Oly,sNy+Oly
65 DO I=1-Olx,sNx+Olx
66 tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
67 ENDDO
68 ENDDO
69 ENDDO
70 ENDDO
71 ENDDO
72
73
74 C ( d_xx +d_yy )^n tmpFld
75
76 C-- Computational Filter
77 DO N=1,nShapComput
78
79 IF (kSize.EQ.Nr) THEN
80 _EXCH_XYZ_R8( tmpFld, myThid )
81 ELSE
82 _EXCH_XY_R8( tmpFld, myThid )
83 ENDIF
84
85 DO bj=myByLo(myThid),myByHi(myThid)
86 DO bi=myBxLo(myThid),myBxHi(myThid)
87 DO K=1,kSize
88
89 DO J=1,sNy
90 DO I=1,sNx
91 tmpGrd(i,j) =
92 & ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
93 & *_maskW(i+1,j,k,bi,bj)
94 & -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
95 & *_maskW( i ,j,k,bi,bj)
96 & +( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
97 & *_maskS(i,j+1,k,bi,bj)
98 & -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
99 & *_maskS(i, j ,k,bi,bj)
100 ENDDO
101 ENDDO
102
103 DO J=1,sNy
104 DO I=1,sNx
105 tmpFld(i,j,k,bi,bj) = -0.125*tmpGrd(i,j)
106 ENDDO
107 ENDDO
108
109 ENDDO
110 ENDDO
111 ENDDO
112 C end loop N=1,nShapComput
113 ENDDO
114
115 DO N=1,nShapTrPhys
116 C-- Physical space Filter
117
118 IF (kSize.EQ.Nr) THEN
119 _EXCH_XYZ_R8( tmpFld, myThid )
120 ELSE
121 _EXCH_XY_R8( tmpFld, myThid )
122 ENDIF
123
124 DO bj=myByLo(myThid),myByHi(myThid)
125 DO bi=myBxLo(myThid),myBxHi(myThid)
126 DO K=1,kSize
127
128 DO J=1,sNy
129 DO I=1,sNx
130 tmpGrd(i,j) =
131 & ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
132 & *_hFacW(i+1,j,k,bi,bj)
133 & *DYG(i+1,j,bi,bj)
134 & *recip_DXC(i+1,j,bi,bj)
135 & -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
136 & *_hFacW( i ,j,k,bi,bj)
137 & *DYG( i ,j,bi,bj)
138 & *recip_DXC( i ,j,bi,bj)
139 & +( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
140 & *_hFacS(i,j+1,k,bi,bj)
141 & *DXG(i,j+1,bi,bj)
142 & *recip_DYC(i,j+1,bi,bj)
143 & -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
144 & *_hFacS(i, j ,k,bi,bj)
145 & *DXG(i, j ,bi,bj)
146 & *recip_DYC(i, j ,bi,bj)
147 ENDDO
148 ENDDO
149
150 IF (Shap_TrLength.EQ.0.) THEN
151 DO J=1,sNy
152 DO I=1,sNx
153 tmpFld(i,j,k,bi,bj) = -0.125*tmpGrd(i,j)
154 & *recip_hFacC(i,j,k,bi,bj)
155 ENDDO
156 ENDDO
157 ELSE
158 DO J=1,sNy
159 DO I=1,sNx
160 tmpFld(i,j,k,bi,bj) = -0.125*tmpGrd(i,j)
161 & *recip_hFacC(i,j,k,bi,bj)*recip_rA(i,j,bi,bj)
162 & *Shap_TrLength*Shap_TrLength
163 ENDDO
164 ENDDO
165 ENDIF
166
167 ENDDO
168 ENDDO
169 ENDDO
170 C end loop N=1,nShapTrPhys
171 ENDDO
172
173 C F <- [1 - (d_xx+d_yy)^n *deltaT/tau].F
174 DO bj=myByLo(myThid),myByHi(myThid)
175 DO bi=myBxLo(myThid),myBxHi(myThid)
176 DO K=1,kSize
177 DO J=1,sNy
178 DO I=1,sNx
179 field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
180 & -tmpFld(i,j,k,bi,bj)*deltaTtracer/Shap_Trtau
181 ENDDO
182 ENDDO
183 ENDDO
184 ENDDO
185 ENDDO
186
187 IF (kSize.EQ.Nr) THEN
188 _EXCH_XYZ_R8( field, myThid )
189 ELSEIF (kSize.EQ.1) THEN
190 _EXCH_XY_R8( field, myThid )
191 ELSE
192 STOP 'S/R SHAP_FILT_TRACER_S4: kSize is wrong'
193 ENDIF
194
195 ENDIF
196 #endif /* ALLOW_SHAP_FILT */
197
198 RETURN
199 END
  ViewVC Help
Powered by ViewVC 1.1.22