** Warning **

Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.

Last-Modified: Thu, 11 Sep 2024 05:12:02 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/pkg/shap_filt/shap_filt_tracer_s4.F
Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:43:52 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
aea29c8517 Alis*0001 #include "SHAP_FILT_OPTIONS.h"
15c70d7cd1 Jean*0002  
                0003 CBOP
                0004 C     !ROUTINE: SHAP_FILT_TRACER_S4
                0005 C     !INTERFACE:
                0006       SUBROUTINE SHAP_FILT_TRACER_S4(
                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_S4
                0012 C     | o Applies Shapiro filter to tracer field (cell center).
                0013 C     | o use filtering function "S4" = [1 - d_xx^n][1- 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_S4
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)
15c70d7cd1 Jean*0048 CEOP
aea29c8517 Alis*0049 
fb09a37055 Jean*0050       IF (nShapTr.gt.0) THEN
aea29c8517 Alis*0051 
                0052         DO bj=myByLo(myThid),myByHi(myThid)
                0053          DO bi=myBxLo(myThid),myBxHi(myThid)
15c70d7cd1 Jean*0054           DO K=1,kSize
                0055            DO J=1-OLy,sNy+Oly
                0056             DO I=1-Olx,sNx+Olx
aea29c8517 Alis*0057              tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
                0058             ENDDO
                0059            ENDDO
                0060           ENDDO
                0061          ENDDO
                0062         ENDDO
                0063 
                0064 
                0065 C      d_xx^n tmpFld 
                0066 
fb09a37055 Jean*0067        DO N=1,nShapTr
aea29c8517 Alis*0068 
15c70d7cd1 Jean*0069         IF (kSize.EQ.Nr) THEN
7163a40534 Jean*0070           _EXCH_XYZ_RL( tmpFld, myThid )
15c70d7cd1 Jean*0071         ELSE
7163a40534 Jean*0072           _EXCH_XY_RL( tmpFld, myThid )
15c70d7cd1 Jean*0073         ENDIF
aea29c8517 Alis*0074 
                0075         DO bj=myByLo(myThid),myByHi(myThid)
                0076          DO bi=myBxLo(myThid),myBxHi(myThid)
15c70d7cd1 Jean*0077           DO K=1,kSize
aea29c8517 Alis*0078 
                0079            DO J=1,sNy
                0080             DO I=1,sNx
                0081              tmpGrd(i,j) = -0.25*(
                0082      &        ( tmpFld(i+1,j,k,bi,bj)-tmpFld( i ,j,k,bi,bj) )
                0083      &            *_maskW(i+1,j,k,bi,bj)
                0084      &       -( tmpFld( i ,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
                0085      &            *_maskW(i,j,k,bi,bj) )
                0086             ENDDO
                0087            ENDDO
                0088 
                0089            DO J=1,sNy
                0090             DO I=1,sNx
                0091              tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
                0092             ENDDO
                0093            ENDDO
                0094 
                0095           ENDDO
                0096          ENDDO
                0097         ENDDO
                0098 
                0099        ENDDO
                0100 
15c70d7cd1 Jean*0101 C      F <-  [1 - d_xx^n *deltaT/tau].F
aea29c8517 Alis*0102        DO bj=myByLo(myThid),myByHi(myThid)
                0103         DO bi=myBxLo(myThid),myBxHi(myThid)
15c70d7cd1 Jean*0104          DO K=1,kSize
aea29c8517 Alis*0105           DO J=1,sNy
                0106            DO I=1,sNx
15c70d7cd1 Jean*0107             field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
dfc17c9c63 Jean*0108      &              -tmpFld(i,j,k,bi,bj)*dTtracerLev(1)/Shap_Trtau
15c70d7cd1 Jean*0109             tmpFld(i,j,k,bi,bj)=field(i,j,k,bi,bj)
aea29c8517 Alis*0110            ENDDO
                0111           ENDDO
                0112          ENDDO
                0113         ENDDO
                0114        ENDDO
                0115 
                0116 
                0117 C      d_yy^n tmpFld 
                0118 
fb09a37055 Jean*0119        DO N=1,nShapTr
aea29c8517 Alis*0120 
15c70d7cd1 Jean*0121         IF (kSize.EQ.1) THEN
7163a40534 Jean*0122           _EXCH_XY_RL( tmpFld, myThid )
15c70d7cd1 Jean*0123         ELSE
7163a40534 Jean*0124           _EXCH_XYZ_RL( tmpFld, myThid )
15c70d7cd1 Jean*0125         ENDIF
aea29c8517 Alis*0126 
                0127         DO bj=myByLo(myThid),myByHi(myThid)
                0128          DO bi=myBxLo(myThid),myBxHi(myThid)
15c70d7cd1 Jean*0129           DO K=1,kSize
aea29c8517 Alis*0130 
                0131            DO J=1,sNy
                0132             DO I=1,sNx
                0133              tmpGrd(i,j) = -0.25*(
                0134      &        ( tmpFld(i,j+1,k,bi,bj)-tmpFld(i, j ,k,bi,bj) )
                0135      &            *_maskS(i,j+1,k,bi,bj)
                0136      &       -( tmpFld(i, j ,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
                0137      &            *_maskS(i,j,k,bi,bj) )
                0138             ENDDO
                0139            ENDDO
                0140 
                0141            DO J=1,sNy
                0142             DO I=1,sNx
                0143              tmpFld(i,j,k,bi,bj) = tmpGrd(i,j)
                0144             ENDDO
                0145            ENDDO
                0146 
                0147           ENDDO
                0148          ENDDO
                0149         ENDDO
                0150 
                0151        ENDDO
                0152 
15c70d7cd1 Jean*0153 C      F <-  [1 - d_yy^n *deltaT/tau].F
aea29c8517 Alis*0154        DO bj=myByLo(myThid),myByHi(myThid)
                0155         DO bi=myBxLo(myThid),myBxHi(myThid)
15c70d7cd1 Jean*0156          DO K=1,kSize
aea29c8517 Alis*0157           DO J=1,sNy
                0158            DO I=1,sNx
15c70d7cd1 Jean*0159             field(i,j,k,bi,bj)=field(i,j,k,bi,bj)
dfc17c9c63 Jean*0160      &              -tmpFld(i,j,k,bi,bj)*dTtracerLev(1)/Shap_Trtau
aea29c8517 Alis*0161            ENDDO
                0162           ENDDO
                0163          ENDDO
                0164         ENDDO
                0165        ENDDO
                0166 
15c70d7cd1 Jean*0167         IF (kSize.EQ.Nr) THEN
7163a40534 Jean*0168           _EXCH_XYZ_RL( field, myThid )
15c70d7cd1 Jean*0169         ELSEIF (kSize.EQ.1) THEN
7163a40534 Jean*0170           _EXCH_XY_RL( field, myThid )
15c70d7cd1 Jean*0171         ELSE
                0172           STOP 'S/R SHAP_FILT_TRACER_S4: kSize is wrong'
                0173         ENDIF
aea29c8517 Alis*0174 
                0175       ENDIF
                0176 #endif /* ALLOW_SHAP_FILT */
                0177 
                0178       RETURN
                0179       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!