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

Contents of /MITgcm/pkg/shap_filt/shap_filt_apply_ts.F

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

Revision 1.10 - (show annotations) (download)
Sun Mar 26 22:56:43 2006 UTC (18 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59, checkpoint58f_post, checkpoint58d_post, checkpoint58y_post, checkpoint58t_post, checkpoint58m_post, checkpoint60, checkpoint61, checkpoint58w_post, checkpoint58o_post, checkpoint58p_post, checkpoint58q_post, checkpoint58e_post, checkpoint58r_post, checkpoint58n_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint58k_post, checkpoint58v_post, checkpoint58l_post, checkpoint58g_post, checkpoint58x_post, checkpoint59j, checkpoint58h_post, checkpoint58j_post, checkpoint58i_post, checkpoint58u_post, checkpoint58s_post, checkpoint61b, checkpoint61c, checkpoint61a
Changes since 1.9: +10 -4 lines 
fix missing Exch with implicitIntGravWave & Shapiro filter on T,S
 (hard to get it right in all cases and to keep the minimum of Exch)
1 C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_apply_ts.F,v 1.9 2005/09/27 22:11:06 jmc Exp $
2 C $Name: $
3
4 #include "SHAP_FILT_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: SHAP_FILT_APPLY_TS
8
9 C !INTERFACE: ==========================================================
10 SUBROUTINE SHAP_FILT_APPLY_TS(
11 U tFld, sFld,
12 I myTime, myIter, myThid )
13
14 C !DESCRIPTION:
15 C Apply a Shapiro filter on active tracers tFld & sFld
16
17 C !USES: ===============================================================
18 IMPLICIT NONE
19
20 #include "SIZE.h"
21 #include "EEPARAMS.h"
22 #include "PARAMS.h"
23 #include "DYNVARS.h"
24 #include "GRID.h"
25 #include "SHAP_FILT.h"
26
27 C !INPUT PARAMETERS: ===================================================
28 C myTime :: current time
29 C myIter :: iteration number
30 C myThid :: thread number
31 _RL myTime
32 INTEGER myIter
33 INTEGER myThid
34
35 C !INPUT/OUTPUT PARAMETERS: ============================================
36 C tFld :: input and filtered temperature field
37 C sFld :: input and filtered salinity field
38 _RL tFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
39 _RL sFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
40
41 #ifdef ALLOW_SHAP_FILT
42
43 LOGICAL DIFFERENT_MULTIPLE
44 EXTERNAL DIFFERENT_MULTIPLE
45
46 C !LOCAL VARIABLES: ====================================================
47 C == Local variables ==
48 #ifdef USE_OLD_SHAPIRO_FILTERS
49 C bi,bj,k :: loop index
50 INTEGER bi, bj, k
51 #endif /* USE_OLD_SHAPIRO_FILTERS */
52 INTEGER exchInOut
53 CHARACTER*(MAX_LEN_MBUF) suff
54
55 CEOP
56
57 IF (nShapT.GT.0 .OR. nShapS.GT.0) THEN
58
59 C- Apply Exchanges on Input field, before the filter (but not after):
60 exchInOut = 1
61 C- Apply Exchanges on Output field, after the filter (but not before):
62 IF ( implicitIntGravWave ) exchInOut = 2
63
64 #ifdef USE_OLD_SHAPIRO_FILTERS
65
66 IF ( tempStepping ) _EXCH_XYZ_R8( tFld,myThid )
67 IF ( saltStepping ) _EXCH_XYZ_R8( sFld,myThid )
68
69 DO bj=myByLo(myThid),myByHi(myThid)
70 DO bi=myBxLo(myThid),myBxHi(myThid)
71 DO k=1, Nr
72 IF ( tempStepping )
73 & CALL SHAP_FILT_TRACEROLD( tFld,bi,bj,k,myTime,myThid )
74 IF ( saltStepping )
75 & CALL SHAP_FILT_TRACEROLD( sFld,bi,bj,k,myTime,myThid )
76 ENDDO
77 ENDDO
78 ENDDO
79
80 IF ( tempStepping ) _EXCH_XYZ_R8( tFld,myThid )
81 IF ( saltStepping ) _EXCH_XYZ_R8( sFld,myThid )
82
83 #else
84
85 IF ( tempStepping .AND. nShapT.GT.0) THEN
86 IF (Shap_funct.EQ.1) THEN
87 CALL SHAP_FILT_TRACER_S1(
88 U tFld, Shap_tmpFld1,
89 I nShapT, Nr, myTime, myThid )
90 ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.20
91 & .OR. Shap_funct.EQ.21) THEN
92 CALL SHAP_FILT_TRACER_S2(
93 U tFld, Shap_tmpFld1,
94 I nShapT, exchInOut, Nr, myTime, myIter, myThid )
95 ELSEIF (Shap_funct.EQ.4) THEN
96 CALL SHAP_FILT_TRACER_S4(
97 U tFld, Shap_tmpFld1,
98 I nShapT, Nr, myTime, myThid )
99 c ELSEIF (Shap_funct.EQ.20) THEN
100 c CALL SHAP_FILT_TRACER_S2G(
101 c U tFld, Shap_tmpFld1,
102 c I nShapT, Nr, myTime, myThid )
103 ELSE
104 STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in T block'
105 ENDIF
106
107 C----- Diagnostic of Shapiro Filter effect on temperature :
108 C Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4)
109 C is directly proportional to Delta-Tr due to the Filter
110 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
111 & DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
112 & ) THEN
113 _BARRIER
114 _BEGIN_MASTER( myThid )
115 WRITE(suff,'(I10.10)') myIter
116 CALL WRITE_FLD_XYZ_RL( 'shap_dT.', suff, Shap_tmpFld1,
117 & myIter, myThid)
118 _END_MASTER( myThid )
119 _BARRIER
120 ENDIF
121
122 #ifdef ALLOW_DIAGNOSTICS
123 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
124 & .AND. useDiagnostics ) THEN
125 CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dT ',0,Nr,
126 & 0,1,1,myThid)
127 ENDIF
128 #endif /* ALLOW_DIAGNOSTICS */
129
130 ENDIF
131
132 IF ( saltStepping .AND. nShapS.GT.0) THEN
133 IF (Shap_funct.EQ.1) THEN
134 CALL SHAP_FILT_TRACER_S1(
135 U sFld, Shap_tmpFld1,
136 I nShapS, Nr, myTime, myThid )
137 ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.20
138 & .OR. Shap_funct.EQ.21) THEN
139 CALL SHAP_FILT_TRACER_S2(
140 U sFld, Shap_tmpFld1,
141 I nShapS, exchInOut, Nr, myTime, myIter, myThid )
142 ELSEIF (Shap_funct.EQ.4) THEN
143 CALL SHAP_FILT_TRACER_S4(
144 U sFld, Shap_tmpFld1,
145 I nShapS, Nr, myTime, myThid )
146 c ELSEIF (Shap_funct.EQ.20) THEN
147 c CALL SHAP_FILT_TRACER_S2G(
148 c U sFld, Shap_tmpFld1,
149 c I nShapS, Nr, myTime, myThid )
150 ELSE
151 STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in S block'
152 ENDIF
153
154 C----- Diagnostic of Shapiro Filter effect on salinity :
155 C Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4)
156 C is directly proportional to Delta-Tr due to the Filter
157 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
158 & DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
159 & ) THEN
160 _BARRIER
161 _BEGIN_MASTER( myThid )
162 WRITE(suff,'(I10.10)') myIter
163 CALL WRITE_FLD_XYZ_RL( 'shap_dS.', suff, Shap_tmpFld1,
164 & myIter, myThid)
165 _END_MASTER( myThid )
166 _BARRIER
167 ENDIF
168
169 #ifdef ALLOW_DIAGNOSTICS
170 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
171 & .AND. useDiagnostics ) THEN
172 CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dS ',0,Nr,
173 & 0,1,1,myThid)
174 ENDIF
175 #endif /* ALLOW_DIAGNOSTICS */
176
177 ENDIF
178
179 #endif /* USE_OLD_SHAPIRO_FILTERS */
180
181 ENDIF
182
183 #endif /* ALLOW_SHAP_FILT */
184
185 RETURN
186 END
  ViewVC Help
Powered by ViewVC 1.1.22