/[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.3 - (hide annotations) (download)
Mon Mar 4 01:32:55 2002 UTC (22 years, 2 months ago) by jmc
Branch: MAIN
Changes since 1.2: +61 -29 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.3 C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_tracer_s1.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 jmc 1.3
6     CBOP
7     C !ROUTINE: SHAP_FILT_TRACER_S1
8     C !INTERFACE:
9 adcroft 1.2 SUBROUTINE SHAP_FILT_TRACER_S1(
10 jmc 1.3 U field, tmpFld,
11     I kSize, myTime, myThid )
12     C !DESCRIPTION: \bv
13     C *==========================================================*
14     C | S/R SHAP_FILT_TRACER_S1
15     C | o Applies Shapiro filter to tracer field (cell center).
16     C | o use filtering function "S1" = [1 - d_xx^n - d_yy^n]
17     C | with no grid spacing (computational Filter)
18     C *==========================================================*
19     C \ev
20    
21     C !USES:
22 adcroft 1.2 IMPLICIT NONE
23 jmc 1.3
24 adcroft 1.2 C == Global variables ===
25     #include "SIZE.h"
26     #include "EEPARAMS.h"
27     #include "PARAMS.h"
28     #include "GRID.h"
29     #include "SHAP_FILT.h"
30    
31 jmc 1.3 C !INPUT/OUTPUT PARAMETERS:
32 adcroft 1.2 C == Routine arguments
33 jmc 1.3 C field :: cell-centered 2D field on which filter applies
34     C tmpFld :: working temporary array
35     C kSize :: length of 3rd Dim : either =1 (2D field) or =Nr (3D field)
36     C myTime :: Current time in simulation
37     C myThid :: Thread number for this instance of SHAP_FILT_TRACER_S1
38     INTEGER kSize
39     _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
40     _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
41 adcroft 1.2 _RL myTime
42     INTEGER myThid
43 jmc 1.3
44 adcroft 1.2 #ifdef ALLOW_SHAP_FILT
45    
46 jmc 1.3 C !LOCAL VARIABLES:
47 adcroft 1.2 C == Local variables ==
48     INTEGER bi,bj,K,I,J,N
49     _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
50     _RL tmpScal
51 jmc 1.3 CEOP
52 adcroft 1.2
53     IF (nShapT.gt.0) THEN
54    
55     DO bj=myByLo(myThid),myByHi(myThid)
56     DO bi=myBxLo(myThid),myBxHi(myThid)
57 jmc 1.3 DO K=1,kSize
58 adcroft 1.2 DO J=1,sNy
59     DO I=1,sNx
60     tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
61     ENDDO
62     ENDDO
63     ENDDO
64     ENDDO
65     ENDDO
66    
67    
68     C d_xx^n tmpFld
69    
70     DO N=1,nShapT
71    
72 jmc 1.3 IF (kSize.EQ.Nr) THEN
73     _EXCH_XYZ_R8( tmpFld, myThid )
74     ELSE
75     _EXCH_XY_R8( tmpFld, myThid )
76     ENDIF
77 adcroft 1.2
78     DO bj=myByLo(myThid),myByHi(myThid)
79     DO bi=myBxLo(myThid),myBxHi(myThid)
80 jmc 1.3 DO K=1,kSize
81 adcroft 1.2
82     DO J=1,sNy
83     DO I=1,sNx
84     tmpGrd(i,j) = -0.25*(
85     & ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
86     & *_maskW(i+1,j,k,bi,bj)
87     & -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
88     & *_maskW(i,j,k,bi,bj) )
89     ENDDO
90     ENDDO
91    
92     DO J=1,sNy
93     DO I=1,sNx
94     tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
95     ENDDO
96     ENDDO
97    
98     ENDDO
99     ENDDO
100     ENDDO
101    
102     ENDDO
103    
104 jmc 1.3 C F <- [1 - d_xx^n *deltaT/tau].F
105 adcroft 1.2 DO bj=myByLo(myThid),myByHi(myThid)
106     DO bi=myBxLo(myThid),myBxHi(myThid)
107 jmc 1.3 DO K=1,kSize
108 adcroft 1.2 DO J=1,sNy
109     DO I=1,sNx
110 jmc 1.3 tmpScal=field(i,j,k,bi,bj)
111     field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
112     & -0.5*tmpFld(i,j,k,bi,bj)*deltaTtracer/Shap_Trtau
113     tmpFld(i,j,k,bi,bj)=tmpScal
114 adcroft 1.2 ENDDO
115     ENDDO
116     ENDDO
117     ENDDO
118     ENDDO
119    
120    
121     C d_yy^n tmpFld
122    
123     DO N=1,nShapT
124    
125 jmc 1.3 IF (kSize.EQ.Nr) THEN
126     _EXCH_XYZ_R8( tmpFld, myThid )
127     ELSE
128     _EXCH_XY_R8( tmpFld, myThid )
129     ENDIF
130 adcroft 1.2
131     DO bj=myByLo(myThid),myByHi(myThid)
132     DO bi=myBxLo(myThid),myBxHi(myThid)
133 jmc 1.3 DO K=1,kSize
134 adcroft 1.2
135     DO J=1,sNy
136     DO I=1,sNx
137     tmpGrd(i,j) = -0.25*(
138     & ( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
139     & *_maskS(i,j+1,k,bi,bj)
140     & -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
141     & *_maskS(i,j,k,bi,bj) )
142     ENDDO
143     ENDDO
144    
145     DO J=1,sNy
146     DO I=1,sNx
147     tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
148     ENDDO
149     ENDDO
150    
151     ENDDO
152     ENDDO
153     ENDDO
154    
155     ENDDO
156    
157 jmc 1.3 C F <- [1 - d_yy^n *deltaT/tau].F
158 adcroft 1.2 DO bj=myByLo(myThid),myByHi(myThid)
159     DO bi=myBxLo(myThid),myBxHi(myThid)
160 jmc 1.3 DO K=1,kSize
161 adcroft 1.2 DO J=1,sNy
162     DO I=1,sNx
163 jmc 1.3 field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
164     & -0.5*tmpFld(i,j,k,bi,bj)*deltaTtracer/Shap_Trtau
165 adcroft 1.2 ENDDO
166     ENDDO
167     ENDDO
168     ENDDO
169     ENDDO
170    
171 jmc 1.3 IF (kSize.EQ.Nr) THEN
172     _EXCH_XYZ_R8( field, myThid )
173     ELSEIF (kSize.EQ.1) THEN
174     _EXCH_XY_R8( field, myThid )
175     ELSE
176     STOP 'S/R SHAP_FILT_TRACER_S1: kSize is wrong'
177     ENDIF
178 adcroft 1.2
179     ENDIF
180     #endif /* ALLOW_SHAP_FILT */
181    
182     RETURN
183     END
  ViewVC Help
Powered by ViewVC 1.1.22