pkg/shap_filt/shap_filt_tracer_s1.F

aea29c8517 Alis*0001 #include "SHAP_FILT_OPTIONS.h"
15c70d7cd1 Jean*0002
                0003 CBOP
                0004 C     !ROUTINE: SHAP_FILT_TRACER_S1
                0005 C     !INTERFACE:
aea29c8517 Alis*0006       SUBROUTINE SHAP_FILT_TRACER_S1(
15c70d7cd1 Jean*0007      U           field, tmpFld,
fb09a37055 Jean*0008      I           nShapTr, kSize, myTime, myThid )
15c70d7cd1 Jean*0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
                0011 C     | S/R SHAP_FILT_TRACER_S1
                0012 C     | o Applies Shapiro filter to tracer field (cell center).
                0013 C     | o use filtering function "S1" = [1 - d_xx^n - d_yy^n]
                0014 C     |     with no grid spacing (computational Filter)
                0015 C     *==========================================================*
                0016 C     \ev
                0017
                0018 C     !USES:
aea29c8517 Alis*0019       IMPLICIT NONE
15c70d7cd1 Jean*0020
aea29c8517 Alis*0021 C     == Global variables ===
                0022 #include "SIZE.h"
                0023 #include "EEPARAMS.h"
                0024 #include "PARAMS.h"
                0025 #include "GRID.h"
                0026 #include "SHAP_FILT.h"
                0027
15c70d7cd1 Jean*0028 C     !INPUT/OUTPUT PARAMETERS:
aea29c8517 Alis*0029 C     == Routine arguments
15c70d7cd1 Jean*0030 C     field :: cell-centered 2D field on which filter applies
                0031 C     tmpFld :: working temporary array
fb09a37055 Jean*0032 C     nShapTr :: (total) power of the filter for this tracer
15c70d7cd1 Jean*0033 C     kSize :: length of 3rd Dim : either =1 (2D field) or =Nr (3D field)
                0034 C     myTime :: Current time in simulation
                0035 C     myThid :: Thread number for this instance of SHAP_FILT_TRACER_S1
fb09a37055 Jean*0036       INTEGER nShapTr, kSize
15c70d7cd1 Jean*0037       _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
                0038       _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
aea29c8517 Alis*0039       _RL     myTime
                0040       INTEGER myThid
15c70d7cd1 Jean*0041
aea29c8517 Alis*0042 #ifdef ALLOW_SHAP_FILT
                0043
15c70d7cd1 Jean*0044 C     !LOCAL VARIABLES:
aea29c8517 Alis*0045 C     == Local variables ==
                0046       INTEGER bi,bj,K,I,J,N
                0047       _RL tmpGrd(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0048       _RL tmpScal
15c70d7cd1 Jean*0049 CEOP
aea29c8517 Alis*0050
fb09a37055 Jean*0051       IF (nShapTr.gt.0) THEN
aea29c8517 Alis*0052
                0053         DO bj=myByLo(myThid),myByHi(myThid)
                0054          DO bi=myBxLo(myThid),myBxHi(myThid)
15c70d7cd1 Jean*0055           DO K=1,kSize
fffe1c7ff3 Jean*0056            DO J=1-OLy,sNy+OLy
                0057             DO I=1-OLx,sNx+OLx
aea29c8517 Alis*0058              tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
                0059             ENDDO
                0060            ENDDO
                0061           ENDDO
                0062          ENDDO
                0063         ENDDO
                0064
                0065
                0066 C      d_xx^n tmpFld
                0067
fb09a37055 Jean*0068        DO N=1,nShapTr
aea29c8517 Alis*0069
15c70d7cd1 Jean*0070         IF (kSize.EQ.Nr) THEN
7163a40534 Jean*0071           _EXCH_XYZ_RL( tmpFld, myThid )
15c70d7cd1 Jean*0072         ELSE
7163a40534 Jean*0073           _EXCH_XY_RL( tmpFld, myThid )
15c70d7cd1 Jean*0074         ENDIF
aea29c8517 Alis*0075
                0076         DO bj=myByLo(myThid),myByHi(myThid)
                0077          DO bi=myBxLo(myThid),myBxHi(myThid)
15c70d7cd1 Jean*0078           DO K=1,kSize
aea29c8517 Alis*0079
                0080            DO J=1,sNy
                0081             DO I=1,sNx
                0082              tmpGrd(i,j) = -0.25*(
                0083      &        ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
                0084      &            *_maskW(i+1,j,k,bi,bj)
                0085      &       -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
                0086      &            *_maskW(i,j,k,bi,bj) )
                0087             ENDDO
                0088            ENDDO
                0089
                0090            DO J=1,sNy
                0091             DO I=1,sNx
                0092              tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
                0093             ENDDO
                0094            ENDDO
                0095
                0096           ENDDO
                0097          ENDDO
                0098         ENDDO
                0099
                0100        ENDDO
                0101
15c70d7cd1 Jean*0102 C      F <-  [1 - d_xx^n *deltaT/tau].F
aea29c8517 Alis*0103        DO bj=myByLo(myThid),myByHi(myThid)
                0104         DO bi=myBxLo(myThid),myBxHi(myThid)
15c70d7cd1 Jean*0105          DO K=1,kSize
aea29c8517 Alis*0106           DO J=1,sNy
                0107            DO I=1,sNx
15c70d7cd1 Jean*0108             tmpScal=field(i,j,k,bi,bj)
                0109             field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
dfc17c9c63 Jean*0110      &          -0.5*tmpFld(i,j,k,bi,bj)*dTtracerLev(1)/Shap_Trtau
15c70d7cd1 Jean*0111             tmpFld(i,j,k,bi,bj)=tmpScal
aea29c8517 Alis*0112            ENDDO
                0113           ENDDO
                0114          ENDDO
                0115         ENDDO
                0116        ENDDO
                0117
                0118
                0119 C      d_yy^n tmpFld
                0120
fb09a37055 Jean*0121        DO N=1,nShapTr
aea29c8517 Alis*0122
15c70d7cd1 Jean*0123         IF (kSize.EQ.Nr) THEN
7163a40534 Jean*0124           _EXCH_XYZ_RL( tmpFld, myThid )
15c70d7cd1 Jean*0125         ELSE
7163a40534 Jean*0126           _EXCH_XY_RL( tmpFld, myThid )
15c70d7cd1 Jean*0127         ENDIF
aea29c8517 Alis*0128
                0129         DO bj=myByLo(myThid),myByHi(myThid)
                0130          DO bi=myBxLo(myThid),myBxHi(myThid)
15c70d7cd1 Jean*0131           DO K=1,kSize
aea29c8517 Alis*0132
                0133            DO J=1,sNy
                0134             DO I=1,sNx
                0135              tmpGrd(i,j) = -0.25*(
                0136      &        ( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
                0137      &            *_maskS(i,j+1,k,bi,bj)
                0138      &       -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
                0139      &            *_maskS(i,j,k,bi,bj) )
                0140             ENDDO
                0141            ENDDO
                0142
                0143            DO J=1,sNy
                0144             DO I=1,sNx
                0145              tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
                0146             ENDDO
                0147            ENDDO
                0148
                0149           ENDDO
                0150          ENDDO
                0151         ENDDO
                0152
                0153        ENDDO
                0154
15c70d7cd1 Jean*0155 C      F <-  [1 - d_yy^n *deltaT/tau].F
aea29c8517 Alis*0156        DO bj=myByLo(myThid),myByHi(myThid)
                0157         DO bi=myBxLo(myThid),myBxHi(myThid)
15c70d7cd1 Jean*0158          DO K=1,kSize
aea29c8517 Alis*0159           DO J=1,sNy
                0160            DO I=1,sNx
15c70d7cd1 Jean*0161             field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
dfc17c9c63 Jean*0162      &          -0.5*tmpFld(i,j,k,bi,bj)*dTtracerLev(1)/Shap_Trtau
aea29c8517 Alis*0163            ENDDO
                0164           ENDDO
                0165          ENDDO
                0166         ENDDO
                0167        ENDDO
                0168
15c70d7cd1 Jean*0169         IF (kSize.EQ.Nr) THEN
7163a40534 Jean*0170           _EXCH_XYZ_RL( field, myThid )
15c70d7cd1 Jean*0171         ELSEIF (kSize.EQ.1) THEN
7163a40534 Jean*0172           _EXCH_XY_RL( field, myThid )
15c70d7cd1 Jean*0173         ELSE
                0174           STOP 'S/R SHAP_FILT_TRACER_S1: kSize is wrong'
                0175         ENDIF
aea29c8517 Alis*0176
                0177       ENDIF
                0178 #endif /* ALLOW_SHAP_FILT */
                0179
                0180       RETURN
                0181       END