/[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.3 - (show annotations) (download)
Fri Jun 15 15:14:56 2001 UTC (22 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint44e_post, release1_p13_pre, checkpoint43a-release1mods, release1_p13, checkpoint40pre3, checkpoint40pre1, checkpoint40pre7, checkpoint40pre6, checkpoint40pre9, checkpoint40pre8, chkpt44d_post, release1_p8, release1_p9, release1_p1, release1_p2, release1_p3, release1_p4, release1_p5, release1_p6, release1_p7, checkpoint44e_pre, release1_b1, checkpoint43, release1_chkpt44d_post, icebear5, icebear4, icebear3, icebear2, checkpoint40pre2, release1-branch_tutorials, chkpt44a_post, checkpoint40pre4, chkpt44c_pre, ecco_c44_e19, ecco_c44_e18, ecco_c44_e17, ecco_c44_e16, release1_p12, release1_p10, release1_p11, release1_p16, release1_p17, release1_p14, release1_p15, release1-branch-end, release1_final_v1, checkpoint44b_post, ecco_ice2, ecco_ice1, release1_p12_pre, ecco_c44_e22, ecco_c44_e25, checkpoint40pre5, chkpt44a_pre, ecco_c44_e23, ecco_c44_e20, ecco_c44_e21, ecco_c44_e26, ecco_c44_e27, ecco_c44_e24, ecco-branch-mod1, ecco-branch-mod2, ecco-branch-mod3, ecco-branch-mod4, ecco-branch-mod5, release1_beta1, checkpoint44b_pre, checkpoint42, checkpoint40, checkpoint41, checkpoint44, chkpt44c_post, release1-branch_branchpoint
Branch point for: c24_e25_ice, release1_final, release1-branch, release1, ecco-branch, release1_50yr, icebear, release1_coupled
Changes since 1.2: +75 -13 lines 
extend S2 Shapiro Filter : new parameters nShapTrPhys and nShapUVPhys allow
to switch from numerical-space filter (default)
            to physical-space filter  (as S2g)
            or a combination of both.
1 C $Header: /u/gcmpack/models/MITgcmUV/pkg/shap_filt/shap_filt_tracer_s2.F,v 1.2 2001/05/29 14:01:40 adcroft Exp $
2 C $Name: $
3
4 #include "SHAP_FILT_OPTIONS.h"
5
6 SUBROUTINE SHAP_FILT_TRACER_S2(
7 U field,
8 I myTime, myThid )
9 C /==========================================================\
10 C | S/R SHAP_FILT_TRACER_S2 |
11 C | Applies Shapiro filter to tracer field over one XY slice |
12 C | of one tile at a time. |
13 C \==========================================================/
14 IMPLICIT NONE
15
16 C == Global variables ===
17 #include "SIZE.h"
18 #include "EEPARAMS.h"
19 #include "PARAMS.h"
20 #include "GRID.h"
21 #include "SHAP_FILT.h"
22 #include "SHAP_FILT_TRACER.h"
23
24 C == Routine arguments
25 _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
26 _RL myTime
27 INTEGER myThid
28
29 #ifdef ALLOW_SHAP_FILT
30
31 C == Local variables ==
32 INTEGER nShapComput
33 INTEGER bi,bj,K,I,J,N
34 _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
35
36 IF (nShapT.GT.0) THEN
37 C-------
38 C Apply computational filter ^(nShap-nShapPhys) without grid factor
39 C then apply Physical filter ^nShapPhys with grid factors
40 C-------
41 nShapComput = nShapT - nShapTrPhys
42
43 DO bj=myByLo(myThid),myByHi(myThid)
44 DO bi=myBxLo(myThid),myBxHi(myThid)
45 DO K=1,Nr
46 DO J=1-Oly,sNy+Oly
47 DO I=1-Olx,sNx+Olx
48 tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
49 ENDDO
50 ENDDO
51 ENDDO
52 ENDDO
53 ENDDO
54
55
56 C ( d_xx +d_yy )^n tmpFld
57
58 C-- Computational Filter
59 DO N=1,nShapComput
60
61 _EXCH_XYZ_R8( tmpFld, myThid )
62
63 DO bj=myByLo(myThid),myByHi(myThid)
64 DO bi=myBxLo(myThid),myBxHi(myThid)
65 DO K=1,Nr
66
67 DO J=1,sNy
68 DO I=1,sNx
69 tmpGrd(i,j) =
70 & ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
71 & *_maskW(i+1,j,k,bi,bj)
72 & -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
73 & *_maskW( i ,j,k,bi,bj)
74 & +( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
75 & *_maskS(i,j+1,k,bi,bj)
76 & -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
77 & *_maskS(i, j ,k,bi,bj)
78 ENDDO
79 ENDDO
80
81 DO J=1,sNy
82 DO I=1,sNx
83 tmpFld(i,j,k,bi,bj) = -0.125*tmpGrd(i,j)
84 ENDDO
85 ENDDO
86
87 ENDDO
88 ENDDO
89 ENDDO
90 C end loop N=1,nShapComput
91 ENDDO
92
93 DO N=1,nShapTrPhys
94 C-- Physical space Filter
95
96 _EXCH_XYZ_R8( tmpFld, myThid )
97
98 DO bj=myByLo(myThid),myByHi(myThid)
99 DO bi=myBxLo(myThid),myBxHi(myThid)
100 DO K=1,Nr
101
102 DO J=1,sNy
103 DO I=1,sNx
104 tmpGrd(i,j) =
105 & ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
106 & *_hFacW(i+1,j,k,bi,bj)
107 & *DYG(i+1,j,bi,bj)
108 & *recip_DXC(i+1,j,bi,bj)
109 & -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
110 & *_hFacW( i ,j,k,bi,bj)
111 & *DYG( i ,j,bi,bj)
112 & *recip_DXC( i ,j,bi,bj)
113 & +( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
114 & *_hFacS(i,j+1,k,bi,bj)
115 & *DXG(i,j+1,bi,bj)
116 & *recip_DYC(i,j+1,bi,bj)
117 & -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
118 & *_hFacS(i, j ,k,bi,bj)
119 & *DXG(i, j ,bi,bj)
120 & *recip_DYC(i, j ,bi,bj)
121 ENDDO
122 ENDDO
123
124 IF (Shap_TrLength.EQ.0.) THEN
125 DO J=1,sNy
126 DO I=1,sNx
127 tmpFld(i,j,k,bi,bj) = -0.125*tmpGrd(i,j)
128 & *recip_hFacC(i,j,k,bi,bj)
129 ENDDO
130 ENDDO
131 ELSE
132 DO J=1,sNy
133 DO I=1,sNx
134 tmpFld(i,j,k,bi,bj) = -0.125*tmpGrd(i,j)
135 & *recip_hFacC(i,j,k,bi,bj)*recip_rA(i,j,bi,bj)
136 & *Shap_TrLength*Shap_TrLength
137 ENDDO
138 ENDDO
139 ENDIF
140
141 ENDDO
142 ENDDO
143 ENDDO
144 C end loop N=1,nShapTrPhys
145 ENDDO
146
147 C F <- [1-(d_xx+d_yy)^n]F
148 DO bj=myByLo(myThid),myByHi(myThid)
149 DO bi=myBxLo(myThid),myBxHi(myThid)
150 DO K=1,Nr
151 DO J=1,sNy
152 DO I=1,sNx
153 field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
154 & -tmpFld(i,j,k,bi,bj)*deltaTtracer/Shap_Trtau
155 ENDDO
156 ENDDO
157 ENDDO
158 ENDDO
159 ENDDO
160
161 _EXCH_XYZ_R8( field, myThid )
162
163 ENDIF
164 #endif /* ALLOW_SHAP_FILT */
165
166 RETURN
167 END
  ViewVC Help
Powered by ViewVC 1.1.22