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

Annotation 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 - (hide annotations) (download)
Mon Mar 4 01:32:55 2002 UTC (22 years, 3 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 jmc 1.4 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 jmc 1.3 C $Name: $
3 adcroft 1.2
4     #include "SHAP_FILT_OPTIONS.h"
5 jmc 1.4
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 adcroft 1.2 IMPLICIT NONE
24 jmc 1.4
25 adcroft 1.2 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 jmc 1.4 C !INPUT/OUTPUT PARAMETERS:
33 adcroft 1.2 C == Routine arguments
34 jmc 1.4 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 adcroft 1.2 _RL myTime
43     INTEGER myThid
44 jmc 1.4
45 adcroft 1.2 #ifdef ALLOW_SHAP_FILT
46    
47 jmc 1.4 C !LOCAL VARIABLES:
48 adcroft 1.2 C == Local variables ==
49 jmc 1.3 INTEGER nShapComput
50 adcroft 1.2 INTEGER bi,bj,K,I,J,N
51     _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
52 jmc 1.4 CEOP
53 adcroft 1.2
54 jmc 1.4 IF (nShapT.gt.0) THEN
55 jmc 1.3 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 adcroft 1.2
61     DO bj=myByLo(myThid),myByHi(myThid)
62     DO bi=myBxLo(myThid),myBxHi(myThid)
63 jmc 1.4 DO K=1,kSize
64 jmc 1.3 DO J=1-Oly,sNy+Oly
65     DO I=1-Olx,sNx+Olx
66 adcroft 1.2 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 jmc 1.3 C-- Computational Filter
77     DO N=1,nShapComput
78 adcroft 1.2
79 jmc 1.4 IF (kSize.EQ.Nr) THEN
80     _EXCH_XYZ_R8( tmpFld, myThid )
81     ELSE
82     _EXCH_XY_R8( tmpFld, myThid )
83     ENDIF
84 jmc 1.3
85 adcroft 1.2 DO bj=myByLo(myThid),myByHi(myThid)
86     DO bi=myBxLo(myThid),myBxHi(myThid)
87 jmc 1.4 DO K=1,kSize
88 jmc 1.3
89 adcroft 1.2 DO J=1,sNy
90     DO I=1,sNx
91 jmc 1.3 tmpGrd(i,j) =
92 adcroft 1.2 & ( 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 jmc 1.3 & *_maskW( i ,j,k,bi,bj)
96 adcroft 1.2 & +( 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 jmc 1.3 & *_maskS(i, j ,k,bi,bj)
100 adcroft 1.2 ENDDO
101     ENDDO
102    
103     DO J=1,sNy
104     DO I=1,sNx
105 jmc 1.3 tmpFld(i,j,k,bi,bj) = -0.125*tmpGrd(i,j)
106 adcroft 1.2 ENDDO
107     ENDDO
108    
109     ENDDO
110     ENDDO
111     ENDDO
112 jmc 1.3 C end loop N=1,nShapComput
113     ENDDO
114    
115     DO N=1,nShapTrPhys
116     C-- Physical space Filter
117    
118 jmc 1.4 IF (kSize.EQ.Nr) THEN
119     _EXCH_XYZ_R8( tmpFld, myThid )
120     ELSE
121     _EXCH_XY_R8( tmpFld, myThid )
122     ENDIF
123 adcroft 1.2
124 jmc 1.3 DO bj=myByLo(myThid),myByHi(myThid)
125     DO bi=myBxLo(myThid),myBxHi(myThid)
126 jmc 1.4 DO K=1,kSize
127 jmc 1.3
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 adcroft 1.2 ENDDO
172    
173 jmc 1.4 C F <- [1 - (d_xx+d_yy)^n *deltaT/tau].F
174 adcroft 1.2 DO bj=myByLo(myThid),myByHi(myThid)
175     DO bi=myBxLo(myThid),myBxHi(myThid)
176 jmc 1.4 DO K=1,kSize
177 adcroft 1.2 DO J=1,sNy
178     DO I=1,sNx
179 jmc 1.3 field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
180     & -tmpFld(i,j,k,bi,bj)*deltaTtracer/Shap_Trtau
181 adcroft 1.2 ENDDO
182     ENDDO
183     ENDDO
184     ENDDO
185     ENDDO
186    
187 jmc 1.4 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 adcroft 1.2
195     ENDIF
196     #endif /* ALLOW_SHAP_FILT */
197    
198     RETURN
199     END
  ViewVC Help
Powered by ViewVC 1.1.22