/[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.3 - (hide 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 jmc 1.3 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 adcroft 1.2
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 jmc 1.3 INTEGER nShapComput
33 adcroft 1.2 INTEGER bi,bj,K,I,J,N
34     _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
35    
36 jmc 1.3 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 adcroft 1.2
43     DO bj=myByLo(myThid),myByHi(myThid)
44     DO bi=myBxLo(myThid),myBxHi(myThid)
45     DO K=1,Nr
46 jmc 1.3 DO J=1-Oly,sNy+Oly
47     DO I=1-Olx,sNx+Olx
48 adcroft 1.2 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 jmc 1.3 C-- Computational Filter
59     DO N=1,nShapComput
60 adcroft 1.2
61     _EXCH_XYZ_R8( tmpFld, myThid )
62 jmc 1.3
63 adcroft 1.2 DO bj=myByLo(myThid),myByHi(myThid)
64     DO bi=myBxLo(myThid),myBxHi(myThid)
65     DO K=1,Nr
66 jmc 1.3
67 adcroft 1.2 DO J=1,sNy
68     DO I=1,sNx
69 jmc 1.3 tmpGrd(i,j) =
70 adcroft 1.2 & ( 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 jmc 1.3 & *_maskW( i ,j,k,bi,bj)
74 adcroft 1.2 & +( 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 jmc 1.3 & *_maskS(i, j ,k,bi,bj)
78 adcroft 1.2 ENDDO
79     ENDDO
80    
81     DO J=1,sNy
82     DO I=1,sNx
83 jmc 1.3 tmpFld(i,j,k,bi,bj) = -0.125*tmpGrd(i,j)
84 adcroft 1.2 ENDDO
85     ENDDO
86    
87     ENDDO
88     ENDDO
89     ENDDO
90 jmc 1.3 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 adcroft 1.2
98 jmc 1.3 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 adcroft 1.2 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 jmc 1.3 field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
154     & -tmpFld(i,j,k,bi,bj)*deltaTtracer/Shap_Trtau
155 adcroft 1.2 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