/[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.7 - (hide annotations) (download)
Tue Apr 28 18:20:30 2009 UTC (15 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint62c, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint63g, checkpoint64, checkpoint65, checkpoint62, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint65o, checkpoint62b, checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint61n, checkpoint61q, checkpoint61o, checkpoint61m, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61z, checkpoint61x, checkpoint61y, HEAD
Changes since 1.6: +7 -7 lines 
change macros (EXCH & GLOBAL_SUM/MAX) sufix _R4/_R8 to _RS/_RL
 when applied to _RS/_RL variable
1 jmc 1.7 C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_tracer_s1.F,v 1.6 2004/12/04 00:19:12 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 jmc 1.7 _EXCH_XYZ_RL( tmpFld, myThid )
75 jmc 1.3 ELSE
76 jmc 1.7 _EXCH_XY_RL( tmpFld, myThid )
77 jmc 1.3 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 jmc 1.7 _EXCH_XYZ_RL( tmpFld, myThid )
128 jmc 1.3 ELSE
129 jmc 1.7 _EXCH_XY_RL( tmpFld, myThid )
130 jmc 1.3 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 jmc 1.7 _EXCH_XYZ_RL( field, myThid )
174 jmc 1.3 ELSEIF (kSize.EQ.1) THEN
175 jmc 1.7 _EXCH_XY_RL( field, myThid )
176 jmc 1.3 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