pkg/shap_filt/shap_filt_v.F

42c525bfb4 Alis*0001 #include "SHAP_FILT_OPTIONS.h"
                0002
                0003       SUBROUTINE SHAP_FILT_V( vVel,bi,bj,K,myCurrentTime,myThid )
                0004 C     /==========================================================\
                0005 C     | S/R SHAP_FILT_V                                          |
                0006 C     | Applies Shapiro filter to V field over one XY slice      |
                0007 C     | of one tile at a time.                                   |
                0008 C     \==========================================================/
                0009       IMPLICIT NONE
                0010
                0011 C     == Global variables ===
                0012 #include "SIZE.h"
                0013 #include "EEPARAMS.h"
                0014 #include "PARAMS.h"
                0015 #include "GRID.h"
aea29c8517 Alis*0016 #include "SHAP_FILT.h"
42c525bfb4 Alis*0017
                0018 C     == Routine arguments
                0019       _RL vVel(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0020       INTEGER myThid
                0021       _RL     myCurrentTime
                0022       INTEGER bi, bj, K
                0023
                0024 #ifdef ALLOW_SHAP_FILT
                0025
                0026 C     == Local variables ==
                0027       _RL tmpFldX(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
                0028       _RL tmpFldY(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
                0029       _RS maskZ(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0030       INTEGER I,J,N,N1,N2
                0031
                0032 C     Create temporary Zeta mask (accounting for thin walls)
                0033       DO J=1-OLy+1,sNy+OLy
                0034        DO I=1-OLx,sNx+OLx
                0035         maskZ(i,j) = _maskW(i,j-1,k,bi,bj)
                0036      &              *_maskW(i, j ,k,bi,bj)
                0037        ENDDO
                0038       ENDDO
                0039
                0040       DO J=1-OLy,sNy+OLy
                0041        DO I=1-OLx,sNx+OLx
                0042         tmpFldX(i,j,1) = vVel(i,j,k,bi,bj)
                0043      &                   *_maskS(i,j,k,bi,bj)
                0044        ENDDO
                0045       ENDDO
                0046
                0047 C     Extract small-scale noise from tmpFldX (delta_ii^n)
aea29c8517 Alis*0048       DO N=1,nShapUV
42c525bfb4 Alis*0049        N1=1+mod(N+1,2)
                0050        N2=1+mod( N ,2)
                0051        DO J=1-OLy+1,sNy+OLy
                0052         DO I=1-OLx+1,sNx+OLx-1
                0053          tmpFldX(i,j,N2) = -0.25*(
                0054      &    (tmpFldX(i+1,j,N1)-tmpFldX( i ,j,N1))*maskZ(i+1,j)
                0055      &   -(tmpFldX( i ,j,N1)-tmpFldX(i-1,j,N1))*maskZ( i ,j)
                0056 #ifdef NO_SLIP_SHAP
                0057      &   -2.*(2.-maskZ(i,j)-maskZ(i+1,j))*tmpFldX(i,j,N1)
                0058 #endif
                0059      &         )*_maskS(i,j,k,bi,bj)
                0060         ENDDO
                0061        ENDDO
                0062       ENDDO
                0063
                0064 #ifdef SEQUENTIAL_2D_SHAP
                0065       DO J=1-OLy,sNy+OLy
                0066        DO I=1-OLx,sNx+OLx
                0067         tmpFldX(i,j,N2) = vVel(i,j,k,bi,bj) - tmpFldX(i,j,N2)
                0068         tmpFldY(i,j,1) = tmpFldX(i,j,N2)
                0069        ENDDO
                0070       ENDDO
                0071 #else
                0072       DO J=1-OLy,sNy+OLy
                0073        DO I=1-OLx,sNx+OLx
                0074         tmpFldY(i,j,1) = vVel(i,j,k,bi,bj)
                0075      &                   *_maskS(i,j,k,bi,bj)
                0076        ENDDO
                0077       ENDDO
                0078 #endif /* SEQUENTIAL_2D_SHAP */
                0079
                0080 C     Extract small-scale noise from tmpFldY (delta_jj^n)
aea29c8517 Alis*0081       DO N=1,nShapUV
42c525bfb4 Alis*0082        N1=1+mod(N+1,2)
                0083        N2=1+mod( N ,2)
                0084        DO J=1-OLy+1,sNy+OLy-1
                0085         DO I=1-OLx,sNx+OLx
                0086          tmpFldY(i,j,N2) = -0.25*(
                0087      &          tmpFldY(i,j-1,N1) + tmpFldY(i,j+1,N1)
                0088      &             - 2.*tmpFldY(i,j,N1)
                0089      &            )*_maskS(i,j,k,bi,bj)
                0090         ENDDO
                0091        ENDDO
                0092       ENDDO
                0093
                0094 C     Subtract small-scale noise from field
                0095 #ifdef SEQUENTIAL_2D_SHAP
                0096       DO J=1-OLy,sNy+OLy
                0097        DO I=1-OLx,sNx+OLx
                0098         vVel(i,j,k,bi,bj) = tmpFldX(i,j,N2) - tmpFldY(i,j,N2)
                0099        ENDDO
                0100       ENDDO
                0101 #else
                0102       DO J=1-OLy,sNy+OLy
                0103        DO I=1-OLx,sNx+OLx
                0104         vVel(i,j,k,bi,bj) = vVel(i,j,k,bi,bj)
                0105      &    -0.5*( tmpFldX(i,j,N2)+tmpFldY(i,j,N2) )
                0106        ENDDO
                0107       ENDDO
                0108 #endif /* SEQUENTIAL_2D_SHAP */
                0109
                0110 #endif /* ALLOW_SHAP_FILT */
                0111
                0112       RETURN
                0113       END