pkg/shap_filt/shap_filt_apply_ts.F

C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_apply_ts.F,v 1.7 2005/04/06 18:46:54 jmc Exp $
C $Name:  $

#include "SHAP_FILT_OPTIONS.h"

CBOP
C !ROUTINE: SHAP_FILT_APPLY_TS

C !INTERFACE: ==========================================================
      SUBROUTINE SHAP_FILT_APPLY_TS(
     U                     tFld, sFld,
     I                     myTime, myIter, myThid )

C !DESCRIPTION:
C Apply a Shapiro filter on active tracers tFld & sFld

C !USES: ===============================================================
      IMPLICIT NONE

#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DYNVARS.h"
#include "GRID.h"
#include "SHAP_FILT.h"

C !INPUT PARAMETERS: ===================================================
C  myTime               :: current time
C  myIter               :: iteration number
C  myThid               :: thread number
      _RL myTime
      INTEGER myIter
      INTEGER myThid

C !INPUT/OUTPUT PARAMETERS: ============================================
C tFld                  :: input and filtered temperature field
C sFld                  :: input and filtered salinity field
      _RL  tFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
      _RL  sFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)

#ifdef ALLOW_SHAP_FILT

      LOGICAL  DIFFERENT_MULTIPLE
      EXTERNAL DIFFERENT_MULTIPLE

C !LOCAL VARIABLES: ====================================================
C     == Local variables ==
#ifdef USE_OLD_SHAPIRO_FILTERS
C     bi,bj,k :: loop index
      INTEGER bi, bj, k
#endif /* USE_OLD_SHAPIRO_FILTERS */
      CHARACTER*(MAX_LEN_MBUF) suff

CEOP

      IF (nShapT.GT.0 .OR. nShapS.GT.0) THEN

#ifdef USE_OLD_SHAPIRO_FILTERS

        IF ( tempStepping ) _EXCH_XYZ_R8( tFld,myThid )
        IF ( saltStepping ) _EXCH_XYZ_R8( sFld,myThid )

        DO bj=myByLo(myThid),myByHi(myThid)
         DO bi=myBxLo(myThid),myBxHi(myThid)
          DO k=1, Nr
            IF ( tempStepping ) 
     &       CALL SHAP_FILT_TRACEROLD( tFld,bi,bj,k,myTime,myThid )
            IF ( saltStepping ) 
     &       CALL SHAP_FILT_TRACEROLD( sFld,bi,bj,k,myTime,myThid )
          ENDDO
         ENDDO
        ENDDO

        IF ( tempStepping ) _EXCH_XYZ_R8( tFld,myThid )
        IF ( saltStepping ) _EXCH_XYZ_R8( sFld,myThid )

#else

        IF ( tempStepping .AND. nShapT.GT.0) THEN
          IF (Shap_funct.EQ.1) THEN
            CALL SHAP_FILT_TRACER_S1(
     U           tFld, Shap_tmpFld1,
     I           nShapT, Nr, myTime, myThid )
          ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.21) THEN
            CALL SHAP_FILT_TRACER_S2(
     U           tFld, Shap_tmpFld1,
     I           nShapT, Nr, myTime, myThid )
          ELSEIF (Shap_funct.EQ.4) THEN
            CALL SHAP_FILT_TRACER_S4(
     U           tFld, Shap_tmpFld1,
     I           nShapT, Nr, myTime, myThid )
          ELSEIF (Shap_funct.EQ.20) THEN
            CALL SHAP_FILT_TRACER_S2G(
     U           tFld, Shap_tmpFld1,
     I           nShapT, Nr, myTime, myThid )
          ELSE
           STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in T block'
          ENDIF

C-----    Diagnostic of Shapiro Filter effect on temperature :
C         Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4)
C               is directly proportional to Delta-Tr due to the Filter
          IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
     &     DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
     &       ) THEN
           _BARRIER
           _BEGIN_MASTER( myThid )
           WRITE(suff,'(I10.10)') myIter
           CALL WRITE_FLD_XYZ_RL( 'shap_dT.', suff, Shap_tmpFld1,
     &                            myIter, myThid)
           _END_MASTER( myThid )
           _BARRIER
          ENDIF

#ifdef ALLOW_DIAGNOSTICS
          IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
     &                         .AND. useDiagnostics ) THEN
            CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dT ',0,Nr,
     &                                                  0,1,1,myThid)
          ENDIF
#endif /* ALLOW_DIAGNOSTICS */

        ENDIF

        IF ( saltStepping .AND. nShapS.GT.0) THEN 
          IF (Shap_funct.EQ.1) THEN
            CALL SHAP_FILT_TRACER_S1(
     U           sFld, Shap_tmpFld1,
     I           nShapS, Nr, myTime, myThid )
          ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.21) THEN
            CALL SHAP_FILT_TRACER_S2(
     U           sFld, Shap_tmpFld1,
     I           nShapS, Nr, myTime, myThid )
          ELSEIF (Shap_funct.EQ.4) THEN
            CALL SHAP_FILT_TRACER_S4(
     U           sFld, Shap_tmpFld1,
     I           nShapS, Nr, myTime, myThid )
          ELSEIF (Shap_funct.EQ.20) THEN
            CALL SHAP_FILT_TRACER_S2G(
     U           sFld, Shap_tmpFld1,
     I           nShapS, Nr, myTime, myThid )
          ELSE
           STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in S block'
          ENDIF

C-----    Diagnostic of Shapiro Filter effect on salinity :
C         Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4) 
C               is directly proportional to Delta-Tr due to the Filter
          IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
     &     DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
     &       ) THEN
           _BARRIER
           _BEGIN_MASTER( myThid )
           WRITE(suff,'(I10.10)') myIter
           CALL WRITE_FLD_XYZ_RL( 'shap_dS.', suff, Shap_tmpFld1,
     &                            myIter, myThid)
           _END_MASTER( myThid )
           _BARRIER
          ENDIF

#ifdef ALLOW_DIAGNOSTICS
          IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
     &                         .AND. useDiagnostics ) THEN
            CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dS ',0,Nr,
     &                                                  0,1,1,myThid)
          ENDIF
#endif /* ALLOW_DIAGNOSTICS */

        ENDIF

#endif /* USE_OLD_SHAPIRO_FILTERS */

      ENDIF

#endif /* ALLOW_SHAP_FILT */

      RETURN
      END
1	jmc	1.8	C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_apply_ts.F,v 1.7 2005/04/06 18:46:54 jmc Exp $
2	jmc	1.1	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	jmc	1.8	LOGICAL DIFFERENT_MULTIPLE
44			EXTERNAL DIFFERENT_MULTIPLE
45	jmc	1.4
46	jmc	1.1	C !LOCAL VARIABLES: ====================================================
47	jmc	1.4	C == Local variables ==
48	jmc	1.3	#ifdef USE_OLD_SHAPIRO_FILTERS
49			C bi,bj,k :: loop index
50			INTEGER bi, bj, k
51			#endif /* USE_OLD_SHAPIRO_FILTERS */
52	jmc	1.4	CHARACTER*(MAX_LEN_MBUF) suff
53	jmc	1.1
54			CEOP
55
56	jmc	1.5	IF (nShapT.GT.0 .OR. nShapS.GT.0) THEN
57	jmc	1.1
58	jmc	1.2	#ifdef USE_OLD_SHAPIRO_FILTERS
59
60			IF ( tempStepping ) _EXCH_XYZ_R8( tFld,myThid )
61			IF ( saltStepping ) _EXCH_XYZ_R8( sFld,myThid )
62
63			DO bj=myByLo(myThid),myByHi(myThid)
64			DO bi=myBxLo(myThid),myBxHi(myThid)
65			DO k=1, Nr
66			IF ( tempStepping )
67			& CALL SHAP_FILT_TRACEROLD( tFld,bi,bj,k,myTime,myThid )
68			IF ( saltStepping )
69			& CALL SHAP_FILT_TRACEROLD( sFld,bi,bj,k,myTime,myThid )
70			ENDDO
71			ENDDO
72			ENDDO
73
74			IF ( tempStepping ) _EXCH_XYZ_R8( tFld,myThid )
75			IF ( saltStepping ) _EXCH_XYZ_R8( sFld,myThid )
76
77			#else
78
79	jmc	1.1	IF ( tempStepping .AND. nShapT.GT.0) THEN
80			IF (Shap_funct.EQ.1) THEN
81			CALL SHAP_FILT_TRACER_S1(
82	jmc	1.3	U tFld, Shap_tmpFld1,
83	jmc	1.5	I nShapT, Nr, myTime, myThid )
84	jmc	1.3	ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.21) THEN
85	jmc	1.1	CALL SHAP_FILT_TRACER_S2(
86	jmc	1.3	U tFld, Shap_tmpFld1,
87	jmc	1.5	I nShapT, Nr, myTime, myThid )
88	jmc	1.1	ELSEIF (Shap_funct.EQ.4) THEN
89			CALL SHAP_FILT_TRACER_S4(
90	jmc	1.3	U tFld, Shap_tmpFld1,
91	jmc	1.5	I nShapT, Nr, myTime, myThid )
92	jmc	1.1	ELSEIF (Shap_funct.EQ.20) THEN
93			CALL SHAP_FILT_TRACER_S2G(
94	jmc	1.3	U tFld, Shap_tmpFld1,
95	jmc	1.5	I nShapT, Nr, myTime, myThid )
96	jmc	1.1	ELSE
97	jmc	1.3	STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in T block'
98	jmc	1.1	ENDIF
99	jmc	1.4
100			C----- Diagnostic of Shapiro Filter effect on temperature :
101			C Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4)
102			C is directly proportional to Delta-Tr due to the Filter
103			IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
104	jmc	1.8	& DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
105	jmc	1.4	& ) THEN
106			_BARRIER
107			_BEGIN_MASTER( myThid )
108			WRITE(suff,'(I10.10)') myIter
109			CALL WRITE_FLD_XYZ_RL( 'shap_dT.', suff, Shap_tmpFld1,
110			& myIter, myThid)
111			_END_MASTER( myThid )
112			_BARRIER
113			ENDIF
114
115	jmc	1.6	#ifdef ALLOW_DIAGNOSTICS
116			IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
117			& .AND. useDiagnostics ) THEN
118			CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dT ',0,Nr,
119			& 0,1,1,myThid)
120			ENDIF
121			#endif /* ALLOW_DIAGNOSTICS */
122
123	jmc	1.1	ENDIF
124	jmc	1.2
125	jmc	1.5	IF ( saltStepping .AND. nShapS.GT.0) THEN
126	jmc	1.1	IF (Shap_funct.EQ.1) THEN
127			CALL SHAP_FILT_TRACER_S1(
128	jmc	1.3	U sFld, Shap_tmpFld1,
129	jmc	1.5	I nShapS, Nr, myTime, myThid )
130	jmc	1.3	ELSEIF (Shap_funct.EQ.2 .OR. Shap_funct.EQ.21) THEN
131	jmc	1.1	CALL SHAP_FILT_TRACER_S2(
132	jmc	1.3	U sFld, Shap_tmpFld1,
133	jmc	1.5	I nShapS, Nr, myTime, myThid )
134	jmc	1.1	ELSEIF (Shap_funct.EQ.4) THEN
135			CALL SHAP_FILT_TRACER_S4(
136	jmc	1.3	U sFld, Shap_tmpFld1,
137	jmc	1.5	I nShapS, Nr, myTime, myThid )
138	jmc	1.1	ELSEIF (Shap_funct.EQ.20) THEN
139			CALL SHAP_FILT_TRACER_S2G(
140	jmc	1.3	U sFld, Shap_tmpFld1,
141	jmc	1.5	I nShapS, Nr, myTime, myThid )
142	jmc	1.1	ELSE
143	jmc	1.3	STOP 'SHAP_FILT_APPLY_TS: Ooops! Bad Shap_funct in S block'
144	jmc	1.1	ENDIF
145	jmc	1.4
146			C----- Diagnostic of Shapiro Filter effect on salinity :
147			C Note: Shap_tmpFld1 from shap_filt_tracer_s2 (and not s1, s4)
148			C is directly proportional to Delta-Tr due to the Filter
149			IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4 .AND.
150	jmc	1.8	& DIFFERENT_MULTIPLE(Shap_diagFreq,myTime,deltaTClock)
151	jmc	1.4	& ) THEN
152			_BARRIER
153			_BEGIN_MASTER( myThid )
154			WRITE(suff,'(I10.10)') myIter
155			CALL WRITE_FLD_XYZ_RL( 'shap_dS.', suff, Shap_tmpFld1,
156			& myIter, myThid)
157			_END_MASTER( myThid )
158			_BARRIER
159			ENDIF
160
161	jmc	1.6	#ifdef ALLOW_DIAGNOSTICS
162			IF ( Shap_funct.NE.1 .AND. Shap_funct.NE.4
163			& .AND. useDiagnostics ) THEN
164			CALL DIAGNOSTICS_FILL(Shap_tmpFld1,'SHAP_dS ',0,Nr,
165			& 0,1,1,myThid)
166			ENDIF
167			#endif /* ALLOW_DIAGNOSTICS */
168
169	jmc	1.1	ENDIF
170
171	jmc	1.2	#endif /* USE_OLD_SHAPIRO_FILTERS */
172
173	jmc	1.1	ENDIF
174	jmc	1.2
175	jmc	1.1	#endif /* ALLOW_SHAP_FILT */
176
177			RETURN
178			END