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

Annotation of /MITgcm/pkg/shap_filt/shap_filt_tracer_s1.F

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

Revision 1.2 - (hide annotations) (download)
Tue May 29 14:01:40 2001 UTC (23 years ago) by adcroft
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.1: +151 -0 lines 
Merge from branch pre38:
 o essential mods for cubed sphere
 o debugged atmosphere, dynamcis + physics (aim)
 o new packages (mom_vecinv, mom_fluxform, ...)
1 adcroft 1.2 C $Header: /u/gcmpack/models/MITgcmUV/pkg/shap_filt/Attic/shap_filt_tracer_s1.F,v 1.1.2.1 2001/05/07 18:40:02 adcroft Exp $
2     C $Name: pre38-close $
3    
4     #include "SHAP_FILT_OPTIONS.h"
5    
6     SUBROUTINE SHAP_FILT_TRACER_S1(
7     U field,
8     I myTime, myThid )
9     C /==========================================================\
10     C | S/R SHAP_FILT_TRACER |
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 bi,bj,K,I,J,N
33     _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
34     _RL tmpScal
35    
36     IF (nShapT.gt.0) THEN
37    
38     DO bj=myByLo(myThid),myByHi(myThid)
39     DO bi=myBxLo(myThid),myBxHi(myThid)
40     DO K=1,Nr
41     DO J=1,sNy
42     DO I=1,sNx
43     tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
44     ENDDO
45     ENDDO
46     ENDDO
47     ENDDO
48     ENDDO
49    
50    
51     C d_xx^n tmpFld
52    
53     DO N=1,nShapT
54    
55     _EXCH_XYZ_R8( tmpFld, myThid )
56    
57     DO bj=myByLo(myThid),myByHi(myThid)
58     DO bi=myBxLo(myThid),myBxHi(myThid)
59     DO K=1,Nr
60    
61     DO J=1,sNy
62     DO I=1,sNx
63     tmpGrd(i,j) = -0.25*(
64     & ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
65     & *_maskW(i+1,j,k,bi,bj)
66     & -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
67     & *_maskW(i,j,k,bi,bj) )
68     ENDDO
69     ENDDO
70    
71     DO J=1,sNy
72     DO I=1,sNx
73     tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
74     ENDDO
75     ENDDO
76    
77     ENDDO
78     ENDDO
79     ENDDO
80    
81     ENDDO
82    
83     C F <- [1-d_xx^n]F
84     DO bj=myByLo(myThid),myByHi(myThid)
85     DO bi=myBxLo(myThid),myBxHi(myThid)
86     DO K=1,Nr
87     DO J=1,sNy
88     DO I=1,sNx
89     tmpScal=tmpFld(i,j,k,bi,bj)
90     tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
91     field(i,j,k,bi,bj)=field(i,j,k,bi,bj)-0.5*tmpScal
92     ENDDO
93     ENDDO
94     ENDDO
95     ENDDO
96     ENDDO
97    
98    
99     C d_yy^n tmpFld
100    
101     DO N=1,nShapT
102    
103     _EXCH_XYZ_R8( tmpFld, myThid )
104    
105     DO bj=myByLo(myThid),myByHi(myThid)
106     DO bi=myBxLo(myThid),myBxHi(myThid)
107     DO K=1,Nr
108    
109     DO J=1,sNy
110     DO I=1,sNx
111     tmpGrd(i,j) = -0.25*(
112     & ( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
113     & *_maskS(i,j+1,k,bi,bj)
114     & -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
115     & *_maskS(i,j,k,bi,bj) )
116     ENDDO
117     ENDDO
118    
119     DO J=1,sNy
120     DO I=1,sNx
121     tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
122     ENDDO
123     ENDDO
124    
125     ENDDO
126     ENDDO
127     ENDDO
128    
129     ENDDO
130    
131     C F <- [1-d_yy^n]F
132     DO bj=myByLo(myThid),myByHi(myThid)
133     DO bi=myBxLo(myThid),myBxHi(myThid)
134     DO K=1,Nr
135     DO J=1,sNy
136     DO I=1,sNx
137     tmpScal=tmpFld(i,j,k,bi,bj)
138     field(i,j,k,bi,bj)=field(i,j,k,bi,bj)-0.5*tmpScal
139     ENDDO
140     ENDDO
141     ENDDO
142     ENDDO
143     ENDDO
144    
145     _EXCH_XYZ_R8( field, myThid )
146    
147     ENDIF
148     #endif /* ALLOW_SHAP_FILT */
149    
150     RETURN
151     END
  ViewVC Help
Powered by ViewVC 1.1.22