/[MITgcm]/MITgcm/pkg/shap_filt/shap_filt_tracer_s2.F
ViewVC logotype

Diff of /MITgcm/pkg/shap_filt/shap_filt_tracer_s2.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.10 by jmc, Fri Oct 7 14:19:42 2005 UTC revision 1.11 by jmc, Sun Mar 26 22:56:43 2006 UTC
# Line 8  C     !ROUTINE: SHAP_FILT_TRACER_S2 Line 8  C     !ROUTINE: SHAP_FILT_TRACER_S2
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE SHAP_FILT_TRACER_S2(        SUBROUTINE SHAP_FILT_TRACER_S2(
10       U           field, tmpFld,       U           field, tmpFld,
11       I           nShapTr, kSize, myTime, myThid )       I           nShapTr, exchInOut, kSize,
12         I           myTime, myIter, myThid )
13  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
14  C     *==========================================================*  C     *==========================================================*
15  C     | S/R SHAP_FILT_TRACER_S2  C     | S/R SHAP_FILT_TRACER_S2
# Line 31  C     == Global variables === Line 32  C     == Global variables ===
32    
33  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
34  C     == Routine arguments  C     == Routine arguments
35  C     field :: cell-centered 2D field on which filter applies  C     field     :: cell-centered 2D field on which filter applies
36  C     tmpFld :: working temporary array  C     tmpFld    :: working temporary array
37  C     nShapTr :: (total) power of the filter for this tracer  C     nShapTr   :: (total) power of the filter for this tracer
38  C     kSize :: length of 3rd Dim : either =1 (2D field) or =Nr (3D field)  C     exchInOut :: apply Exchanges to fill overlap region:
39  C     myTime :: Current time in simulation  C            = 0 : do not apply Exch on neither input nor output field
40  C     myThid :: Thread number for this instance of SHAP_FILT_TRACER_S2  C            = 1 : apply Exch on input field
41        INTEGER nShapTr, kSize  C                  (needed if input field has invalid overlap)
42    C            = 2 : apply Exch on output field (after the filter)
43    C            = 3 : apply Exch on both input & output field
44    C     kSize     :: length of 3rd Dim : either =1 (2D field) or =Nr (3D field)
45    C     myTime    :: Current time in simulation
46    C     myIter    :: Current iteration number in simulation
47    C     myThid    :: Thread number for this instance of SHAP_FILT_TRACER_S2
48        _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)        _RL field(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
49        _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)        _RL tmpFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
50          INTEGER nShapTr, exchInOut, kSize
51        _RL     myTime        _RL     myTime
52          INTEGER myIter
53        INTEGER myThid        INTEGER myThid
54    
55  #ifdef ALLOW_SHAP_FILT  #ifdef ALLOW_SHAP_FILT
# Line 54  C     == Local variables == Line 63  C     == Local variables ==
63        _RL tmpFdy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL tmpFdy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
64  CEOP  CEOP
65    
66          IF ( exchInOut.LT.0 .OR. exchInOut.GT.3 ) THEN
67             STOP 'S/R SHAP_FILT_TRACER_S2: exchInOut is wrong'
68          ENDIF
69    
70        IF (nShapTr.GT.0) THEN        IF (nShapTr.GT.0) THEN
71  C-------  C-------
72  C  Apply computational filter ^(nShap-nShapPhys) without grid factor  C  Apply computational filter ^(nShap-nShapPhys) without grid factor
# Line 78  C      ( d_xx +d_yy )^n tmpFld Line 91  C      ( d_xx +d_yy )^n tmpFld
91    
92         DO n=1,nShapTr         DO n=1,nShapTr
93    
94          IF ( MOD(n,2).EQ.1 .OR. Shap_alwaysExchTr ) THEN          IF ( ( MOD(n,2).EQ.1 .OR. Shap_alwaysExchTr ) .AND.
95         &       ( n.GE.2 .OR. MOD(exchInOut,2).EQ.1 )  ) THEN
96           IF (kSize.EQ.Nr) THEN           IF (kSize.EQ.Nr) THEN
97            _EXCH_XYZ_R8( tmpFld, myThid )            _EXCH_XYZ_R8( tmpFld, myThid )
98           ELSEIF (kSize.EQ.1) THEN           ELSEIF (kSize.EQ.1) THEN
# Line 99  C--        Calculate gradient in X direc Line 113  C--        Calculate gradient in X direc
113             IF ( .NOT.Shap_alwaysExchTr             IF ( .NOT.Shap_alwaysExchTr
114       &          .AND. useCubedSphereExchange ) THEN       &          .AND. useCubedSphereExchange ) THEN
115  C          to compute d/dx(tmpFld), fill corners with appropriate values:  C          to compute d/dx(tmpFld), fill corners with appropriate values:
116               CALL FILL_CS_CORNER_TR_RL( .TRUE.,               CALL FILL_CS_CORNER_TR_RL( .TRUE.,
117       &                                 tmpFld(1-Olx,1-Oly,k,bi,bj),       &                                 tmpFld(1-Olx,1-Oly,k,bi,bj),
118       &                                 bi,bj, myThid )       &                                 bi,bj, myThid )
119             ENDIF             ENDIF
120  #endif  #endif
# Line 108  C          to compute d/dx(tmpFld), fill Line 122  C          to compute d/dx(tmpFld), fill
122  C-         Computational space: del_i  C-         Computational space: del_i
123               DO j=0,sNy+1               DO j=0,sNy+1
124                DO i=0,sNx+2                DO i=0,sNx+2
125                 tmpFdx(i,j) =                 tmpFdx(i,j) =
126       &            ( tmpFld(i,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )       &            ( tmpFld(i,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
127       &                     *_maskW(i,j,k,bi,bj)       &                     *_maskW(i,j,k,bi,bj)
128                ENDDO                ENDDO
# Line 117  C-         Computational space: del_i Line 131  C-         Computational space: del_i
131  C-         Physical space: grad_x  C-         Physical space: grad_x
132               DO j=0,sNy+1               DO j=0,sNy+1
133                DO i=0,sNx+2                DO i=0,sNx+2
134                 tmpFdx(i,j) =                 tmpFdx(i,j) =
135       &            ( tmpFld(i,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )       &            ( tmpFld(i,j,k,bi,bj)-tmpFld(i-1,j,k,bi,bj) )
136       &                     *_hFacW(i,j,k,bi,bj)       &                     *_hFacW(i,j,k,bi,bj)
137       &                     *dyG(i,j,bi,bj)*recip_dxC(i,j,bi,bj)       &                     *dyG(i,j,bi,bj)*recip_dxC(i,j,bi,bj)
# Line 130  C--        Calculate gradient in Y direc Line 144  C--        Calculate gradient in Y direc
144             IF ( .NOT.Shap_alwaysExchTr             IF ( .NOT.Shap_alwaysExchTr
145       &          .AND. useCubedSphereExchange ) THEN       &          .AND. useCubedSphereExchange ) THEN
146  C          to compute d/dy(tmpFld), fill corners with appropriate values:  C          to compute d/dy(tmpFld), fill corners with appropriate values:
147               CALL FILL_CS_CORNER_TR_RL(.FALSE.,               CALL FILL_CS_CORNER_TR_RL(.FALSE.,
148       &                                 tmpFld(1-Olx,1-Oly,k,bi,bj),       &                                 tmpFld(1-Olx,1-Oly,k,bi,bj),
149       &                                 bi,bj, myThid )       &                                 bi,bj, myThid )
150             ENDIF             ENDIF
151  #endif  #endif
# Line 139  C          to compute d/dy(tmpFld), fill Line 153  C          to compute d/dy(tmpFld), fill
153  C-         Computational space: del_j  C-         Computational space: del_j
154               DO j=0,sNy+2               DO j=0,sNy+2
155                DO i=0,sNx+1                DO i=0,sNx+1
156                 tmpFdy(i,j) =                 tmpFdy(i,j) =
157       &            ( tmpFld(i,j,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )       &            ( tmpFld(i,j,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
158       &                     *_maskS(i,j,k,bi,bj)       &                     *_maskS(i,j,k,bi,bj)
159                ENDDO                ENDDO
# Line 148  C-         Computational space: del_j Line 162  C-         Computational space: del_j
162  C-         Physical space: grad_y  C-         Physical space: grad_y
163               DO j=0,sNy+2               DO j=0,sNy+2
164                DO i=0,sNx+1                DO i=0,sNx+1
165                 tmpFdy(i,j) =                 tmpFdy(i,j) =
166       &            ( tmpFld(i,j,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )       &            ( tmpFld(i,j,k,bi,bj)-tmpFld(i,j-1,k,bi,bj) )
167       &                     *_hFacS(i,j,k,bi,bj)       &                     *_hFacS(i,j,k,bi,bj)
168       &                     *dxG(i,j,bi,bj)*recip_dyC(i,j,bi,bj)       &                     *dxG(i,j,bi,bj)*recip_dyC(i,j,bi,bj)
# Line 164  C--        Calculate (d_xx + d_yy) tmpFl Line 178  C--        Calculate (d_xx + d_yy) tmpFl
178               ENDDO               ENDDO
179             ENDDO             ENDDO
180    
181  C--        Computational space Filter  C--        Computational space Filter
182             IF ( n.LE.nShapComput ) THEN             IF ( n.LE.nShapComput ) THEN
183               DO j=0,sNy+1               DO j=0,sNy+1
184                DO i=0,sNx+1                DO i=0,sNx+1
185                 tmpFld(i,j,k,bi,bj) = -0.125*tmpGrd(i,j)                 tmpFld(i,j,k,bi,bj) = -0.125*tmpGrd(i,j)
186                ENDDO                ENDDO
187               ENDDO               ENDDO
188  C--        Physical space Filter  C--        Physical space Filter
189             ELSEIF (Shap_TrLength.LE.0.) THEN             ELSEIF (Shap_TrLength.LE.0.) THEN
190               DO j=0,sNy+1               DO j=0,sNy+1
191                DO i=0,sNx+1                DO i=0,sNx+1
# Line 212  C      F <-  [1 - (d_xx+d_yy)^n *deltaT/ Line 226  C      F <-  [1 - (d_xx+d_yy)^n *deltaT/
226          ENDDO          ENDDO
227         ENDDO         ENDDO
228    
229  c       IF (kSize.EQ.Nr) THEN         IF ( exchInOut.GE.2 ) THEN
230  c         _EXCH_XYZ_R8( field, myThid )          IF (kSize.EQ.Nr) THEN
231  c       ELSEIF (kSize.EQ.1) THEN            _EXCH_XYZ_R8( field, myThid )
232  c         _EXCH_XY_R8( field, myThid )          ELSEIF (kSize.EQ.1) THEN
233  c       ELSE            _EXCH_XY_R8( field, myThid )
234  c         STOP 'S/R SHAP_FILT_TRACER_S2: kSize is wrong'          ELSE
235  c       ENDIF            STOP 'S/R SHAP_FILT_TRACER_S2: kSize is wrong'
236            ENDIF
237           ENDIF
238    
239        ENDIF        ENDIF
240  #endif /* ALLOW_SHAP_FILT */  #endif /* ALLOW_SHAP_FILT */
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22