C $Header: /u/gcmpack/MITgcm/pkg/shap_filt/shap_filt_apply_ts.F,v 1.13 2017/03/24 23:51:14 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
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 */
INTEGER exchInOut
CHARACTER*(10) suff
CEOP
IF (nShapT.GT.0 .OR. nShapS.GT.0) THEN
C- Apply Exchanges on Input field, before the filter (but not after):
exchInOut = 1
C- Apply Exchanges on Output field, after the filter (but not before):
IF ( implicitIntGravWave ) exchInOut = 2
#ifdef USE_OLD_SHAPIRO_FILTERS
IF ( tempStepping ) _EXCH_XYZ_RL( tFld,myThid )
IF ( saltStepping ) _EXCH_XYZ_RL( 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_RL( tFld,myThid )
IF ( saltStepping ) _EXCH_XYZ_RL( 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.20
& .OR. Shap_funct.EQ.21) THEN
CALL SHAP_FILT_TRACER_S2(
U tFld, Shap_tmpFld1,
I nShapT, exchInOut, Nr, myTime, myIter, myThid )
ELSEIF (Shap_funct.EQ.4) THEN
CALL SHAP_FILT_TRACER_S4(
U tFld, Shap_tmpFld1,
I nShapT, Nr, myTime, myThid )
c ELSEIF (Shap_funct.EQ.20) THEN
c CALL SHAP_FILT_TRACER_S2G(
c U tFld, Shap_tmpFld1,
c 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
IF ( rwSuffixType.EQ.0 ) THEN
WRITE(suff,'(I10.10)') myIter
ELSE
CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
ENDIF
CALL WRITE_FLD_XYZ_RL( 'shap_dT.', suff, Shap_tmpFld1,
& myIter, 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.20
& .OR. Shap_funct.EQ.21) THEN
CALL SHAP_FILT_TRACER_S2(
U sFld, Shap_tmpFld1,
I nShapS, exchInOut, Nr, myTime, myIter, myThid )
ELSEIF (Shap_funct.EQ.4) THEN
CALL SHAP_FILT_TRACER_S4(
U sFld, Shap_tmpFld1,
I nShapS, Nr, myTime, myThid )
c ELSEIF (Shap_funct.EQ.20) THEN
c CALL SHAP_FILT_TRACER_S2G(
c U sFld, Shap_tmpFld1,
c 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
IF ( rwSuffixType.EQ.0 ) THEN
WRITE(suff,'(I10.10)') myIter
ELSE
CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
ENDIF
CALL WRITE_FLD_XYZ_RL( 'shap_dS.', suff, Shap_tmpFld1,
& myIter, 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