/[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.12 - (show annotations) (download)
Tue Apr 28 18:20:30 2009 UTC (15 years 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, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, 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
Changes since 1.11: +5 -5 lines
change macros (EXCH & GLOBAL_SUM/MAX) sufix _R4/_R8 to _RS/_RL
 when applied to _RS/_RL variable

1 C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_apply_ts.F,v 1.11 2008/09/09 19:58:27 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_RL( tFld,myThid )
67 IF ( saltStepping ) _EXCH_XYZ_RL( 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_RL( tFld,myThid )
81 IF ( saltStepping ) _EXCH_XYZ_RL( 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 WRITE(suff,'(I10.10)') myIter
115 CALL WRITE_FLD_XYZ_RL( 'shap_dT.', suff, Shap_tmpFld1,
116 & myIter, myThid)
117 _BARRIER
118 ENDIF
119
120 #ifdef ALLOW_DIAGNOSTICS
121 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
122 & .AND. useDiagnostics ) THEN
123 CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dT ',0,Nr,
124 & 0,1,1,myThid)
125 ENDIF
126 #endif /* ALLOW_DIAGNOSTICS */
127
128 ENDIF
129
130 IF ( saltStepping .AND. nShapS.GT.0) THEN
131 IF (Shap_funct.EQ.1) THEN
132 CALL SHAP_FILT_TRACER_S1(
133 U sFld, Shap_tmpFld1,
134 I nShapS, Nr, myTime, myThid )
135 ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.20
136 & .OR. Shap_funct.EQ.21) THEN
137 CALL SHAP_FILT_TRACER_S2(
138 U sFld, Shap_tmpFld1,
139 I nShapS, exchInOut, Nr, myTime, myIter, myThid )
140 ELSEIF (Shap_funct.EQ.4) THEN
141 CALL SHAP_FILT_TRACER_S4(
142 U sFld, Shap_tmpFld1,
143 I nShapS, Nr, myTime, myThid )
144 c ELSEIF (Shap_funct.EQ.20) THEN
145 c CALL SHAP_FILT_TRACER_S2G(
146 c U sFld, Shap_tmpFld1,
147 c I nShapS, Nr, myTime, myThid )
148 ELSE
149 STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in S block'
150 ENDIF
151
152 C----- Diagnostic of Shapiro Filter effect on salinity :
153 C Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4)
154 C is directly proportional to Delta-Tr due to the Filter
155 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
156 & DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
157 & ) THEN
158 _BARRIER
159 WRITE(suff,'(I10.10)') myIter
160 CALL WRITE_FLD_XYZ_RL( 'shap_dS.', suff, Shap_tmpFld1,
161 & myIter, myThid)
162 _BARRIER
163 ENDIF
164
165 #ifdef ALLOW_DIAGNOSTICS
166 IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
167 & .AND. useDiagnostics ) THEN
168 CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dS ',0,Nr,
169 & 0,1,1,myThid)
170 ENDIF
171 #endif /* ALLOW_DIAGNOSTICS */
172
173 ENDIF
174
175 #endif /* USE_OLD_SHAPIRO_FILTERS */
176
177 ENDIF
178
179 #endif /* ALLOW_SHAP_FILT */
180
181 RETURN
182 END

  ViewVC Help
Powered by ViewVC 1.1.22