/[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.6 - (hide annotations) (download)
Sat Dec 4 00:19:12 2004 UTC (19 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint57m_post, checkpoint57g_pre, checkpoint57s_post, checkpoint58b_post, checkpoint57b_post, checkpoint57g_post, checkpoint57y_post, checkpoint57r_post, checkpoint57d_post, checkpoint57i_post, checkpoint59, checkpoint58, checkpoint57, checkpoint58f_post, checkpoint57n_post, checkpoint58d_post, checkpoint58a_post, checkpoint57z_post, checkpoint58y_post, checkpoint58t_post, checkpoint58m_post, checkpoint57l_post, checkpoint57t_post, checkpoint57v_post, checkpoint57f_post, checkpoint60, checkpoint61, checkpoint57a_post, checkpoint57h_pre, checkpoint58w_post, checkpoint57h_post, checkpoint57y_pre, checkpoint58o_post, checkpoint57c_post, checkpoint58p_post, checkpoint58q_post, checkpoint58e_post, checkpoint57c_pre, checkpoint58r_post, checkpoint58n_post, checkpoint57e_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, eckpoint57e_pre, checkpoint58k_post, checkpoint58v_post, checkpoint58l_post, checkpoint57h_done, checkpoint57j_post, checkpoint57f_pre, checkpoint61f, checkpoint58g_post, checkpoint58x_post, checkpoint59j, checkpoint58h_post, checkpoint58j_post, checkpoint57a_pre, checkpoint57o_post, checkpoint57k_post, checkpoint57w_post, checkpoint61e, checkpoint58i_post, checkpoint57x_post, checkpoint58c_post, checkpoint58u_post, checkpoint58s_post, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61l, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i
Changes since 1.5: +3 -3 lines 
depth convergence accelerator: replace deltaTtracer by dTtracerLev(k)
1 jmc 1.6 C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_tracer_s1.F,v 1.5 2004/06/26 01:15:30 jmc Exp $
2 jmc 1.3 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 jmc 1.5 I nShapTr, kSize, myTime, myThid )
12 jmc 1.3 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 jmc 1.5 C nShapTr :: (total) power of the filter for this tracer
36 jmc 1.3 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_S1
39 jmc 1.5 INTEGER nShapTr, kSize
40 jmc 1.3 _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.3
45 adcroft 1.2 #ifdef ALLOW_SHAP_FILT
46    
47 jmc 1.3 C !LOCAL VARIABLES:
48 adcroft 1.2 C == Local variables ==
49     INTEGER bi,bj,K,I,J,N
50     _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
51     _RL tmpScal
52 jmc 1.3 CEOP
53 adcroft 1.2
54 jmc 1.5 IF (nShapTr.gt.0) THEN
55 adcroft 1.2
56     DO bj=myByLo(myThid),myByHi(myThid)
57     DO bi=myBxLo(myThid),myBxHi(myThid)
58 jmc 1.3 DO K=1,kSize
59 jmc 1.4 DO J=1-OLy,sNy+OLy
60     DO I=1-OLx,sNx+OLx
61 adcroft 1.2 tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
62     ENDDO
63     ENDDO
64     ENDDO
65     ENDDO
66     ENDDO
67    
68    
69     C d_xx^n tmpFld
70    
71 jmc 1.5 DO N=1,nShapTr
72 adcroft 1.2
73 jmc 1.3 IF (kSize.EQ.Nr) THEN
74     _EXCH_XYZ_R8( tmpFld, myThid )
75     ELSE
76     _EXCH_XY_R8( tmpFld, myThid )
77     ENDIF
78 adcroft 1.2
79     DO bj=myByLo(myThid),myByHi(myThid)
80     DO bi=myBxLo(myThid),myBxHi(myThid)
81 jmc 1.3 DO K=1,kSize
82 adcroft 1.2
83     DO J=1,sNy
84     DO I=1,sNx
85     tmpGrd(i,j) = -0.25*(
86     & ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
87     & *_maskW(i+1,j,k,bi,bj)
88     & -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
89     & *_maskW(i,j,k,bi,bj) )
90     ENDDO
91     ENDDO
92    
93     DO J=1,sNy
94     DO I=1,sNx
95     tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
96     ENDDO
97     ENDDO
98    
99     ENDDO
100     ENDDO
101     ENDDO
102    
103     ENDDO
104    
105 jmc 1.3 C F <- [1 - d_xx^n *deltaT/tau].F
106 adcroft 1.2 DO bj=myByLo(myThid),myByHi(myThid)
107     DO bi=myBxLo(myThid),myBxHi(myThid)
108 jmc 1.3 DO K=1,kSize
109 adcroft 1.2 DO J=1,sNy
110     DO I=1,sNx
111 jmc 1.3 tmpScal=field(i,j,k,bi,bj)
112     field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
113 jmc 1.6 & -0.5*tmpFld(i,j,k,bi,bj)*dTtracerLev(1)/Shap_Trtau
114 jmc 1.3 tmpFld(i,j,k,bi,bj)=tmpScal
115 adcroft 1.2 ENDDO
116     ENDDO
117     ENDDO
118     ENDDO
119     ENDDO
120    
121    
122     C d_yy^n tmpFld
123    
124 jmc 1.5 DO N=1,nShapTr
125 adcroft 1.2
126 jmc 1.3 IF (kSize.EQ.Nr) THEN
127     _EXCH_XYZ_R8( tmpFld, myThid )
128     ELSE
129     _EXCH_XY_R8( tmpFld, myThid )
130     ENDIF
131 adcroft 1.2
132     DO bj=myByLo(myThid),myByHi(myThid)
133     DO bi=myBxLo(myThid),myBxHi(myThid)
134 jmc 1.3 DO K=1,kSize
135 adcroft 1.2
136     DO J=1,sNy
137     DO I=1,sNx
138     tmpGrd(i,j) = -0.25*(
139     & ( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
140     & *_maskS(i,j+1,k,bi,bj)
141     & -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
142     & *_maskS(i,j,k,bi,bj) )
143     ENDDO
144     ENDDO
145    
146     DO J=1,sNy
147     DO I=1,sNx
148     tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
149     ENDDO
150     ENDDO
151    
152     ENDDO
153     ENDDO
154     ENDDO
155    
156     ENDDO
157    
158 jmc 1.3 C F <- [1 - d_yy^n *deltaT/tau].F
159 adcroft 1.2 DO bj=myByLo(myThid),myByHi(myThid)
160     DO bi=myBxLo(myThid),myBxHi(myThid)
161 jmc 1.3 DO K=1,kSize
162 adcroft 1.2 DO J=1,sNy
163     DO I=1,sNx
164 jmc 1.3 field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
165 jmc 1.6 & -0.5*tmpFld(i,j,k,bi,bj)*dTtracerLev(1)/Shap_Trtau
166 adcroft 1.2 ENDDO
167     ENDDO
168     ENDDO
169     ENDDO
170     ENDDO
171    
172 jmc 1.3 IF (kSize.EQ.Nr) THEN
173     _EXCH_XYZ_R8( field, myThid )
174     ELSEIF (kSize.EQ.1) THEN
175     _EXCH_XY_R8( field, myThid )
176     ELSE
177     STOP 'S/R SHAP_FILT_TRACER_S1: kSize is wrong'
178     ENDIF
179 adcroft 1.2
180     ENDIF
181     #endif /* ALLOW_SHAP_FILT */
182    
183     RETURN
184     END
  ViewVC Help
Powered by ViewVC 1.1.22